"
 COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
              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.
"



Model subclass:#SelectionInTree
	instanceVariableNames:'root list selection showRoot contentsAction labelAction
		childrenAction iconAction indicatorList indicatorTask accessLock'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Support-Models'
!

!SelectionInTree class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1997 by eXept Software AG / Claus Gittinger
              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
"
    list and selection holder for hierarchical list structures. Used
    to buildup file-trees, class tress etc.

    Especially suited for use with SelectionInTreeView.

    [See also:]
        TreeItem
        SelectionInTreeView

    [Author:]
        W. Olberding
        Claus Atzkern
"
! !

!SelectionInTree class methodsFor:'instance creation'!

new
    ^ super new initialize
! !

!SelectionInTree methodsFor:'accessing'!

list
    "get list oc currently shown objects
    "
    ^ list
!

root
    "get the root node
    "
    ^ root
!

root:aRoot
    "set a new root
    "
    root notNil ifTrue: [
        root tree: nil
    ].
    self stopRunningTasks.

    (root := aRoot) notNil ifTrue:[
        root parent:nil.
        root tree: self.
    ].
    self listFromRoot.
    self changed:#list.
!

value
    ^ list
! !

!SelectionInTree methodsFor:'accessing behavior'!

childrenAction
    "get children action block
    "
    ^childrenAction
!

childrenAction:aBlock
    "set children action block
    "
    childrenAction := aBlock.
!

contentsAction
    "get contents action block
    "
    ^contentsAction
!

contentsAction:aBlock
    "set contents action block
    "
    contentsAction := aBlock.
!

iconAction
    "get icon action block
    "
    ^iconAction
!

iconAction:aBlock
    "set icon action block
    "
    iconAction := aBlock.
!

labelAction
    "get label action block
    "
    ^labelAction
!

labelAction:aBlock
    "set label action block
    "
    labelAction := aBlock.
!

showRoot
    "list with or without root
    "
    ^ showRoot
!

showRoot:aState
    "list with or without root
    "
    aState ~~ showRoot ifTrue:[
        showRoot := aState.

        root notNil ifTrue:[
            aState ifTrue:[
                list addFirst:root.
                self changed:#insertCollection: with:(Array with:1 with:1 with:nil).
            ] ifFalse:[
                list removeFirst.
                self changed:#removeFrom: with:(Array with:1 with:1 with:nil).
            ].
        ].
    ].
! !

!SelectionInTree methodsFor:'accessing hierarchy'!

collapse:something 
    "collapse a node or collection of nodes
    "
    |listChanged|

    listChanged := false.

    self each:something do:[:aNode|
        aNode isCollapsable ifTrue:[
            aNode collapse.
            listChanged := true
        ]
    ].
    listChanged ifTrue:[
        self listFromRoot.
        self changed:#list.
    ]

!

expand
    "expand the root
    "
    self expand:root
!

expand:something 
    "expand a node or collection of nodes
    "
    |listChanged|

    listChanged := false.

    self each:something do:[:aNode|
        aNode isExpandable ifTrue:[
            aNode expand.
            listChanged := true
        ]
    ].
    listChanged ifTrue:[
        self listFromRoot.
        self changed:#list.
    ]
! !

!SelectionInTree methodsFor:'accessing hierarchy new'!

doCollapse:something
    "collapse all children under an item or a sequence of items;
     if the list changed, notifications are raised
    "
    self each:something do:[:anItem|
        self collapseItem:anItem do:[ anItem collapse ]
    ]
!

doCollapseAll:something
    "collapse all children and subChildren under an item or sequence of items;
     if the list changed, notifications are raised
    "
    self each:something do:[:anItem|
        self collapseItem:anItem do:[ anItem collapseAll ]
    ]
!

doExpand:something
    "expand all children under an item or collection of items;
     if the list changed, notifications are raised
    "
    self each:something do:[:anItem|
        self expandItem:anItem do:[anItem expand]
    ]
!

doExpandAll:something
    "expand all children and subChildren under an item or sequence of items;
     if the list changed, notifications are raised
    "
    self each:something do:[:anItem|
        self expandItem:anItem do:[anItem expandAll]
    ]
!

doMakeVisible:something
    "make an item or list of items to become visible
    "
    |anchor parent|

    self each:something do:[:anItem|
        parent := anItem.
        anchor := nil.

        [(parent := parent parent) notNil] whileTrue:[
            parent hidden ifTrue:[
                anchor notNil ifTrue:[ anchor expand ].
                anchor := parent.
            ]
        ].
        anchor notNil ifTrue:[
            self expandItem:anchor do:[anchor expand]
        ]
    ]
! !

!SelectionInTree methodsFor:'adding & removing'!

add:something after:aChild
    "add a node or collection of nodes to parent after a child
    "
    "add a node or collection of nodes to after a child
    "
    |p|

    (aChild notNil and:[(p := aChild parent) notNil]) ifTrue:[
        self add:something afterIndex:(p indexOfChild:aChild) below:p
    ]

!

add:something afterIndex:anIndex below:aParent
    "add a node or collection of nodes to parent after an index
    "
    self add:something beforeIndex:(anIndex + 1) below:aParent
!

add:something before:aChild
    "add a node or collection of nodes to before a child
    "
    |p|

    (aChild notNil and:[(p := aChild parent) notNil]) ifTrue:[
        self add:something beforeIndex:(p indexOfChild:aChild) below:p
    ]
!

add:something beforeIndex:anIndex below:aParent
    "add a node or collection of nodes to parent before an index
    "
    |children start index size pList|

    (    aParent isNil
     or:[something isNil
     or:[(something isCollection and:[something isEmpty])]]
    ) ifTrue:[
        ^ self
    ].

    (start := self indexOf:aParent) == 0 ifTrue:[
        "/
        "/ parent not visible; list not changed
        "/
        aParent add:something beforeIndex:anIndex.
        ^ self
    ].

    aParent shown ifFalse:[
        aParent add:something beforeIndex:anIndex.
        self changed:#at: with:start.
        ^ self
    ].
    children := aParent children.

    (children isEmpty or:[anIndex <= 1]) ifTrue:[
        index := 1.
    ] ifFalse:[
        size  := children size.

        anIndex > size ifTrue:[
            index := size + 1.
            start := aParent numberOfAllVisibleChildren + start.
        ] ifFalse:[
            index := anIndex.
            start := (self indexOf:(children at:index)) - 1.
        ]
    ].
    aParent add:something beforeIndex:index.

    (start := start + 1) == 0 ifTrue:[
        "/
        "/ not visible
        "/
        ^ self
    ].
    pList := OrderedCollection new:2048.

    self each:something do:[:aNode|
        pList add:aNode.
        aNode addVisibleChildrenTo:pList
    ].
    pList isEmpty ifTrue:[
        ^ self
    ].
    list addAll:pList beforeIndex:start.

    self changed:#insertCollection:
            with:(Array with:start with:pList size with:aParent).

!

add:something below:aParent
    "add a node or collection of nodes to parent
    "
    aParent notNil ifTrue:[
        self add:something beforeIndex:(aParent numberOfChildren + 1) below:aParent
    ]
!

remove:something
    "remove a node or collection of nodes
    "
    |node coll index loNums loItem start size parent stop|

    something isNil ifTrue:[
        ^ something
    ].
    loNums := SortedCollection new.

    self each:something do:[:el|
        node := el isNumber ifTrue:[list at:el ifAbsent:nil]
                           ifFalse:[el].

        node notNil ifTrue:[
            self stopIndicatorValidationFor:node.

            node parent isNil ifTrue:[
                "/ remove all including root
                node == root ifTrue:[ self root:nil ].
              ^ something
            ].
            index := self indexOf:node.

            index == 0 ifTrue:[
                "/ not visible
                node parent removeChild:node
            ] ifFalse:[
                loNums add:index
            ].
        ]
    ].

    loNums isEmpty ifTrue:[
        "/ nothing visible changed
        ^ something
    ].
    loItem := OrderedCollection new.
    loNums do:[:i| loItem add:(list at:i)].

    loItem do:[:aNode|
        start := self indexOf:aNode.

        start ~~ 0 ifTrue:[
            parent := aNode parent.
            size   := 1 + aNode numberOfAllVisibleChildren.
            stop   := start + size - 1.
            parent remove:aNode.
            list removeFromIndex:start toIndex:stop.

            self changed:#removeFrom:
                    with:(Array with:start with:stop with:parent).
        ]
    ].
    ^ something
!

removeAllOtherThanRoot
    "remove all other than the root
    "
    |listChanged|

    root notNil ifTrue:[
        listChanged := root isCollapsable.
        root children:(OrderedCollection new).

        listChanged ifTrue:[
            self listFromRoot.
            self changed:#list
        ]
    ]
!

removeIndex:something
    "remove a node at index or collection of indexed nodes
    "
    self remove:something
!

removeSelection
    "remove selected nodes
    "
    |sel|

    sel := self selectionIndex.
    self selectionIndex:nil.
    self remove:sel.
! !

!SelectionInTree methodsFor:'change & update'!

invalidate
    "called; something changed what requires a redraw but no recomputation.
     for example a name
    "
    self dependents do:[:aDependent|
        aDependent isView ifTrue:[ aDependent invalidate ]
    ].


!

update:something with:aParameter from:aModel

    self dependents do:[:aDependent|
        aDependent update:something with:aParameter from:aModel
    ]
! !

!SelectionInTree methodsFor:'enumerating'!

each:something do:aBlock
    "evaluate a block for something or in case of a collection for each
     element in the collection
    "
    something notNil ifTrue:[
        something isCollection ifTrue:[something do:[:el|aBlock value:el]]
                              ifFalse:[aBlock value:something]
    ]

! !

!SelectionInTree methodsFor:'initialization'!

initialize

    showRoot := true.
    indicatorList := OrderedCollection new.
    accessLock    := Semaphore forMutualExclusion.
    list          := OrderedCollection new:128.
    super initialize.

! !

!SelectionInTree methodsFor:'private'!

recomputeList
    "Travers the tree and build a new list."

    self listFromRoot.
    self changed:#list.
! !

!SelectionInTree methodsFor:'private hierarchy'!

collapseItem:anItem do:collapseBlock
    "collapse all children under an item; raise a notification if
     the list changed
    "
    |start stop size|

    anItem isCollapsable ifFalse:[
        ^ self
    ].

    (start := self indexOf:anItem) == 0 ifTrue:[
        "/
        "/ item not visible
        "/
        collapseBlock value.
    ] ifFalse:[
        size := anItem numberOfAllVisibleChildren.
        collapseBlock value.

        size == 0 ifTrue:[
            "/
            "/ no children before; list not changed 
            "/
            self changed:#at: with:start
        ] ifFalse:[        
            stop  := start + size.
            start := start + 1.
            list removeFromIndex:start toIndex:stop.
            self changed:#removeFrom: with:(Array with:start with:stop with:anItem).
        ]
    ]
!

expandItem:anItem do:expandBlock
    "expand all children under an item; raise a notification if
     the list changed
    "
    |start size pList|

    anItem isExpandable ifFalse:[
        ^ self
    ].
    expandBlock value.

    (start := self indexOf:anItem) ~~ 0 ifTrue:[
        anItem addVisibleChildrenTo:(pList := OrderedCollection new:2048).

        (size := pList size) ~~ 0 ifTrue:[
            start := 1 + start.
            list addAll:pList beforeIndex:start.

            self changed:#insertCollection:
                    with:(Array with:start with:size with:anItem).
        ] ifFalse:[
            self changed:#at: with:start
        ]
    ]
!

listFromRoot
    "Travers the tree and build a new list;
     no change notification is raised
    "
    list clearContents.

    root notNil ifTrue:[
        showRoot ifTrue:[ list add:root ].
        root addVisibleChildrenTo:list
    ]

! !

!SelectionInTree methodsFor:'queries'!

indexOf:anItem
    "returns the index of an item or 0
    "
    ^ anItem notNil ifTrue:[list identityIndexOf:anItem]
                   ifFalse:[0]
! !

!SelectionInTree methodsFor:'searching'!

detectItem:aOneArgBlock
    "detect an item the evaluation of the block returns true. The
     argument to the block is the item.
    "
    root notNil ifTrue:[
        ^ root detectChild:aOneArgBlock
    ].
    ^ nil


!

detectItem:aTwoArgBlock arguments:aListOfArgs
    "detect an item the evaluation of the block returns true. The
     first argument to the block is the item, the second argument
     the value derived from the argument list at an index
    "
    root notNil ifTrue:[
        ^ root detectChild:aTwoArgBlock arguments:aListOfArgs index:1
    ].
    ^ nil


! !

!SelectionInTree methodsFor:'selection'!

selectedNodes
    "returns list of selected nodes or nil
    "
    |node coll|

    selection isNil ifTrue:[
        ^ nil
    ].

    selection isCollection ifFalse:[
        node := list at:selection ifAbsent:nil.
      ^ node notNil ifTrue:[Array with:node] ifFalse:[nil]
    ].

    selection isEmpty ifTrue:[
        ^ nil
    ].

    coll := OrderedCollection new:(selection size).

    selection do:[:idx|
        (node := list at:idx ifAbsent:nil) notNil ifTrue:[
            coll add:node
        ]
    ].
    ^ coll notEmpty ifTrue:[coll] ifFalse:[nil]
        
!

selection
    "get the selection or nil
    "
    ^ self selectionIndex
!

selection:indexesOrNil
    "set the selection
    "
    self selectionIndex:indexesOrNil
!

selectionIndex
    "get the selection or nil
    "
    ^ selection
!

selectionIndex:indexesOrNil
    "set the selection
    "
    |oldSel|

    oldSel := selection.
    self setSelectionIndex:indexesOrNil.

    oldSel = selection ifFalse:[
        self changed:#selectionIndex
    ]
!

setSelection:indexesOrNil
    "set the selection without raising a notification
    "
    self setSelectionIndex:indexesOrNil
!

setSelectionIndex:indexesOrNil
    "set the selection without raising a notification
    "
    |indexes|

    indexes := indexesOrNil.

    indexes size == 0 ifTrue:[
        (indexes isCollection or:[indexes == 0]) ifTrue:[
            indexes := nil
        ]
    ].
    selection := indexes

! !

!SelectionInTree methodsFor:'update indication task'!

startIndicatorValidationFor:aNode
    "add a node to list of updating indications
    "
    |index|

    accessLock critical:[
        index := indicatorList identityIndexOf:aNode.

        index ~~ 0 ifTrue:[
            indicatorList removeIndex:index.    "/ reorganize list to be faster
        ].
        indicatorList addFirst:aNode.

        indicatorTask isNil ifTrue:[
            indicatorTask := [
                [ self taskCycle ] whileTrue:[ Processor yield ]
            ] forkAt:(Processor activePriority - 1)
        ]
    ].
!

stopIndicatorValidationFor:aNodeOrList
    "remove a node or list of nodes from list of updating indications
    "
    accessLock critical:[
        aNodeOrList isCollection ifTrue:[
            aNodeOrList do:[:aNode|
                indicatorList removeIdentical:aNode ifAbsent:nil
            ]
        ] ifFalse:[
            indicatorList removeIdentical:aNodeOrList ifAbsent:nil
        ]
    ]


!

stopRunningTasks
    "stop task
    "
    accessLock critical:[ indicatorList removeAll ]

!

taskCycle
    "run one cycle
    "
    |node|

    accessLock critical:[
        indicatorList isEmpty ifTrue:[          "/ queue is empty; terminate task
            indicatorTask := nil.
            ^ false
        ].
        node := indicatorList removeFirst.      "/ run task on first node

        node hasValidIndicator ifTrue:[         "/ up to date
            ^ true
        ].
        node setShowIndicator:false             "/ disable registry
    ].

    (DirectoryContents directoryNamed:(node fileName) detect:(node matchAction)) ifTrue:[
        node showIndicator:true
    ].
    ^ true
! !

!SelectionInTree class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTree.st,v 1.14 1998-04-16 10:59:19 ca Exp $'
! !