"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

BrowserList subclass:#ClassCategoryList

	instanceVariableNames:'categoryList classes allSelected'

	classVariableNames:'AdditionalEmptyCategories'

	poolDictionaries:''

	category:'Interface-Browsers-New'

!

!ClassCategoryList class methodsFor:'documentation'!

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: #canDrop:

		#dropSelector: #doDrop:

	      )

	    )

	   )

	)

      )

    "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

    |selectedCategoriesHolder 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 == true ifTrue:[

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

	    aParameter isMethodChange 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.

		    aParameter changeClass ifNotNil:[

			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.    

    ].

    selectedCategoriesHolder := self selectedCategories.

    changedObject == selectedCategoriesHolder 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 == #methodDictionary ifTrue:[

	    ^ self 

	].

	something == #classComment ifTrue:[

	    ^ self.

	].

	(something == #classVariables

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

	    categoryOfClass := aParameter category.

	    ((self selectedCategories value ? #()) includes:categoryOfClass) ifTrue:[

"/ self halt.

		self updateOutputGenerator.                

	    ].

	].

	something == #methodTrap ifTrue:[

	    ^ self

	].

	something == #methodInClass 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'!

canDrop:aDropContext

    |cat classes|

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

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

    (classes contains:[:aClass | aClass isPrivate not]) ifFalse:[^ false].

    cat := self categoryAtTargetPointOf:aDropContext.

    cat isNil ifTrue:[

	^ false

    ].

    cat = '* obsolete *' ifTrue:[

	^  false

    ].

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

!

doDrop:aDropContext

    |cat classes|

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

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

    cat := self categoryAtTargetPointOf:aDropContext.

    cat notNil ifTrue:[

	self masterApplication moveClasses:classes toCategory:cat.

    ].

! !

!ClassCategoryList methodsFor:'generators'!

makeGenerator

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

    |cats hideUnloadedClasses allName nameSpaceFilter packageFilter|

    cats := self selectedCategories value.

    cats size == 0 ifTrue:[

        ^ #()

    ].

    cats := cats collect:[:each | each string].

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

                                        (packageFilter isNil

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

                                            whatToDo value:cls

                                        ]

                                    ]

                               ]

                           ]

                      ]