-
-
Notifications
You must be signed in to change notification settings - Fork 24
/
Copy pathMODERNIZE
626 lines (422 loc) · 30.9 KB
/
MODERNIZE
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
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "30-Jun-2024 22:38:08" {WMEDLEY}<lispusers>MODERNIZE.;50 30912
:EDIT-BY rmk
:CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN)
:PREVIOUS-DATE "27-Jan-2024 13:38:15" {WMEDLEY}<lispusers>MODERNIZE.;49)
(PRETTYCOMPRINT MODERNIZECOMS)
(RPAQQ MODERNIZECOMS
[
(* ;; "Externals")
(COMS (FNS MODERNWINDOW MODERNWINDOW.SETUP UNMODERNWINDOW MODERNWINDOW.UNSETUP
\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(INITVARS (MODERN-WINDOW-MARGIN 25)))
(* ;; "Internals")
[COMS (FNS MODERNWINDOW.BUTTONEVENTFN NEARTOP NEARESTCORNER INCORNER.REGION)
(* ;; "Behavior for some known window creators")
(FNS MODERN-ADD-EXEC MODERN-SNAPW TOTOPW.MODERNIZE MODERN-MENUBUTTONFN)
(FNS \MODERNIZED.FREEMENU.BUTTONEVENTFN MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Add some Meta commands")
(FNS TEDIT.MODERNIZE \MODERNIZED.TEDIT.BUTTONEVENTFN)
(DECLARE%: DONTEVAL@LOAD DOCOPY (P
(* ;; "Tedit")
(TEDIT.MODERNIZE)
(* ;; "Inspector")
(MODERNWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER)
(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either")
(* (MODERNWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN))
(MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
(* ;; "File browser")
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN
'\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(* ;; "SEDIT")
(MODERNWINDOW.SETUP 'SEDIT::BUTTONEVENTFN)
(* ;; "Debugger")
(MODERNWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT)
(* ;; "Snap")
(MODERNWINDOW.SETUP 'SNAPW 'MODERN-SNAPW)
(* ;; "New execs")
(MODERNWINDOW.SETUP 'ADD-EXEC 'MODERN-ADD-EXEC)
(* ;; "Existing exec of the load")
(MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
'WINDOW))
(* ;; "Table browser and filebrowser)")
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN
'MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Grapher")
(MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE)
(* ;; "Sketch")
(MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER)
(* ;; "Promptwindow")
(MODERNWINDOW PROMPTWINDOW T)
(* ;; "Menus: Move only with title clicks")
(MODERNWINDOW.SETUP 'MENUBUTTONFN
'MODERN-MENUBUTTONFN]
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
(NLAML)
(LAMA MODERN-ADD-EXEC])
(* ;; "Externals")
(DEFINEQ
(MODERNWINDOW
[LAMBDA (WINDOW ANYWHERE TITLEPROPORTION) (* ; "Edited 7-Oct-2022 21:45 by rmk")
(* ; "Edited 8-Jul-2021 23:33 by rmk:")
(* ; "Edited 3-Jul-2021 10:31 by rmk:")
(* ; "Edited 24-Jun-2021 14:52 by rmk:")
(* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn. If the window was previously modernized, we restore its original state first, in case it is called here with different parameters")
(CL:WHEN (AND TITLEPROPORTION (GREATERP TITLEPROPORTION 0.5))
(ERROR "TITLEPROPORTION cannot be greater than .5"))
(CL:WHEN (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN)
(WINDOWPROP WINDOW 'BUTTONEVENTFN (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN))
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN NIL))
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN (WINDOWPROP WINDOW 'BUTTONEVENTFN))
(WINDOWPROP WINDOW 'BUTTONEVENTFN (IF (OR ANYWHERE TITLEPROPORTION)
THEN `[LAMBDA (WINDOW)
(MODERNWINDOW.BUTTONEVENTFN WINDOW NIL T
',TITLEPROPORTION]
ELSE (FUNCTION MODERNWINDOW.BUTTONEVENTFN)))
WINDOW])
(MODERNWINDOW.SETUP
[LAMBDA (ORIGFN MODERNWINDOWFN ANYWHERE TITLEPROPORTION)
(* ; "Edited 24-Jun-2021 14:53 by rmk:")
(* ;; "ORIGFN is either a function that creates windows of a given type (e.g. SNAPW or ADD-EXEC) or the known BUTTONEVENTFN of a class of windows.")
(* ;; "Moves ORIGNFN to a new name, prefixed with MODERNORIG-.")
(* ;; "If MODERNWINDOWFN is given, then that replaces the original definition of ORIGFN, and presumably knows how to call the renamed ORIGFN under the right circumstances. This is typically the case where ORIGFN is a window creator.")
(* ;; "Otherwise, ORIGFN is taken to be the BUTTONEVENTFN for a class of windows, and its new definition is defaulted to one that maps left-clicks in appropriate areas into modern window operations. If not in appropriate areas, then the renamed ORIGNFN is called to give the original button behavior.")
(* ;; "If ANYWHERE, moving will happen for any click not in one of the shaping corners.")
(* ;; "The renamed function has arguments in addition to WINDOW: the new name for the original function, if MODERNWINDOFN is provided, and the value specified here for ANYWHERE.")
(CL:WHEN (GETD ORIGFN)
(* ;; "If ORIGFN is defined, then presumably the file containing ORIGFN (e.g. sketch) was loaded before MODERNIZE (if we are being called on our load), and we can rearrange things. But of ORIGFN is not defined, then there is really nothing to do. The package loader itself should call MODERNWINDOW.SETUP if we are defined when it is loaded. ")
(* ;; "")
(CL:WHEN (AND TITLEPROPORTION (GREATERP TITLEPROPORTION 0.5))
(ERROR "TITLEPROPORTION cannot be greater than .5"))
(MODERNWINDOW.UNSETUP ORIGFN)
[LET [RENAMEDORIG (PKGNAME (CL:PACKAGE-NAME (CL:SYMBOL-PACKAGE ORIGFN]
(* ;; "The renamed version of XCL symbols go into Interlisp, so there is less confusion about accessing it")
(CL:WHEN (STREQUAL PKGNAME "XEROX-COMMON-LISP")
(SETQ PKGNAME "INTERLISP"))
(SETQ RENAMEDORIG (CL:INTERN (CONCAT 'MODERN-ORIG- ORIGFN)
PKGNAME))
(MOVD? ORIGFN RENAMEDORIG)
(IF MODERNWINDOWFN
THEN (MOVD MODERNWINDOWFN ORIGFN)
ELSE (PUTD ORIGFN `(LAMBDA ,(ARGLIST ORIGFN)
(MODERNWINDOW.BUTTONEVENTFN
,(CL:IF (LISTP (ARGLIST ORIGFN))
(CAR (ARGLIST ORIGFN))
(ARGLIST ORIGFN))
(FUNCTION ,RENAMEDORIG)
,ANYWHERE
,TITLEPROPORTION])])
(UNMODERNWINDOW
[LAMBDA (WINDOW) (* ; "Edited 22-Feb-2021 16:44 by rmk:")
(* ;; "Restores original window behavior")
(CL:WHEN (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN)
(WINDOWPROP WINDOW 'BUTTONEVENTFN (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN))
(WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN NIL))
WINDOW])
(MODERNWINDOW.UNSETUP
[LAMBDA (ORIGFN) (* ; "Edited 22-Feb-2021 16:45 by rmk:")
(* ; "Edited 24-Jun-2020 15:09 by rmk:")
(* ;; "Moves the renamed original function back to its original name")
(LET [RENAMEDORIG (PKGNAME (CL:PACKAGE-NAME (CL:SYMBOL-PACKAGE ORIGFN]
(* ;; "The renamed version of XCL symbols go into Interlisp, so there is less confusion about accessing it")
(CL:WHEN (STREQUAL PKGNAME "XEROX-COMMON-LISP")
(SETQ PKGNAME "INTERLISP"))
(SETQ RENAMEDORIG (CL:INTERN (CONCAT 'MODERN-ORIG- ORIGFN)
PKGNAME))
(CL:WHEN (GETD RENAMEDORIG)
(MOVD RENAMEDORIG ORIGFN])
(\MODERNIZED.FREEMENU.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 15:15 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\FM.BUTTONEVENTFN)
NIL NIL (WINDOWPROP (CENTRALWINDOW W)
'REGION)
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
)
(RPAQ? MODERN-WINDOW-MARGIN 25)
(* ;; "Internals")
(DEFINEQ
(MODERNWINDOW.BUTTONEVENTFN
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
(* ; "Edited 5-Mar-2022 23:20 by rmk")
(* ; "Edited 25-Dec-2021 22:19 by rmk")
(* ; "Edited 16-Oct-2021 15:25 by rmk:")
(* ;; "WINDOW is the window that received the click and that should be passed through to the original function, if we don't pick it off here.")
(* ;; "However, that window may be an auxiliary window (an attached menu? or a lower split-pane in Tedit) whose region and title intuitively should not be used to control shaping and moving behavior. That behavior is determined by the CORNERREGION and TITLED parameters.")
(* ;; "If CORNERREGION is given, we know that there are two windows in play. In that case also TOPMARGIN tells us the hotband at the top of the cornerregion where the move/shaping click is recognized, T to mean that it has an ordinary title bar. .")
(* ;; "For windows without a top margin, the shape/move region is MODERN-WINDOW-MARGIN points below the top, in the clipping region of the window. ")
(* ;; "Changed to use Wborder for the top region of an untitle window instead of MODERN-WINDOW-MARGIN. Maybe it should be 2 times the border width in that case, and the MODERN-WINDOW-MARGIN separately defines the rectangle that constitutes a corner.")
(LET (CORNER ATTACHEDREGION)
(IF CORNERREGION
THEN
(* ;; "Caller tells us whether the corner window has a title.")
(CL:UNLESS (FIXP TOPMARGIN)
(SETQ TOPMARGIN (if (OR TOPMARGIN (WINDOWPROP WINDOW 'TITLE))
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else WBorder)))
ELSE (SETQ CORNERREGION (WINDOWPROP WINDOW 'REGION))
(* ; "WINDOW is the corner window")
(SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN)
elseif (WINDOWPROP WINDOW 'TITLE)
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else WBorder)))
(if (AND (MOUSESTATE (ONLY LEFT))
(EQ LASTKEYBOARD 0)
(INSIDE? CORNERREGION LASTMOUSEX LASTMOUSEY))
then
(* ;; "INSIDE? check because we may be called by a click in WINDOW that is outside the corner region, we just pass it through.")
(TOTOPW WINDOW)
(SETQ ATTACHEDREGION (ATTACHEDWINDOWREGION (CENTRALWINDOW WINDOW)))
(* ;; "If the window has a TOPMARGIN property, that tells us that it does not have a canonical title but may still have a title-like attached window just above the main window. The TOPMARGIN should be 0 in that case.")
(* ;; "This is particularly the case of FILEBROWSER windows, where the modified ATTACHEDWINDOWTOTOPFN drives the click here. ")
(SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN))
(if [AND CORNER (NOT (MEMB 'SHAPEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS]
then
(* ;;
"The upper corners may be in the title bar, near the side, so test corners before titlebar.")
(* ;; "We are in the corner of the main window, so we are reshaping. But the ghost region should include all of the attached windows, and the starting cursor should be positioned at the corner closest to the selected corner of the main window.")
(* ;; "WINDOWREGION includes the attached windows")
(LET ((LEFT (fetch (REGION LEFT) of ATTACHEDREGION))
(RIGHT (fetch (REGION RIGHT) of ATTACHEDREGION))
(TOP (fetch (REGION TOP) of ATTACHEDREGION))
(BOTTOM (fetch (REGION BOTTOM) of ATTACHEDREGION))
STARTINGREGION)
(* ;; "\CURSORPOSITION moves the mouse to the tracking corner of the ghost region, in screen coordinates, so that the mouse starts out at the tracking corner of the ghost region, even if there are attached windows (as in the filebrowser) that overhang the corner and the initiating click was at the corner of the mainwindow.")
(CL:UNLESS (EQ 'DON'T (WINDOWPROP WINDOW 'RESHAPEFN))
[SETQ STARTINGREGION
(GETREGION NIL NIL NIL NIL NIL
(SELECTQ CORNER
(RIGHTBOTTOM (\CURSORPOSITION RIGHT BOTTOM)
(GETMOUSESTATE)
(LIST LEFT TOP RIGHT BOTTOM))
(LEFTBOTTOM (\CURSORPOSITION LEFT BOTTOM)
(GETMOUSESTATE)
(LIST RIGHT TOP LEFT BOTTOM))
(RIGHTTOP (\CURSORPOSITION RIGHT TOP)
(GETMOUSESTATE)
(LIST LEFT BOTTOM RIGHT TOP))
(LEFTTOP (\CURSORPOSITION LEFT TOP)
(GETMOUSESTATE)
(LIST RIGHT BOTTOM LEFT TOP))
(SHOULDNT])
(SHAPEW (CENTRALWINDOW WINDOW)
STARTINGREGION))
T
elseif (AND [NOT (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS]
(OR ANYWHERE (NEARTOP CORNERREGION TOPMARGIN TITLEPROPORTION)))
then (NEARESTCORNER ATTACHEDREGION)
(MOVEW (CENTRALWINDOW WINDOW))
T
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW
'PREMODERN-BUTTONEVENTFN]
then (APPLY* ORIGFUNCTION WINDOW))
elseif [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMODERN-BUTTONEVENTFN]
then (APPLY* ORIGFUNCTION WINDOW])
(NEARTOP
[LAMBDA (CORNERREGION TOPMARGIN TITLEPROPORTION) (* ; "Edited 13-Oct-2021 21:28 by rmk:")
(* ;; "True if the MOUSEY is near the top of CORNERREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)")
(* ;; "If TITLEPROPORTION is N, then the click must be within that proportion of the window-width from either edge. ")
(AND (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF CORNERREGION)
TOPMARGIN))
(OR (NOT TITLEPROPORTION)
(LET ((WIDTH (FETCH WIDTH of CORNERREGION))
(LEFT (FETCH LEFT OF CORNERREGION)))
(OR (ILESSP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH TITLEPROPORTION)))
(IGREATERP LASTMOUSEX (IPLUS LEFT (TIMES WIDTH (DIFFERENCE 1 TITLEPROPORTION])
(NEARESTCORNER
[LAMBDA (REGION) (* ; "Edited 29-Oct-2023 10:56 by rmk")
(* ; "Edited 29-Jul-2023 10:32 by rmk")
(* ; "Edited 14-Feb-2021 21:46 by rmk:")
(* ;; "Moves the cursor to the corner of REGION that is closest to the current LASTMOUSEX and LASTMOUSEY, provided that that corner is on-screen.")
(LET ((LEFT (FETCH (REGION LEFT) OF REGION))
(RIGHT (FETCH (REGION RIGHT) OF REGION))
(TOP (FETCH (REGION TOP) OF REGION))
(BOTTOM (FETCH (REGION BOTTOM) OF REGION))
X Y)
(* ;; "If the nearest corner is offscreen, pick the other one.")
(SETQ X (if (OR (ILESSP LEFT 0)
(IGEQ LEFT SCREENWIDTH))
then
(* ;; "LEFT is offscreen")
RIGHT
elseif (ILESSP (IDIFFERENCE LASTMOUSEX LEFT)
(IDIFFERENCE RIGHT LASTMOUSEX))
then
(* ;; "Closer to LEFT")
LEFT
else RIGHT))
(SETQ Y (if (OR (ILESSP TOP 0)
(IGEQ TOP SCREENHEIGHT))
then
(* ;; "TOP is offscreen")
BOTTOM
elseif (ILESSP (IDIFFERENCE LASTMOUSEY BOTTOM)
(IDIFFERENCE TOP LASTMOUSEY))
then
(* ;; "Closer to BOTTOM")
BOTTOM
else TOP))
(\CURSORPOSITION X Y])
(INCORNER.REGION
[LAMBDA (CORNERREGION TOPMARGIN) (* ; "Edited 13-Oct-2021 15:04 by rmk:")
(* ;; "CORNERREGION, LASTMOUSEX, LASTMOUSEY in screen coordinates.")
(* ;; "TOPMARGIN is the height of the titlebar for titled windows, otherwise the margin at the top of the window's content that we regard as the top. ")
(if (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (fetch LEFT of CORNERREGION)))
MODERN-WINDOW-MARGIN)
then (if (NEARTOP CORNERREGION TOPMARGIN)
then 'LEFTTOP
elseif (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (fetch BOTTOM of CORNERREGION)))
then 'LEFTBOTTOM)
elseif (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (fetch RIGHT of CORNERREGION)))
MODERN-WINDOW-MARGIN)
then (if (NEARTOP CORNERREGION TOPMARGIN)
then 'RIGHTTOP
elseif (ILEQ LASTMOUSEY (IPLUS MODERN-WINDOW-MARGIN (fetch BOTTOM of CORNERREGION)))
then 'RIGHTBOTTOM])
)
(* ;; "Behavior for some known window creators")
(DEFINEQ
(MODERN-ADD-EXEC
[LAMBDA U (* ; "Edited 22-Feb-2021 16:41 by rmk:")
(LET [(PROC (APPLY (FUNCTION MODERN-ORIG-ADD-EXEC)
(FOR N FROM 1 TO U COLLECT (ARG U N]
(* ;; "For some reason, the window may not be there immediately")
(DISMISS 100)
(MODERNWINDOW (PROCESSPROP PROC 'WINDOW))
PROC])
(MODERN-SNAPW
[LAMBDA NIL (* ; "Edited 22-Feb-2021 16:41 by rmk:")
(* ;; "No point in shaping a snap window, just move it.;;")
(* ;;
"This changes the creation function (SNAPW), since snap windows otherwise don't have a BUTTONEVENTN")
(LET ((W (MODERN-ORIG-SNAPW)))
[WINDOWPROP W 'BUTTONEVENTFN (FUNCTION (LAMBDA (W)
(TOTOPW W)
(MOVEW W]
W])
(TOTOPW.MODERNIZE
[LAMBDA (WINDOW) (* ; "Edited 22-Feb-2021 16:31 by rmk:")
(* ;; "This replaces the TOTOPW BUTTONEVENTFN on an attached window where the click is then directed to the MAINWINDOW.")
(TOTOPW WINDOW)
(LET ((MAIN (MAINWINDOW WINDOW T)))
(CL:WHEN MAIN
(MODERNWINDOW.BUTTONEVENTFN MAIN (WINDOWPROP MAIN 'BUTTONEVENTFN)))])
(MODERN-MENUBUTTONFN
[LAMBDA (WINDOW) (* ; "Edited 25-Dec-2021 22:26 by rmk")
(* ; "Edited 23-May-2021 20:37 by rmk:")
(* ;; "Replaces the button fn for a Menu window, allowing title clicks to do the move. Sometimes the title isn't in the window, it's in the menu.")
(LET (MENU)
(IF [AND [NOT (MEMB 'MOVEW (WINDOWPROP WINDOW 'PASSTOMAINCOMS]
(MOUSESTATE (ONLY LEFT))
(EQ LASTKEYBOARD 0)
(OR (WINDOWPROP WINDOW 'TITLE)
(AND [NULL (CDR (SETQ MENU (MKLIST (WINDOWPROP WINDOW 'MENU]
(TYPE? MENU (SETQ MENU (CAR MENU)))
(FETCH (MENU TITLE) OF MENU)))
(NEARTOP (WINDOWPROP WINDOW 'REGION)
(FONTPROP WindowTitleDisplayStream 'HEIGHT]
THEN (MOVEW WINDOW)
ELSE (MODERN-ORIG-MENUBUTTONFN WINDOW])
)
(DEFINEQ
(\MODERNIZED.FREEMENU.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 13-Oct-2021 15:15 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\FM.BUTTONEVENTFN)
NIL NIL (WINDOWPROP (CENTRALWINDOW W)
'REGION)
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
(MODERNIZED.TB.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 16-Oct-2021 15:40 by rmk:")
(* ;; "If a free menu is attached to another window, we don't want the corners of the free menu that abut another window to be hot-spots for moving or reshaping. In fact, if the menu window has a main window, use the main window's region as the cornerregion")
(LET ((CW (CENTRALWINDOW W))
CORNERREG TOPMARGIN)
(CL:WHEN (WINDOWPROP CW 'FILEBROWSER)
[SETQ CORNERREG (UNIONREGIONS (WINDOWPROP (FB.GETWINDOW CW 'HEADING)
'REGION)
(WINDOWPROP (FB.GETWINDOW CW 'COUNTER)
'REGION)
(WINDOWPROP (FB.GETWINDOW CW 'BROWSER)
'REGION]
[SETQ TOPMARGIN (IPLUS (FETCH (REGION HEIGHT) OF (WINDOWPROP (FB.GETWINDOW
CW
'HEADING)
'REGION))
(FETCH (REGION HEIGHT) OF (WINDOWPROP (FB.GETWINDOW
CW
'COUNTER)
'REGION])
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-TB.BUTTONEVENTFN)
NIL NIL CORNERREG TOPMARGIN])
)
(* ;; "Add some Meta commands")
(DEFINEQ
(TEDIT.MODERNIZE
[LAMBDA NIL (* ; "Edited 14-Jun-2023 16:56 by rmk")
(* ; "Edited 11-Oct-2021 15:02 by rmk:")
(MODERNWINDOW.SETUP (FUNCTION \TEDIT.BUTTONEVENTFN)
(FUNCTION \MODERNIZED.TEDIT.BUTTONEVENTFN])
(\MODERNIZED.TEDIT.BUTTONEVENTFN
[LAMBDA (W STREAM) (* ; "Edited 30-Jun-2024 22:29 by rmk")
(* ; "Edited 29-Jul-2023 10:48 by rmk")
(* ; "Edited 13-Oct-2021 21:43 by rmk:")
(* ;; "If a TEDIT window has been split, we have to make sure that movement happens only for clicks at the top of the main window and at the bottom of the bottom-most split window. Clicks near the split lines must be ignored. Essentially, the %"region%" of the Tedit window is the union of the regions of all of its split-panes.")
(* ;; "We pass the pane that received the click, because that's what the original \TEDIT.BUTTONEVENTFN needs to see, if we decide not to shape or move.")
(MODERNWINDOW.BUTTONEVENTFN W (FUNCTION MODERN-ORIG-\TEDIT.BUTTONEVENTFN)
NIL
(WINDOWPROP W 'MODERNIZE.TITLEPROPORTION)
[APPLY (FUNCTION UNIONREGIONS)
(for PANE in (\TEDIT.PANELIST (CENTRALWINDOW W)) collect (WINDOWPROP PANE
'REGION]
(WINDOWPROP (CENTRALWINDOW W)
'TITLE])
)
(DECLARE%: DONTEVAL@LOAD DOCOPY
(* ;; "Tedit")
(TEDIT.MODERNIZE)
(* ;; "Inspector")
(MODERNWINDOW.SETUP '\ITEM.WINDOW.BUTTON.HANDLER)
(* ;; "Commonlisp array inspector. If you move the main window, the little attached window doesn't move. But if you move the attached window, it all works. Needs a special definition. Shaping doesn't work either")
(* (MODERNWINDOW.SETUP
(QUOTE ONEDINSPECT.BUTTONEVENTFN)))
(MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
(* ;; "File browser")
(MODERNWINDOW.SETUP '\FM.BUTTONEVENTFN '\MODERNIZED.FREEMENU.BUTTONEVENTFN)
(* ;; "SEDIT")
(MODERNWINDOW.SETUP 'SEDIT::BUTTONEVENTFN)
(* ;; "Debugger")
(MODERNWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT)
(* ;; "Snap")
(MODERNWINDOW.SETUP 'SNAPW 'MODERN-SNAPW)
(* ;; "New execs")
(MODERNWINDOW.SETUP 'ADD-EXEC 'MODERN-ADD-EXEC)
(* ;; "Existing exec of the load")
(MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
'WINDOW))
(* ;; "Table browser and filebrowser)")
(MODERNWINDOW.SETUP 'TB.BUTTONEVENTFN 'MODERNIZED.TB.BUTTONEVENTFN)
(* ;; "Grapher")
(MODERNWINDOW.SETUP 'APPLYTOSELECTEDNODE)
(* ;; "Sketch")
(MODERNWINDOW.SETUP 'WB.BUTTON.HANDLER)
(* ;; "Promptwindow")
(MODERNWINDOW PROMPTWINDOW T)
(* ;; "Menus: Move only with title clicks")
(MODERNWINDOW.SETUP 'MENUBUTTONFN 'MODERN-MENUBUTTONFN)
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML )
(ADDTOVAR LAMA MODERN-ADD-EXEC)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5066 11428 (MODERNWINDOW 5076 . 6616) (MODERNWINDOW.SETUP 6618 . 9567) (UNMODERNWINDOW
9569 . 9963) (MODERNWINDOW.UNSETUP 9965 . 10777) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10779 . 11426)) (
11493 22459 (MODERNWINDOW.BUTTONEVENTFN 11503 . 18530) (NEARTOP 18532 . 19460) (NEARESTCORNER 19462 .
21329) (INCORNER.REGION 21331 . 22457)) (22517 24989 (MODERN-ADD-EXEC 22527 . 22958) (MODERN-SNAPW
22960 . 23503) (TOTOPW.MODERNIZE 23505 . 23933) (MODERN-MENUBUTTONFN 23935 . 24987)) (24990 27419 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 25000 . 25647) (MODERNIZED.TB.BUTTONEVENTFN 25649 . 27417)) (27460
29151 (TEDIT.MODERNIZE 27470 . 27823) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27825 . 29149)))))
STOP