--- a/HierarchicalItem.st Fri May 01 14:52:30 2015 +0200
+++ b/HierarchicalItem.st Fri May 01 16:38:36 2015 +0200
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
"
COPYRIGHT (c) 1999 by eXept Software AG
All Rights Reserved
@@ -13,8 +15,8 @@
"{ NameSpace: Smalltalk }"
-Object subclass:#HierarchicalItem
- instanceVariableNames:'parent children isExpanded height width'
+AbstractHierarchicalItem subclass:#HierarchicalItem
+ instanceVariableNames:'isExpanded height width'
classVariableNames:''
poolDictionaries:''
category:'Views-Support'
@@ -55,6 +57,8 @@
children <Collection or nil> list of children
isExpanded <Boolean> indicates whether the item is
expanded or collapsed
+ width <Integer> cached width of displayed label
+ height <Integer> cached height of displayed label
[author:]
Claus Atzkern
@@ -63,1093 +67,12 @@
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 as they are present (or not); not going to the model..."
-
- ^ children
-!
-
-level
- "returns the level starting with 0 for the root"
-
- |item level|
-
- item := self.
- level := 0.
-
- [ (item := item parentOrModel) notNil] whileTrue:[
- level := level + 1.
- level > 100000 ifTrue:[
- self halt:'possibly recursive item hierarchy'
- ].
- ].
- ^ level
-
- "Modified: / 09-07-2010 / 08:56:27 / cg"
-!
-
-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. return anItem (sigh)"
-
- |children oldItem visIndex model expFlag|
-
- anItem isNil ifTrue:[
- self removeFromIndex:anIndex toIndex:anIndex.
- ^ nil
- ].
- anItem parent:self.
-
- (model := self model) isNil ifTrue:[
- self children at:anIndex put:anItem.
- ^ 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].
- ]
- ]
- ]
-!
-
-enforcedExpand
- "expand children - even if there are no children,
- the item is initially expanded (but this might be undone later,
- when we know that no children are there"
-
- self expand:true
-!
-
-expand
- "expand children - but only if there are children
- (i.e. this cannot be used before the childInfo is valid;
- aka not before the updateTask came along this item)"
-
- self expand:false
-!
-
-expand:enforced
- "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 ifTrue:[ ^ self ].
- (enforced not and:[self canExpand not]) ifTrue:[ ^ self ].
-
- self criticalDo:[
- (index := self listIndex) notNil ifTrue:[
- "/ must set expand-flag to false, otherwise change notifications
- "/ are raised during lazy auto creation (to the list).
- isExpanded := false.
- list := self children.
- isExpanded := true.
-
- list notEmptyOrNil ifTrue:[
- list := OrderedCollection new.
- 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 makeVisible.
- parent expand.
- ]
- ].
-!
-
-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"
-
- "/ test whether the item already is expanded; #canExpand could be redefined
- "/ without checking whether the node is expanded (happens already) !!
-
- |index list|
-
- isExpanded 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.
- 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 ifTrue:[
- self recursiveCollapse
- ] ifFalse:[
- self recursiveExpand
- ]
-!
-
-toggleExpand
- "if the item is collapsed, the item is 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 for each dependent application"
-
- |model|
-
- (model := self model) notNil ifTrue:[
- model applicationsDo:aOneArgBlock
- ]
-!
-
-model
- "returns the hierachicalList model or nil.
- This is a stupid implementation here, in that the top-item's parent is assumed to
- be the model of the tree, and that is returned.
- This saves a slot in every node, but makes some algorithms O(n*log n) or even O(n^2).
- So be aware of the performance penalty"
-
- |item next|
-
- item := self.
- [ (next := item parentOrModel) notNil ] whileTrue:[
- item := next.
- ].
-
- item isHierarchicalItem ifFalse:[^ item].
- ^ 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:index ].
-
- 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:index ].
-
- 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:index ].
-
- ^ 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:[ ^ aList ].
-
- aBlock isNil ifTrue:[
- self addAll:aList.
- ] ifFalse:[
- self criticalDo:[
- aList do:[:el| self basicAdd: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 the beginning"
-
- ^ self add:aChildItem beforeIndex:1.
-!
-
-addLast:anItem
- "add a child at the 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
-!
-
-removeAllIdentical:aList
- "remove all children in the collection"
-
- self removeAll:aList.
- ^ aList
-
- "Created: / 20-09-2010 / 09:43:06 / sr"
-!
-
-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.
- Returns the receiver."
-
- |nrOfChildren stop|
-
- nrOfChildren := children size.
-
- (startIndex <= stopIndex and:[startIndex <= nrOfChildren]) ifTrue:[
- stop := stopIndex min:nrOfChildren.
-
- self criticalDo:[
- self basicRemoveFromIndex:startIndex toIndex:stop
- ]
- ].
-
- children size == 0 ifTrue:[
- self clearExpandedWhenLastChildWasRemoved ifTrue:[
- isExpanded := false.
- ]
- ].
-!
-
-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"
-
- |size list|
-
- size := children size.
- list := Array with:aChild.
-
- (aBlock notNil and:[size ~~ 0]) ifTrue:[
- children keysAndValuesDo:[:i :el|
- (aBlock value:aChild value:el) ifTrue:[
- self basicAddAll:list beforeIndex:i.
- ^ aChild
- ]
- ]
- ].
- self basicAddAll:list beforeIndex:(size + 1).
- ^ 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:index
- ].
- 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 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:index
- ].
- 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:what with:anArgument
- "the item changed; raise change notification
- #icon icon is modified; height and width are unchanged
- #hierarchy collapsed/expanded; height and width are unchanged
- #redraw redraw but height and width are unchanged
- ....... all others: the height and width are reset
- "
- |model|
-
- what ~~ #redraw ifTrue:[
- (what ~~ #hierarchy and:[what ~~ #icon]) ifTrue:[
- self class doResetExtentOnChange ifTrue:[
- width := height := nil
- ].
- ].
- ].
- (model := self model) notNil ifTrue:[
- model itemChanged:what with:anArgument from:self
- ].
- super changed:what with:anArgument
-
- "Modified: / 24-11-2010 / 17:21:20 / cg"
-!
-
-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 isNil ifTrue:[^ 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.
- Clear the precomputed width and height"
-
- 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
-!
-
-labelChanged
- "called if the label has changed.
- Clear the precomputed width and height"
-
- width := height := nil.
-
- "Created: / 17-01-2011 / 17:43:42 / cg"
-! !
-
-!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
-!
-
-contains:aBlock
- "evaluate aOneArgBlock for each of the receiver's elements
- Return true and skip remaining elements, if aBlock ever returns true,
- otherwise return false"
-
- self do:[:el | (aBlock value:el) ifTrue:[^ true] ].
- ^ false
-!
-
-do:aOneArgBlock
- "evaluate a block for each child"
-
- self from:1 to:nil 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:[^ self "nil"].
- res := nil.
-
- self criticalDo:[
- res := self nonCriticalFrom:startIndex to:endIndex do:aOneArgBlock
- ].
- "/ ^ res - return the receiver, as all other collections do
-!
-
-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:[^ self "nil"].
- res := nil.
-
- self criticalDo:[
- res := self nonCriticalFrom:startIndex to:endIndex reverseDo:aOneArgBlock
- ].
- "/ ^ res - return the receiver, as all other collections do
-!
-
-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 - no: return the receiver, as all other collections do
-!
-
-keysAndValuesReverseDo:aTwoArgBlock
- "evaluate the argument, aBlock in reverse order for every
- child, passing both index and element as arguments."
-
- |res|
-
- self size == 0 ifTrue:[^ self "nil"].
- res := nil.
-
- self criticalDo:[
- res := self nonCriticalKeysAndValuesReverseDo:aTwoArgBlock
- ].
- "/ ^ res - no: return the receiver, as all other collections do
-!
-
-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 for 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 ifFalse:[^ self].
-
- self nonCriticalFrom:1 to:nil do:[:el|
- aList add:el.
- el addVisibleChildrenTo:aList.
- ].
-!
-
-clearExpandedWhenLastChildWasRemoved
- ^ true
-!
-
-criticalDo:aBlock
- |model|
-
- (model := self model) notNil ifTrue:[
- model recursionLock critical:aBlock
- ] ifFalse:[
- aBlock value
- ]
-!
-
-listIndex
- "returns the visible index or nil; for a non-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 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
+makeWidthAndHeightUnknown
+ width := height := nil
!
setExpanded:aBoolean
@@ -1158,380 +81,10 @@
isExpanded := aBoolean
! !
-!HierarchicalItem methodsFor:'private-displaying'!
-
-displayLabel:aLabel h:lH on:aGC x:x y:y h:h
- <resource: #obsolete>
-
- "display the label at x@y"
-
- "/ obsolete - left in for backward compatibility
- self displayLabel:aLabel h:lH on:aGC x:x y:y h:h isHighlightedAsSelected:false
-!
-
-displayLabel:aLabel h:lH on:aGC x:x y:y h:h isHighlightedAsSelected:isHighlightedAsSelected
- "display the label at x@y"
-
- |y0 labelShown|
-
- lH ~~ 0 ifTrue:[
- y0 := y - ((lH + 1 - h) // 2).
- y0 := y0 + (aLabel ascentOn:aGC).
-
- (aLabel isString not
- or:[(aLabel includes:(Character cr)) not]) ifTrue:[
- labelShown := aLabel.
- isHighlightedAsSelected ifTrue:[
- (aLabel isText and:[aLabel hasChangeOfEmphasis]) ifTrue:[
- labelShown := Text string:aLabel string emphasisCollection:aLabel emphasis asArray.
- labelShown emphasisAllRemove:#color.
- ].
- ].
- ^ labelShown displayOn:aGC x:x y:y0
- ].
-
- labelShown asCollectionOfLines do:[:el|
- labelShown := el.
- isHighlightedAsSelected ifTrue:[
- (el isText and:[el hasChangeOfEmphasis]) ifTrue:[
- labelShown := Text string:el string emphasisCollection:el emphasis asArray.
- labelShown emphasisAllRemove:#color.
- ].
- ].
- labelShown displayOn:aGC x:x y:y0.
- y0 := y0 + (el heightOn:aGC)
- ]
- ].
-!
-
-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 for each child."
-
- ^ self nonCriticalFrom:1 to:nil do:aOneArgBlock
-!
-
-nonCriticalFrom:startIndex to:endIndex do:aOneArgBlock
- "evaluate a block noncritical for 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 for 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:aOneArgBlock
- "evaluate the block non critical for each item and all the sub-items"
-
- self nonCriticalFrom:1 to:nil do:[:eachChild|
- aOneArgBlock value:eachChild.
- eachChild nonCriticalRecursiveDo:aOneArgBlock
- ].
-!
-
-nonCriticalRecursiveReverseDo:aOneArgBlock
- "evaluate the block non critical for each item and all the sub-items;
- proccesing children in reverse direction"
-
- self nonCriticalFrom:1 to:nil reverseDo:[:eachChild|
- eachChild nonCriticalRecursiveReverseDo:aOneArgBlock.
- aOneArgBlock value:eachChild.
- ].
-!
-
-nonCriticalRecursiveSort:aSortBlock
- "evaluate a block noncritical for 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"
-
- self criticalDo:[
- self recursiveSetCollapsedHelper
- ]
-!
-
-recursiveSetCollapsedHelper
- "private helper.
- collapse all children and sub-children without notifications.
- Helper only - does not lock"
-
- isExpanded := false.
-
- "/ do not call #size: children will be autoloaded !!!!
- children size ~~ 0 ifTrue:[
- self nonCriticalFrom:1 to:nil do:[:eachChild|
- eachChild canRecursiveCollapse ifTrue:[
- eachChild recursiveSetCollapsedHelper
- ]
- ].
- ]
-!
-
-recursiveSetExpandedAndAddToList:aList
- "expand all children and sub-children without notifications;
- add children to list"
-
- self criticalDo:[
- self recursiveSetExpandedAndAddToListHelper:aList
- ].
-!
-
-recursiveSetExpandedAndAddToListHelper:aList
- "private helper.
- expand all children and sub-children without notifications; adds children to aList
- Helper only - does not lock"
-
- isExpanded := true.
-
- self nonCriticalFrom:1 to:nil do:[:eachChild|
- aList add:eachChild.
-
- eachChild canRecursiveExpand ifTrue:[
- eachChild recursiveSetExpandedAndAddToListHelper:aList.
- ].
- ].
-! !
-
-!HierarchicalItem methodsFor:'protocol-accessing'!
-
-children
- "returns a list of children. When first asked, the list is fetched, if it was
- built lazyly.
- *** to optimize: either redefine this or fetchChildren by subClass"
-
- children isNil ifTrue:[
- children := self fetchChildren
- ].
- ^ children
-!
-
-fetchChildren
- "should compute the list of children via the model.
- Be aware, that the somewhat stupid 'optimization' of how the model is fetched may lead to
- a O(n*log n) or even O(n^2) behavior here.
- *** to optimize: redefine by subClass"
-
- |model childrenFromModel|
-
- (model := self model) notNil ifTrue:[
- childrenFromModel := model childrenFor:self
- ].
- ^ childrenFromModel
-!
-
-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 items middleButtonMenu or nil if no menu is defined.
- If nil is returned, the view is asked for a menu."
-
- <resource: #programMenu>
-
- |model|
-
- (model := self model) notNil ifTrue:[
- ^ model middleButtonMenuFor:self
- ].
- ^ nil
-!
-
-recursiveSortChildren:aSortBlock
- |children|
-
- (children := self children) notEmptyOrNil 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"
-
- <resource: #obsolete>
- self obsoleteMethodWarning:'use #sort:'.
- self sort:aSortBlock.
-! !
-
!HierarchicalItem methodsFor:'protocol-displaying'!
-displayIcon:anIcon atX:x y:y on:aGC
- "called to draw the icon - can be redefined to manipulate the icon"
-
- anIcon displayOn:aGC x:x y:y.
-!
-
-displayOn:aGC x:x y:y h:h
- <resource: #obsolete>
- "draw the receiver in the graphicsContext, aGC"
-
- "/ obsolete - left here for backward compatibility
- self displayOn:aGC x:x y:y h:h isHighlightedAsSelected:false
-!
-
-displayOn:aGC x:x y:y h:h isHighlightedAsSelected:isHighlightedAsSelected
- "draw the receiver in the graphicsContext, aGC"
-
- |label
- x0 "{ Class:SmallInteger }"|
-
- label := self label.
- label isNil ifTrue:[^ self].
-
- (label isString or:[label isSequenceable not]) ifTrue:[
- ^ self displayLabel:label h:(self heightOn:aGC) on:aGC x:x y:y h:h isHighlightedAsSelected:isHighlightedAsSelected
- ].
-
- 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 isHighlightedAsSelected:isHighlightedAsSelected.
- x0 := x0 + 5 + (el widthOn:aGC).
- ].
- ]
-!
-
heightOn:aGC
- "return the width of the receiver, if it is to be displayed on aGC"
+ "return the height of the receiver, if it is to be displayed on aGC"
height isNil ifTrue:[
height := self heightOf:(self label) on:aGC
@@ -1548,331 +101,12 @@
^ width
! !
-!HierarchicalItem methodsFor:'protocol-event processing'!
-
-processButtonPress:button visibleX:visX visibleY: visY on: view
- "A mouse button was pressed on myself. The visX/visY coordinates
- are relative to the viewOrigin.
-
- If this method returns TRUE, the other method
- #processButtonPress:x:y:on: IS NOT CALLED !!!!!!
- "
-
- ^false
-
- "Created: / 18-04-2013 / 09:56:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified (comment): / 18-04-2013 / 11:04:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-processButtonPress:button x:x y:y
- "a mouse button was pressed in my label.
- Return true, if the event is eaten (ignored by the gc).
- By default, false is returned (should be handled by the gc)."
-
- ^ false
-!
-
-processButtonPress:button x:x y:y on:aGC
- "a mouse button was pressed in my label.
- Return true, if the event is eaten (ignored by the gc).
- By default, false is returned (should be handled by the gc)."
-
- ^ self processButtonPress:button x:x y:y
-!
-
-processButtonPressOnIcon:button on:aGC
- "a mouse button was pressed in my icon.
- Return true, if the event is eaten (ignored by the gc).
- By default, false is returned (should be handled by the gc)."
-
- ^ false
-! !
-
-!HierarchicalItem methodsFor:'protocol-monitoring'!
-
-monitoringCycle
- "called every '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
-!
-
-canExpand
- "called before expanding the item; can be redefined
- by subclass to omit the expand operation"
-
- ^ self hasChildren
-!
-
-canRecursiveCollapse
- "called before collapsing the item; can be redefined
- by subclass to omit the collapse operation "
-
- ^ self canCollapse
-!
-
-canRecursiveExpand
- "called before expanding the item; can be redefined
- by subclass to omit the collapse operation"
-
- ^ self canExpand
-!
-
-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 children;
- the list needs not to be loaded yet( example. FileDirectory ).
- *** to optimize: redefine in 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. Can be redefined in subclasses"
-
- ^ true
-!
-
-string
- "access the printable string used for stepping 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 not
-!
-
-isDirectoryItem
- ^ false
-
- "Created: / 23-06-2006 / 12:47:05 / fm"
- "Modified: / 23-02-2007 / 12:04:23 / User"
-!
-
isExpanded
"returns true if the item is expanded"
^ isExpanded
-!
-
-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:aOneArgBlock ifNone:exceptionValue
- "find the first child, for which evaluation of the block returns
- true; if none does so, return the value of anExceptionValue"
-
- self do:[:el|
- (aOneArgBlock value:el) ifTrue:[^ el]
- ].
- ^ exceptionValue 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:anExceptionValue
- "find the last child, for which evaluation of the block returns
- true; if none does so, return the value of anExceptionValue"
-
- self reverseDo:[:el| (aOneArgBlock value:el) ifTrue:[^ el] ].
- ^ anExceptionValue value
-!
-
-findFirst:aOneArgBlock
- "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| (aOneArgBlock 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:'sorting & reordering'!
-
-recursiveSort:aSortBlock
- "recursive sort the children inplace using the 2-arg block sortBlock for comparison"
-
- self criticalDo:[
- children notEmptyOrNil ifTrue:[
- self nonCriticalRecursiveSort:aSortBlock.
- self childrenOrderChanged.
- ]
- ].
-!
-
-sort:aSortBlock
- "sort the children inplace using the 2-arg block sortBlock for comparison"
-
- children notEmptyOrNil ifTrue: [
- self criticalDo:[
- "/ check again (asynchronous update was possible before)
- children notEmptyOrNil ifTrue: [
- children := children sort:aSortBlock.
- self childrenOrderChanged.
- ]
- ].
- ]
! !
!HierarchicalItem::Example class methodsFor:'instance creation'!
@@ -2015,10 +249,10 @@
!HierarchicalItem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalItem.st,v 1.110 2015-02-26 09:57:17 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalItem.st,v 1.111 2015-05-01 14:38:36 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalItem.st,v 1.110 2015-02-26 09:57:17 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalItem.st,v 1.111 2015-05-01 14:38:36 cg Exp $'
! !