"{ Encoding: utf8 }"

"
 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)."

    ^ #(
        environmentHolder
        #(#doubleClickChannel #action )
        #forceGeneratorTrigger
        #hideUnloadedClasses
        #immediateUpdate
        #inGeneratorHolder
        #menuHolder
        #nameSpaceFilter
        #organizerMode
        #outGeneratorHolder
        #packageFilter
        #selectedCategories
        #selectionChangeCondition
        #slaveMode
        #updateTrigger
        #showCoverageInformation
      ).

    "Modified: / 20-07-2011 / 14:29:15 / cg"
    "Modified: / 24-02-2014 / 10:38:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!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 copyButLast.
            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 ? '* no category *') asLowercase 
                < (i2 category ? '* no category *') asLowercase
        ].
    anchor expand.

    ^ anchor

    "Modified: / 03-03-2019 / 22:32:53 / Claus Gittinger"
!

hierarchicalCategoryList
    |anchor |

    hierarchicalCategoryList isNil ifTrue:[
        hierarchicalCategoryList := HierarchicalList new.
        hierarchicalCategoryList showRoot:false.

        (self slaveMode value ~~ true) ifTrue:[
            anchor := self generateHierarchicalCategoryTree.
            hierarchicalCategoryList root:anchor.
            self setListValid:true.
        ] ifFalse:[
            self setListValid: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
    ^ '$Header$'
!

version_CVS
    ^ '$Header$'
! !