"
 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.
            self setListValid:true.
        ] ifFalse:[
            self setListValid: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.
            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.16 2014-11-19 21:41:12 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libtool/Tools__HierarchicalProjectList.st,v 1.16 2014-11-19 21:41:12 cg Exp $'
! !