"
 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)
	  #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 orgMode|

    changedObject == Smalltalk ifTrue:[
        orgMode := organizerMode value.

        orgMode == OrganizerCanvas organizerModeCategory ifTrue:[
            something == #organization ifTrue:[
                self updateList.
                ^ self
            ].
            something == #newClass ifTrue:[
                self updateList.
                ^ self
            ].
            something == #methodInClass ifTrue:[ ^ self ].
"/ self halt:'debug halt'.
            ^ self.
        ].
        orgMode == OrganizerCanvas organizerModeNamespace ifTrue:[
            something == #newClass ifTrue:[
                aParameter isNameSpace ifTrue:[
                    self updateList
                ].
                ^ self
            ].
            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).
    ^ 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 := Smalltalk allProjectIDs.
    ].

    "/ 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 == 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: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.6 2006-03-27 17:10:43 cg Exp $'
! !