"
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
"
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 := 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
"remove the children from startIndex up to end of children
"
^ self removeFromIndex:startIndex toIndex:(children size)
!
removeFromIndex:startIndex toIndex:stopIndex
"remove the children from startIndex up to and including
the child under stopIndex.
"
|noChildren stop|
noChildren := children size.
(startIndex <= stopIndex and:[startIndex <= noChildren]) ifTrue:[
stop := stopIndex min:noChildren.
self criticalDo:[
self basicRemoveFromIndex:startIndex toIndex:stop
]
].
!
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 := 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
#icon icon is modified; hight and width are unchanged
#hierarchy collapsed/expanded; hight and width are unchanged
#redraw redraw but hight and width are unchanged
....... all others the hight and width are reset
"
|model why|
what ~~ #redraw ifTrue:[
(what ~~ #hierarchy and:[what ~~ #icon]) ifTrue:[
self class doResetExtentOnChange ifTrue:[
width := height := nil
].
].
why := what
] ifFalse:[
why := #redraw
].
(model := self model) notNil ifTrue:[
model itemChanged:why with:anArgument from:self
].
super changed:why with:anArgument
!
childrenOrderChanged
"called if the order of the children changed by a user
operation. Update the model and raise a change notification for
each item which has changed its position
triggered by the user operation !!
"
|model visStart list|
self isExpanded ifFalse:[ ^ self ]. "/ not expanded
children size > 1 ifFalse:[ ^ self ].
model := self model.
model ifNil:[^ self]. "/ no model
visStart := model identityIndexOf:self.
visStart == 0 ifTrue:[
model root ~~ self ifTrue:[ ^ self ].
"/ I'am the root but switched of by setting #showRoot to false
].
self criticalDo:[
list := OrderedCollection new.
self addVisibleChildrenTo:list.
list do:[:el|
visStart := visStart + 1.
(model at:visStart ifAbsent:el) ~~ el ifTrue:[
model at:visStart put:el
].
]
].
!
fontChanged
"called if the font has changed
"
width := height := nil.
children size ~~ 0 ifTrue:[
children do:[:el| el fontChanged ].
].
!
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
"
|coll|
coll := OrderedCollection new.
self do:[:el| coll add:(aBlock value:el) ].
^ coll
!
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:nil do:aOneArgBlock
!
from:startIndex reverseDo:aOneArgBlock
"evaluate a block on each child starting at end to the startIndex
"
^ self from:startIndex to:nil reverseDo:aOneArgBlock
!
from:startIndex to:endIndex do:aOneArgBlock
"evaluate a block on each child starting with the
child at startIndex to the endIndex.
"
|res|
self size < startIndex ifTrue:[^ nil].
res := nil.
self criticalDo:[
res := self nonCriticalFrom:startIndex to:endIndex do:aOneArgBlock
].
^ res
!
from:startIndex to:endIndex reverseDo:aOneArgBlock
"evaluate a block on each child starting with the
child at endIndex to the startIndex.
"
|res|
self size < startIndex ifTrue:[^ nil].
res := nil.
self criticalDo:[
res := self nonCriticalFrom:startIndex to:endIndex reverseDo:aOneArgBlock
].
^ res
!
keysAndValuesDo:aTwoArgBlock
"evaluate the argument, aBlock for every child,
passing both index and element as arguments.
"
|key res|
key := 1.
res := nil.
self do:[:el|
res := el value:key value:el.
key := key + 1.
].
^ res
!
keysAndValuesReverseDo:aTwoArgBlock
"evaluate the argument, aBlock in reverse order for every
child, passing both index and element as arguments.
"
|res|
self size == 0 ifTrue:[^ nil].
res := nil.
self criticalDo:[
res := self nonCriticalKeysAndValuesReverseDo:aTwoArgBlock
].
^ res
!
recursiveCollect:aBlock
"for each child in the receiver, evaluate the argument, aBlock
and return a new collection with the results
"
|coll|
coll := OrderedCollection new.
self recursiveDo:[:el| coll add:(aBlock value:el) ].
^ coll
!
recursiveDo:aOneArgBlock
"evaluate a block on each item and all the sub-items
"
self do:[:aChild|
aOneArgBlock value:aChild.
aChild nonCriticalRecursiveDo:aOneArgBlock
].
!
recursiveReverseDo:aOneArgBlock
"evaluate a block on each item and all the sub-items;
proccesing children in reverse direction
"
self reverseDo:[:aChild|
aChild nonCriticalRecursiveReverseDo: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.
"
|coll|
coll := OrderedCollection new.
self recursiveDo:[:el| (aBlock value:el) ifTrue:[coll add:el] ].
^ coll
!
reverseDo:aOneArgBlock
"evaluate a block on each child in reverse direction
"
^ self from:1 reverseDo:aOneArgBlock
!
select:aBlock
"return a new collection with all items from the receiver, for which
the argument aBlock evaluates to true.
"
|coll|
coll := OrderedCollection new.
self do:[:el| (aBlock value:el) ifTrue:[coll add:el] ].
^ coll
!
withAllDo:aOneArgBlock
"evaluate the block on each item and subitem including self
"
aOneArgBlock value:self.
self do:[:el|
aOneArgBlock value:el.
el nonCriticalRecursiveDo:aOneArgBlock.
].
! !
!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 ifFalse:[^ self].
self nonCriticalFrom:1 to:nil do:[:el|
aList add:el.
el 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|
isExpanded == true ifFalse:[^ 0].
size := 0.
self nonCriticalFrom:1 to:nil do:[:el|
size := 1 + size + el numberOfVisibleChildren
].
^ size
!
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 enumerating'!
nonCriticalDo:aOneArgBlock
"evaluate a block noncritical on each child.
"
^ self nonCriticalFrom:1 to:nil do:aOneArgBlock
!
nonCriticalFrom:startIndex to:endIndex do:aOneArgBlock
"evaluate a block noncritical on each child starting with the
child at startIndex to the endIndex (if nil to end of list).
"
|list size resp|
list := self children.
size := list size.
startIndex > size ifTrue:[^ nil].
resp := nil.
endIndex notNil ifTrue:[
size := size min:endIndex
].
startIndex to:size do:[:i| |item|
item := list at:i ifAbsent:nil.
item isNil ifTrue:[^ resp].
resp := aOneArgBlock value:item.
].
^ resp
!
nonCriticalFrom:startIndex to:endIndex reverseDo:aOneArgBlock
"evaluate a block non critical on each child starting with the
child at endIndex (if nil to end of list) to startIndex.
"
|list size resp|
list := self children.
size := list size.
resp := nil.
endIndex notNil ifTrue:[
size := size min:endIndex
].
size to:startIndex by:-1 do:[:i| |item|
item := list at:i ifAbsent:nil.
item isNil ifTrue:[^ resp].
resp := aOneArgBlock value:item.
].
^ resp
!
nonCriticalKeysAndValuesReverseDo:aOneArgBlock
"evaluate the argument, aBlock in reverse order for every
child, passing both index and element as arguments.
"
|list size resp|
list := self children.
size := list size.
resp := nil.
size to:1 by:-1 do:[:i| |item|
item := list at:i ifAbsent:nil.
item isNil ifTrue:[^ resp].
resp := aOneArgBlock value:i value:item.
].
^ resp
!
nonCriticalRecursiveDo:anOneArgBlock
"evaluate the block non critical on each item and all the sub-items
"
self nonCriticalFrom:1 to:nil do:[:aChild|
anOneArgBlock value:aChild.
aChild nonCriticalRecursiveDo:anOneArgBlock
].
!
nonCriticalRecursiveReverseDo:anOneArgBlock
"evaluate the block non critical on each item and all the sub-items;
proccesing children in reverse direction
"
self nonCriticalFrom:1 to:nil reverseDo:[:aChild|
aChild nonCriticalRecursiveReverseDo:anOneArgBlock.
anOneArgBlock value:aChild.
].
!
nonCriticalRecursiveSort:aSortBlock
"evaluate a block noncritical on each child.
"
|unsorted sorted|
unsorted := children.
unsorted size ~~ 0 ifTrue:[
sorted := unsorted sort:aSortBlock.
sorted do:[:el| el nonCriticalRecursiveSort:aSortBlock ].
children := sorted.
].
! !
!HierarchicalItem methodsFor:'private hierarchy'!
recursiveSetCollapsed
"collapse all children and sub-children without notifications
"
isExpanded := false.
"/ do not call :#size: children will be autoloaded !!!!
children size ~~ 0 ifTrue:[
self nonCriticalFrom:1 to:nil do:[:el| el recursiveSetCollapsed ].
]
!
recursiveSetExpandedAndAddToList:aList
"expand all children and sub-children without notifications;
add children to list
"
isExpanded := true.
self do:[:anItem|
aList add:anItem.
anItem 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
"sort the children inplace using the 2-arg block sortBlock for comparison
"
self obsoleteMethodWarning:'renamed to sort:'.
self 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 event processing'!
processButtonPress:button x:x y:y
"a mouse button was pressed in my label.
Return true, if I have eaten the event.
On default false is returned (unhandled).
"
^ false
! !
!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'!
canCollapse
"called before collapsing the item; can be redefined
by subclass to omit the collapse operation
"
^ (isExpanded == true)
!
canExpand
"called before expanding the item; can be redefined
by subclass to omit the collapse operation
"
^ (isExpanded == true) not and:[self hasChildren]
!
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
"
^ self children size ~~ 0
!
hasIndicator
"on default the indicator is drawn if the item
has children
"
^ self hasChildren
!
isSelectable
"returns true if the item is selectable otherwise false
"
^ true
!
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'!
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
!
isCollapsed
"returns true if the item is collapsed
"
^ (isExpanded ~~ true)
!
isExpanded
"returns true if the item is expanded
"
^ (isExpanded == true)
!
isHierarchicalItem
"used to decide if the parent is a hierarchical item
or the model
"
^ true
!
isRealChildOf:anItem
"returns true if the item is a child of anItem
"
|item|
item := self parent.
[item notNil] whileTrue:[
item == anItem ifTrue:[^ true].
item := item parent.
].
^ false
!
isRootItem
"returns true if the item is the root item
"
^ parent isHierarchicalItem not
!
size
"return the number of children
"
^ 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:anOneArgBlock ifNone:anExceptionBlock
"find the first child, for which evaluation of the block returns
true; if none does so, return the evaluation of anExceptionBlock
"
self do:[:el| (anOneArgBlock value:el) ifTrue:[^ el] ].
^ 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:anOneArgBlock ifNone:anExceptionBlock
"find the last child, for which evaluation of the block returns
true; if none does so, return the evaluation of anExceptionBlock
"
self reverseDo:[:el| (anOneArgBlock value:el) ifTrue:[^ el] ].
^ anExceptionBlock value
!
findFirst:anOneArgBlock
"find the first child, for which evaluation of the argument, aOneArgBlock
returns true; return its index or 0 if none detected.
"
self keysAndValuesDo:[:i :el| (anOneArgBlock value:el) ifTrue:[^ i] ].
^ 0
!
findLast:anOneArgBlock
"find the last child, for which evaluation of the argument, aOneArgBlock
returns true; return its index or 0 if none detected.
"
self keysAndValuesReverseDo:[:i :el| (anOneArgBlock value:el) ifTrue:[^ i] ].
^ 0
!
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 := startIndex.
self from:startIndex do:[:el|
el == aChild ifTrue:[^ index ].
index := index + 1.
].
^ 0
!
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
!
withAllDetect:aOneArgBlock
"recursive find the first item including self, for which evaluation
of the block returns true; if none nil is returned
"
(aOneArgBlock value:self) ifTrue:[^ self].
^ self recursiveDetect:aOneArgBlock
! !
!HierarchicalItem methodsFor:'sort & reordering'!
recursiveSort:aSortBlock
"recursive sort the children inplace using the 2-arg block sortBlock for comparison
"
self criticalDo:[
children size ~~ 0 ifTrue:[
self nonCriticalRecursiveSort:aSortBlock.
self childrenOrderChanged.
]
].
!
sort:aSortBlock
"sort the children inplace using the 2-arg block sortBlock for comparison
"
|unsorted|
self criticalDo:[
unsorted := children.
unsorted size ~~ 0 ifTrue:[
children := unsorted sort:aSortBlock.
self childrenOrderChanged.
]
].
! !
!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.51 2002-10-29 13:55:47 ca Exp $'
! !