--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__ClassCategoryList.st Sun Jan 29 12:53:39 2012 +0000
@@ -0,0 +1,911 @@
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ 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
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+BrowserList subclass:#ClassCategoryList
+ instanceVariableNames:'categoryList classes allSelected showPseudoCategories'
+ classVariableNames:'AdditionalEmptyCategories'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!ClassCategoryList class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2004 by eXept Software AG
+ 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
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ embeddable application displaying the class-categories.
+ Provides an outputGenerator, which enumerates the classes in
+ the selected categories.
+
+ [author:]
+ Claus Gittinger (cg@exept.de)
+"
+! !
+
+!ClassCategoryList class methodsFor:'interface specs'!
+
+singleCategoryWindowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ClassCategoryList andSelector:#singleCategoryWindowSpec
+ ClassCategoryList new openInterface:#singleCategoryWindowSpec
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #singleCategoryWindowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'ClassCategoryList'
+ #name: 'ClassCategoryList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 218 175 518 475)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#LabelSpec
+ #label: 'ClassCategoryName'
+ #name: 'ClassCategoryLabel'
+ #layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
+ #translateLabel: true
+ #labelChannel: #classCategoryLabelHolder
+ #menu: #menuHolder
+ )
+ )
+
+ )
+ )
+!
+
+windowSpec
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "
+ UIPainter new openOnClass:ClassCategoryList andSelector:#windowSpec
+ ClassCategoryList new openInterface:#windowSpec
+ ClassCategoryList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'ClassCategoryList'
+ #name: 'ClassCategoryList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 13 23 313 323)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#SequenceViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #selectedCategories
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #useIndex: false
+ #sequenceList: #categoryList
+ #doubleClickChannel: #doubleClickChannel
+ #properties:
+ #(#PropertyListDictionary
+ #dragArgument: nil
+ #dropArgument: nil
+ #canDropSelector: #canDropContext:
+ #dropSelector: #doDropContext:
+ )
+ )
+ )
+
+ )
+ )
+
+ "Created: / 5.2.2000 / 13:42:11 / cg"
+ "Modified: / 18.8.2000 / 20:11:49 / cg"
+! !
+
+!ClassCategoryList class methodsFor:'plugIn spec'!
+
+aspectSelectors
+ "This resource specification was automatically generated
+ by the UIPainter of ST/X."
+
+ "Do not manually edit this. If it is corrupted,
+ the UIPainter may not be able to read the specification."
+
+ "Return a description of exported aspects;
+ these can be connected to aspects of an embedding application
+ (if this app is embedded in a subCanvas)."
+
+ ^ #(
+ #(#doubleClickChannel #action )
+ #forceGeneratorTrigger
+ #hideUnloadedClasses
+ #immediateUpdate
+ #inGeneratorHolder
+ #menuHolder
+ #nameSpaceFilter
+ #organizerMode
+ #outGeneratorHolder
+ #packageFilter
+ #selectedCategories
+ #selectionChangeCondition
+ #slaveMode
+ #updateTrigger
+ #showCoverageInformation
+ ).
+
+ "Modified: / 20-07-2011 / 14:29:08 / cg"
+! !
+
+!ClassCategoryList class methodsFor:'special'!
+
+addAdditionalCategory:aCategory
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ AdditionalEmptyCategories isNil ifTrue:[
+ AdditionalEmptyCategories := Set new.
+ ].
+ AdditionalEmptyCategories add:aCategory.
+ Smalltalk changed:#organization with:(nil -> aCategory). "/ not really ... to force update
+!
+
+removeAdditionalCategories:aListOfCategories
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ AdditionalEmptyCategories isNil ifTrue:[^ self].
+ aListOfCategories do:[:eachCategory |
+ AdditionalEmptyCategories remove:eachCategory ifAbsent:nil.
+ ].
+
+ Smalltalk changed:#organization "/ not really ... to force update
+!
+
+removeAllAdditionalCategories
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ AdditionalEmptyCategories := nil
+!
+
+renameAdditionalCategories:oldNames to:newName
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ self removeAdditionalCategories:oldNames.
+ self addAdditionalCategory:newName.
+! !
+
+!ClassCategoryList methodsFor:'aspects'!
+
+categoryList
+ categoryList isNil ifTrue:[
+ categoryList := ValueHolder new.
+ ].
+ ^ categoryList
+
+ "Created: / 25.2.2000 / 02:23:08 / cg"
+!
+
+categoryList:aValueHolder
+ categoryList notNil ifTrue:[
+ categoryList removeDependent:self
+ ].
+ categoryList := aValueHolder.
+ categoryList notNil ifTrue:[
+ categoryList addDependent:self
+ ].
+
+ "Created: / 18.8.2000 / 15:21:42 / cg"
+!
+
+classCategoryLabelHolder
+ ^ self pseudoListLabelHolder
+!
+
+selectedCategories
+ ^ self selectionHolder
+!
+
+selectedCategories:aValueHolder
+ ^ self selectionHolder:aValueHolder
+! !
+
+!ClassCategoryList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+ |selectedCategories allSelectedBefore
+ nameListEntryForALL categoryOfClass wg|
+
+ selectedCategories := self selectedCategoriesStrings.
+
+ changedObject == Smalltalk ifTrue:[
+ ((something == #classVariables)
+ or:[something == #classDefinition]) ifTrue:[
+ listValid == true ifTrue:[
+ categoryOfClass := aParameter category.
+ (categoryList value includes:categoryOfClass) ifFalse:[
+ self invalidateList.
+ ].
+ slaveMode value ~~ true ifTrue:[
+ (selectedCategories includes:categoryOfClass) ifTrue:[
+ "/ a selected class has changed
+ "/ in order to give others a chance to update their list before,
+ "/ this one is always enqueued for delayed update (even if immediateUpdate is true)
+ "/ self enqueueDelayedUpdateOutputGenerator
+ self enqueueMessage:#updateOutputGenerator for:self arguments:#()
+ ].
+ ].
+ ].
+ ^ self
+ ].
+ something == #newClass ifTrue:[
+ categoryOfClass := aParameter category.
+ listValid == false ifTrue:[
+ ^ self
+ ].
+
+ (categoryList value includes:categoryOfClass) ifFalse:[
+ self invalidateList.
+ ].
+
+ slaveMode value ~~ true ifTrue:[
+ (selectedCategories includes:categoryOfClass) ifTrue:[
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ].
+ ^ self
+ ].
+
+ self invalidateList.
+
+ (something == #classRemove
+ or:[something == #projectOrganization
+ or:[something == #organization]]) ifTrue:[
+ slaveMode value ~~ true ifTrue:[
+ "/ sorry: cannot filter on category (already changed to #removed)
+ self enqueueDelayedUpdateOutputGenerator
+ ].
+ ].
+ ^ self
+ ].
+
+ changedObject == ChangeSet ifTrue:[
+ "/ remove all other change notifications from the eventQueue
+ wg := self windowGroup.
+ wg isNil ifTrue:[
+ "/ oops - should no longer be dependent...
+ changedObject removeDependent:self.
+ ] ifFalse:[
+ wg sensor
+ flushEventsFor:self
+ where:[:ev | ev isMessageSendEvent
+ and:[ev selector == #delayedUpdate:with:from:
+ and:[(ev arguments at:3) == ChangeSet]]].
+ ].
+
+ something == #addChange: ifTrue:[
+ "/ only need to invalidate, if that change changes my emphasis
+ "/ (i.e. if its a new methodChange)
+ self window topView shown ifFalse:[
+ self invalidateList.
+ ^ self
+ ].
+
+"/ self invalidateList.
+
+ aParameter isMethodChange ifTrue:[
+ aParameter changeClass notNil ifTrue:[
+ (ChangeSet current
+ count:[:chg | chg notNil and:[chg isMethodChange
+ and:[ chg className = aParameter className ]]])
+ == 1 ifTrue:[
+ "/ that methodChange is the first for this method.
+ self colorizeCategoryAsChanged:(aParameter changeClass category).
+ ]
+ ]
+ ].
+ ^ self
+ ].
+
+ self invalidateList.
+ ^ self
+ ].
+
+ changedObject == nameSpaceFilter ifTrue:[
+ "/ all might be more or less than before ...
+ allSelected := false.
+ ].
+ changedObject == packageFilter ifTrue:[
+ "/ all might be more or less than before ...
+ allSelected := false.
+ ].
+
+ changedObject == self selectedCategories ifTrue:[
+ categoryList isNil ifTrue:[
+ "/ oops - hurry up
+ self invalidateList.
+ ].
+
+ nameListEntryForALL := self class nameListEntryForALL.
+
+ selectedCategories size > 1 ifTrue:[
+ (selectedCategories includes:nameListEntryForALL) ifTrue:[
+ self makeSelectionOtherThanAllVisible.
+ ]
+ ].
+
+ "/ if all selected before AND allSelected after, no need to update the output generator
+ allSelectedBefore := allSelected ? false.
+ allSelected := selectedCategories includes:nameListEntryForALL.
+ (allSelectedBefore and:[allSelected]) ifTrue:[
+ ^ self
+ ].
+ ].
+
+ super delayedUpdate:something with:aParameter from:changedObject
+
+ "Created: / 5.2.2000 / 13:42:12 / cg"
+ "Modified: / 12.11.2001 / 19:36:16 / cg"
+!
+
+forceUpdateList
+ self categoryList setValue:#().
+ self updateList.
+ self categoryList changed.
+!
+
+selectionChangedByClick
+ "we are not interested in that - get another notification
+ via the changed valueHolder"
+
+ "Created: / 11.2.2000 / 11:39:48 / cg"
+!
+
+update:something with:aParameter from:changedObject
+ |categoryOfClass|
+
+ changedObject == Smalltalk ifTrue:[
+ (something == #methodInClass
+ or:[ something == #classComment
+ or:[ something == #methodDictionary
+ or:[ something == #methodTrap
+ or:[ something == #methodCoverageInfo
+ or:[ something == #methodInClassRemoved ]]]]]) ifTrue:[
+ ^ self
+ ].
+
+ (something == #classVariables
+ or:[something == #classDefinition]) ifTrue:[
+ categoryOfClass := aParameter category.
+ (self selectedCategoriesStrings includes:categoryOfClass) ifTrue:[
+"/ self halt.
+ self updateOutputGenerator.
+ ].
+ ].
+ ].
+
+"/ changedObject == ChangeSet ifTrue:[
+"/ something == #addChange: ifTrue:[
+"/ ^ self
+"/ ]
+"/ ].
+
+ super update:something with:aParameter from:changedObject
+
+ "Modified: / 20-07-2011 / 18:50:04 / cg"
+! !
+
+!ClassCategoryList methodsFor:'drag & drop'!
+
+canDropContext:aDropContext
+ |cat objects droppedClasses|
+
+ objects := aDropContext dropObjects collect:[:obj | obj theObject].
+ (self objectsAreClassFiles:objects) ifTrue:[^ true].
+
+ (objects conform:[:aClass | aClass isClass]) ifFalse:[^ false].
+ droppedClasses := objects.
+ (droppedClasses contains:[:aClass | aClass isPrivate not]) ifFalse:[^ false].
+
+ cat := self categoryAtTargetPointOf:aDropContext.
+ cat isNil ifTrue:[ ^ false ].
+ cat = '* obsolete *' ifTrue:[ ^ false ].
+
+ (droppedClasses contains:[:aClass | aClass category ~= cat]) ifFalse:[^ false].
+ ^ true.
+
+ "Modified: / 17-10-2006 / 18:28:04 / cg"
+!
+
+categoryAtTargetPointOf:aDropContext
+ |p categoryListView lineNr cat|
+
+ p := aDropContext targetPoint.
+
+ categoryListView := aDropContext targetWidget.
+
+ lineNr := categoryListView lineAtY:p y.
+ lineNr isNil ifTrue:[^ nil].
+
+ cat := categoryList value at:lineNr.
+ cat := cat string.
+ cat = self class nameListEntryForALL ifTrue:[^ nil].
+ (cat endsWith:(self stringForExtensions)) ifTrue:[
+ cat := cat copyWithoutLast:(self stringForExtensions size)
+ ].
+ ^ cat
+!
+
+doDropContext:aDropContext
+ |cat objects|
+
+ objects := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
+ (objects conform:[:something | something isClass]) ifTrue:[
+ cat := self categoryAtTargetPointOf:aDropContext.
+ cat notNil ifTrue:[
+ self masterApplication moveClasses:objects toCategory:cat.
+ ].
+ ^ self
+ ].
+ (objects conform:[:something | something isFilename]) ifTrue:[
+ self dropClassFiles:objects.
+ ^ self
+ ].
+
+ "Modified: / 17-10-2006 / 18:29:25 / cg"
+! !
+
+!ClassCategoryList methodsFor:'generators'!
+
+makeGenerator
+ "return a generator which enumerates the classes from the selected category."
+
+ |cats hideUnloadedClasses allName nameSpaceFilter packageFilter
+ showChangedClasses showUnloaded showUndocumented inclusionTest changedClasses|
+
+ cats := self selectedCategoriesStrings.
+ cats size == 0 ifTrue:[
+ ^ #()
+ ].
+
+ allName := self class nameListEntryForALL.
+
+ (cats includes:allName) ifTrue:[
+ inGeneratorHolder value isOrderedCollection ifTrue:[
+ cats := categoryList value copyWithout:allName.
+ ]
+ ].
+
+ showChangedClasses := cats includes:(self class nameListEntryForChanged).
+ showUnloaded := cats includes:(self class nameListEntryForUnloaded).
+ showUndocumented := cats includes:(self class nameListEntryForUndocumented).
+
+ hideUnloadedClasses := self hideUnloadedClasses value ? false.
+ nameSpaceFilter := self nameSpaceFilter value.
+ nameSpaceFilter notNil ifTrue:[
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ ].
+ packageFilter := self packageFilter value.
+ packageFilter notNil ifTrue:[
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ ].
+
+ (cats includes:allName) ifTrue:[
+ hideUnloadedClasses ifTrue:[
+ inclusionTest := [:cls | cls isLoaded].
+ ] ifFalse:[
+ inclusionTest := [:cls | true].
+ ].
+ ] ifFalse:[
+ inclusionTest :=
+ [:cls |
+ |cat isLoaded included|
+
+ isLoaded := cls isLoaded.
+ included := isLoaded not and:[ showUnloaded ].
+ included ifFalse:[
+ (hideUnloadedClasses not or:[isLoaded]) ifTrue:[
+ cat := cls category ? '* no category *'.
+ included := cats includes:cat.
+ included ifFalse:[
+ included := showChangedClasses
+ and:[ (changedClasses includes:cls theNonMetaclass)
+ or:[(changedClasses includes:cls theMetaclass)] ].
+ included ifFalse:[
+ included := showUndocumented and:[ isLoaded and:[ (cls theMetaclass includesSelector:#documentation) not ]].
+ ].
+ ].
+ ].
+ ].
+ included
+ ].
+ ].
+
+ ^ Iterator on:[:whatToDo |
+ showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].
+
+ Smalltalk allClassesDo:[:cls |
+ (cls isRealNameSpace) ifFalse:[
+ (inclusionTest value:cls) ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ whatToDo value:cls
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+
+ "Created: / 05-02-2000 / 13:42:12 / cg"
+ "Modified: / 10-11-2006 / 17:13:26 / cg"
+! !
+
+!ClassCategoryList methodsFor:'private'!
+
+colorizeCategoryAsChanged:category
+ |colorizedCategoryItem categoryList idx|
+
+ colorizedCategoryItem := self colorizeForChangedCode:category copy asText.
+
+ categoryList := self categoryList value.
+ idx := categoryList indexOf:category.
+ idx ~~ 0 ifTrue:[
+ ((categoryList at:idx) sameStringAndEmphasisAs:colorizedCategoryItem) ifFalse:[
+ categoryList at:idx put:colorizedCategoryItem.
+ self categoryList changed.
+ ]
+ ].
+!
+
+listOfCategories
+ |categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
+ categoriesWithExtensions categoriesWithChangedCode categoriesWithRemoteChangedCode
+ classesInChangeSet classesInRemoteChangeSet
+ numClassesInChangeSet numClasses numUnloaded numUndocumented pseudoEntryColor|
+
+ allName := self class nameListEntryForALL.
+
+ hideUnloadedClasses := self hideUnloadedClasses value.
+ nameSpaceFilter := self nameSpaceFilter value.
+ nameSpaceFilter notNil ifTrue:[
+ (nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
+ ].
+ packageFilter := self packageFilter value.
+ packageFilter notNil ifTrue:[
+ (packageFilter includes:allName) ifTrue:[packageFilter := nil].
+ ].
+
+ numClasses := numUndocumented := numUnloaded := numClassesInChangeSet := 0.
+
+ categories := Set new.
+ categoriesWithExtensions := Set new.
+ categoriesWithChangedCode := Set new.
+ categoriesWithRemoteChangedCode := Set new.
+
+ classesInChangeSet := ChangeSet current changedClasses.
+ classesInChangeSet := classesInChangeSet collect:[:eachClass | eachClass theNonMetaclass].
+
+ classesInRemoteChangeSet := SmallTeam isNil ifTrue:[#()] ifFalse:[ SmallTeam changedClasses ].
+ classesInRemoteChangeSet := classesInRemoteChangeSet collect:[:each | each theNonMetaclass].
+
+ classes := IdentitySet new.
+ inGeneratorHolder isNil ifTrue:[
+ Smalltalk allClassesDo:[:cls |
+ |cat isLoaded|
+
+ (cls isRealNameSpace) ifFalse:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+
+ isLoaded := cls isLoaded.
+ isLoaded ifTrue:[
+ numUnloaded := numUnloaded + 1.
+ (cls theMetaclass includesSelector:#documentation) ifFalse:[
+ numUndocumented := numUndocumented + 1.
+ ].
+ ].
+
+ (hideUnloadedClasses not or:[isLoaded])
+ ifTrue:[
+ numClasses := numClasses + 1.
+
+ cat := cls category ? '* no category *'.
+ cat isString ifFalse:[self halt:'oops - strange category'].
+ categories add:cat.
+ classes add:cls.
+
+ (classesInChangeSet includes:cls theNonMetaclass) ifTrue:[
+ categoriesWithChangedCode add:cat
+ ].
+ (classesInRemoteChangeSet includes:cls theNonMetaclass) ifTrue:[
+ categoriesWithRemoteChangedCode add:cat
+ ].
+ cls hasExtensions ifTrue:[
+ categoriesWithExtensions add:cat
+ ].
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyCategories size > 0 ifTrue:[
+ "/ remove those that are present ...
+ AdditionalEmptyCategories := AdditionalEmptyCategories select:[:cat | (categories includes:cat) not].
+ categories addAll:AdditionalEmptyCategories.
+ ].
+ ] ifFalse:[
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ generator do:[:cat | categories add:cat string].
+ ].
+
+ categories := categories asOrderedCollection.
+
+ categories sort.
+ categories :=
+ categories collect:[:cat |
+ (categoriesWithChangedCode includes:cat) ifTrue:[
+ (self colorizeForChangedCode:cat copy asText).
+ ] ifFalse:[
+ (categoriesWithExtensions includes:cat) ifTrue:[
+ (self colorizeForDifferentPackage:cat copy asText)
+ "/ cannot add a + here - need separate list for presentation and filter
+ "/ cat , (self colorizeForDifferentPackage:self stringForExtensions)
+ ] ifFalse:[
+ (categoriesWithRemoteChangedCode includes:cat) ifTrue:[
+ (self colorizeForChangedCodeInSmallTeam:cat copy asText).
+ ] ifFalse:[
+ cat
+ ]
+ ]
+ ]
+ ].
+
+ pseudoEntryColor := self class pseudoEntryForegroundColor.
+
+ numUnloaded > 0 ifTrue:[
+ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+ categories addFirst:((self class nameListEntryForUnloaded "bindWith:numClassesInChangeSet") allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+ numUndocumented > 0 ifTrue:[
+ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+ categories addFirst:((self class nameListEntryForUndocumented "bindWith:numClassesInChangeSet") allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+ numClassesInChangeSet := ChangeSet current changedClasses size.
+ numClassesInChangeSet > 0 ifTrue:[
+ "/ dont include count - makeGenerator compares against the un-expanded nameListEntry (sigh - need two lists)
+ categories addFirst:((self class nameListEntryForChanged "bindWith:numClassesInChangeSet") allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+
+ categories size > 0 ifTrue:[
+ categories size == 1 ifTrue:[
+ self classCategoryLabelHolder value:(categories first)
+ ].
+ categories addFirst:((self class nameListEntryForALL "WithCount bindWith:numClasses") allItalic colorizeAllWith:pseudoEntryColor).
+ ].
+
+ ^ categories
+
+ "Created: / 05-02-2000 / 13:42:12 / cg"
+ "Modified: / 10-11-2006 / 17:43:19 / cg"
+!
+
+listView
+ ^ self componentAt:#List
+!
+
+makeDependent
+ Smalltalk addDependent:self.
+ ChangeSet addDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+!
+
+makeIndependent
+ Smalltalk removeDependent:self.
+ ChangeSet removeDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+!
+
+makeItemVisible:item
+ |idx listView|
+
+ idx := categoryList value indexOf:item.
+ idx ~~ 0 ifTrue:[
+ (listView := self listView) notNil ifTrue:[
+ listView makeLineVisible:idx.
+ ]
+ ]
+!
+
+makeSelectionOtherThanAllVisible
+ |selectedCategories item|
+
+ selectedCategories := self selectedCategoriesStrings.
+ "/ the first item after the *all* item
+ item := (selectedCategories copy remove:self class nameListEntryForALL; yourself) first.
+ self makeItemVisible:item.
+!
+
+release
+ super release.
+
+ categoryList removeDependent:self.
+!
+
+selectedCategoriesStrings
+ |selectedCategoriesHolder selectedCategories stringForExtensions|
+
+ stringForExtensions := self stringForExtensions.
+
+ selectedCategoriesHolder := self selectedCategories.
+ selectedCategories := selectedCategoriesHolder value ? #().
+
+ selectedCategories := selectedCategories
+ collect:[:each |
+ |s|
+ s := each string.
+ (s endsWith:stringForExtensions) ifTrue:[
+ s := s copyWithoutLast:(stringForExtensions size).
+ ].
+ s
+ ].
+ ^ selectedCategories
+
+ "Modified: / 23-08-2006 / 11:38:26 / cg"
+!
+
+stringForExtensions
+ ^ ' [ + ]'
+!
+
+updateList
+ |oldList newList oldSelection newSelection prevClasses
+ selectedCategoriesHolder|
+
+ selectedCategoriesHolder := self selectedCategories.
+ oldSelection := selectedCategoriesHolder value ? #().
+ prevClasses := classes copy.
+
+ newList := self listOfCategories.
+ oldList := (self categoryList value) ? #().
+ (newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
+ ifFalse:[
+ "/ a real change, or only emphasis ?
+ (newList sameContentsAs:oldList whenComparedWith:[:a :b | a asString string = b asString string]) ifTrue:[
+ "/ a real change
+ oldSelection size > 0 ifTrue:[
+ selectedCategoriesHolder removeDependent:self.
+ selectedCategoriesHolder value:#().
+ selectedCategoriesHolder addDependent:self.
+ ].
+ categoryList value:newList.
+
+ oldSelection size > 0 ifTrue:[
+ newSelection := oldSelection select:[:cat | newList includes:cat].
+ selectedCategoriesHolder value:newSelection.
+ ]
+ ] ifFalse:[
+ "/ only emphasis
+ categoryList value:newList.
+
+ "/ in case the same categories are present, but classes have changed ...
+ (prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
+ self updateOutputGenerator.
+ ]
+ ]
+ ] ifTrue:[
+ "/ in case the same categories are present, but classes have changed ...
+ (prevClasses isNil or:[(classes identicalContentsAs:prevClasses) not]) ifTrue:[
+ self updateOutputGenerator.
+ ]
+ ].
+ listValid := true.
+
+ "Created: / 05-02-2000 / 13:42:13 / cg"
+ "Modified: / 17-08-2011 / 09:52:13 / cg"
+! !
+
+!ClassCategoryList methodsFor:'setup'!
+
+commonPostBuild
+ |listView|
+
+ listView := self listView.
+ listView notNil ifTrue:[
+ listView scrollWhenUpdating:nil
+ ].
+ super commonPostBuild
+! !
+
+!ClassCategoryList methodsFor:'special'!
+
+addAdditionalCategory:aCategory
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ self class addAdditionalCategory:aCategory
+!
+
+removeAdditionalCategories:aListOfCategories
+ self class removeAdditionalCategories:aListOfCategories
+!
+
+removeAllAdditionalCategories
+ self class removeAllAdditionalCategories
+!
+
+renameAdditionalCategories:oldNames to:newName
+ "/ those are simulated - in ST/X, empty categories do not
+ "/ really exist; however, during browsing, it makes sense.
+
+ self class renameAdditionalCategories:oldNames to:newName
+! !
+
+!ClassCategoryList class methodsFor:'documentation'!
+
+version
+ ^ '$Id: Tools__ClassCategoryList.st 7816 2011-08-18 08:03:34Z vranyj1 $'
+!
+
+version_CVS
+ ^ '§Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.32 2011/08/18 00:20:52 cg Exp §'
+! !
\ No newline at end of file