From fe1943865975a202f21077c888a9f30dc14245c5 Mon Sep 17 00:00:00 2001
From: rmkaplan <ron.kaplan@post.harvard.edu>
Date: Sun, 27 Dec 2020 12:09:32 -0800
Subject: [PATCH] Fix bug in MACINTERFACE for better (but not perfect) behavior
 with attached windows

---
 lispusers/MACINTERFACE      |   2 +-
 lispusers/MACINTERFACE.LCOM | Bin 5733 -> 6027 bytes
 2 files changed, 1 insertion(+), 1 deletion(-)

diff --git a/lispusers/MACINTERFACE b/lispusers/MACINTERFACE
index 6b135c9b..7546fc94 100644
--- a/lispusers/MACINTERFACE
+++ b/lispusers/MACINTERFACE
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED " 8-Aug-2020 15:48:17" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>MACINTERFACE.;52
 14335  

      changes to%:  (VARS MACINTERFACECOMS)

      previous date%: " 8-Aug-2020 08:01:06" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>MACINTERFACE.;51)


(PRETTYCOMPRINT MACINTERFACECOMS)

(RPAQQ MACINTERFACECOMS

       [
        (* ;; "Externals")


        (COMS (FNS MACWINDOW MACWINDOW.SETUP MACWINDOW.UNSETUP)
              (INITVARS (MACINTERFACECORNERMARGIN 25)))
        
        (* ;; "Internals")


        [COMS (FNS INTITLEBAR INCORNER MACWINDOW.BUTTONEVENTFN MACWINDOW.BUTTONEVENTFN.ANYWHERE)
              
              (* ;; "Behavior for some known window creators")


              (FNS MACINT-ADD-EXEC MACINT-SNAPW)
              (FNS TEDIT.MACINTERFACE TEDIT.SELECTALL)
              (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]
        (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 24-Jun-2020 15:09 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 write 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])

(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? MACINTERFACECORNERMARGIN
 25)



(* ;; "Internals")


(DEFINEQ

(INTITLEBAR

  [LAMBDA (WINDOW)
                                      (* ; "Edited  3-May-2020 20:38 by rmk:")

    (IGREATERP (LASTMOUSEY WINDOW)
           (FETCH
 TOP OF
 (DSPCLIPPINGREGION NIL WINDOW])

(INCORNER

  [LAMBDA (WINDOW MARGIN)
                               (* ; "Edited 13-May-2020 14:26 by rmk:")


                                                            (* ; "Edited 10-May-2020 12:41 by rmk:")


                                                            (* ; "Edited  3-May-2020 20:43 by rmk:")

    (CL:UNLESS MARGIN (SETQ MARGIN MACINTERFACECORNERMARGIN))
    (LET ((CR (DSPCLIPPINGREGION NIL WINDOW))
          (X (LASTMOUSEX WINDOW))
          (Y (LASTMOUSEY WINDOW)))
         (IF
 (ILEQ (IABS (IDIFFERENCE X (FETCH
 LEFT OF
 CR)))
                       MARGIN)
             THEN
 

                   (* ;; "GREATERP puts it in title bar")


                   (IF
 (IGREATERP Y (FETCH
 TOP OF
 CR))
                       THEN
 'LEFTTOP
                     ELSEIF
 (ILEQ (IABS (IDIFFERENCE Y (FETCH
 BOTTOM OF
 CR)))
                                      MARGIN)
                       THEN
 'LEFTBOTTOM)
           ELSEIF
 (ILEQ (IABS (IDIFFERENCE X (FETCH
 RIGHT OF
 CR)))
                            MARGIN)
             THEN
 (IF
 (IGREATERP Y (FETCH
 TOP OF
 CR))
                          THEN
 'RIGHTTOP
                        ELSEIF
 (ILEQ (IABS (IDIFFERENCE Y (FETCH
 BOTTOM OF
 CR)))
                                         MARGIN)
                          THEN
 'RIGHTBOTTOM])

(MACWINDOW.BUTTONEVENTFN

  [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE)
                (* ; "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 (REGION (CORNER (INCORNER
 WINDOW)))
                   (IF
 CORNER
                       THEN
 

                             (* ;; 

                     "The upper corners may be in the title bar, near the side, so test this first")


                             (SETQ REGION (WINDOWPROP WINDOW 'REGION))
                             [LET ((LEFT (FETCH
 LEFT OF
 REGION))
                                   (RIGHT (FETCH
 RIGHT OF
 REGION))
                                   (TOP (FETCH
 TOP OF
 REGION))
                                   (BOTTOM (FETCH
 BOTTOM OF
 REGION)))
                                  (SHAPEW WINDOW (GETREGION NIL NIL NIL NIL NIL
                                                        (SELECTQ CORNER
                                                            (RIGHTBOTTOM (LIST LEFT TOP RIGHT BOTTOM))
                                                            (LEFTBOTTOM (LIST RIGHT TOP LEFT BOTTOM))
                                                            (RIGHTTOP (LIST LEFT BOTTOM RIGHT TOP))
                                                            (LEFTTOP (LIST RIGHT BOTTOM LEFT TOP))
                                                            (SHOULDNT]
                             T
                     ELSEIF
 (OR ANYWHERE (INTITLEBAR
 WINDOW))
                       THEN
 (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 24-Jun-2020 13:24 by rmk:")


    (* ;; "Move if left-click anywhere, not just titlebar")


    (MACWINDOW.BUTTONEVENTFN
 NIL T])
)



(* ;; "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))])
)
(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))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 MACINT-ADD-EXEC)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (3345 6723 (MACWINDOW 3355 . 3996) (MACWINDOW.SETUP 3998 . 5914) (MACWINDOW.UNSETUP 5916
 . 6721)) (6792 11103 (INTITLEBAR 6802 . 7022) (INCORNER 7024 . 8439) (MACWINDOW.BUTTONEVENTFN 8441 . 
10850) (MACWINDOW.BUTTONEVENTFN.ANYWHERE 10852 . 11101)) (11161 12138 (MACINT-ADD-EXEC 11171 . 11595) 
(MACINT-SNAPW 11597 . 12136)) (12139 13098 (TEDIT.MACINTERFACE 12149 . 12767) (TEDIT.SELECTALL 12769
 . 13096)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "27-Dec-2020 12:06:04" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>MACINTERFACE.;54
 15486  

      previous date%: "13-Dec-2020 21:50:49" 
{DSK}<Users>kaplan>Local>medley3.5>lispcore>lispusers>MACINTERFACE.;57)


(PRETTYCOMPRINT MACINTERFACECOMS)

(RPAQQ MACINTERFACECOMS

       [
        (* ;; "Externals")


        (COMS (FNS MACWINDOW MACWINDOW.SETUP UNMACWINDOW MACWINDOW.UNSETUP)
              (INITVARS (MACINTERFACECORNERMARGIN 25)))
        
        (* ;; "Internals")


        [COMS (FNS INTITLEBAR INCORNER MACWINDOW.BUTTONEVENTFN MACWINDOW.BUTTONEVENTFN.ANYWHERE)
              
              (* ;; "Behavior for some known window creators")


              (FNS MACINT-ADD-EXEC MACINT-SNAPW)
              (FNS TEDIT.MACINTERFACE TEDIT.SELECTALL)
              (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]
        (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 24-Jun-2020 15:09 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 write 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? MACINTERFACECORNERMARGIN
 25)



(* ;; "Internals")


(DEFINEQ

(INTITLEBAR

  [LAMBDA (WINDOW)
                                      (* ; "Edited  3-May-2020 20:38 by rmk:")

    (IGREATERP (LASTMOUSEY WINDOW)
           (FETCH
 TOP OF
 (DSPCLIPPINGREGION NIL WINDOW])

(INCORNER

  [LAMBDA (WINDOW MARGIN)
                               (* ; "Edited 13-Dec-2020 21:45 by rmk:")


                                                            (* ; "Edited 13-May-2020 14:26 by rmk:")


                                                            (* ; "Edited 10-May-2020 12:41 by rmk:")


                                                            (* ; "Edited  3-May-2020 20:43 by rmk:")


    (* ;; "X and Y in window coordinates")


    (CL:UNLESS MARGIN (SETQ MARGIN MACINTERFACECORNERMARGIN))
    (LET ((CR (DSPCLIPPINGREGION NIL WINDOW))
          (X (LASTMOUSEX WINDOW))
          (Y (LASTMOUSEY WINDOW)))
         (IF
 (ILEQ (IABS (IDIFFERENCE X (FETCH
 LEFT OF
 CR)))
                       MARGIN)
             THEN
 

                   (* ;; "GREATERP puts it in title bar")


                   (IF
 (IGREATERP Y (FETCH
 TOP OF
 CR))
                       THEN
 'LEFTTOP
                     ELSEIF
 (ILEQ (IABS (IDIFFERENCE Y (FETCH
 BOTTOM OF
 CR)))
                                      MARGIN)
                       THEN
 'LEFTBOTTOM)
           ELSEIF
 (ILEQ (IABS (IDIFFERENCE X (FETCH
 RIGHT OF
 CR)))
                            MARGIN)
             THEN
 (IF
 (IGREATERP Y (FETCH
 TOP OF
 CR))
                          THEN
 'RIGHTTOP
                        ELSEIF
 (ILEQ (IABS (IDIFFERENCE Y (FETCH
 BOTTOM OF
 CR)))
                                         MARGIN)
                          THEN
 'RIGHTBOTTOM])

(MACWINDOW.BUTTONEVENTFN

  [LAMBDA (WINDOW ORIGFUNCTION ANYWHERE)
                (* ; "Edited 13-Dec-2020 20:35 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 (REGION CORNER (MOUSEX LASTMOUSEX)
                          (MOUSEY LASTMOUSEY))
                   (SETQ CORNER (INCORNER
 WINDOW))
                   (IF
 CORNER
                       THEN
 

                             (* ;; 

       "The upper corners may be in the title bar, near the side, so test corners before titlebar.")


                             (* ;; "WINDOWREGION includes the attached windows")


                             (SETQ REGION (WINDOWREGION WINDOW 'SHAPEW))
                             (LET ((LEFT (FETCH
 LEFT OF
 REGION))
                                   (RIGHT (FETCH
 RIGHT OF
 REGION))
                                   (TOP (FETCH
 TOP OF
 REGION))
                                   (BOTTOM (FETCH
 BOTTOM OF
 REGION))
                                   STARTINGREGION)

                                  (* ;; 

                                "The  hot cornerr of the starting region is the mouse position")


                                  [SETQ STARTINGREGION
                                   (GETREGION NIL NIL NIL NIL NIL
                                          (SELECTQ CORNER
                                              (RIGHTBOTTOM (LIST LEFT TOP MOUSEX MOUSEY))
                                              (LEFTBOTTOM (LIST RIGHT TOP MOUSEX MOUSEY))
                                              (RIGHTTOP (LIST LEFT BOTTOM MOUSEX MOUSEY))
                                              (LEFTTOP (LIST RIGHT BOTTOM MOUSEX MOUSEY))
                                              (SHOULDNT]
                                  (SHAPEW WINDOW STARTINGREGION))
                             T
                     ELSEIF
 (OR ANYWHERE (INTITLEBAR
 WINDOW))
                       THEN
 (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])
)



(* ;; "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))])
)
(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))
)
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 )

(ADDTOVAR LAMA
 MACINT-ADD-EXEC)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (3314 7073 (MACWINDOW 3324 . 3965) (MACWINDOW.SETUP 3967 . 5883) (UNMACWINDOW 5885 . 
6264) (MACWINDOW.UNSETUP 6266 . 7071)) (7142 12254 (INTITLEBAR 7152 . 7372) (INCORNER 7374 . 8947) (
MACWINDOW.BUTTONEVENTFN 8949 . 11885) (MACWINDOW.BUTTONEVENTFN.ANYWHERE 11887 . 12252)) (12312 13289 (
MACINT-ADD-EXEC 12322 . 12746) (MACINT-SNAPW 12748 . 13287)) (13290 14249 (TEDIT.MACINTERFACE 13300 . 
13918) (TEDIT.SELECTALL 13920 . 14247)))))
STOP
\ No newline at end of file
diff --git a/lispusers/MACINTERFACE.LCOM b/lispusers/MACINTERFACE.LCOM
index e1341dda1a5eeb3e41822055a34849870653ac8a..72cc73fb3494ead7d92491498fbb494f4acfa099 100644
GIT binary patch
delta 1109
zcmZuwOK;Oa5Vn(2+EnfX6{++zSQJvJNximXC%KTc*`zLxZ8@8^JfzarQ4^HDpdfLI
zkb2`n<P#4GiC+NZ#wFrk^ahunIKY8BtnDOCA$u6jd^0;UJKyZt!pp^1#c5HE<tjTd
zQ4j?{Vp>qrDAn9jBD=NY*j~k{SDrWD&$4p!%k1{?&cWVc{gwl@ec<(c0g!xtHy)4k
z;A|aN9N_zLA(<8gnwFpEqIpfn%QnsuoCE&<!h+m9x_Pm%AOlLsNd*ocSDw`lo<8wQ
z%%y?jk#t^MMCpW(mQy^qn=EG4Rwnc_)F>Op?DD#1<ji$Q=aO7h0|5ei9vF#X7&fy@
zB@^+)=efY>gT_3(9RO9|$V@U(Sp}<1f;^UOS|G{)0AdOXn2ZM@<r22NF!x(%2FVC4
z8`HLy%7mB(Uc&~-8z9mQ17MT{*9wcR)TJxo?Ie^))+U-!uyH{%4X{9kC6lHpQdI#$
zJFy@EwpLgnRFgr+c~6mG*|ZI8Q&oiCT?9pwwsx1ILZEKACnF1utD_7P9`PUk(3ADc
zXZ4|9A3iZZeDjf~e$UV#hVcPkO!46Wy6;f;>%I}*bJ$gOH56h`_x_x&hCH>WPfd?h
z9eVCKJ`2CzwsnK7Xw_MIK4t^#P0{Egi`}?)ZQUI2qSv}{J?O;mo*VXB+?;G@%t?2D
zRBI>+kCcm?(7}s?P*J5LS;Olf(qEw&L?b$0%Gw|z0ZJ=bi+WJXC%H3El#-~!EbBRg
zfGTyitm8~5G>5B3ZZs5OAkU&iS85RdYQiVcqZTDP)cS@LI6Cwrqy)5gY=!Ph&?Vhf
zJzF9jsyX`Fp1I+EjXaq0R-esOYyNiA<yKp<vD-t}`@as?`$h4xQNpBb%|q0EF=3B#
Rnh~s)8ylNx{hl}){tE>w6r2D6

delta 805
zcmZuvJ#5oJ6pr0CYFZ*S5*4K|JVk0rq&E0$=XarQa%rydPh>l-kSal&SV>Ttg!~{n
zWnp80$P=)!uu^43Vn)oMijAQ&9ogWVi%KhT!`=73d-~qH@7>G$=NqrJn~>U62DMF5
z5CuT-jGW4#<mfQre&fQNIQq0YJnA}?_Hn1tbgJMy?{s@>8ECcp^+u}(jTVG8r`mK*
zK#Ij7KWH|=I_b3seYmO{i^alFJ?vA3@Kv7Hlf+D13`c{JJW+Ah#EOk`*OCJNx_Y|q
zb!CZwWJ!ucrGD6|IX&pNX-APg#k3%(DOsZ1*vu<goHaBn3Z1U=tkE9yCiQ9JwFZP#
zMnD-MF=Emj8vo{g@#FKkyEExHY#X+1Xix$fY@<X^2~4t6uqhHj#d!}PF!2sCbP5H?
z8m5j-w-VUkeSUWoxHbI#*hklsi}$C#uUi2Rvpp2z3Y2@rqA&i3RgQ3k=ee`vKWBvZ
z;3W>t&TZAJbQP*KPvPR-=Uug^)mQ2I_<&Jwi|X!_*}Rgrt`$|5x5Dz?6t!K(yqNd2
zf_`szj~2*KmSG3m`$W$f`(+E8C6m5c6w&`!Apx4PhxY-c(?AU;wu-kE6HqD*RzWFw
zH>ru<)E$&e(F>!j=5!n4NjM<7RW>oJ2C@XijV`Y7QrhKamS;qi@XjPkpo!0(`$!g<
z`;$Oq1DH+-3De22*!{71u;iJ|)f)@m`<8r>gnP=bj33>&H@i&#2&)?_>lU`lr6@##
W?uR8aKy)@iaDUF<9^VOd{C@#)Xw!ZG