"
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
! !
!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.
].
self criticalDo:[
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 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 children size)
! !
!HierarchicalItem methodsFor:'accessing-hierarchy'!
collapse
"hide children
"
|visChd model index|
self canCollapse ifTrue:[
isExpanded := false.
self criticalDo:[
(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.
self criticalDo:[
(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]
]
]
]
]
]
!
makeVisible
"expand all my parents
"
(parent notNil and:[parent isHierarchicalItem]) ifTrue:[
self criticalDo:[
parent expand.
parent makeVisible
]
].
!
recursiveCollapse
"collapse children and sub-children
**** must be expanded
"
|visChd index|
self canCollapse ifTrue:[
self criticalDo:[
(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 criticalDo:[
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 == true) ifTrue:[
self recursiveCollapse
] ifFalse:[
self recursiveExpand
]
!
toggleExpand
"if the item is collapsed, the children are expanded
otherwise collapsed
"
self criticalDo:[
(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) ~~ 0 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
!
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) ~~ 0 ifTrue:[
^ self addAll:aList beforeIndex:index
].
self subscriptBoundsError
!
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
"
aList size ~~ 0 ifTrue:[
aBlock isNil ifTrue:[
self addAll:aList
] ifFalse:[
self criticalDo:[
aList do:[:el|self add:el sortBlock:aBlock]
]
]
].
^ 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
"remove the item
"
parent notNil ifTrue:[ "check whether parent exists"
parent isHierarchicalItem ifTrue:[parent remove:self] "parent is HierarchicalItem"
ifFalse:[parent root:nil] "parent is HierarchicalList"
].
^ self
!
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
]
!
removeAll:aList
"remove all children in the collection
"
|index|
aList size ~~ 0 ifTrue:[
self criticalDo:[
aList do:[:el|
(index := self identityIndexOf:el) ~~ 0 ifTrue:[
self removeIndex:index
]
]
]
].
^ aList
!
removeFromIndex:startIndex toIndex:stopIndex
"remove the children from startIndex up to and including
the child under stopIndex.
"
self criticalDo:[
self basicRemoveFromIndex:startIndex toIndex:stopIndex
].
!
removeIndex:anIndex
"remove the child at an index
"
anIndex > 0 ifTrue:[
self removeFromIndex:anIndex toIndex:anIndex
]
! !
!HierarchicalItem methodsFor:'basic adding & removing'!
basicAdd:aChild sortBlock:aBlock
"add a child sorted
"
(aBlock notNil and:[children size ~~ 0]) ifTrue:[
self criticalDo:[
children keysAndValuesDo:[:index :child|
(aBlock value:aChild value:child) ifTrue:[
^ self add:aChild beforeIndex:index
]
]
]
].
^ self add:aChild.
!
basicAddAll:aList beforeIndex:anIndex
"add children before an index
"
|coll model notify index size|
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
]
].
children isArray ifTrue:[
children := children asOrderedCollection
].
size == 0 ifTrue:[
children := OrderedCollection new
].
aList do:[:anItem| anItem parent:self ].
children addAll:aList beforeIndex:anIndex.
(model := self model) isNil ifTrue:[
^ aList
].
(isExpanded == true) 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
!
basicRemoveFromIndex: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
].
! !
!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:what with:anArgument
"the item changed; raise change notification
"
|model|
(what ~~ #hierarchy and:[what ~~ #icon]) ifTrue:[
width := height := nil
].
(model := self model) notNil ifTrue:[
model itemChanged:what with:anArgument from:self
].
super changed:what 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'!
collect:aBlock
"for each child in the receiver, evaluate the argument, aBlock
and return a new collection with the results
"
|newCollection|
self children size == 0 ifTrue:[
^ #()
].
self criticalDo:[
newCollection := OrderedCollection new.
children do:[:aChild| newCollection add:(aBlock value:aChild) ]
].
^ newCollection
!
do:aOneArgBlock
"evaluate a block on each child
"
self from:1 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.
"
|children|
children := self children.
children size ~~ 0 ifTrue:[
self criticalDo:[
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.
"
|children|
children := self children.
children size ~~ 0 ifTrue:[
self criticalDo:[
children from:startIndex to:endIndex reverseDo:aOneArgBlock
]
]
!
recursiveCollect:aBlock
"for each child in the receiver, evaluate the argument, aBlock
and return a new collection with the results
"
|newCollection|
self children size == 0 ifTrue:[
^ #()
].
newCollection := OrderedCollection new.
self recursiveDo:[:aChild|
newCollection add:(aBlock value:aChild)
].
^ newCollection
!
recursiveDo:aOneArgBlock
"evaluate a block on each item and all the sub-items
"
self do:[:aChild|
aOneArgBlock value:aChild.
aChild recursiveDo:aOneArgBlock
].
!
recursiveReverseDo:aOneArgBlock
"evaluate a block on each item and all the sub-items;
proccesing children in reverse direction
"
|children|
children := self children.
children size ~~ 0 ifTrue:[
self criticalDo:[
children reverseDo:[:aChild|
aChild reverseRecursiveDo:aOneArgBlock.
aOneArgBlock value:aChild.
]
]
].
!
recursiveSelect:aBlock
"return a new collection with all children and subChildren from the receiver, for which
the argument aBlock evaluates to true.
"
|newCollection|
self children size == 0 ifTrue:[
^ #()
].
newCollection := OrderedCollection new.
self recursiveDo:[:aChild|
(aBlock value:aChild) ifTrue:[newCollection add:aChild]
].
^ newCollection
!
reverseDo:aOneArgBlock
"evaluate a block on each child
proccesing children in reverse direction
"
|children|
children := self children.
children size ~~ 0 ifTrue:[
self criticalDo:[children reverseDo:aOneArgBlock]
]
!
select:aBlock
"return a new collection with all children from the receiver, for which
the argument aBlock evaluates to true.
"
|newCollection children|
children := self children.
children size == 0 ifTrue:[
^ #()
].
self criticalDo:[
newCollection := OrderedCollection new.
children do:[:aChild|
(aBlock value:aChild) ifTrue:[newCollection add:aChild]
]
].
^ newCollection
! !
!HierarchicalItem methodsFor:'enumerating parents'!
parentsDetect:aBlock
"find the first parent, for which evaluation of the block returns
true; if none does so, report an error
"
^ self parentsDetect:aBlock ifNone:[self errorNotFound]
!
parentsDetect:aBlock ifNone:anExceptionBlock
"find the first parent, for which evaluation of the block returns
true; if none does so, return the evaluation of anExceptionBlock
"
|prnt|
prnt := self.
self criticalDo:[
[(prnt := prnt parent) notNil and:[prnt isHierarchicalItem]] whileTrue:[
(aBlock value:prnt) ifTrue:[^ prnt]
]
].
^ anExceptionBlock value
!
parentsDo:aBlock
"evaluate a block on each parent
"
|prnt|
prnt := self.
self criticalDo:[
[(prnt := prnt parent) notNil and:[prnt isHierarchicalItem]] whileTrue:[
aBlock value:prnt
]
].
! !
!HierarchicalItem methodsFor:'initialization'!
initialize
isExpanded := false
! !
!HierarchicalItem methodsFor:'private'!
addVisibleChildrenTo:aList
"add all visible children and sub-children to the list
"
isExpanded == true ifTrue:[
(children notNil or:[self children notNil]) ifTrue:[
children do:[:aChild|
aList add:aChild.
aChild addVisibleChildrenTo:aList
]
]
]
!
criticalDo:aBlock
|model|
(model := self model) notNil ifTrue:[
model recursionLock critical:aBlock
] ifFalse:[
aBlock value
]
!
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 == true) ifTrue:[
(children notNil or:[self children notNil]) ifTrue:[
(size := children size) ~~ 0 ifTrue:[
self criticalDo:[
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 displaying'!
displayLabel:aLabel h:lH on:aGC x:x y:y h:h
"display the label at x@y
"
|y0 hF|
lH ~~ 0 ifTrue:[
y0 := y - (lH + 1 - h // 2).
aLabel isImageOrForm ifTrue:[
^ aLabel displayOn:aGC x:x y:y0
].
y0 := y0 + (aGC font ascent).
aLabel isString ifFalse:[
^ aLabel displayOn:aGC x:x y:y0
].
(aLabel indexOf:(Character cr)) == 0 ifTrue:[
^ aLabel displayOn:aGC x:x y:y0
].
hF := aGC font height.
aLabel asCollectionOfLines do:[:el|
el displayOn:aGC x:x y:y0.
y0 := y0 + hF
]
].
!
heightOf:aLabel on:aGC
"returns the height of the label or 0
"
|h|
aLabel isSequenceable ifFalse:[
^ aLabel notNil ifTrue:[aLabel heightOn:aGC] ifFalse:[0]
].
aLabel isString ifFalse:[
h := 0.
aLabel do:[:el|h := h max:(self heightOf:el on:aGC)].
^ h
].
h := 1 + (aLabel occurrencesOf:(Character cr)).
^ h * (aGC font height)
!
widthOf:aLabel on:aGC
"returns the height of the label or 0
"
|w|
aLabel isSequenceable ifFalse:[
^ aLabel notNil ifTrue:[aLabel widthOn:aGC] ifFalse:[0]
].
aLabel isString ifFalse:[
w := -5.
aLabel do:[:el|w := w + 5 + (self widthOf:el on:aGC)].
^ w
].
(aLabel indexOf:(Character cr)) == 0 ifTrue:[
^ aLabel widthOn:aGC
].
w := 0.
aLabel asCollectionOfLines do:[:el|w := w max:(el widthOn:aGC)].
^ w
! !
!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:[
self criticalDo:[
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:[
children := 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
!
recursiveSortChildren:aSortBlock
|children|
(children := self children) notNil ifTrue:[
self criticalDo:[
children sort:aSortBlock.
children do:[:aChild| aChild recursiveSortChildren:aSortBlock ]
]
].
!
sortChildren:aSortBlock
|children|
(children := self children) notNil ifTrue:[
self criticalDo:[
children sort:aSortBlock
]
].
! !
!HierarchicalItem methodsFor:'protocol displaying'!
displayOn:aGC x:x y:y h:h
"draw the receiver in the graphicsContext, aGC.
"
|label
x0 "{ Class:SmallInteger }"
|
(label := self label) isNil ifTrue:[^ self].
(label isSequenceable and:[label isString not]) ifFalse:[
^ self displayLabel:label h:(self heightOn:aGC) on:aGC x:x y:y h:h
].
x0 := x.
label do:[:el|
el notNil ifTrue:[
self displayLabel:el h:(self heightOf:el on:aGC) on:aGC x:x0 y:y h:h.
x0 := x0 + 5 + (el widthOn:aGC).
].
]
!
heightOn:aGC
"return the width of the receiver, if it is to be displayed on aGC
"
height isNil ifTrue:[
height := self heightOf:(self label) on:aGC
].
^ height
!
widthOn:aGC
"return the width of the receiver, if it is to be displayed on aGC
"
width isNil ifTrue:[
width := self widthOf:(self label) on:aGC
].
^ width
! !
!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'!
drawHorizontalLineUpToText
"draw the horizizontal line for the selected item up to the text
or on default to the start of the the vertical line; only used by
the hierarchical view
"
^ false
!
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
"
|label|
(label := self label) notNil ifTrue:[
label isString ifTrue:[ ^ label string ].
label isImageOrForm ifTrue:[ ^ nil ].
label isSequenceable ifFalse:[
^ label perform:#string ifNotUnderstood:nil
].
label do:[:el||s|
(el notNil and:[el isImageOrForm not]) ifTrue:[
s := el perform:#string ifNotUnderstood:nil.
s notNil ifTrue:[^ s].
]
]
].
^ nil
! !
!HierarchicalItem methodsFor:'queries'!
canCollapse
"called before collapsing the item
"
^ (isExpanded == true)
!
canExpand
"called before expanding the item
"
^ (isExpanded == true) not and:[self hasChildren]
!
isChildOf:anItem
"returns true if the item is a child of anItem
"
|item|
item := self.
[anItem ~~ item] whileTrue:[
((item := item parent) notNil and:[item isHierarchicalItem]) ifFalse:[
^ false
]
].
^ true
!
isExpanded
"return true if item is expanded
"
^ (isExpanded == true)
!
isHierarchicalItem
"used to decide if the parent is a hierarchical item
or the model
"
^ true
!
isSelectable
"returns true if the item is selectable otherwise false
"
^ 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
"
|item|
self children size ~~ 0 ifTrue:[
self criticalDo:[
item := children detect:aOneArgBlock ifNone:nil
].
item notNil ifTrue:[
^ item
]
].
^ anExceptionBlock value
!
detectLast:aOneArgBlock
"find the last child, for which evaluation of the block returns
true; if none does so, an exception is raised
"
^ self detectLast:aOneArgBlock ifNone:[self errorNotFound]
!
detectLast:aOneArgBlock ifNone:anExceptionBlock
"find the last child, for which evaluation of the block returns
true; if none does so, return the evaluation of anExceptionBlock
"
|item|
self children size ~~ 0 ifTrue:[
self criticalDo:[
item := children detectLast:aOneArgBlock ifNone:nil
].
item notNil ifTrue:[
^ item
]
].
^ anExceptionBlock value
!
identityIndexOf:aChild
"return the index of aChild or 0 if not found. Compare using ==
"
^ self identityIndexOf:aChild startingAt:1
!
identityIndexOf:aChild startingAt:startIndex
"return the index of aChild, starting search at startIndex.
Compare using ==; return 0 if not found
"
|index|
index := 0.
self children size ~~ 0 ifTrue:[
self criticalDo:[
index := children identityIndexOf:aChild startingAt:startIndex
]
].
^ index
!
recursiveDetect:aOneArgBlock
"recursive find the first child, for which evaluation
of the block returns true; if none nil is returned
"
self recursiveDo:[:aChild|
(aOneArgBlock value:aChild) ifTrue:[^ aChild]
].
^ nil
!
recursiveDetectLast:aBlock
"find the last child, for which evaluation of the block returns
true; if none does so, nil id returned
"
self recursiveReverseDo:[:aChild|
(aBlock value:aChild) ifTrue:[^ aChild].
].
^ nil
! !
!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 := Smalltalk imageFromFileNamed:'xpmBitmaps/misc_logos/linux_penguin.xpm'
inPackage:'stx:goodies'
].
^ PenguinIcon
! !
!HierarchicalItem::Example methodsFor:'accessing'!
children
|lvl lbl txt image img icon tmp|
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 := Array with:(self class penguinIcon)
with:('penguin#and#text' replaceAll:$# with:(Character cr)).
] 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].
lbl := Array with:lbl with:'test' with: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.24 2000-09-06 12:41:59 cg Exp $'
! !