--- a/Tools__ViewTreeModel.st Wed Feb 03 11:02:07 2010 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,1338 +0,0 @@
-"{ 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$'
-! !