#REFACTORING by stefan
Sanitize BlockValues
class: BookmarkListEditor
changed:
#hasFolderSelectedHolder
#hasSelectionHolder
"
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 allLoadedProjectIDs.
] ifFalse:[
allProjects := environment 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 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: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.14 2013-09-05 10:46:11 vrany Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/Tools_ClassGeneratorList.st,v 1.14 2013-09-05 10:46:11 vrany Exp $'
! !