|
1 " |
|
2 COPYRIGHT (c) 1989-93 by Claus Gittinger |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 PopUpView subclass:#PopUpMenu |
|
14 instanceVariableNames:'menuView lastSelection memorize hideOnLeave |
|
15 actionLabels actionLines actionValues' |
|
16 classVariableNames:'' |
|
17 poolDictionaries:'' |
|
18 category:'Views-Menus' |
|
19 ! |
|
20 |
|
21 PopUpMenu comment:' |
|
22 |
|
23 COPYRIGHT (c) 1989-93 by Claus Gittinger |
|
24 All Rights Reserved |
|
25 |
|
26 %W% %E% |
|
27 |
|
28 written summer 89 by claus; |
|
29 ST-80 compatibility added Dec 92; |
|
30 '! |
|
31 |
|
32 !PopUpMenu class methodsFor:'instance creation'! |
|
33 |
|
34 labels:labels selectors:selectors receiver:anObject for:aView |
|
35 |newMenu| |
|
36 |
|
37 aView isNil ifTrue:[ |
|
38 newMenu := self on:Display |
|
39 ] ifFalse:[ |
|
40 newMenu := self on:(aView device) |
|
41 ]. |
|
42 ^ newMenu menu:(MenuView |
|
43 labels:labels |
|
44 selectors:selectors |
|
45 receiver:anObject |
|
46 in:newMenu) |
|
47 ! |
|
48 |
|
49 labels:labels selectors:selectors receiver:anObject |
|
50 ^ self labels:labels selectors:selectors receiver:anObject for:nil |
|
51 ! |
|
52 |
|
53 labels:labels selectors:selectors args:args receiver:anObject for:aView |
|
54 |newMenu| |
|
55 |
|
56 aView isNil ifTrue:[ |
|
57 newMenu := self on:Display |
|
58 ] ifFalse:[ |
|
59 newMenu := self on:(aView device) |
|
60 ]. |
|
61 ^ newMenu menu:(MenuView |
|
62 labels:labels |
|
63 selectors:selectors |
|
64 args:args |
|
65 receiver:anObject |
|
66 in:newMenu) |
|
67 ! |
|
68 |
|
69 labels:labels selectors:selectors args:args receiver:anObject |
|
70 ^ self labels:labels |
|
71 selectors:selectors |
|
72 args:args |
|
73 receiver:anObject |
|
74 for:nil |
|
75 ! ! |
|
76 |
|
77 !PopUpMenu class methodsFor:'ST-80 instance creation'! |
|
78 |
|
79 labels:labels |
|
80 ^ self labels:labels lines:nil values:nil |
|
81 ! |
|
82 |
|
83 labels:labels values:values |
|
84 ^ self labels:labels lines:nil values:values |
|
85 ! |
|
86 |
|
87 labels:labels lines:lines |
|
88 ^ self labels:labels lines:lines values:nil |
|
89 ! |
|
90 |
|
91 labels:labels lines:lines values:values |
|
92 ^ (self new) labels:labels lines:lines values:values |
|
93 ! |
|
94 |
|
95 labelList:labels values:values |
|
96 ^ self labels:labels lines:nil values:values |
|
97 ! |
|
98 |
|
99 labelList:labels lines:lines values:values |
|
100 ^ (self new) labels:labels lines:lines values:values |
|
101 ! ! |
|
102 |
|
103 !PopUpMenu methodsFor:'initialization'! |
|
104 |
|
105 initialize |
|
106 super initialize. |
|
107 memorize := true. |
|
108 hideOnLeave := false |
|
109 ! |
|
110 |
|
111 initEvents |
|
112 super initEvents. |
|
113 self enableEnterLeaveEvents. |
|
114 self enableButtonMotionEvents. |
|
115 self enableMotionEvents. |
|
116 self enableButtonEvents |
|
117 ! ! |
|
118 |
|
119 !PopUpMenu methodsFor:'realization'! |
|
120 |
|
121 fixSize |
|
122 "adjust my size to the size of the actual menu" |
|
123 |
|
124 |extra newWidth newHeight| |
|
125 |
|
126 extra := margin * 2. |
|
127 newWidth := menuView width + extra. |
|
128 newHeight := menuView height + extra. |
|
129 ((newWidth ~~ width) or:[newHeight ~~ height]) ifTrue:[ |
|
130 self extent:(menuView width + extra) @ (menuView height + extra) |
|
131 ]. |
|
132 super fixSize |
|
133 ! |
|
134 |
|
135 realize |
|
136 menuView deselectWithoutRedraw. |
|
137 super realize. |
|
138 |
|
139 menuView disableButtonMotionEvents. |
|
140 menuView disableMotionEvents. |
|
141 menuView disableButtonEvents |
|
142 ! ! |
|
143 |
|
144 !PopUpMenu methodsFor:'private accessing'! |
|
145 |
|
146 menu:aMenu |
|
147 "set the actual menu" |
|
148 |
|
149 menuView := aMenu. |
|
150 menuView origin:(margin @ margin). |
|
151 menuView borderWidth:0 |
|
152 ! |
|
153 |
|
154 menuView |
|
155 "return the actual menu" |
|
156 |
|
157 ^ menuView |
|
158 ! ! |
|
159 |
|
160 !PopUpMenu methodsFor:'accessing'! |
|
161 |
|
162 viewBackground:aColor |
|
163 "this is a kludge and will vanish ..." |
|
164 |
|
165 super viewBackground:aColor. |
|
166 menuView viewBackground:aColor |
|
167 ! |
|
168 |
|
169 hideOnLeave:aBoolean |
|
170 "set/clear the hideOnLeave attribute, which controls |
|
171 if the menu should be hidden when the pointer leaves |
|
172 the view (used with multiple-menus)" |
|
173 |
|
174 hideOnLeave := aBoolean |
|
175 ! |
|
176 |
|
177 enable:anEntry |
|
178 "enable a menu entry" |
|
179 |
|
180 menuView enable:anEntry |
|
181 ! |
|
182 |
|
183 disable:anEntry |
|
184 "disable a menu entry" |
|
185 |
|
186 menuView disable:anEntry |
|
187 ! |
|
188 |
|
189 receiver:anObject |
|
190 menuView receiver:anObject |
|
191 ! |
|
192 |
|
193 addLabel:aLabel selector:aSelector |
|
194 "add a new menu entry to the end" |
|
195 |
|
196 menuView addLabel:aLabel selector:aSelector |
|
197 ! |
|
198 |
|
199 addLabel:aLabel selector:aSelector arg:anArg |
|
200 "add a new menu entry to the end" |
|
201 |
|
202 menuView addLabel:aLabel selector:aSelector arg:anArg |
|
203 ! |
|
204 |
|
205 labelAt:index put:aString |
|
206 "change a menu entry" |
|
207 |
|
208 menuView labelAt:index put:aString |
|
209 ! |
|
210 |
|
211 selectorAt:index put:aSymbol |
|
212 "change a selector entry" |
|
213 |
|
214 menuView selectorAt:index put:aSymbol |
|
215 ! |
|
216 |
|
217 subMenuAt:indexOrName put:aMenu |
|
218 "define a submenu to be shown for entry indexOrName" |
|
219 |
|
220 aMenu hideOnLeave:true. |
|
221 menuView subMenuAt:indexOrName put:aMenu |
|
222 |
|
223 "|v m| |
|
224 v := View new. |
|
225 m := PopUpMenu labels:#('1' '2' '3') |
|
226 selectors:#(one two nil) |
|
227 receiver:v |
|
228 for:nil. |
|
229 m subMenuAt:3 put:(PopUpMenu |
|
230 labels:#('a' 'b' 'c') |
|
231 selectors:#(a b c) |
|
232 receiver:v |
|
233 for:nil). |
|
234 v middleButtonMenu:m. |
|
235 v realize" |
|
236 ! |
|
237 |
|
238 checkToggleAt:index |
|
239 "return a checkToggles state" |
|
240 |
|
241 ^ menuView checkToggleAt:index |
|
242 ! |
|
243 |
|
244 checkToggleAt:index put:aBoolean |
|
245 "set/clear a checkToggle" |
|
246 |
|
247 ^ menuView checkToggleAt:index put:aBoolean |
|
248 ! ! |
|
249 |
|
250 !PopUpMenu methodsFor:'ST-80 accessing'! |
|
251 |
|
252 numberOfItems |
|
253 ^ actionLabels asText size |
|
254 ! |
|
255 |
|
256 labels |
|
257 ^ actionLabels asText |
|
258 ! |
|
259 |
|
260 values |
|
261 ^ actionValues |
|
262 ! |
|
263 |
|
264 lines |
|
265 ^ actionLines |
|
266 ! |
|
267 |
|
268 labels:labelString lines:lineArray values:valueArray |
|
269 "define the menu the ST-80 way (with labels and lines |
|
270 defined separately)" |
|
271 |
|
272 |labelArray argArray convertedLabels |
|
273 offs dstOffs linePos| |
|
274 |
|
275 actionLabels := labelString. |
|
276 actionLines := lineArray. |
|
277 actionValues := valueArray. |
|
278 |
|
279 labelArray := labelString asText. |
|
280 |
|
281 convertedLabels := Array new:(labelArray size + lineArray size). |
|
282 argArray := Array new:(labelArray size + lineArray size). |
|
283 |
|
284 offs := 1. |
|
285 dstOffs := 1. |
|
286 1 to:lineArray size do:[:lineIndex | |
|
287 linePos := lineArray at:lineIndex. |
|
288 [offs <= linePos] whileTrue:[ |
|
289 convertedLabels at:dstOffs put:(labelArray at:offs). |
|
290 argArray at:dstOffs put:offs. |
|
291 offs := offs + 1. |
|
292 dstOffs := dstOffs + 1 |
|
293 ]. |
|
294 convertedLabels at:dstOffs put:'-'. |
|
295 argArray at:dstOffs put:nil. |
|
296 dstOffs := dstOffs + 1 |
|
297 ]. |
|
298 [offs <= labelArray size] whileTrue:[ |
|
299 convertedLabels at:dstOffs put:(labelArray at:offs). |
|
300 argArray at:dstOffs put:offs. |
|
301 offs := offs + 1. |
|
302 dstOffs := dstOffs + 1 |
|
303 ]. |
|
304 self menu:(MenuView |
|
305 labels:convertedLabels |
|
306 selector:nil |
|
307 args:argArray |
|
308 receiver:nil |
|
309 in:self) |
|
310 |
|
311 ! ! |
|
312 |
|
313 !PopUpMenu methodsFor:'activation'! |
|
314 |
|
315 showAt:aPoint |
|
316 "realize the menu at aPoint - return control" |
|
317 |
|
318 self fixSize. |
|
319 self origin:aPoint. |
|
320 ((top + height) > (device height)) ifTrue:[ |
|
321 self top:(device height - height) |
|
322 ]. |
|
323 ((left + width) > (device width)) ifTrue:[ |
|
324 self left:(device width - width) |
|
325 ]. |
|
326 self realize |
|
327 ! |
|
328 |
|
329 showAtPointer |
|
330 "realize the menu at the current pointer position - return control" |
|
331 |
|
332 self showAt:(device pointerPosition) |
|
333 ! |
|
334 |
|
335 show |
|
336 "realize the menu at its last position - return control" |
|
337 |
|
338 self fixSize. |
|
339 self realize |
|
340 ! |
|
341 |
|
342 hide |
|
343 "hide the menu" |
|
344 |
|
345 ^ self unrealize |
|
346 ! ! |
|
347 |
|
348 !PopUpMenu methodsFor:'ST-80 activation'! |
|
349 |
|
350 startUp |
|
351 "start the menu modal - return the selected selector, |
|
352 or - if no selectors where specified - the index. |
|
353 If nothing was selected, return 0. |
|
354 Modal - i.e. stay in the menu until finished" |
|
355 |
|
356 |actionIndex value| |
|
357 |
|
358 menuView action:[:selected | |
|
359 menuView args isNil ifTrue:[ |
|
360 menuView selectors isNil ifTrue:[ |
|
361 ^ 0 |
|
362 ]. |
|
363 ^ menuView receiver perform:(menuView selectors at:selected) |
|
364 ]. |
|
365 actionIndex := menuView args at:selected. |
|
366 actionIndex isNil ifTrue:[^ 0]. |
|
367 actionValues isNil ifTrue:[^ actionIndex]. |
|
368 value := actionValues at:actionIndex. |
|
369 (value isKindOf:PopUpMenu) ifTrue:[ |
|
370 ^ value startUp |
|
371 ]. |
|
372 ^ value |
|
373 ]. |
|
374 self showAtPointer. |
|
375 self modalLoop. |
|
376 ^ 0 |
|
377 ! ! |
|
378 |
|
379 !PopUpMenu methodsFor:'events'! |
|
380 |
|
381 buttonMotion:button x:x y:y |
|
382 (x >= 0) ifTrue:[ |
|
383 (x < width) ifTrue:[ |
|
384 (y >= 0) ifTrue:[ |
|
385 (y < height) ifTrue:[ |
|
386 menuView buttonMotion:button x:x y:y. |
|
387 ^ self |
|
388 ] |
|
389 ] |
|
390 ] |
|
391 ]. |
|
392 menuView pointerLeave:button. |
|
393 hideOnLeave ifTrue:[ |
|
394 self hide |
|
395 ] |
|
396 ! |
|
397 |
|
398 pointerLeave:state |
|
399 menuView pointerLeave:state. |
|
400 hideOnLeave ifTrue:[ |
|
401 self hide |
|
402 ] |
|
403 ! |
|
404 |
|
405 buttonRelease:button x:x y:y |
|
406 self hide. |
|
407 menuView buttonRelease:button x:x y:y |
|
408 ! ! |