"

 COPYRIGHT (c) 1999 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:libwidg2' }"

Object subclass:#HierarchicalItem

	instanceVariableNames:'parent children isExpanded height width'

	classVariableNames:''

	poolDictionaries:''

	category:'Views-Support'

!

HierarchicalItem subclass:#Example

	instanceVariableNames:'label icon'

	classVariableNames:'PenguinIcon'

	poolDictionaries:''

	privateIn:HierarchicalItem

!

!HierarchicalItem class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1999 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

"

    Hierarchical Items are mostly like Models, but the list of

    dependencies are kept by its HierarchicalList.

    The class is used to build up hierarchical trees.

    [Instance variables:]

        parent      <Item, List or nil>         parent or my HierarchicalList.

        children    <Collection or nil>         list of children

        isExpanded  <Boolean>                   indicates whether the item is

                                                expanded or collapsed

    [author:]

        Claus Atzkern

    [see also:]

        HierarchicalList

        HierarchicalListView

"

! !

!HierarchicalItem class methodsFor:'instance creation'!

new

    ^ (self basicNew) initialize

!

parent:aParent

    |item|

    item := self new.

    item parent:aParent.

  ^ item

! !

!HierarchicalItem class methodsFor:'protocol'!

doResetExtentOnChange

    "true: the extent of the item is reset if a change

     notification is raised from the item. the default is true

    "

    ^ true

! !

!HierarchicalItem methodsFor:'accessing'!

getChildren

    "returns the children at it is; not going to the model ...

    "

    ^ children

!

level

    "returns the level starting with 1

    "

    |parent

     level "{ Class:SmallInteger }"

    |

    level  := 0.

    parent := self.

    [(parent := parent parentOrModel) notNil] whileTrue:[

        level := level + 1

    ].

    ^ level

!

parent

    "returns the parent or nil

    "

    ^ (parent notNil and:[parent isHierarchicalItem]) ifTrue:[parent]

                                                     ifFalse:[nil]

!

parent:aParent

    "set the parent (or the model if the item is the root item)

    "

    parent := aParent

!

rootItem

    "returns the root item

    "

    parent isHierarchicalItem ifTrue:[

        ^ parent rootItem

    ].

    ^ self

! !

!HierarchicalItem methodsFor:'accessing-children'!

at:anIndex

    "return the child at anIndex if valid;

     if the index is invalid, nil is returned

    "

    ^ self at:anIndex ifAbsent:nil

!

at:anIndex ifAbsent:exceptionBlock

    "return the child at anIndex if valid; if the index is

     invalid, the result of evaluating the exceptionBlock is returned.

    "

    |list|

    (list := self children) notNil ifTrue:[

        ^ list at:anIndex ifAbsent:exceptionBlock

    ].

    ^ exceptionBlock value

!

at:anIndex put:anItem

    "replace a child by a new item

    "

    |children oldItem visIndex model expFlag|

    anItem isNil ifTrue:[

        ^ self removeFromIndex:anIndex toIndex:anIndex.

    ].

    anItem parent:self.

    (model := self model) isNil ifTrue:[

        ^ self children at:anIndex put:anItem

    ].

    model criticalDo:[

        children := self children.

        oldItem  := children at:anIndex.

        oldItem isExpanded ifTrue:[

            oldItem collapse

        ].

        visIndex := model identityIndexOf:oldItem.

        expFlag  := anItem isExpanded.

        anItem setExpanded:false.

        children at:anIndex put:anItem.

        visIndex ~~ 0 ifTrue:[

            model at:visIndex put:anItem.

        ].

        self changed:#redraw.

        expFlag ifTrue:[ anItem expand ].

    ].

    ^ anItem

!

children:aListOfChildren

    "set a new list of children

    "

    self criticalDo:[

        self removeAll.

        self addAll:aListOfChildren beforeIndex:1

    ].

    ^ aListOfChildren

!

first

    "returns the first child

    "

    ^ self at:1

!

last

    "returns the last child

    "

    ^ self at:(self size)

!

second

    "returns the second child

    "

    ^ self at:2

! !

!HierarchicalItem methodsFor:'accessing-hierarchy'!

collapse

    "hide all my subitems

    "

    |visChd index|

    self canCollapse ifTrue:[

        isExpanded := false.

        self criticalDo:[

            (index := self listIndex) notNil ifTrue:[

                "/ do not call :#size: children will be autoloaded !!!!

                (visChd := children size) ~~ 0 ifTrue:[

                    self nonCriticalFrom:1 to:nil do:[:el|

                        visChd := visChd + el numberOfVisibleChildren

                    ].

                    self model itemRemoveFromIndex:(index + 1) toIndex:(index + visChd).

                ].

                index ~~ 0 ifTrue:[ self hierarchyChanged ]

            ]

        ]

    ]

!

expand

    "expand children

    "

    |index list|

    "/ test whether the item already is expanded; #canExpand could be redefined

    "/ without checking whether the node is expanded (happens already) !!

    isExpanded == true ifTrue:[ ^ self ].

    self canExpand    ifFalse:[ ^ self ].

    self criticalDo:[

        (index := self listIndex) notNil ifTrue:[

            "/ must set expand-flag to false, otherwise change notifications

            "/ are raised durring lazy auto creation (to the list).

            isExpanded := false.

            list := self children.

            isExpanded := true.

            list notNil ifTrue:[

                list notEmpty ifTrue:[

                    list := OrderedCollection new:64.

                    self addVisibleChildrenTo:list.

                    self model itemAddAll:list beforeIndex:(index + 1).

                ]

            ].

            index ~~ 0 ifTrue:[self hierarchyChanged].

        ] ifFalse:[

            isExpanded := true

        ]

    ].

!

makeVisible

    "expand all my parents

    "

    (parent notNil and:[parent isHierarchicalItem]) ifTrue:[

        self criticalDo:[

            parent expand.

            parent makeVisible

        ]

    ].

!

recursiveCollapse

    "collapse all item and sub items

     **** must be expanded

    "

    |visChd index|

    self canCollapse ifTrue:[

        self criticalDo:[

            (index := self listIndex) notNil ifTrue:[

                "/ do not call :#size: children will be autoloaded !!!!

                (visChd := children size) ~~ 0 ifTrue:[

                    self nonCriticalFrom:1 to:nil do:[:el|

                        visChd := visChd + el numberOfVisibleChildren

                    ].

                ].

                self recursiveSetCollapsed.

                visChd ~~ 0 ifTrue:[

                    self model itemRemoveFromIndex:(index + 1)

                                           toIndex:(index + visChd)

                ].

                index ~~ 0 ifTrue:[

                    self hierarchyChanged

                ]

            ] ifFalse:[

                self recursiveSetCollapsed

            ]

        ]

    ]

!

recursiveExpand

    "expand children and sub-children

     **** must be collapsed

    "

    |index list|

    "/ test whether the item already is expanded; #canExpand could be redefined

    "/ without checking whether the node is expanded (happens already) !!

    isExpanded == true ifTrue:[ ^ self ].

    self canExpand    ifFalse:[ ^ self ].

    isExpanded := true.

    self criticalDo:[

        self size ~~ 0 ifTrue:[

            index := self listIndex.    "/ get the visible list index

            index isNil ifTrue:[        "/ not visible

                self nonCriticalFrom:1 to:nil do:[:el|

                    el setExpanded:true

                ].

            ] ifFalse:[

                list := OrderedCollection new:512.

                self recursiveSetExpandedAndAddToList:list.

                self model itemAddAll:list beforeIndex:(index + 1).

                index ~~ 0 ifTrue:[self hierarchyChanged]

            ]

        ]

    ].

!

recursiveToggleExpand

    "if the item is collapsed, the item and all its sub-items

     are expanded otherwise collapsed

    "

    isExpanded == true ifTrue:[

        self recursiveCollapse

    ] ifFalse:[

        self recursiveExpand

    ]

!

toggleExpand

    "if the item is collapsed, the item is expanded otherwise

     collapsed.

    "

    isExpanded == true ifTrue:[

        self collapse

    ] ifFalse:[

        self expand

    ].

! !

!HierarchicalItem methodsFor:'accessing-mvc'!

application

    "returns the responsible application or nil

    "

    |model|

    (model := self model) notNil ifTrue:[

        ^ model application

    ].

    ^ nil

!

applicationsDo:aOneArgBlock

    "evaluate the block on each dependent application

    "

    |model|

    (model := self model) notNil ifTrue:[

        model applicationsDo:aOneArgBlock

    ]

!

model

    "returns the hierachicalList model or nil

    "

    |p model|

    model := self.

    [(p := model parentOrModel) notNil] whileTrue:[model := p].

  ^ model isHierarchicalItem ifFalse:[model] ifTrue:[nil]

! !

!HierarchicalItem methodsFor:'adding & removing'!

add:aChildItem

    "add a child at end

    "

    ^ self add:aChildItem beforeIndex:(self children size + 1).

!

add:aChildItem after:aChild

    "add an item after an existing item

    "

    |index|

    index := self identityIndexOf:aChild.

    index == 0 ifTrue:[ self subscriptBoundsError ].

    self add:aChildItem beforeIndex:(index + 1).

  ^ aChildItem

!

add:aChildItem afterIndex:anIndex

    "add an item after an index

    "

    ^ self add:aChildItem beforeIndex:(anIndex + 1).

!

add:aChildItem before:aChild

    "add an item before an existing item

    "

    |index|

    index := self identityIndexOf:aChild.

    index == 0 ifTrue:[ self subscriptBoundsError ].

    self add:aChildItem beforeIndex:index.

  ^ aChild

!

add:aChildItem beforeIndex:anIndex

    "add an item before an index

    "

    aChildItem notNil ifTrue:[

        self addAll:(Array with:aChildItem) beforeIndex:anIndex

    ].

    ^ aChildItem

!

add:aChild sortBlock:aBlock

    "add a child sorted

    "

    self criticalDo:[

        self basicAdd:aChild sortBlock:aBlock

    ].

    ^ aChild

!

addAll:aList

    "add children at the end

    "

    ^ self addAll:aList beforeIndex:(self children size + 1)

!

addAll:aList before:aChild

    "add an item before an existing item

    "

    |index|

    index := self identityIndexOf:aChild.

    index == 0 ifTrue:[ self subscriptBoundsError ].

  ^ self addAll:aList beforeIndex:index

!

addAll:aList beforeIndex:anIndex

    "add children before an index

    "

    aList size ~~ 0 ifTrue:[

        self criticalDo:[

            self basicAddAll:aList beforeIndex:anIndex

        ]

    ].

    ^ aList

!

addAll:aList sortBlock:aBlock

    "add children sorted

    "