-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathATTACHEDWINDOW
2055 lines (1765 loc) · 124 KB
/
ATTACHEDWINDOW
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
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "28-Jun-99 17:18:50" {DSK}<project>medley3.5>sources>ATTACHEDWINDOW.;3 124287
changes to%: (FNS RESHAPEALLWINDOWS)
previous date%: "28-Jun-99 15:59:05" {DSK}<project>medley3.5>sources>ATTACHEDWINDOW.;2)
(* ; "
Copyright (c) 1983, 1984, 1985, 1986, 1987, 1988, 1990, 1991, 1992, 1995, 1999 by Venue & Xerox Corporation. All rights reserved.
")
(PRETTYCOMPRINT ATTACHEDWINDOWCOMS)
(RPAQQ ATTACHEDWINDOWCOMS
((COMS (* User entries)
(FNS ATTACHWINDOW ATTACHEDWINDOWS ALLATTACHEDWINDOWS DETACHWINDOW DETACHALLWINDOWS
FREEATTACHEDWINDOW MAINWINDOW REMOVEWINDOW REPOSITIONATTACHEDWINDOWS))
(FNS ATTACHEDWINDOWREGION ATTACHEDWINDOWTOTOPFN CENTERINHEIGHT CENTERINWIDTH CENTRALWINDOW
CLOSEATTACHEDWINDOWS DOATTACHEDWINDOWCOM DOATTACHEDWINDOWCOM2 DOMAINWINDOWCOMFN
EXPANDATTACHEDWINDOWS MAKEMAINWINDOW MAXATTACHEDWINDOWEXTENT MAXIMUMMAINWINDOWSIZE
MAXIMUMWINDOWSIZE MINATTACHEDWINDOWEXTENT MINIMUMMAINWINDOWSIZE MOVEATTACHEDWINDOWS
MOVEATTACHEDWINDOWTOPLACE OPENATTACHEDWINDOWS RESHAPEALLWINDOWS \TOTALPROPOSEDSIZE
SHRINKATTACHEDWINDOWS TOPATTACHEDWINDOWS UNMAKEMAINWINDOW UPIQUOTIENT WINDOWPOSITION
WINDOWSIZE \ALLOCMINIMUMSIZES \ALLOCSPACETOGROUPEDWINDOWS \TOTALFIXEDHEIGHT
\TOTALFIXEDWIDTH \ALLOCHEIGHTTOGROUPEDWINDOW \ALLOCWIDTHTOGROUPEDWINDOW \ATWGROUPSIZE
\BREAKAPARTATWSTRUCTURE \BUILDATWSTRUCTURE \LIMITBYMAX \LIMITBYMIN \MAXHEIGHTOFGROUP
\MAXWIDTHOFGROUP \RESHAPEATTACHEDWINDOWSAROUNDMAINW \SETGROUPMIN \SETWINFOXSIZE
\SETWINFOYSIZE \SHAREOFXTRAX \SHAREOFXTRAY)
(FNS ATTACHMENU CREATEMENUEDWINDOW MENUWINDOW MENUWMINSIZEFN MENUWRESHAPEFN)
(FNS GETPROMPTWINDOW \PROMPTWINDOW.EXPAND \PROMPTWINDOW.SET.HEIGHT \PROMPTWINDOW.OPENFN
\PROMPTWINDOW.PAGEFULLFN REATTACHPROMPTWINDOW REMOVEPROMPTWINDOW)
(DECLARE%: DONTCOPY DOEVAL@COMPILE (RECORDS RESHAPINGWINDOWDATA)
(GLOBALVARS WindowMenu WindowTitleDisplayStream WBorder WindowMenuCommands))
(VARIABLES *ATTACHED-WINDOW-COMMAND-SYNONYMS*)))
(* User entries)
(DEFINEQ
(ATTACHWINDOW
[LAMBDA (WINDOWTOATTACH MAINWINDOW EDGE POSITIONONEDGE WINDOWCOMACTION)
(* ; "Edited 12-Jan-87 18:12 by woz")
(* ;; "attaches a window to another window. EDGE is one of LEFT, RIGHT, TOP or BOTTOM. POSITIONONEDGE is one of NIL {means reshape window to fit new main window size}, {left or bottom}, {center} or {right or top}. The attached window is opened if the main window is open, and not if not.")
(PROG (MAINW ATTACHW)
(SETQ MAINW (INSURE.WINDOW MAINWINDOW))
(SETQ ATTACHW (INSURE.WINDOW WINDOWTOATTACH))
(COND
((OR (EQ WINDOWTOATTACH MAINWINDOW)
(MEMB MAINW (ALLATTACHEDWINDOWS ATTACHW)))
(ERROR "Attempt to create a loop in window attachment" ATTACHW)
(RETURN)))
(SELECTQ EDGE
((LEFT RIGHT TOP BOTTOM))
(NIL (SETQ EDGE 'TOP))
(\ILLEGAL.ARG EDGE))
(SELECTQ POSITIONONEDGE
((JUSTIFY CENTER LEFT RIGHT TOP BOTTOM))
(NIL (SETQ POSITIONONEDGE 'JUSTIFY))
(\ILLEGAL.ARG POSITIONONEDGE))
(MAKEMAINWINDOW MAINW)
(WINDOWADDPROP MAINW 'ATTACHEDWINDOWS ATTACHW)
(WINDOWPROP ATTACHW 'WHEREATTACHED (CONS EDGE POSITIONONEDGE))
(WINDOWPROP ATTACHW 'MAINWINDOW MAINW)
(WINDOWPROP ATTACHW 'TOTOPFN (FUNCTION ATTACHEDWINDOWTOTOPFN))
(* ;; "put a property on the window that will be noticed by DOWINDOWCOM to decide what to do with window command requests.")
(WINDOWPROP ATTACHW 'DOWINDOWCOMFN (FUNCTION DOATTACHEDWINDOWCOM))
[SELECTQ WINDOWCOMACTION
(MAIN (WINDOWPROP ATTACHW 'PASSTOMAINCOMS T))
(HERE (* ; "leave it alone")
(WINDOWPROP ATTACHW 'PASSTOMAINCOMS NIL))
(LOCALCLOSE (* ;
"set up so that closing is handled locally and detaches the window.")
(WINDOWADDPROP ATTACHW 'CLOSEFN (FUNCTION DETACHWINDOW))
(WINDOWPROP ATTACHW 'PASSTOMAINCOMS '(MOVEW SHAPEW SHRINKW BURYW)))
(WINDOWPROP ATTACHW 'PASSTOMAINCOMS '(CLOSEW MOVEW SHAPEW SHRINKW BURYW]
(MOVEATTACHEDWINDOWTOPLACE ATTACHW MAINW EDGE POSITIONONEDGE)
(AND (OPENWP MAINW)
(OPENW ATTACHW))
(RETURN MAINW])
(ATTACHEDWINDOWS
(LAMBDA (WINDOW COM) (* ; "Edited 5-Jul-88 19:01 by drc:") (* ;; "Returns the list of windows attached to this window. COM can be a window command, only the attached windows who allow this COM to be applied to them from above will be returned. An attached window can have a ALLOWMAINCOMS prop, which is a list of allowable commands. If ALLOWMAINCOMS is NIL, all commands are allowed. If COM is not given, all attached windows are returned.") (DECLARE (GLOBALVARS *ATTACHED-WINDOW-COMMAND-SYNONYMS*)) (LET ((AWS (WINDOWPROP WINDOW (QUOTE ATTACHEDWINDOWS)))) (COND ((NULL COM) AWS) (T (LET ((REALCOM (OR (CDR (ASSOC COM *ATTACHED-WINDOW-COMMAND-SYNONYMS*)) COM))) (COND ((for ATTW in AWS thereis (FMEMB COM (WINDOWPROP ATTW (QUOTE REJECTMAINCOMS)))) (* ;; "don't cons new list of windows unless we must") (for ATTW in AWS unless (FMEMB COM (WINDOWPROP ATTW (QUOTE REJECTMAINCOMS))) collect ATTW)) (T AWS)))))))
)
(ALLATTACHEDWINDOWS
[LAMBDA (MAINW) (* rrb "30-NOV-83 16:29")
(* returns a list of all of the windows attached to MAINW or any of its
attached windows.)
(PROG ((ATWS (ATTACHEDWINDOWS MAINW)))
(RETURN (COND
(ATWS (APPEND ATWS (for ATW in ATWS join (ALLATTACHEDWINDOWS ATW])
(DETACHWINDOW
(LAMBDA (WINDOWTODETACH MAINWINDOW) (* ; "Edited 5-Jul-88 19:43 by drc:") (* ;;; "detaches a window from its main window.") (PROG ((WHEREAT (WINDOWPROP WINDOWTODETACH (QUOTE WHEREATTACHED) NIL)) (MAINW (OR MAINWINDOW (WINDOWPROP WINDOWTODETACH (QUOTE MAINWINDOW) NIL))) ATWINS PWINDOW OLDFN) (OR MAINW (RETURN NIL)) (WINDOWDELPROP MAINW (QUOTE ATTACHEDWINDOWS) WINDOWTODETACH) (COND ((NOT (ATTACHEDWINDOWS MAINW)) (UNMAKEMAINWINDOW MAINW))) (SELECTQ (SETQ OLDFN (WINDOWPROP WINDOWTODETACH (QUOTE DOWINDOWCOMFN) NIL)) ((DOMAINWINDOWCOMFN DOATTACHEDWINDOWCOM)) (WINDOWPROP WINDOWTODETACH (QUOTE DOWINDOWCOMFN) OLDFN)) (* ; "Remove window's TOTOPFN and DOWINDOWCOMFN if they were the ones that ATTACHWINDOW put there") (SELECTQ (SETQ OLDFN (WINDOWPROP WINDOWTODETACH (QUOTE TOTOPFN) NIL)) (ATTACHEDWINDOWTOTOPFN) (WINDOWPROP WINDOWTODETACH (QUOTE TOTOPFN) OLDFN)) (RETURN WHEREAT)))
)
(DETACHALLWINDOWS
(LAMBDA (MAINWINDOW) (* ; "Edited 5-Jul-88 19:45 by drc:") (REMOVEPROMPTWINDOW MAINWINDOW) (* ;; "Do this separately so that prompt window is 'permanently' removed, not just locally closed") (for W in (WINDOWPROP MAINWINDOW (QUOTE ATTACHEDWINDOWS)) do (DETACHWINDOW W MAINWINDOW) (CLOSEW W)))
)
(FREEATTACHEDWINDOW
[LAMBDA (WINDOW) (* jow "16-Aug-85 14:35")
(* frees an attached window and snuggles any other attached windows closer to
the main window. Only the windows that allowed MOVEW will be snuggled.)
(LET* [(MAINWINDOW (MAINWINDOW WINDOW))
[ATWINS (COPY (ATTACHEDWINDOWS MAINWINDOW 'MOVEW]
(REGION (WINDOWPROP WINDOW 'REGION))
(BOTTOM (fetch (REGION BOTTOM) of REGION))
(HEIGHT (fetch (REGION HEIGHT) of REGION))
(EDGE (CAR (WINDOWPROP WINDOW 'WHEREATTACHED]
(DETACHWINDOW WINDOW)
(SELECTQ EDGE
(TOP [for ATWIN in ATWINS when (IGREATERP (fetch (REGION BOTTOM)
of (WINDOWPROP ATWIN 'REGION))
BOTTOM)
do (RELMOVEW ATWIN (create POSITION
XCOORD _ 0
YCOORD _ (IMINUS HEIGHT])
(BOTTOM (for ATWIN in ATWINS when (ILESSP (fetch (REGION BOTTOM)
of (WINDOWPROP ATWIN 'REGION))
BOTTOM)
do (RELMOVEW ATWIN (create POSITION
XCOORD _ 0
YCOORD _ HEIGHT))))
NIL])
(MAINWINDOW
[LAMBDA (WINDOW RECURSEFLG) (* rrb "20-Aug-84 09:45")
(* * returns the main window of a window.
If recurseflg is T, continues until it finds a window not attached to any
other.)
(PROG ((WIN (\INSUREWINDOW WINDOW))
MAINW)
(COND
([NULL (SETQ MAINW (WINDOWPROP WIN 'MAINWINDOW]
(RETURN WIN))
((NULL RECURSEFLG)
(RETURN MAINW)))
LP (COND
([NULL (SETQ WIN (WINDOWPROP MAINW 'MAINWINDOW]
(RETURN MAINW))
(T (SETQ MAINW WIN)
(GO LP])
(REMOVEWINDOW
[LAMBDA (WINDOW) (* jow "16-Aug-85 14:37")
(* Closes an attached window and then calls FREEATTACHEDWINDOW to snuggle up
other windows)
(CLOSEW WINDOW)
(FREEATTACHEDWINDOW WINDOW])
(REPOSITIONATTACHEDWINDOWS
[LAMBDA (WINDOW) (* ; "Edited 6-Jan-87 14:38 by woz")
(* can be a main window's RESHAPEFN. used when some attached windows don't want
to be reshaped, but do want to be repositioned after a reshape.)
(for ATTW in (ATTACHEDWINDOWS WINDOW 'MOVEW) do (MOVEATTACHEDWINDOWTOPLACE ATTW WINDOW)
(OR (OPENWP ATTW)
(\OPENW1 ATTW])
)
(DEFINEQ
(ATTACHEDWINDOWREGION
[LAMBDA (MAINW COM) (* jow "15-Aug-85 13:08")
(* returns the region of the area taken up by a window and all of its attached
windows. COM can be the command that this region is being calculated for, and
is passed to ATTACHEDWINDOWS so windows can except themselves.)
(PROG [(REG (WINDOWPROP MAINW 'REGION]
[for ATWIN in (ATTACHEDWINDOWS MAINW COM) do (SETQ REG (UNIONREGIONS REG (WINDOWREGION
ATWIN]
(RETURN REG])
(ATTACHEDWINDOWTOTOPFN
[LAMBDA (WINDOW) (* ; "Edited 17-Aug-88 19:46 by jds")
(* ;; "This function causes both the main window and its attached windows to be visible when either is selected")
(LET ((ROOT (MAINWINDOW WINDOW T)))
(* ;; "start at the root & let it propagate down ")
(COND
((AND (WINDOWP ROOT)
(NEQ ROOT WINDOW))
(TOTOPW ROOT])
(CENTERINHEIGHT
[LAMBDA (HEIGHTTOCENTER RELATIVETOREGION) (* ; "Edited 13-Jan-87 13:52 by woz")
(* returns the bottom coordinate that a height needs to be centered relative to
a region.)
(PLUS (fetch (REGION BOTTOM) of RELATIVETOREGION)
(IQUOTIENT (DIFFERENCE (fetch (REGION HEIGHT) of RELATIVETOREGION)
HEIGHTTOCENTER)
2])
(CENTERINWIDTH
[LAMBDA (WIDTHTOCENTER RELATIVETOREGION) (* rrb "15-NOV-83 13:21")
(* returns the left coordinate that a width needs to be centered relative to a
region.)
(PLUS (fetch (REGION LEFT) of RELATIVETOREGION)
(IQUOTIENT (DIFFERENCE (fetch (REGION WIDTH) of RELATIVETOREGION)
WIDTHTOCENTER)
2])
(CENTRALWINDOW
[LAMBDA (WINDOW) (* rrb "30-Dec-83 13:59")
(* returns the window that is a main window to this one and is not itself
attached to any other.)
(PROG (MAINW)
LP (COND
((SETQ MAINW (WINDOWPROP WINDOW 'MAINWINDOW))
(SETQ WINDOW MAINW)
(GO LP)))
(RETURN WINDOW])
(CLOSEATTACHEDWINDOWS
[LAMBDA (WINDOW) (* jow "15-Aug-85 13:02")
(* propagates closing to attached
windows.)
(for ATTACHEDWINDOW in (ATTACHEDWINDOWS WINDOW 'CLOSEW) do (CLOSEW ATTACHEDWINDOW)
(WINDOWPROP ATTACHEDWINDOW
'MAINWINDOW NIL])
(DOATTACHEDWINDOWCOM
[LAMBDA (ATTACHEDW) (* ; "Edited 16-Jul-92 11:22 by cat")
(* ; "Edited 22-Jan-88 13:35 by woz")
(* ;; "a right button function for attached windows that brings up the window command menu and then, depending upon the command selected, either passes the command to the main window or performs it on the attached window. The commands in the windowprop PASSTOMAINCOMS are passed to the central window. Others are applied to ATTACHEDW.")
(COND
((WINDOWP ATTACHEDW)
(TOTOPW ATTACHEDW)
(LET [(COM (MENU (COND
((type? MENU WindowMenu)
WindowMenu)
(T (SETQ WindowMenu (create MENU
ITEMS _ WindowMenuCommands
CHANGEOFFSETFLG _ 'Y
MENUOFFSET _
(create POSITION
XCOORD _ -1
YCOORD _ 0)
WHENHELDFN _ (FUNCTION PPROMPT3)
WHENUNHELDFN _ (FUNCTION CLRPROMPT)
CENTERFLG _ T]
(CL:WHEN COM
(COND
([OR (EQ (WINDOWPROP ATTACHEDW 'PASSTOMAINCOMS)
T)
(MEMB (OR (CDR (ASSOC COM *ATTACHED-WINDOW-COMMAND-SYNONYMS*))
COM)
(WINDOWPROP ATTACHEDW 'PASSTOMAINCOMS]
(APPLY* COM (CENTRALWINDOW ATTACHEDW)))
(T (APPLY* COM ATTACHEDW)))
T)))
((NULL ATTACHEDW)
(DOBACKGROUNDCOM])
(DOATTACHEDWINDOWCOM2
[LAMBDA (ATTACHEDW) (* rrb "28-Mar-84 11:25")
(* a right button function for attached windows that want to handle CLOSE
locally.)
(DOATTACHEDWINDOWCOM ATTACHEDW T])
(DOMAINWINDOWCOMFN
[LAMBDA (ATTACHEDW) (* rrb "10-Dec-83 14:57")
(* applies the right button function
of the main window.)
(PROG (MAINW)
(RETURN (APPLY* (OR (WINDOWPROP (SETQ MAINW (WINDOWPROP ATTACHEDW 'MAINWINDOW))
'RIGHTBUTTONFN)
(FUNCTION DOWINDOWCOM))
MAINW])
(EXPANDATTACHEDWINDOWS
[LAMBDA (WINDOW) (* ; "Edited 5-Mar-87 11:03 by lal")
(* ;
"propagates expanding to attached windows.")
(* ;
"doesn't allow the attached window functions to stop the expanding.")
(if (WINDOWPROP WINDOW 'EXPANDREGIONFN)
then (REPOSITIONATTACHEDWINDOWS WINDOW)
else (for ATTACHEDWINDOW in (ATTACHEDWINDOWS WINDOW 'EXPANDW)
do (OR (OPENWP ATTACHEDWINDOW)
(DOUSERFNS (WINDOWPROP ATTACHEDWINDOW 'EXPANDFN)
ATTACHEDWINDOW)) (* ;
"the expandfn may have opened the window.")
(OR (OPENWP ATTACHEDWINDOW)
(\OPENW1 ATTACHEDWINDOW])
(MAKEMAINWINDOW
[LAMBDA (MAINWINDOW) (* jow "15-Aug-85 13:23")
(* puts the necessary functions on a window to propagate its activities to all
of its attached windows.)
(* has functions for moving,
reshaping, totoping)
(WINDOWADDPROP MAINWINDOW 'TOTOPFN (FUNCTION TOPATTACHEDWINDOWS))
(WINDOWADDPROP MAINWINDOW 'CLOSEFN (FUNCTION CLOSEATTACHEDWINDOWS))
(WINDOWADDPROP MAINWINDOW 'OPENFN (FUNCTION OPENATTACHEDWINDOWS))
(WINDOWADDPROP MAINWINDOW 'SHRINKFN (FUNCTION SHRINKATTACHEDWINDOWS))
(WINDOWADDPROP MAINWINDOW 'EXPANDFN (FUNCTION EXPANDATTACHEDWINDOWS))
(WINDOWPROP MAINWINDOW 'CALCULATEREGIONFN (FUNCTION ATTACHEDWINDOWREGION))
[PROG [(OLDMINSIZE (WINDOWPROP MAINWINDOW 'MINSIZE))
(OLDMAXSIZE (WINDOWPROP MAINWINDOW 'MAXSIZE]
(* move this windows minsize function and maxsize onto a different place.)
(COND
((AND OLDMINSIZE (NEQ OLDMINSIZE (FUNCTION MINATTACHEDWINDOWEXTENT)))
(WINDOWPROP MAINWINDOW 'MAINWINDOWMINSIZE OLDMINSIZE)))
(COND
((AND OLDMAXSIZE (NEQ OLDMAXSIZE (FUNCTION MAXATTACHEDWINDOWEXTENT)))
(WINDOWPROP MAINWINDOW 'MAINWINDOWMAXSIZE OLDMAXSIZE]
(WINDOWPROP MAINWINDOW 'MINSIZE (FUNCTION MINATTACHEDWINDOWEXTENT))
(WINDOWPROP MAINWINDOW 'MAXSIZE (FUNCTION MAXATTACHEDWINDOWEXTENT))
(WINDOWADDPROP MAINWINDOW 'MOVEFN (FUNCTION MOVEATTACHEDWINDOWS))
(WINDOWPROP MAINWINDOW 'DOSHAPEFN (FUNCTION RESHAPEALLWINDOWS])
(MAXATTACHEDWINDOWEXTENT
[LAMBDA (MAINW) (* bvm%: "29-Dec-83 15:57")
(* returns the maximum extent of a window computing it from the attached
windows if necessary.)
(PROG ((ATWS (ATTACHEDWINDOWS MAINW))
(EXTENT (MAXIMUMMAINWINDOWSIZE MAINW))
TL TC TR RT RC RB BR BC BL LB LC LT)
[COND
((NULL ATWS)
(RETURN EXTENT))
((NULL EXTENT)
(* if the main window is willing to expand, start with a large maximum)
(RETURN (SETQ EXTENT (CONS 64000 64000]
[SETQ TL (SETQ TC (SETQ TR (CDR EXTENT]
[SETQ RT (SETQ RC (SETQ RB (CAR EXTENT]
(SETQ BR (SETQ BC (SETQ BL 0)))
(SETQ LB (SETQ LC (SETQ LT 0)))
(bind ATWHERE WHERECODE ATWDTH ATWHGHT for ATW in ATWS
do
(* go through the attached windows keeping track of their effect on the extent.)
(SETQ EXTENT (MAXIMUMWINDOWSIZE ATW))
(SETQ ATWDTH (OR (CAR EXTENT)
64000))
(SETQ ATWHGHT (OR (CDR EXTENT)
64000))
(SETQ WHERECODE (SELECTQ [CDR (SETQ ATWHERE (WINDOWPROP ATW 'WHEREATTACHED]
(JUSTIFY 'JUSTIFY)
(CENTER 0)
((LEFT BOTTOM)
-1)
1))
(SELECTQ (CAR ATWHERE)
(TOP [COND
((GREATERP ATWDTH (DIFFERENCE RT LT))
(* check to see if min width pushes the width.
This could push either way and is actually not right because a later window on
the left or right top could use this extra.)
(SETQ RT (PLUS ATWDTH LT]
(SELECTQ WHERECODE
(JUSTIFY [SETQ TL (SETQ TC (SETQ TR (PLUS (MAX TL TC TR)
ATWHGHT])
(-1 (SETQ TL (PLUS TL ATWHGHT)))
(0 (SETQ TC (PLUS TC ATWHGHT)))
(1 (SETQ TR (PLUS TR ATWHGHT)))
(SHOULDNT)))
(RIGHT [COND
((GREATERP ATWHGHT (DIFFERENCE TR BR))
(SETQ TR (PLUS ATWHGHT BR]
(SELECTQ WHERECODE
(JUSTIFY [SETQ RT (SETQ RC (SETQ RB (PLUS (MAX RT RC RB)
ATWDTH])
(1 (SETQ RT (PLUS RT ATWDTH)))
(0 (SETQ RC (PLUS RC ATWDTH)))
(-1 (SETQ RB (PLUS RB ATWDTH)))
(SHOULDNT)))
(LEFT [COND
((GREATERP ATWHGHT (DIFFERENCE TL BL))
(SETQ TL (PLUS ATWHGHT BL]
(SELECTQ WHERECODE
(JUSTIFY [SETQ LT (SETQ LC (SETQ LB (DIFFERENCE (MIN LT LC LB)
ATWDTH])
(1 (SETQ LT (DIFFERENCE LT ATWDTH)))
(0 (SETQ LC (DIFFERENCE LC ATWDTH)))
(-1 (SETQ LB (DIFFERENCE LB ATWDTH)))
(SHOULDNT)))
(BOTTOM [COND
((GREATERP ATWDTH (DIFFERENCE RB LB))
(SETQ RB (PLUS ATWDTH LB]
(SELECTQ WHERECODE
(JUSTIFY [SETQ BL (SETQ BC (SETQ BR (DIFFERENCE (MIN BL BC BR)
ATWHGHT])
(-1 (SETQ BL (DIFFERENCE BL ATWHGHT)))
(0 (SETQ BC (DIFFERENCE BC ATWHGHT)))
(1 (SETQ BR (DIFFERENCE BR ATWHGHT)))
(SHOULDNT)))
(SHOULDNT)))
(RETURN (CONS (DIFFERENCE (MAX RT RC RB)
(MIN LT LC LB))
(DIFFERENCE (MAX TL TC TR)
(MIN BL BC BR])
(MAXIMUMMAINWINDOWSIZE
[LAMBDA (WINDOW) (* bvm%: "29-Dec-83 15:46")
(* returns the maximum extent of a
main window)
(PROG [(EXT (WINDOWPROP WINDOW 'MAINWINDOWMAXSIZE]
[COND
((NULL EXT)
(RETURN NIL))
((LITATOM EXT)
(SETQ EXT (APPLY* EXT WINDOW]
[COND
[(AND (NUMBERP (CAR EXT))
(NUMBERP (CDR EXT]
(T (SETQ EXT (ERROR "Illegal maximum size property" EXT]
(RETURN EXT])
(MAXIMUMWINDOWSIZE
[LAMBDA (WINDOW) (* rrb "19-Mar-84 14:23")
(* returns the maximum extent of a
window)
(PROG [(EXT (WINDOWPROP WINDOW 'MAXSIZE]
[COND
((NULL EXT)
(RETURN NIL))
((LITATOM EXT)
(SETQ EXT (APPLY* EXT WINDOW]
[COND
[(AND (OR (NULL (CAR EXT))
(NUMBERP (CAR EXT)))
(OR (NULL (CDR EXT))
(NUMBERP (CDR EXT]
(EXT (SETQ EXT (ERROR "Illegal extent property" EXT]
(RETURN EXT])
(MINATTACHEDWINDOWEXTENT
[LAMBDA (MAINW) (* rrb "15-Dec-83 10:16")
(* returns the extent of a window computing it from the attached windows if
necessary.)
(PROG ((ATWS (ATTACHEDWINDOWS MAINW))
(EXTENT (MINIMUMMAINWINDOWSIZE MAINW))
TL TC TR RT RC RB BR BC BL LB LC LT)
(COND
((NULL ATWS)
(RETURN EXTENT)))
[SETQ TL (SETQ TC (SETQ TR (CDR EXTENT]
[SETQ RT (SETQ RC (SETQ RB (CAR EXTENT]
(SETQ BR (SETQ BC (SETQ BL 0)))
(SETQ LB (SETQ LC (SETQ LT 0)))
(bind ATWHERE WHERECODE ATWDTH ATWHGHT for ATW in ATWS
do
(* go through the attached windows keeping track of their effect on the extent.)
(SETQ EXTENT (MINIMUMWINDOWSIZE ATW))
(SETQ ATWDTH (CAR EXTENT))
(SETQ ATWHGHT (CDR EXTENT))
(SETQ WHERECODE (SELECTQ [CDR (SETQ ATWHERE (WINDOWPROP ATW 'WHEREATTACHED]
(JUSTIFY 'JUSTIFY)
(CENTER 0)
((LEFT BOTTOM)
-1)
1))
(SELECTQ (CAR ATWHERE)
(TOP [COND
((GREATERP ATWDTH (DIFFERENCE RT LT))
(* check to see if min width pushes the width.
This could push either way and is actually not right because a later window on
the left or right top could use this extra.)
(SETQ RT (PLUS ATWDTH LT]
(SELECTQ WHERECODE
(JUSTIFY [SETQ TL (SETQ TC (SETQ TR (PLUS (MAX TL TC TR)
ATWHGHT])
(-1 (SETQ TL (PLUS TL ATWHGHT)))
(0 (SETQ TC (PLUS TC ATWHGHT)))
(1 (SETQ TR (PLUS TR ATWHGHT)))
(SHOULDNT)))
(RIGHT [COND
((GREATERP ATWHGHT (DIFFERENCE TR BR))
(SETQ TR (PLUS ATWHGHT BR]
(SELECTQ WHERECODE
(JUSTIFY [SETQ RT (SETQ RC (SETQ RB (PLUS (MAX RT RC RB)
ATWDTH])
(1 (SETQ RT (PLUS RT ATWDTH)))
(0 (SETQ RC (PLUS RC ATWDTH)))
(-1 (SETQ RB (PLUS RB ATWDTH)))
(SHOULDNT)))
(LEFT [COND
((GREATERP ATWHGHT (DIFFERENCE TL BL))
(SETQ TL (PLUS ATWHGHT BL]
(SELECTQ WHERECODE
(JUSTIFY [SETQ LT (SETQ LC (SETQ LB (DIFFERENCE (MIN LT LC LB)
ATWDTH])
(1 (SETQ LT (DIFFERENCE LT ATWDTH)))
(0 (SETQ LC (DIFFERENCE LC ATWDTH)))
(-1 (SETQ LB (DIFFERENCE LB ATWDTH)))
(SHOULDNT)))
(BOTTOM [COND
((GREATERP ATWDTH (DIFFERENCE RB LB))
(SETQ RB (PLUS ATWDTH LB]
(SELECTQ WHERECODE
(JUSTIFY [SETQ BL (SETQ BC (SETQ BR (DIFFERENCE (MIN BL BC BR)
ATWHGHT])
(-1 (SETQ BL (DIFFERENCE BL ATWHGHT)))
(0 (SETQ BC (DIFFERENCE BC ATWHGHT)))
(1 (SETQ BR (DIFFERENCE BR ATWHGHT)))
(SHOULDNT)))
(SHOULDNT)))
(RETURN (CONS (DIFFERENCE (MAX RT RC RB)
(MIN LT LC LB))
(DIFFERENCE (MAX TL TC TR)
(MIN BL BC BR])
(MINIMUMMAINWINDOWSIZE
[LAMBDA (WINDOW) (* rrb "24-Sep-86 14:03")
(* returns the minimum extent of a
window)
(PROG [(EXT (WINDOWPROP WINDOW 'MAINWINDOWMINSIZE]
[COND
[(NULL EXT)
(SETQ EXT (CONS 26 (HEIGHTIFWINDOW (FONTPROP WINDOW 'HEIGHT)
(WINDOWPROP WINDOW 'TITLE]
((LITATOM EXT)
(SETQ EXT (APPLY* EXT WINDOW]
[COND
[(AND (NUMBERP (CAR EXT))
(NUMBERP (CDR EXT]
(T (SETQ EXT (ERROR "Illegal extent property" EXT]
(RETURN EXT])
(MOVEATTACHEDWINDOWS
(LAMBDA (WINDOW NEWPOS) (* ; "Edited 8-Jul-88 11:00 by drc:") (* ; "propagates moving to attached windows.") (PROG ((DELTA (PTDIFFERENCE NEWPOS (WINDOWPOSITION WINDOW)))) (for ATTACHEDWINDOW in (ATTACHEDWINDOWS WINDOW (QUOTE MOVEW)) do (* ;; "bring each to top by hand so we don't bring whole tree to top for each one we move") (AND (OPENWP ATTACHEDWINDOW) (TOTOPW ATTACHEDWINDOW T)) (MOVEW ATTACHEDWINDOW (PTPLUS (WINDOWPOSITION ATTACHEDWINDOW) DELTA)) (* ;; "main window (non-terminal) about to be moved. bring it to top by hand so that whole tree doesn't get brought to top. ") (AND (OPENWP WINDOW) (TOTOPW WINDOW T)))))
)
(MOVEATTACHEDWINDOWTOPLACE
[LAMBDA (ATWIN MAINW EDGE POSONEDGE) (* ; "Edited 12-Jan-87 17:01 by woz")
(* DECLARATIONS%: (RECORD
ATTACHEDWINDATA ((EDGE . WHEREONEDGE)
WID . HGHT)))
(* ;;; "moves a window to the place it should be relative to MAINW and reshapes it if it is JUSTIFY. The window will be opened if it is justified, and otherwise will not. This function should not open the window; it is a nasty side effect of reshaping the window. So if the main window is not open, punt, and let the openfn take care of calling me again, because the attached window shouldn't be opened. If the main window is open, the attached window will be moved into position, and it is the responsibility of the caller to ensure that the window gets opened. ")
(AND (OPENWP MAINW)
(PROG (MAINWEXTENT EXTENT ATMINWIDTH ATMINHEIGHT ATWHGHT ATWDTH TL TC TR RT RC RB BR BC BL
LB LC LT)
[COND
((NULL EDGE)
(SETQ EDGE (WINDOWPROP ATWIN 'WHEREATTACHED))
(SETQ POSONEDGE (CDR EDGE))
(SETQ EDGE (CAR EDGE] (* ;
"calculate the minimum so that this window won't be reshaped smaller than its minimum.")
[SETQ ATMINHEIGHT (CDR (SETQ ATMINWIDTH (MINIMUMWINDOWSIZE ATWIN]
(SETQ ATMINWIDTH (CAR ATMINWIDTH))
(SETQ POSONEDGE (SELECTQ POSONEDGE
(JUSTIFY 'JUSTIFY)
(CENTER 0)
((LEFT BOTTOM)
-1)
1))
(SETQ MAINWEXTENT (WINDOWPROP MAINW 'REGION))
(* ;; "the extent of a group of windows is thought of as its maximum extent along each edge and each position on that edge eg. top-left, top-center, top-right. A justify takes the maximum of the three positions along that edge.")
[SETQ TL (SETQ TC (SETQ TR (fetch (REGION TOP) of MAINWEXTENT]
[SETQ RT (SETQ RC (SETQ RB (fetch (REGION RIGHT) of MAINWEXTENT]
[SETQ BR (SETQ BC (SETQ BL (fetch (REGION BOTTOM) of MAINWEXTENT]
[SETQ LB (SETQ LC (SETQ LT (fetch (REGION LEFT) of MAINWEXTENT]
(bind ATWHERE ATPOSONEDGE ATWREG for ATW in (ATTACHEDWINDOWS MAINW)
until (EQ ATW ATWIN)
do
(* ;; "go through the attached windows keeping track of their effect on the position. Only consider windows attached to MAINW before ATWIN.")
(SETQ ATWREG (WINDOWREGION ATW))
(SETQ ATWHGHT (fetch (REGION HEIGHT) of ATWREG))
(SETQ ATWDTH (fetch (REGION WIDTH) of ATWREG))
(SETQ ATPOSONEDGE (SELECTQ [CDR (SETQ ATWHERE (WINDOWPROP ATW 'WHEREATTACHED]
(JUSTIFY 'JUSTIFY)
(CENTER 0)
((LEFT BOTTOM)
-1)
1))
(SELECTQ (CAR ATWHERE)
(TOP (SELECTQ ATPOSONEDGE
(JUSTIFY [SETQ TL (SETQ TC (SETQ TR (PLUS (MAX TL TC TR)
ATWHGHT])
(-1 (SETQ TL (PLUS TL ATWHGHT)))
(0 (SETQ TC (PLUS TC ATWHGHT)))
(1 (SETQ TR (PLUS TR ATWHGHT)))
(SHOULDNT)))
(RIGHT (SELECTQ ATPOSONEDGE
(JUSTIFY [SETQ RT (SETQ RC (SETQ RB (PLUS (MAX RT RC RB)
ATWDTH])
(1 (SETQ RT (PLUS RT ATWDTH)))
(0 (SETQ RC (PLUS RC ATWDTH)))
(-1 (SETQ RB (PLUS RB ATWDTH)))
(SHOULDNT)))
(LEFT (SELECTQ ATPOSONEDGE
(JUSTIFY [SETQ LT (SETQ LC (SETQ LB (DIFFERENCE (MIN LT LC LB)
ATWDTH])
(1 (SETQ LT (DIFFERENCE LT ATWDTH)))
(0 (SETQ LC (DIFFERENCE LC ATWDTH)))
(-1 (SETQ LB (DIFFERENCE LB ATWDTH)))
(SHOULDNT)))
(BOTTOM (SELECTQ ATPOSONEDGE
(JUSTIFY [SETQ BL (SETQ BC (SETQ BR (DIFFERENCE (MAX BL BC BR)
ATWHGHT])
(-1 (SETQ BL (DIFFERENCE BL ATWHGHT)))
(0 (SETQ BC (DIFFERENCE BC ATWHGHT)))
(1 (SETQ BR (DIFFERENCE BR ATWHGHT)))
(SHOULDNT)))
(SHOULDNT))) (* ; "now position the window")
(SETQ EXTENT (WINDOWREGION ATWIN))
(SETQ ATWHGHT (fetch (REGION HEIGHT) of EXTENT))
(SETQ ATWDTH (fetch (REGION WIDTH) of EXTENT))
(COND
((EQ POSONEDGE 'JUSTIFY)
(SHAPEW ATWIN (SELECTQ EDGE
(TOP (CREATEREGION LT (ADD1 (MAX TL TC TR))
(IMAX (ADD1 (DIFFERENCE RT LT))
ATMINWIDTH)
ATWHGHT))
(RIGHT (CREATEREGION (ADD1 (MAX RT RC RB))
BR ATWDTH (IMAX (ADD1 (DIFFERENCE TR BR))
ATMINHEIGHT)))
(LEFT (CREATEREGION (DIFFERENCE (MIN LT LC LB)
ATWDTH)
BL ATWDTH (IMAX (ADD1 (DIFFERENCE TL BL))
ATMINHEIGHT)))
(BOTTOM (CREATEREGION LB (DIFFERENCE (MIN BL BC BR)
ATWHGHT)
(IMAX (ADD1 (DIFFERENCE RB LB))
ATMINWIDTH)
ATWHGHT))
NIL)))
(T (SELECTQ EDGE
(TOP (SELECTQ POSONEDGE
(1 (MOVEW ATWIN (ADD1 (DIFFERENCE RT ATWDTH))
(ADD1 TR)))
(0 (MOVEW ATWIN (CENTERINWIDTH ATWDTH MAINWEXTENT)
(ADD1 TC)))
(MOVEW ATWIN LT (ADD1 TL))))
(RIGHT (SELECTQ POSONEDGE
(1 (MOVEW ATWIN (ADD1 RT)
(ADD1 (DIFFERENCE TR ATWHGHT))))
(0 (MOVEW ATWIN (ADD1 RC)
(CENTERINHEIGHT ATWHGHT MAINWEXTENT)))
(MOVEW ATWIN (ADD1 RB)
BR)))
(LEFT (SELECTQ POSONEDGE
(1 (MOVEW ATWIN (DIFFERENCE LT ATWDTH)
(ADD1 (DIFFERENCE TL ATWHGHT))))
(0 (MOVEW ATWIN (DIFFERENCE LC ATWDTH)
(CENTERINHEIGHT ATWHGHT MAINWEXTENT)))
(MOVEW ATWIN (DIFFERENCE LB ATWDTH)
BL)))
(BOTTOM (SELECTQ POSONEDGE
(1 (MOVEW ATWIN (ADD1 (DIFFERENCE RB ATWDTH))
(DIFFERENCE BR ATWHGHT)))
(0 (MOVEW ATWIN (CENTERINWIDTH ATWDTH MAINWEXTENT)
(DIFFERENCE BC ATWHGHT)))
(MOVEW ATWIN LB (DIFFERENCE BL ATWHGHT))))
NIL])
(OPENATTACHEDWINDOWS
[LAMBDA (WINDOW) (* ; "Edited 12-Jan-87 11:11 by woz")
(* ;;; "propagates opening to attached windows. since MOVEATTACHEDWINDOWTOPLACE punts when the main window is closed, must call it here to ensure the attached window is positioned.")
(for ATTACHEDWINDOW in (ATTACHEDWINDOWS WINDOW 'OPENW) do
(* ;; "reestablish the link from the attached window and the main window.")
(WINDOWPROP ATTACHEDWINDOW 'MAINWINDOW
WINDOW)
(MOVEATTACHEDWINDOWTOPLACE
ATTACHEDWINDOW WINDOW)
(OPENW ATTACHEDWINDOW])
(RESHAPEALLWINDOWS
[LAMBDA (MAINW NEWREGION MAINONLYFLG) (* ; "Edited 24-Jan-97 11:27 by rmk:")
(* DAHJr "11-Oct-86 18:57")
(* reshapes all of the windows in a
group.)
(* calculate all of the attached
window sizes)
(PROG ((ATWINS (ATTACHEDWINDOWS MAINW 'SHAPEW))
(MWXOFF 0)
(MWYOFF 0)
(NEWWIDTH (fetch (REGION WIDTH) of NEWREGION))
(NEWHEIGHT (fetch (REGION HEIGHT) of NEWREGION))
FIXEDVAR TOTALNOWSIZE EXPANSIONWIDTH EXPANSIONHEIGHT NEWEXPANDABLEWIDTH
NEWEXPANDABLEHEIGHT ATWINSINFO EXCESS NOW)
[COND
((NULL ATWINS)
(RETURN (SHAPEW1 MAINW NEWREGION)))
(MAINONLYFLG (SHAPEW1 MAINW NEWREGION)
(RETURN (\RESHAPEATTACHEDWINDOWSAROUNDMAINW MAINW
(\BREAKAPARTATWSTRUCTURE (CDR (\BUILDATWSTRUCTURE MAINW
ATWINS]
(SETQ TOTALNOWSIZE (WINDOWSIZE MAINW))
(* calculate the amount of the total size that is available to change.
This ignores the case where a window can only expand 5 but its share would be
10 but it is easy and better than nothing.)
(SETQ ATWINSINFO (\BUILDATWSTRUCTURE MAINW ATWINS))
(\ALLOCMINIMUMSIZES ATWINSINFO 0 0)
[SETQ EXPANSIONWIDTH (IDIFFERENCE (CAR TOTALNOWSIZE)
(SETQ FIXEDVAR (\TOTALFIXEDWIDTH ATWINSINFO]
(SETQ NEWEXPANDABLEWIDTH (IMAX (DIFFERENCE NEWWIDTH FIXEDVAR)
0))
[SETQ EXPANSIONHEIGHT (IDIFFERENCE (CDR TOTALNOWSIZE)
(SETQ FIXEDVAR (\TOTALFIXEDHEIGHT ATWINSINFO]
(SETQ NEWEXPANDABLEHEIGHT (IMAX (DIFFERENCE NEWHEIGHT FIXEDVAR)
0))
(* make a pass through allocating each window a portion of the space that is in
excess of the minimum. In this pass, the grouped windows are treated as a
whole. (If there is no space in excess of minimum, allocate on the basis of the
actual size of the windows -- Austin Henderson |10-11-86|))
[for ATWINFO in ATWINSINFO do [COND
[(EQP EXPANSIONWIDTH 0)
(\SETWINFOXSIZE
ATWINFO
(\SHAREOFXTRAX ATWINFO
(fetch (RESHAPINGWINDOWDATA
ATNOWX) of ATWINFO)
(CAR TOTALNOWSIZE]
(T (\SETWINFOXSIZE ATWINFO
(\SHAREOFXTRAX ATWINFO
NEWEXPANDABLEWIDTH
EXPANSIONWIDTH]
(COND
[(EQP EXPANSIONHEIGHT 0)
(\SETWINFOYSIZE ATWINFO
(\SHAREOFXTRAY ATWINFO
(fetch (RESHAPINGWINDOWDATA
ATNOWY) of
ATWINFO)
(CDR TOTALNOWSIZE]
(T (\SETWINFOYSIZE ATWINFO
(\SHAREOFXTRAY ATWINFO
NEWEXPANDABLEHEIGHT
EXPANSIONHEIGHT]
(* now go through allocate the space
within the groups of windows.)
(for ATWINFO in ATWINSINFO when (LISTP (fetch (RESHAPINGWINDOWDATA
ATTACHEDW)
of ATWINFO))
do (\ALLOCSPACETOGROUPEDWINDOWS ATWINFO))
(* calculate how much of the available space was actually allocated.
This is necessary because some of the windows may have reached their maximum
and hence left some space not used. The extra is given to the main window.
The main window is shaped first so that user reshape functions can determine
its size and shape as they do their thing.)
(SETQ TOTALNOWSIZE (\TOTALPROPOSEDSIZE ATWINSINFO))
[COND
((NEQ (SETQ EXCESS (IDIFFERENCE NEWWIDTH (CAR TOTALNOWSIZE)))
0)
(* Feed the excess width to any windows that will take it, starting with the
main window)
(for ATWINFO in ATWINSINFO
do (SETQ EXCESS (IDIFFERENCE EXCESS (IDIFFERENCE
(\SETWINFOXSIZE
ATWINFO
(IPLUS (SETQ NOW (fetch (
RESHAPINGWINDOWDATA
ATXSIZE)
of ATWINFO))
EXCESS))
NOW))) repeatuntil (EQ EXCESS 0]
[COND
((NEQ (SETQ EXCESS (IDIFFERENCE NEWHEIGHT (CDR TOTALNOWSIZE)))
0)
(* Feed the excess width to any windows that will take it, starting with the
main window)
(for ATWINFO in ATWINSINFO
do (SETQ EXCESS (IDIFFERENCE EXCESS (IDIFFERENCE
(\SETWINFOYSIZE
ATWINFO
(IPLUS (SETQ NOW (fetch (
RESHAPINGWINDOWDATA
ATYSIZE)
of ATWINFO))
EXCESS))
NOW))) repeatuntil (EQ EXCESS 0]
(for ATWINFO in ATWINSINFO do (* Calculate new position of main
window inside the total region)
(SELECTQ (fetch (RESHAPINGWINDOWDATA ATEDGE)
of ATWINFO)
(BOTTOM (add MWYOFF (fetch
(RESHAPINGWINDOWDATA
ATYSIZE)
of ATWINFO)))
(LEFT (add MWXOFF (fetch (
RESHAPINGWINDOWDATA
ATXSIZE)
of ATWINFO)))
NIL))
[SHAPEW1 MAINW (CREATEREGION (IPLUS MWXOFF (fetch (REGION LEFT) of NEWREGION))
(IPLUS MWYOFF (fetch (REGION BOTTOM) of NEWREGION))
(fetch (RESHAPINGWINDOWDATA ATXSIZE) of (CAR ATWINSINFO))
(fetch (RESHAPINGWINDOWDATA ATYSIZE) of (CAR ATWINSINFO]
(* reshape all of the attached
windows according to the calculated
new sizes.)
(\RESHAPEATTACHEDWINDOWSAROUNDMAINW MAINW (\BREAKAPARTATWSTRUCTURE (CDR ATWINSINFO])
(\TOTALPROPOSEDSIZE
[LAMBDA (ATWSINFO PWIDTH PHEIGHT) (* rrb " 9-Dec-83 16:12")
(* determines the width of the windows that do not change their size.)
(COND
[ATWSINFO (PROG (THISWID THISHEIGHT THISMINWIDTH THISMINHEIGHT (ATW (CAR ATWSINFO))
(RESTATWS (CDR ATWSINFO)))
(SETQ THISMINWIDTH (fetch (RESHAPINGWINDOWDATA ATMINX) of ATW))
(SETQ THISMINHEIGHT (fetch (RESHAPINGWINDOWDATA ATMINY) of ATW))
(SETQ THISWID (fetch (RESHAPINGWINDOWDATA ATXSIZE) of ATW))
(SETQ THISHEIGHT (fetch (RESHAPINGWINDOWDATA ATYSIZE) of ATW))
(RETURN (SELECTQ (fetch (RESHAPINGWINDOWDATA ATEDGE) of ATW)
((LEFT RIGHT)
(\TOTALPROPOSEDSIZE RESTATWS (IPLUS PWIDTH THISWID)
(IMAX PHEIGHT THISMINHEIGHT)))
((TOP BOTTOM)
(\TOTALPROPOSEDSIZE RESTATWS (IMAX PWIDTH THISMINWIDTH)
(IPLUS PHEIGHT THISHEIGHT)))
(PROGN (* this is the main window.)
(\TOTALPROPOSEDSIZE RESTATWS THISWID THISHEIGHT]
(T (CONS PWIDTH PHEIGHT])
(SHRINKATTACHEDWINDOWS
[LAMBDA (WINDOW) (* ; "Edited 5-Mar-87 11:06 by lal")
(* ;
"propagates shrinking to attached windows.")
(* ;
"doesn't actually shrink, just closes and evaluates the shrink functions.")
(for ATTACHEDWINDOW in (ATTACHEDWINDOWS WINDOW 'SHRINKW)
do (* ;
"Don't shrink the attached windows if they say not to")
(if (EQ (DOUSERFNS (WINDOWPROP ATTACHEDWINDOW 'SHRINKFN)
ATTACHEDWINDOW T)
'DON'T)
then NIL
else (\CLOSEW1 ATTACHEDWINDOW])
(TOPATTACHEDWINDOWS
[LAMBDA (WINDOW RECURSIVE) (* ; "Edited 17-Aug-88 19:46 by jds")
(* ;; "if WINDOW is root, propagate totoping down tree")
(COND
([OR RECURSIVE (NULL (WINDOWPROP WINDOW 'MAINWINDOW]
(for ATTACHEDWINDOW in (ATTACHEDWINDOWS WINDOW 'TOTOPW)
do
(* ;; "walk tree, totoping")
(TOTOPW ATTACHEDWINDOW T)
(TOPATTACHEDWINDOWS ATTACHEDWINDOW T])
(UNMAKEMAINWINDOW
[LAMBDA (MAINWINDOW) (* rrb "21-NOV-83 14:37")
(* the last attached window has been detached, clear any relevant window
properties.)
(WINDOWDELPROP MAINWINDOW 'TOTOPFN (FUNCTION TOPATTACHEDWINDOWS))
(WINDOWDELPROP MAINWINDOW 'CLOSEFN (FUNCTION CLOSEATTACHEDWINDOWS))
(WINDOWDELPROP MAINWINDOW 'OPENFN (FUNCTION OPENATTACHEDWINDOWS))
(WINDOWDELPROP MAINWINDOW 'SHRINKFN (FUNCTION SHRINKATTACHEDWINDOWS))
(WINDOWDELPROP MAINWINDOW 'EXPANDFN (FUNCTION EXPANDATTACHEDWINDOWS))
(WINDOWPROP MAINWINDOW 'CALCULATEREGIONFN NIL)
(WINDOWDELPROP MAINWINDOW 'MOVEFN (FUNCTION MOVEATTACHEDWINDOWS))
(WINDOWPROP MAINWINDOW 'DOSHAPEFN NIL])
(UPIQUOTIENT
[LAMBDA (N DIVISOR) (* rrb "20-NOV-83 13:41")
(* returns the smallest integer such that DIVISOR * that number is greater than
or equal to N.)
(IQUOTIENT (IPLUS N (SUB1 DIVISOR))
DIVISOR])
(WINDOWPOSITION
[LAMBDA (WINDOW) (* rrb "27-OCT-83 15:41")
(PROG [(REG (WINDOWPROP WINDOW 'REGION]
(RETURN (create POSITION
XCOORD _ (fetch (REGION LEFT) of REG)
YCOORD _ (fetch (REGION BOTTOM) of REG])
(WINDOWSIZE
[LAMBDA (WINDOW) (* rrb " 6-Dec-83 17:45")
(* returns the size (WIDTH . HEIGHT) of a window and its attached windows if
any.)
(PROG ((EXT (WINDOWREGION WINDOW)))
(* this will give the wrong answer if the attached windows have been moved and
have gaps between them.)
(RETURN (CONS (fetch (REGION WIDTH) of EXT)
(fetch (REGION HEIGHT) of EXT])
(\ALLOCMINIMUMSIZES
[LAMBDA (ATWSINFO INTMINWIDTH INTMINHEIGHT NOWWIDTH NOWHEIGHT)
(* rrb " 7-Jan-86 14:37")
(* allocates to each window in the list of window structures ATWSINFO the
minimum space it should get based on the minimums of all of the other windows
in ATWSINFO)
(* returns the minimum size dictated by the first window on ATWSINFO)
(COND
[ATWSINFO (PROG ((ATW (CAR ATWSINFO))
(THISMINWIDTH INTMINWIDTH)
(THISMINHEIGHT INTMINHEIGHT)
EXTSIZE EDGE WINDOWPILE RESTATWS FIXEDVAR EXPANSIONWIDTH NEWEXPANDABLEWIDTH
NEWWIDTH EXPANSIONHEIGHT NEWEXPANDABLEHEIGHT NEWHEIGHT)
(SETQ RESTATWS ATWSINFO)
(SELECTQ (fetch (RESHAPINGWINDOWDATA ATEDGE) of ATW)
((LEFT RIGHT)
(* collect a list of windows that fit on the sides.
This is so that any excess size imposed by windows further out can be allocated
among all of the windows piled together.)
(for WININFO in RESTATWS
until [NOT (FMEMB (fetch (RESHAPINGWINDOWDATA ATEDGE) of WININFO)
'(LEFT RIGHT]
do (SETQ THISMINHEIGHT (IMAX THISMINHEIGHT (fetch (
RESHAPINGWINDOWDATA
ATMINY)
of WININFO)))
(* calculate the current size of this
pile of windows.)
(SETQ NOWHEIGHT (IMAX NOWHEIGHT (fetch (RESHAPINGWINDOWDATA
ATNOWY) of WININFO)))
(SETQ NOWWIDTH (IPLUS NOWWIDTH (fetch (RESHAPINGWINDOWDATA
ATNOWX) of WININFO)))
(SETQ THISMINWIDTH (IPLUS THISMINWIDTH (fetch (
RESHAPINGWINDOWDATA
ATMINX)
of WININFO)))
(SETQ WINDOWPILE (CONS WININFO WINDOWPILE))
(SETQ RESTATWS (CDR RESTATWS)))
(* calculate the dimensions imposed by the minimum sizes of windows further out
on the attached window list.)
[SETQ NEWWIDTH (CAR (SETQ EXTSIZE (\ALLOCMINIMUMSIZES RESTATWS
THISMINWIDTH THISMINHEIGHT