Object subclass:#HierarchicalItem
instanceVariableNames:'parent children isExpanded'
classVariableNames:''
poolDictionaries:''
category:'AAA-Model'
!
HierarchicalItem subclass:#Example
instanceVariableNames:'label icon'
classVariableNames:'PenguinIcon'
poolDictionaries:''
privateIn:HierarchicalItem
!
!HierarchicalItem class methodsFor:'documentation'!
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
! !
!HierarchicalItem methodsFor:'accessing'!
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
! !
!HierarchicalItem methodsFor:'accessing children'!
at:anIndex
"returns the child under an index or nil
"
^ self children notNil ifTrue:[children at:anIndex ifAbsent:nil]
ifFalse:[nil]
!
at:anIndex put:anItem
"replace a child by a new item
"
|oldItem itemExpanded size|
size := self children size.
(anIndex between:1 and:size) ifFalse:[
^ self subscriptBoundsError
].
anItem isNil ifTrue:[
^ self removeFromIndex:anIndex toIndex:anIndex.
].
oldItem := children at:anIndex.
oldItem collapse.
itemExpanded := anItem isExpanded.
anItem setExpanded:false.
children at:anIndex put:anItem.
self changed.
itemExpanded ifTrue:[
anItem expand
].
!
children:aListOfChildren
"set a new list of children
"
self removeAll.
^ self addAll:aListOfChildren beforeIndex:1
!
first
"returns the first child
"
^ self at:1
!
last
"returns the last child
"
^ self at:(self children size)
! !
!HierarchicalItem methodsFor:'accessing hierarchy'!
collapse
"hide children
"
|visChd model index|
self canCollapse ifTrue:[
isExpanded := false.
(index := self listIndex) notNil ifTrue:[
(visChd := children size) ~~ 0 ifTrue:[
children do:[:aChild|
visChd := visChd + aChild numberOfVisibleChildren
].
self model itemRemoveFromIndex:(index + 1)
toIndex:(index + visChd).
index ~~ 0 ifTrue:[
self hierarchyChanged
]
]
]
]
!
expand
"expand children
"
|index list|
self canExpand ifTrue:[
isExpanded := true.
(index := self listIndex) notNil ifTrue:[
(children notNil or:[self children notNil]) ifTrue:[
children notEmpty ifTrue:[
list := OrderedCollection new:64.
self addVisibleChildrenTo:list.
self model itemAddAll:list beforeIndex:(index + 1).
].
index ~~ 0 ifTrue:[
self hierarchyChanged
]
]
]
]
!
recursiveCollapse
"collapse children and sub-children
**** must be expanded
"
|visChd index|
self canCollapse ifTrue:[
(index := self listIndex) notNil ifTrue:[
(visChd := children size) ~~ 0 ifTrue:[
children do:[:aChild|
visChd := visChd + aChild 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
"
|model index list|
self canExpand ifTrue:[
isExpanded := true.
self children size ~~ 0 ifTrue:[
(index := self listIndex) isNil ifTrue:[
children do:[:aChild| aChild 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 children and all sub-children
are expanded otherwise collapsed
"
isExpanded ifTrue:[self recursiveCollapse] ifFalse:[self recursiveExpand]
!
toggleExpand
"if the item is collapsed, the children are expanded
otherwise collapsed
"
isExpanded 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 listIndex) isNil ifTrue:[
self subscriptBoundsError
] ifFalse:[
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) ~~ 0 ifTrue:[
^ self add:aChildItem beforeIndex:index
].
self subscriptBoundsError
!
add:aChildItem beforeIndex:anIndex
"add an item before an index
"
aChildItem notNil ifTrue:[
self addAll:(Array with:aChildItem) beforeIndex:anIndex
].
^ aChildItem
!
addAll:aList
"add children at the end
"
^ self addAll:aList beforeIndex:(self children size + 1)
!
addAll:aList beforeIndex:anIndex
"add children before an index
"
|coll model notify
index "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
|
(aList isNil or:[aList isEmpty]) ifTrue:[
^ aList
].
size := self children size.
anIndex == 1 ifTrue:[
notify := self
] ifFalse:[
anIndex > size ifTrue:[
anIndex > (1 + size) ifTrue:[
^ self subscriptBoundsError
].
notify := self at:size
] ifFalse:[
notify := nil
]
].
size == 0 ifTrue:[
children := OrderedCollection new
].
aList do:[:anItem| anItem parent:self ].
children addAll:aList beforeIndex:anIndex.
(model := self model) isNil ifTrue:[
^ aList
].
isExpanded ifFalse:[
notify notNil ifTrue:[
notify changed
].
^ aList
].
(index := self listIndex) isNil ifTrue:[
^ aList
].
children from:1 to:(anIndex - 1) do:[:anItem|
index := 1 + index + anItem numberOfVisibleChildren
].
coll := OrderedCollection new.
aList do:[:anItem|
coll add:anItem.
anItem addVisibleChildrenTo:coll.
].
model itemAddAll:coll beforeIndex:(index + 1).
notify notNil ifTrue:[
notify changed
].
^ aList
!
addAllFirst:aCollectionOfItems
"add children at the beginning
"
^ self addAll:aCollectionOfItems beforeIndex:1
!
addAllLast:aCollectionOfItems
"add children at the end
"
^ self addAll:aCollectionOfItems
!
addFirst:aChildItem
"add a child at begin
"
^ self add:aChildItem beforeIndex:1.
!
addLast:anItem
"add a child at end
"
^ self add:anItem
!
remove:aChild
"remove a child
"
self removeIndex:(self identityIndexOf:aChild)
!
removeAll
"remove all children
"
|size|
(size := self children size) ~~ 0 ifTrue:[
self removeFromIndex:1 toIndex:size
]
!
removeFromIndex:startIndex toIndex:stopIndex
"remove the children from startIndex up to and including
the child under stopIndex.
"
|model notify
index "{ Class:SmallInteger }"
start "{ Class:SmallInteger }"
stop "{ Class:SmallInteger }"
size "{ Class:SmallInteger }"
|
size := self children size.
stop := stopIndex.
start := startIndex.
(stop <= size and:[start between:1 and:stop]) ifFalse:[
^ self subscriptBoundsError
].
start == 1 ifTrue:[
notify := self
] ifFalse:[
stop == size ifTrue:[
notify := self at:(start - 1)
] ifFalse:[
notify := nil
]
].
(model := self model) notNil ifTrue:[
index := model identityIndexOf:(children at:start).
size := stop - start + 1.
] ifFalse:[
index := 0
].
children from:start to:stop do:[:aChild|
index ~~ 0 ifTrue:[
size := size + aChild numberOfVisibleChildren
].
aChild parent:nil
].
children removeFromIndex:start toIndex:stop.
index ~~ 0 ifTrue:[
model itemRemoveFromIndex:index toIndex:(index + size - 1)
].
notify notNil ifTrue:[
notify changed
].
!
removeIndex:anIndex
"remove the child at an index
"
anIndex > 0 ifTrue:[
self removeFromIndex:anIndex toIndex:anIndex
]
! !
!HierarchicalItem methodsFor:'change & update'!
changed
"the item changed; raise change notification
"
self changed:nil with:nil
!
changed:aParameter
"the item changed; raise change notification
"
self changed:aParameter with:nil
!
changed:aParameter with:anArgument
"the item changed; raise change notification
"
|model|
model := self model.
model notNil ifTrue:[
model itemChanged:aParameter with:anArgument from:self
].
super changed:aParameter with:anArgument
!
hierarchyChanged
"hierarchy changed; optimize redrawing
"
self changed:#hierarchy with:nil
!
iconChanged
"icon changed; optimize redrawing
"
self changed:#icon with:nil
! !
!HierarchicalItem methodsFor:'enumerating'!
do:aOneArgBlock
"evaluate a block on each child
"
self children notNil ifTrue:[ children do:aOneArgBlock ]
!
from:startIndex do:aOneArgBlock
"evaluate a block on each child starting with the
child at startIndex to the end.
"
self from:startIndex to:self size do:aOneArgBlock
!
from:startIndex to:endIndex do:aOneArgBlock
"evaluate a block on each child starting with the
child at startIndex to the endIndex.
"
self children notNil ifTrue:[
children from:startIndex to:endIndex do:aOneArgBlock
]
!
from:startIndex to:endIndex reverseDo:aOneArgBlock
"evaluate a block on each child starting with the
child at endIndex to the startIndex.
"
self children notNil ifTrue:[
children from:startIndex to:endIndex reverseDo:aOneArgBlock
]
!
recursiveDo:aOneArgBlock
"evaluate a block on each item and all the sub-items
"
self do:[:aChild|
aOneArgBlock value:aChild.
aChild recursiveDo:aOneArgBlock
].
!
reverseDo:aOneArgBlock
"evaluate a block on each child
procesing children in reverse direction
"
self children notNil ifTrue:[ children reverseDo:aOneArgBlock ]
! !
!HierarchicalItem methodsFor:'initialization'!
initialize
isExpanded := false
! !
!HierarchicalItem methodsFor:'private'!
addVisibleChildrenTo:aList
"add all visible children and sub-children to the list
"
isExpanded ifTrue:[
(children notNil or:[self children notNil]) ifTrue:[
children do:[:aChild|
aList add:aChild.
aChild addVisibleChildrenTo:aList
]
]
]
!
listIndex
"returns the visible index or nil; for a none visible root
0 is returned
"
|index model|
(model := self model) notNil ifTrue:[
index := model identityIndexOf:self.
(index ~~ 0 or:[parent == model]) ifTrue:[
^ index
]
].
^ nil
!
numberOfVisibleChildren
"returns number of all visible children including subchildren
"
|size "{ Class: SmallInteger }"
|
isExpanded ifTrue:[
(children notNil or:[self children notNil]) ifTrue:[
(size := children size) ~~ 0 ifTrue:[
children do:[:el| size := size + el numberOfVisibleChildren ].
^ size
]
]
].
^ 0
!
parentOrModel
"returns the parent without checking for item or model
"
^ parent
!
setExpanded:aBoolean
"set expanded flag without any computation or notification
"
isExpanded := aBoolean
! !
!HierarchicalItem methodsFor:'private hierarchy'!
recursiveSetCollapsed
"collapse all children and sub-children without notifications
"
isExpanded := false.
children notNil ifTrue:[
children do:[:aChild| aChild recursiveSetCollapsed ]
]
!
recursiveSetExpandedAndAddToList:aList
"expand all children and sub-children without notifications;
add children to list
"
isExpanded := true.
(children notNil or:[self children notNil]) ifTrue:[
children do:[:aChild|
aList add:aChild.
aChild recursiveSetExpandedAndAddToList:aList.
]
]
! !
!HierarchicalItem methodsFor:'protocol accessing'!
children
"returns list of children
*** to optimize:redefine by subClass
"
|model|
children isNil ifTrue:[
(model := self model) notNil ifTrue:[
model childrenFor:self
].
].
^ children
!
icon
"returns the icon or nil;
*** to optimize:redefine by subClass
"
|model|
(model := self model) notNil ifTrue:[
^ model iconFor:self
].
^ nil
!
label
"returns the label displayed on aGC;
*** to optimize:redefine by subClass
"
|model|
(model := self model) notNil ifTrue:[
^ model labelFor:self
].
^ nil
!
middleButtonMenu
"returns the middleButtonMenu or nil if no menu is defined
"
|model|
(model := self model) notNil ifTrue:[
^ model middleButtonMenuFor:self
].
^ nil
! !
!HierarchicalItem methodsFor:'protocol displaying'!
displayOn:aGC x:x y:y
"draw the receiver in the graphicsContext, aGC.
"
|label
y0 "{ Class:SmallInteger }"
|
label := self label.
label notNil ifTrue:[
( label isImageOrForm not
and:[(label isString or:[label isKindOf:LabelAndIcon])]
) ifTrue:[
y0 := y + aGC font ascent
] ifFalse:[
y0 := y
].
label displayOn:aGC x:x y:y0.
]
!
heightOn:aGC
"return the width of the receiver, if it is to be displayed on aGC
"
|label|
label := self label.
^ label notNil ifTrue:[label heightOn:aGC] ifFalse:[0]
!
widthOn:aGC
"return the width of the receiver, if it is to be displayed on aGC
"
|label|
label := self label.
^ label notNil ifTrue:[label widthOn:aGC] ifFalse:[0]
! !
!HierarchicalItem methodsFor:'protocol monitoring'!
monitoringCycle
"called all 'n' seconds by the model, if the monitoring
cycle is enabled. The item can perform some checks, ..
**** can be redefined by subclass to perform some actions
"
! !
!HierarchicalItem methodsFor:'protocol queries'!
hasChildren
"checks whether the item has a list of children; the list must not
be loaded yet( ex. FileDirectory ).
*** to optimize:redefine by subClass
"
^ children notNil ifTrue:[children notEmpty]
ifFalse:[self children size ~~ 0]
!
string
"access the printable string used for steping through a list
searching for an entry starting with a character.
*** to optimize:redefine by subClass
"
^ self label perform:#string ifNotUnderstood:nil
! !
!HierarchicalItem methodsFor:'queries'!
canCollapse
"called before collapsing the item
"
^ isExpanded
!
canExpand
"called before expanding the item
"
^ isExpanded not and:[self hasChildren]
!
isExpanded
"return true if item is expanded
"
^ isExpanded
!
isHierarchicalItem
"used to decide if the parent is a hierarchical item
or the model
"
^ true
!
size
"return the number of children
"
^ children notNil ifTrue:[children size]
ifFalse:[self children size]
! !
!HierarchicalItem methodsFor:'searching'!
detect:aOneArgBlock
"find the first child, for which evaluation of the block returns
true; if none does so, report an error
"
^ self detect:aOneArgBlock ifNone:[self errorNotFound]
!
detect:aOneArgBlock ifNone:anExceptionBlock
"find the first child, for which evaluation of the block returns
true; if none does so, return the evaluation of anExceptionBlock
"
self children notNil ifTrue:[
^ children detect:aOneArgBlock ifNone:anExceptionBlock
].
^ anExceptionBlock value
!
identityIndexOf:aChild
"return the index of aChild or 0 if not found. Compare using ==
"
self children notNil ifTrue:[
^ children identityIndexOf:aChild
].
^ 0
!
identityIndexOf:aChild startingAt:startIndex
"return the index of aChild, starting search at startIndex.
Compare using ==; return 0 if not found
"
self children notNil ifTrue:[
^ children identityIndexOf:aChild startingAt:startIndex
].
^ 0
! !
!HierarchicalItem::Example class methodsFor:'instance creation'!
labeled:aLabel
^ self new setLabel:aLabel
!
labeled:aLabel icon:anIcon
^ self new setLabel:aLabel icon:anIcon
! !
!HierarchicalItem::Example class methodsFor:'resources'!
iconForLevel:aLevel
"returns an icon
"
aLevel == 2 ifTrue:[ ^ ResourceSelectionBrowser iconPrivateClass ].
aLevel == 3 ifTrue:[ ^ ResourceSelectionBrowser iconClass ].
aLevel == 4 ifTrue:[ ^ ResourceSelectionBrowser iconCategory ].
^ nil
!
penguinIcon
PenguinIcon isNil ifTrue:[
PenguinIcon := Image fromFile:'bitmaps/xpmBitmaps/misc_logos/linux_penguin.xpm'.
].
^ PenguinIcon
! !
!HierarchicalItem::Example methodsFor:'accessing'!
children
|lvl lbl txt image img icon|
children notNil ifTrue:[
^ children
].
(lvl := self level) == 5 ifTrue:[
children := #().
^ children
].
icon := self class iconForLevel:(lvl + 1).
children := OrderedCollection new.
lvl < 4 ifTrue:[
txt := (lvl + 1) printString, ' ['.
img := NewLauncher saveImageIcon.
1 to:5 do:[:i|
(i == 2 or:[i == 3]) ifTrue:[
lbl := img
] ifFalse:[
i == 4 ifTrue:[
lbl := self class penguinIcon
] ifFalse:[
lbl := txt, (i printString), ']'
]
].
children add:(self class labeled:lbl icon:icon)
].
] ifFalse:[
image := ResourceSelectionBrowser iconPrivateClass.
txt := LabelAndIcon icon:image string:'Text'.
img := Icon copyIcon.
1 to:5 do:[:i|
lbl := i odd ifTrue:[txt] ifFalse:[img].
children add:(self class labeled:lbl icon:icon).
]
].
children do:[:aChild| aChild parent:self ].
^ children
!
icon
"returns the icon
"
^ icon
!
icon:anIcon
"set the icon; if icon changed, a notification
is raised.
"
icon ~= anIcon ifTrue:[
icon := anIcon.
self iconChanged
]
!
label
"returns the label
"
^ label
!
label:aLabel
"set the label; if label changed, a notification
is raised.
"
label ~= aLabel ifTrue:[
label := aLabel.
self changed.
]
!
setIcon:anIcon
"set the icon without any change notification
"
icon := anIcon
!
setLabel:aLabel
"set the label without any change notification
"
label := aLabel
!
setLabel:aLabel icon:anIcon
"set the label and icon without any change notification
"
label := aLabel.
icon := anIcon.
! !
!HierarchicalItem class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalItem.st,v 1.1 1999-05-23 12:56:18 cg Exp $'
! !