"
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 }"
ClassCategoryList subclass:#HierarchicalClassCategoryList
instanceVariableNames:'hierarchicalCategoryTree hierarchicalCategoryList
hierarchicalCategorySelection categoryToItemDictionary'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers-New'
!
HierarchicalItemWithLabel subclass:#ClassCategoryItem
instanceVariableNames:'category'
classVariableNames:''
poolDictionaries:''
privateIn:HierarchicalClassCategoryList
!
!HierarchicalClassCategoryList 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 classes as listed by
the inputGenerator.
Provides an outputGenerator, which enumerates the classes and
their protocols (method-categories) in the selected classes.
[author:]
Claus Gittinger (cg@exept.de)
"
! !
!HierarchicalClassCategoryList 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:HierarchicalClassCategoryList andSelector:#windowSpec
HierarchicalClassCategoryList new openInterface:#windowSpec
HierarchicalClassCategoryList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ClassCategoryList'
#name: 'ClassCategoryList'
#min: #(#Point 0 0)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#HierarchicalListViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #hierarchicalCategorySelection
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#listModel: #hierarchicalCategoryList
#multipleSelectOk: true
#highlightMode: #line
#doubleClickSelector: #doubleClicked:
#showLines: false
#indicatorSelector: #indicatorPressed:
#useDefaultIcons: false
#properties:
#(#PropertyListDictionary
#dragArgument: nil
#dropArgument: nil
#canDropSelector: #canDrop:
#dropSelector: #doDrop:
)
)
)
)
)
! !
!HierarchicalClassCategoryList class methodsFor:'plugIn spec'!
aspectSelectors
"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."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#(#doubleClickChannel #action )
#forceGeneratorTrigger
#hideUnloadedClasses
#immediateUpdate
#inGeneratorHolder
#menuHolder
#nameSpaceFilter
#organizerMode
#outGeneratorHolder
#packageFilter
#selectedCategories
#selectionChangeCondition
#slaveMode
#updateTrigger
#showCoverageInformation
).
"Modified: / 20-07-2011 / 14:29:15 / cg"
! !
!HierarchicalClassCategoryList methodsFor:'aspects'!
addCategory:category
|item path parentPath parentCategory parentItem|
item:= categoryToItemDictionary at:category ifAbsent:nil.
item isNil ifTrue:[
path := category asCollectionOfSubstringsSeparatedBy:$-.
item := ClassCategoryItem new.
item category:category.
item label:(path last).
categoryToItemDictionary at:category put:item.
category size > 0 ifTrue:[
"/ find the parent ...
parentPath := path copyWithoutLast:1.
parentCategory := parentPath asStringWith:$-.
parentItem := self addCategory:parentCategory .
parentItem add:item sortBlock:[:i1 :i2 | i1 category asLowercase < i2 category asLowercase].
]
].
^ item
!
generateHierarchicalCategoryTree
|anchor|
self categoryList value isNil ifTrue:[
self updateList.
self categoryList value isNil ifTrue:[
^ nil.
]
].
anchor := ClassCategoryItem new.
anchor category:nil.
anchor label:nil.
categoryToItemDictionary := Dictionary new.
categoryToItemDictionary at:'' asSymbol put:anchor.
self categoryList value do:[:eachCategory |
(categoryToItemDictionary includesKey:eachCategory) ifFalse:[
self addCategory:eachCategory
].
].
anchor recursiveSortChildren:[:i1 :i2 | i1 category asLowercase < i2 category asLowercase].
anchor expand.
^ anchor
!
hierarchicalCategoryList
|anchor |
hierarchicalCategoryList isNil ifTrue:[
hierarchicalCategoryList := HierarchicalList new.
hierarchicalCategoryList showRoot:false.
(self slaveMode value ~~ true) ifTrue:[
anchor := self generateHierarchicalCategoryTree.
hierarchicalCategoryList root:anchor.
listValid := true
] ifFalse:[
listValid := false
]
].
^ hierarchicalCategoryList
!
hierarchicalCategorySelection
hierarchicalCategorySelection isNil ifTrue:[
hierarchicalCategorySelection := #() asValue.
hierarchicalCategorySelection addDependent:self.
].
^ hierarchicalCategorySelection.
! !
!HierarchicalClassCategoryList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
|cls sel oldMethod newMethod newPackage|
self inSlaveModeOrInvisible ifTrue:[
super delayedUpdate:something with:aParameter from:changedObject.
^ self.
].
changedObject == updateTrigger ifTrue:[
hierarchicalCategoryTree := nil.
self hierarchicalCategoryList.
self updateTreeSelectionFromList.
^ self
].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList
].
"/ self invalidateList.
^ self
].
changedObject == hierarchicalCategorySelection ifTrue:[
self updateSelectionFromTree.
^ self
].
changedObject == self selectedCategories ifTrue:[
"/ update the trees selection as appropriate
"/ self updateTreeSelection.
self updateTreeSelectionFromList.
].
changedObject == categoryList ifTrue:[
"/ update the tree
self hierarchicalCategoryList root:(self generateHierarchicalCategoryTree).
^ self.
].
super delayedUpdate:something with:aParameter from:changedObject
"Created: / 17.2.2000 / 23:41:02 / cg"
"Modified: / 26.2.2000 / 01:21:49 / cg"
!
updateSelectionFromTree
|treeSelection|
treeSelection := hierarchicalCategorySelection value
collect:[:eachIndex | |item|
item := hierarchicalCategoryList at:eachIndex ifAbsent:nil.
item category
].
treeSelection asSet ~= (self selectedCategories value ? #()) asSet ifTrue:[
self selectedCategories value:treeSelection.
]
!
updateTreeSelectionFromList
|listSelection selectedTreeItems treeSelection|
listSelection := self selectedCategories value.
selectedTreeItems := listSelection collect:[:itemString | self treeItemForString:itemString string].
treeSelection := selectedTreeItems collect:[:eachItem | hierarchicalCategoryList identityIndexOf:eachItem].
treeSelection := treeSelection asOrderedCollection.
"/hierarchicalCategorySelection value
"/ collect:[:eachIndex | |item|
"/ item := hierarchicalCategoryList at:eachIndex ifAbsent:nil.
"/ item category
"/ ].
"/
"/ treeSelection asSet ~= (self selectedCategories value ? #()) asSet ifTrue:[
"/ self selectedCategories value:treeSelection.
"/ ]
self hierarchicalCategorySelection value:treeSelection
! !
!HierarchicalClassCategoryList methodsFor:'private'!
makeItemVisible:itemString
|treeItem idx listView|
treeItem := self treeItemForString:itemString.
idx := hierarchicalCategoryList identityIndexOf:treeItem.
idx ~~ 0 ifTrue:[
(listView := self listView) notNil ifTrue:[
listView makeLineVisible:idx.
]
]
!
release
super release.
hierarchicalCategorySelection removeDependent:self.
!
treeItemForString:itemString
|itemPath treeItem|
itemPath := itemString string asCollectionOfSubstringsSeparatedBy:$-.
treeItem := hierarchicalCategoryList root.
[itemPath notEmpty] whileTrue:[
treeItem expand.
treeItem := treeItem detect:[:childItem | childItem label string = itemPath first] ifNone:nil.
itemPath := itemPath copyFrom:2.
].
^ treeItem
! !
!HierarchicalClassCategoryList methodsFor:'user actions'!
doubleClicked:anIndex
|item|
item := hierarchicalCategoryList at:anIndex ifAbsent:nil.
item isNil ifTrue:[
^ self
].
(item canExpand not or:[item isExpanded]) ifTrue:[
doubleClickChannel notNil ifTrue:[
doubleClickChannel value:anIndex.
] ifFalse:[
item collapse.
].
^ self
].
item expand.
!
indicatorPressed:anIndex
|item sensor|
item := hierarchicalCategoryList at:anIndex ifAbsent:nil.
item isNil ifTrue:[
^ self
].
sensor := self window sensor.
(sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
item recursiveToggleExpand
] ifFalse:[
item toggleExpand
].
! !
!HierarchicalClassCategoryList::ClassCategoryItem methodsFor:'accessing'!
category
^ category
!
category:something
category := something.
!
icon
^ nil "/ SystemBrowser packageIcon
! !
!HierarchicalClassCategoryList class methodsFor:'documentation'!
version
^ '$Id: Tools__HierarchicalClassCategoryList.st 8018 2012-07-18 17:00:57Z vranyj1 $'
!
version_CVS
^ '§Header: /cvs/stx/stx/libtool/Tools_HierarchicalClassCategoryList.st,v 1.9 2011/07/20 12:54:09 cg Exp §'
!
version_SVN
^ '$Id: Tools__HierarchicalClassCategoryList.st 8018 2012-07-18 17:00:57Z vranyj1 $'
! !