"

 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

	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)

          #max: #(#Point 1024 721)

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

    ^ #(

      ).

! !

!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 ifTrue:[

            ^ self

        ].

        something == #classComment ifTrue:[

            ^ self.

        ].

        something == #methodDictionary ifTrue:[

            ^ self 

        ].

        (something == #classVariables

        or:[something == #classDefinition]) ifTrue:[

            categoryOfClass := aParameter category.

            (self selectedCategoriesStrings includes:categoryOfClass) ifTrue:[

"/ self halt.

                self updateOutputGenerator.                

            ].

        ].

        something == #methodTrap ifTrue:[

            ^ self

        ].

        something == #methodInClassRemoved ifTrue:[

            ^ self

        ].

    ].

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