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