--- a/Tools_MethodCategoryList.st Thu Apr 01 18:10:27 2004 +0200
+++ b/Tools_MethodCategoryList.st Fri Apr 02 13:30:01 2004 +0200
@@ -873,7 +873,8 @@
generator nm variablesToHighlight classVarsToHighLight
itemsWithVarRefs itemsWithVarMods itemsWithExtensions itemsWithSuppressedExtensions
itemsInChangeSet
- item packageFilterOnInput packageFilter nameListEntryForALL emp|
+ item packageFilterOnInput packageFilter nameListEntryForALL emp
+ changeSet classesInChangeSet|
generator := inGeneratorHolder value.
generator isNil ifTrue:[ ^ #() ].
@@ -882,11 +883,11 @@
packageFilterOnInput := self packageFilterOnInput value.
(packageFilterOnInput notNil and:[packageFilterOnInput includes:nameListEntryForALL]) ifTrue:[
- packageFilterOnInput := nil
+ packageFilterOnInput := nil
].
packageFilter := self packageFilter value.
(packageFilter notNil and:[packageFilter includes:nameListEntryForALL]) ifTrue:[
- packageFilter := nil
+ packageFilter := nil
].
categoryList := Set new.
@@ -902,95 +903,98 @@
classVarsToHighLight := filterClassVars value.
generator do:[:clsIn :catIn |
- |emptyProtocols clsName doHighLight doHighLightRed suppress|
+ |emptyProtocols clsName doHighLight doHighLightRed suppress|
- leafClassesProcessed add:clsIn.
- (self classesToProcessForClasses:(Array with:clsIn)) do:[:cls |
- |cats|
+ leafClassesProcessed add:clsIn.
+ (self classesToProcessForClasses:(Array with:clsIn)) do:[:cls |
+ |cats|
- classesProcessed add:cls.
+ classesProcessed add:cls.
- cls ~~ clsIn ifTrue:[
- cats := cls categories
- ] ifFalse:[
- cats := Array with:catIn.
- ].
- cats do:[:cat |
- cat notNil ifTrue:[
- suppress := packageFilterOnInput notNil
- and:[ (self class:cls protocol:cat includesMethodsInAnyPackage:packageFilterOnInput) not ].
+ cls ~~ clsIn ifTrue:[
+ cats := cls categories
+ ] ifFalse:[
+ cats := Array with:catIn.
+ ].
+ cats do:[:cat |
+ cat notNil ifTrue:[
+ suppress := packageFilterOnInput notNil
+ and:[ (self class:cls protocol:cat includesMethodsInAnyPackage:packageFilterOnInput) not ].
- suppress ifFalse:[
- variablesToHighlight size > 0 ifTrue:[
- (itemsWithVarRefs includes:cat) ifFalse:[
- classVarsToHighLight ifTrue:[
- doHighLight := self class:cls protocol:cat includesRefsToClassVariable:variablesToHighlight.
- doHighLight ifTrue:[
- doHighLightRed := self class:cls protocol:cat includesModsOfClassVariable:variablesToHighlight.
- ].
- ] ifFalse:[
- doHighLight := self class:cls protocol:cat includesRefsToInstanceVariable:variablesToHighlight.
- doHighLight ifTrue:[
- doHighLightRed := self class:cls protocol:cat includesModsOfInstanceVariable:variablesToHighlight.
- ].
- ].
- doHighLight ifTrue:[
- itemsWithVarRefs add:cat.
- doHighLightRed ifTrue:[
- itemsWithVarMods add:cat.
- ].
- ]
- ]
- ].
- categoryList add:cat.
+ suppress ifFalse:[
+ variablesToHighlight size > 0 ifTrue:[
+ (itemsWithVarRefs includes:cat) ifFalse:[
+ classVarsToHighLight ifTrue:[
+ doHighLight := self class:cls protocol:cat includesRefsToClassVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self class:cls protocol:cat includesModsOfClassVariable:variablesToHighlight.
+ ].
+ ] ifFalse:[
+ doHighLight := self class:cls protocol:cat includesRefsToInstanceVariable:variablesToHighlight.
+ doHighLight ifTrue:[
+ doHighLightRed := self class:cls protocol:cat includesModsOfInstanceVariable:variablesToHighlight.
+ ].
+ ].
+ doHighLight ifTrue:[
+ itemsWithVarRefs add:cat.
+ doHighLightRed ifTrue:[
+ itemsWithVarMods add:cat.
+ ].
+ ]
+ ]
+ ].
+ categoryList add:cat.
- AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
- clsName := cls name.
- emptyProtocols := AdditionalEmptyCategoriesPerClassName at:clsName ifAbsent:nil.
- emptyProtocols size > 0 ifTrue:[
- emptyProtocols remove:cat ifAbsent:nil.
- ].
- emptyProtocols size == 0 ifTrue:[
- AdditionalEmptyCategoriesPerClassName removeKey:clsName ifAbsent:nil
- ].
- ].
- ]
- ]
- ]
- ]
- ].
+ AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
+ clsName := cls name.
+ emptyProtocols := AdditionalEmptyCategoriesPerClassName at:clsName ifAbsent:nil.
+ emptyProtocols size > 0 ifTrue:[
+ emptyProtocols remove:cat ifAbsent:nil.
+ ].
+ emptyProtocols size == 0 ifTrue:[
+ AdditionalEmptyCategoriesPerClassName removeKey:clsName ifAbsent:nil
+ ].
+ ].
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ changeSet := ChangeSet current.
+ classesInChangeSet := changeSet changedClasses.
classesProcessed do:[:eachClass |
- |classPackage|
+ |classPackage|
- classPackage := eachClass package.
- eachClass methodDictionary keysAndValuesDo:[:sel :mthd |
- |mPackage mCategory|
+ classPackage := eachClass package.
+ eachClass methodDictionary keysAndValuesDo:[:sel :mthd |
+ |mPackage mCategory|
- mPackage := mthd package.
- mCategory := mthd category.
+ mPackage := mthd package.
+ mCategory := mthd category.
- #fixme.
- mPackage = classPackage ifTrue:[
- mPackage ~~ classPackage ifTrue:[
- mthd setPackage:(mPackage := mPackage string asSymbol).
- ]
- ].
- mPackage ~~ classPackage ifTrue:[
- itemsWithExtensions add:mCategory.
+ #fixme.
+ mPackage = classPackage ifTrue:[
+ mPackage ~~ classPackage ifTrue:[
+ mthd setPackage:(mPackage := mPackage string asSymbol).
+ ]
+ ].
+ mPackage ~~ classPackage ifTrue:[
+ itemsWithExtensions add:mCategory.
- (packageFilter notNil
- and:[ (packageFilter includes:mPackage) not])
- ifTrue:[
- itemsWithSuppressedExtensions add:mCategory.
- ].
- ].
- (ChangeSet current changedClasses includes:eachClass) ifTrue:[
- (ChangeSet current includesChangeForClass:eachClass selector:mthd selector) ifTrue:[
- itemsInChangeSet add:mCategory.
- ]
- ]
- ]
+ (packageFilter notNil
+ and:[ (packageFilter includes:mPackage) not])
+ ifTrue:[
+ itemsWithSuppressedExtensions add:mCategory.
+ ].
+ ].
+ (classesInChangeSet includes:eachClass) ifTrue:[
+ (changeSet includesChangeForClass:eachClass selector:mthd selector) ifTrue:[
+ itemsInChangeSet add:mCategory.
+ ]
+ ]
+ ]
].
categoryList := categoryList asOrderedCollection.
@@ -998,57 +1002,57 @@
rawProtocolList addAll:categoryList.
itemsWithExtensions do:[:cat |
- (categoryList includes:cat) ifTrue:[
- (itemsWithVarRefs includes:cat) ifFalse:[
- categoryList remove:cat.
- rawProtocolList remove:cat.
- (itemsWithSuppressedExtensions includes:cat) ifTrue:[
- item := cat , (self colorizeForDifferentPackage:' [ + ]').
- ] ifFalse:[
- item := self colorizeForDifferentPackage:cat.
- ].
- categoryList add:item.
- rawProtocolList add:cat.
- ]
- ]
+ (categoryList includes:cat) ifTrue:[
+ (itemsWithVarRefs includes:cat) ifFalse:[
+ categoryList remove:cat.
+ rawProtocolList remove:cat.
+ (itemsWithSuppressedExtensions includes:cat) ifTrue:[
+ item := cat , (self colorizeForDifferentPackage:' [ + ]').
+ ] ifFalse:[
+ item := self colorizeForDifferentPackage:cat.
+ ].
+ categoryList add:item.
+ rawProtocolList add:cat.
+ ]
+ ]
].
itemsInChangeSet do:[:cat |
- (categoryList includes:cat) ifTrue:[
- categoryList remove:cat.
- rawProtocolList remove:cat.
- item := self colorizeForChangedCode:cat.
- categoryList add:item.
- rawProtocolList add:cat.
- ]
+ (categoryList includes:cat) ifTrue:[
+ categoryList remove:cat.
+ rawProtocolList remove:cat.
+ item := self colorizeForChangedCode:cat.
+ categoryList add:item.
+ rawProtocolList add:cat.
+ ]
].
categoryList removeAll:itemsWithVarRefs.
rawProtocolList removeAll:itemsWithVarRefs.
itemsWithVarRefs do:[:cat |
- item := cat allBold.
- (itemsWithVarMods includes:cat) ifTrue:[
- emp := (UserPreferences current emphasisForWrittenVariable).
- ] ifFalse:[
- emp := (UserPreferences current emphasisForReadVariable).
- ].
- item emphasisAllAdd:emp.
- categoryList add:item.
- rawProtocolList add:cat.
+ item := cat allBold.
+ (itemsWithVarMods includes:cat) ifTrue:[
+ emp := (UserPreferences current emphasisForWrittenVariable).
+ ] ifFalse:[
+ emp := (UserPreferences current emphasisForReadVariable).
+ ].
+ item emphasisAllAdd:emp.
+ categoryList add:item.
+ rawProtocolList add:cat.
].
classesProcessed size > 0 ifTrue:[
- "/ those are simulated - in ST/X, empty categories do not
- "/ really exist; however, during browsing, it makes sense.
- AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
- AdditionalEmptyCategoriesPerClassName keysAndValuesDo:[:clsName :protocols |
- (classesProcessed contains:[:cls | cls name = clsName]) ifTrue:[
- categoryList addAll:protocols.
- rawProtocolList addAll:protocols.
- ]
- ]
- ].
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyCategoriesPerClassName size > 0 ifTrue:[
+ AdditionalEmptyCategoriesPerClassName keysAndValuesDo:[:clsName :protocols |
+ (classesProcessed contains:[:cls | cls name = clsName]) ifTrue:[
+ categoryList addAll:protocols.
+ rawProtocolList addAll:protocols.
+ ]
+ ]
+ ].
].
self makeIndependent.
@@ -1068,17 +1072,17 @@
"/
rawProtocolList sortWith:categoryList.
categoryList size == 1 ifTrue:[
- nm := categoryList first string.
- classes size == 1 ifTrue:[
- nm := classes first name , '-' , nm
- ].
- self protocolLabelHolder value:nm
+ nm := categoryList first string.
+ classes size == 1 ifTrue:[
+ nm := classes first name , '-' , nm
+ ].
+ self protocolLabelHolder value:nm
].
categoryList notEmpty ifTrue:[
- noAllItem value ~~ true ifTrue:[
- categoryList addFirst:nameListEntryForALL.
- rawProtocolList addFirst:nameListEntryForALL.
- ]
+ noAllItem value ~~ true ifTrue:[
+ categoryList addFirst:nameListEntryForALL.
+ rawProtocolList addFirst:nameListEntryForALL.
+ ]
].
^ categoryList
@@ -1250,5 +1254,5 @@
!MethodCategoryList class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.2 2004-02-26 19:03:55 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_MethodCategoryList.st,v 1.3 2004-04-02 11:30:01 werner Exp $'
! !