--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__ViewTreeModel.st Fri Sep 21 13:45:26 2007 +0200
@@ -0,0 +1,1243 @@
+"{ Package: 'stx:libtool2' }"
+
+"{ NameSpace: Tools }"
+
+ValueModel subclass:#ViewTreeModel
+ instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
+ inputEventAction mappedViewAction beforeSelectionChangedAction
+ testMode icons timedUpdateTask selectOnClickHolder'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'A-Views-Support'
+!
+
+HierarchicalList subclass:#ItemList
+ instanceVariableNames:'treeModel eventHook eventHookInitialized'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:ViewTreeModel
+!
+
+!ViewTreeModel class methodsFor:'documentation'!
+
+documentation
+"
+ Instances of ViewTreeModel can be used as model on a View and all
+ it contained subviews for a HierarchicalListView.
+ The model keeps two values, the hierarchical representation of the views
+ and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
+ It shows the selected items highlighted.
+
+
+ [Instance variables:]
+ lockSema <Semaphore> lock selection notifications and redraws
+
+ testMode <Boolean> true, the selection is not highlighted and
+ all input events are eaten.
+
+ selection <Sequence or nil> selected items or nil
+
+ hiddenLevel <Integer> internal use; redrawing the selection
+ only is done if the counter is 0.
+
+ listOfItems <HierarchicalList> hiearchical list build from existing items.
+
+ selectedSuperItems <Sequence> list of selected super items; items selected
+ but not contained in another selected item.
+
+ inputEventAction <Action> called for each InputEvent
+
+ mappedViewAction <Action> called for a new mapped view which
+ can not be found in the current item list.
+
+ beforeSelectionChangedAction <Action> called before the selection changed
+
+ [author:]
+ Claus Atzkern
+
+ [see also:]
+ ViewTreeItem
+"
+!
+
+examples
+"
+ example 1: pick any window and show views and contained views
+ [exBegin]
+ |top sel model panel|
+
+ model := ViewTreeModel new.
+ top := StandardSystemView new; extent:440@400.
+ sel := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
+ sel bottomInset:24.
+
+ panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
+ panel topInset:-24.
+ panel horizontalLayout:#fitSpace.
+
+ Button label:'Exit' action:[model rootItem:nil. top destroy] in:panel.
+ Button label:'Pick Views' action:[ |win|
+ ( (win := Screen current viewFromUser) notNil
+ and:[(win := win topView) ~~ Screen current rootView
+ and:[win ~~ top]]
+ ) ifTrue:[
+ model rootItem:(ViewTreeItem buildViewsFrom:win)
+ ] ifFalse:[
+ model rootItem:nil
+ ]
+ ] in:panel.
+
+ sel multipleSelectOk:true.
+ sel list:model listOfItems.
+ sel model:model.
+ sel useIndex:false.
+
+ sel doubleClickAction:[:i| |el|
+ el := model listOfItems at:i.
+ el spec notNil ifTrue:[ el spec inspect ] ifFalse:[ el widget inspect ]
+ ].
+ sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
+
+ model inputEventAction:[:anEvent| |item|
+ anEvent isButtonEvent ifTrue:[
+ anEvent isButtonPressEvent ifTrue:[
+ model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
+ ] ifFalse:[
+ anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
+ (item := model selectedItem) notNil ifTrue:[item widget inspect]
+ ]
+ ]
+ ]
+ ].
+
+ top openAndWait.
+ [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
+
+ [exEnd]
+"
+! !
+
+!ViewTreeModel methodsFor:'accessing'!
+
+application:anApplication
+ listOfItems application:anApplication.
+!
+
+listOfItems
+ "hiearchical list build from existing items
+ "
+ ^ listOfItems
+!
+
+rootItem
+ "get the rootItem the event viewer is established on
+ "
+ ^ listOfItems root
+!
+
+rootItem:anItem
+ "set the rootItem the event viewer is established on
+ "
+ |expanded|
+
+ timedUpdateTask := nil.
+
+ lockSema critical:[
+ anItem notNil ifTrue:[ expanded := anItem isExpanded ]
+ ifFalse:[ expanded := false ].
+
+ self value:nil.
+ listOfItems root:anItem.
+
+ anItem notNil ifTrue:[
+ timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
+ timedUpdateTask name:'Update'.
+ timedUpdateTask resume.
+ ].
+ ].
+
+ (expanded and:[anItem notNil]) ifTrue:[
+ anItem expand
+ ].
+ ^ anItem
+!
+
+rootView
+ "get the top widget the event viewer is established on, a View
+ "
+ ^ listOfItems rootView
+! !
+
+!ViewTreeModel methodsFor:'accessing actions'!
+
+beforeSelectionChangedAction
+ "none argument action which is called before
+ the selection changed
+ "
+ ^ beforeSelectionChangedAction
+!
+
+beforeSelectionChangedAction:aNoneArgBlock
+ "none argument action which is called before
+ the selection changed
+ "
+ beforeSelectionChangedAction := aNoneArgBlock.
+!
+
+inputEventAction
+ "called for each input event; the argument to the action is the WindowEvent
+ "
+ ^ inputEventAction
+!
+
+inputEventAction:aOneArgActionTheEvent
+ "called for each input event; the argument to the action is the WindowEvent
+ "
+ inputEventAction := aOneArgActionTheEvent.
+!
+
+mappedViewAction
+ "called for a new mapped view which can not be found
+ in the current item list
+ "
+ ^ mappedViewAction
+!
+
+mappedViewAction:aOneArgBlockTheMappedView
+ "called for a new mapped view which can not be found
+ in the current item list
+ "
+ mappedViewAction := aOneArgBlockTheMappedView
+! !
+
+!ViewTreeModel methodsFor:'accessing look'!
+
+iconAt:aKey ifNonePut:aNoneArgBlock
+ |icon view|
+
+ icon := icons at:aKey ifAbsent:nil.
+ icon notNil ifTrue:[^ icon].
+
+ icon := aNoneArgBlock value.
+ icon isNil ifTrue:[^ nil].
+
+ view := self rootView.
+ view isNil ifTrue:[^ icon].
+
+ icon := icon copy onDevice:(view device).
+ icon isImage ifTrue:[
+ icon clearMaskedPixels.
+ ].
+ icons at:aKey put:icon.
+ ^ icon
+! !
+
+!ViewTreeModel methodsFor:'accessing visibility'!
+
+selectOnClickHolder
+ "boolean holder, which indicates whether the selection will change on click
+ "
+ ^ selectOnClickHolder
+!
+
+signalHiddenLevel
+ "show the selection if signaled; increments hiddenLevel
+ see: #waitHiddenLevel
+ "
+ (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
+ hiddenLevel := 0.
+ self invalidateSelection.
+ ].
+!
+
+testMode
+ "false, than all input events are eaten and the selection
+ is shown on the target view
+ "
+ ^ testMode
+!
+
+testMode:aBoolean
+ "false, than all input events are eaten and the selection
+ is shown on the target view
+ "
+ testMode ~~ aBoolean ifTrue:[
+ self withSelectionHiddenDo:[
+ self value:nil.
+ testMode := aBoolean.
+ ].
+ ].
+!
+
+waitHiddenLevel
+ "hide the selection until signaled; increments hiddenLevel
+ see: #signalHiddenLevel
+ "
+ self redrawUnselected:selection andLock:true
+!
+
+withSelectionHiddenDo:aNoneArgumentBlock
+ "apply block with selection hidden
+ "
+
+ [ self waitHiddenLevel.
+
+ aNoneArgumentBlock value
+
+ ] valueNowOrOnUnwindDo:[
+ self signalHiddenLevel.
+ ].
+! !
+
+!ViewTreeModel methodsFor:'change & update'!
+
+timedUpdateTaskCycle
+ |view myTaskId|
+
+ myTaskId := timedUpdateTask.
+
+ listOfItems root notNil ifTrue:[
+ view := listOfItems root widget.
+ ].
+
+ [ view notNil ] whileTrue:[
+ Delay waitForSeconds:0.5.
+
+ (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
+ view := nil.
+ ] ifTrue:[
+ (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
+ view sensor pushUserEvent:#updateChildren for:self.
+ ].
+ ].
+ ].
+ timedUpdateTask == myTaskId ifTrue:[
+ timedUpdateTask := nil.
+ listOfItems root:nil.
+ ].
+!
+
+updateChildren
+ |rootItem|
+
+ rootItem := listOfItems root.
+ rootItem isNil ifTrue:[^ self].
+
+ rootItem exists ifFalse:[
+ listOfItems root:nil.
+ ] ifTrue:[
+ rootItem updateChildren.
+ ].
+! !
+
+!ViewTreeModel methodsFor:'event processing'!
+
+processEvent:anEvent
+ "catch and process all WindowEvents for the rootComponent and its contained
+ widgets; redraw selection in case of damage ....
+ "
+ |evView item rootView|
+
+ evView := anEvent view.
+ evView isNil ifTrue:[
+ (anEvent isMessageSendEvent and:[anEvent receiver == self]) ifFalse:[
+ ^ false
+ ].
+ anEvent value.
+ ^ true.
+ ].
+ rootView := listOfItems rootView.
+ rootView isNil ifTrue:[ ^ false ].
+
+ anEvent isConfigureEvent ifTrue:[
+ hiddenLevel == 0 ifTrue:[
+ self redrawUnselected:selection andLock:false.
+ ].
+ ^ false
+ ].
+
+ "/ check whether view is contained within the rootView
+ (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
+ ^ false
+ ].
+
+ anEvent isInputEvent ifFalse:[
+ anEvent isDamage ifTrue:[
+ hiddenLevel == 0 ifTrue:[self invalidateSelection].
+ ^ false
+ ].
+
+ anEvent isMapEvent ifTrue:[
+ mappedViewAction notNil ifTrue:[
+ item := listOfItems recursiveDetect:[:el| el widget == evView].
+ item isNil ifTrue:[ mappedViewAction value:evView ]
+ ].
+ ^ false
+ ].
+
+ anEvent type == #terminate ifTrue:[
+ item := listOfItems recursiveDetect:[:el| el widget == evView].
+ item notNil ifTrue:[ self processTerminateForItem:item ].
+ ^ false
+ ].
+ ^ false
+ ].
+ anEvent isFocusEvent ifTrue:[
+ evView == rootView ifTrue:[
+ self invalidateSelection
+ ].
+ ^ testMode not.
+ ].
+ anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
+
+ testMode ifFalse:[
+ inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
+ ] ifTrue:[
+ anEvent isButtonPressEvent ifTrue:[
+ selectOnClickHolder value ifTrue:[
+ self selectItem:(listOfItems detectItemRespondsToView:evView).
+ ].
+ ]
+ ].
+
+ (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
+ hiddenLevel := 1.
+ self signalHiddenLevel.
+ ].
+
+ ^ testMode not
+!
+
+processTerminateForItem:anItem
+ "received terminate for an item
+ "
+ anItem remove.
+! !
+
+!ViewTreeModel methodsFor:'initialization'!
+
+initialize
+ "setup the default attributes
+ "
+ super initialize.
+
+ hiddenLevel := 0.
+ lockSema := RecursionLock new.
+ listOfItems := ItemList new on:self.
+ selectedSuperItems := #().
+ testMode := false.
+ icons := IdentityDictionary new.
+ selectOnClickHolder := true asValue.
+! !
+
+!ViewTreeModel methodsFor:'private selection'!
+
+invalidateSelection
+ "invalidate the current selection
+ "
+ |topView|
+
+ testMode ifTrue:[ ^ self ]. "/ test whether running testMode
+
+ ( hiddenLevel == 0
+ and:[selection notNil
+ and:[(topView := listOfItems rootView) notNil
+ and:[topView shown]]]
+ ) ifTrue:[
+ topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
+ ]
+!
+
+recursiveRepair:theDamages startIn:aView relativeTo:aRootView
+ "repair all views and contained views, which intersects the damage.
+ !!!! all damages repaired are removed from the list of damages !!!!
+ "
+ |color relOrg damage subViews repaired
+ bwWidth "{ Class:SmallInteger }"
+ x "{ Class:SmallInteger }"
+ y "{ Class:SmallInteger }"
+ w "{ Class:SmallInteger }"
+ h "{ Class:SmallInteger }"
+ relOrgX "{ Class:SmallInteger }"
+ relOrgY "{ Class:SmallInteger }"
+ width "{ Class:SmallInteger }"
+ height "{ Class:SmallInteger }"
+ size "{ Class:SmallInteger }"
+ |
+ (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
+
+ subViews := aView subViews.
+
+ subViews size ~~ 0 ifTrue:[
+ subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
+ theDamages isEmpty ifTrue:[ ^ self ].
+ ].
+
+ relOrg := aView originRelativeTo:aRootView.
+ bwWidth := aView borderWidth.
+ size := theDamages size.
+
+ "/ compute relative origin starting from border left@top
+ relOrgX := relOrg x - bwWidth.
+ relOrgY := relOrg y - bwWidth.
+ width := aView width + bwWidth + bwWidth.
+ height := aView height + bwWidth + bwWidth.
+
+ size to:1 by:-1 do:[:anIndex|
+ repaired := damage := theDamages at:anIndex.
+
+ "/ compute the rectangle into the view
+ y := damage top - relOrgY.
+ x := damage left - relOrgX.
+ w := damage width.
+ h := damage height.
+
+ x < 0 ifTrue:[ w := w + x. x := 0. repaired := nil ].
+ y < 0 ifTrue:[ h := h + y. y := 0. repaired := nil ].
+ x + w > width ifTrue:[ w := width - x. repaired := nil ].
+ y + h > height ifTrue:[ h := height - y. repaired := nil ].
+
+ (w > 0 and:[h > 0]) ifTrue:[
+ bwWidth ~~ 0 ifTrue:[
+ color isNil ifTrue:[
+ "/ must force redraw of border
+ color := aView borderColor.
+ aView borderColor:(Color colorId:1).
+ aView borderColor:color.
+ ].
+ w := w - bwWidth.
+ h := h - bwWidth.
+
+ (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
+ (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
+
+ h > 0 ifFalse:[w := 0]. "/ later testing on width only
+ ].
+
+ w > 0 ifTrue:[
+ aView clearRectangleX:x y:y width:w height:h.
+ aView exposeX:x y:y width:w height:h
+ ].
+ repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
+ ]
+ ].
+!
+
+redrawSelection
+ "redraw all items selected
+ "
+ |topView size|
+
+ testMode ifTrue:[ ^ self ]. "/ test whether running testMode
+
+ ( hiddenLevel == 0
+ and:[(size := selection size) > 0
+ and:[(topView := listOfItems rootView) notNil
+ and:[topView shown
+ and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
+ ) ifFalse:[
+ ^ self
+ ].
+
+ lockSema critical:[
+ topView paint:(Color black).
+
+ topView clippedByChildren:false.
+
+ selection keysAndValuesReverseDo:[:anIndex :anItem|
+ (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
+
+ anItem handlesDo:[:aRect :what|
+ what isNil ifTrue:[topView displayRectangle:aRect]
+ ifFalse:[topView fillRectangle:aRect]
+ ]
+ ].
+ topView clippedByChildren:true.
+ ].
+!
+
+redrawUnselected:aList andLock:doLock
+ "redraw all items unselected; if doLock is true, the hiddenLevel
+ is incremented and thus the select mechanism is locked.
+ "
+ |rootView damages subViews x y w h|
+
+ doLock ifTrue:[
+ hiddenLevel := hiddenLevel + 1.
+ hiddenLevel ~~ 1 ifTrue:[^ self].
+ ] ifFalse:[
+ hiddenLevel ~~ 0 ifTrue:[^ self].
+ ].
+ testMode ifTrue:[ ^ self ]. "/ test whether running testMode
+
+ ( aList size ~~ 0
+ and:[(rootView := listOfItems rootView) notNil
+ and:[rootView shown]]
+ ) ifFalse:[
+ ^ self
+ ].
+
+ lockSema critical:[
+ damages := OrderedCollection new:(8 * aList size).
+
+ aList do:[:item|
+ item handlesDo:[:handle :what|
+ damages reverseDo:[:el|
+ (el intersects:handle) ifTrue:[
+ damages removeIdentical:el.
+
+ handle left:(handle left min:el left)
+ right:(handle right max:el right)
+ top:(handle top min:el top)
+ bottom:(handle bottom max:el bottom)
+ ]
+ ].
+ damages add:handle
+ ]
+ ].
+ rootView clippedByChildren:false.
+
+ damages do:[:el|
+ x := el left.
+ y := el top.
+ w := el width.
+ h := el height.
+
+ rootView clearRectangleX:x y:y width:w height:h.
+ rootView exposeX:x y:y width:w height:h.
+ ].
+ rootView clippedByChildren:true.
+
+ (subViews := rootView subViews) notNil ifTrue:[
+ subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
+ ].
+ ].
+! !
+
+!ViewTreeModel methodsFor:'selection accessing'!
+
+at:anIndex
+ "returns the selected item at an index or nil
+ "
+ selection notNil ifTrue:[
+ ^ selection at:anIndex ifAbsent:nil
+ ].
+ ^ nil
+!
+
+at:anIndex ifAbsent:aBlock
+ "returns the selected item at an index or the result of the block
+ "
+ selection notNil ifTrue:[
+ ^ selection at:anIndex ifAbsent:aBlock
+ ].
+ ^ aBlock value
+!
+
+first
+ "returns the first selected item or nil
+ "
+ ^ self at:1
+!
+
+last
+ "returns the last selected item or nil
+ "
+ ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
+!
+
+selectedItem
+ "returns the single selected item or nil (size ~~ 1 nil is returned)
+ "
+ ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
+!
+
+selectedSuperItems
+ "returs the list of selected superItems; items selected
+ but not contained in another selected item.
+ "
+ ^ selectedSuperItems
+!
+
+size
+ "returns the number of items selected
+ "
+ ^ selection size
+! !
+
+!ViewTreeModel methodsFor:'selection adding & removing'!
+
+add:item
+ "add an item to the current selection
+ "
+ |newSelect|
+
+ item isNil ifTrue:[^ item].
+
+ lockSema critical:[
+ selection isNil ifTrue:[
+ newSelect := Array with:item.
+ ] ifFalse:[
+ (self includes:item) ifFalse:[
+ newSelect := selection copyWith:item
+ ]
+ ].
+
+ newSelect size ~~ selection size ifTrue:[
+ item makeVisible.
+ self value:newSelect
+ ]
+ ].
+ ^ item
+!
+
+addAll:aCollectionOfItems
+ "add a collection of items to the current selection
+ "
+ |newSelect|
+
+ aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
+
+ lockSema critical:[
+ selection isNil ifTrue:[
+ newSelect := Array withAll:aCollectionOfItems.
+ ] ifFalse:[
+ newSelect := OrderedCollection withAll:selection.
+
+ aCollectionOfItems do:[:el|
+ (selection includesIdentical:el) ifFalse:[newSelect add:el]
+ ].
+ ].
+ self value:newSelect.
+ ].
+ ^ aCollectionOfItems
+!
+
+deselect
+ "clear the selection
+ "
+ self value:nil.
+!
+
+remove:item
+ "remove the item from the current selection
+ "
+ |newSelect|
+
+ item isNil ifTrue:[^ nil].
+
+ lockSema critical:[
+ (selection notNil and:[selection includesIdentical:item]) ifTrue:[
+ selection size == 1 ifTrue:[ newSelect := nil ]
+ ifFalse:[ newSelect := selection copyWithout:item ].
+
+ self value:newSelect
+ ].
+ ].
+ ^ item
+!
+
+removeAll
+ "clear the selection
+ "
+ self deselect.
+!
+
+removeAll:loItems
+ "remove all items of the collection from the current selection
+ "
+ |newSelect|
+
+ selection isNil ifTrue:[ ^ loItems ].
+ loItems size == 0 ifTrue:[ ^ loItems ].
+
+ lockSema critical:[
+ selection notNil ifTrue:[
+ newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
+ self value:newSelect.
+ ]
+ ].
+ ^ loItems
+!
+
+selectAll
+ "select all items
+ "
+ |root newSelection|
+
+ root := listOfItems root.
+
+ root isNil ifTrue:[
+ newSelection := nil
+ ] ifFalse:[
+ newSelection := OrderedCollection new.
+ root recursiveDo:[:el| newSelection add:el ].
+ ].
+ self value:newSelection.
+!
+
+selectItem:anItem
+ "set the current selection to the item
+ "
+ self value:anItem
+!
+
+selectRootItem
+ "set the current selection to the root item
+ "
+ self value:(self rootItem).
+!
+
+selectedItem:anItem
+ "set the current selection to the item
+ "
+ self selectItem:anItem.
+!
+
+toggleSelectItem:anItem
+ "toggle selection-state of the item; add or remove the item from the
+ current selection.
+ "
+ anItem notNil ifTrue:[
+ (self includes:anItem) ifTrue:[self remove:anItem]
+ ifFalse:[self add:anItem]
+ ].
+ ^ anItem
+! !
+
+!ViewTreeModel methodsFor:'selection enumerating'!
+
+collect:aBlock
+ "for each element in the selection, evaluate the argument, aBlock
+ and return a new collection with the results
+ "
+ |res|
+
+ res := OrderedCollection new.
+ self do:[:el| res add:(aBlock value:el)].
+ ^ res
+!
+
+do:aOneArgBlock
+ "evaluate the argument, aBlock for each item in the selection
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ nil].
+ ^ cashedSelection do:aOneArgBlock
+!
+
+from:start do:aOneArgBlock
+ "evaluate the argument, aBlock for the items starting at index start
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ nil].
+ ^ cashedSelection from:start do:aOneArgBlock
+!
+
+from:start to:stop do:aOneArgBlock
+ "evaluate the argument, aBlock for the items with index start to
+ stop in the selection.
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ nil].
+ ^ cashedSelection from:start to:stop do:aOneArgBlock
+!
+
+reverseDo:aOneArgBlock
+ "evaluate the argument, aBlock for each item in the selection
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ nil].
+ ^ cashedSelection reverseDo:aOneArgBlock
+!
+
+select:aBlock
+ "return a new collection with all elements from the selection, for which
+ the argument aBlock evaluates to true.
+ "
+ |res|
+
+ res := OrderedCollection new.
+ self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
+ ^ res
+! !
+
+!ViewTreeModel methodsFor:'selection protocol'!
+
+changed:aParameter with:oldSelection
+ "update the visibility staus of the current selection
+ "
+ |unselected rootView rootItem selSize|
+
+ selSize := selection size.
+
+ selSize == 0 ifTrue:[
+ selectedSuperItems := #().
+ ] ifFalse:[
+ selSize == 1 ifTrue:[
+ selectedSuperItems := Array with:(selection at:1).
+ ] ifFalse:[
+ rootItem := listOfItems root.
+
+ (selection includesIdentical:rootItem) ifTrue:[
+ selectedSuperItems := Array with:rootItem.
+ ] ifFalse:[
+ selectedSuperItems := OrderedCollection new:selSize.
+
+ selection do:[:anItem|
+ anItem parentsDetect:[:el| selection includesIdentical:el ]
+ ifNone:[ selectedSuperItems add:anItem ].
+ ].
+ ]
+ ]
+ ].
+
+ ( hiddenLevel == 0
+ and:[(rootView := listOfItems rootView) notNil
+ and:[rootView shown]]
+ ) ifTrue:[
+ selSize == 0 ifTrue:[
+ "/ must redraw the old selection unselected
+ self redrawUnselected:oldSelection andLock:false
+ ] ifFalse:[
+ self invalidateSelection.
+
+ oldSelection size ~~ 0 ifTrue:[
+ "/ must redraw all elements no longer in the selection
+ unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
+ self redrawUnselected:unselected andLock:false.
+ ]
+ ]
+ ].
+ super changed:aParameter with:oldSelection.
+!
+
+setValue:aNewSelection
+ "set the selection without notifying
+ "
+ |newSelect idx|
+
+ newSelect := nil.
+
+ aNewSelection notNil ifTrue:[
+ lockSema critical:[
+ aNewSelection isCollection ifFalse:[
+ (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
+ newSelect := selection
+ ] ifFalse:[
+ newSelect := Array with:aNewSelection.
+ ]
+ ] ifTrue:[
+ aNewSelection notEmpty ifTrue:[
+ aNewSelection size ~~ selection size ifTrue:[
+ newSelect := aNewSelection copy.
+ ] ifFalse:[
+ idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
+
+ idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
+ ifFalse:[newSelect := selection ].
+ ]
+ ]
+ ]
+ ].
+ ].
+ newSelect ~~ selection ifTrue:[
+ beforeSelectionChangedAction value.
+ selection := newSelect.
+ selection notNil ifTrue:[selection do:[:el| el makeVisible]]
+ ].
+!
+
+triggerValue:aValue
+ "set my value & send change notifications to my dependents.
+ Send the change message even if the value didn't change.
+ "
+ |oldSelection|
+
+ lockSema critical:[
+ oldSelection := selection.
+ self setValue:aValue.
+ self changed:#value with:oldSelection
+ ]
+!
+
+value
+ "returns the current selection
+ "
+ ^ selection ? #()
+!
+
+value:aValue
+ "change the current selection and send change notifications to my
+ dependents if it changed.
+ "
+ |oldSelection|
+
+ lockSema critical:[
+ oldSelection := selection.
+ self setValue:aValue.
+
+ oldSelection == selection ifFalse:[
+ self changed:#value with:oldSelection
+ ]
+ ].
+! !
+
+!ViewTreeModel methodsFor:'selection searching'!
+
+detect:aBlock
+ "evaluate the argument, aBlock for each item in the selection until
+ the block returns true; in this case return the element which caused
+ the true evaluation.
+ If none of the evaluations returns true, an error is raised
+ "
+ ^ self detect:aBlock ifNone:[self errorNotFound]
+!
+
+detect:aBlock ifNone:exceptionBlock
+ "evaluate the argument, aBlock for each item in the selection until the
+ block returns true; in this case return the element which caused the
+ true evaluation.
+ If none of the evaluations returns true, the result of the evaluation
+ of the exceptionBlock is returned
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
+ ^ cashedSelection detect:aBlock ifNone:exceptionBlock
+!
+
+detectLast:aBlock
+ "evaluate the argument, aBlock for each item in the selection until
+ the block returns true; in this case return the element which caused
+ the true evaluation. The items are processed in reverse order.
+ If none of the evaluations returns true, an error is raised
+ "
+ ^ self detectLast:aBlock ifNone:[self errorNotFound]
+!
+
+detectLast:aBlock ifNone:exceptionBlock
+ "evaluate the argument, aBlock for each item in the selection until
+ the block returns true; in this case return the element which caused
+ the true evaluation. The items are processed in reverse order.
+ If none of the evaluations returns true, the result of the evaluation
+ of the exceptionBlock is returned
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
+ ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
+! !
+
+!ViewTreeModel methodsFor:'selection testing'!
+
+includes:anItem
+ "returns true if the item is in the current selection
+ "
+ |cashedSelection|
+
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[^ false].
+ ^ cashedSelection includesIdentical:anItem
+!
+
+includesAll:aCollection
+ "return true, if all items of the collection are included in the current selection
+ "
+ |cashedSelection|
+
+ aCollection size ~~ 0 ifTrue:[
+ cashedSelection := selection.
+ cashedSelection isNil ifTrue:[ ^ false ].
+
+ aCollection do:[:el|
+ (cashedSelection includesIdentical:el) ifFalse:[^ false]
+ ]
+ ].
+ ^ true
+!
+
+includesAny:aCollection
+ "return true, if the any item of the collection is in the current selection
+ "
+ |cashedSelection|
+
+ aCollection notNil ifTrue:[
+ cashedSelection := selection.
+
+ cashedSelection notNil ifTrue:[
+ aCollection do:[:el|
+ (cashedSelection includesIdentical:el) ifTrue:[^ true]
+ ]
+ ]
+ ].
+ ^ false
+!
+
+includesIdentical:anItem
+ "returns true if the item is in the current selection
+ "
+ ^ self includes:anItem
+!
+
+isEmpty
+ "returns true if the current selection is empty
+ "
+ ^ selection size == 0
+!
+
+isSelected:anItem
+ "returns true if the item is in the current selection
+ "
+ ^ self includes:anItem
+!
+
+notEmpty
+ "returns true if the current selection is not empty
+ "
+ ^ selection size ~~ 0
+! !
+
+!ViewTreeModel::ItemList class methodsFor:'documentation'!
+
+documentation
+"
+ Kind of HierarchicalList class which contains all the visible
+ ViewTreeItem's and the root, the anchor of the hierarchical list.
+
+ [Instance variables:]
+ treeModel <ViewTreeModel> all events are delegated to
+ eventHook <BlockValue> save and resore the pre/post -EventHook
+
+
+ [author:]
+ Claus Atzkern
+
+ [see also:]
+ HierarchicalList
+ ViewTreeModel
+ ViewTreeItem
+"
+! !
+
+!ViewTreeModel::ItemList methodsFor:'accessing'!
+
+root:theRoot
+ "set the root item; delegate events to my treeModel
+ "
+ |rootView|
+
+ theRoot == root ifTrue:[^ self].
+
+ rootView := self rootView.
+ super root:theRoot.
+
+ rootView notNil ifTrue:[ |wgrp|
+ wgrp := rootView windowGroup.
+
+ wgrp notNil ifTrue:[
+ wgrp removePreEventHook:treeModel.
+ wgrp removePostEventHook:self.
+ ].
+ ].
+
+ super root:theRoot.
+ rootView := self rootView.
+
+ rootView notNil ifTrue:[
+ "must setup a task because there might not exist a windowGroup at the moment
+ "
+ [ |wgrp|
+
+ [rootView == self rootView] whileTrue:[
+ wgrp := rootView windowGroup.
+ wgrp notNil ifTrue:[
+ rootView := nil.
+ wgrp addPreEventHook:treeModel.
+ wgrp addPostEventHook:self.
+ ] ifFalse:[
+ Delay waitForMilliseconds:100.
+ ].
+ ].
+
+ ] forkAt:(Processor userSchedulingPriority + 2).
+ ].
+ ^ root.
+!
+
+rootView
+ "returns the widget assigned to the root or nil
+ "
+ ^ root notNil ifTrue:[root widget] ifFalse:[nil]
+!
+
+treeModel
+ "returne the treeModel, a ViewTreeModel
+ "
+ ^ treeModel
+! !
+
+!ViewTreeModel::ItemList methodsFor:'event processing'!
+
+processEvent:anEvent
+ "post process event
+ "
+ ^ treeModel testMode not
+! !
+
+!ViewTreeModel::ItemList methodsFor:'instance creation'!
+
+on:aModel
+ "set the model, a ViewTreeModel
+ "
+ treeModel := aModel.
+ showRoot := true.
+! !
+
+!ViewTreeModel::ItemList methodsFor:'searching'!
+
+detectItemRespondsToView:aView
+ "returns the bottom-most item which contains the view
+ "
+ |view item topView|
+
+ root notNil ifTrue:[
+ view := aView.
+ topView := root widget.
+
+ [ view notNil ] whileTrue:[
+ topView == view ifTrue:[^ root].
+ item := root recursiveDetect:[:el| el widget == view ].
+ item notNil ifTrue:[^ item].
+ view := view superView
+ ]
+ ].
+ ^ nil
+!
+
+recursiveDetect:aOneOrgBlock
+ "recursive find the first child, for which evaluation
+ of the block returns true; if none nil is returned
+ "
+ root notNil ifTrue:[
+ (aOneOrgBlock value:root) ifTrue:[ ^ root ].
+ ^ root recursiveDetect:aOneOrgBlock
+ ].
+ ^ nil
+! !
+
+!ViewTreeModel class methodsFor:'documentation'!
+
+version
+ ^ '$Header$'
+! !