diff -r f8dd64f73dfc -r eef25c370979 Tools__ViewTreeModel.st
--- /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$'
+! !