github.com/Interlisp.medley
1
0
Fork 0
mirror of synced 2026-01-27 12:52:06 +00:00
Code Issues Projects Releases Wiki Activity

MODERNIZEP: pass shape and move to main window if PASSTOMAINCOMS

Browse Source
This commit is contained in:
rmkaplan
2021-12-26 15:49:24 -08:00
parent 9f7bf48b8c
commit 488dcc3be3
2 changed files with 87 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

174
lispusers/MODERNIZE
View File

@@ -1,12 +1,12 @@
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
(FILECREATED "16-Oct-2021 15:42:11" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;41 30305
(FILECREATED "25-Dec-2021 22:27:41" 
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;39 30532
changes to%: (FNS MODERNIZED.TB.BUTTONEVENTFN)
:CHANGES-TO (FNS MODERN-MENUBUTTONFN)
previous date%: "16-Oct-2021 15:29:38"
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MODERNIZE.;40)
:PREVIOUS-DATE "25-Dec-2021 22:20:10"
{DSK}<Users>kaplan>Local>medley3.5>my-medley>lispusers>MODERNIZE.;38)
(PRETTYCOMPRINT MODERNIZECOMS)
@@ -216,8 +216,9 @@
(DEFINEQ
(MODERNWINDOW.BUTTONEVENTFN
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
(* ; "Edited 16-Oct-2021 15:25 by rmk:")
[LAMBDA (WINDOW ORIGFUNCTION ANYWHERE TITLEPROPORTION CORNERREGION TOPMARGIN)
(* ; "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.")
@@ -232,81 +233,78 @@
(LET (CORNER ATTACHEDREGION)
(IF CORNERREGION
THEN
(* ;; "Caller tells us whether the corner window has a title.")
(* ;; "Caller tells us whether the corner window has a title.")
(CL:UNLESS (FIXP TOPMARGIN)
(SETQ TOPMARGIN (if TOPMARGIN
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
(CL:UNLESS (FIXP TOPMARGIN)
(SETQ TOPMARGIN (if TOPMARGIN
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
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 MODERN-WINDOW-MARGIN)))
(SETQ TOPMARGIN (if (WINDOWPROP WINDOW 'TOPMARGIN)
elseif (WINDOWPROP WINDOW 'TITLE)
then (FONTPROP WindowTitleDisplayStream 'HEIGHT)
else MODERN-WINDOW-MARGIN)))
(if (AND (MOUSESTATE (ONLY LEFT))
(EQ LASTKEYBOARD 0)
(INSIDE? CORNERREGION LASTMOUSEX LASTMOUSEY))
(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.")
(* ;; "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)))
(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.")
(* ;; "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. ")
(* ;; "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.")
(SETQ CORNER (INCORNER.REGION CORNERREGION TOPMARGIN))
(if CORNER
then
(* ;; "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.")
(* ;;
 "The upper corners may be in the title bar, near the side, so test corners before titlebar.")
(* ;; "WINDOWREGION includes the attached windows")
(* ;; "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.")
(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)
(* ;; "WINDOWREGION includes the attached windows")
(* ;; "\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.")
(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)
(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 LEFT BOTTOM RIGHT TOP))
(LEFTTOP (\CURSORPOSITION LEFT TOP)
(GETMOUSESTATE)
(LIST RIGHT BOTTOM LEFT TOP))
(SHOULDNT])
(SHAPEW (CENTRALWINDOW WINDOW)
STARTINGREGION))
T
elseif (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]
(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
@@ -406,19 +404,21 @@
(MODERNWINDOW.BUTTONEVENTFN MAIN (WINDOWPROP MAIN 'BUTTONEVENTFN)))])
(MODERN-MENUBUTTONFN
[LAMBDA (WINDOW) (* ; "Edited 23-May-2021 20:37 by rmk:")
[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.")
(* ;; "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 (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]
(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])
)
@@ -532,7 +532,7 @@
(* (MODERNWINDOW.SETUP
 (QUOTE ONEDINSPECT.BUTTONEVENTFN)))
 (QUOTE ONEDINSPECT.BUTTONEVENTFN)))
(MODERNWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN)
@@ -571,7 +571,7 @@
(MODERNWINDOW (PROCESSPROP (TTY.PROCESS)
'WINDOW))
'WINDOW))
(* ;; "Table browser and filebrowser)")
@@ -612,12 +612,12 @@
(ADDTOVAR LAMA MODERN-ADD-EXEC)
)
(DECLARE%: DONTCOPY
(FILEMAP (NIL (5135 11412 (MODERNWINDOW 5145 . 6600) (MODERNWINDOW.SETUP 6602 . 9551) (UNMODERNWINDOW
9553 . 9947) (MODERNWINDOW.UNSETUP 9949 . 10761) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10763 . 11410)) (
11477 21412 (MODERNWINDOW.BUTTONEVENTFN 11487 . 18287) (NEARTOP 18289 . 19217) (NEARESTCORNER 19219 .
20098) (INCORNER.REGION 20100 . 21410)) (21470 23792 (MODERN-ADD-EXEC 21480 . 21911) (MODERN-SNAPW
21913 . 22456) (TOTOPW.MODERNIZE 22458 . 22886) (MODERN-MENUBUTTONFN 22888 . 23790)) (23793 26222 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 23803 . 24450) (MODERNIZED.TB.BUTTONEVENTFN 24452 . 26220)) (26263
28542 (TEDIT.MODERNIZE 26273 . 27087) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27089 . 28211) (TEDIT.SELECTALL
28213 . 28540)))))
(FILEMAP (NIL (5122 11399 (MODERNWINDOW 5132 . 6587) (MODERNWINDOW.SETUP 6589 . 9538) (UNMODERNWINDOW
9540 . 9934) (MODERNWINDOW.UNSETUP 9936 . 10748) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10750 . 11397)) (
11464 21491 (MODERNWINDOW.BUTTONEVENTFN 11474 . 18366) (NEARTOP 18368 . 19296) (NEARESTCORNER 19298 .
20177) (INCORNER.REGION 20179 . 21489)) (21549 24021 (MODERN-ADD-EXEC 21559 . 21990) (MODERN-SNAPW
21992 . 22535) (TOTOPW.MODERNIZE 22537 . 22965) (MODERN-MENUBUTTONFN 22967 . 24019)) (24022 26451 (
\MODERNIZED.FREEMENU.BUTTONEVENTFN 24032 . 24679) (MODERNIZED.TB.BUTTONEVENTFN 24681 . 26449)) (26492
28771 (TEDIT.MODERNIZE 26502 . 27316) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27318 . 28440) (TEDIT.SELECTALL
28442 . 28769)))))
STOP

BIN
lispusers/MODERNIZE.LCOM
View File

Binary file not shown.