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




Object subclass:#TreeItem
	instanceVariableNames:'name tree parent children contents hide readChildren'
	classVariableNames:''
	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:'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'!

children
    "get list of children
    "
    (readChildren and:[children isEmpty]) ifTrue:[       
        self retrieveChildren
    ].
    ^children
!

children:aCollection 
    "set children
    "     
    aCollection do:[:child| child parent:self ].
    aCollection isCollection ifTrue: [readChildren := false].
    children := aCollection.
!

contents
    "get contents
    "
    contents isNil ifTrue:[        
        self retrieveContents
    ].
    ^contents
!

contents:something 
    "set contents
    "
    contents:= something
!

firstChild
    "returns first child in sequence
    "
    self children notEmpty ifTrue:[
        ^ self children at:1
    ].
    ^ nil
        
!

hide
    ^ hide
!

hide:aBoolean
   "set hide flag
   "    
   hide:= aBoolean
!

icon
    "get the icon
    "        
    ^self retrieveAndEvaluate: #iconAction
    
!

lastChild
    "returns last child in sequence
    "
    self children notEmpty ifTrue:[
        ^ self children last
    ].
    ^ nil
        
!

level
    "get level
    "
    |p
     lv "{ Class:SmallInteger }"
    |
    lv := 1.
    p  := self.

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

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

readChildren:aBoolean
   "set read children flag
   "    
   readChildren:= aBoolean
!

value
    "get contents
    "
    ^ self contents
!

value:something 
    "set contents
    "
    self contents:something
! !

!TreeItem methodsFor:'accessing hierarchy'!

childAt:anIndex
    "get child at an index or nil
    "
  ^ self children at:anIndex ifAbsent:nil
!

collapse 
    "hide all my children
    "
    hide := true
!

collapseAll 
    "hide all my children and sub children
    "
    hide ifFalse:[
        hide := true.
        self allChildrenDo:[:aChild| aChild hide:true].
    ]
!

collapseAllChildren 
    "hide all my sub children
    "
    hide ifFalse:[
        children notEmpty ifTrue:[ children do:[:c| c collapseAll] ]
    ]
!

expand
    "show all my children
    "
    hide := false
!

expandAll 
    "show all my children and sub children
    "
    hide ifTrue:[
        hide := false.
        self allChildrenDo:[:aChild| aChild hide:false].
    ]
!

expandAllChildren
    "show all my children and sub children
    "
    hide := false.
    self allChildrenDo:[: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)
!

removeIndex:anIndex
    "remove child at index
    "
    self remove:(self childAt:anIndex)
! !

!TreeItem methodsFor:'adding & removing basics'!

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.
    ]
!

remove:something 
    "remove a child or collection of children
    "
    |children|

    children := self children.

    self each:something do:[:aChild|
        aChild parent:nil.
        children remove:aChild.
    ].
  ^ something
!

removeAll
    "remove all children
    "
    self childrenDo:[:aChild| aChild parent:nil ].
    self children removeAll.
! !

!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 retrieveAll]
        ifFalse: [what == #children ifTrue: [self retrieveChildren]].

    (model := self model) notNil ifTrue:[
        model update:what with:nil from:self
    ]
!

update:something with:aParameter from:anItem
    "raise change notification to my model
    "
    |m|

    (m := self model) notNil ifTrue:[
        m update:something with:aParameter from:anItem
    ]
! !

!TreeItem methodsFor:'converting'!

fromLiteralArrayEncoding:aLiteralEncodedArray
    "read my contents from a aLiteralEncodedArray.
    "
    |narg|

    (     (aLiteralEncodedArray size > 0)
     and:[(name := aLiteralEncodedArray at:1) isString]) ifFalse:[
        ^ nil
    ].
    narg := aLiteralEncodedArray at:2 ifAbsent:nil.

    name isSymbol ifTrue:[
        (narg isArray and:[aLiteralEncodedArray size == 2]) ifTrue:[
            ^ self fromLiteralArrayEncoding:narg
        ].
        ^ nil
    ].

    narg isArray ifFalse:[
        contents := narg.
        narg := aLiteralEncodedArray at:3 ifAbsent:nil.
    ].

    narg isArray ifTrue:[
        children := OrderedCollection new.

        narg do:[:aSubArray||aChild|
            children add:(aChild := TreeItem new).
            aChild fromLiteralArrayEncoding:aSubArray.
            aChild parent:self.
        ]
    ]



!

literalArrayEncoding
    "return myself encoded as a literal array
    "
    |array childs size noChld|

    contents isString ifTrue:[size := 2]
                     ifFalse:[size := 1].

    noChld := self numberOfChildren.

    noChld == 0 ifTrue:[
        array := Array new:size
    ] ifFalse:[
        array  := Array new:size + 1.
        childs := Array new:noChld.
        array at:(size + 1) put:childs.

        self children keysAndValuesDo:[:i :aChild|
            childs at:i put:(aChild literalArrayEncoding)
        ]
    ].
    array at:1 put:(name ? '').

    contents isString ifTrue:[
        array at:2 put:contents
    ].
    parent isNil ifTrue:[
        array := Array with:#TreeItem with:array.
    ].
    ^ array


! !

!TreeItem methodsFor:'copy'!

copy
    |node|

    node := self species new.

    node name:(name copy).
    node contents:(contents copy).
    node children:(self children collect:[:c| c copy]).
    node readChildren:readChildren.
  ^ node
! !

!TreeItem methodsFor:'enumerating'!

allChildrenDo:aOneArgBlock
    "evaluate a block on each children and subchildren
    "
    self children do:[:aChild|
        aOneArgBlock value:aChild.
        aChild allChildrenDo:aOneArgBlock
    ]
!

allWithParentAndChildrenDo:aTwoArgBlock
    self childrenDo:[:aChild|
        aTwoArgBlock value:self value:aChild.
        aChild allWithParentAndChildrenDo:aTwoArgBlock
    ]
!

childrenDo:aOneArgBlock
    "evaluate a block on each children( excluding  sub-children )
    "
    self children do:[:aChild| aOneArgBlock value:aChild ]
!

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]
    ]

! !

!TreeItem methodsFor:'initialize-release'!

initialize
    "setup defaults
    "
    super initialize.

    children := OrderedCollection new.
    readChildren := hide := true.
! !

!TreeItem methodsFor:'queries'!

hasChildren
    "returns true if any child exists
    "
    ^ self children notEmpty
!

hasChildrenWithSubChildren
    "returns true if any child exists and has children too
    "
    self children do:[:aChild|
        aChild hasChildren ifTrue:[^ true].
    ].
    ^ false

!

hasExpandedChildren
    "returns true if any of my children is expanded
    "
    children notEmpty ifTrue:[
        children do:[:aChild| aChild hidden ifFalse:[^ true] ]
    ].
    ^ false
!

hidden
    "returns true if node is not visible
    "
    ^ hide
!

isCollapsable
    "is collabsable; children existing and shown
    "
    ^ (self hasChildren and:[hide == false])
!

isContainedByParent:aParent
    "returns true if contained in subtree of a parent
    "
    |p|

    p := parent.

    [p notNil] whileTrue:[
        p == aParent ifTrue:[^ true ].
        p := p parent
    ].
    ^ false
!

isExpandable
    "is expandable; children existing and hidden
    "
    ^ (self hasChildren and:[hide == true])

!

numberOfChildren
    "returns number of children
    "
    ^ self children size
!

recomputeList:aList
    "add all shown children and its shown sub children into
     a list
    "  
    hide ifFalse:[
        self childrenDo:[:aChild|  
            aList add:aChild.
            aChild recomputeList:aList
        ]
    ]
!

showIndicator
    "returns true if children exists
    "
    ^ self hasChildren
!

shown
    "returns true if node is visible
    "
    ^ hide not
! !

!TreeItem methodsFor:'retrieving'!

childrenAction
    "get children action block
    "
    |m|

    ^ (m := self model) notNil ifTrue:[m childrenAction] ifFalse:[nil]
!

contentsAction
    "get contents action block
    "
    |m|

    ^ (m := self model) notNil ifTrue:[m contentsAction] ifFalse:[nil]
!

iconAction
    "get icon action block
    "
    |m|

    ^ (m := self model) notNil ifTrue:[m iconAction] ifFalse:[nil]
!

labelAction
    "get label action block
    "
    |m|

    ^ (m := self model) notNil ifTrue:[m labelAction] ifFalse:[nil]
!

retrieveAll
    "retrieve all values from model
    "
    self "retrieveContents;" retrieveLabel; retrieveChildren
!

retrieveAndEvaluate: aBlockSymbol
    "retrieve a specific value from model; if no model exists nil is returned
    "
    |arg model numArgs|

    (model := self model) isNil ifTrue:[
        ^ nil
    ].
    arg := model perform:aBlockSymbol.

    arg isBlock ifFalse:[
        ^ arg value
    ].

    numArgs := arg numArgs.
    numArgs == 0 ifTrue:[^ arg value].
    numArgs == 1 ifTrue:[^ arg value:self].
    self error:'invalid arguments for value'.
    ^ nil
!

retrieveChildren
    "retrieve children from model
    "
    |retChildren cls|

    retChildren := self retrieveAndEvaluate:#childrenAction.

    retChildren notNil ifTrue:[
        retChildren isCollection ifFalse: [retChildren := OrderedCollection with:retChildren].
        cls := self class.

        self children: (retChildren collect: 
        [:obj|      
            (obj isKindOf:cls) ifTrue:[obj]
                              ifFalse:[cls new contents:obj]       
        ]). 
        readChildren := false.
    ].     

    ^ children
!

retrieveContents
    "retrieve contents value from model;
    "
    |cont|

    (cont := self retrieveAndEvaluate: #contentsAction) isNil ifTrue:[
        cont := contents ? ''
    ].
    ^ contents := cont
!

retrieveLabel
    "retrieve label from model
    "
    |n|

    (n := self retrieveAndEvaluate:#labelAction) isNil ifTrue:[
        n := name ? ''
    ].
    ^ name := n
! !

!TreeItem methodsFor:'searching'!

detectChild:aOneArgBlock
    "evaluate the block on each child; returns the child's node
     or nil
    "
    ^ self children detect:aOneArgBlock ifNone:nil

!

indexOfChild:aChild
    "get index of a child or 0
    "
    ^ aChild notNil ifTrue:[self children identityIndexOf:aChild]
                   ifFalse:[0]
! !

!TreeItem class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libwidg2/TreeItem.st,v 1.17 1998-04-03 08:39:40 ca Exp $'
! !