Tools__ViewTreeModel.st
author Claus Gittinger <cg@exept.de>
Wed, 29 Jul 2009 20:02:02 +0200
changeset 2570 4e663bc64364
parent 2457 04459d76932e
permissions -rw-r--r--
changed #requestPackage
     1 "{ Package: 'stx:libtool2' }"
     2 
     3 "{ NameSpace: Tools }"
     4 
     5 ValueModel subclass:#ViewTreeModel
     6 	instanceVariableNames:'lockSema selectedSuperItems selection hiddenLevel listOfItems
     7 		inputEventAction mappedViewAction beforeSelectionChangedAction
     8 		icons timedUpdateTask selectOnClickHolder testModeChannel
     9 		hasTargetWidgetChannel'
    10 	classVariableNames:''
    11 	poolDictionaries:''
    12 	category:'A-Views-Support'
    13 !
    14 
    15 HierarchicalList subclass:#ItemList
    16 	instanceVariableNames:'treeModel eventHook eventHookInitialized showWidgetNames'
    17 	classVariableNames:''
    18 	poolDictionaries:''
    19 	privateIn:ViewTreeModel
    20 !
    21 
    22 !ViewTreeModel class methodsFor:'documentation'!
    23 
    24 documentation
    25 "
    26     Instances of ViewTreeModel can be used as model on a View and all
    27     it contained subviews for a HierarchicalListView.
    28     The model keeps two values, the hierarchical representation of the views
    29     and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's.
    30     It shows the selected items highlighted.
    31 
    32 
    33     [Instance variables:]
    34         lockSema            <Semaphore>         lock selection notifications and redraws
    35 
    36         testModeChannel     <ValueHolder>       true, than running in test mode.
    37 
    38         hasTargetWidgetChannel <ValueHolder>    true, than any target view is grapped
    39 
    40         selection           <Sequence or nil>   selected items or nil
    41 
    42         hiddenLevel         <Integer>           internal use; redrawing the selection
    43                                                 only is done if the counter is 0.
    44 
    45         listOfItems         <HierarchicalList>  hiearchical list build from existing items.
    46 
    47         selectedSuperItems  <Sequence>          list of selected super items; items selected
    48                                                 but not contained in another selected item.
    49 
    50         inputEventAction    <Action>            called for each InputEvent
    51 
    52         mappedViewAction    <Action>            called for a new mapped view which
    53                                                 can not be found in the current item list.
    54 
    55         beforeSelectionChangedAction <Action>   called before the selection changed
    56 
    57     [author:]
    58         Claus Atzkern
    59 
    60     [see also:]
    61         ViewTreeItem
    62 "
    63 !
    64 
    65 examples
    66 "
    67     example 1: pick any window and show views and contained views
    68                                                                                 [exBegin]
    69     |top sel model panel|
    70 
    71     model := ViewTreeModel new.
    72     top   := StandardSystemView new; extent:440@400.
    73     sel   := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top.
    74     sel bottomInset:24.
    75 
    76     panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top.
    77     panel topInset:-24.
    78     panel horizontalLayout:#fitSpace.
    79 
    80     Button label:'Exit'       action:[model rootItem:nil. top destroy] in:panel.
    81     Button label:'Pick Views' action:[  |win|
    82                                         (     (win := Screen current viewFromUser) notNil
    83                                          and:[(win := win topView) ~~ Screen current rootView
    84                                          and:[win ~~ top]]
    85                                         ) ifTrue:[
    86                                             model rootItem:(ViewTreeItem buildViewsFrom:win)
    87                                         ] ifFalse:[
    88                                             model rootItem:nil
    89                                         ]
    90                                      ] in:panel.
    91 
    92     sel  multipleSelectOk:true.
    93     sel              list:model listOfItems.
    94     sel             model:model.
    95     sel          useIndex:false.
    96 
    97     sel doubleClickAction:[:i| |el|
    98         el := model listOfItems at:i.
    99         el spec notNil ifTrue:[ el spec   inspect ] ifFalse:[ el widget inspect ]
   100     ].
   101     sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ].
   102 
   103     model inputEventAction:[:anEvent| |item|
   104         anEvent isButtonEvent ifTrue:[
   105             anEvent isButtonPressEvent ifTrue:[
   106                 model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)).
   107             ] ifFalse:[
   108                 anEvent type == #'buttonMultiPress:x:y:' ifTrue:[
   109                     (item := model selectedItem) notNil ifTrue:[item widget inspect]
   110                 ]
   111             ]
   112         ]
   113     ].
   114 
   115     top openAndWait.
   116     [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8
   117 
   118                                                                                 [exEnd]
   119 "
   120 ! !
   121 
   122 !ViewTreeModel methodsFor:'accessing'!
   123 
   124 application:anApplication
   125     listOfItems application:anApplication.
   126 !
   127 
   128 rootItem
   129     "get the rootItem the event viewer is established on
   130     "
   131     ^ listOfItems root
   132 !
   133 
   134 rootItem:anItem
   135     "set the rootItem the event viewer is established on
   136     "
   137     |expanded|
   138 
   139     timedUpdateTask := nil.
   140     self deselect.
   141 
   142     lockSema critical:[
   143         anItem notNil ifTrue:[ expanded := anItem isExpanded ]
   144                      ifFalse:[ expanded := false ].
   145 
   146         self value:nil.
   147         listOfItems root:anItem.
   148 
   149         anItem notNil ifTrue:[
   150             timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8.
   151             timedUpdateTask name:'Update'.
   152             timedUpdateTask resume.
   153         ].
   154     ].
   155 
   156     (expanded and:[anItem notNil]) ifTrue:[
   157         anItem expand
   158     ].
   159     ^ anItem
   160 !
   161 
   162 rootView
   163     "get the top widget the event viewer is established on, a View
   164     "
   165     ^ listOfItems rootView
   166 ! !
   167 
   168 !ViewTreeModel methodsFor:'accessing actions'!
   169 
   170 beforeSelectionChangedAction
   171     "none argument action which is called before
   172      the selection changed
   173     "
   174     ^ beforeSelectionChangedAction
   175 !
   176 
   177 beforeSelectionChangedAction:aNoneArgBlock
   178     "none argument action which is called before
   179      the selection changed
   180     "
   181     beforeSelectionChangedAction := aNoneArgBlock.
   182 !
   183 
   184 inputEventAction
   185     "called for each input event; the argument to the action is the WindowEvent
   186     "
   187     ^ inputEventAction
   188 !
   189 
   190 inputEventAction:aOneArgActionTheEvent
   191     "called for each input event; the argument to the action is the WindowEvent
   192     "
   193     inputEventAction := aOneArgActionTheEvent.
   194 !
   195 
   196 mappedViewAction
   197     "called for a new mapped view which can not be found
   198      in the current item list
   199     "
   200     ^ mappedViewAction
   201 !
   202 
   203 mappedViewAction:aOneArgBlockTheMappedView
   204     "called for a new mapped view which can not be found
   205      in the current item list
   206     "
   207     mappedViewAction := aOneArgBlockTheMappedView
   208 ! !
   209 
   210 !ViewTreeModel methodsFor:'accessing look'!
   211 
   212 iconAt:aKey ifNonePut:aNoneArgBlock
   213     |icon view|
   214 
   215     icon := icons at:aKey ifAbsent:nil.
   216     icon notNil ifTrue:[^ icon].
   217 
   218     icon := aNoneArgBlock value.
   219     icon isNil ifTrue:[^ nil].
   220 
   221     view := self rootView.
   222     view isNil ifTrue:[^ icon].
   223 
   224     icon := icon copy onDevice:(view device).
   225     icon isImage ifTrue:[
   226         icon clearMaskedPixels.
   227     ].
   228     icons at:aKey put:icon.
   229     ^ icon
   230 ! !
   231 
   232 !ViewTreeModel methodsFor:'accessing visibility'!
   233 
   234 signalHiddenLevel
   235     "show the selection if signaled; increments hiddenLevel
   236      see: #waitHiddenLevel
   237     "
   238     (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[
   239         hiddenLevel := 0.
   240         self invalidateSelection.
   241     ].
   242 !
   243 
   244 waitHiddenLevel
   245     "hide the selection until signaled; increments hiddenLevel
   246      see: #signalHiddenLevel
   247     "
   248     self redrawUnselected:selection andLock:true
   249 !
   250 
   251 withSelectionHiddenDo:aNoneArgumentBlock
   252     "apply block with selection hidden
   253     "
   254 
   255     [   self waitHiddenLevel.
   256 
   257         aNoneArgumentBlock value
   258 
   259     ] valueNowOrOnUnwindDo:[
   260         self signalHiddenLevel.
   261     ].
   262 ! !
   263 
   264 !ViewTreeModel methodsFor:'aspects'!
   265 
   266 hasTargetWidgetChannel
   267     "answer the channel which is set to true if a target widget exists"
   268 
   269     ^ hasTargetWidgetChannel
   270 !
   271 
   272 listOfItems
   273     "hiearchical list build from existing items"
   274 
   275     ^ listOfItems
   276 !
   277 
   278 selectOnClickHolder
   279     "boolean holder, which indicates whether the selection will change on click
   280     "
   281     ^ selectOnClickHolder
   282 !
   283 
   284 testModeChannel
   285     "answer a boolean channel which describes the behaviour how to process
   286      events on the target view.
   287 
   288      false: all input events are eaten and the selection is shown on the target view.
   289      true:  no  input events are eaten and no  selection is shown on the target view."
   290 
   291     ^ testModeChannel
   292 ! !
   293 
   294 !ViewTreeModel methodsFor:'change & update'!
   295 
   296 targetWidgetChanged
   297     hasTargetWidgetChannel value:(self rootItem notNil).
   298 !
   299 
   300 timedUpdateTaskCycle
   301     |view myTaskId|
   302 
   303     myTaskId := timedUpdateTask.
   304 
   305     listOfItems root notNil ifTrue:[
   306         view := listOfItems root widget.
   307     ].
   308 
   309     [ view notNil ] whileTrue:[
   310         Delay waitForSeconds:0.5.
   311         
   312         (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[
   313             view := nil.
   314         ] ifTrue:[
   315             (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[
   316                 view sensor pushUserEvent:#updateChildren for:self.
   317             ].
   318         ].
   319     ].
   320     timedUpdateTask == myTaskId ifTrue:[
   321         timedUpdateTask := nil.
   322         listOfItems root:nil.
   323     ].
   324 !
   325 
   326 update:something with:someArgument from:aModel
   327 
   328     aModel == testModeChannel ifTrue:[
   329         (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[
   330             testModeChannel value ifTrue:[
   331                 self redrawUnselected:selection andLock:false checkTestMode:false.
   332             ] ifFalse:[
   333                 self invalidateSelection.
   334             ].
   335         ].
   336         ^ self
   337     ].
   338     super update:something with:someArgument from:aModel.
   339 !
   340 
   341 updateChildren
   342     |rootItem|
   343 
   344     rootItem := listOfItems root.
   345     rootItem isNil ifTrue:[^ self].
   346 
   347     rootItem exists ifFalse:[
   348         listOfItems root:nil.
   349     ] ifTrue:[
   350         rootItem updateChildren.
   351     ].
   352 ! !
   353 
   354 !ViewTreeModel methodsFor:'event processing'!
   355 
   356 processEvent:anEvent
   357     "catch and process all WindowEvents for the rootComponent and its contained
   358      widgets; redraw selection in case of damage ....
   359     "
   360     |evView item rootView testMode|
   361 
   362     evView := anEvent view.
   363     evView isNil ifTrue:[
   364         (anEvent isMessageSendEvent and:[anEvent receiver == self]) ifFalse:[
   365             ^ false
   366         ].
   367         anEvent value.
   368         ^ true.
   369     ].
   370     rootView := listOfItems rootView.
   371     rootView isNil ifTrue:[ ^ false ].
   372 
   373     anEvent isConfigureEvent ifTrue:[
   374         hiddenLevel == 0 ifTrue:[
   375             self redrawUnselected:selection andLock:false.
   376         ].
   377         ^ false
   378     ].
   379 
   380     "/ check whether view is contained within the rootView
   381     (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[
   382         ^ false
   383     ].
   384 
   385     anEvent isInputEvent ifFalse:[
   386         anEvent isDamage ifTrue:[
   387             hiddenLevel == 0 ifTrue:[self invalidateSelection].
   388             ^ false
   389         ].
   390 
   391         anEvent isMapEvent ifTrue:[
   392             mappedViewAction notNil ifTrue:[
   393                 item := listOfItems recursiveDetect:[:el| el widget == evView].
   394                 item isNil ifTrue:[ mappedViewAction value:evView ]
   395             ].
   396             ^ false
   397         ].
   398 
   399         anEvent type == #terminate ifTrue:[
   400             item := listOfItems recursiveDetect:[:el| el widget == evView].
   401             item notNil ifTrue:[ self processTerminateForItem:item ].
   402             ^ false
   403         ].
   404         ^ false
   405     ].
   406     testMode := testModeChannel value.
   407 
   408     anEvent isFocusEvent ifTrue:[
   409         evView == rootView ifTrue:[
   410             self invalidateSelection
   411         ].
   412         ^ testMode not.
   413     ].
   414     anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ].
   415 
   416     testMode ifFalse:[
   417         inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ].
   418     ] ifTrue:[
   419         anEvent isButtonPressEvent ifTrue:[
   420             selectOnClickHolder value ifTrue:[
   421                 self selectItem:(listOfItems detectItemRespondsToView:evView).
   422             ].
   423         ]
   424     ].
   425 
   426     (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[
   427         hiddenLevel := 1.
   428         self signalHiddenLevel.
   429     ].
   430 
   431     ^ testMode not
   432 !
   433 
   434 processTerminateForItem:anItem
   435     "received terminate for an item
   436     "
   437     anItem remove.
   438 ! !
   439 
   440 !ViewTreeModel methodsFor:'initialization'!
   441 
   442 initialize
   443     "setup the default attributes
   444     "
   445     super initialize.
   446 
   447     hiddenLevel           := 0.
   448     lockSema              := RecursionLock new.
   449     listOfItems           := ItemList new on:self.
   450     selectedSuperItems    := #().
   451     icons                 := IdentityDictionary new.
   452 
   453     hasTargetWidgetChannel := false asValue.
   454     selectOnClickHolder    := true asValue.
   455 
   456     testModeChannel := false asValue.
   457     testModeChannel addDependent:self.
   458 ! !
   459 
   460 !ViewTreeModel methodsFor:'private selection'!
   461 
   462 invalidateSelection
   463     "invalidate the current selection
   464     "
   465     |topView|
   466 
   467     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
   468 
   469     (     hiddenLevel == 0
   470      and:[selection notNil
   471      and:[(topView := listOfItems rootView) notNil
   472      and:[topView shown]]]
   473     ) ifTrue:[
   474         topView sensor pushUserEvent:#redrawSelection for:self withArguments:#()
   475     ]
   476 !
   477 
   478 recursiveRepair:theDamages startIn:aView relativeTo:aRootView
   479     "repair all views and contained views, which intersects the damage.
   480      !!!! all damages repaired are removed from the list of damages !!!!
   481     "
   482     |color relOrg damage subViews repaired
   483      bwWidth    "{ Class:SmallInteger }"
   484      x          "{ Class:SmallInteger }"
   485      y          "{ Class:SmallInteger }"
   486      w          "{ Class:SmallInteger }"
   487      h          "{ Class:SmallInteger }"
   488      relOrgX    "{ Class:SmallInteger }"
   489      relOrgY    "{ Class:SmallInteger }"
   490      width      "{ Class:SmallInteger }"
   491      height     "{ Class:SmallInteger }"
   492      size       "{ Class:SmallInteger }"
   493     |
   494     (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ].
   495 
   496     subViews := aView subViews.
   497 
   498     subViews size ~~ 0 ifTrue:[
   499         subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ].
   500         theDamages isEmpty ifTrue:[ ^ self ].
   501     ].
   502 
   503     relOrg  := aView originRelativeTo:aRootView.
   504     bwWidth := aView borderWidth.
   505     size    := theDamages size.
   506 
   507     "/ compute relative origin starting from border left@top
   508     relOrgX := relOrg x - bwWidth.
   509     relOrgY := relOrg y - bwWidth.
   510     width   := aView width  + bwWidth + bwWidth.
   511     height  := aView height + bwWidth + bwWidth.
   512 
   513     size to:1 by:-1 do:[:anIndex|
   514         repaired := damage := theDamages at:anIndex.
   515 
   516         "/ compute the rectangle into the view
   517         y := damage top  - relOrgY.
   518         x := damage left - relOrgX.
   519         w := damage width.
   520         h := damage height.
   521 
   522         x     < 0      ifTrue:[ w := w + x. x := 0. repaired := nil ].
   523         y     < 0      ifTrue:[ h := h + y. y := 0. repaired := nil ].
   524         x + w > width  ifTrue:[ w := width  - x.    repaired := nil ].
   525         y + h > height ifTrue:[ h := height - y.    repaired := nil ].
   526 
   527         (w > 0 and:[h > 0]) ifTrue:[
   528             bwWidth ~~ 0 ifTrue:[
   529                 color isNil ifTrue:[
   530                     "/ must force redraw of border
   531                     color := aView borderColor.
   532                     aView borderColor:(Color colorId:1).
   533                     aView borderColor:color.
   534                 ].
   535                 w := w - bwWidth.
   536                 h := h - bwWidth.
   537 
   538                 (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0].
   539                 (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0].
   540 
   541                 h > 0 ifFalse:[w := 0].         "/ later testing on width only
   542             ].
   543 
   544             w > 0 ifTrue:[
   545                 aView clearRectangleX:x y:y width:w height:h.
   546                 aView exposeX:x y:y width:w height:h
   547             ].
   548             repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ].
   549         ]
   550     ].
   551 !
   552 
   553 redrawSelection
   554     "redraw all items selected
   555     "
   556     |topView size|
   557 
   558     testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
   559 
   560     (     hiddenLevel == 0
   561      and:[(size := selection size) > 0
   562      and:[(topView := listOfItems rootView) notNil
   563      and:[topView shown
   564      and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]]
   565     ) ifFalse:[
   566         ^ self
   567     ].
   568 
   569     lockSema critical:[
   570         |list|
   571 
   572         list := selection.
   573 
   574         list size > 0 ifTrue:[
   575             topView paint:(Color black).
   576             topView clippedByChildren:false.
   577 
   578             list keysAndValuesReverseDo:[:anIndex :anItem|
   579                 (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ].
   580 
   581                 anItem handlesDo:[:aRect :what|
   582                     what isNil ifTrue:[topView displayRectangle:aRect]
   583                               ifFalse:[topView    fillRectangle:aRect]
   584                 ]
   585             ].
   586             topView clippedByChildren:true.
   587         ].
   588     ].
   589 !
   590 
   591 redrawUnselected:aList andLock:doLock
   592     "redraw all items unselected; if doLock is true, the hiddenLevel
   593      is incremented and thus the select mechanism is locked.
   594     "
   595     self redrawUnselected:aList andLock:doLock checkTestMode:true.
   596 !
   597 
   598 redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode
   599     "redraw all items unselected; if doLock is true, the hiddenLevel
   600      is incremented and thus the select mechanism is locked.
   601     "
   602     |rootView damages subViews x y w h|
   603 
   604     doLock ifTrue:[
   605         hiddenLevel := hiddenLevel + 1.
   606         hiddenLevel ~~ 1 ifTrue:[^ self].
   607     ] ifFalse:[
   608         hiddenLevel ~~ 0 ifTrue:[^ self].
   609     ].
   610     checkTestMode ifTrue:[
   611         testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode
   612     ].
   613 
   614     (     aList size ~~ 0
   615      and:[(rootView := listOfItems rootView) notNil
   616      and:[rootView shown]]
   617     ) ifFalse:[
   618         ^ self
   619     ].
   620 
   621     lockSema critical:[
   622         damages := OrderedCollection new:(8 * aList size).
   623 
   624         aList do:[:item|
   625             item handlesDo:[:handle :what|
   626                 damages reverseDo:[:el|
   627                     (el intersects:handle) ifTrue:[
   628                         damages removeIdentical:el.
   629 
   630                         handle left:(handle left   min:el left)
   631                               right:(handle right  max:el right)
   632                                 top:(handle top    min:el top)
   633                              bottom:(handle bottom max:el bottom)
   634                     ]
   635                 ].                        
   636                 damages add:handle
   637             ]
   638         ].
   639 
   640         damages do:[:el|
   641             x := el left.
   642             y := el top.
   643             w := el width.
   644             h := el height.
   645 
   646             rootView clearRectangleX:x y:y width:w height:h.
   647             rootView         exposeX:x y:y width:w height:h.
   648         ].
   649 
   650         (subViews := rootView subViews) notNil ifTrue:[
   651             subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ].
   652         ].
   653     ].
   654 ! !
   655 
   656 !ViewTreeModel methodsFor:'queries'!
   657 
   658 isInTestMode
   659     "answer false, all input events are eaten and the selection is shown on the target view.
   660      answer true,  no  input events are eaten and no  selection is shown on the target view."
   661 
   662     ^ testModeChannel value
   663 ! !
   664 
   665 !ViewTreeModel methodsFor:'selection accessing'!
   666 
   667 at:anIndex
   668     "returns the selected item at an index or nil
   669     "
   670     selection notNil ifTrue:[
   671         ^ selection at:anIndex ifAbsent:nil
   672     ].
   673     ^ nil
   674 !
   675 
   676 at:anIndex ifAbsent:aBlock
   677     "returns the selected item at an index or the result of the block
   678     "
   679     selection notNil ifTrue:[
   680         ^ selection at:anIndex ifAbsent:aBlock
   681     ].
   682     ^ aBlock value
   683 !
   684 
   685 first
   686     "returns the first selected item or nil
   687     "
   688     ^ self at:1
   689 !
   690 
   691 last
   692     "returns the last selected item or nil
   693     "
   694     ^ selection notNil ifTrue:[selection last] ifFalse:[nil]
   695 !
   696 
   697 selectedItem
   698     "returns the single selected item or nil (size ~~ 1 nil is returned)
   699     "
   700     ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil]
   701 !
   702 
   703 selectedSuperItems
   704     "returs the list of selected superItems; items selected
   705      but not contained in another selected item.
   706     "
   707     ^ selectedSuperItems
   708 !
   709 
   710 size
   711     "returns the number of items selected
   712     "
   713     ^ selection size
   714 ! !
   715 
   716 !ViewTreeModel methodsFor:'selection adding & removing'!
   717 
   718 add:item
   719     "add an item to the current selection
   720     "
   721     |newSelect|
   722 
   723     item isNil ifTrue:[^ item].
   724 
   725     lockSema critical:[
   726         selection isNil ifTrue:[
   727             newSelect := Array with:item.
   728         ] ifFalse:[
   729             (self includes:item) ifFalse:[
   730                 newSelect := selection copyWith:item
   731             ]
   732         ].
   733 
   734         newSelect size ~~ selection size ifTrue:[
   735             item makeVisible.
   736             self value:newSelect
   737         ]
   738     ].
   739     ^ item
   740 !
   741 
   742 addAll:aCollectionOfItems
   743     "add a collection of items to the current selection
   744     "
   745     |newSelect|
   746 
   747     aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ].
   748 
   749     lockSema critical:[
   750         selection isNil ifTrue:[
   751             newSelect := Array withAll:aCollectionOfItems.
   752         ] ifFalse:[
   753             newSelect := OrderedCollection withAll:selection.
   754 
   755             aCollectionOfItems do:[:el|
   756                 (selection includesIdentical:el) ifFalse:[newSelect add:el]
   757             ].
   758         ].
   759         self value:newSelect.
   760     ].
   761     ^ aCollectionOfItems
   762 !
   763 
   764 deselect
   765     "clear the selection
   766     "
   767     self value:nil.
   768 !
   769 
   770 remove:item
   771     "remove the item from the current selection
   772     "
   773     |newSelect|
   774 
   775     item isNil ifTrue:[^ nil].
   776 
   777     lockSema critical:[
   778         (selection notNil and:[selection includesIdentical:item]) ifTrue:[
   779             selection size == 1 ifTrue:[ newSelect := nil ]
   780                                ifFalse:[ newSelect := selection copyWithout:item ].
   781 
   782             self value:newSelect
   783         ].
   784     ].
   785     ^ item
   786 !
   787 
   788 removeAll
   789     "clear the selection
   790     "
   791     self deselect.
   792 !
   793 
   794 removeAll:loItems
   795     "remove all items of the collection from the current selection
   796     "
   797     |newSelect|
   798 
   799     selection   isNil ifTrue:[ ^ loItems ].
   800     loItems size == 0 ifTrue:[ ^ loItems ].
   801 
   802     lockSema critical:[
   803         selection notNil ifTrue:[
   804             newSelect := selection select:[:el| (loItems includesIdentical:el) not ].
   805             self value:newSelect.
   806         ]
   807     ].
   808     ^ loItems
   809 !
   810 
   811 selectAll
   812     "select all items
   813     "
   814     |root newSelection|
   815 
   816     root := listOfItems root.
   817 
   818     root isNil ifTrue:[
   819         newSelection := nil
   820     ] ifFalse:[
   821         newSelection := OrderedCollection new.
   822         root recursiveDo:[:el| newSelection add:el ].
   823     ].
   824     self value:newSelection.
   825 !
   826 
   827 selectItem:anItem
   828     "set the current selection to the item
   829     "
   830     self value:anItem
   831 !
   832 
   833 selectRootItem
   834     "set the current selection to the root item
   835     "
   836     self value:(self rootItem).
   837 !
   838 
   839 selectedItem:anItem
   840     "set the current selection to the item
   841     "
   842     self selectItem:anItem.
   843 !
   844 
   845 toggleSelectItem:anItem
   846     "toggle selection-state of the item; add or remove the item from the
   847      current selection.
   848     "
   849     anItem notNil ifTrue:[
   850         (self includes:anItem) ifTrue:[self remove:anItem]
   851                               ifFalse:[self add:anItem]
   852     ].
   853     ^ anItem
   854 ! !
   855 
   856 !ViewTreeModel methodsFor:'selection enumerating'!
   857 
   858 collect:aBlock
   859     "for each element in the selection, evaluate the argument, aBlock
   860      and return a new collection with the results
   861     "
   862     |res|
   863 
   864     res := OrderedCollection new.
   865     self do:[:el| res add:(aBlock value:el)].
   866   ^ res
   867 !
   868 
   869 do:aOneArgBlock
   870     "evaluate the argument, aBlock for each item in the selection
   871     "
   872     |cashedSelection|
   873 
   874     cashedSelection := selection.
   875     cashedSelection isNil ifTrue:[^ nil].
   876   ^ cashedSelection do:aOneArgBlock
   877 !
   878 
   879 from:start do:aOneArgBlock
   880     "evaluate the argument, aBlock for the items starting at index start
   881     "
   882     |cashedSelection|
   883 
   884     cashedSelection := selection.
   885     cashedSelection isNil ifTrue:[^ nil].
   886   ^ cashedSelection from:start do:aOneArgBlock
   887 !
   888 
   889 from:start to:stop do:aOneArgBlock
   890     "evaluate the argument, aBlock for the items with index start to
   891      stop in the selection.
   892     "
   893     |cashedSelection|
   894 
   895     cashedSelection := selection.
   896     cashedSelection isNil ifTrue:[^ nil].
   897   ^ cashedSelection from:start to:stop do:aOneArgBlock
   898 !
   899 
   900 reverseDo:aOneArgBlock
   901     "evaluate the argument, aBlock for each item in the selection
   902     "
   903     |cashedSelection|
   904 
   905     cashedSelection := selection.
   906     cashedSelection isNil ifTrue:[^ nil].
   907   ^ cashedSelection reverseDo:aOneArgBlock
   908 !
   909 
   910 select:aBlock
   911     "return a new collection with all elements from the selection, for which
   912      the argument aBlock evaluates to true.
   913     "
   914     |res|
   915 
   916     res := OrderedCollection new.
   917     self do:[:el| (aBlock value:el) ifTrue:[res add:el] ].
   918   ^ res
   919 ! !
   920 
   921 !ViewTreeModel methodsFor:'selection protocol'!
   922 
   923 changed:aParameter with:oldSelection
   924     "update the visibility staus of the current selection
   925     "
   926     |unselected rootView rootItem selSize|
   927 
   928     selSize := selection size.
   929 
   930     selSize == 0 ifTrue:[
   931         selectedSuperItems := #().
   932     ] ifFalse:[
   933         selSize == 1 ifTrue:[
   934             selectedSuperItems := Array with:(selection at:1).
   935         ] ifFalse:[
   936             rootItem := listOfItems root.
   937 
   938             (selection includesIdentical:rootItem) ifTrue:[
   939                 selectedSuperItems := Array with:rootItem.
   940             ] ifFalse:[
   941                 selectedSuperItems := OrderedCollection new:selSize.
   942 
   943                 selection do:[:anItem|
   944                     anItem parentsDetect:[:el| selection includesIdentical:el ]
   945                                   ifNone:[ selectedSuperItems add:anItem ].
   946                 ].
   947             ]
   948         ]
   949     ].
   950 
   951     (     hiddenLevel == 0
   952      and:[(rootView := listOfItems rootView) notNil
   953      and:[rootView shown]]
   954     ) ifTrue:[
   955         selSize == 0 ifTrue:[
   956             "/ must redraw the old selection unselected
   957             self redrawUnselected:oldSelection andLock:false
   958         ] ifFalse:[
   959             self invalidateSelection.
   960 
   961             oldSelection size ~~ 0 ifTrue:[
   962                 "/ must redraw all elements no longer in the selection
   963                 unselected := oldSelection select:[:el| (selection includesIdentical:el) not ].
   964                 self redrawUnselected:unselected andLock:false.
   965             ]
   966         ]
   967     ].
   968     super changed:aParameter with:oldSelection.
   969 !
   970 
   971 setValue:aNewSelection 
   972     "set the selection without notifying
   973     "
   974     |newSelect idx|
   975 
   976     newSelect := nil.
   977 
   978     aNewSelection notNil ifTrue:[
   979         lockSema critical:[
   980             aNewSelection isCollection ifFalse:[
   981                 (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[
   982                     newSelect := selection
   983                 ] ifFalse:[
   984                     newSelect := Array with:aNewSelection.
   985                 ]
   986             ] ifTrue:[
   987                 aNewSelection notEmpty ifTrue:[
   988                     aNewSelection size ~~ selection size ifTrue:[
   989                         newSelect := aNewSelection copy.
   990                     ] ifFalse:[
   991                         idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ].
   992 
   993                         idx ~~ 0 ifTrue:[newSelect := aNewSelection copy]
   994                                 ifFalse:[newSelect := selection ].
   995                     ]
   996                 ]
   997             ]
   998         ].
   999     ].
  1000     newSelect ~~ selection ifTrue:[
  1001         beforeSelectionChangedAction value.
  1002         selection := newSelect.
  1003         selection notNil ifTrue:[selection do:[:el| el makeVisible]]
  1004     ].
  1005 !
  1006 
  1007 triggerValue:aValue
  1008     "set my value & send change notifications to my dependents.
  1009      Send the change message even if the value didn't change.
  1010     "
  1011     |oldSelection|
  1012 
  1013     lockSema critical:[
  1014         oldSelection := selection.
  1015         self setValue:aValue.
  1016         self changed:#value with:oldSelection
  1017     ]
  1018 !
  1019 
  1020 value
  1021     "returns the current selection
  1022     "
  1023     ^ selection ? #()
  1024 !
  1025 
  1026 value:aValue
  1027     "change the current selection and send change notifications to my
  1028      dependents if it changed.
  1029     "
  1030     |oldSelection|
  1031 
  1032     lockSema critical:[
  1033         oldSelection := selection.
  1034         self setValue:aValue.
  1035 
  1036         oldSelection == selection ifFalse:[
  1037             self changed:#value with:oldSelection
  1038         ]
  1039     ].
  1040 ! !
  1041 
  1042 !ViewTreeModel methodsFor:'selection searching'!
  1043 
  1044 detect:aBlock
  1045     "evaluate the argument, aBlock for each item in the selection until
  1046      the block returns true; in this case return the element which caused
  1047      the true evaluation.
  1048      If none of the evaluations returns true, an error is raised
  1049     "
  1050     ^ self detect:aBlock ifNone:[self errorNotFound]
  1051 !
  1052 
  1053 detect:aBlock ifNone:exceptionBlock
  1054     "evaluate the argument, aBlock for each item in the selection until the
  1055      block returns true; in this case return the element which caused the
  1056      true evaluation.
  1057      If none of the evaluations returns true, the result of the evaluation
  1058      of the exceptionBlock is returned
  1059     "
  1060     |cashedSelection|
  1061 
  1062     cashedSelection := selection.
  1063     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  1064   ^ cashedSelection detect:aBlock ifNone:exceptionBlock
  1065 !
  1066 
  1067 detectLast:aBlock
  1068     "evaluate the argument, aBlock for each item in the selection until
  1069      the block returns true; in this case return the element which caused
  1070      the true evaluation. The items are processed in reverse order.
  1071      If none of the evaluations returns true, an error is raised
  1072     "
  1073     ^ self detectLast:aBlock ifNone:[self errorNotFound]
  1074 !
  1075 
  1076 detectLast:aBlock ifNone:exceptionBlock
  1077     "evaluate the argument, aBlock for each item in the selection until
  1078      the block returns true; in this case return the element which caused
  1079      the true evaluation. The items are processed in reverse order.
  1080      If none of the evaluations returns true, the result of the evaluation
  1081      of the exceptionBlock is returned
  1082     "
  1083     |cashedSelection|
  1084 
  1085     cashedSelection := selection.
  1086     cashedSelection isNil ifTrue:[ ^ exceptionBlock value ].
  1087   ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock
  1088 ! !
  1089 
  1090 !ViewTreeModel methodsFor:'selection testing'!
  1091 
  1092 includes:anItem
  1093     "returns true if the item is in the current selection
  1094     "
  1095     |cashedSelection|
  1096 
  1097     cashedSelection := selection.
  1098     cashedSelection isNil ifTrue:[^ false].
  1099  ^  cashedSelection includesIdentical:anItem
  1100 !
  1101 
  1102 includesAll:aCollection
  1103     "return true, if all items of the collection are included in the current selection
  1104     "
  1105     |cashedSelection|
  1106 
  1107     aCollection size ~~ 0 ifTrue:[
  1108         cashedSelection := selection.
  1109         cashedSelection isNil ifTrue:[ ^ false ].
  1110 
  1111         aCollection do:[:el|
  1112             (cashedSelection includesIdentical:el) ifFalse:[^ false]
  1113         ]
  1114     ].
  1115     ^ true
  1116 !
  1117 
  1118 includesAny:aCollection
  1119     "return true, if the any item of the collection is in the current selection
  1120     "
  1121     |cashedSelection|
  1122 
  1123     aCollection notNil ifTrue:[
  1124         cashedSelection := selection.
  1125 
  1126         cashedSelection notNil ifTrue:[
  1127             aCollection do:[:el|
  1128                 (cashedSelection includesIdentical:el) ifTrue:[^ true]
  1129             ]
  1130         ]
  1131     ].
  1132     ^ false
  1133 !
  1134 
  1135 includesIdentical:anItem
  1136     "returns true if the item is in the current selection
  1137     "
  1138     ^ self includes:anItem
  1139 !
  1140 
  1141 isEmpty
  1142     "returns true if the current selection is empty
  1143     "
  1144     ^ selection size == 0
  1145 !
  1146 
  1147 isSelected:anItem
  1148     "returns true if the item is in the current selection
  1149     "
  1150     ^ self includes:anItem
  1151 !
  1152 
  1153 notEmpty
  1154     "returns true if the current selection is not empty
  1155     "
  1156     ^ selection size ~~ 0
  1157 ! !
  1158 
  1159 !ViewTreeModel::ItemList class methodsFor:'documentation'!
  1160 
  1161 documentation
  1162 "
  1163     Kind of HierarchicalList class which contains all the visible
  1164     ViewTreeItem's and the root, the anchor of the hierarchical list.
  1165 
  1166     [Instance variables:]
  1167         treeModel       <ViewTreeModel>         all events are delegated to
  1168         eventHook       <BlockValue>            save and resore the pre/post -EventHook
  1169 
  1170 
  1171     [author:]
  1172         Claus Atzkern
  1173 
  1174     [see also:]
  1175         HierarchicalList
  1176         ViewTreeModel
  1177         ViewTreeItem
  1178 "
  1179 ! !
  1180 
  1181 !ViewTreeModel::ItemList methodsFor:'accessing'!
  1182 
  1183 root:theRoot
  1184     "set the root item; delegate events to my treeModel
  1185     "
  1186     |rootView|
  1187 
  1188     theRoot == root ifTrue:[^ self].
  1189 
  1190     rootView := self rootView.
  1191     super root:theRoot.
  1192 
  1193     rootView notNil ifTrue:[ |wgrp|
  1194         wgrp := rootView windowGroup.
  1195 
  1196         wgrp notNil ifTrue:[
  1197            wgrp removePreEventHook:treeModel.
  1198            wgrp removePostEventHook:self.
  1199         ].
  1200     ].
  1201 
  1202     super root:theRoot.
  1203     rootView := self rootView.
  1204 
  1205     rootView notNil ifTrue:[
  1206         "must setup a task because there might not exist a windowGroup at the moment
  1207         "
  1208         [   |wgrp|
  1209 
  1210             [rootView == self rootView] whileTrue:[
  1211                 wgrp := rootView windowGroup.
  1212                 wgrp notNil ifTrue:[
  1213                     rootView := nil.
  1214                     wgrp addPreEventHook:treeModel.
  1215                     wgrp addPostEventHook:self.
  1216                 ] ifFalse:[
  1217                     Delay waitForMilliseconds:100.
  1218                 ].
  1219             ].
  1220 
  1221         ] forkAt:(Processor userSchedulingPriority + 2).
  1222     ].
  1223     treeModel notNil ifTrue:[
  1224         treeModel targetWidgetChanged.
  1225     ].
  1226     
  1227     ^ root.
  1228 !
  1229 
  1230 rootView
  1231     "returns the widget assigned to the root or nil
  1232     "
  1233     ^ root notNil ifTrue:[root widget] ifFalse:[nil]
  1234 !
  1235 
  1236 treeModel
  1237     "returne the treeModel, a ViewTreeModel
  1238     "
  1239     ^ treeModel
  1240 ! !
  1241 
  1242 !ViewTreeModel::ItemList methodsFor:'accessing look'!
  1243 
  1244 additionalLabelForItem:anItem
  1245     "answer the additional lable for an item or nil"
  1246 
  1247     |applClass|
  1248 
  1249     showWidgetNames == true ifTrue:[
  1250         ^ '[', anItem widget name, ']'
  1251     ].
  1252 
  1253     anItem isApplicationClass ifTrue:[
  1254         applClass := anItem applicationClass.
  1255 
  1256         applClass notNil ifTrue:[
  1257             ^ ('[', applClass name, ']')
  1258         ].
  1259     ].
  1260     ^ nil
  1261 !
  1262 
  1263 showWidgetNames
  1264     "answer true if the additional text is the widget name
  1265      otherwise the name of the application"
  1266 
  1267     ^ showWidgetNames ? false
  1268 !
  1269 
  1270 showWidgetNames:aBoolean
  1271     "set true if the additional text is the widget name
  1272      otherwise the name of the application"
  1273 
  1274     self showWidgetNames == aBoolean ifFalse:[
  1275         showWidgetNames := aBoolean.
  1276 
  1277         root notNil ifTrue:[
  1278             root recursiveAdditionalNameBehaviourChanged.
  1279             self changed.
  1280         ].
  1281     ].
  1282 ! !
  1283 
  1284 !ViewTreeModel::ItemList methodsFor:'event processing'!
  1285 
  1286 processEvent:anEvent
  1287     "post process event
  1288     "
  1289     ^ treeModel isInTestMode not
  1290 ! !
  1291 
  1292 !ViewTreeModel::ItemList methodsFor:'instance creation'!
  1293 
  1294 on:aModel
  1295     "set the model, a ViewTreeModel
  1296     "
  1297     treeModel := aModel.
  1298     showRoot  := true.
  1299     showWidgetNames := false.
  1300 ! !
  1301 
  1302 !ViewTreeModel::ItemList methodsFor:'searching'!
  1303 
  1304 detectItemRespondsToView:aView
  1305     "returns the bottom-most item which contains the view
  1306     "
  1307     |view item topView|
  1308 
  1309     root notNil ifTrue:[
  1310         view    := aView.
  1311         topView := root widget.
  1312 
  1313         [ view notNil ] whileTrue:[
  1314             topView == view ifTrue:[^ root].
  1315             item := root recursiveDetect:[:el| el widget == view ].
  1316             item notNil ifTrue:[^ item].
  1317             view := view superView
  1318         ]
  1319     ].
  1320     ^ nil
  1321 !
  1322 
  1323 recursiveDetect:aOneOrgBlock
  1324     "recursive find the first child, for which evaluation 
  1325      of the block returns true; if none nil is returned
  1326     "
  1327     root notNil ifTrue:[
  1328         (aOneOrgBlock value:root) ifTrue:[ ^ root ].
  1329       ^ root recursiveDetect:aOneOrgBlock
  1330     ].
  1331     ^ nil
  1332 ! !
  1333 
  1334 !ViewTreeModel class methodsFor:'documentation'!
  1335 
  1336 version
  1337     ^ '$Header$'
  1338 ! !