--- a/Tools_MethodCategoryList.st Thu Oct 29 18:55:01 2009 +0100
+++ b/Tools_MethodCategoryList.st Thu Oct 29 18:56:10 2009 +0100
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 2000 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -14,31 +14,31 @@
"{ NameSpace: Tools }"
BrowserList subclass:#MethodCategoryList
- instanceVariableNames:'variableFilter filterClassVars lastSelectedProtocols classes
- leafClasses protocolList rawProtocolList selectedProtocolIndices
- lastGeneratedProtocols packageFilterOnInput
- methodVisibilityHolder noAllItem noPseudoItems
- showPseudoProtocols'
- classVariableNames:'AdditionalEmptyCategoriesPerClassName MethodInfoCache
- MethodInfoCacheAccessLock'
- poolDictionaries:''
- category:'Interface-Browsers-New'
+ instanceVariableNames:'variableFilter filterClassVars lastSelectedProtocols classes
+ leafClasses protocolList rawProtocolList selectedProtocolIndices
+ lastGeneratedProtocols packageFilterOnInput
+ methodVisibilityHolder noAllItem noPseudoItems
+ showPseudoProtocols'
+ classVariableNames:'AdditionalEmptyCategoriesPerClassName MethodInfoCache
+ MethodInfoCacheAccessLock'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
!
Object subclass:#CachedMethodInfo
- instanceVariableNames:'flags'
- classVariableNames:'FlagObsolete FlagSendsSuper FlagIsUncommented
- FlagIsDocumentationMethod FlagIsLongMethod FlagIsExtension
- FlagIsRedefine FlagIsOverride FlagIsSubclassResponsibility'
- poolDictionaries:''
- privateIn:MethodCategoryList
+ instanceVariableNames:'flags'
+ classVariableNames:'FlagObsolete FlagSendsSuper FlagIsUncommented
+ FlagIsDocumentationMethod FlagIsLongMethod FlagIsExtension
+ FlagIsRedefine FlagIsOverride FlagIsSubclassResponsibility'
+ poolDictionaries:''
+ privateIn:MethodCategoryList
!
Method variableSubclass:#MissingMethod
- instanceVariableNames:'selector'
- classVariableNames:''
- poolDictionaries:''
- privateIn:MethodCategoryList
+ instanceVariableNames:'selector'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:MethodCategoryList
!
!MethodCategoryList class methodsFor:'documentation'!
@@ -46,7 +46,7 @@
copyright
"
COPYRIGHT (c) 2000 by eXept Software AG
- All Rights Reserved
+ All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
@@ -90,29 +90,29 @@
^
#(#FullSpec
- #name: #singleProtocolWindowSpec
- #window:
+ #name: #singleProtocolWindowSpec
+ #window:
#(#WindowSpec
- #label: 'ProtocolList'
- #name: 'ProtocolList'
- #min: #(#Point 0 0)
- #max: #(#Point 1024 721)
- #bounds: #(#Rectangle 12 22 312 322)
- )
- #component:
+ #label: 'ProtocolList'
+ #name: 'ProtocolList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 12 22 312 322)
+ )
+ #component:
#(#SpecCollection
- #collection: #(
- #(#LabelSpec
- #label: 'ProtocolName'
- #name: 'ProtocolLabel'
- #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
- #translateLabel: true
- #labelChannel: #protocolLabelHolder
- #menu: #menuHolder
- )
- )
+ #collection: #(
+ #(#LabelSpec
+ #label: 'ProtocolName'
+ #name: 'ProtocolLabel'
+ #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #translateLabel: true
+ #labelChannel: #protocolLabelHolder
+ #menu: #menuHolder
+ )
+ )
- )
+ )
)
!
@@ -218,8 +218,8 @@
filterClassVars
filterClassVars isNil ifTrue:[
- filterClassVars := false asValue.
- filterClassVars addDependent:self
+ filterClassVars := false asValue.
+ filterClassVars addDependent:self
].
^ filterClassVars
@@ -229,11 +229,11 @@
filterClassVars:aValueHolder
filterClassVars notNil ifTrue:[
- filterClassVars removeDependent:self
+ filterClassVars removeDependent:self
].
filterClassVars := aValueHolder.
filterClassVars notNil ifTrue:[
- filterClassVars addDependent:self
+ filterClassVars addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
@@ -242,19 +242,19 @@
methodVisibilityHolder
methodVisibilityHolder isNil ifTrue:[
- methodVisibilityHolder := false asValue.
- methodVisibilityHolder addDependent:self
+ methodVisibilityHolder := false asValue.
+ methodVisibilityHolder addDependent:self
].
^ methodVisibilityHolder
!
methodVisibilityHolder:aValueHolder
methodVisibilityHolder notNil ifTrue:[
- methodVisibilityHolder removeDependent:self
+ methodVisibilityHolder removeDependent:self
].
methodVisibilityHolder := aValueHolder.
methodVisibilityHolder notNil ifTrue:[
- methodVisibilityHolder addDependent:self
+ methodVisibilityHolder addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
@@ -263,26 +263,26 @@
noAllItem
noAllItem isNil ifTrue:[
- noAllItem := false asValue.
- noAllItem addDependent:self
+ noAllItem := false asValue.
+ noAllItem addDependent:self
].
^ noAllItem
!
noAllItem:aValueHolder
noAllItem notNil ifTrue:[
- noAllItem removeDependent:self
+ noAllItem removeDependent:self
].
noAllItem := aValueHolder.
noAllItem notNil ifTrue:[
- noAllItem addDependent:self
+ noAllItem addDependent:self
].
!
packageFilterOnInput
packageFilterOnInput isNil ifTrue:[
- packageFilterOnInput := nil asValue.
- packageFilterOnInput addDependent:self
+ packageFilterOnInput := nil asValue.
+ packageFilterOnInput addDependent:self
].
^ packageFilterOnInput
!
@@ -292,14 +292,14 @@
prevFilter := packageFilterOnInput value.
packageFilterOnInput notNil ifTrue:[
- packageFilterOnInput removeDependent:self
+ packageFilterOnInput removeDependent:self
].
packageFilterOnInput := aValueHolder.
packageFilterOnInput notNil ifTrue:[
- packageFilterOnInput addDependent:self
+ packageFilterOnInput addDependent:self
].
prevFilter ~= packageFilterOnInput value ifTrue:[
- self enqueueDelayedUpdateList
+ self enqueueDelayedUpdateList
].
!
@@ -309,7 +309,7 @@
protocolList
protocolList isNil ifTrue:[
- protocolList := List new. "/ ValueHolder new
+ protocolList := List new. "/ ValueHolder new
].
^ protocolList
@@ -319,15 +319,15 @@
rawProtocolList
rawProtocolList isNil ifTrue:[
- rawProtocolList := List new.
+ rawProtocolList := List new.
].
^ rawProtocolList
!
selectedProtocolIndices
selectedProtocolIndices isNil ifTrue:[
- selectedProtocolIndices := ValueHolder new.
- selectedProtocolIndices addDependent:self
+ selectedProtocolIndices := ValueHolder new.
+ selectedProtocolIndices addDependent:self
].
^ selectedProtocolIndices.
!
@@ -360,8 +360,8 @@
variableFilter
variableFilter isNil ifTrue:[
- variableFilter := false asValue.
- variableFilter addDependent:self
+ variableFilter := false asValue.
+ variableFilter addDependent:self
].
^ variableFilter
@@ -371,11 +371,11 @@
variableFilter:aValueHolder
variableFilter notNil ifTrue:[
- variableFilter removeDependent:self
+ variableFilter removeDependent:self
].
variableFilter := aValueHolder.
variableFilter notNil ifTrue:[
- variableFilter addDependent:self
+ variableFilter addDependent:self
].
"Modified: / 31.1.2000 / 00:56:31 / cg"
@@ -389,30 +389,30 @@
anyChange := false.
refetch := [:oldClass |
- |nm cls newClass|
+ |nm cls newClass|
- nm := oldClass theNonMetaclass name.
- oldClass isMeta ifTrue:[
- newClass := Smalltalk at:nm.
- newClass isNil ifTrue:[
- Transcript showCR:'oops - browser lost class ' , nm.
- newClass := oldClass
- ] ifFalse:[
- newClass := newClass theMetaclass
- ]
- ] ifFalse:[
- newClass := Smalltalk at:nm
- ].
- newClass ~~ oldClass ifTrue:[
- anyChange := true.
- ].
- newClass
- ].
+ nm := oldClass theNonMetaclass name.
+ oldClass isMeta ifTrue:[
+ newClass := Smalltalk at:nm.
+ newClass isNil ifTrue:[
+ Transcript showCR:'oops - browser lost class ' , nm.
+ newClass := oldClass
+ ] ifFalse:[
+ newClass := newClass theMetaclass
+ ]
+ ] ifFalse:[
+ newClass := Smalltalk at:nm
+ ].
+ newClass ~~ oldClass ifTrue:[
+ anyChange := true.
+ ].
+ newClass
+ ].
classes := classes collect:refetch.
leafClasses := leafClasses collect:refetch.
anyChange ifTrue:[
- self updateOutputGenerator
+ self updateOutputGenerator
].
!
@@ -656,8 +656,8 @@
and:[newSelectedCategories notNil
and:[(lastSelectedProtocols includes:(allEntry))
and:[newSelectedCategories includes:(allEntry)]]]) ifTrue:[
- "/ no change ...
- ^ self
+ "/ no change ...
+ ^ self
].
super selectionChanged.
@@ -960,11 +960,11 @@
class:cls protocol:cat includesMethodsInAnyPackage:packageFilter
cls methodDictionary keysAndValuesDo:[:sel :mthd |
- mthd category == cat ifTrue:[
- (packageFilter includes:mthd package) ifTrue:[
- ^ true
- ]
- ]
+ mthd category == cat ifTrue:[
+ (packageFilter includes:mthd package) ifTrue:[
+ ^ true
+ ]
+ ]
].
^ false
!
@@ -990,41 +990,41 @@
anyVarNameAccessable := cls allInstVarNames includesAny:variablesToHighLight.
anyVarNameAccessable ifFalse:[
- anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
+ anyVarNameAccessable := cls theNonMetaclass allClassVarNames includesAny:variablesToHighLight.
].
anyVarNameAccessable ifFalse:[
- "/ no need to parse
- ^ false
+ "/ no need to parse
+ ^ false
].
cls selectorsAndMethodsDo:[:sel :mthd |
- |src parser usedVars|
+ |src parser usedVars|
- mthd category = cat ifTrue:[
- src := mthd source.
- src notNil ifTrue:[
- "
- before doing a slow parse, quickly scan the
- methods source for the variables name ...
- "
- (variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
- parser := Parser
- parseMethod:src
- in:cls
- ignoreErrors:true
- ignoreWarnings:true.
- (parser notNil and:[parser ~~ #Error]) ifTrue:[
- usedVars := parser perform:querySelector.
- (usedVars includesAny:variablesToHighLight)
- ifTrue:[
- ^ true
- ]
- ]
- ]
- ] ifFalse:[
- Transcript showCR:'Oops - cannot access methods source'.
- ]
- ]
+ mthd category = cat ifTrue:[
+ src := mthd source.
+ src notNil ifTrue:[
+ "
+ before doing a slow parse, quickly scan the
+ methods source for the variables name ...
+ "
+ (variablesToHighLight contains:[:varName | (src findString:varName) ~~ 0]) ifTrue:[
+ parser := Parser
+ parseMethod:src
+ in:cls
+ ignoreErrors:true
+ ignoreWarnings:true.
+ (parser notNil and:[parser ~~ #Error]) ifTrue:[
+ usedVars := parser perform:querySelector.
+ (usedVars includesAny:variablesToHighLight)
+ ifTrue:[
+ ^ true
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ Transcript showCR:'Oops - cannot access methods source'.
+ ]
+ ]
].
^ false
!
@@ -1059,7 +1059,7 @@
emphasizedPlus emphasisForRef emphasisForMod
numAll numObsolete numSuper numUncommented numDocumentation numLong numOverride
numRedefine numExtension numMissingRequired numSubclassResponsibility showPseudoProtocols
- addPseudoEntry countAll|
+ addPseudoEntry countAll pseudoEntryColor|
countAll := true.
@@ -1292,23 +1292,29 @@
self protocolLabelHolder value:nm
].
+ pseudoEntryColor := self class pseudoEntryForegroundColor.
+
categoryList notEmpty ifTrue:[
noAllItem value ~~ true ifTrue:[
+ |allName|
+
countAll ifTrue:[
- categoryList addFirst:((self class nameListEntryForALLWithCount bindWith:numAll) allItalic colorizeAllWith:Color grey).
+ allName := self class nameListEntryForALLWithCount bindWith:numAll.
] ifFalse:[
- categoryList addFirst:(nameListEntryForALL allItalic colorizeAllWith:Color grey).
+ allName := nameListEntryForALL.
].
+ categoryList addFirst:(allName allItalic colorizeAllWith:pseudoEntryColor).
rawProtocolList addFirst:nameListEntryForALL.
].
].
+
showPseudoProtocols value ifTrue:[
addPseudoEntry := [:s :n |
n > 0 ifTrue:[
categoryList
add:((s bindWith:n)
allItalic
- colorizeAllWith:Color grey).
+ colorizeAllWith:pseudoEntryColor).
rawProtocolList add:s.
].
].
@@ -1374,42 +1380,42 @@
sameContents := self updateListFor:newList.
self selectedProtocolIndices addDependent:self.
sameContents ifFalse:[
- prevSelection := lastSelectedProtocols ? (selectedProtocolsHolder value) ? #().
- "/ prevSelection := selectedProtocolsHolder value ? lastSelectedProtocols ? #().
+ prevSelection := lastSelectedProtocols ? (selectedProtocolsHolder value) ? #().
+ "/ prevSelection := selectedProtocolsHolder value ? lastSelectedProtocols ? #().
- rawList := self rawProtocolList value.
- newSelection := prevSelection select:[:item | rawList includes:item string].
+ rawList := self rawProtocolList value.
+ newSelection := prevSelection select:[:item | rawList includes:item string].
- newSelection size > 0 ifTrue:[
- "/ force change (for dependents)
+ newSelection size > 0 ifTrue:[
+ "/ force change (for dependents)
"/ selectedProtocolsHolder value:nil.
"/ selectedProtocolsHolder value:newSelection.
- selectedProtocolsHolder setValue:newSelection.
- selectedProtocolsHolder changed:#value.
- ] ifFalse:[
- prevSelection := selectedProtocolsHolder value.
- selectedProtocolsHolder value:nil.
- ].
- (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
- self enqueueDelayedUpdateOutputGenerator.
- "/ self updateOutputGenerator.
- ].
+ selectedProtocolsHolder setValue:newSelection.
+ selectedProtocolsHolder changed:#value.
+ ] ifFalse:[
+ prevSelection := selectedProtocolsHolder value.
+ selectedProtocolsHolder value:nil.
+ ].
+ (prevSelection size > 0 or:[newSelection size > 0]) ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator.
+ "/ self updateOutputGenerator.
+ ].
"/ prevSelection notNil ifTrue:[
"/ lastSelectedProtocols := prevSelection.
"/ ].
] ifTrue:[
- "/ same list - but classes might have changed
- "/ that is the case, if the class selection has been changed,
- "/ to another class which has the same categories.
- (prevClasses size ~= classes size
- or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
- (newList size > 0 or:[oldList size > 0]) ifTrue:[
- self updateOutputGenerator
- ]
- ] ifFalse:[
+ "/ same list - but classes might have changed
+ "/ that is the case, if the class selection has been changed,
+ "/ to another class which has the same categories.
+ (prevClasses size ~= classes size
+ or:[prevClasses asOrderedCollection ~= (classes ? #()) asOrderedCollection ]) ifTrue:[
+ (newList size > 0 or:[oldList size > 0]) ifTrue:[
+ self updateOutputGenerator
+ ]
+ ] ifFalse:[
"/ self protocolList value:newList.
- ]
+ ]
].
listValid := true.
@@ -1565,7 +1571,7 @@
"/ those are simulated - in ST/X, empty categories do not
"/ really exist; however, during browsing, it makes sense.
AdditionalEmptyCategoriesPerClassName notNil ifTrue:[
- AdditionalEmptyCategoriesPerClassName removeKey:aClass name ifAbsent:nil
+ AdditionalEmptyCategoriesPerClassName removeKey:aClass name ifAbsent:nil
].
@@ -1747,11 +1753,11 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.50 2009-10-29 17:29:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.51 2009-10-29 17:56:10 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.50 2009-10-29 17:29:14 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.51 2009-10-29 17:56:10 cg Exp $'
! !
MethodCategoryList initialize!