author | Claus Gittinger <cg@exept.de> |
Mon, 11 Sep 2017 09:08:06 +0200 | |
changeset 17686 | c6fc2da19287 |
parent 14020 | 6d318d3f52fd |
permissions | -rw-r--r-- |
" 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)." ^ #( environmentHolder #(#doubleClickChannel #action ) #forceGeneratorTrigger #hideUnloadedClasses #immediateUpdate #inGeneratorHolder #menuHolder #organizerMode #outGeneratorHolder #selectedProjects #selectionChangeCondition #slaveMode #updateTrigger #showCoverageInformation ). "Modified: / 20-07-2011 / 14:29:26 / cg" "Modified: / 24-02-2014 / 10:37:54 / Jan Vrany <jan.vrany@fit.cvut.cz>" ! ! !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 ]. ]. "/ environment 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:[ "/ don't care for that. ^ self. ]. changedObject == organizerMode ifTrue:[ "/ don't 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 copyButLast: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 ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.14 2014-02-25 10:40:58 vrany Exp $' ! version_CVS ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.14 2014-02-25 10:40:58 vrany Exp $' ! !