|
1 " |
|
2 COPYRIGHT (c) 1995 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 'From Smalltalk/X, Version:3.1.4 on 25-feb-1997 at 2:17:26 pm' ! |
|
14 |
|
15 ApplicationModel subclass:#UIPainter |
|
16 instanceVariableNames:'topView workView propertyView treeView elementMenu fileName |
|
17 specClass specSelector specSuperclass aspects' |
|
18 classVariableNames:'' |
|
19 poolDictionaries:'' |
|
20 category:'Interface-UIPainter' |
|
21 ! |
|
22 |
1 HorizontalPanelView subclass:#ButtonPanel |
23 HorizontalPanelView subclass:#ButtonPanel |
2 instanceVariableNames:'receiver argumentToSelector' |
24 instanceVariableNames:'receiver argumentToSelector' |
3 classVariableNames:'' |
25 classVariableNames:'' |
4 poolDictionaries:'' |
26 poolDictionaries:'' |
5 privateIn:UIPainter |
27 privateIn:UIPainter |
6 ! |
28 ! |
|
29 |
|
30 !UIPainter class methodsFor:'documentation'! |
|
31 |
|
32 copyright |
|
33 " |
|
34 COPYRIGHT (c) 1995 by Claus Gittinger |
|
35 All Rights Reserved |
|
36 |
|
37 This software is furnished under a license and may be used |
|
38 only in accordance with the terms of that license and with the |
|
39 inclusion of the above copyright notice. This software may not |
|
40 be provided or otherwise made available to, or used by, any |
|
41 other person. No title to or ownership of the software is |
|
42 hereby transferred. |
|
43 " |
|
44 ! |
|
45 |
|
46 documentation |
|
47 " |
|
48 not yet finished, not yet published, not yet released. |
|
49 |
|
50 [start with:] |
|
51 UIPainter open |
|
52 " |
|
53 ! ! |
|
54 |
|
55 !UIPainter class methodsFor:'interface specs'! |
|
56 |
|
57 nameAndSelectorSpec |
|
58 "this window spec was automatically generated by the ST/X UIPainter" |
|
59 |
|
60 "do not manually edit this - the painter/builder may not be able to |
|
61 handle the specification if its corrupted." |
|
62 |
|
63 " |
|
64 UIPainter new openOnClass:UIPainter andSelector:#nameAndSelectorSpec |
|
65 UIPainter new openInterface:#nameAndSelectorSpec |
|
66 " |
|
67 |
|
68 <resource: #canvas> |
|
69 |
|
70 ^ |
|
71 |
|
72 #(#FullSpec |
|
73 #'isOpaque:' true |
|
74 #'window:' |
|
75 #(#WindowSpec |
|
76 #'name:' 'uIPainterView' |
|
77 #'layout:' #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0) |
|
78 #'isOpaque:' true |
|
79 #'label:' 'unnamed' |
|
80 #'bounds:' #(#Rectangle 0 0 300 300) |
|
81 ) |
|
82 #'component:' |
|
83 #(#SpecCollection |
|
84 #'collection:' |
|
85 #( |
|
86 #(#LabelSpec |
|
87 #'name:' 'label1' |
|
88 #'layout:' #(#LayoutFrame 10 0 50 0 110 0 70 0) |
|
89 #'isOpaque:' true |
|
90 #'label:' 'class:' |
|
91 #'foregroundColor:' #(#Color 0.0 0.0 0.0) |
|
92 #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) |
|
93 #'initiallyInvisible:' false |
|
94 #'level:' 0 |
|
95 #'adjust:' #right |
|
96 #'hasCharacterOrientedLabel:' true |
|
97 ) |
|
98 #(#LabelSpec |
|
99 #'name:' 'label2' |
|
100 #'layout:' #(#LayoutFrame 10 0 90 0 110 0 110 0) |
|
101 #'isOpaque:' true |
|
102 #'label:' 'superclass:' |
|
103 #'foregroundColor:' #(#Color 0.0 0.0 0.0) |
|
104 #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) |
|
105 #'initiallyInvisible:' false |
|
106 #'level:' 0 |
|
107 #'adjust:' #right |
|
108 #'hasCharacterOrientedLabel:' true |
|
109 ) |
|
110 #(#LabelSpec |
|
111 #'name:' 'label3' |
|
112 #'layout:' #(#LayoutFrame 10 0 130 0 110 0 150 0) |
|
113 #'isOpaque:' true |
|
114 #'label:' 'selector:' |
|
115 #'foregroundColor:' #(#Color 0.0 0.0 0.0) |
|
116 #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) |
|
117 #'initiallyInvisible:' false |
|
118 #'level:' 0 |
|
119 #'adjust:' #right |
|
120 #'hasCharacterOrientedLabel:' true |
|
121 ) |
|
122 #(#InputFieldSpec |
|
123 #'name:' 'classNameField' |
|
124 #'layout:' #(#LayoutFrame 120 0 50 0 289 0 69 0) |
|
125 #'isOpaque:' true |
|
126 #'initiallyDisabled:' false |
|
127 #'initiallyInvisible:' false |
|
128 #'model:' #classNameChannel |
|
129 #'isReadOnly:' false |
|
130 #'tabable:' true |
|
131 #'immediateAccept:' false |
|
132 #'acceptOnLeave:' true |
|
133 #'acceptOnReturn:' true |
|
134 #'acceptOnTab:' true |
|
135 #'acceptOnLostFocus:' true |
|
136 #'hasBorder:' false |
|
137 ) |
|
138 #(#InputFieldSpec |
|
139 #'name:' 'superclassNameField' |
|
140 #'layout:' #(#LayoutFrame 120 0 90 0 289 0 109 0) |
|
141 #'isOpaque:' true |
|
142 #'initiallyDisabled:' false |
|
143 #'initiallyInvisible:' false |
|
144 #'model:' #superclassNameChannel |
|
145 #'isReadOnly:' false |
|
146 #'tabable:' true |
|
147 #'immediateAccept:' false |
|
148 #'acceptOnLeave:' true |
|
149 #'acceptOnReturn:' true |
|
150 #'acceptOnTab:' true |
|
151 #'acceptOnLostFocus:' true |
|
152 #'hasBorder:' false |
|
153 ) |
|
154 #(#InputFieldSpec |
|
155 #'name:' 'methodNameField' |
|
156 #'layout:' #(#LayoutFrame 120 0 130 0 289 0 149 0) |
|
157 #'isOpaque:' true |
|
158 #'initiallyDisabled:' false |
|
159 #'initiallyInvisible:' false |
|
160 #'model:' #methodNameChannel |
|
161 #'isReadOnly:' false |
|
162 #'tabable:' true |
|
163 #'immediateAccept:' false |
|
164 #'acceptOnLeave:' true |
|
165 #'acceptOnReturn:' true |
|
166 #'acceptOnTab:' true |
|
167 #'acceptOnLostFocus:' true |
|
168 #'numChars:' 5 |
|
169 #'hasBorder:' false |
|
170 ) |
|
171 #(#ActionButtonSpec |
|
172 #'name:' 'button1' |
|
173 #'layout:' #(#LayoutFrame 30 0 250 0 129 0 279 0) |
|
174 #'isOpaque:' true |
|
175 #'label:' 'cancel' |
|
176 #'foregroundColor:' #(#Color 0.0 0.0 0.0) |
|
177 #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) |
|
178 #'initiallyInvisible:' false |
|
179 #'tabable:' true |
|
180 #'isDefault:' false |
|
181 #'defaultable:' false |
|
182 #'model:' #cancel |
|
183 #'hasCharacterOrientedLabel:' true |
|
184 #'isDecorated:' false |
|
185 #'initiallyDisabled:' false |
|
186 ) |
|
187 #(#ActionButtonSpec |
|
188 #'name:' 'button2' |
|
189 #'layout:' #(#LayoutFrame 160 0 250 0 259 0 279 0) |
|
190 #'isOpaque:' true |
|
191 #'label:' 'ok' |
|
192 #'foregroundColor:' #(#Color 0.0 0.0 0.0) |
|
193 #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) |
|
194 #'initiallyInvisible:' false |
|
195 #'tabable:' true |
|
196 #'isDefault:' true |
|
197 #'defaultable:' false |
|
198 #'model:' #accept |
|
199 #'hasCharacterOrientedLabel:' true |
|
200 #'isDecorated:' false |
|
201 #'initiallyDisabled:' false |
|
202 ) |
|
203 #(#LabelSpec |
|
204 #'name:' 'boxLabel' |
|
205 #'layout:' #(#LayoutOrigin 78 0 11 0) |
|
206 #'isOpaque:' true |
|
207 #'label:' 'class & selector for code' |
|
208 #'foregroundColor:' #(#Color 0.0 0.0 0.0) |
|
209 #'backgroundColor:' #(#Color 66.9993 66.9993 66.9993) |
|
210 #'initiallyInvisible:' false |
|
211 #'level:' 0 |
|
212 #'adjust:' #center |
|
213 #'hasCharacterOrientedLabel:' true |
|
214 ) |
|
215 ) |
|
216 ) |
|
217 ) |
|
218 ! ! |
|
219 |
|
220 !UIPainter methodsFor:'BuilderView interface'! |
|
221 |
|
222 update:something |
|
223 |
|
224 elementMenu deselect. |
|
225 treeView update:something. |
|
226 propertyView update:something. |
|
227 ! ! |
|
228 |
|
229 !UIPainter methodsFor:'aspects'! |
|
230 |
|
231 aspectFor:aKey |
|
232 ^ aspects at:aKey ifAbsent:[ super aspectFor:aKey ] |
|
233 |
|
234 ! ! |
|
235 |
|
236 !UIPainter methodsFor:'filein & fileout'! |
|
237 |
|
238 openFile:aFileName |
|
239 |aStream | |
|
240 |
|
241 aStream := FileStream readonlyFileNamed:aFileName. |
|
242 |
|
243 aStream notNil ifTrue:[ |
|
244 workView fileInContentsFrom:aStream. |
|
245 aStream close. |
|
246 fileName := aFileName |
|
247 ] |
|
248 |
|
249 ! |
|
250 |
|
251 saveAs:aFileName |
|
252 |aStream| |
|
253 |
|
254 aStream := FileStream newFileNamed:aFileName. |
|
255 |
|
256 aStream notNil ifTrue:[ |
|
257 workView storeContentsOn:aStream. |
|
258 aStream close. |
|
259 fileName := aFileName |
|
260 ]. |
|
261 |
|
262 ! ! |
|
263 |
|
264 !UIPainter methodsFor:'help'! |
|
265 |
|
266 helpTextFor:aComponent |
|
267 |sel| |
|
268 |
|
269 (aComponent isKindOf:Button) ifTrue:[ |
|
270 (sel := aComponent changeMessage) notNil ifTrue:[ |
|
271 "/ take the buttons change symbol as resource-key |
|
272 ^ resources string:(sel asString) |
|
273 ] |
|
274 ]. |
|
275 ^ nil |
|
276 |
|
277 "Modified: 31.8.1995 / 20:49:58 / claus" |
|
278 ! ! |
|
279 |
|
280 !UIPainter methodsFor:'initialization'! |
|
281 |
|
282 createCanvas |
|
283 |topView| |
|
284 |
|
285 super initialize. |
|
286 |
|
287 topView := StandardSystemView new. |
|
288 topView label:'unnamed'. |
|
289 topView extent:300@300. |
|
290 topView application:self. |
|
291 |
|
292 workView := UIPainterView in:topView. |
|
293 workView layout:(0.0 @ 0.0 corner:1.0 @ 1.0) asLayout. |
|
294 |
|
295 ^ workView. |
|
296 |
|
297 "Builder new createCanvas open" |
|
298 ! |
|
299 |
|
300 initChannels |
|
301 |cls| |
|
302 |
|
303 aspects := IdentityDictionary new. |
|
304 |
|
305 aspects at:#classNameChannel put:( |
|
306 (specClass notNil ifTrue:[specClass] |
|
307 ifFalse:['NewApplication']) asValue |
|
308 ). |
|
309 specSuperclass isNil ifTrue:[ |
|
310 specClass notNil ifTrue:[ |
|
311 (cls := Smalltalk at:specClass asSymbol) notNil ifTrue:[ |
|
312 specSuperclass := cls superclass name. |
|
313 ] |
|
314 ] |
|
315 ]. |
|
316 aspects at:#superclassNameChannel put:( |
|
317 (specSuperclass notNil ifTrue:[specSuperclass] |
|
318 ifFalse:['ApplicationModel']) asValue |
|
319 ). |
|
320 aspects at:#methodNameChannel put:( |
|
321 (specSelector notNil ifTrue:[specSelector] |
|
322 ifFalse:[#windowSpec]) asValue |
|
323 ). |
|
324 ! |
|
325 |
|
326 initPullDownMenu:aMenu |
|
327 aMenu labels:(resources array:#( |
|
328 'file' |
|
329 'font' |
|
330 'type' |
|
331 'align' |
|
332 'dimension' |
|
333 'special' |
|
334 'misc' |
|
335 'code' |
|
336 'test' |
|
337 )). |
|
338 |
|
339 aMenu selectors:#(#file |
|
340 #font |
|
341 #type |
|
342 #align |
|
343 #dimension |
|
344 #special |
|
345 #misc |
|
346 #code |
|
347 #test |
|
348 ). |
|
349 |
|
350 aMenu at:#file |
|
351 putLabels:(resources array: |
|
352 #('new' |
|
353 'from class ...' |
|
354 'pick a view ' |
|
355 '-' |
|
356 'load' |
|
357 'save' |
|
358 'save as ...' |
|
359 '-' |
|
360 'install spec' |
|
361 'install aspects' |
|
362 '-' |
|
363 "/ 'source' |
|
364 'windowSpec' |
|
365 'inspect me' |
|
366 'raise' |
|
367 '-' |
|
368 'print' |
|
369 '-' |
|
370 'quit' |
|
371 )) |
|
372 selectors:#(doNew |
|
373 doFromClass |
|
374 doPickAView |
|
375 nil |
|
376 doOpen |
|
377 doSave |
|
378 doSaveAs |
|
379 nil |
|
380 doInstallSpec |
|
381 doInstallAspects |
|
382 nil |
|
383 "/ doSource |
|
384 doWindowSpec |
|
385 inspect |
|
386 doRaise |
|
387 nil |
|
388 doPrint |
|
389 nil |
|
390 doFinish |
|
391 ) |
|
392 receiver:self. |
|
393 |
|
394 aMenu at:#font putMenu:(workView subMenuFont menuView). |
|
395 |
|
396 aMenu at:#type |
|
397 putLabels:(resources array:#( |
|
398 'basic widgets' |
|
399 'layout' |
|
400 'text' |
|
401 'interactors' |
|
402 'modal' |
|
403 'other' |
|
404 '-' |
|
405 'all' |
|
406 ) ) |
|
407 selectors:#(showBasicWidgets |
|
408 showLayoutWidgets |
|
409 showTextWidgets |
|
410 showInteractorWidgets |
|
411 showModalWidgets |
|
412 showOtherWidgets |
|
413 nil |
|
414 showAllWidgets |
|
415 ) |
|
416 receiver:self. |
|
417 |
|
418 aMenu at:#align putMenu:(workView subMenuAlign menuView). |
|
419 aMenu at:#dimension putMenu:(workView subMenuDimension menuView). |
|
420 |
|
421 aMenu at:#special |
|
422 putLabels:(resources array:#( |
|
423 'group radioButtons' |
|
424 'group enterFields' |
|
425 '-' |
|
426 'delete undo history' |
|
427 ) ) |
|
428 selectors:#( |
|
429 groupRadioButtons |
|
430 groupEnterFields |
|
431 nil |
|
432 removeUndoHistory |
|
433 ) |
|
434 receiver:workView. |
|
435 |
|
436 aMenu at:#code |
|
437 putLabels:(resources array:#( |
|
438 'class & method' |
|
439 ) ) |
|
440 selectors:#( |
|
441 defineClassAndSelector |
|
442 ) |
|
443 receiver:self. |
|
444 |
|
445 aMenu at:#misc putMenu:(self menuMisc). |
|
446 |
|
447 aMenu at:#test |
|
448 putLabels:(resources array:#( |
|
449 '\c test mode' |
|
450 ) ) |
|
451 selectors:#(doToggleTest |
|
452 ) |
|
453 receiver:self. |
|
454 |
|
455 (aMenu menuAt:#test) checkToggleAt:#doToggleTest put:(workView testMode). |
|
456 ! |
|
457 |
|
458 openInterface |
|
459 |inset panel menu| |
|
460 |
|
461 super initialize. |
|
462 self initChannels. |
|
463 workView := self createCanvas. |
|
464 |
|
465 topView := StandardSystemView new. |
|
466 topView label:'Interface Builder'. |
|
467 topView icon:(Image fromFile:'bitmaps/Builder.xbm' resolution:100). |
|
468 topView extent:(600 @ 400). |
|
469 |
|
470 menu := PullDownMenu in:topView. |
|
471 panel := ButtonPanel in:topView. |
|
472 inset := menu preferredExtent y + panel preferredExtent y. |
|
473 |
|
474 panel origin:0.0@(menu preferredExtent y) corner:1.0@inset . |
|
475 panel receiver:workView. |
|
476 |
|
477 elementMenu := HVScrollableView for:SelectionInListView miniScrollerH:true in:topView. |
|
478 elementMenu origin:0.0@0.0 corner:0.3 @ 1.0. |
|
479 elementMenu topInset:inset . |
|
480 elementMenu := elementMenu scrolledView. |
|
481 |
|
482 elementMenu action:[:selection | |
|
483 workView testMode ifTrue:[ |
|
484 elementMenu deselect |
|
485 ] ifFalse:[ |
|
486 selection notNil ifTrue:[ |
|
487 workView createWidgetWithClass: |
|
488 (Smalltalk at:(elementMenu selectionValue asSymbol)) |
|
489 ] |
|
490 ] |
|
491 ]. |
|
492 |
|
493 treeView := HVScrollableView for:UIPainterTreeView miniScrollerH:true in:topView. |
|
494 treeView origin:0.3 @ 0.0 corner:0.6@1.0. |
|
495 treeView topInset:inset . |
|
496 treeView := treeView scrolledView. |
|
497 treeView builderView:workView. |
|
498 |
|
499 propertyView := View origin:(0.6 @ 0.0) corner:1.0@1.0 in:topView. |
|
500 propertyView topInset:inset . |
|
501 propertyView := UIPropertyView in:propertyView receiver:workView. |
|
502 |
|
503 workView addDependent:self. |
|
504 self initPullDownMenu:menu. |
|
505 topView application:self. |
|
506 builder window:topView. |
|
507 topView beMaster. |
|
508 workView topView beSlave. |
|
509 topView open. |
|
510 workView topView openInGroup:(topView windowGroup). |
|
511 ! |
|
512 |
|
513 openNewWindowCanvas |
|
514 self open. |
|
515 |
|
516 |
|
517 ! |
|
518 |
|
519 openOnClass:aClass andSelector:aSelector |
|
520 "open up an interface builder, fetching a spec from someClass |
|
521 via some selector" |
|
522 |
|
523 |specArray| |
|
524 |
|
525 specClass := aClass name. |
|
526 specSuperclass := aClass superclass name. |
|
527 specSelector := aSelector. |
|
528 |
|
529 self openInterface. |
|
530 workView className:aClass name. |
|
531 workView methodName:aSelector. |
|
532 workView setupFromSpec:(aClass perform:aSelector). |
|
533 ! |
|
534 |
|
535 openOnSpec:aSpecOrSpecArray |
|
536 "open up an interface builder, given some specArray" |
|
537 |
|
538 |newBuilder| |
|
539 |
|
540 newBuilder := self new. |
|
541 ! ! |
|
542 |
|
543 !UIPainter methodsFor:'menus'! |
|
544 |
|
545 menuMisc |
|
546 |
|
547 |menuView menuGrid menuUndo| |
|
548 |
|
549 menuView := MenuView labels: |
|
550 (resources array:#( |
|
551 'grid' |
|
552 'undo' |
|
553 ) |
|
554 ) |
|
555 selectors:#( |
|
556 #grid |
|
557 #undo |
|
558 ) |
|
559 receiver:self. |
|
560 |
|
561 |
|
562 menuGrid := PopUpMenu labels:( |
|
563 resources array:#( |
|
564 '\c show' |
|
565 '\c align' |
|
566 ) |
|
567 ) |
|
568 selectors:#( |
|
569 #gridShown: |
|
570 #gridAlign: |
|
571 ) |
|
572 receiver:workView. |
|
573 |
|
574 menuGrid checkToggleAt:#gridShown: put:(workView gridShown). |
|
575 menuGrid checkToggleAt:#gridAlign: put:(workView gridAlign). |
|
576 menuView subMenuAt:#grid put:menuGrid. |
|
577 |
|
578 menuUndo := PopUpMenu labels:( |
|
579 resources array:#( |
|
580 'last' |
|
581 'menu' |
|
582 '-' |
|
583 'delete' |
|
584 ) |
|
585 ) |
|
586 selectors:#( |
|
587 #undoLast |
|
588 #openUndoMenu |
|
589 nil |
|
590 #removeUndoHistory |
|
591 ) |
|
592 receiver:workView. |
|
593 |
|
594 menuView subMenuAt:#undo put:menuUndo. |
|
595 ^ menuView |
|
596 ! ! |
|
597 |
|
598 !UIPainter methodsFor:'setup choices'! |
|
599 |
|
600 showAllWidgets |
|
601 "create list of basic widgets" |
|
602 |
|
603 self showWidgetsWhere:[:class | true] |
|
604 ! |
|
605 |
|
606 showBasicWidgets |
|
607 "create list of basic widgets" |
|
608 |
|
609 self showWidgetsInCategory:'Views-Basic' |
|
610 butNot:[:class | class isKindOf:ModalBox class] |
|
611 ! |
|
612 |
|
613 showInteractorWidgets |
|
614 "create list of interactor widgets" |
|
615 |
|
616 self showWidgetsInCategory:'Views-Interactors' |
|
617 butNot:[:class | class isKindOf:ModalBox class] |
|
618 ! |
|
619 |
|
620 showLayoutWidgets |
|
621 "create list of basic widgets" |
|
622 |
|
623 self showWidgetsInCategory:'Views-Layout' |
|
624 butNot:[:class | class isKindOf:ModalBox class] |
|
625 ! |
|
626 |
|
627 showModalWidgets |
|
628 "create list of modal widgets" |
|
629 |
|
630 self showWidgetsWhere:[:class | class isKindOf:ModalBox class] |
|
631 ! |
|
632 |
|
633 showOtherWidgets |
|
634 "create list of other widgets" |
|
635 |
|
636 |check cat| |
|
637 |
|
638 check := [:class | |
|
639 (#('Views-Basic' |
|
640 'Views-Interactors' |
|
641 'Views-Layout' |
|
642 'Views-Text') includes:class category) not]. |
|
643 self showWidgetsWhere:check |
|
644 butNot:[:class | class isKindOf:ModalBox class] |
|
645 ! |
|
646 |
|
647 showTextWidgets |
|
648 "create list of basic widgets" |
|
649 |
|
650 self showWidgetsInCategory:'Views-Text' |
|
651 butNot:[:class | class isKindOf:ModalBox class] |
|
652 ! |
|
653 |
|
654 showWidgetsInCategory:aCategory |
|
655 "create list of basic widgets" |
|
656 |
|
657 self showWidgetsWhere:[:class | class category = aCategory] |
|
658 ! |
|
659 |
|
660 showWidgetsInCategory:aCategory butNot:excludeBlock |
|
661 "create list of basic widgets" |
|
662 |
|
663 self showWidgetsWhere:[:class | class category = aCategory] |
|
664 butNot:excludeBlock |
|
665 ! |
|
666 |
|
667 showWidgetsWhere:aBlock |
|
668 "create list of widgets where aBlock avaluates to true" |
|
669 |
|
670 self showWidgetsWhere:aBlock butNot:[:class | false] |
|
671 ! |
|
672 |
|
673 showWidgetsWhere:aBlock butNot:excludeBlock |
|
674 "create list of widgets where aBlock evaluates to true and excludeBlock |
|
675 evaluates to false" |
|
676 |
|
677 |list| |
|
678 |
|
679 list := OrderedCollection new:0. |
|
680 SimpleView allSubclassesDo:[:aSubclass | |
|
681 (aBlock value:aSubclass) ifTrue:[ |
|
682 (excludeBlock value:aSubclass) ifFalse:[ |
|
683 list add:(aSubclass name) |
|
684 ] |
|
685 ] |
|
686 ]. |
|
687 (aBlock value:View) ifTrue:[ |
|
688 (excludeBlock value:View) ifFalse:[ |
|
689 list add:'View' |
|
690 ] |
|
691 ]. |
|
692 (list size == 0) ifFalse:[ |
|
693 list sort |
|
694 ]. |
|
695 elementMenu list:list |
|
696 ! ! |
|
697 |
|
698 !UIPainter methodsFor:'user interaction'! |
|
699 |
|
700 closeRequest |
|
701 workView notNil ifTrue:[workView release. workView := nil]. |
|
702 super closeRequest |
|
703 ! |
|
704 |
|
705 closeRequestFor:aTopView |
|
706 aTopView == topView ifTrue:[ |
|
707 super closeRequestFor:aTopView |
|
708 ] ifFalse:[ |
|
709 topView device beep |
|
710 ] |
|
711 ! ! |
|
712 |
|
713 !UIPainter methodsFor:'user interaction - dialogs'! |
|
714 |
|
715 checkClassAndSelector |
|
716 "check for class & superclass" |
|
717 |
|
718 |superclass cls| |
|
719 |
|
720 specClass isNil ifTrue:[^ false]. |
|
721 |
|
722 specClass isBehavior ifFalse:[ |
|
723 cls := Smalltalk at:specClass asSymbol |
|
724 ] ifTrue:[ |
|
725 cls := specClass |
|
726 ]. |
|
727 cls isNil ifTrue:[ |
|
728 (superclass := Smalltalk at:specSuperclass asSymbol) isNil ifTrue:[ |
|
729 self warn:'no class named ' , specSuperclass , ' exists.'. |
|
730 ^ false. |
|
731 ]. |
|
732 (self confirm:'create ' , specClass , ' ?') ifTrue:[ |
|
733 superclass subclass:(specClass asSymbol) |
|
734 instanceVariableNames:'' |
|
735 classVariableNames:'' |
|
736 poolDictionaries:'' |
|
737 category:'New-Applications'. |
|
738 ^ true. |
|
739 ]. |
|
740 ^ false. |
|
741 ]. |
|
742 cls isBehavior ifFalse:[ |
|
743 self warn:'a global named ' , specClass , ' exists, but is no class.'. |
|
744 ^ false. |
|
745 ]. |
|
746 |
|
747 specSuperclass isBehavior ifFalse:[ |
|
748 superclass := Smalltalk at:specSuperclass asSymbol |
|
749 ] ifTrue:[ |
|
750 superclass := specSuperclass |
|
751 ]. |
|
752 specSuperclass notNil ifTrue:[ |
|
753 superclass isNil ifTrue:[ |
|
754 self warn:'no class named ' , specSuperclass , ' exists.'. |
|
755 ^ false. |
|
756 ]. |
|
757 |
|
758 (cls isSubclassOf:superclass) ifFalse:[ |
|
759 self warn:'a global named ' , specClass , ' exists, but is not a subclass of ' , superclass name , '.'. |
|
760 ^ false. |
|
761 ] |
|
762 ]. |
|
763 ^ true |
|
764 ! |
|
765 |
|
766 defineClassAndSelector |
|
767 "launch a dialog to define class, superclass and method" |
|
768 |
|
769 |again| |
|
770 |
|
771 [ |
|
772 again := false. |
|
773 (self openDialogInterface:#nameAndSelectorSpec) ifTrue:[ |
|
774 |
|
775 specClass := (self aspectFor:#classNameChannel) value. |
|
776 specSelector := (self aspectFor:#methodNameChannel) value. |
|
777 specSuperclass := (self aspectFor:#superclassNameChannel) value. |
|
778 |
|
779 again := self checkClassAndSelector not. |
|
780 again ifFalse:[ |
|
781 workView className:specClass superclassName:specSuperclass selector:specSelector. |
|
782 ]. |
|
783 ] |
|
784 ] doWhile:[again] |
|
785 |
|
786 ! ! |
|
787 |
|
788 !UIPainter methodsFor:'user interaction - menu'! |
|
789 |
|
790 doFinish |
|
791 self closeRequest |
|
792 ! |
|
793 |
|
794 doFromClass |
|
795 |className methodName cls sel accepted failed spec s| |
|
796 |
|
797 className := '' asValue. |
|
798 methodName := '' asValue. |
|
799 (s := workView className) notNil ifTrue:[ |
|
800 className value:s |
|
801 ]. |
|
802 (s := workView methodName) notNil ifTrue:[ |
|
803 methodName value:s |
|
804 ]. |
|
805 |
|
806 failed := false. |
|
807 [ |
|
808 accepted := |
|
809 (DialogBox new |
|
810 addTextLabel:'Classes name:'; |
|
811 addInputFieldOn:className; |
|
812 addVerticalSpace; |
|
813 addTextLabel:'methods name:'; |
|
814 addInputFieldOn:methodName; |
|
815 addAbortButton; |
|
816 addOkButton; |
|
817 open |
|
818 ) accepted. |
|
819 |
|
820 accepted ifTrue:[ |
|
821 cls := Smalltalk classNamed:className value. |
|
822 cls isNil ifTrue:[ |
|
823 failed := true. |
|
824 self warn:'no such class'. |
|
825 ] ifFalse:[ |
|
826 sel := methodName value asSymbol. |
|
827 (cls respondsTo:sel ) ifFalse:[ |
|
828 failed := true. |
|
829 self warn:'no such method' |
|
830 ] ifTrue:[ |
|
831 spec := cls perform:sel. |
|
832 spec isArray ifFalse:[ |
|
833 failed := true. |
|
834 self warn:'not a windowSpec method' |
|
835 ]. |
|
836 "/ ok, got it |
|
837 workView className:className value. |
|
838 workView methodName:methodName value. |
|
839 workView setupFromSpec:spec. |
|
840 ^ self |
|
841 ] |
|
842 ] |
|
843 ] |
|
844 ] doWhile:[accepted and:[failed]]. |
|
845 |
|
846 "Modified: 5.9.1995 / 18:47:57 / claus" |
|
847 ! |
|
848 |
|
849 doInstallAspects |
|
850 |code| |
|
851 |
|
852 (specClass isNil or:[specSelector isNil]) ifTrue:[ |
|
853 self defineClassAndSelector |
|
854 ]. |
|
855 |
|
856 self checkClassAndSelector ifFalse:[ |
|
857 ^ self |
|
858 ]. |
|
859 |
|
860 workView className:specClass superclassName:specSuperclass selector:specSelector. |
|
861 |
|
862 code := workView generateAspectMethods. |
|
863 (ReadStream on:code) fileIn. |
|
864 |
|
865 "Modified: 4.9.1995 / 17:06:10 / claus" |
|
866 ! |
|
867 |
|
868 doInstallSpec |
|
869 |code| |
|
870 |
|
871 (specClass isNil or:[specSelector isNil]) ifTrue:[ |
|
872 self defineClassAndSelector |
|
873 ]. |
|
874 |
|
875 self checkClassAndSelector ifFalse:[ |
|
876 ^ self |
|
877 ]. |
|
878 |
|
879 workView className:specClass superclassName:specSuperclass selector:specSelector. |
|
880 |
|
881 code := workView generateCode. |
|
882 (ReadStream on:code) fileIn. |
|
883 |
|
884 "Modified: 4.9.1995 / 17:06:10 / claus" |
|
885 ! |
|
886 |
|
887 doNew |
|
888 workView removeAll. |
|
889 ! |
|
890 |
|
891 doOpen |
|
892 |box| |
|
893 |
|
894 box := FileSelectionBox new. |
|
895 box title:(resources string:'Which file ?'). |
|
896 box selectingDirectory:false. |
|
897 box pattern:'*.*'. |
|
898 box action:[:aFile| self openFile:aFile ]. |
|
899 box open |
|
900 ! |
|
901 |
|
902 doPickAView |
|
903 |view className methodName cls sel accepted spec s| |
|
904 |
|
905 view := Display viewFromUser. |
|
906 view isNil ifTrue:[^ self]. |
|
907 |
|
908 spec := UISpecification fromView:view topView. |
|
909 |
|
910 "/ ok, got it |
|
911 workView setupFromSpec:spec. |
|
912 workView className:view class name. |
|
913 workView methodName:#newSpec. |
|
914 ^ self |
|
915 |
|
916 "Modified: 5.9.1995 / 23:25:53 / claus" |
|
917 ! |
|
918 |
|
919 doPrint |
|
920 ^ self |
|
921 ! |
|
922 |
|
923 doRaise |
|
924 workView topView raise |
|
925 ! |
|
926 |
|
927 doSave |
|
928 fileName notNil ifTrue:[ |
|
929 self saveAs:fileName |
|
930 ] ifFalse:[ |
|
931 self doSaveAs |
|
932 ] |
|
933 ! |
|
934 |
|
935 doSaveAs |
|
936 |box| |
|
937 |
|
938 box := FileSelectionBox new. |
|
939 box title:(resources string:'Which file ?'). |
|
940 box selectingDirectory:false. |
|
941 box pattern:'*.*'. |
|
942 box action:[:aFile| self saveAs:aFile ]. |
|
943 box open |
|
944 ! ! |
|
945 |
|
946 !UIPainter ignoredMethodsFor:'user interaction - menu'! |
|
947 |
|
948 doSource |
|
949 |code v| |
|
950 |
|
951 code := workView generateCode. |
|
952 v := CodeView open. |
|
953 v contents:code. |
|
954 v label:(workView applicationName). |
|
955 ^ self |
|
956 |
|
957 "Modified: 5.9.1995 / 21:02:05 / claus" |
|
958 ! ! |
|
959 |
|
960 !UIPainter methodsFor:'user interaction - menu'! |
|
961 |
|
962 doToggleTest |
|
963 workView testMode:(workView testMode not) |
|
964 ! |
|
965 |
|
966 doWindowSpec |
|
967 |code v| |
|
968 |
|
969 code := workView generateWindowSpecMethodSource. |
|
970 code := code , workView generateAspectMethods. |
|
971 v := CodeView open. |
|
972 v contents:code. |
|
973 v label:'windowSpec'. |
|
974 ^ self |
|
975 |
|
976 "Modified: 5.9.1995 / 21:04:14 / claus" |
|
977 ! ! |
|
978 |
|
979 !UIPainter::ButtonPanel class methodsFor:'documentation'! |
|
980 |
|
981 version |
|
982 ^ '$Header$' |
|
983 ! ! |
7 |
984 |
8 !UIPainter::ButtonPanel methodsFor:'accessing'! |
985 !UIPainter::ButtonPanel methodsFor:'accessing'! |
9 |
986 |
10 receiver |
987 receiver |
11 ^ receiver |
988 ^ receiver |