-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathSTYLESHEET
777 lines (601 loc) · 37.7 KB
/
STYLESHEET
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP")
(FILECREATED "26-Jan-88 17:58:05" {QV}<TRIGG>LISP>STYLESHEET.;2 37593
changes to%: (FNS STYLESHEET.CHANGE.ITEMS STYLESHEET.FILL.IN.WINDOW STYLESHEET.IMAGEHEIGHT
STYLESHEET.IMAGEWIDTH STYLESHEET.AT.LOAD)
(VARS STYLESHEETCOMS)
previous date%: "27-Aug-87 13:10:53" |{IE:PARC:XEROX}<LISPUSERS>LYRIC>STYLESHEET.;1|)
(* "
Copyright (c) 1983, 1985, 1987, 1988 by Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT STYLESHEETCOMS)
(RPAQQ STYLESHEETCOMS [(DECLARE%: DONTCOPY (PROPS (STYLESHEET MAKEFILE-ENVIRONMENT)
(STYLESHEET FILETYPE)))
(DECLARE%: (LOCALVARS . T))
(* * Public entry)
(FNS CREATE.STYLE STYLESHEETP STYLE.PROP STYLESHEET STYLESHEET.IMAGEHEIGHT
STYLESHEET.IMAGEWIDTH)
(* * Private routines.)
(DECLARE%: EVAL@COMPILE DONTCOPY (RECORDS STYLEBLOCK))
(INITRECORDS STYLEBLOCK)
(FNS STYLESHEET.CHANGE.FILL STYLESHEET.CHANGE.ITEMS
STYLESHEET.CHANGE.SELECTIONS STYLESHEET.CHANGE.TITLES STYLESHEET.MENUITEM
)
(FNS STYLESHEET.SETUP STYLESHEET.WAIT.TILL.DONE STYLESHEET.GET.SELECTIONS
STYLESHEET.CLEANUP)
(FNS STYLESHEET.WHENSELECTEDFN STYLESHEET.CLEAR.WHENSELECTEDFN
STYLESHEET.DONE.FN)
(FNS STYLESHEET.ITEM.HEIGHT STYLESHEET.ITEM.WIDTH)
(FNS STYLESHEET.CREATE.WINDOW STYLESHEET.FILL.IN.WINDOW STYLESHEET.ADD.MENU
STYLESHEET.SHADE.SELECTIONS)
(FNS STYLESHEET.AT.LOAD)
(P (STYLESHEET.AT.LOAD))
(GLOBALVARS STYLESHEET.SELECTED.SHADE)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA)
(NLAML)
(LAMA STYLE.PROP CREATE.STYLE])
(DECLARE%: DONTCOPY
(PUTPROPS STYLESHEET MAKEFILE-ENVIRONMENT (:PACKAGE "INTERLISP" :READTABLE "INTERLISP"))
(PUTPROPS STYLESHEET FILETYPE :TCOMPL)
)
(DECLARE%:
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
)
(* * Public entry)
(DEFINEQ
(CREATE.STYLE
[LAMBDA STYLE (* hts%: "21-Mar-85 14:14")
(* * Stylesheet constructor.)
(LET* [(PLIST (for I to STYLE collect (ARG STYLE I)))
(ITEMS (LISTP (LISTGET PLIST 'ITEMS]
(if ITEMS
then (LET ((STYLESHEET (LIST 'STYLESHEET 'ITEMS ITEMS)))
(for PROP on PLIST by (CDDR PROP) do (STYLE.PROP STYLESHEET (CAR PROP)
(CADR PROP)))
STYLESHEET)
else NIL])
(STYLESHEETP
[LAMBDA (THING) (* hts%: "22-Mar-85 13:00")
(* * Tells whether THING is probably a stylesheet.)
(AND (LISTP THING)
(EQ (CAR THING)
'STYLESHEET)
(LISTP (LISTGET (CDR THING)
'ITEMS])
(STYLE.PROP
[LAMBDA PROPSTUFF (* hts%: "22-Mar-85 13:22")
(* * Get or put a "field" of a stylesheet.
Works externally the same way as WINDOWPROP.
A stylesheet is represented as the cons of the atom STYLESHEET and a plist
containing all the requisite data.)
(OR (EQ PROPSTUFF 2)
(EQ PROPSTUFF 3)
(\ILLEGAL.ARG))
(LET ((STYLESHEET (ARG PROPSTUFF 1)))
(OR (STYLESHEETP STYLESHEET)
(\ILLEGAL.ARG STYLESHEET))
(LET [(PROP (MKATOM (ARG PROPSTUFF 2]
(if (EQ PROPSTUFF 2)
then (LISTGET (CDR STYLESHEET)
PROP)
else (LET ((OLDVAL (LISTGET (CDR STYLESHEET)
PROP))
(NEWVAL (ARG PROPSTUFF 3)))
(LISTPUT (CDR STYLESHEET)
PROP NEWVAL)
(* * Certain stylesheet properties are normalized and collected into a list of
"styleblocks" %, one for each item. Styleblocks make it easier later on to
handle the information for each item. Styleblocks store the items themselves,
selections, fill information, titles, and CLEAR-ALL submenus
(if any)%.)
(SELECTQ (ARG PROPSTUFF 2)
(ITEMS (STYLESHEET.CHANGE.ITEMS STYLESHEET NEWVAL))
(NEED.NOT.FILL.IN
(STYLESHEET.CHANGE.FILL STYLESHEET NEWVAL))
(SELECTIONS (STYLESHEET.CHANGE.SELECTIONS STYLESHEET NEWVAL))
(ITEM.TITLES (STYLESHEET.CHANGE.TITLES STYLESHEET NEWVAL))
NIL)
OLDVAL])
(STYLESHEET
[LAMBDA (STYLE) (* ; "Edited 27-Aug-87 13:08 by Stansbury")
(* ;;; "Creates a window, lays out the menus in it, and waits for BACKGROUND to notify it that the the user has made all his selections and hit the DONE button. Then removes the window and returns the selections the user made.")
(OR (STYLESHEETP STYLE)
(\ILLEGAL.ARG STYLE))
(LET ((OLD.WHENSELECTEDFNS (STYLESHEET.SETUP STYLE) (* ;
"Hold onto old WHENSELECTEDFNs so that they can be restored on exit.")
)
(W (STYLESHEET.CREATE.WINDOW STYLE) (* ;
"Lay out stylesheet of appropriate size and fill it in.")
))
(* ;;
"Wait until the user has filled everything in he needs to, and has hit the DONE button.")
(STYLESHEET.WAIT.TILL.DONE W STYLE)
(* ;; "Clean things up and return user's selections.")
(PROG1 (if (EQ (WINDOWPROP W 'HOW NIL)
'ABORT)
then
(* ;;
"user selected ABORT: restore original selections, in case stylesheet is reused. Return NIL.")
(STYLE.PROP STYLE 'SELECTIONS (STYLE.PROP STYLE 'SELECTIONS))
NIL
else
(* ;; "normal exit: return new selections.")
(STYLESHEET.GET.SELECTIONS STYLE))
(STYLESHEET.CLEANUP W STYLE OLD.WHENSELECTEDFNS])
(STYLESHEET.IMAGEHEIGHT
[LAMBDA (STYLESHEET) (* ; "Edited 26-Jan-88 11:48 by Trigg")
(* ;;; "Tells how high in pixels the given stylesheet would be if it were displayed.")
(* ;;
"rht 1/26/88: Now grabs Done/Reset/Abort styleblock off of STYLEPROP rather than from globalvar.")
(HEIGHTIFWINDOW (bind THIS.ONE (BIG _ 0)
(TITLEFONT _ (STYLE.PROP STYLESHEET 'ITEM.TITLE.FONT)) for BLOCK
in (CONS (STYLE.PROP STYLESHEET '\DONE.STYLEBLOCK)
(STYLE.PROP STYLESHEET '\STYLE.BLOCKS))
do (if (IGREATERP (SETQ THIS.ONE (STYLESHEET.ITEM.HEIGHT BLOCK TITLEFONT))
BIG)
then (SETQ BIG THIS.ONE)) finally (RETURN BIG))
(STYLE.PROP STYLESHEET 'TITLE])
(STYLESHEET.IMAGEWIDTH
[LAMBDA (STYLESHEET) (* ; "Edited 26-Jan-88 11:50 by Trigg")
(* ;;;
"returns the width in pixels this entire stylesheet would take up on the screen were it displayed.")
(* ;;
"rht 1/26/88: Now grabs Done/Reset/Abort styleblock off of STYLEPROP rather than from globalvar.")
(WIDTHIFWINDOW (LET [(BLOCKS (STYLE.PROP STYLESHEET '\STYLE.BLOCKS]
(IPLUS (bind (TITLEFONT _ (STYLE.PROP STYLESHEET 'ITEM.TITLE.FONT))
for BLOCK in (CONS (STYLE.PROP STYLESHEET '\DONE.STYLEBLOCK)
BLOCKS) sum (STYLESHEET.ITEM.WIDTH BLOCK
TITLEFONT))
(ITIMES 2 (LENGTH BLOCKS])
)
(* * Private routines.)
(DECLARE%: EVAL@COMPILE DONTCOPY
(DECLARE%: EVAL@COMPILE
(DATATYPE STYLEBLOCK (TITLE MENU SUBMENU FILL SELECTIONS))
)
(/DECLAREDATATYPE 'STYLEBLOCK '(POINTER POINTER POINTER POINTER POINTER) '((STYLEBLOCK 0 POINTER)
(STYLEBLOCK 2 POINTER)
(STYLEBLOCK 4 POINTER)
(STYLEBLOCK 6 POINTER)
(STYLEBLOCK 8 POINTER))
'10)
)
(/DECLAREDATATYPE 'STYLEBLOCK '(POINTER POINTER POINTER POINTER POINTER) '((STYLEBLOCK 0 POINTER)
(STYLEBLOCK 2 POINTER)
(STYLEBLOCK 4 POINTER)
(STYLEBLOCK 6 POINTER)
(STYLEBLOCK 8 POINTER))
'10)
(DEFINEQ
(STYLESHEET.CHANGE.FILL
[LAMBDA (STYLESHEET NEWFILL BLOCKS) (* hts%: "23-Mar-85 16:22")
(* * Modifies the given stylesheet to reflect new menu fill information.
Must be called either when the fill info changes or when the styleblock list
must be rebuilt (since fill info is cached in styleblocks)%.
Note that it calls STYLESHEET.CHANGE.SELECTIONS, since changing the fill to or
from MULTI requires changing the format in which selections are represented.)
(* * Fill in defaulted arguments.)
[OR NEWFILL (SETQ NEWFILL (STYLE.PROP STYLESHEET 'NEED.NOT.FILL.IN]
[OR BLOCKS (SETQ BLOCKS (STYLE.PROP STYLESHEET '\STYLE.BLOCKS]
(* * update fill info in styleblocks.)
[for BLOCK in BLOCKS as N from 1
do (LET ((FILL (if (LISTP NEWFILL)
then (CAR (FNTH NEWFILL N))
else NEWFILL)))
(* * Record new fill type. Note if new fill type is just a single atom rather
than a list, that atom applies to all items in the stylesheet.)
(replace (STYLEBLOCK FILL) of BLOCK with FILL)
(* * Build ALL-CLEAR submenu if necessary%: Menus that need not have any
selections are always equipped with a CLEAR button in the submenu
(not strictly necessary, since pressing a selected item on such a menu will
deselect that item; but it serves as a simple visual aid to the user to tell
him he need not make any selections in this menu);
menus that can have multiple selections are equipped with an ALL button in the
submenu (same reason as for the CLEAR button);
and other menus have no submenu.)
(replace (STYLEBLOCK SUBMENU) of BLOCK
with (SELECTQ FILL
(MULTI (create MENU
ITEMS _ '(ALL CLEAR)
WHENSELECTEDFN _ (FUNCTION STYLESHEET.CLEAR.WHENSELECTEDFN)
MENUUSERDATA _ (fetch (STYLEBLOCK MENU) of BLOCK)))
(T (create MENU
ITEMS _ '(CLEAR)
WHENSELECTEDFN _ (FUNCTION STYLESHEET.CLEAR.WHENSELECTEDFN)
MENUUSERDATA _ (fetch (STYLEBLOCK MENU) of BLOCK)))
(NIL NIL)
(\ILLEGAL.ARG NEWFILL]
(* * Build mapping from submenus to styleblocks, which will enable the
WHENSELECTEDFN of the submenu to get hold of the corresponding styleblock to
modify its selections as necessary.)
(STYLE.PROP STYLESHEET '\SUBMENU.TO.BLOCK (for BLOCK in BLOCKS bind SUBMENU
when (SETQ SUBMENU (fetch (STYLEBLOCK SUBMENU)
of BLOCK))
collect (CONS SUBMENU BLOCK)))
(* * Change selection format%: MULTI requires a list of selections, T or NIL
require a single selection.)
(STYLESHEET.CHANGE.SELECTIONS STYLESHEET NIL BLOCKS])
(STYLESHEET.CHANGE.ITEMS
[LAMBDA (STYLESHEET NEWITEMS) (* ; "Edited 26-Jan-88 17:56 by Trigg")
(* ;;; "Rebuilds all the styleblocks. Should be called whenever the user changes the items of a stylesheet.")
(* ;; "rht 1/26/88: Now computes Done/Reset/Abort styleblock here and stashes on STYLEPROP rather than using globalvar.")
(LET [(BLOCKS (for MENU in NEWITEMS collect (create STYLEBLOCK
MENU _ MENU]
(STYLE.PROP STYLESHEET '\STYLE.BLOCKS BLOCKS)
[STYLE.PROP STYLESHEET '\DONE.STYLEBLOCK (create STYLEBLOCK
MENU _ (create MENU
ITEMS _
'(DONE RESET ABORT)
WHENSELECTEDFN _
(FUNCTION STYLESHEET.DONE.FN]
(* ;; "Build mapping from menus to styleblocks. This will allow the menus' WHENSELECTEDFN to get hold of the appropriate styleblock to change its selection information.")
(STYLE.PROP STYLESHEET '\MENU.TO.BLOCK (for BLOCK in BLOCKS
collect (CONS (fetch (STYLEBLOCK MENU)
of BLOCK)
BLOCK)))
(* ;;
"Fill in fill info and selections (STYLESHEET.CHANGE.FILL calls STYLESHEET.CHANGE.SELECTIONS)")
(STYLESHEET.CHANGE.FILL STYLESHEET NIL BLOCKS)
(* ;; "Fill in item titles.")
(STYLESHEET.CHANGE.TITLES STYLESHEET NIL BLOCKS])
(STYLESHEET.CHANGE.SELECTIONS
[LAMBDA (STYLESHEET NEWSELECTIONS BLOCKS) (* hts%: "22-Mar-85 13:45")
(* * Records new default selections in the styleblocks.)
(* * Fill in defaulted arguments.)
[OR NEWSELECTIONS (SETQ NEWSELECTIONS (STYLE.PROP STYLESHEET 'SELECTIONS]
[OR BLOCKS (SETQ BLOCKS (STYLE.PROP STYLESHEET '\STYLE.BLOCKS]
(* * Normalize selections and stick them into styleblocks.
Selections must be normalized in two ways%: abbreviations for a menu item must
be replaced by the entire menu item; and items with fill = MULTI should have a
list of selections, but other items should have just a single selection
(or NIL))
(for BLOCK in BLOCKS as N from 1
do (replace (STYLEBLOCK SELECTIONS) of BLOCK
with (LET [(MENU (fetch (STYLEBLOCK MENU) of BLOCK))
(SELECTIONS (CAR (FNTH NEWSELECTIONS N]
(SELECTQ (fetch (STYLEBLOCK FILL) of BLOCK)
(MULTI (SETQ SELECTIONS (MKLIST SELECTIONS))
(for MULTISEL
in [LET [(FULL.SELECTIONS (for SUBSEL in SELECTIONS
collect (STYLESHEET.MENUITEM SUBSEL
MENU]
(if (for SUBSEL in FULL.SELECTIONS always SUBSEL)
then FULL.SELECTIONS
else (LIST (STYLESHEET.MENUITEM SELECTIONS MENU]
when MULTISEL collect MULTISEL))
((T NIL)
(STYLESHEET.MENUITEM SELECTIONS MENU))
(SHOULDNT])
(STYLESHEET.CHANGE.TITLES
[LAMBDA (STYLESHEET NEWTITLES BLOCKS) (* hts%: "22-Mar-85 13:49")
(* * Fills in item titles in styleblocks)
(* * FIll in defaulted args.)
[OR NEWTITLES (SETQ NEWTITLES (STYLE.PROP STYLESHEET 'ITEM.TITLES]
[OR BLOCKS (SETQ BLOCKS (STYLE.PROP STYLESHEET '\STYLE.BLOCKS]
(* * Fill in titles in styleblocks. ((CAR
(FNTH xxx)) stuff ensures that if the title list is too short, titles in
leftover styleblocks will be NILLed apropriately.))
(for BLOCK in BLOCKS as N from 1 do (replace (STYLEBLOCK TITLE) of BLOCK
with (CAR (FNTH NEWTITLES N])
(STYLESHEET.MENUITEM
[LAMBDA (SELECTION MENU) (* hts%: "22-Mar-85 13:50")
(* * Finds the full menu item corresponding to the given abbreviation.)
(for MENUITEM in (fetch (MENU ITEMS) of MENU)
thereis (OR (EQUAL MENUITEM SELECTION)
(STREQUAL (MKSTRING MENUITEM)
(MKSTRING SELECTION))
(AND (LISTP MENUITEM)
(STREQUAL (MKSTRING (CAR MENUITEM))
(MKSTRING SELECTION])
)
(DEFINEQ
(STYLESHEET.SETUP
[LAMBDA (STYLESHEET) (* hts%: "22-Mar-85 14:05")
(* * Changes the WHENSELECTEDFNs of all the menus to be the appropriate one for
stylesheet menus, and returns the old WHENSELECTEDFNs.
Also NILLs the SHADEDITEMS of each menu, since STYLESHEET.SHADE.SELECTIONS
depends on the validity of this field. (ADDMENU should really do it --
submit AR.))
(for BLOCK in (STYLE.PROP STYLESHEET '\STYLE.BLOCKS)
collect (LET ((MENU (fetch (STYLEBLOCK MENU) of BLOCK)))
(PROG1 (fetch (MENU WHENSELECTEDFN) of MENU)
(replace (MENU WHENSELECTEDFN) of MENU with (FUNCTION
STYLESHEET.WHENSELECTEDFN))
(replace (MENU SHADEDITEMS) of MENU with NIL])
(STYLESHEET.WAIT.TILL.DONE
[LAMBDA (W STYLESHEET) (* hts%: "21-Mar-85 18:39")
(* * Wait until the user has filled everything in he needs to, and has hit the
DONE button.)
(* * make sure there is a mouse process running.)
(SPAWN.MOUSE)
(bind QUIT.TYPE do
(* * keep the window on top to bring the users attention to it and to keep it
from being covered.)
(TOTOPW W)
(WINDOWPROP W 'HOW NIL)
(WINDOWPROP W 'DONE (CREATE.EVENT 'DONE))
(AWAIT.EVENT (WINDOWPROP W 'DONE)
1000)
repeatuntil (if (SETQ QUIT.TYPE (WINDOWPROP W 'HOW))
then
(* if not this was a timeout to bring the window back to the top.)
[if (EQ QUIT.TYPE 'ABORT)
then (* user selected the abort button.)
T
else
(* wait until the user hits the "done" button AND all menus have been selected
from.)
(for BLOCK in (STYLE.PROP STYLESHEET '\STYLE.BLOCKS)
always (OR (fetch (STYLEBLOCK FILL) of BLOCK)
(fetch (STYLEBLOCK SELECTIONS) of BLOCK]
else NIL])
(STYLESHEET.GET.SELECTIONS
[LAMBDA (STYLESHEET) (* hts%: "22-Mar-85 14:09")
(* * Gathers up the selections the user made, and records them as the new
default selections for the stylesheet, so that if it is reused
(and the default selections are not changed in between)%, the user will see his
last selections.)
(LET
[(SELECTIONS
(for BLOCK in (STYLE.PROP STYLESHEET '\STYLE.BLOCKS)
collect (LET ((SEL (fetch (STYLEBLOCK SELECTIONS) of BLOCK)))
(SELECTQ (fetch (STYLEBLOCK FILL) of BLOCK)
(MULTI (for SUBSEL in SEL
collect (if (AND (LISTP SUBSEL)
(LISTP (CDR SUBSEL)))
then (CADR SUBSEL)
else SUBSEL)))
((T NIL)
(if (AND (LISTP SEL)
(LISTP (CDR SEL)))
then (CADR SEL)
else SEL))
(SHOULDNT]
(STYLE.PROP STYLESHEET 'SELECTIONS SELECTIONS)
SELECTIONS])
(STYLESHEET.CLEANUP
[LAMBDA (W STYLESHEET OLD.WHENSELECTEDFNS) (* hts%: "22-Mar-85 14:10")
(* * cleans up the WHENSELECTEDFNs in a stylesheet.
And closes its window.)
(for I in (STYLE.PROP STYLESHEET 'ITEMS) as W in OLD.WHENSELECTEDFNS
do (* * Restore the old WHENSELECTEDFNs and MENUUSERDATAs.)
(replace WHENSELECTEDFN of I with W))
(* * Get rid of the stylesheet window)
(CLOSEW W])
)
(DEFINEQ
(STYLESHEET.WHENSELECTEDFN
[LAMBDA (ELEMENT MENU BUTTON) (* hts%: "22-Mar-85 14:11")
(* * Special whenselectedfn for menus inside stylesheets.
Permanently shades the selected item and records the new selection.)
(LET* ([BLOCK (CDR (FASSOC MENU (STYLE.PROP (WINDOWPROP (WFROMMENU MENU)
'STYLESHEET)
'\MENU.TO.BLOCK]
(SELECTIONS (fetch (STYLEBLOCK SELECTIONS) of BLOCK)))
(* * Modify recorded selections.)
(replace (STYLEBLOCK SELECTIONS) of BLOCK
with (SELECTQ (fetch (STYLEBLOCK FILL) of BLOCK)
(T
(* * Can have 0 or 1 selection. If selected same one twice, undo the selection,
else change selection.)
(if (EQ ELEMENT SELECTIONS)
then NIL
else ELEMENT))
(MULTI
(* * Can have any number of selection. If made same selection twice, remove it;
else add it to the list of selections so far.)
(if (FMEMB ELEMENT SELECTIONS)
then (REMOVE ELEMENT SELECTIONS)
else (CONS ELEMENT SELECTIONS)))
(NIL
(* * Must have exactly one selection. Change the current selection.)
ELEMENT)
(SHOULDNT)))
(* * Display new selections.)
(STYLESHEET.SHADE.SELECTIONS BLOCK])
(STYLESHEET.CLEAR.WHENSELECTEDFN
[LAMBDA (ELEMENT CLEAR.MENU BUTTON) (* hts%: "22-Mar-85 14:14")
(* * WHENSELECTEDFN for the ALL-CLEAR submenus.
Finds the styleblock corresponding to this submenu.
If the user punched CLEAR, deselects all items in that styleblock's menu;
if the user punched ALL, selects all the items in the menu.
Changes shading to reflect new selections.)
(LET [(BLOCK (CDR (FASSOC CLEAR.MENU (STYLE.PROP (WINDOWPROP (WFROMMENU CLEAR.MENU)
'STYLESHEET)
'\SUBMENU.TO.BLOCK]
(replace (STYLEBLOCK SELECTIONS) of BLOCK
with (SELECTQ ELEMENT
(CLEAR NIL)
(ALL (for MENUITEM in (fetch (MENU ITEMS) of (fetch (STYLEBLOCK MENU)
of BLOCK)) collect MENUITEM))
NIL))
(STYLESHEET.SHADE.SELECTIONS BLOCK])
(STYLESHEET.DONE.FN
[LAMBDA (ITEM M BUTTON) (* hts%: "21-Mar-85 16:39")
(* * WHENSELECTEDFN for the DONE-ABORT-RESET menu.)
(LET ((W (WFROMMENU M)))
(SELECTQ ITEM
((DONE ABORT)
(* * Done selecting from this stylesheet.
Notify calling process.)
(WINDOWPROP W 'HOW ITEM)
(NOTIFY.EVENT (WINDOWPROP W 'DONE)))
(RESET (LET [(STYLESHEET (WINDOWPROP W 'STYLESHEET]
(* * Restore the original selections.)
(STYLE.PROP STYLESHEET 'SELECTIONS (STYLE.PROP STYLESHEET 'SELECTIONS))
(* * Shade the original selections.)
(for BLOCK in (STYLE.PROP STYLESHEET '\STYLE.BLOCKS)
do (STYLESHEET.SHADE.SELECTIONS BLOCK))))
NIL])
)
(DEFINEQ
(STYLESHEET.ITEM.HEIGHT
[LAMBDA (BLOCK TITLEFONT) (* hts%: "20-Mar-85 19:50")
(* * Returns the height in pixels the given block would occupy in a stylesheet.)
(PLUS (if (fetch (STYLEBLOCK TITLE) of BLOCK)
then (PLUS 2 (FONTHEIGHT TITLEFONT))
else 0)
(fetch (MENU IMAGEHEIGHT) of (fetch (STYLEBLOCK MENU) of BLOCK))
(LET ((SUBMENU (fetch (STYLEBLOCK SUBMENU) of BLOCK)))
(if SUBMENU
then (PLUS 2 (fetch (MENU IMAGEHEIGHT) of SUBMENU))
else 0])
(STYLESHEET.ITEM.WIDTH
[LAMBDA (BLOCK TITLEFONT) (* hts%: "20-Mar-85 19:59")
(* * returns the width in piexels that the given block would occupy were it
printed in a stylesheet.)
(MAX (LET ((TITLE (fetch (STYLEBLOCK TITLE) of BLOCK)))
(if TITLE
then (STRINGWIDTH TITLE TITLEFONT)
else 0))
(fetch (MENU IMAGEWIDTH) of (fetch (STYLEBLOCK MENU) of BLOCK))
(LET ((SUBMENU (fetch (STYLEBLOCK SUBMENU) of BLOCK)))
(if SUBMENU
then (fetch (MENU IMAGEWIDTH) of SUBMENU)
else 0])
)
(DEFINEQ
(STYLESHEET.CREATE.WINDOW
[LAMBDA (STYLESHEET) (* hts%: "22-Mar-85 14:18")
(* * Lay out stylesheet window of appropriate size and fill it in.)
(LET ((POS (STYLE.PROP STYLESHEET 'POSITION))
(TITLE (STYLE.PROP STYLESHEET 'TITLE))
(HEIGHT (STYLESHEET.IMAGEHEIGHT STYLESHEET))
(WIDTH (STYLESHEET.IMAGEWIDTH STYLESHEET)))
(* * If position for stylesheet is not provided, prompt for it.)
(if (NULL POS)
then (SETQ POS (GETBOXPOSITION WIDTH HEIGHT)))
(* * Ensure that stylesheet is on the screen.)
[replace XCOORD of POS with (MAX 1 (MIN (fetch XCOORD of POS)
(IDIFFERENCE SCREENWIDTH WIDTH]
[replace YCOORD of POS with (MAX 1 (MIN (fetch YCOORD of POS)
(IDIFFERENCE SCREENHEIGHT HEIGHT]
(* * Lay out a window big enough to fit all the items.)
(LET ((W (CREATEW (CREATEREGION (fetch XCOORD of POS)
(fetch YCOORD of POS)
WIDTH HEIGHT)
TITLE)))
(* * Save the stylesheet on its window, where it can be accessed by the
WHENSELECTEDFNS etc. running in a different process.)
(WINDOWPROP W 'STYLESHEET STYLESHEET)
(* * Give the window a REPAINTFN so it can be redisplayed properly.)
(WINDOWPROP W 'REPAINTFN (FUNCTION STYLESHEET.FILL.IN.WINDOW))
(* * Fill in the window.)
(REDISPLAYW W)
W])
(STYLESHEET.FILL.IN.WINDOW
[LAMBDA (W) (* ; "Edited 26-Jan-88 17:56 by Trigg")
(* ;;; "Put items into stylesheet and shade default menu selections.")
(* ;;
"rht 1/26/88: Now gets Done/Reset/Abort styleblock off of STYLEPROP rather than using globalvar.")
(for M in (WINDOWPROP W 'MENU) do (DELETEMENU M NIL W))
(LET [(STYLESHEET (WINDOWPROP W 'STYLESHEET]
(bind (TITLEFONT _ (STYLE.PROP STYLESHEET 'ITEM.TITLE.FONT))
(HEIGHT _ (WINDOWPROP W 'HEIGHT))
(XOFFSET _ 0)
WIDTH for BLOCK in [APPEND (STYLE.PROP STYLESHEET '\STYLE.BLOCKS)
(LIST (STYLE.PROP STYLESHEET '\DONE.STYLEBLOCK]
do (SETQ WIDTH (STYLESHEET.ITEM.WIDTH BLOCK TITLEFONT))
(STYLESHEET.ADD.MENU BLOCK W XOFFSET HEIGHT WIDTH TITLEFONT)
(SETQ XOFFSET (PLUS XOFFSET WIDTH 2])
(STYLESHEET.ADD.MENU
[LAMBDA (BLOCK W XOFFSET HEIGHT WIDTH TITLEFONT) (* hts%: "22-Mar-85 14:24")
(* * Adds the current styleblock (title, menu, and submenu) to the stylesheet.
XOFFSET determines the placement of left boundary of the styleblock.
HEIGHT and WIDTH bound the styleblock above and to the right.
Centers the pieces of the styleblock within this box.)
(LET ((TOP HEIGHT))
(* * Title stuff)
[LET ((TITLE (fetch (STYLEBLOCK TITLE) of BLOCK)))
(if TITLE
then (MOVETO (IPLUS XOFFSET (IQUOTIENT (DIFFERENCE WIDTH (STRINGWIDTH TITLE
TITLEFONT))
2))
[DIFFERENCE TOP (DIFFERENCE (FONTPROP TITLEFONT 'HEIGHT)
(FONTPROP TITLEFONT 'DESCENT]
W)
(printout W .FONT TITLEFONT TITLE)
(SETQ TOP (DIFFERENCE TOP (PLUS (FONTHEIGHT TITLEFONT)
2]
(* * Stick the menu on the stylesheet window.)
[LET ((MENU (fetch (STYLEBLOCK MENU) of BLOCK)))
[ADDMENU MENU W (create POSITION
XCOORD _ (IPLUS XOFFSET (IQUOTIENT (DIFFERENCE
WIDTH
(fetch (MENU IMAGEWIDTH)
of MENU))
2))
YCOORD _ (IDIFFERENCE TOP (fetch IMAGEHEIGHT of MENU]
(SETQ TOP (DIFFERENCE TOP (PLUS (fetch IMAGEHEIGHT of MENU)
2]
(* * Shade in selections.)
(STYLESHEET.SHADE.SELECTIONS BLOCK)
(* * Add clear/all menu at bottom of this item.)
[LET ((SUBMENU (fetch (STYLEBLOCK SUBMENU) of BLOCK)))
(if SUBMENU
then (ADDMENU SUBMENU W (create POSITION
XCOORD _ (IPLUS XOFFSET
(IQUOTIENT
(DIFFERENCE WIDTH
(fetch (MENU IMAGEWIDTH)
of SUBMENU))
2))
YCOORD _ (IDIFFERENCE TOP (fetch IMAGEHEIGHT
of SUBMENU]
NIL])
(STYLESHEET.SHADE.SELECTIONS
[LAMBDA (BLOCK) (* hts%: "22-Mar-85 14:26")
(* * Updates the selections shaded on the screen to reflect those recorded
internally for the specified Makes use of the SHADEDITEMS field of the menu to
tell what has already been shaded. Format of SHADEDITEMS is an alist mapping
the number of the menu item onto its shade.)
(LET* ((MENU (fetch (STYLEBLOCK MENU) of BLOCK))
(SHADEDITEMS (fetch (MENU SHADEDITEMS) of MENU))
(SELECTIONS (fetch (STYLEBLOCK SELECTIONS) of BLOCK)))
(if (NEQ (fetch (STYLEBLOCK FILL) of BLOCK)
'MULTI)
then (SETQ SELECTIONS (LIST SELECTIONS)))
(for MENUITEM in (fetch (MENU ITEMS) of MENU) as ITEMNUMBER from 1
do (LET* [(SELECTED (FMEMB MENUITEM SELECTIONS))
(SHADENTRY (FASSOC ITEMNUMBER SHADEDITEMS))
(SHADED (AND (LISTP SHADENTRY)
(NEQ (CDR SHADENTRY)
0]
(if (AND SHADED (NOT SELECTED))
then (SHADEITEM MENUITEM MENU WHITESHADE)
elseif (AND SELECTED (NOT SHADED))
then (SHADEITEM MENUITEM MENU STYLESHEET.SELECTED.SHADE])
)
(DEFINEQ
(STYLESHEET.AT.LOAD
[LAMBDA NIL (* ; "Edited 26-Jan-88 11:51 by Trigg")
(* ;;; "Sets up global variables for the stylesheet package.")
(* ;; "rht 1/26/88: No longer computes STYLESHEET.DONE.MENU globalvar here. It gets computed each time STYLESHEET is called. ")
(SETQ STYLESHEET.SELECTED.SHADE BLACKSHADE])
)
(STYLESHEET.AT.LOAD)
(DECLARE%: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS STYLESHEET.SELECTED.SHADE)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA STYLE.PROP CREATE.STYLE)
)
(PUTPROPS STYLESHEET COPYRIGHT ("Xerox Corporation" 1983 1985 1987 1988))
(DECLARE%: DONTCOPY
(FILEMAP (NIL (2524 9062 (CREATE.STYLE 2534 . 3185) (STYLESHEETP 3187 . 3521) (STYLE.PROP 3523 . 5467)
(STYLESHEET 5469 . 7168) (STYLESHEET.IMAGEHEIGHT 7170 . 8133) (STYLESHEET.IMAGEWIDTH 8135 . 9060)) (
10225 19271 (STYLESHEET.CHANGE.FILL 10235 . 13800) (STYLESHEET.CHANGE.ITEMS 13802 . 15786) (
STYLESHEET.CHANGE.SELECTIONS 15788 . 17876) (STYLESHEET.CHANGE.TITLES 17878 . 18681) (
STYLESHEET.MENUITEM 18683 . 19269)) (19272 23908 (STYLESHEET.SETUP 19282 . 20280) (
STYLESHEET.WAIT.TILL.DONE 20282 . 21940) (STYLESHEET.GET.SELECTIONS 21942 . 23359) (STYLESHEET.CLEANUP
23361 . 23906)) (23909 27835 (STYLESHEET.WHENSELECTEDFN 23919 . 25706) (
STYLESHEET.CLEAR.WHENSELECTEDFN 25708 . 26859) (STYLESHEET.DONE.FN 26861 . 27833)) (27836 29270 (
STYLESHEET.ITEM.HEIGHT 27846 . 28526) (STYLESHEET.ITEM.WIDTH 28528 . 29268)) (29271 36824 (
STYLESHEET.CREATE.WINDOW 29281 . 31120) (STYLESHEET.FILL.IN.WINDOW 31122 . 32153) (STYLESHEET.ADD.MENU
32155 . 35318) (STYLESHEET.SHADE.SELECTIONS 35320 . 36822)) (36825 37242 (STYLESHEET.AT.LOAD 36835 .
37240)))))
STOP