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