"

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

    ^ #(

        #(doubleClickChannel action)

        #forceGeneratorTrigger

        #hideUnloadedClasses

        #immediateUpdate

        #inGeneratorHolder

        #menuHolder

        #nameSpaceFilter

        #organizerMode

        #outGeneratorHolder

        #packageFilter

        #selectedCategories

        #selectionChangeCondition

        #showCoverageInformation

        #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

!

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 categoryOfClass wg|

    selectedCategories := self selectedCategoriesStrings.

    changedObject == Smalltalk 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

        ].

        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 halt.

    ].

    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 := rawCategoryList 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.

        ].