From 7c74e2f3af1d17cd7a2cb8e4f514df934a1295fe Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Mon, 22 Feb 2021 14:09:43 -0800 Subject: [PATCH] MACINTERFACE: first step towards renaming to MODERNIZE --- lispusers/MACINTERFACE | 2 +- lispusers/MACINTERFACE.LCOM | Bin 7715 -> 7588 bytes 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/lispusers/MACINTERFACE b/lispusers/MACINTERFACE index 76123d56..2b9baacb 100644 --- a/lispusers/MACINTERFACE +++ b/lispusers/MACINTERFACE @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "15-Feb-2021 20:50:07"  {DSK}kaplan>Local>medley3.5>git-medley>lispusers>MACINTERFACE.;75 21496 changes to%: (FNS MACWINDOW.BUTTONEVENTFN) previous date%: "14-Feb-2021 21:51:47" {DSK}kaplan>Local>medley3.5>git-medley>lispusers>MACINTERFACE.;74) (PRETTYCOMPRINT MACINTERFACECOMS) (RPAQQ MACINTERFACECOMS [ (* ;; "Externals") (COMS (FNS MACWINDOW MACWINDOW.SETUP UNMACWINDOW MACWINDOW.UNSETUP) (INITVARS (MACWINDOWMARGIN 25))) (* ;; "Internals") [COMS (FNS MACWINDOW.BUTTONEVENTFN MACWINDOW.BUTTONEVENTFN.ANYWHERE NEARTOP NEARESTCORNER INCORNER.REGION) (* ;; "Behavior for some known window creators") (FNS MACINT-ADD-EXEC MACINT-SNAPW) (FNS TEDIT.MACINTERFACE TEDIT.SELECTALL) (FNS FB.MAKEHEADINGWINDOW.MACINTERFACE TOTOPW.MACINTERFACE) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (TEDIT.MACINTERFACE) (* ;; "Inspector") (MACWINDOW.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") (* (MACWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN)) (MACWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN) (* ;; "Freemenu") (MACWINDOW.SETUP '\FM.BUTTONEVENTFN) (* ;; "SEDIT") (MACWINDOW.SETUP 'SEDIT::BUTTONEVENTFN) (* ;; "Debugger") (MACWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT) (* ;; "Snap") (MACWINDOW.SETUP 'SNAPW 'MACINT-SNAPW) (* ;; "New execs") (MACWINDOW.SETUP 'ADD-EXEC 'MACINT-ADD-EXEC) (* ;; "Existing exec of the load") (MACWINDOW (PROCESSPROP (TTY.PROCESS) 'WINDOW)) (* ;; "Table browser (specialized to filebrowser)") (MACWINDOW.SETUP 'FB.MAKEHEADINGWINDOW 'FB.MAKEHEADINGWINDOW.MACINTERFACE) (MACWINDOW.SETUP 'TB.BUTTONEVENTFN) (* ;; "Grapher") (MACWINDOW.SETUP 'APPLYTOSELECTEDNODE) (* ;; "Promptwindow") (MACWINDOW PROMPTWINDOW T] (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA MACINT-ADD-EXEC]) (* ;; "Externals") (DEFINEQ (MACWINDOW [LAMBDA (WINDOW ANYWHERE) (* ; "Edited 23-Jun-2020 16:01 by rmk:") (* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn.") (CL:UNLESS (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN) (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN (WINDOWPROP WINDOW 'BUTTONEVENTFN)) (WINDOWPROP WINDOW 'BUTTONEVENTFN (IF ANYWHERE THEN (FUNCTION MACWINDOW.BUTTONEVENTFN.ANYWHERE) ELSE (FUNCTION MACWINDOW.BUTTONEVENTFN)))) WINDOW]) (MACWINDOW.SETUP [LAMBDA (ORIGFN MACWINDOWFN ANYWHERE) (* ; "Edited 13-Feb-2021 19: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 MACORIG-.") (* ;; "If MACWINDOWFN 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 Mac 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 MACWINDOFN is provided, and the value specified here for ANYWHERE.") (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 'MACORIG- ORIGFN) PKGNAME)) (MOVD? ORIGFN RENAMEDORIG) (IF MACWINDOWFN THEN (MOVD MACWINDOWFN ORIGFN) ELSE (PUTD ORIGFN `(LAMBDA (WINDOW) (MACWINDOW.BUTTONEVENTFN WINDOW (FUNCTION ,RENAMEDORIG) ,ANYWHERE]) (UNMACWINDOW [LAMBDA (WINDOW) (* ; "Edited 7-Dec-2020 17:57 by rmk:") (* ;; "Restores original window behavior") (CL:WHEN (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN) (WINDOWPROP WINDOW 'BUTTONEVENTFN (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN)) (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN NIL)) WINDOW]) (MACWINDOW.UNSETUP [LAMBDA (ORIGFN) (* ; "Edited 6-Jul-2020 13:04 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 'MACORIG- ORIGFN) PKGNAME)) (CL:WHEN (GETD RENAMEDORIG) (MOVD RENAMEDORIG ORIGFN]) ) (RPAQ? MACWINDOWMARGIN 25) (* ;; "Internals") (DEFINEQ (MACWINDOW.BUTTONEVENTFN [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE) (* ; "Edited 14-Feb-2021 21:51 by rmk:") (* ; "Edited 24-Jun-2020 20:23 by rmk:") (* ; "Edited 23-May-2020 08:34 by rmk:") (* ; "Edited 10-May-2020 03:35 by rmk:") (* ; "Edited 3-May-2020 21:18 by rmk:") (IF (AND (MOUSESTATE (ONLY LEFT)) (EQ LASTKEYBOARD 0)) THEN (TOTOPW WINDOW) (LET [CORNER TOPMARGIN (MAINREGION (WINDOWPROP WINDOW 'REGION)) (ATTACHEDREGION (WINDOWREGION WINDOW 'SHAPEW] (* ;; "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 the modified ATTACHEDWINDOWTOTOPFN drives the click here. ") (SETQ TOPMARGIN (IF (WINDOWPROP WINDOW 'TOPMARGIN) ELSEIF (WINDOWPROP WINDOW 'TITLE) THEN (FONTPROP WindowTitleDisplayStream 'HEIGHT) ELSE MACWINDOWMARGIN)) (SETQ CORNER (INCORNER.REGION MAINREGION TOPMARGIN)) (IF CORNER 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 LEFT OF ATTACHEDREGION)) (RIGHT (FETCH RIGHT OF ATTACHEDREGION)) (TOP (FETCH TOP OF ATTACHEDREGION)) (BOTTOM (FETCH 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 WINDOW STARTINGREGION)) T ELSEIF (OR ANYWHERE (NEARTOP MAINREGION TOPMARGIN)) THEN (NEARESTCORNER ATTACHEDREGION) (MOVEW WINDOW) T ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN] THEN (APPLY* ORIGFUNCTION WINDOW))) ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN] THEN (APPLY* ORIGFUNCTION WINDOW]) (MACWINDOW.BUTTONEVENTFN.ANYWHERE [LAMBDA (WINDOW) (* ; "Edited 3-Dec-2020 14:24 by rmk:") (* ; "Edited 24-Jun-2020 13:24 by rmk:") (* ;; "Move if left-click anywhere, not just titlebar") (MACWINDOW.BUTTONEVENTFN WINDOW NIL T]) (NEARTOP [LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 12-Feb-2021 23:19 by rmk:") (* ;; "True if the MOUSEY is near the top of MAINREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)") (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF MAINREGION) TOPMARGIN]) (NEARESTCORNER [LAMBDA (REGION) (* ; "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") (\CURSORPOSITION (CL:IF (ILESSP (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF REGION)) (IDIFFERENCE (FETCH RIGHT OF REGION) LASTMOUSEX)) (FETCH LEFT OF REGION) (FETCH RIGHT OF REGION)) (CL:IF (ILESSP (IDIFFERENCE LASTMOUSEY (FETCH BOTTOM OF REGION)) (IDIFFERENCE (FETCH TOP OF REGION) LASTMOUSEY)) (FETCH BOTTOM OF REGION) (FETCH TOP OF REGION))]) (INCORNER.REGION [LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 12-Feb-2021 23:22 by rmk:") (* ;; "MAINREGION, 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 MAINREGION))) MACWINDOWMARGIN) THEN (IF (NEARTOP MAINREGION TOPMARGIN) THEN 'LEFTTOP ELSEIF (ILEQ LASTMOUSEY (IPLUS MACWINDOWMARGIN (FETCH BOTTOM OF MAINREGION ))) THEN 'LEFTBOTTOM) ELSEIF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH RIGHT OF MAINREGION))) MACWINDOWMARGIN) THEN (IF (NEARTOP MAINREGION TOPMARGIN) THEN 'RIGHTTOP ELSEIF (ILEQ LASTMOUSEY (IPLUS MACWINDOWMARGIN (FETCH BOTTOM OF MAINREGION ))) THEN 'RIGHTBOTTOM]) ) (* ;; "Behavior for some known window creators") (DEFINEQ (MACINT-ADD-EXEC [LAMBDA U (* ; "Edited 24-Jun-2020 14:23 by rmk:") (LET [(PROC (APPLY (FUNCTION MACORIG-ADD-EXEC) (FOR N FROM 1 TO U COLLECT (ARG U N] (* ;; "For some reason, the window may not be there immediately") (DISMISS 100) (MACWINDOW (PROCESSPROP PROC 'WINDOW)) PROC]) (MACINT-SNAPW [LAMBDA NIL (* ; "Edited 24-Jun-2020 13:19 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 (MACORIG-SNAPW))) [WINDOWPROP W 'BUTTONEVENTFN (FUNCTION (LAMBDA (W) (TOTOPW W) (MOVEW W] W]) ) (DEFINEQ (TEDIT.MACINTERFACE [LAMBDA NIL (* ; "Edited 8-Aug-2020 07:58 by rmk:") (MACWINDOW.SETUP '\TEDIT.BUTTONEVENTFN) (* ;; "All") (TEDIT.SETFUNCTION (CHARCODE "1,a") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,A") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (* ;; "Quit") (TEDIT.SETFUNCTION (CHARCODE "1,q") (FUNCTION TEDIT.QUIT) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,Q") (FUNCTION TEDIT.QUIT) TEDIT.READTABLE]) (TEDIT.SELECTALL [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (CL:WHEN TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of (TEXTOBJ TEXTSTREAM))) 'LEFT))]) ) (DEFINEQ (FB.MAKEHEADINGWINDOW.MACINTERFACE [LAMBDA (BROWSERWINDOW WIDTH HEIGHT FONT) (* ; "Edited 13-Feb-2021 23:21 by rmk:") (* ;; "This makes the heading window for a filebrowser, the little black window that has the column headings over the main window. It looks like a titlebar of the main window, our goal here is to make clicking in the heading window behave as if the click had happened in a true title window, so that corners will cause a SHAPE and middle will cause a MOVE. This is achieved by replacing the TOTOPW BUTTONEVENTFN of this window by a function that does the TOTOPW and then invokes the BUTTONEVENTFN of the main window") (* ;; "This function essentially advises the FB.MAKEHEADINGWINDOW in FILEBROWSER--works only if FILEBROWSER was loaded first.") (LET ((HW (MACORIG-FB.MAKEHEADINGWINDOW BROWSERWINDOW WIDTH HEIGHT FONT))) (* ;; "We also mark the height of the attached %"title%" window as the TOPMARGIN of the main window, so that MACWINDOW.BUTTONEVENTFN knows to look outside the putative region.") (WINDOWPROP HW 'BUTTONEVENTFN 'TOTOPW.MACINTERFACE) (WINDOWPROP BROWSERWINDOW 'TOPMARGIN 0) HW]) (TOTOPW.MACINTERFACE [LAMBDA (WINDOW) (* ; "Edited 13-Feb-2021 23:27 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 (MACWINDOW.BUTTONEVENTFN MAIN (WINDOWPROP MAIN 'BUTTONEVENTFN)))]) ) (DECLARE%: DONTEVAL@LOAD DOCOPY (TEDIT.MACINTERFACE) (* ;; "Inspector") (MACWINDOW.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") (* (MACWINDOW.SETUP  (QUOTE ONEDINSPECT.BUTTONEVENTFN))) (MACWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN) (* ;; "Freemenu") (MACWINDOW.SETUP '\FM.BUTTONEVENTFN) (* ;; "SEDIT") (MACWINDOW.SETUP 'SEDIT::BUTTONEVENTFN) (* ;; "Debugger") (MACWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT) (* ;; "Snap") (MACWINDOW.SETUP 'SNAPW 'MACINT-SNAPW) (* ;; "New execs") (MACWINDOW.SETUP 'ADD-EXEC 'MACINT-ADD-EXEC) (* ;; "Existing exec of the load") (MACWINDOW (PROCESSPROP (TTY.PROCESS) 'WINDOW)) (* ;; "Table browser (specialized to filebrowser)") (MACWINDOW.SETUP 'FB.MAKEHEADINGWINDOW 'FB.MAKEHEADINGWINDOW.MACINTERFACE) (MACWINDOW.SETUP 'TB.BUTTONEVENTFN) (* ;; "Grapher") (MACWINDOW.SETUP 'APPLYTOSELECTEDNODE) (* ;; "Promptwindow") (MACWINDOW PROMPTWINDOW T) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA MACINT-ADD-EXEC) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (4304 8063 (MACWINDOW 4314 . 4955) (MACWINDOW.SETUP 4957 . 6873) (UNMACWINDOW 6875 . 7254) (MACWINDOW.UNSETUP 7256 . 8061)) (8123 16305 (MACWINDOW.BUTTONEVENTFN 8133 . 13155) ( MACWINDOW.BUTTONEVENTFN.ANYWHERE 13157 . 13522) (NEARTOP 13524 . 13960) (NEARESTCORNER 13962 . 14841) (INCORNER.REGION 14843 . 16303)) (16363 17340 (MACINT-ADD-EXEC 16373 . 16797) (MACINT-SNAPW 16799 . 17338)) (17341 18300 (TEDIT.MACINTERFACE 17351 . 17969) (TEDIT.SELECTALL 17971 . 18298)) (18301 19950 (FB.MAKEHEADINGWINDOW.MACINTERFACE 18311 . 19518) (TOTOPW.MACINTERFACE 19520 . 19948))))) STOP \ No newline at end of file +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "22-Feb-2021 14:01:07"  {DSK}kaplan>Local>medley3.5>git-medley>lispusers>MACINTERFACE.;78 20371 changes to%: (VARS MACINTERFACECOMS) previous date%: "22-Feb-2021 12:56:21" {DSK}kaplan>Local>medley3.5>git-medley>lispusers>MACINTERFACE.;77) (PRETTYCOMPRINT MACINTERFACECOMS) (RPAQQ MACINTERFACECOMS [ (* ;; "Externals") (COMS (FNS MACWINDOW MACWINDOW.SETUP UNMACWINDOW MACWINDOW.UNSETUP) (INITVARS (MACWINDOWMARGIN 25))) (* ;; "Internals") [COMS (FNS MACWINDOW.BUTTONEVENTFN MACWINDOW.BUTTONEVENTFN.ANYWHERE NEARTOP NEARESTCORNER INCORNER.REGION) (* ;; "Behavior for some known window creators") (FNS MACINT-ADD-EXEC MACINT-SNAPW) (FNS TEDIT.MACINTERFACE TEDIT.SELECTALL) (FNS TOTOPW.MACINTERFACE) (P (MOVD 'TOTOPW.MACINTERFACE 'TOTOPW.MODERNIZE) (MOVD 'MACWINDOW 'MODERNWINDOW) (MOVD 'UNMACWINDOW 'UNMODERNWINDOW)) (DECLARE%: DONTEVAL@LOAD DOCOPY (P (TEDIT.MACINTERFACE) (* ;; "Inspector") (MACWINDOW.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") (* (MACWINDOW.SETUP 'ONEDINSPECT.BUTTONEVENTFN)) (MACWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN) (* ;; "Freemenu") (MACWINDOW.SETUP '\FM.BUTTONEVENTFN) (* ;; "SEDIT") (MACWINDOW.SETUP 'SEDIT::BUTTONEVENTFN) (* ;; "Debugger") (MACWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT) (* ;; "Snap") (MACWINDOW.SETUP 'SNAPW 'MACINT-SNAPW) (* ;; "New execs") (MACWINDOW.SETUP 'ADD-EXEC 'MACINT-ADD-EXEC) (* ;; "Existing exec of the load") (MACWINDOW (PROCESSPROP (TTY.PROCESS) 'WINDOW)) (* ;; "Table browser (for filebrowser)") (MACWINDOW.SETUP 'TB.BUTTONEVENTFN) (* ;; "Grapher") (MACWINDOW.SETUP 'APPLYTOSELECTEDNODE) (* ;; "Promptwindow") (MACWINDOW PROMPTWINDOW T] (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA) (NLAML) (LAMA MACINT-ADD-EXEC]) (* ;; "Externals") (DEFINEQ (MACWINDOW [LAMBDA (WINDOW ANYWHERE) (* ; "Edited 23-Jun-2020 16:01 by rmk:") (* ;; "This can be applied to windows that have been created with an unknown or unmodifiable buttoneventfn.") (CL:UNLESS (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN) (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN (WINDOWPROP WINDOW 'BUTTONEVENTFN)) (WINDOWPROP WINDOW 'BUTTONEVENTFN (IF ANYWHERE THEN (FUNCTION MACWINDOW.BUTTONEVENTFN.ANYWHERE) ELSE (FUNCTION MACWINDOW.BUTTONEVENTFN)))) WINDOW]) (MACWINDOW.SETUP [LAMBDA (ORIGFN MACWINDOWFN ANYWHERE) (* ; "Edited 13-Feb-2021 19: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 MACORIG-.") (* ;; "If MACWINDOWFN 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 Mac 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 MACWINDOFN is provided, and the value specified here for ANYWHERE.") (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 'MACORIG- ORIGFN) PKGNAME)) (MOVD? ORIGFN RENAMEDORIG) (IF MACWINDOWFN THEN (MOVD MACWINDOWFN ORIGFN) ELSE (PUTD ORIGFN `(LAMBDA (WINDOW) (MACWINDOW.BUTTONEVENTFN WINDOW (FUNCTION ,RENAMEDORIG) ,ANYWHERE]) (UNMACWINDOW [LAMBDA (WINDOW) (* ; "Edited 7-Dec-2020 17:57 by rmk:") (* ;; "Restores original window behavior") (CL:WHEN (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN) (WINDOWPROP WINDOW 'BUTTONEVENTFN (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN)) (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN NIL)) WINDOW]) (MACWINDOW.UNSETUP [LAMBDA (ORIGFN) (* ; "Edited 6-Jul-2020 13:04 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 'MACORIG- ORIGFN) PKGNAME)) (CL:WHEN (GETD RENAMEDORIG) (MOVD RENAMEDORIG ORIGFN]) ) (RPAQ? MACWINDOWMARGIN 25) (* ;; "Internals") (DEFINEQ (MACWINDOW.BUTTONEVENTFN [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE) (* ; "Edited 14-Feb-2021 21:51 by rmk:") (* ; "Edited 24-Jun-2020 20:23 by rmk:") (* ; "Edited 23-May-2020 08:34 by rmk:") (* ; "Edited 10-May-2020 03:35 by rmk:") (* ; "Edited 3-May-2020 21:18 by rmk:") (IF (AND (MOUSESTATE (ONLY LEFT)) (EQ LASTKEYBOARD 0)) THEN (TOTOPW WINDOW) (LET [CORNER TOPMARGIN (MAINREGION (WINDOWPROP WINDOW 'REGION)) (ATTACHEDREGION (WINDOWREGION WINDOW 'SHAPEW] (* ;; "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 the modified ATTACHEDWINDOWTOTOPFN drives the click here. ") (SETQ TOPMARGIN (IF (WINDOWPROP WINDOW 'TOPMARGIN) ELSEIF (WINDOWPROP WINDOW 'TITLE) THEN (FONTPROP WindowTitleDisplayStream 'HEIGHT) ELSE MACWINDOWMARGIN)) (SETQ CORNER (INCORNER.REGION MAINREGION TOPMARGIN)) (IF CORNER 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 LEFT OF ATTACHEDREGION)) (RIGHT (FETCH RIGHT OF ATTACHEDREGION)) (TOP (FETCH TOP OF ATTACHEDREGION)) (BOTTOM (FETCH 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 WINDOW STARTINGREGION)) T ELSEIF (OR ANYWHERE (NEARTOP MAINREGION TOPMARGIN)) THEN (NEARESTCORNER ATTACHEDREGION) (MOVEW WINDOW) T ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN] THEN (APPLY* ORIGFUNCTION WINDOW))) ELSEIF [OR ORIGFUNCTION (SETQ ORIGFUNCTION (WINDOWPROP WINDOW 'PREMACBUTTONEVENTFN] THEN (APPLY* ORIGFUNCTION WINDOW]) (MACWINDOW.BUTTONEVENTFN.ANYWHERE [LAMBDA (WINDOW) (* ; "Edited 3-Dec-2020 14:24 by rmk:") (* ; "Edited 24-Jun-2020 13:24 by rmk:") (* ;; "Move if left-click anywhere, not just titlebar") (MACWINDOW.BUTTONEVENTFN WINDOW NIL T]) (NEARTOP [LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 12-Feb-2021 23:19 by rmk:") (* ;; "True if the MOUSEY is near the top of MAINREGION. That means in the title bar for titled windows, otherwise a short distance below the top of the window. (Could be in the border?)") (IGREATERP LASTMOUSEY (IDIFFERENCE (FETCH TOP OF MAINREGION) TOPMARGIN]) (NEARESTCORNER [LAMBDA (REGION) (* ; "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") (\CURSORPOSITION (CL:IF (ILESSP (IDIFFERENCE LASTMOUSEX (FETCH LEFT OF REGION)) (IDIFFERENCE (FETCH RIGHT OF REGION) LASTMOUSEX)) (FETCH LEFT OF REGION) (FETCH RIGHT OF REGION)) (CL:IF (ILESSP (IDIFFERENCE LASTMOUSEY (FETCH BOTTOM OF REGION)) (IDIFFERENCE (FETCH TOP OF REGION) LASTMOUSEY)) (FETCH BOTTOM OF REGION) (FETCH TOP OF REGION))]) (INCORNER.REGION [LAMBDA (MAINREGION TOPMARGIN) (* ; "Edited 12-Feb-2021 23:22 by rmk:") (* ;; "MAINREGION, 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 MAINREGION))) MACWINDOWMARGIN) THEN (IF (NEARTOP MAINREGION TOPMARGIN) THEN 'LEFTTOP ELSEIF (ILEQ LASTMOUSEY (IPLUS MACWINDOWMARGIN (FETCH BOTTOM OF MAINREGION ))) THEN 'LEFTBOTTOM) ELSEIF (ILEQ (IABS (IDIFFERENCE LASTMOUSEX (FETCH RIGHT OF MAINREGION))) MACWINDOWMARGIN) THEN (IF (NEARTOP MAINREGION TOPMARGIN) THEN 'RIGHTTOP ELSEIF (ILEQ LASTMOUSEY (IPLUS MACWINDOWMARGIN (FETCH BOTTOM OF MAINREGION ))) THEN 'RIGHTBOTTOM]) ) (* ;; "Behavior for some known window creators") (DEFINEQ (MACINT-ADD-EXEC [LAMBDA U (* ; "Edited 24-Jun-2020 14:23 by rmk:") (LET [(PROC (APPLY (FUNCTION MACORIG-ADD-EXEC) (FOR N FROM 1 TO U COLLECT (ARG U N] (* ;; "For some reason, the window may not be there immediately") (DISMISS 100) (MACWINDOW (PROCESSPROP PROC 'WINDOW)) PROC]) (MACINT-SNAPW [LAMBDA NIL (* ; "Edited 24-Jun-2020 13:19 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 (MACORIG-SNAPW))) [WINDOWPROP W 'BUTTONEVENTFN (FUNCTION (LAMBDA (W) (TOTOPW W) (MOVEW W] W]) ) (DEFINEQ (TEDIT.MACINTERFACE [LAMBDA NIL (* ; "Edited 22-Feb-2021 12:56 by rmk:") (CL:WHEN (GETD '\TEDIT.BUTTONEVENTFN) (MACWINDOW.SETUP '\TEDIT.BUTTONEVENTFN) (* ;; "All") (TEDIT.SETFUNCTION (CHARCODE "1,a") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,A") (FUNCTION TEDIT.SELECTALL) TEDIT.READTABLE) (* ;; "Quit") (TEDIT.SETFUNCTION (CHARCODE "1,q") (FUNCTION TEDIT.QUIT) TEDIT.READTABLE) (TEDIT.SETFUNCTION (CHARCODE "1,Q") (FUNCTION TEDIT.QUIT) TEDIT.READTABLE))]) (TEDIT.SELECTALL [LAMBDA (STREAM TEXTOBJ SEL) (* ; "Edited 3-May-2020 17:29 by rmk:") (LET [(TEXTSTREAM (TEXTSTREAM (TTY.PROCESS] (CL:WHEN TEXTSTREAM (TEDIT.SETSEL TEXTSTREAM 0 (ADD1 (fetch TEXTLEN of (TEXTOBJ TEXTSTREAM))) 'LEFT))]) ) (DEFINEQ (TOTOPW.MACINTERFACE [LAMBDA (WINDOW) (* ; "Edited 13-Feb-2021 23:27 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 (MACWINDOW.BUTTONEVENTFN MAIN (WINDOWPROP MAIN 'BUTTONEVENTFN)))]) ) (MOVD 'TOTOPW.MACINTERFACE 'TOTOPW.MODERNIZE) (MOVD 'MACWINDOW 'MODERNWINDOW) (MOVD 'UNMACWINDOW 'UNMODERNWINDOW) (DECLARE%: DONTEVAL@LOAD DOCOPY (TEDIT.MACINTERFACE) (* ;; "Inspector") (MACWINDOW.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") (* (MACWINDOW.SETUP  (QUOTE ONEDINSPECT.BUTTONEVENTFN))) (MACWINDOW.SETUP 'ICMLARRAY.TITLECOMMANDFN) (* ;; "Freemenu") (MACWINDOW.SETUP '\FM.BUTTONEVENTFN) (* ;; "SEDIT") (MACWINDOW.SETUP 'SEDIT::BUTTONEVENTFN) (* ;; "Debugger") (MACWINDOW.SETUP 'DBG::DEBUGGER-BUTTON-EVENT) (* ;; "Snap") (MACWINDOW.SETUP 'SNAPW 'MACINT-SNAPW) (* ;; "New execs") (MACWINDOW.SETUP 'ADD-EXEC 'MACINT-ADD-EXEC) (* ;; "Existing exec of the load") (MACWINDOW (PROCESSPROP (TTY.PROCESS) 'WINDOW)) (* ;; "Table browser (for filebrowser)") (MACWINDOW.SETUP 'TB.BUTTONEVENTFN) (* ;; "Grapher") (MACWINDOW.SETUP 'APPLYTOSELECTEDNODE) (* ;; "Promptwindow") (MACWINDOW PROMPTWINDOW T) ) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDTOVAR NLAMA ) (ADDTOVAR NLAML ) (ADDTOVAR LAMA MACINT-ADD-EXEC) ) (DECLARE%: DONTCOPY (FILEMAP (NIL (4238 7997 (MACWINDOW 4248 . 4889) (MACWINDOW.SETUP 4891 . 6807) (UNMACWINDOW 6809 . 7188) (MACWINDOW.UNSETUP 7190 . 7995)) (8057 16239 (MACWINDOW.BUTTONEVENTFN 8067 . 13089) ( MACWINDOW.BUTTONEVENTFN.ANYWHERE 13091 . 13456) (NEARTOP 13458 . 13894) (NEARESTCORNER 13896 . 14775) (INCORNER.REGION 14777 . 16237)) (16297 17274 (MACINT-ADD-EXEC 16307 . 16731) (MACINT-SNAPW 16733 . 17272)) (17275 18358 (TEDIT.MACINTERFACE 17285 . 18027) (TEDIT.SELECTALL 18029 . 18356)) (18359 18799 (TOTOPW.MACINTERFACE 18369 . 18797))))) STOP \ No newline at end of file diff --git a/lispusers/MACINTERFACE.LCOM b/lispusers/MACINTERFACE.LCOM index 71a2a9eeed84acc4a890206543d6d9b489b420fe..c01be2b83571d4cc166bcddd0e1eb550f0101e16 100644 GIT binary patch delta 801 zcmah_zi-n(7>!eP0Lh3Zl?iE)K1BjKL#^130P9AD7j;6=M@c@QnDA{3u6rO@CC}7S;Bk)fr(QFE7 zB|#8M(CDK$+JsVt+$R`%naEic1lGJ_0V zx0c%{gZ#dWvZ_j2Tls8FPL67w9@~tvEavo==+v&|7;aba5e_`4!=Zsp%Rz=mLs6?V zkA;O+U|~?ybXAovDj(70SZ_8#s$YY|8XT@9o(34Z4(cEWn+{YdyqQRoFZulY+}HR= z{&|)-9LIXV+iu4Iz7@EbG`Yfjc|pKp7rS0puw4VS9qRy<%V{S1mxbc1mKAjsaGf1E zm)S4*ECmzwzb*8|K;($y$XiZkSfUpSYuW6rHIW6Dv&t%SWlnm81$$8r}>8Wi*BX-Y~C)85kZ;;-U$*lZu)`OEry~ zF5ODr+LaoA09%c5(Vc(7zu?+L-+*l)nOVG?d)~X}+)q?_$>3M*brn*&*@ggXg`@Y@_%yEo_a=0sjj7%-E0kC!D9DGD3qGVI z`;bLwXcdQ;Rm<^YJ59c*QvCn0)gcse=dKSXrF`kfvxd6DHq zKf-!>qoHkM18Y@c)+TQ3PbhY3I6y!K-7+Z$5*V1&3=bl3NR=8KWua_aP8-|P8Pg!# z=W$#uY30gIfqy|!F!nt#ITk%sn!pzmY%B{Yxd_b;o%T0vs|iwJO6+)BPnb