"

 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.

"

"{ Package: 'stx:libwidg2' }"

Object subclass:#TreeItem

	instanceVariableNames:'name tree parent children contents hide readChildren'

	classVariableNames:'UnknownContents'

	poolDictionaries:''

	category:'Interface-Support'

!

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

"

    class to build up trees like structures to represent

    file-trees, class tress etc.

    Especially suited for use with SelectionInTree and

    SelectionInTreeView.

    [Author:]

        W. Olberding

        Claus Atzkern

    [See also:]

        SelectionInTree

        SelectionInTreeView

"

! !

!TreeItem class methodsFor:'instance creation'!

contents:aContents

    |node|

    node := self new.

    node contents:aContents.

  ^ node

!

name:aName

    ^ self name:aName contents:nil

!

name:aName contents:aContents

    |node|

    node := self new.

    node name:aName.

    node contents:aContents.

  ^ node

!

name:aName value:aContents

    ^ self name:aName contents:aContents

!

new

    ^ self basicNew initialize

! !

!TreeItem class methodsFor:'class initialization'!

initialize

    UnknownContents isNil ifTrue:[

        UnknownContents := Object new.

    ]

    "

     self initialize

    "

! !

!TreeItem class methodsFor:'default icons'!

keysAndIcons

    "returns an IdentityDictionary containing a list of images and keys used

     by any file entry; could be redefined by subclass

    "

    ^ nil

! !

!TreeItem class methodsFor:'example - instance creation'!

newAsTreeFromSmalltalkClass:aClass

    "create a tree of nodes with aClass and all its

     subclasses as contents. Set the initial level as given."

    |newInst clsName|

    aClass isNil ifTrue:[

        "/ nil subclasses requested

        clsName := 'nil'

    ] ifFalse:[

        "/ regular tree requested

        clsName := aClass name

    ].

    newInst := super new initialize.

    newInst name:clsName.

    aClass isNil ifTrue:[

        ((Smalltalk allClasses select:[:cls | cls superclass isNil])

            asSortedCollection:[:a :b | a name < b name])

        do:[:aSubClass |

            newInst add:(self newAsTreeFromSmalltalkClass:aSubClass).

        ]

    ] ifFalse:[

        (aClass subclasses asSortedCollection:[:a :b | a name < b name])

        do:[:aSubClass |

            newInst add:(self newAsTreeFromSmalltalkClass:aSubClass).

        ]

    ].

    ^newInst

"

      |top model sel root|

      root  := TreeItem newAsTreeFromSmalltalkClass:ByteArray.

      root expand.

      model := SelectionInTree new root:root.

      top := StandardSystemView new.

      top extent:300@300.

      sel := SelectionInTreeView new.

      sel model: model.

      sel action:[:nr | Transcript show:'selected:'; showCR:nr].

      top add:(ScrollableView forView:sel) in:((0.0 @ 0.0 ) corner:( 1.0 @ 1.0)).

      top open.

"

! !

!TreeItem methodsFor:'accessing'!

contents

    "get the contents; 

     usually, the contents is computed lazily i.e. #retrieveContents

     is invoked when the contents has not yet been set.

    "

    contents == UnknownContents ifTrue:[        

        self retrieveContents

    ].

    ^contents

!

contents:something 

    "set contents

    "

    contents := something

!

editor

    "returns an editor on the editable value or nil

    "

    ^ nil

!

hide

    ^ hide

!

hide:aBoolean

   "set hide flag

   "    

   hide:= aBoolean

!

icon

    "get the icon

    "        

    ^self retrieveAndEvaluate: #iconAction

!

level

    "get level

    "

    |p

     lv "{ Class:SmallInteger }"

    |

    lv := 1.

    p  := self.

    [ (p := p parent) notNil ] whileTrue:[ lv := lv + 1 ].

    ^ lv

!

middleButtonMenu

    "returns the middleButtonMenu of the item or nil

    "

    ^ nil

!

name

    "get name

    "   

    name isNil ifTrue:[    

        self retrieveLabel

    ].

    ^name

!

name:aString

    "set name

    "      

    name := aString.

!

parent

    "get parent

    "

    ^ parent

!

parent:something

    "set parent

    "

    parent := something.

!

value

    "get contents

    "

    ^ self contents

!

value:something 

    "set contents

    "

    self contents:something

! !

!TreeItem methodsFor:'accessing-children'!

basicLastChild

    "returns the last child without checking for valid sequence

    "

    ^ children last

!

children

    "get list of children

    "

    (readChildren and:[children isEmpty]) ifTrue:[       

        self retrieveChildren

    ].

    ^children

!

children:aCollection 

    "set children

    "

    aCollection isNil ifTrue:[

        children removeAll

    ] ifFalse:[

        aCollection notNil ifTrue:[

            aCollection do:[:child| child parent:self ].

            readChildren := false

        ].

        children := aCollection

    ]

!

firstChild

    "returns first child in sequence

    "

    self children notEmpty ifTrue:[

        ^ children at:1

    ].

    ^ nil

!

lastChild

    "returns last child in sequence

    "

    self children notEmpty ifTrue:[

        ^ children last

    ].

    ^ nil

!

readChildren:aBoolean

   "set read children flag

   "    

   readChildren:= aBoolean

! !

!TreeItem methodsFor:'accessing-dimensions'!

childrenWidthOn:aDevice

    "returns the maximum name length of my children

    "

    |max name|

    max := 0.

    children do:[:aChild|

        (name := aChild name) notNil ifTrue:[

            max := max max:(name widthOn:aDevice)

        ]

    ].

    ^ max

! !

!TreeItem methodsFor:'accessing-hierarchy'!

collapse 

    "hide all my children

    "

    hide := true

!

collapseAll 

    "hide all my children and sub children

    "

    hide := true.

    children notEmpty ifTrue:[

        children do:[:aChild| aChild collapseAll]

    ]

!

expand

    "show all my children

    "

    hide := false

!

expandAll 

    "show all my children and sub children

    "

    hide := false.

    self children notEmpty ifTrue:[

        children do:[:aChild| aChild expandAll ]

    ]

! !

!TreeItem methodsFor:'accessing-model'!

model

    "get my model (an instance of selection in tree) or nil

    "    

    ^ parent notNil ifTrue:[parent model] ifFalse:[tree]

!

model:aSelectionInTree

    "set my model (an instance of selection in tree) or nil

    "    

    tree:= aSelectionInTree

!

tree

    "get my model (an instance of selection in tree) or nil

    "    

    ^ self model

!

tree:aSelectionInTree

    "set my model (an instance of selection in tree) or nil

    "    

    self model:aSelectionInTree

! !

!TreeItem methodsFor:'adding & removing'!

add:something

    "add a child or collection of children add end

    "

    self add:something beforeIndex:(self children size + 1)

!

add:something after:aChild

    "add a child or collection of children add end

    "

    self add:something afterIndex:(self indexOfChild:aChild)

!

add:something afterIndex:anIndex

    "add a child or collection after an index

    "

    self add:something beforeIndex:(anIndex + 1)

!

add:something before:aChild

    "add a child or collection of children add end

    "

    self add:something beforeIndex:(self indexOfChild:aChild)

!

add:something beforeIndex:anIndex

    "add a child or collection before an index

    "

    |idx children|

    children := self children.

    (idx := anIndex) > children size ifTrue:[

        idx := children size + 1

    ] ifFalse:[

        idx == 0 ifTrue:[idx := 1]

    ].

    self each:something do:[:el|

        children add:el beforeIndex:idx.

        el parent:self.

        el allWithParentAndChildrenDo:[:aParent :aChild| aChild parent:aParent ].

        idx := idx + 1.

    ]

!

addFirst: something

    "add a child at the beginning

    "

    self add:something beforeIndex:1

!

remove:something 

    "remove a child or collection of children

    "

    self each:something do:[:aChild| self removeChild:aChild ].

  ^ something

!

removeAll

    "remove all children

    "

    self childrenDo:[:aChild| aChild parent:nil ].

    self children removeAll.

!

removeChild:aChild

    "remove a aChild

    "

    |item|

    (item := self children remove:aChild ifAbsent:nil) notNil ifTrue:[

        item parent:nil

    ].

    ^ item

!

removeIndex:anIndex

    "remove child at index

    "

    ^ self removeChild:(self childAt:anIndex)

! !

!TreeItem methodsFor:'change & update'!

changed

    "node changed; raise notification to model

    "

    self changed:#value

!

changed:what

    "node changed; raise notification to model

    "

    |model|

    what == #value 

        ifTrue:  [self retrieveLabel]

        ifFalse: [what == #children ifTrue: [self retrieveChildren]].