(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) (FILECREATED "27-Jan-2024 13:38:15" {DSK}frank>il>medley>gmedley>lispusers>MODERNIZE.;7 30816 :CHANGES-TO (FNS \MODERNIZED.TEDIT.BUTTONEVENTFN) :PREVIOUS-DATE "27-Jan-2024 13:28:36" {DSK}frank>il>medley>gmedley>lispusers>MODERNIZE.;6 ) (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 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) (bind PANE _ (CENTRALWINDOW W) collect (WINDOWPROP PANE 'REGION) repeatwhile (SETQ PANE (WINDOWPROP PANE 'TEDIT-NEXT-PANE-DOWN] (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 (5095 11457 (MODERNWINDOW 5105 . 6645) (MODERNWINDOW.SETUP 6647 . 9596) (UNMODERNWINDOW 9598 . 9992) (MODERNWINDOW.UNSETUP 9994 . 10806) (\MODERNIZED.FREEMENU.BUTTONEVENTFN 10808 . 11455)) ( 11522 22488 (MODERNWINDOW.BUTTONEVENTFN 11532 . 18559) (NEARTOP 18561 . 19489) (NEARESTCORNER 19491 . 21358) (INCORNER.REGION 21360 . 22486)) (22546 25018 (MODERN-ADD-EXEC 22556 . 22987) (MODERN-SNAPW 22989 . 23532) (TOTOPW.MODERNIZE 23534 . 23962) (MODERN-MENUBUTTONFN 23964 . 25016)) (25019 27448 ( \MODERNIZED.FREEMENU.BUTTONEVENTFN 25029 . 25676) (MODERNIZED.TB.BUTTONEVENTFN 25678 . 27446)) (27489 29055 (TEDIT.MODERNIZE 27499 . 27852) (\MODERNIZED.TEDIT.BUTTONEVENTFN 27854 . 29053))))) STOP