"

 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'

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

    ^ #(

	#(#doubleClickChannel #action )

	#forceGeneratorTrigger

	#hideUnloadedClasses

	#immediateUpdate

	#inGeneratorHolder

	#menuHolder

	#nameSpaceFilter

	#organizerMode

	#outGeneratorHolder

	#packageFilter

	#selectedCategories

	#selectionChangeCondition

	#slaveMode

	#updateTrigger

      ).

! !

!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

     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.    

    ].

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

    droppedClasses := aDropContext dropObjects collect:[:obj | obj theObject].

    (droppedClasses contains:[:aClass | aClass isClass not]) ifTrue:[^ false].

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

!

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

!

doDropContext:aDropContext

    |cat droppedClasses|

    droppedClasses := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].

    (droppedClasses contains:[:something | something isClass not]) ifTrue:[^ self].

    cat := self categoryAtTargetPointOf:aDropContext.

    cat notNil ifTrue:[

        self masterApplication moveClasses:droppedClasses toCategory:cat.

    ].

! !

!ClassCategoryList methodsFor:'generators'!

makeGenerator

    "return a generator which enumerates the classes from the selected category."

    |cats hideUnloadedClasses allName nameSpaceFilter packageFilter|

    cats size == 0 ifTrue:[

        ^ #()

    ].

    allName := self class nameListEntryForALL.

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

            ^ Iterator on:[:whatToDo |

                               Smalltalk allClassesDo:[:cls |

                                   cls isLoaded ifTrue:[

                                       (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[

                                           (nameSpaceFilter isNil

                                           or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[

                                               (packageFilter isNil

                                               or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[

                                                   whatToDo value:cls

                                               ]

                                           ]

                                       ]

                                   ]

                               ]

                          ]

        ].

        ^ Iterator on:[:whatToDo | 

                           Smalltalk allClassesDo:[:cls |

                               (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[

                                    (nameSpaceFilter isNil

                                    or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[