|
1 SelectionInListModelView subclass:#HierarchicalListView |
|
2 instanceVariableNames:'imageInset imageWidth lineMask lineColor showRoot showLines |
|
3 showLeftIndicators indicatorAction useDefaultIcons icons |
|
4 openIndicator closeIndicator' |
|
5 classVariableNames:'' |
|
6 poolDictionaries:'' |
|
7 category:'AAA' |
|
8 ! |
|
9 |
|
10 !HierarchicalListView class methodsFor:'documentation'! |
|
11 |
|
12 documentation |
|
13 " |
|
14 This class implements a hierarchical list view based on a |
|
15 hierachical list |
|
16 |
|
17 [Instance variables:] |
|
18 textStartLeft <Integer> inset between icon and text |
|
19 imageInset <Integer> inset between left side and icon |
|
20 imageWidth <Integer> width of widest icon |
|
21 lineMask <Form> line mask |
|
22 lineColor <Color> line color |
|
23 showRoot <Boolean> root element is shown or hidden |
|
24 derives from the hierachical list. |
|
25 showLines <Boolean> show or hide lines |
|
26 useDefaultIcons <Boolean> use the default icons if no icon |
|
27 for an item is specified |
|
28 icons <IdentityDictionary> list of registered icons; |
|
29 identifier := <key> value := <icon> |
|
30 showLeftIndicators <Boolean> show or hide indicator for most left items |
|
31 indicatorAction <Block> action evaluated if indicator is pressed |
|
32 openIndicator <Icon, Image or Form> expanded indicator |
|
33 closeIndicator <Icon, Image or Form> collapsed indicator |
|
34 |
|
35 [author:] |
|
36 Claus Atzkern |
|
37 |
|
38 [see also:] |
|
39 ListModelView |
|
40 SelectionInListModelView |
|
41 HierarchicalList |
|
42 HierarchicalItem |
|
43 " |
|
44 |
|
45 |
|
46 ! |
|
47 |
|
48 examples |
|
49 " |
|
50 [exBegin] |
|
51 |top sel list item| |
|
52 |
|
53 list := HierarchicalList new. |
|
54 item := HierarchicalItem::Example labeled:'Root Item'. |
|
55 |
|
56 item expand. |
|
57 list showRoot:false. |
|
58 list root:item. |
|
59 |
|
60 top := StandardSystemView new; extent:300@300. |
|
61 sel := ScrollableView for:HierarchicalListView miniScroller:true |
|
62 origin:0.0@0.0 corner:1.0@1.0 in:top. |
|
63 |
|
64 sel list:list. |
|
65 sel multipleSelectOk:true. |
|
66 |
|
67 sel doubleClickAction:[:i| (list at:i) toggleExpand ]. |
|
68 sel indicatorAction:[:i| (list at:i) toggleExpand ]. |
|
69 |
|
70 top open. |
|
71 [exEnd] |
|
72 |
|
73 |
|
74 " |
|
75 ! ! |
|
76 |
|
77 !HierarchicalListView class methodsFor:'resources'! |
|
78 |
|
79 closeIndicator |
|
80 "returns a little [+] bitmap" |
|
81 |
|
82 <resource: #fileImage> |
|
83 |
|
84 ^ Icon constantNamed:#plus |
|
85 ifAbsentPut:[Image fromFile:('xpmBitmaps/plus.xpm')] |
|
86 |
|
87 |
|
88 ! |
|
89 |
|
90 collapsedIcon |
|
91 "returns icon to indicate a collapsed entry |
|
92 " |
|
93 <resource: #fileImage> |
|
94 |
|
95 ^ Icon constantNamed:#directory |
|
96 ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm')] |
|
97 |
|
98 ! |
|
99 |
|
100 emptyIcon |
|
101 "returns icon to indicate an not extendable entry |
|
102 " |
|
103 <resource: #fileImage> |
|
104 |
|
105 ^ Icon constantNamed:#plainFile |
|
106 ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')] |
|
107 |
|
108 ! |
|
109 |
|
110 expandedIcon |
|
111 "returns icon to indicate an extended entry |
|
112 " |
|
113 <resource: #fileImage> |
|
114 |
|
115 ^ Icon constantNamed:#directoryOpened |
|
116 ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm')] |
|
117 |
|
118 ! |
|
119 |
|
120 openIndicator |
|
121 "returns a little [-] bitmap" |
|
122 |
|
123 <resource: #fileImage> |
|
124 |
|
125 ^ Icon constantNamed:#minus |
|
126 ifAbsentPut:[Image fromFile:('xpmBitmaps/minus.xpm')] |
|
127 |
|
128 ! ! |
|
129 |
|
130 !HierarchicalListView methodsFor:'accessing'! |
|
131 |
|
132 list:aList |
|
133 "get the status of <showRoot> from the list |
|
134 " |
|
135 aList notNil ifTrue:[ |
|
136 showRoot := aList showRoot |
|
137 ]. |
|
138 super list:aList |
|
139 ! ! |
|
140 |
|
141 !HierarchicalListView methodsFor:'accessing colors'! |
|
142 |
|
143 lineColor |
|
144 "get the line color |
|
145 " |
|
146 ^ lineColor |
|
147 |
|
148 |
|
149 ! |
|
150 |
|
151 lineColor:aColor |
|
152 "set the line color |
|
153 " |
|
154 (aColor notNil and:[aColor ~= lineColor]) ifTrue:[ |
|
155 lineColor := aColor. |
|
156 |
|
157 shown ifTrue:[ |
|
158 lineColor := lineColor on:device. |
|
159 |
|
160 showLines ifTrue:[ |
|
161 self invalidate |
|
162 ] |
|
163 ] |
|
164 ] |
|
165 |
|
166 ! ! |
|
167 |
|
168 !HierarchicalListView methodsFor:'accessing look'! |
|
169 |
|
170 registerKeysAndIcons:aDictionary |
|
171 "register icons by key and value derived from a directory |
|
172 " |
|
173 |image| |
|
174 |
|
175 (aDictionary isNil or:[aDictionary isEmpty]) ifTrue:[ |
|
176 ^ self |
|
177 ]. |
|
178 |
|
179 aDictionary keysAndValuesDo:[:aKey :anImage| |
|
180 (image := self imageOnDevice:anImage) notNil ifTrue:[ |
|
181 icons at:aKey put:image |
|
182 ] |
|
183 ] |
|
184 |
|
185 ! |
|
186 |
|
187 showLeftIndicators |
|
188 "show or hide the indicators for the most left items |
|
189 " |
|
190 ^ showLeftIndicators |
|
191 |
|
192 ! |
|
193 |
|
194 showLeftIndicators:aState |
|
195 "show or hide the indicators for the most left items |
|
196 " |
|
197 aState ~~ showLeftIndicators ifTrue:[ |
|
198 showLeftIndicators := aState. |
|
199 self invalidate |
|
200 ]. |
|
201 |
|
202 ! |
|
203 |
|
204 showLines |
|
205 "returns true if lines are shown |
|
206 " |
|
207 ^ showLines |
|
208 |
|
209 ! |
|
210 |
|
211 showLines:aState |
|
212 "show or hide lines |
|
213 " |
|
214 aState ~~ showLines ifTrue:[ |
|
215 showLines := aState. |
|
216 self invalidate |
|
217 ]. |
|
218 |
|
219 ! |
|
220 |
|
221 useDefaultIcons |
|
222 "use the default icons if no icon for an item is specified; |
|
223 ** default: true |
|
224 " |
|
225 ^ useDefaultIcons |
|
226 ! |
|
227 |
|
228 useDefaultIcons:aBool |
|
229 "use the default icons if no icon for an item is specified; |
|
230 ** default: true |
|
231 " |
|
232 useDefaultIcons ~~ aBool ifTrue:[ |
|
233 useDefaultIcons := aBool. |
|
234 |
|
235 shown ifTrue:[ |
|
236 self invalidate |
|
237 ] |
|
238 ] |
|
239 ! ! |
|
240 |
|
241 !HierarchicalListView methodsFor:'actions'! |
|
242 |
|
243 indicatorAction |
|
244 "if the action is not nil, indicators are shown and a click on the indicator |
|
245 will evaluate the action with none or one argument, the index into the list |
|
246 " |
|
247 ^ indicatorAction |
|
248 ! |
|
249 |
|
250 indicatorAction:anAction |
|
251 "if the action is not nil, indicators are shown and a click on the indicator |
|
252 will evaluate the action with none or one argument, the index into the list |
|
253 " |
|
254 |wasNilBefore| |
|
255 |
|
256 wasNilBefore := indicatorAction isNil. |
|
257 indicatorAction := anAction. |
|
258 |
|
259 wasNilBefore == (anAction isNil) ifTrue:[ |
|
260 self invalidate |
|
261 ]. |
|
262 ! ! |
|
263 |
|
264 !HierarchicalListView methodsFor:'change & update'! |
|
265 |
|
266 lineChangedAt:aLnNr with:arg |
|
267 "line changed at position; check whether line height changed |
|
268 " |
|
269 |item |
|
270 lv "{ Class:SmallInteger }" |
|
271 x0 "{ Class:SmallInteger }" |
|
272 x1 "{ Class:SmallInteger }" |
|
273 h "{ Class:SmallInteger }" |
|
274 y0 "{ Class:SmallInteger }" |
|
275 y1 "{ Class:SmallInteger }" |
|
276 | |
|
277 |
|
278 (arg == #icon or:[arg == #hierarchy]) ifFalse:[ |
|
279 ^ super lineChangedAt:aLnNr with:arg |
|
280 ]. |
|
281 y0 := (self yVisibleOfLine:aLnNr) max:margin. |
|
282 y1 := (self yVisibleOfLine:(aLnNr + 1)) min:(height - margin). |
|
283 |
|
284 (h := y1 - y0) > 0 ifTrue:[ |
|
285 x0 := margin. |
|
286 x1 := width - margin. |
|
287 |
|
288 (item := list at:aLnNr ifAbsent:nil) isNil ifFalse:[ |
|
289 lv := item level. |
|
290 x0 := self xOfFigureLevel:lv. |
|
291 x1 := x0 + imageWidth. |
|
292 |
|
293 arg == #hierarchy ifTrue:[ |
|
294 x0 := self xOfFigureLevel:(lv -1). |
|
295 ]. |
|
296 x0 := x0 max:margin. |
|
297 x1 := x1 min:(width - margin). |
|
298 |
|
299 x1 > x0 ifFalse:[ |
|
300 ^ self |
|
301 ] |
|
302 ]. |
|
303 self redrawX:x0 y:y0 width:x1 - x0 height:h. |
|
304 ] |
|
305 |
|
306 |
|
307 |
|
308 |
|
309 ! |
|
310 |
|
311 update:what with:aPara from:chgObj |
|
312 "get the status of <showRoot> from the list |
|
313 " |
|
314 chgObj == list ifTrue:[ |
|
315 showRoot ~~ list showRoot ifTrue:[ |
|
316 showRoot := list showRoot. |
|
317 self invalidate. |
|
318 ] |
|
319 ]. |
|
320 super update:what with:aPara from:chgObj |
|
321 ! ! |
|
322 |
|
323 !HierarchicalListView methodsFor:'drawing basics'! |
|
324 |
|
325 drawElementsFrom:start to:stop x:x0 y:y0 width:aWidth |
|
326 "draw the items between start to stop without clearing the background |
|
327 " |
|
328 |item prevItem parent icon showIndc showIcon showText nxtPrnt |
|
329 |
|
330 x1 "{ Class:SmallInteger }" |
|
331 yTop "{ Class:SmallInteger }" |
|
332 yCtr "{ Class:SmallInteger }" |
|
333 yBot "{ Class:SmallInteger }" |
|
334 |
|
335 xIndc "{ Class:SmallInteger }" |
|
336 xIcon "{ Class:SmallInteger }" |
|
337 xText "{ Class:SmallInteger }" |
|
338 |
|
339 widthLvl "{ Class:SmallInteger }" |
|
340 insetTxt "{ Class:SmallInteger }" |
|
341 |
|
342 offIndcX "{ Class:SmallInteger }" |
|
343 offIndcY "{ Class:SmallInteger }" |
|
344 offIconX "{ Class:SmallInteger }" |
|
345 | |
|
346 x1 := x0 + aWidth. |
|
347 widthLvl := imageInset + imageWidth. |
|
348 insetTxt := textStartLeft + imageWidth. |
|
349 offIconX := self xOfFigureLevel:0. |
|
350 showIndc := false. |
|
351 |
|
352 indicatorAction notNil ifTrue:[ |
|
353 icon := openIndicator extent // 2. |
|
354 offIndcX := imageWidth // 2 - widthLvl. |
|
355 offIndcX := offIndcX - icon x. |
|
356 offIndcY := icon y. |
|
357 ]. |
|
358 |
|
359 showLines ifTrue:[ |
|
360 self drawLinesFrom:start to:stop x:x0 y:y0 width:aWidth |
|
361 ]. |
|
362 |
|
363 parent := 4711. "/ to force a recompute |
|
364 prevItem := 4711. "/ to force a recomputation of the level |
|
365 yBot := y0. |
|
366 |
|
367 start to:stop do:[:anIndex| |
|
368 (item := list at:anIndex ifAbsent:nil) isNil ifTrue:[ |
|
369 ^ self "/ list changed |
|
370 ]. |
|
371 yTop := yBot. |
|
372 yBot := self yVisibleOfLine:(anIndex + 1). |
|
373 yCtr := yTop + (yBot - yTop // 2). |
|
374 |
|
375 (nxtPrnt := item parent) ~~ parent ifTrue:[ |
|
376 parent := nxtPrnt. |
|
377 xIcon := prevItem == parent ifTrue:[xIcon + widthLvl] |
|
378 ifFalse:[item level * widthLvl + offIconX]. |
|
379 |
|
380 xText := xIcon + insetTxt. |
|
381 showIcon := xIcon < x1 and:[xText > x0]. |
|
382 showText := xText < x1. |
|
383 |
|
384 indicatorAction notNil ifTrue:[ |
|
385 xIndc := xIcon + offIndcX. |
|
386 |
|
387 showIndc := ( (parent notNil or:[showLeftIndicators]) |
|
388 and:[(xIcon > x0 and:[xIndc < x1])] |
|
389 ) |
|
390 ] |
|
391 ]. |
|
392 |
|
393 (showIcon and:[(icon := self figureFor:item) notNil]) ifTrue:[ |
|
394 icon width > imageWidth ifTrue:[ |
|
395 imageWidth := icon width. |
|
396 StopRedrawSignal raise |
|
397 ]. |
|
398 self displayForm:icon x:xIcon y:(yCtr - (icon height // 2)) |
|
399 ]. |
|
400 |
|
401 showText ifTrue:[ |
|
402 self drawLabelAt:xText y:yTop h:(yBot - yTop) index:anIndex |
|
403 ]. |
|
404 (showIndc and:[item hasChildren]) ifTrue:[ |
|
405 icon := item isExpanded ifTrue:[openIndicator] ifFalse:[closeIndicator]. |
|
406 self displayForm:icon x:xIndc y:(yCtr - offIndcY) |
|
407 ]. |
|
408 prevItem := item. |
|
409 ] |
|
410 ! |
|
411 |
|
412 drawLinesFrom:start to:stop x:x0 y:y0 width:aWidth |
|
413 "draw the lines between start to stop without clearing the background |
|
414 " |
|
415 |item prevItem parent p1 p2 showVLines showHLine lv nxtPrnt |
|
416 showRootNot isFirst buildInArray |
|
417 |
|
418 x "{ Class:SmallInteger }" |
|
419 x1 "{ Class:SmallInteger }" |
|
420 y "{ Class:SmallInteger }" |
|
421 |
|
422 yTop "{ Class:SmallInteger }" |
|
423 yBot "{ Class:SmallInteger }" |
|
424 yCtr "{ Class:SmallInteger }" |
|
425 |
|
426 begHLnY "{ Class:SmallInteger }" |
|
427 runHLnY "{ Class:SmallInteger }" |
|
428 begHLnX "{ Class:SmallInteger }" |
|
429 endHLnX "{ Class:SmallInteger }" |
|
430 |
|
431 widthLvl "{ Class:SmallInteger }" |
|
432 offsHLnX "{ Class:SmallInteger }" |
|
433 |
|
434 level "{ Class:SmallInteger }" |
|
435 startLvI "{ Class:SmallInteger }" |
|
436 startLvX "{ Class:SmallInteger }" |
|
437 limitLvI "{ Class:SmallInteger }" |
|
438 limitLvX "{ Class:SmallInteger }" |
|
439 | |
|
440 x1 := x0 + aWidth. |
|
441 widthLvl := imageInset + imageWidth. |
|
442 offsHLnX := imageWidth // 2 + (self xOfFigureLevel:-1). |
|
443 |
|
444 parent := 4711. "/ to force a recompute |
|
445 prevItem := 4711. "/ to force a recomputation of the level |
|
446 |
|
447 self setMaskOrigin:(self viewOrigin + (0 @ 1) \\ (lineMask extent)). |
|
448 self paint:lineColor on:bgColor. |
|
449 self mask:lineMask. |
|
450 startLvI := self smallestLevelBetween:start and:stop. |
|
451 startLvX := self xOfFigureLevel:startLvI. |
|
452 limitLvI := 2. |
|
453 limitLvX := limitLvI * widthLvl + offsHLnX. |
|
454 |
|
455 buildInArray := Array new:20. |
|
456 buildInArray atAllPut:0. |
|
457 |
|
458 showRootNot := showRoot not. |
|
459 yBot := y0. |
|
460 begHLnY := runHLnY := y0. |
|
461 |
|
462 start to:stop do:[:anIndex| |
|
463 (item := list at:anIndex ifAbsent:nil) isNil ifTrue:[ |
|
464 ^ self mask:nil "/ list changed |
|
465 ]. |
|
466 yTop := yBot. |
|
467 yBot := self yVisibleOfLine:(anIndex + 1). |
|
468 yCtr := yTop + (yBot - yTop // 2). |
|
469 anIndex == 1 ifTrue:[ begHLnY := runHLnY := yCtr ]. |
|
470 |
|
471 (nxtPrnt := item parent) ~~ parent ifTrue:[ |
|
472 parent := nxtPrnt. |
|
473 |
|
474 prevItem == parent ifTrue:[ |
|
475 level := level + 1. |
|
476 begHLnX := endHLnX. |
|
477 ] ifFalse:[ |
|
478 level := item level. |
|
479 begHLnX := item level * widthLvl + offsHLnX. |
|
480 ]. |
|
481 |
|
482 isFirst := parent isNil or:[(showRootNot and:[level == 2])]. |
|
483 endHLnX := begHLnX + widthLvl. |
|
484 showVLines := begHLnX >= x0 and:[level > 1]. |
|
485 showHLine := x0 < endHLnX and:[x1 > begHLnX]. |
|
486 |
|
487 (showHLine and:[isFirst]) ifTrue:[ |
|
488 showHLine := showLeftIndicators and:[indicatorAction notNil] |
|
489 ] |
|
490 ]. |
|
491 |
|
492 showHLine ifTrue:[ |
|
493 self displayLineFromX:begHLnX y:yCtr toX:endHLnX y:yCtr |
|
494 ]. |
|
495 |
|
496 showVLines ifTrue:[ |
|
497 y := (parent last == item) ifTrue:[yCtr] ifFalse:[yBot]. |
|
498 x := begHLnX. |
|
499 p2 := parent. |
|
500 lv := level - 1. |
|
501 self displayLineFromX:x y:runHLnY toX:x y:y. |
|
502 |
|
503 [((p1 := p2 parent) notNil and:[(x := x - widthLvl) >= limitLvX])] whileTrue:[ |
|
504 (p1 last ~~ p2 and:[x <= x1]) ifTrue:[ |
|
505 x >= startLvX ifTrue:[ |
|
506 self displayLineFromX:x y:(yTop - 1) toX:x y:yBot |
|
507 ] ifFalse:[ |
|
508 buildInArray at:lv put:yBot |
|
509 ]. |
|
510 ]. |
|
511 lv := lv - 1. |
|
512 p2 := p1 |
|
513 ] |
|
514 ]. |
|
515 prevItem := item. |
|
516 runHLnY := yCtr. |
|
517 ]. |
|
518 |
|
519 "/ |
|
520 "/ draw outstanding verical lines to left |
|
521 "/ |
|
522 x := limitLvX. |
|
523 y := begHLnY. |
|
524 |
|
525 limitLvI to:startLvI do:[:i| |
|
526 (yBot := buildInArray at:i) ~~ 0 ifTrue:[ |
|
527 self displayLineFromX:x y:y toX:x y:yBot |
|
528 ]. |
|
529 x := x + widthLvl. |
|
530 ]. |
|
531 ( start == stop |
|
532 and:[(item := list at:start ifAbsent:nil) notNil |
|
533 and:[item isExpanded |
|
534 and:[item hasChildren]]] |
|
535 ) ifTrue:[ |
|
536 x := begHLnX + widthLvl. |
|
537 |
|
538 (x >= x0 and:[x <= x1]) ifTrue:[ |
|
539 yBot := self yVisibleOfLine:(start + 1). |
|
540 yCtr := y0 + (yBot - y0 // 2). |
|
541 self displayLineFromX:x y:yCtr toX:x y:yBot. |
|
542 ] |
|
543 ]. |
|
544 self mask:nil. |
|
545 |
|
546 |
|
547 ! |
|
548 |
|
549 redrawLabelFromItem:anItem atY:y h:h |
|
550 "called to redraw a label caused by a selection change |
|
551 " |
|
552 |w "{ Class:SmallInteger }" |
|
553 x "{ Class:SmallInteger }" |
|
554 | |
|
555 x := (self xOfStringLevel:(anItem level)) - (textStartLeft // 2). |
|
556 x := x max:margin. |
|
557 |
|
558 (w := width - x) > 0 ifTrue:[ |
|
559 self redrawX:x y:y width:w height:h |
|
560 ] |
|
561 |
|
562 |
|
563 ! ! |
|
564 |
|
565 !HierarchicalListView methodsFor:'event handling'! |
|
566 |
|
567 buttonMultiPress:button x:x y:y |
|
568 "handle a button multiPress event |
|
569 " |
|
570 |lnNr| |
|
571 |
|
572 enabled ifTrue:[ |
|
573 ( (button == 1 or:[button == #select]) |
|
574 and:[(lnNr := self indicatorLineAtX:x y:y) notNil] |
|
575 ) ifFalse:[ |
|
576 super buttonMultiPress:button x:x y:y |
|
577 ] |
|
578 ] |
|
579 ! |
|
580 |
|
581 buttonPress:button x:x y:y |
|
582 "handle a button press event |
|
583 " |
|
584 |lnNr menu item appl| |
|
585 |
|
586 enabled ifTrue:[ |
|
587 ((button == 2) or:[button == #menu]) ifTrue:[ |
|
588 ( (item := self selectedElement) notNil |
|
589 and:[(menu := item middleButtonMenu) notNil] |
|
590 ) ifTrue:[ |
|
591 menu isCollection ifTrue:[ |
|
592 menu := Menu new fromLiteralArrayEncoding:menu. |
|
593 appl := self application. |
|
594 |
|
595 appl notNil ifTrue:[ |
|
596 menu findGuiResourcesIn:appl. |
|
597 menu receiver:appl |
|
598 ] ifFalse:[ |
|
599 menu receiver:item |
|
600 ] |
|
601 ]. |
|
602 ^ menu startUp |
|
603 ]. |
|
604 ] ifFalse:[ |
|
605 (lnNr := self indicatorLineAtX:x y:y) notNil ifTrue:[ |
|
606 (indicatorAction numArgs == 1) ifTrue:[ |
|
607 indicatorAction value:lnNr |
|
608 ] ifFalse:[ |
|
609 indicatorAction value |
|
610 ]. |
|
611 ^ self |
|
612 ] |
|
613 ]. |
|
614 super buttonPress:button x:x y:y |
|
615 ] |
|
616 ! |
|
617 |
|
618 keyPress:aKey x:x y:y |
|
619 "a key was pressed - handle page-keys here |
|
620 " |
|
621 <resource: #keyboard( #CursorLeft #CursorRight )> |
|
622 |
|
623 |item parent index size stop step| |
|
624 |
|
625 (aKey == #CursorLeft or:[aKey == #CursorRight]) ifFalse:[ |
|
626 ^ super keyPress:aKey x:x y:y |
|
627 ]. |
|
628 |
|
629 ( enabled |
|
630 and:[(size := list size) > 1 |
|
631 and:[(index := self selectedIndex) ~~ 0 |
|
632 and:[(item := list at:index ifAbsent:nil) notNil]]] |
|
633 ) ifTrue:[ |
|
634 parent := item parent. |
|
635 |
|
636 aKey == #CursorLeft ifTrue:[step := -1. stop := 1] |
|
637 ifFalse:[step := 1. stop := size]. |
|
638 |
|
639 (index + step) to:stop by:step do:[:i| |
|
640 item := list at:i ifAbsent:[^ nil ]. |
|
641 item parent ~~ parent ifTrue:[^ self selection:i] |
|
642 ]. |
|
643 |
|
644 index := aKey == #CursorLeft ifTrue:[size] ifFalse:[1]. |
|
645 self selection:index |
|
646 ]. |
|
647 ! ! |
|
648 |
|
649 !HierarchicalListView methodsFor:'fetch resources'! |
|
650 |
|
651 fetchResources |
|
652 "fetch device colors and ..., to avoid reallocation at redraw time; |
|
653 *** called after a create or snapin to fetch all device resources |
|
654 " |
|
655 |image| |
|
656 |
|
657 super fetchResources. |
|
658 |
|
659 lineMask := lineMask onDevice:device. |
|
660 lineColor := lineColor onDevice:device. |
|
661 openIndicator := self imageOnDevice:openIndicator. |
|
662 closeIndicator := self imageOnDevice:closeIndicator. |
|
663 imageWidth := 4. |
|
664 |
|
665 icons keysAndValuesDo:[:aKey :anImage| |
|
666 image := self imageOnDevice:anImage. |
|
667 icons at:aKey put:image. |
|
668 imageWidth := image width max:imageWidth. |
|
669 ]. |
|
670 imageWidth := imageWidth // 2. |
|
671 imageWidth odd ifTrue:[imageWidth := imageWidth + 1]. |
|
672 imageWidth := imageWidth * 2. |
|
673 |
|
674 |
|
675 |
|
676 ! ! |
|
677 |
|
678 !HierarchicalListView methodsFor:'initialize / release'! |
|
679 |
|
680 initStyle |
|
681 "setup viewStyle specifics |
|
682 " |
|
683 |cls| |
|
684 |
|
685 super initStyle. |
|
686 |
|
687 cls := self class. |
|
688 |
|
689 lineMask := Form width:2 height:2 fromArray:#[16rAA 16r55]. |
|
690 icons := IdentityDictionary new. |
|
691 |
|
692 icons at:#expanded ifAbsentPut:[cls expandedIcon]. |
|
693 icons at:#collapsed ifAbsentPut:[cls collapsedIcon]. |
|
694 icons at:#empty ifAbsentPut:[cls emptyIcon]. |
|
695 |
|
696 openIndicator := self class openIndicator. |
|
697 closeIndicator := self class closeIndicator. |
|
698 lineColor := fgColor. |
|
699 highlightMode := #label. |
|
700 showRoot := true. |
|
701 showLeftIndicators := true. |
|
702 useDefaultIcons := true. |
|
703 showLines := true. |
|
704 imageInset := 4. |
|
705 imageWidth := 8. "/ default |
|
706 ! ! |
|
707 |
|
708 !HierarchicalListView methodsFor:'private'! |
|
709 |
|
710 figureFor:anItem |
|
711 "return a (bitmap) figure for an item |
|
712 " |
|
713 |key image w h| |
|
714 |
|
715 "/ the item may provide an icon |
|
716 "/ (it knows for itself if its open or closed) |
|
717 |
|
718 (key := anItem icon) notNil ifTrue:[ |
|
719 (key isImageOrForm and:[key device == device]) ifTrue:[ |
|
720 ^ key |
|
721 ]. |
|
722 |
|
723 (image := icons at:key ifAbsent:nil) notNil ifTrue:[ |
|
724 ^ image |
|
725 ]. |
|
726 |
|
727 key isImageOrForm ifTrue:[ |
|
728 image := self imageOnDevice:key. |
|
729 icons at:key put:image. |
|
730 ^ image |
|
731 ] |
|
732 ]. |
|
733 |
|
734 useDefaultIcons ifFalse:[^ nil]. |
|
735 |
|
736 "/ ok, item did not return an icon - use default. |
|
737 |
|
738 anItem hasChildren ifTrue:[ |
|
739 key := anItem isExpanded ifTrue:[#expanded] ifFalse:[#collapsed] |
|
740 ] ifFalse:[ |
|
741 key := #empty |
|
742 ]. |
|
743 ^ icons at:key |
|
744 ! |
|
745 |
|
746 heightOfLineAt:aLineNr |
|
747 "returns the total height for a line at an index, including |
|
748 lineSpacing, the figure and the label |
|
749 " |
|
750 |item icon height| |
|
751 |
|
752 item := list at:aLineNr ifAbsent:[^ 4]. |
|
753 height := item heightOn:self. |
|
754 |
|
755 (icon := self figureFor:item) notNil ifTrue:[ |
|
756 height := (item heightOn:self) max:height. |
|
757 ]. |
|
758 ^ lineSpacing + height |
|
759 |
|
760 |
|
761 ! |
|
762 |
|
763 indicatorLineAtX:x y:y |
|
764 "returns the lineNumber assigned to an indicator at x/y or nil |
|
765 " |
|
766 |lnNr item x0| |
|
767 |
|
768 ( indicatorAction isNil |
|
769 or:[(lnNr := self yVisibleToLineNr:y) isNil |
|
770 or:[(item := list at:lnNr ifAbsent:nil) isNil |
|
771 or:[item hasChildren not]]] |
|
772 ) ifFalse:[ |
|
773 x0 := self xOfFigureLevel:(item level - 1). |
|
774 |
|
775 (x > x0 and:[(x0 + imageWidth) > x]) ifTrue:[ |
|
776 ^ lnNr |
|
777 ] |
|
778 ]. |
|
779 ^ nil |
|
780 ! |
|
781 |
|
782 smallestLevelBetween:start and:stop |
|
783 "returns the smallest level between a range |
|
784 " |
|
785 |prevItem currParent nextParent item |
|
786 |
|
787 lvl "{ Class:SmallInteger }" |
|
788 min "{ Class:SmallInteger }" |
|
789 beg "{ Class:SmallInteger }" |
|
790 | |
|
791 |
|
792 prevItem := list at:start ifAbsent:[ ^ 1 ]. |
|
793 |
|
794 (currParent := prevItem parent) isNil ifTrue:[ |
|
795 ^ 1 |
|
796 ]. |
|
797 |
|
798 (min := prevItem level) == 2 ifTrue:[ |
|
799 ^ min |
|
800 ]. |
|
801 beg := start + 1. |
|
802 |
|
803 beg to:stop do:[:i| |
|
804 item := list at:i ifAbsent:[^ min]. |
|
805 |
|
806 (nextParent := item parent) == currParent ifFalse:[ |
|
807 (currParent := nextParent) == prevItem ifFalse:[ |
|
808 (lvl := item level) == 2 ifTrue:[ |
|
809 ^ 2 |
|
810 ]. |
|
811 min := min min:lvl |
|
812 ] |
|
813 ]. |
|
814 prevItem := item |
|
815 ]. |
|
816 ^ min |
|
817 |
|
818 |
|
819 |
|
820 |
|
821 |
|
822 ! |
|
823 |
|
824 widthOfWidestLineBetween:firstLine and:lastLine |
|
825 "return the width of the longest line in pixels |
|
826 " |
|
827 |nprnt pprnt pitem item |
|
828 textX "{ Class: SmallInteger }" |
|
829 level "{ Class: SmallInteger }" |
|
830 width "{ Class: SmallInteger }" |
|
831 deltaX "{ Class: SmallInteger }" |
|
832 startX "{ Class: SmallInteger }" |
|
833 | |
|
834 |
|
835 pprnt := 4711. "/ force a computation |
|
836 pitem := 4712. "/ force a computation |
|
837 width := 20. |
|
838 deltaX := imageInset + imageWidth. |
|
839 startX := self xOfStringLevel:1. |
|
840 |
|
841 firstLine to:lastLine do:[:idx| |
|
842 item := list at:idx ifAbsent:[^ width + startX]. |
|
843 |
|
844 (nprnt := item parent) ~~ pprnt ifTrue:[ |
|
845 (pprnt := nprnt) == pitem ifTrue:[ |
|
846 level := level + 1. |
|
847 textX := textX + deltaX. |
|
848 ] ifFalse:[ |
|
849 level := item level. |
|
850 textX := level - 1 * deltaX. |
|
851 ] |
|
852 ]. |
|
853 pitem := item. |
|
854 width := (item widthOn:self) max:width |
|
855 ]. |
|
856 ^ width + startX |
|
857 |
|
858 |
|
859 ! |
|
860 |
|
861 xOfFigureLevel:aLevel |
|
862 "origin x where to draw the icon |
|
863 " |
|
864 |l "{ Class:SmallInteger }"| |
|
865 |
|
866 l := showRoot ifTrue:[aLevel] ifFalse:[aLevel - 1]. |
|
867 |
|
868 indicatorAction isNil ifTrue:[ |
|
869 l := l - 1 |
|
870 ] ifFalse:[ |
|
871 showLeftIndicators ifFalse:[ |
|
872 l := l - 1 |
|
873 ] |
|
874 ]. |
|
875 ^ (l * (imageInset + imageWidth)) + imageInset - (viewOrigin x) |
|
876 ! |
|
877 |
|
878 xOfStringLevel:aLevel |
|
879 "origin x where to draw the text( label ) |
|
880 " |
|
881 ^ (self xOfFigureLevel:aLevel) + imageWidth + textStartLeft |
|
882 |
|
883 ! ! |
|
884 |
|
885 !HierarchicalListView class methodsFor:'documentation'! |
|
886 |
|
887 version |
|
888 ^ '$Header: /cvs/stx/stx/libwidg2/HierarchicalListView.st,v 1.1 1999-05-23 12:56:26 cg Exp $' |
|
889 ! ! |