--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__ClassGeneratorList.st Fri Mar 25 22:47:11 2016 +0100
@@ -0,0 +1,524 @@
+"
+ 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:#ClassGeneratorList
+ instanceVariableNames:'organizerList categoryList namespaceList namespaceNameList
+ projectList selectedCategories selectedNamespaces
+ selectedProjects selectedClasses'
+ classVariableNames:'AdditionalEmptyCategories AdditionalEmptyProjects'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!ClassGeneratorList 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)
+"
+! !
+
+!ClassGeneratorList class methodsFor:'interface specs'!
+
+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:ClassGeneratorList andSelector:#windowSpec
+ ClassGeneratorList new openInterface:#windowSpec
+ ClassGeneratorList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'OrganizerList'
+ #name: 'OrganizerList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 12 22 312 322)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#SequenceViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #organizerSelection
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #useIndex: true
+ #sequenceList: #organizerList
+ #doubleClickChannel: #doubleClickChannel
+ )
+ )
+
+ )
+ )
+
+ "Modified: / 18.8.2000 / 20:12:20 / cg"
+! !
+
+!ClassGeneratorList methodsFor:'aspects'!
+
+categoryList
+ categoryList isNil ifTrue:[
+ categoryList := ValueHolder new.
+ ].
+ ^ categoryList
+
+
+!
+
+nameSpaceList
+ namespaceList isNil ifTrue:[
+ namespaceList := ValueHolder new
+ ].
+ ^ namespaceList
+
+ "Created: / 18.2.2000 / 00:59:01 / cg"
+!
+
+projectList
+ projectList isNil ifTrue:[
+ projectList := ValueHolder new
+ ].
+ ^ projectList
+
+ "Created: / 17.2.2000 / 23:39:32 / cg"
+
+!
+
+selectedCategories
+ selectedCategories isNil ifTrue:[
+ selectedCategories := ValueHolder new.
+ selectedCategories addDependent:self
+ ].
+ ^ selectedCategories.
+
+!
+
+selectedCategories:aValueHolder
+ |prevSelection|
+
+ prevSelection := selectedCategories value ? #().
+
+ selectedCategories notNil ifTrue:[
+ selectedCategories removeDependent:self
+ ].
+ selectedCategories := aValueHolder.
+ selectedCategories notNil ifTrue:[
+ selectedCategories addDependent:self
+ ].
+ (selectedCategories value ? #()) ~= prevSelection ifTrue:[
+ "/ update
+ self update:#value with:nil from:selectedCategories
+ ].
+
+
+
+!
+
+selectedClasses
+ "bad name- it's a holder, baby"
+
+ selectedClasses isNil ifTrue:[
+ selectedClasses := ValueHolder new.
+ ].
+ ^ selectedClasses.
+!
+
+selectedClasses:aValueHolder
+"/ selectedClasses notNil ifTrue:[
+"/ selectedClasses removeDependent:self
+"/ ].
+ selectedClasses := aValueHolder.
+"/ selectedClasses notNil ifTrue:[
+"/ selectedClasses addDependent:self
+"/ ].
+!
+
+selectedNamespaces
+ selectedNamespaces isNil ifTrue:[
+ selectedNamespaces := ValueHolder new.
+ selectedNamespaces addDependent:self
+ ].
+ ^ selectedNamespaces.
+
+!
+
+selectedNamespaces:aValueHolder
+ |prevSelection|
+
+ prevSelection := selectedNamespaces value ? #().
+
+ selectedNamespaces notNil ifTrue:[
+ selectedNamespaces removeDependent:self
+ ].
+ selectedNamespaces := aValueHolder.
+ selectedNamespaces notNil ifTrue:[
+ selectedNamespaces addDependent:self
+ ].
+ (selectedNamespaces value ? #()) ~= prevSelection ifTrue:[
+ "/ update
+ self update:#value with:nil from:selectedNamespaces
+ ].
+
+
+
+!
+
+selectedProjects
+ selectedProjects isNil ifTrue:[
+ selectedProjects := ValueHolder new.
+ selectedProjects addDependent:self
+ ].
+ ^ selectedProjects.
+
+!
+
+selectedProjects:aValueHolder
+ |prevSelection|
+
+ prevSelection := selectedProjects value ? #().
+
+ selectedProjects notNil ifTrue:[
+ selectedProjects removeDependent:self
+ ].
+ selectedProjects := aValueHolder.
+ selectedProjects notNil ifTrue:[
+ selectedProjects addDependent:self
+ ].
+ (selectedProjects value ? #()) ~= prevSelection ifTrue:[
+ "/ update
+ self update:#value with:nil from:selectedProjects
+ ].
+
+
+
+! !
+
+!ClassGeneratorList methodsFor:'aspects-private'!
+
+organizerList
+ organizerList isNil ifTrue:[
+ organizerList := ValueHolder new.
+ ].
+ ^ organizerList
+
+
+! !
+
+!ClassGeneratorList methodsFor:'change & update'!
+
+delayedUpdate:something with:aParameter from:changedObject
+ |cls sel pkg mthd orgMode|
+
+ changedObject == environment ifTrue:[
+ orgMode := organizerMode value.
+
+ orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
+ (something == #organization
+ or:[something == #newClass]) ifTrue:[
+ self updateList.
+ ^ self
+ ].
+ something == #methodInClass ifTrue:[ ^ self ].
+"/ self halt:'debug halt'.
+ ^ self.
+ ].
+ orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
+ (something == #newClass
+ or:[something == #classRemove]) ifTrue:[
+ aParameter isNameSpace ifTrue:[
+ self updateList
+ ].
+ ^ self
+ ].
+"/ self halt:'debug halt'.
+ ^ self
+ ].
+ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
+ something == #projectOrganization ifTrue:[
+ self updateList.
+ ^ self
+ ].
+ something == #methodInClass ifTrue:[
+ cls := aParameter at:1.
+ sel := aParameter at:2.
+ mthd := cls compiledMethodAt:sel.
+ pkg := mthd package.
+ (projectList value includes:pkg) ifFalse:[
+ self halt:'debug-halt. remove when known to work'.
+ self updateList.
+ ^ self
+ ].
+ ^ self
+ ].
+ (something == #classDefinition
+ or:[something == #newClass]) ifTrue:[
+ cls := aParameter.
+ pkg := cls package.
+ (projectList value includes:pkg) ifFalse:[
+ self halt:'debug-halt. remove when known to work'.
+ self updateList.
+ ^ self
+ ].
+ ^ self
+ ].
+"/ self halt.
+ ^ self
+ ].
+ ^ self
+ ].
+ super delayedUpdate:something with:aParameter from:changedObject
+
+ "Created: / 25.2.2000 / 21:32:03 / cg"
+ "Modified: / 25.2.2000 / 21:35:23 / cg"
+! !
+
+!ClassGeneratorList methodsFor:'private'!
+
+listFromInGenerator
+ |generator theList|
+
+ theList := Set new.
+ generator := inGeneratorHolder value.
+ generator isNil ifTrue:[^ #() ].
+ generator do:[:prj | theList add:prj].
+ theList := theList asOrderedCollection sort.
+ theList addFirst:(self class nameListEntryForALL allItalic).
+ ^ theList
+
+ "Created: / 25.2.2000 / 21:24:26 / cg"
+!
+
+listOfCategories
+ |categories hideUnloadedClasses|
+
+ inGeneratorHolder notNil ifTrue:[
+ ^ self listFromInGenerator
+ ].
+
+ hideUnloadedClasses := self hideUnloadedClasses value.
+
+ categories := Set new.
+ environment allClassesDo:[:cls |
+ (hideUnloadedClasses not or:[cls isLoaded])
+ ifTrue:[
+ categories add:cls category.
+ ]
+ ].
+
+ "/ 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 reject:[:cat | (categories includes:cat)].
+ categories addAll:AdditionalEmptyCategories.
+ ].
+ categories := categories asOrderedCollection.
+ categories sort.
+ categories addFirst:(self class nameListEntryForALL allItalic).
+ ^ categories
+
+ "Created: / 5.2.2000 / 13:42:12 / cg"
+ "Modified: / 25.2.2000 / 21:26:04 / cg"
+!
+
+listOfNamespaces
+ |allNamespaces showAllNamespaces|
+
+ inGeneratorHolder notNil ifTrue:[
+ ^ self listFromInGenerator
+ ].
+
+showAllNamespaces := true.
+
+ allNamespaces := IdentitySet new.
+
+ (self hideUnloadedClasses value) ifTrue:[
+ environment allClassesDo:[:eachClass |
+ eachClass isLoaded ifTrue:[
+ allNamespaces add:(eachClass theNonMetaclass topNameSpace)
+ ].
+ ]
+ ] ifFalse:[
+ allNamespaces := NameSpace allNameSpaces.
+ ].
+
+ showAllNamespaces ifFalse:[
+ "/ only topLevel namespaces are shown
+ "/ i.e. ignore subspaces
+
+ allNamespaces := allNamespaces select:[:ns | ns isTopLevelNameSpace].
+ ].
+ allNamespaces := allNamespaces collect:[:ns | ns name].
+ allNamespaces := allNamespaces asOrderedCollection.
+ allNamespaces sort.
+ allNamespaces addFirst:(self class nameListEntryForALL allItalic).
+ ^ allNamespaces
+
+ "Created: / 25.2.2000 / 21:21:14 / cg"
+ "Modified: / 25.2.2000 / 21:26:41 / cg"
+!
+
+listOfProjects
+ |allProjects|
+
+ inGeneratorHolder notNil ifTrue:[
+ ^ self listFromInGenerator
+ ].
+
+ allProjects := IdentitySet new.
+
+ (self hideUnloadedClasses value) ifTrue:[
+ allProjects := environment allLoadedPackageIDs.
+ ] ifFalse:[
+ allProjects := environment allPackageIDs.
+ ].
+
+ "/ those are simulated - in ST/X, empty projects do not
+ "/ really exist; however, during browsing, it makes sense.
+ AdditionalEmptyProjects size > 0 ifTrue:[
+ "/ remove those that are present ...
+ AdditionalEmptyProjects := AdditionalEmptyProjects reject:[:pkg | (allProjects includes:pkg)].
+ allProjects addAll:AdditionalEmptyProjects.
+ ].
+ allProjects sort.
+ allProjects addFirst:(self class nameListEntryForALL allItalic).
+ ^ allProjects
+
+ "Created: / 25.2.2000 / 21:22:06 / cg"
+ "Modified: / 25.2.2000 / 21:27:27 / cg"
+!
+
+makeDependent
+ environment addDependent:self
+
+!
+
+makeIndependent
+ environment removeDependent:self.
+
+!
+
+release
+ super release.
+
+ selectedCategories removeDependent:self.
+ selectedNamespaces removeDependent:self.
+ selectedProjects removeDependent:self.
+!
+
+updateCategoryList
+ |newList|
+
+ newList := self listOfCategories.
+ newList ~= self categoryList value ifTrue:[
+ categoryList value:newList.
+ self organizerList value:newList.
+ ].
+
+ "Created: / 25.2.2000 / 21:12:32 / cg"
+!
+
+updateList
+ |orgMode|
+
+ orgMode := self organizerMode value.
+ orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
+ self updateCategoryList.
+ ^ self
+ ].
+ orgMode == OrganizerCanvas organizerModeProject ifTrue:[
+ self updateProjectList.
+ ^ self
+ ].
+ orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
+ self updateNamespaceList.
+ ^ self
+ ].
+ self halt:'unexpected value'.
+
+ "Created: / 5.2.2000 / 13:42:13 / cg"
+ "Modified: / 25.2.2000 / 21:14:19 / cg"
+!
+
+updateNamespaceList
+ |newList|
+
+ newList := self listOfNamespaces.
+ newList ~= self nameSpaceList value ifTrue:[
+ namespaceList value:newList.
+ self organizerList value:newList.
+ ].
+
+ "Created: / 25.2.2000 / 21:13:16 / cg"
+!
+
+updateProjectList
+ |newList|
+
+ newList := self listOfProjects.
+ newList ~= self projectList value ifTrue:[
+ projectList value:newList.
+ self organizerList value:newList.
+ ].
+
+ "Created: / 25.2.2000 / 21:12:57 / cg"
+! !
+
+!ClassGeneratorList class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+!
+
+version_CVS
+ ^ '$Header$'
+! !
+