Tools_ClassCategoryList.st
author Stefan Vogel <sv@exept.de>
Fri, 17 May 2019 17:11:44 +0200
changeset 18767 0478d93cdb75
parent 14026 4c197be9097f
child 15566 184cea584be5
permissions -rw-r--r--
#REFACTORING by stefan Sanitize BlockValues class: Tools::Inspector2 changed: #toolbarBackgroundHolder

"
 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
		rawCategoryList cookedCategoryList categoryListView'
	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:Tools::ClassCategoryList andSelector:#windowSpec
     Tools::ClassCategoryList new openInterface:#windowSpec
     Tools::ClassCategoryList open
    "

    <resource: #canvas>

    ^ 
     #(FullSpec
        name: windowSpec
        window: 
       (WindowSpec
          label: 'ClassCategoryList'
          name: 'ClassCategoryList'
          min: (Point 0 0)
          bounds: (Rectangle 0 0 300 300)
        )
        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
                canDropSelector: canDropContext:
                dragArgument: nil
                dropArgument: nil
                dropSelector: doDropContext:
              )
              postBuildCallback: postBuildCategoryListView:
            )
           )
         
        )
      )
! !

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

    ^ #(
        environmentHolder
        #(doubleClickChannel action)
        #forceGeneratorTrigger
        #hideUnloadedClasses
        #immediateUpdate
        #inGeneratorHolder
        #menuHolder
        #nameSpaceFilter
        #organizerMode
        #outGeneratorHolder
        #packageFilter
        #selectedCategories
        #selectionChangeCondition
        #showCoverageInformation
        #slaveMode
        #updateTrigger
      ).

    "Modified: / 24-02-2014 / 10:37:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!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
!

selectionHolder
"/    self halt.
    ^ super selectionHolder
!

selectionHolder:aValueHolder
    "/ self halt.
    super selectionHolder:aValueHolder
! !

!ClassCategoryList methodsFor:'change & update'!

delayedUpdate:something with:aParameter from:changedObject
    |selectedCategories allSelectedBefore 
     nameListEntryForALL cls categoryOfClass wg|

    selectedCategories := self selectedCategoriesStrings.

    changedObject == environment ifTrue:[
        ((something == #classVariables) 
        or:[something == #classDefinition]) ifTrue:[
            listValid == true ifTrue:[
                categoryOfClass := aParameter category.
                (rawCategoryList 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
            ].

            (rawCategoryList includes:categoryOfClass) ifFalse:[
                self invalidateList.                
            ].

            slaveMode value ~~ true ifTrue:[
                (selectedCategories includes:categoryOfClass) ifTrue:[
                    self enqueueDelayedUpdateOutputGenerator
                ].
            ].
            ^ self
        ].
        something == #projectOrganization ifTrue:[
            listValid == false ifTrue:[
                ^ self
            ].
            aParameter isNil ifTrue:[
                self invalidateList.                
                slaveMode value ~~ true ifTrue:[
                    selectedCategories notEmptyOrNil ifTrue:[
                        self enqueueDelayedUpdateOutputGenerator
                    ].
                ]
            ] ifFalse:[
                cls := aParameter first.
                categoryOfClass := cls category.

                (rawCategoryList 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.
        "/ self invalidateList - done in super
    ].
    changedObject == packageFilter ifTrue:[
        "/ all might be more or less than before ...
        allSelected := false.
        "/ self invalidateList - done in super
    ].

    changedObject == self selectedCategories ifTrue:[
        listValid ifFalse:[
            "/ 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
        ].
    ].
    changedObject == categoryList ifTrue:[
        self breakPoint:#cg.
    ].
    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 == environment 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 
      or:[ (cat = '* obsolete *')
      or:[ (cat = #'* as yet unknown category *')
      or:[ self class isPseudoCategory:cat ]]])
        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 := rawCategoryList at:lineNr.
    cat := cat string.
    cat = self class nameListEntryForALL ifTrue:[^ nil].

    (cat endsWith:(self stringForExtensions)) ifTrue:[
        cat := cat copyButLast:(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 isNil 
          or:[ (cat = '* obsolete *')
          or:[ self class isPseudoCategory:cat ]])
        ifFalse:[
            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 showExtendedClasses inclusionTest changedClasses|

    cats := self selectedCategoriesStrings.
    cats size == 0 ifTrue:[
        ^ #()
    ].

    allName := self class nameListEntryForALL.

    (cats includes:allName) ifTrue:[
        inGeneratorHolder value isOrderedCollection ifTrue:[
            cats := rawCategoryList copyWithout:allName.
        ]
    ].

    showChangedClasses := cats includes:(self class nameListEntryForChanged).
    showUnloaded := cats includes:(self class nameListEntryForUnloaded).
    showUndocumented := cats includes:(self class nameListEntryForUndocumented).
    showExtendedClasses := cats includes:(self class nameListEntryForExtendedClasses).

    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 isPrivate not    
                                            and:[ (cls theMetaclass includesSelector:#documentation) not ]]].
                                included ifFalse:[
                                    included := showExtendedClasses
                                                and:[ cls hasExtensions ].
                                ].
                            ].
                        ].
                    ].
                ].
                included
            ].
    ].

    ^ Iterator on:[:whatToDo |
            showChangedClasses ifTrue:[ changedClasses := ChangeSet current changedClasses ].

            environment 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 categoriesBag hideUnloadedClasses generator nameSpaceFilter packageFilter allName
     categoriesWithExtensions categoriesWithChangedCode categoriesWithRemoteChangedCode
     classesInChangeSet classesInRemoteChangeSet classesWithExtensions
     numClassesInChangeSet numClasses numUnloaded numUndocumented numExtendedClasses 
     pseudoEntryColor showCounts|

    showCounts := true.

    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 := numExtendedClasses := 0.

    categories := Set new.
    categoriesBag := Bag 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].

    classesWithExtensions := IdentitySet new.

    classes := IdentitySet new.
    inGeneratorHolder isNil ifTrue:[
        environment 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 isPrivate ifFalse:[  
                                (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.
                            categoriesBag add:cat.

                            (classesInChangeSet includes:cls theNonMetaclass) ifTrue:[
                                categoriesWithChangedCode add:cat
                            ].
                            (classesInRemoteChangeSet includes:cls theNonMetaclass) ifTrue:[
                                categoriesWithRemoteChangedCode add:cat
                            ].
                            cls hasExtensions ifTrue:[
                                categoriesWithExtensions add:cat.
                                classesWithExtensions add:cls.
                                numExtendedClasses := numExtendedClasses + 1.
                            ].
                        ]
                    ]
                ]
            ]
        ].

        "/ 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 reject:[:cat | (categories includes:cat)].
            categories addAll:AdditionalEmptyCategories.
            categoriesBag addAll:AdditionalEmptyCategories withOccurrences:0.
        ].
    ] ifFalse:[
        |setOfCategories|

        generator := inGeneratorHolder value.
        generator isNil ifTrue:[^ #() ].
        setOfCategories := Set withAll:generator.
        generator do:[:cat | categories add:cat string].
        
        environment allClassesDo:[:each |
            |cat|

            each isNameSpace ifFalse:[
                cat := each category string asSymbol.
                (setOfCategories includes:cat) ifTrue:[
                    categoriesBag add:cat.
                ].
            ]
        ].
    ].

    pseudoEntryColor := self class pseudoEntryForegroundColor.

    categories := categories asOrderedCollection.

    categories sort.
    rawCategoryList := categories.

    categories := 
        categories collect:[:cat |
            |item isInChangeSet|

            isInChangeSet := categoriesWithChangedCode includes:cat.
            isInChangeSet ifTrue:[
                 item := self colorizeForChangedCode:cat copy asText
            ] ifFalse:[
                (categoriesWithExtensions includes:cat) ifTrue:[
                     item := 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:[
                         item := self colorizeForChangedCodeInSmallTeam:cat copy asText
                    ] ifFalse:[
                         item := cat
                    ]
                ]
            ].
            showCounts ifTrue:[
                item := item , ((' (%1)' bindWith:(categoriesBag occurrencesOf:cat)) 
                                    colorizeAllWith:pseudoEntryColor).
            ].
            isInChangeSet ifTrue:[
                item := item , self class markForBeingInChangeList
            ].

            item        
        ].

    numUndocumented > 0 ifTrue:[
        rawCategoryList add:self class nameListEntryForUndocumented.
        categories add:((self class nameListEntryForUndocumentedWithCount bindWith:numUndocumented) allItalic colorizeAllWith:pseudoEntryColor).
    ].
    numUnloaded > 0 ifTrue:[
        rawCategoryList add:self class nameListEntryForUnloaded.
        categories add:((self class nameListEntryForUnloadedWithCount bindWith:numUnloaded) allItalic colorizeAllWith:pseudoEntryColor).
    ].
    numExtendedClasses > 0 ifTrue:[
        rawCategoryList add:self class nameListEntryForExtendedClasses.
        categories add:((self class nameListEntryForExtendedClassesWithCount bindWith:numExtendedClasses) allItalic colorizeAllWith:pseudoEntryColor).
    ].
    numClassesInChangeSet := (ChangeSet current changedClasses collect:[:c | c theNonMetaclass] as:Set) size.
    numClassesInChangeSet > 0 ifTrue:[
        rawCategoryList addFirst:self class nameListEntryForChanged.
        categories addFirst:((self class nameListEntryForChangedWithCount bindWith:numClassesInChangeSet) allItalic colorizeAllWith:pseudoEntryColor).
    ].

    categories size > 0 ifTrue:[
        categories size == 1 ifTrue:[
            self classCategoryLabelHolder value:(categories first)
        ].
        rawCategoryList addFirst:self class nameListEntryForALL.
        categories addFirst:((self class nameListEntryForALLWithCount bindWith:numClasses) allItalic colorizeAllWith:pseudoEntryColor).
    ].

    cookedCategoryList := categories.
    ^ rawCategoryList.

    "Created: / 05-02-2000 / 13:42:12 / cg"
    "Modified: / 27-10-2012 / 12:34:19 / cg"
!

listView 
    ^ self componentAt:#List
!

makeDependent
    environment addDependent:self.
    ChangeSet addDependent:self.

    "Created: / 5.2.2000 / 13:42:13 / cg"
!

makeIndependent
    environment 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
    |selectedCategories stringForExtensions|

    stringForExtensions := self stringForExtensions.

    selectedCategories := self selectedCategories 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.    "/ sigh - sideeffect of setting rawList
    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:[
            "/ only emphasis
            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:[
            "/ a real change

            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
!

postBuildCategoryListView:aView
    categoryListView := aView.
    categoryListView visualBlock:[:view :lineNr | cookedCategoryList at:lineNr].
    categoryListView selectedVisualBlock:[:view :lineNr | (cookedCategoryList at:lineNr) string]
! !

!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.51 2014-02-25 10:41:34 vrany Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libtool/Tools_ClassCategoryList.st,v 1.51 2014-02-25 10:41:34 vrany Exp $'
! !