Tools__ViewTreeModel.st
author sr
Fri, 23 Oct 2009 15:38:34 +0200
changeset 2682 54418b0e52fb
parent 2457 04459d76932e
permissions -rw-r--r--
some tries for UNIX - unfinished

"{ Package: 'stx:libtool2' }"

"{ NameSpace: Tools }"

ValueModel subclass:#ViewTreeModel
	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
		inputEventAction mappedViewAction beforeSelectionChangedAction
		icons timedUpdateTask selectOnClickHolder testModeChannel
		hasTargetWidgetChannel'
	classVariableNames:''
	poolDictionaries:''
	category:'A-Views-Support'
!

HierarchicalList subclass:#ItemList
	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
	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

        testModeChannel     <ValueHolder>       true, than running in test mode.

        hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped

        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.
!

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.
    self deselect.

    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'!

signalHiddenLevel
    "show the selection if signaled; increments hiddenLevel
     see: #waitHiddenLevel
    "
    (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
        hiddenLevel := 0.
        self invalidateSelection.
    ].
!

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:'aspects'!

hasTargetWidgetChannel
    "answer the channel which is set to true if a target widget exists"

    ^ hasTargetWidgetChannel
!

listOfItems
    "hiearchical list build from existing items"

    ^ listOfItems
!

selectOnClickHolder
    "boolean holder, which indicates whether the selection will change on click
    "
    ^ selectOnClickHolder
!

testModeChannel
    "answer a boolean channel which describes the behaviour how to process
     events on the target view.

     false: all input events are eaten and the selection is shown on the target view.
     true:  no  input events are eaten and no  selection is shown on the target view."

    ^ testModeChannel
! !

!ViewTreeModel methodsFor:'change & update'!

targetWidgetChanged
    hasTargetWidgetChannel value:(self rootItem notNil).
!

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.
    ].
!

update:something with:someArgument from:aModel

    aModel == testModeChannel ifTrue:[
        (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
            testModeChannel value ifTrue:[
                self redrawUnselected:selection andLock:false checkTestMode:false.
            ] ifFalse:[
                self invalidateSelection.
            ].
        ].
        ^ self
    ].
    super update:something with:someArgument from:aModel.
!

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 testMode|

    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
    ].
    testMode := testModeChannel value.

    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    := #().
    icons                 := IdentityDictionary new.

    hasTargetWidgetChannel := false asValue.
    selectOnClickHolder    := true asValue.

    testModeChannel := false asValue.
    testModeChannel addDependent:self.
! !

!ViewTreeModel methodsFor:'private selection'!

invalidateSelection
    "invalidate the current selection
    "
    |topView|

    testModeChannel value 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|

    testModeChannel value 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:[
        |list|

        list := selection.

        list size > 0 ifTrue:[
            topView paint:(Color black).
            topView clippedByChildren:false.

            list 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.
    "
    self redrawUnselected:aList andLock:doLock checkTestMode:true.
!

redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
    "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].
    ].
    checkTestMode ifTrue:[
        testModeChannel value 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
            ]
        ].

        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.
        ].

        (subViews := rootView subViews) notNil ifTrue:[
            subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
        ].
    ].
! !

!ViewTreeModel methodsFor:'queries'!

isInTestMode
    "answer false, all input events are eaten and the selection is shown on the target view.
     answer true,  no  input events are eaten and no  selection is shown on the target view."

    ^ testModeChannel value
! !

!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).
    ].
    treeModel notNil ifTrue:[
        treeModel targetWidgetChanged.
    ].
    
    ^ 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:'accessing look'!

additionalLabelForItem:anItem
    "answer the additional lable for an item or nil"

    |applClass|

    showWidgetNames == true ifTrue:[
        ^ '[', anItem widget name, ']'
    ].

    anItem isApplicationClass ifTrue:[
        applClass := anItem applicationClass.

        applClass notNil ifTrue:[
            ^ ('[', applClass name, ']')
        ].
    ].
    ^ nil
!

showWidgetNames
    "answer true if the additional text is the widget name
     otherwise the name of the application"

    ^ showWidgetNames ? false
!

showWidgetNames:aBoolean
    "set true if the additional text is the widget name
     otherwise the name of the application"

    self showWidgetNames == aBoolean ifFalse:[
        showWidgetNames := aBoolean.

        root notNil ifTrue:[
            root recursiveAdditionalNameBehaviourChanged.
            self changed.
        ].
    ].
! !

!ViewTreeModel::ItemList methodsFor:'event processing'!

processEvent:anEvent
    "post process event
    "
    ^ treeModel isInTestMode not
! !

!ViewTreeModel::ItemList methodsFor:'instance creation'!

on:aModel
    "set the model, a ViewTreeModel
    "
    treeModel := aModel.
    showRoot  := true.
    showWidgetNames := false.
! !

!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$'
! !