--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__HierarchicalProjectList.st Sun Jan 29 12:53:39 2012 +0000
@@ -0,0 +1,526 @@
+"
+ 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 }"
+
+ProjectList subclass:#HierarchicalProjectList
+ instanceVariableNames:'hierarchicalProjectTree selectedProjectItems packageIcon
+ hierarchicalProjectList hierarchicalProjectSelection
+ packageToItemDictionary'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+HierarchicalItemWithLabel subclass:#ProjectItem
+ instanceVariableNames:'packageID'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:HierarchicalProjectList
+!
+
+!HierarchicalProjectList 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
+"
+ Like a ClassList, but shows classes hierarchical.
+
+ If topClassHolders value is non-nil, only that classes hierarchy
+ is shown.
+
+ 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)
+"
+
+
+! !
+
+!HierarchicalProjectList 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:HierarchicalProjectList andSelector:#windowSpec
+ HierarchicalProjectList new openInterface:#windowSpec
+ HierarchicalProjectList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'ProjectList'
+ #name: 'ProjectList'
+ #min: #(#Point 0 0)
+ #bounds: #(#Rectangle 16 46 316 346)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#HierarchicalListViewSpec
+ #name: 'HierarchicalListView1'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #model: #hierarchicalProjectSelection
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #listModel: #hierarchicalProjectList
+ #multipleSelectOk: true
+ #highlightMode: #line
+ #doubleClickSelector: #doubleClicked:
+ #indicatorSelector: #indicatorPressed:
+ #properties:
+ #(#PropertyListDictionary
+ #dragArgument: nil
+ #dropArgument: nil
+ #canDropSelector: #canDrop:
+ #dropSelector: #doDrop:
+ )
+ )
+ )
+
+ )
+ )
+!
+
+xxwindowSpec
+ "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:HierarchicalProjectList andSelector:#windowSpec
+ HierarchicalProjectList new openInterface:#windowSpec
+ HierarchicalProjectList open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(#FullSpec
+ #name: #windowSpec
+ #window:
+ #(#WindowSpec
+ #label: 'ProjectList'
+ #name: 'ProjectList'
+ #min: #(#Point 0 0)
+ #max: #(#Point 1024 721)
+ #bounds: #(#Rectangle 12 22 312 322)
+ )
+ #component:
+ #(#SpecCollection
+ #collection: #(
+ #(#SelectionInTreeViewSpec
+ #name: 'List'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #model: #selectedProjectItems
+ #menu: #menuHolder
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #showRoot: false
+ #showDirectoryIndicator: true
+ #isMultiSelect: true
+ #valueChangeSelector: #selectionChangedByClick
+ #hierarchicalList: #hierarchicalProjectTree
+ #childrenSelector: #actionToRetrieveChildren
+ #highlightMode: #line
+ #doubleClickChannel: #doubleClickChannel
+ )
+ #(#HierarchicalListViewSpec
+ #name: 'HierarchicalListView1'
+ #layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
+ #tabable: true
+ #hasHorizontalScrollBar: true
+ #hasVerticalScrollBar: true
+ #miniScrollerHorizontal: true
+ #listModel: #hierarchicalProjectList
+ #multipleSelectOk: true
+ #highlightMode: #line
+ #doubleClickSelector: #doubleClicked:
+ #indicatorSelector: #indicatorPressed:
+ "/ #showLeftIndicators: false
+ )
+ )
+
+ )
+ )
+! !
+
+!HierarchicalProjectList 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
+ #organizerMode
+ #outGeneratorHolder
+ #selectedProjects
+ #selectionChangeCondition
+ #slaveMode
+ #updateTrigger
+ #showCoverageInformation
+ ).
+
+ "Modified: / 20-07-2011 / 14:29:26 / cg"
+! !
+
+!HierarchicalProjectList methodsFor:'aspects'!
+
+generateHierarchicalProjectTree
+ |anchor|
+
+ self projectList value isNil ifTrue:[
+ self updateList.
+ self projectList value isNil ifTrue:[
+ ^ nil.
+ ]
+ ].
+
+ anchor := ProjectItem new.
+ anchor package:''.
+ anchor label:nil.
+
+ packageToItemDictionary := IdentityDictionary new.
+ packageToItemDictionary at:'' asSymbol put:anchor.
+
+ self projectList value do:[:eachPackageString |
+ |package|
+
+ package := eachPackageString asSymbol.
+ (packageToItemDictionary includesKey:package) ifFalse:[
+ self addPackage:package
+ ].
+ ].
+
+"/ Smalltalk allClassesDo:[:eachClass |
+"/ |package|
+"/
+"/ package := eachClass package asSymbol.
+"/ (packageToItemDictionary includesKey:package) ifFalse:[
+"/ self addPackage:package
+"/ ].
+"/ ].
+ anchor recursiveSortChildren:[:i1 :i2 | i1 label asLowercase < i2 label asLowercase].
+ anchor expand.
+
+ ^ anchor
+!
+
+hierarchicalProjectList
+ |anchor |
+
+ hierarchicalProjectList isNil ifTrue:[
+ hierarchicalProjectList := HierarchicalList new.
+ hierarchicalProjectList showRoot:false.
+
+ (self slaveMode value ~~ true) ifTrue:[
+ anchor := self generateHierarchicalProjectTree.
+ hierarchicalProjectList root:anchor.
+ listValid := true
+ ] ifFalse:[
+ listValid := false
+ ]
+ ].
+ ^ hierarchicalProjectList
+!
+
+hierarchicalProjectSelection
+ hierarchicalProjectSelection isNil ifTrue:[
+ hierarchicalProjectSelection := #() asValue.
+ hierarchicalProjectSelection addDependent:self.
+ ].
+ ^ hierarchicalProjectSelection.
+!
+
+updateTreeSelection
+ "/ must expand items as required
+ |itemsToSelect oldSelection newSelection|
+
+ itemsToSelect := OrderedCollection new.
+
+ (self selectedProjects value ? #()) do:[:eachSelectedProject |
+ |item child|
+
+ item := hierarchicalProjectList root.
+ item notNil ifTrue:[
+ (eachSelectedProject asCollectionOfSubstringsSeparatedByAny:':/') do:[:part |
+ item expand.
+ child := item detect:[:child | child label = part] ifNone:nil.
+ child notNil ifTrue:[
+ item := child.
+ ].
+ ].
+ itemsToSelect add:child.
+ ].
+ ].
+ oldSelection := hierarchicalProjectSelection value.
+ newSelection := itemsToSelect collect:[:eachItem | hierarchicalProjectList identityIndexOf:eachItem].
+ oldSelection ~= newSelection ifTrue:[
+ hierarchicalProjectSelection value:newSelection.
+ ].
+
+ "Modified: / 17-08-2006 / 09:56:32 / cg"
+! !
+
+!HierarchicalProjectList 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.
+ ].
+
+"/ (self slaveMode value == true) ifTrue:[
+"/ super delayedUpdate:something with:aParameter from:changedObject.
+"/ ^ self
+"/ ].
+
+ changedObject == updateTrigger ifTrue:[
+ hierarchicalProjectList := nil.
+ self hierarchicalProjectList.
+ self updateTreeSelection.
+ ^ self
+ ].
+
+ changedObject == slaveMode ifTrue:[
+ listValid ~~ true ifTrue:[
+ self enqueueDelayedUpdateList
+ ].
+ "/ self invalidateList.
+ self updateTreeSelection.
+ ^ self
+ ].
+
+ changedObject == hierarchicalProjectSelection ifTrue:[
+ self updateSelectionFromTree.
+ ^ self
+ ].
+"/ changedObject == self selectedProjects ifTrue:[
+"/ "/ update the trees selection as appropriate
+"/ self updateTreeSelection.
+"/ ].
+ changedObject == projectList ifTrue:[
+ "/ update the tree
+ self hierarchicalProjectList root:(self generateHierarchicalProjectTree).
+ ^ self.
+ ].
+
+ super delayedUpdate:something with:aParameter from:changedObject
+
+ "Created: / 17.2.2000 / 23:41:02 / cg"
+ "Modified: / 26.2.2000 / 01:21:49 / cg"
+!
+
+enqueueDelayedAddPackage:package
+ (NewSystemBrowser synchronousUpdate == true
+ or:[ immediateUpdate value == true ])
+ ifTrue:[
+ self addPackage:package.
+ ^ self
+ ].
+ ^ self
+ enqueueMessage:#addPackage:
+ for:self
+ arguments:(Array with:package)
+!
+
+update:something with:aParameter from:changedObject
+ something == #methodTrap ifTrue:[
+ "/ dont care for that.
+ ^ self.
+ ].
+ changedObject == organizerMode ifTrue:[
+ "/ dont care for that.
+ ^ self.
+ ].
+ super update:something with:aParameter from:changedObject
+!
+
+updateSelectionFromTree
+ |treeSelection|
+
+ treeSelection := hierarchicalProjectSelection value
+ collect:[:eachIndex | |item|
+ item := hierarchicalProjectList at:eachIndex ifAbsent:nil.
+ item package
+ ].
+
+ treeSelection asSet ~= (self selectedProjects value ? #()) asSet ifTrue:[
+ self selectedProjects value:treeSelection.
+ ]
+! !
+
+!HierarchicalProjectList methodsFor:'private'!
+
+addPackage:package
+ |i p pp l parentPackage parentItem idx|
+
+ i:= packageToItemDictionary at:package asSymbol ifAbsent:nil.
+ i isNil ifTrue:[
+ i := ProjectItem new.
+ i package:package.
+ packageToItemDictionary at:package asSymbol put:i.
+
+ package size > 0 ifTrue:[
+ "/ find the parent ...
+ p := package asCollectionOfSubstringsSeparatedByAny:':/.'.
+ pp := p copyWithoutLast:1.
+ l := (pp asStringWith:$/) size.
+ parentPackage := package copyTo:l.
+
+ parentItem := self addPackage:parentPackage asSymbol .
+
+ parentPackage size == 0 ifTrue:[
+ idx := 1.
+ ] ifFalse:[
+ idx := parentPackage size + 2
+ ].
+ i label:(package copyFrom:idx).
+
+ parentItem add:i sortBlock:[:i1 :i2 | i1 label asLowercase < i2 label asLowercase].
+
+ "/ TODO: special items for classes, resources etc.
+
+ ]
+ ].
+ ^ i
+!
+
+release
+ super release.
+
+ hierarchicalProjectSelection removeDependent:self.
+! !
+
+!HierarchicalProjectList methodsFor:'user actions'!
+
+doubleClicked:anIndex
+ |item|
+
+ item := hierarchicalProjectList at:anIndex ifAbsent:nil.
+ item isNil ifTrue:[
+ ^ self
+ ].
+
+ (item canExpand not or:[item isExpanded]) ifTrue:[
+ doubleClickChannel notNil ifTrue:[
+ doubleClickChannel value:anIndex.
+ ].
+ ^ self
+ ].
+
+ item expand.
+!
+
+indicatorPressed:anIndex
+ |item sensor|
+
+ item := hierarchicalProjectList at:anIndex ifAbsent:nil.
+
+ item isNil ifTrue:[
+ ^ self
+ ].
+
+ sensor := self window sensor.
+ (sensor ctrlDown or:[sensor shiftDown]) ifTrue:[
+ item recursiveToggleExpand
+ ] ifFalse:[
+ item toggleExpand
+ ].
+! !
+
+!HierarchicalProjectList::ProjectItem methodsFor:'accessing'!
+
+children
+ children isNil ifTrue:[
+ children := #()
+ ].
+ ^ children
+!
+
+icon
+ ^ SystemBrowser packageIcon
+!
+
+label:aString
+ label ~= aString ifTrue:[
+ label := aString.
+ self changed:#label
+ ].
+!
+
+package
+ ^ packageID
+!
+
+package:prefixOrPackageID
+ packageID := prefixOrPackageID
+! !
+
+!HierarchicalProjectList class methodsFor:'documentation'!
+
+version
+ ^ '$Id: Tools__HierarchicalProjectList.st 7810 2011-08-12 14:54:02Z vranyj1 $'
+!
+
+version_CVS
+ ^ '§Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.10 2011/07/20 12:54:00 cg Exp §'
+! !
\ No newline at end of file