"{ Package: 'stx:__NoProject__' }"

"{ 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'!

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)

          #max: #(#Point 1024 721)

          #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

    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|

    changedObject == Smalltalk ifTrue:[

	organizerMode value == #category ifTrue:[

	    something == #organization ifTrue:[

		self updateList.

		^ self

	    ].

	    something == #newClass ifTrue:[

		self updateList.

		^ self

	    ].

	    something == #methodInClass ifTrue:[ ^ self ].

"/ self halt:'debug halt'.

	    ^ self.

	].

	organizerMode value == #namespace ifTrue:[

	    something == #newClass ifTrue:[

		aParameter isNameSpace ifTrue:[

		    self updateList

		].

		^ self

	    ].

	    something == #classRemove ifTrue:[

		aParameter isNameSpace ifTrue:[

		    self updateList

		].

		^ self

	    ].

"/ self halt:'debug halt'.

	    ^ self

	].

	organizerMode value == #project 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).

    ^ theList

    "Created: / 25.2.2000 / 21:24:26 / cg"

!

listOfCategories

    |categories hideUnloadedClasses|

    inGeneratorHolder notNil ifTrue:[

	^ self listFromInGenerator

    ].

    hideUnloadedClasses := self hideUnloadedClasses value.

    categories := Set new.

    Smalltalk 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 select:[:cat | (categories includes:cat) not].

	categories addAll:AdditionalEmptyCategories.

    ].

    categories := categories asOrderedCollection.

    categories sort.

    categories addFirst:(self class nameListEntryForALL).

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

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

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

	Smalltalk allClassesDo:[:eachClass |

	    |cls pkg|

	    eachClass isLoaded ifTrue:[

		cls := eachClass theNonMetaclass.

		cls isPrivate ifTrue:[

		    cls := cls topOwningClass

		].

		pkg := cls package.

		pkg withoutSeparators size > 0 ifTrue:[

		    allProjects add:pkg asSymbol.

		] ifFalse:[

		    "/ for now, nameSpaces are not in any package;

		    "/ this might change. Then, 0-sized packages are

		    "/ illegal, abd the following should be enabled.

		    "/ self halt

		].

		cls methodDictionary do:[:mthd |

		    allProjects add:mthd package asSymbol.

		].

	    ].

	].

	allProjects := allProjects asOrderedCollection.

    ] ifFalse:[

	allProjects := NewSystemBrowser allProjectsIDs.

    ].

    "/ 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 select:[:pkg | (allProjects includes:pkg) not].

	allProjects addAll:AdditionalEmptyProjects.

    ].

    allProjects sort.

    allProjects addFirst:(self class nameListEntryForALL).

    ^ allProjects

    "Created: / 25.2.2000 / 21:22:06 / cg"

    "Modified: / 25.2.2000 / 21:27:27 / cg"

!

makeDependent

    Smalltalk addDependent:self

!

makeIndependent

    Smalltalk 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 == #category ifTrue:[

	self updateCategoryList.

	^ self

    ].

    orgMode == #project ifTrue:[

	self updateProjectList.

	^ self

    ].

    orgMode == #namespace 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: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.1 2004-02-26 18:56:38 cg Exp $'

! !