"
 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
      ).
! !

!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 == #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: / 5.11.2001 / 14:31:18 / 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:[
	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.
	]
    ] 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: / 5.2.2000 / 13:42:13 / cg"
    "Modified: / 18.8.2000 / 15:52:22 / 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
    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.29 2010-05-07 12:27:27 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.29 2010-05-07 12:27:27 cg Exp $'
! !