class doubleClick: ALT enforces display mode toggle.
ask if main-startable app should be started so.
--- a/NewSystemBrowser.st Fri Feb 15 14:06:02 2002 +0100
+++ b/NewSystemBrowser.st Fri Feb 15 14:13:57 2002 +0100
@@ -87,6 +87,13 @@
privateIn:NewSystemBrowser
!
+NewSystemBrowser::BrowserList subclass:#ClassCategoryList
+ instanceVariableNames:'categoryList classes allSelected'
+ classVariableNames:'AdditionalEmptyCategories'
+ poolDictionaries:''
+ privateIn:NewSystemBrowser
+!
+
NewSystemBrowser::ClassList subclass:#HierarchicalClassList
instanceVariableNames:'topClassHolder'
classVariableNames:'InheritedEntry'
@@ -172,9 +179,9 @@
privateIn:NewSystemBrowser
!
-NewSystemBrowser::BrowserList subclass:#ClassCategoryList
- instanceVariableNames:'categoryList classes allSelected'
- classVariableNames:'AdditionalEmptyCategories'
+NewSystemBrowser::ClassCategoryList subclass:#HierarchicalClassCategoryList
+ instanceVariableNames:'hierarchicalCategoryTree'
+ classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
@@ -30831,58 +30838,70 @@
if unloaded : load it
if visualStartable: start the applciation"
- |cls clsName organizerModeHolder organizerMode newMode|
+ |cls clsName organizerModeHolder organizerMode newMode doSwitchDisplayMode|
cls := self theSingleSelectedClass.
- cls notNil ifTrue:[
- (navigationState isVersionDiffBrowser
- or:[navigationState isCheckOutputBrowser]) ifTrue:[
- self spawnFullBrowserInClass:cls selector:nil in:#newBuffer.
- ^ self
- ].
-
- self withWaitCursorDo:[
- cls := cls theNonMetaclass.
- clsName := cls name.
-
- self window sensor shiftDown ifTrue:[
- self spawnClassReferencesBrowserFor:(Array with:cls) in:#newBuffer.
- ^ self.
- ].
-
- cls isVisualStartable ifTrue:[
+ cls isNil ifTrue:[^ self].
+
+ (navigationState isVersionDiffBrowser
+ or:[navigationState isCheckOutputBrowser]) ifTrue:[
+ self spawnFullBrowserInClass:cls selector:nil in:#newBuffer.
+ ^ self
+ ].
+
+ self withWaitCursorDo:[
+ cls := cls theNonMetaclass.
+ clsName := cls name.
+
+ self window sensor shiftDown ifTrue:[
+ self spawnClassReferencesBrowserFor:(Array with:cls) in:#newBuffer.
+ ^ self.
+ ].
+
+ doSwitchDisplayMode := true.
+ self window sensor metaDown ifFalse:[
+ (cls isVisualStartable) ifTrue:[
self busyLabel:'starting application %1' with:clsName.
cls open.
+ doSwitchDisplayMode := false.
] ifFalse:[
(cls isStartableWithMain) ifTrue:[
self busyLabel:'starting main of %1' with:clsName.
- cls main.
+ (self confirm:('Invoke %1''s main ?' bindWith:clsName)) ifTrue:[
+ cls main.
+ ].
+ doSwitchDisplayMode := false.
] ifFalse:[
cls isLoaded ifFalse:[
self busyLabel:'loading %1' with:clsName.
self classLoad.
+ doSwitchDisplayMode := false.
] ifTrue:[
(TestRunner notNil and:[cls isSubclassOf:TestCase]) ifTrue:[
- TestRunner openOnTestCase:cls
- ] ifFalse:[
- organizerModeHolder := navigationState organizerMode.
- organizerMode := organizerModeHolder value.
-
- "/ toggle view mode (between category and class hierarchy)
- organizerMode == #classHierarchy ifTrue:[
- newMode := #category
- ] ifFalse:[
- newMode := #classHierarchy
- ].
- organizerModeHolder value:newMode
- ]
- ]
- ]
- ].
- self normalLabel.
- ].
- ^ self
- ].
+ TestRunner openOnTestCase:cls.
+ doSwitchDisplayMode := false.
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ doSwitchDisplayMode ifTrue:[
+ organizerModeHolder := navigationState organizerMode.
+ organizerMode := organizerModeHolder value.
+
+ "/ toggle view mode (between category and class hierarchy)
+ organizerMode == #classHierarchy ifTrue:[
+ newMode := #category
+ ] ifFalse:[
+ newMode := #classHierarchy
+ ].
+ organizerModeHolder value:newMode
+ ].
+
+ self normalLabel.
+ ].
+ ^ self
"Modified: / 2.11.2001 / 09:38:39 / cg"
!
@@ -37249,6 +37268,666 @@
Smalltalk changed:#classOrganization with:aClass. "/ not really ... to force update
! !
+!NewSystemBrowser::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)
+"
+! !
+
+!NewSystemBrowser::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:NewSystemBrowser::ClassCategoryList andSelector:#singleCategoryWindowSpec
+ NewSystemBrowser::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:NewSystemBrowser::ClassCategoryList andSelector:#windowSpec
+ NewSystemBrowser::ClassCategoryList new openInterface:#windowSpec
+ NewSystemBrowser::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"
+! !
+
+!NewSystemBrowser::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
+ ).
+
+! !
+
+!NewSystemBrowser::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
+! !
+
+!NewSystemBrowser::ClassCategoryList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+ |selectedCategoriesHolder selectedCategories allSelectedBefore idx listView
+ nameListEntryForALL categoryOfClass|
+
+ selectedCategoriesHolder := self selectedCategories.
+ selectedCategories := selectedCategoriesHolder value ? #().
+ selectedCategories := selectedCategories collect:[:each | each string].
+
+ nameListEntryForALL := self class nameListEntryForALL.
+
+ 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 ChangeList
+ self windowGroup sensor
+ flushEventsFor:self
+ where:[:ev | ev isMessageSendEvent
+ and:[ev selector == #delayedUpdate:with:from:
+ and:[(ev arguments at:3) == ChangeSet]]].
+
+ 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 == selectedCategoriesHolder ifTrue:[
+ categoryList isNil ifTrue:[
+ "/ oops - hurry up
+ self invalidateList.
+ ].
+ selectedCategories size > 1 ifTrue:[
+ (selectedCategories includes:nameListEntryForALL) ifTrue:[
+ idx := categoryList value indexOf: (selectedCategories copy remove:nameListEntryForALL; yourself) first.
+ idx ~~ 0 ifTrue:[
+ (listView := self builder componentAt:#List) notNil ifTrue:[
+ listView makeLineVisible:idx.
+ ]
+ ]
+ ]
+ ].
+
+ "/ 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
+ changedObject == Smalltalk ifTrue:[
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #classVariables ifTrue:[
+ ^ self
+ ].
+ 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"
+! !
+
+!NewSystemBrowser::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 := self builder componentAt:'List'.
+ categoryListView isNil ifTrue:[^ nil].
+
+ lineNr := categoryListView lineAtY:p y.
+ lineNr isNil ifTrue:[^ nil].
+
+ cat := categoryList value at:lineNr.
+ 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.
+ ].
+! !
+
+!NewSystemBrowser::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
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ ^ Iterator on:[:whatToDo |
+ Smalltalk allClassesDo:[:cls |
+ (hideUnloadedClasses not or:[cls isLoaded])
+ ifTrue:[
+ (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
+ (cats includes:cls category) ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+
+ "Created: / 5.2.2000 / 13:42:12 / cg"
+ "Modified: / 18.8.2000 / 15:52:41 / cg"
+! !
+
+!NewSystemBrowser::ClassCategoryList methodsFor:'private'!
+
+listOfCategories
+ |categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
+ categoriesWithExtensions categoriesWithChangedCode classesInCangeSet|
+
+ 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].
+ ].
+
+ categories := Set new.
+ categoriesWithExtensions := Set new.
+ categoriesWithChangedCode := Set new.
+
+ classesInCangeSet := ChangeSet current changedClasses.
+
+ classes := IdentitySet new.
+ inGeneratorHolder isNil ifTrue:[
+ Smalltalk allClassesDo:[:cls |
+ |cat|
+
+ (hideUnloadedClasses not or:[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:[
+ cat := cls category.
+cat isString ifFalse:[self halt].
+ categories add:cat.
+ classes add:cls.
+
+ ((classesInCangeSet includes:cls theNonMetaclass)
+ or:[(classesInCangeSet includes:cls theMetaclass)]) ifTrue:[
+ categoriesWithChangedCode add:cat
+ ] ifFalse:[
+ cls hasExtensions ifTrue:[
+ categoriesWithExtensions add:cat
+ ]
+ ].
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ "/ 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 select:[:cat | (categories includes:cat) not].
+ categories addAll:AdditionalEmptyCategories.
+ ].
+ ] ifFalse:[
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ generator do:[:cat | categories add:cat].
+ ].
+
+ categories := categories asOrderedCollection.
+
+ categories sort.
+ categories := categories collect:[:cat |
+ (categoriesWithChangedCode includes:cat) ifTrue:[
+ (self colorizeForChangedCode:cat copy asText).
+ ] ifFalse:[
+ (categoriesWithExtensions includes:cat) ifTrue:[
+ (self colorizeForDifferentPackage:cat copy asText).
+ ] ifFalse:[
+ cat
+ ]
+ ]
+ ].
+ categories size == 1 ifTrue:[
+ self classCategoryLabelHolder value:(categories first)
+ ].
+ categories size == 0 ifFalse:[
+ categories addFirst:(self class nameListEntryForALL).
+ ].
+ ^ categories
+
+ "Created: / 5.2.2000 / 13:42:12 / cg"
+ "Modified: / 13.11.2001 / 11:32:36 / cg"
+!
+
+makeDependent
+ Smalltalk addDependent:self.
+ ChangeSet addDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+!
+
+makeIndependent
+ Smalltalk removeDependent:self.
+ ChangeSet removeDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+!
+
+updateList
+ |oldList newList oldSelection newSelection prevClasses
+ selectedCategoriesHolder|
+
+ selectedCategoriesHolder := self selectedCategories.
+ oldSelection := selectedCategoriesHolder value ? #().
+ prevClasses := classes copy.
+
+ newList := self listOfCategories.
+ oldList := (self categoryList value) ? #().
+ (newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
+ ifFalse:[
+ 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.
+ ]
+ ] 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: / 5.2.2000 / 13:42:13 / cg"
+ "Modified: / 18.8.2000 / 15:52:22 / cg"
+! !
+
+!NewSystemBrowser::ClassCategoryList methodsFor:'setup'!
+
+commonPostBuildWith:aBuilder
+ |list|
+
+ list := aBuilder componentAt:#List.
+ list notNil ifTrue:[
+ list scrollWhenUpdating:nil
+ ].
+ super commonPostBuildWith:aBuilder
+
+! !
+
+!NewSystemBrowser::ClassCategoryList 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 "/ 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
+! !
+
!NewSystemBrowser::HierarchicalClassList class methodsFor:'documentation'!
documentation
@@ -46883,666 +47562,6 @@
^ super resources
! !
-!NewSystemBrowser::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)
-"
-! !
-
-!NewSystemBrowser::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:NewSystemBrowser::ClassCategoryList andSelector:#singleCategoryWindowSpec
- NewSystemBrowser::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:NewSystemBrowser::ClassCategoryList andSelector:#windowSpec
- NewSystemBrowser::ClassCategoryList new openInterface:#windowSpec
- NewSystemBrowser::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"
-! !
-
-!NewSystemBrowser::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
- ).
-
-! !
-
-!NewSystemBrowser::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
-! !
-
-!NewSystemBrowser::ClassCategoryList methodsFor:'change & update'!
-
-delayedUpdate:something with:aParameter from:changedObject
- |selectedCategoriesHolder selectedCategories allSelectedBefore idx listView
- nameListEntryForALL categoryOfClass|
-
- selectedCategoriesHolder := self selectedCategories.
- selectedCategories := selectedCategoriesHolder value ? #().
- selectedCategories := selectedCategories collect:[:each | each string].
-
- nameListEntryForALL := self class nameListEntryForALL.
-
- 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 ChangeList
- self windowGroup sensor
- flushEventsFor:self
- where:[:ev | ev isMessageSendEvent
- and:[ev selector == #delayedUpdate:with:from:
- and:[(ev arguments at:3) == ChangeSet]]].
-
- 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 == selectedCategoriesHolder ifTrue:[
- categoryList isNil ifTrue:[
- "/ oops - hurry up
- self invalidateList.
- ].
- selectedCategories size > 1 ifTrue:[
- (selectedCategories includes:nameListEntryForALL) ifTrue:[
- idx := categoryList value indexOf: (selectedCategories copy remove:nameListEntryForALL; yourself) first.
- idx ~~ 0 ifTrue:[
- (listView := self builder componentAt:#List) notNil ifTrue:[
- listView makeLineVisible:idx.
- ]
- ]
- ]
- ].
-
- "/ 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
- changedObject == Smalltalk ifTrue:[
- something == #methodDictionary ifTrue:[
- ^ self
- ].
- something == #classComment ifTrue:[
- ^ self.
- ].
- something == #classVariables ifTrue:[
- ^ self
- ].
- 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"
-! !
-
-!NewSystemBrowser::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 := self builder componentAt:'List'.
- categoryListView isNil ifTrue:[^ nil].
-
- lineNr := categoryListView lineAtY:p y.
- lineNr isNil ifTrue:[^ nil].
-
- cat := categoryList value at:lineNr.
- 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.
- ].
-! !
-
-!NewSystemBrowser::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
- ]
- ]
- ]
- ]
- ]
- ].
-
- ^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
- (hideUnloadedClasses not or:[cls isLoaded])
- ifTrue:[
- (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
- (cats includes:cls category) ifTrue:[
- (nameSpaceFilter isNil
- or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
- (packageFilter isNil
- or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
- whatToDo value:cls
- ]
- ]
- ]
- ]
- ]
- ]
- ]
-
- "Created: / 5.2.2000 / 13:42:12 / cg"
- "Modified: / 18.8.2000 / 15:52:41 / cg"
-! !
-
-!NewSystemBrowser::ClassCategoryList methodsFor:'private'!
-
-listOfCategories
- |categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
- categoriesWithExtensions categoriesWithChangedCode classesInCangeSet|
-
- 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].
- ].
-
- categories := Set new.
- categoriesWithExtensions := Set new.
- categoriesWithChangedCode := Set new.
-
- classesInCangeSet := ChangeSet current changedClasses.
-
- classes := IdentitySet new.
- inGeneratorHolder isNil ifTrue:[
- Smalltalk allClassesDo:[:cls |
- |cat|
-
- (hideUnloadedClasses not or:[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:[
- cat := cls category.
-cat isString ifFalse:[self halt].
- categories add:cat.
- classes add:cls.
-
- ((classesInCangeSet includes:cls theNonMetaclass)
- or:[(classesInCangeSet includes:cls theMetaclass)]) ifTrue:[
- categoriesWithChangedCode add:cat
- ] ifFalse:[
- cls hasExtensions ifTrue:[
- categoriesWithExtensions add:cat
- ]
- ].
- ]
- ]
- ]
- ]
- ].
-
- "/ 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 select:[:cat | (categories includes:cat) not].
- categories addAll:AdditionalEmptyCategories.
- ].
- ] ifFalse:[
- generator := inGeneratorHolder value.
- generator isNil ifTrue:[^ #() ].
- generator do:[:cat | categories add:cat].
- ].
-
- categories := categories asOrderedCollection.
-
- categories sort.
- categories := categories collect:[:cat |
- (categoriesWithChangedCode includes:cat) ifTrue:[
- (self colorizeForChangedCode:cat copy asText).
- ] ifFalse:[
- (categoriesWithExtensions includes:cat) ifTrue:[
- (self colorizeForDifferentPackage:cat copy asText).
- ] ifFalse:[
- cat
- ]
- ]
- ].
- categories size == 1 ifTrue:[
- self classCategoryLabelHolder value:(categories first)
- ].
- categories size == 0 ifFalse:[
- categories addFirst:(self class nameListEntryForALL).
- ].
- ^ categories
-
- "Created: / 5.2.2000 / 13:42:12 / cg"
- "Modified: / 13.11.2001 / 11:32:36 / cg"
-!
-
-makeDependent
- Smalltalk addDependent:self.
- ChangeSet addDependent:self.
-
- "Created: / 5.2.2000 / 13:42:13 / cg"
-!
-
-makeIndependent
- Smalltalk removeDependent:self.
- ChangeSet removeDependent:self.
-
- "Created: / 5.2.2000 / 13:42:13 / cg"
-!
-
-updateList
- |oldList newList oldSelection newSelection prevClasses
- selectedCategoriesHolder|
-
- selectedCategoriesHolder := self selectedCategories.
- oldSelection := selectedCategoriesHolder value ? #().
- prevClasses := classes copy.
-
- newList := self listOfCategories.
- oldList := (self categoryList value) ? #().
- (newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
- ifFalse:[
- 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.
- ]
- ] 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: / 5.2.2000 / 13:42:13 / cg"
- "Modified: / 18.8.2000 / 15:52:22 / cg"
-! !
-
-!NewSystemBrowser::ClassCategoryList methodsFor:'setup'!
-
-commonPostBuildWith:aBuilder
- |list|
-
- list := aBuilder componentAt:#List.
- list notNil ifTrue:[
- list scrollWhenUpdating:nil
- ].
- super commonPostBuildWith:aBuilder
-
-! !
-
-!NewSystemBrowser::ClassCategoryList 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 "/ 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
-! !
-
!NewSystemBrowser::OrganizerCanvas class methodsFor:'interface specs'!
embeddedNameSpaceListSpec
@@ -51609,6 +51628,6 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.310 2002-02-11 13:00:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.311 2002-02-15 13:13:57 cg Exp $'
! !
NewSystemBrowser initialize!
--- a/Tools__NewSystemBrowser.st Fri Feb 15 14:06:02 2002 +0100
+++ b/Tools__NewSystemBrowser.st Fri Feb 15 14:13:57 2002 +0100
@@ -87,6 +87,13 @@
privateIn:NewSystemBrowser
!
+NewSystemBrowser::BrowserList subclass:#ClassCategoryList
+ instanceVariableNames:'categoryList classes allSelected'
+ classVariableNames:'AdditionalEmptyCategories'
+ poolDictionaries:''
+ privateIn:NewSystemBrowser
+!
+
NewSystemBrowser::ClassList subclass:#HierarchicalClassList
instanceVariableNames:'topClassHolder'
classVariableNames:'InheritedEntry'
@@ -172,9 +179,9 @@
privateIn:NewSystemBrowser
!
-NewSystemBrowser::BrowserList subclass:#ClassCategoryList
- instanceVariableNames:'categoryList classes allSelected'
- classVariableNames:'AdditionalEmptyCategories'
+NewSystemBrowser::ClassCategoryList subclass:#HierarchicalClassCategoryList
+ instanceVariableNames:'hierarchicalCategoryTree'
+ classVariableNames:''
poolDictionaries:''
privateIn:NewSystemBrowser
!
@@ -30831,58 +30838,70 @@
if unloaded : load it
if visualStartable: start the applciation"
- |cls clsName organizerModeHolder organizerMode newMode|
+ |cls clsName organizerModeHolder organizerMode newMode doSwitchDisplayMode|
cls := self theSingleSelectedClass.
- cls notNil ifTrue:[
- (navigationState isVersionDiffBrowser
- or:[navigationState isCheckOutputBrowser]) ifTrue:[
- self spawnFullBrowserInClass:cls selector:nil in:#newBuffer.
- ^ self
- ].
-
- self withWaitCursorDo:[
- cls := cls theNonMetaclass.
- clsName := cls name.
-
- self window sensor shiftDown ifTrue:[
- self spawnClassReferencesBrowserFor:(Array with:cls) in:#newBuffer.
- ^ self.
- ].
-
- cls isVisualStartable ifTrue:[
+ cls isNil ifTrue:[^ self].
+
+ (navigationState isVersionDiffBrowser
+ or:[navigationState isCheckOutputBrowser]) ifTrue:[
+ self spawnFullBrowserInClass:cls selector:nil in:#newBuffer.
+ ^ self
+ ].
+
+ self withWaitCursorDo:[
+ cls := cls theNonMetaclass.
+ clsName := cls name.
+
+ self window sensor shiftDown ifTrue:[
+ self spawnClassReferencesBrowserFor:(Array with:cls) in:#newBuffer.
+ ^ self.
+ ].
+
+ doSwitchDisplayMode := true.
+ self window sensor metaDown ifFalse:[
+ (cls isVisualStartable) ifTrue:[
self busyLabel:'starting application %1' with:clsName.
cls open.
+ doSwitchDisplayMode := false.
] ifFalse:[
(cls isStartableWithMain) ifTrue:[
self busyLabel:'starting main of %1' with:clsName.
- cls main.
+ (self confirm:('Invoke %1''s main ?' bindWith:clsName)) ifTrue:[
+ cls main.
+ ].
+ doSwitchDisplayMode := false.
] ifFalse:[
cls isLoaded ifFalse:[
self busyLabel:'loading %1' with:clsName.
self classLoad.
+ doSwitchDisplayMode := false.
] ifTrue:[
(TestRunner notNil and:[cls isSubclassOf:TestCase]) ifTrue:[
- TestRunner openOnTestCase:cls
- ] ifFalse:[
- organizerModeHolder := navigationState organizerMode.
- organizerMode := organizerModeHolder value.
-
- "/ toggle view mode (between category and class hierarchy)
- organizerMode == #classHierarchy ifTrue:[
- newMode := #category
- ] ifFalse:[
- newMode := #classHierarchy
- ].
- organizerModeHolder value:newMode
- ]
- ]
- ]
- ].
- self normalLabel.
- ].
- ^ self
- ].
+ TestRunner openOnTestCase:cls.
+ doSwitchDisplayMode := false.
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ doSwitchDisplayMode ifTrue:[
+ organizerModeHolder := navigationState organizerMode.
+ organizerMode := organizerModeHolder value.
+
+ "/ toggle view mode (between category and class hierarchy)
+ organizerMode == #classHierarchy ifTrue:[
+ newMode := #category
+ ] ifFalse:[
+ newMode := #classHierarchy
+ ].
+ organizerModeHolder value:newMode
+ ].
+
+ self normalLabel.
+ ].
+ ^ self
"Modified: / 2.11.2001 / 09:38:39 / cg"
!
@@ -37249,6 +37268,666 @@
Smalltalk changed:#classOrganization with:aClass. "/ not really ... to force update
! !
+!NewSystemBrowser::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)
+"
+! !
+
+!NewSystemBrowser::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:NewSystemBrowser::ClassCategoryList andSelector:#singleCategoryWindowSpec
+ NewSystemBrowser::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:NewSystemBrowser::ClassCategoryList andSelector:#windowSpec
+ NewSystemBrowser::ClassCategoryList new openInterface:#windowSpec
+ NewSystemBrowser::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"
+! !
+
+!NewSystemBrowser::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
+ ).
+
+! !
+
+!NewSystemBrowser::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
+! !
+
+!NewSystemBrowser::ClassCategoryList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+ |selectedCategoriesHolder selectedCategories allSelectedBefore idx listView
+ nameListEntryForALL categoryOfClass|
+
+ selectedCategoriesHolder := self selectedCategories.
+ selectedCategories := selectedCategoriesHolder value ? #().
+ selectedCategories := selectedCategories collect:[:each | each string].
+
+ nameListEntryForALL := self class nameListEntryForALL.
+
+ 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 ChangeList
+ self windowGroup sensor
+ flushEventsFor:self
+ where:[:ev | ev isMessageSendEvent
+ and:[ev selector == #delayedUpdate:with:from:
+ and:[(ev arguments at:3) == ChangeSet]]].
+
+ 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 == selectedCategoriesHolder ifTrue:[
+ categoryList isNil ifTrue:[
+ "/ oops - hurry up
+ self invalidateList.
+ ].
+ selectedCategories size > 1 ifTrue:[
+ (selectedCategories includes:nameListEntryForALL) ifTrue:[
+ idx := categoryList value indexOf: (selectedCategories copy remove:nameListEntryForALL; yourself) first.
+ idx ~~ 0 ifTrue:[
+ (listView := self builder componentAt:#List) notNil ifTrue:[
+ listView makeLineVisible:idx.
+ ]
+ ]
+ ]
+ ].
+
+ "/ 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
+ changedObject == Smalltalk ifTrue:[
+ something == #methodDictionary ifTrue:[
+ ^ self
+ ].
+ something == #classComment ifTrue:[
+ ^ self.
+ ].
+ something == #classVariables ifTrue:[
+ ^ self
+ ].
+ 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"
+! !
+
+!NewSystemBrowser::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 := self builder componentAt:'List'.
+ categoryListView isNil ifTrue:[^ nil].
+
+ lineNr := categoryListView lineAtY:p y.
+ lineNr isNil ifTrue:[^ nil].
+
+ cat := categoryList value at:lineNr.
+ 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.
+ ].
+! !
+
+!NewSystemBrowser::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
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ ^ Iterator on:[:whatToDo |
+ Smalltalk allClassesDo:[:cls |
+ (hideUnloadedClasses not or:[cls isLoaded])
+ ifTrue:[
+ (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
+ (cats includes:cls category) ifTrue:[
+ (nameSpaceFilter isNil
+ or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
+ (packageFilter isNil
+ or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
+ whatToDo value:cls
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+
+ "Created: / 5.2.2000 / 13:42:12 / cg"
+ "Modified: / 18.8.2000 / 15:52:41 / cg"
+! !
+
+!NewSystemBrowser::ClassCategoryList methodsFor:'private'!
+
+listOfCategories
+ |categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
+ categoriesWithExtensions categoriesWithChangedCode classesInCangeSet|
+
+ 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].
+ ].
+
+ categories := Set new.
+ categoriesWithExtensions := Set new.
+ categoriesWithChangedCode := Set new.
+
+ classesInCangeSet := ChangeSet current changedClasses.
+
+ classes := IdentitySet new.
+ inGeneratorHolder isNil ifTrue:[
+ Smalltalk allClassesDo:[:cls |
+ |cat|
+
+ (hideUnloadedClasses not or:[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:[
+ cat := cls category.
+cat isString ifFalse:[self halt].
+ categories add:cat.
+ classes add:cls.
+
+ ((classesInCangeSet includes:cls theNonMetaclass)
+ or:[(classesInCangeSet includes:cls theMetaclass)]) ifTrue:[
+ categoriesWithChangedCode add:cat
+ ] ifFalse:[
+ cls hasExtensions ifTrue:[
+ categoriesWithExtensions add:cat
+ ]
+ ].
+ ]
+ ]
+ ]
+ ]
+ ].
+
+ "/ 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 select:[:cat | (categories includes:cat) not].
+ categories addAll:AdditionalEmptyCategories.
+ ].
+ ] ifFalse:[
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ generator do:[:cat | categories add:cat].
+ ].
+
+ categories := categories asOrderedCollection.
+
+ categories sort.
+ categories := categories collect:[:cat |
+ (categoriesWithChangedCode includes:cat) ifTrue:[
+ (self colorizeForChangedCode:cat copy asText).
+ ] ifFalse:[
+ (categoriesWithExtensions includes:cat) ifTrue:[
+ (self colorizeForDifferentPackage:cat copy asText).
+ ] ifFalse:[
+ cat
+ ]
+ ]
+ ].
+ categories size == 1 ifTrue:[
+ self classCategoryLabelHolder value:(categories first)
+ ].
+ categories size == 0 ifFalse:[
+ categories addFirst:(self class nameListEntryForALL).
+ ].
+ ^ categories
+
+ "Created: / 5.2.2000 / 13:42:12 / cg"
+ "Modified: / 13.11.2001 / 11:32:36 / cg"
+!
+
+makeDependent
+ Smalltalk addDependent:self.
+ ChangeSet addDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+!
+
+makeIndependent
+ Smalltalk removeDependent:self.
+ ChangeSet removeDependent:self.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+!
+
+updateList
+ |oldList newList oldSelection newSelection prevClasses
+ selectedCategoriesHolder|
+
+ selectedCategoriesHolder := self selectedCategories.
+ oldSelection := selectedCategoriesHolder value ? #().
+ prevClasses := classes copy.
+
+ newList := self listOfCategories.
+ oldList := (self categoryList value) ? #().
+ (newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
+ ifFalse:[
+ 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.
+ ]
+ ] 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: / 5.2.2000 / 13:42:13 / cg"
+ "Modified: / 18.8.2000 / 15:52:22 / cg"
+! !
+
+!NewSystemBrowser::ClassCategoryList methodsFor:'setup'!
+
+commonPostBuildWith:aBuilder
+ |list|
+
+ list := aBuilder componentAt:#List.
+ list notNil ifTrue:[
+ list scrollWhenUpdating:nil
+ ].
+ super commonPostBuildWith:aBuilder
+
+! !
+
+!NewSystemBrowser::ClassCategoryList 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 "/ 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
+! !
+
!NewSystemBrowser::HierarchicalClassList class methodsFor:'documentation'!
documentation
@@ -46883,666 +47562,6 @@
^ super resources
! !
-!NewSystemBrowser::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)
-"
-! !
-
-!NewSystemBrowser::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:NewSystemBrowser::ClassCategoryList andSelector:#singleCategoryWindowSpec
- NewSystemBrowser::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:NewSystemBrowser::ClassCategoryList andSelector:#windowSpec
- NewSystemBrowser::ClassCategoryList new openInterface:#windowSpec
- NewSystemBrowser::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"
-! !
-
-!NewSystemBrowser::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
- ).
-
-! !
-
-!NewSystemBrowser::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
-! !
-
-!NewSystemBrowser::ClassCategoryList methodsFor:'change & update'!
-
-delayedUpdate:something with:aParameter from:changedObject
- |selectedCategoriesHolder selectedCategories allSelectedBefore idx listView
- nameListEntryForALL categoryOfClass|
-
- selectedCategoriesHolder := self selectedCategories.
- selectedCategories := selectedCategoriesHolder value ? #().
- selectedCategories := selectedCategories collect:[:each | each string].
-
- nameListEntryForALL := self class nameListEntryForALL.
-
- 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 ChangeList
- self windowGroup sensor
- flushEventsFor:self
- where:[:ev | ev isMessageSendEvent
- and:[ev selector == #delayedUpdate:with:from:
- and:[(ev arguments at:3) == ChangeSet]]].
-
- 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 == selectedCategoriesHolder ifTrue:[
- categoryList isNil ifTrue:[
- "/ oops - hurry up
- self invalidateList.
- ].
- selectedCategories size > 1 ifTrue:[
- (selectedCategories includes:nameListEntryForALL) ifTrue:[
- idx := categoryList value indexOf: (selectedCategories copy remove:nameListEntryForALL; yourself) first.
- idx ~~ 0 ifTrue:[
- (listView := self builder componentAt:#List) notNil ifTrue:[
- listView makeLineVisible:idx.
- ]
- ]
- ]
- ].
-
- "/ 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
- changedObject == Smalltalk ifTrue:[
- something == #methodDictionary ifTrue:[
- ^ self
- ].
- something == #classComment ifTrue:[
- ^ self.
- ].
- something == #classVariables ifTrue:[
- ^ self
- ].
- 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"
-! !
-
-!NewSystemBrowser::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 := self builder componentAt:'List'.
- categoryListView isNil ifTrue:[^ nil].
-
- lineNr := categoryListView lineAtY:p y.
- lineNr isNil ifTrue:[^ nil].
-
- cat := categoryList value at:lineNr.
- 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.
- ].
-! !
-
-!NewSystemBrowser::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
- ]
- ]
- ]
- ]
- ]
- ].
-
- ^ Iterator on:[:whatToDo |
- Smalltalk allClassesDo:[:cls |
- (hideUnloadedClasses not or:[cls isLoaded])
- ifTrue:[
- (cls isNameSpace not or:[cls == Smalltalk]) ifTrue:[
- (cats includes:cls category) ifTrue:[
- (nameSpaceFilter isNil
- or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
- (packageFilter isNil
- or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
- whatToDo value:cls
- ]
- ]
- ]
- ]
- ]
- ]
- ]
-
- "Created: / 5.2.2000 / 13:42:12 / cg"
- "Modified: / 18.8.2000 / 15:52:41 / cg"
-! !
-
-!NewSystemBrowser::ClassCategoryList methodsFor:'private'!
-
-listOfCategories
- |categories hideUnloadedClasses generator nameSpaceFilter packageFilter allName
- categoriesWithExtensions categoriesWithChangedCode classesInCangeSet|
-
- 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].
- ].
-
- categories := Set new.
- categoriesWithExtensions := Set new.
- categoriesWithChangedCode := Set new.
-
- classesInCangeSet := ChangeSet current changedClasses.
-
- classes := IdentitySet new.
- inGeneratorHolder isNil ifTrue:[
- Smalltalk allClassesDo:[:cls |
- |cat|
-
- (hideUnloadedClasses not or:[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:[
- cat := cls category.
-cat isString ifFalse:[self halt].
- categories add:cat.
- classes add:cls.
-
- ((classesInCangeSet includes:cls theNonMetaclass)
- or:[(classesInCangeSet includes:cls theMetaclass)]) ifTrue:[
- categoriesWithChangedCode add:cat
- ] ifFalse:[
- cls hasExtensions ifTrue:[
- categoriesWithExtensions add:cat
- ]
- ].
- ]
- ]
- ]
- ]
- ].
-
- "/ 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 select:[:cat | (categories includes:cat) not].
- categories addAll:AdditionalEmptyCategories.
- ].
- ] ifFalse:[
- generator := inGeneratorHolder value.
- generator isNil ifTrue:[^ #() ].
- generator do:[:cat | categories add:cat].
- ].
-
- categories := categories asOrderedCollection.
-
- categories sort.
- categories := categories collect:[:cat |
- (categoriesWithChangedCode includes:cat) ifTrue:[
- (self colorizeForChangedCode:cat copy asText).
- ] ifFalse:[
- (categoriesWithExtensions includes:cat) ifTrue:[
- (self colorizeForDifferentPackage:cat copy asText).
- ] ifFalse:[
- cat
- ]
- ]
- ].
- categories size == 1 ifTrue:[
- self classCategoryLabelHolder value:(categories first)
- ].
- categories size == 0 ifFalse:[
- categories addFirst:(self class nameListEntryForALL).
- ].
- ^ categories
-
- "Created: / 5.2.2000 / 13:42:12 / cg"
- "Modified: / 13.11.2001 / 11:32:36 / cg"
-!
-
-makeDependent
- Smalltalk addDependent:self.
- ChangeSet addDependent:self.
-
- "Created: / 5.2.2000 / 13:42:13 / cg"
-!
-
-makeIndependent
- Smalltalk removeDependent:self.
- ChangeSet removeDependent:self.
-
- "Created: / 5.2.2000 / 13:42:13 / cg"
-!
-
-updateList
- |oldList newList oldSelection newSelection prevClasses
- selectedCategoriesHolder|
-
- selectedCategoriesHolder := self selectedCategories.
- oldSelection := selectedCategoriesHolder value ? #().
- prevClasses := classes copy.
-
- newList := self listOfCategories.
- oldList := (self categoryList value) ? #().
- (newList sameContentsAs:oldList whenComparedWith:[:a :b | a sameStringAndEmphasisAs: b])
- ifFalse:[
- 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.
- ]
- ] 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: / 5.2.2000 / 13:42:13 / cg"
- "Modified: / 18.8.2000 / 15:52:22 / cg"
-! !
-
-!NewSystemBrowser::ClassCategoryList methodsFor:'setup'!
-
-commonPostBuildWith:aBuilder
- |list|
-
- list := aBuilder componentAt:#List.
- list notNil ifTrue:[
- list scrollWhenUpdating:nil
- ].
- super commonPostBuildWith:aBuilder
-
-! !
-
-!NewSystemBrowser::ClassCategoryList 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 "/ 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
-! !
-
!NewSystemBrowser::OrganizerCanvas class methodsFor:'interface specs'!
embeddedNameSpaceListSpec
@@ -51609,6 +51628,6 @@
!NewSystemBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.310 2002-02-11 13:00:37 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.311 2002-02-15 13:13:57 cg Exp $'
! !
NewSystemBrowser initialize!