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