"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

ProjectList subclass:#HierarchicalProjectList
	instanceVariableNames:'hierarchicalProjectTree selectedProjectItems packageIcon
		hierarchicalProjectList hierarchicalProjectSelection
		packageToItemDictionary'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Browsers-New'
!

!HierarchicalProjectList class methodsFor:'documentation'!

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)
	  #max: #(#Point 1024 721)
	  #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
      ).

! !

!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.

	(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.
    ].
! !

!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 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 class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/Tools_HierarchicalProjectList.st,v 1.2 2004-02-26 19:03:55 cg Exp $'
! !