From 6c8ef665bb820157da97bc0470a1a83ff17a8239 Mon Sep 17 00:00:00 2001
From: rmkaplan <ron.kaplan@post.harvard.edu>
Date: Tue, 16 Feb 2021 22:37:49 -0800
Subject: [PATCH] Tedit scrolling executed in mouse process

---
 lispusers/WHEELSCROLL      |   2 +-
 lispusers/WHEELSCROLL.LCOM | Bin 3267 -> 3301 bytes
 2 files changed, 1 insertion(+), 1 deletion(-)

diff --git a/lispusers/WHEELSCROLL b/lispusers/WHEELSCROLL
index 256f0ee4..e71d6c40 100644
--- a/lispusers/WHEELSCROLL
+++ b/lispusers/WHEELSCROLL
@@ -1 +1 @@
-(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "16-Feb-2021 15:37:58" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;7
 5064   

      changes to%:  (VARS WHEELSCROLLCOMS)
                    (FNS WHEELSCROLL \SCROLLBARTOMAIN? \TEDIT.WHEELSCROLL)

      previous date%: "16-Feb-2021 15:12:14" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;6)


(PRETTYCOMPRINT WHEELSCROLLCOMS)

(RPAQQ WHEELSCROLLCOMS
 [(FNS ENABLEWHEELSCROLL WHEELSCROLL INSTALL-WHEELSCROLL 
                                 LISPINTERRUPTS.WHEELSCROLL CREATESCROLLBARWINDOW \SCROLLBARTOMAIN?)
                            (FNS \TEDIT.WHEELSCROLL)
                            (INITVARS (WHEELSCROLLDELTA 10))
                            (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INSTALL-WHEELSCROLL)
                                                               (ENABLEWHEELSCROLL T])
(DEFINEQ

(ENABLEWHEELSCROLL

  [LAMBDA (ON
)
                                      (* ; "Edited 15-Feb-2021 18:17 by rmk:")


    (* ;; "So we can toggle this scrolling, for experimentation.")


    (IF
 ON
        THEN
 [KEYACTION 'PAD1 '((520 520) . IGNORE]
              [KEYACTION 'PAD2 '((521 521) . IGNORE]
      ELSE
 (KEYACTION 'PAD1 '(IGNORE . IGNORE))
            (KEYACTION 'PAD2 '(IGNORE . IGNORE])

(WHEELSCROLL

  [LAMBDA (UP)
                                          (* ; "Edited 16-Feb-2021 15:35 by rmk:")

    (LET ((W (\SCROLLBARTOMAIN?
)))
         (CL:WHEN W
             (SCROLLW W 0 (CL:IF UP
                              (IMINUS WHEELSCROLLDELTA)
                              WHEELSCROLLDELTA)))])

(INSTALL-WHEELSCROLL

  [LAMBDA NIL
                                           (* ; "Edited 16-Feb-2021 14:38 by rmk:")

    (CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL)
        (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG)
        (MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS))
    (INTERRUPTCHAR 520 '(WHEELSCROLL
 T)
           T)
    (INTERRUPTCHAR 521 '(WHEELSCROLL
 NIL)
           T)
    (CHANGENAME 'SCROLL.HANDLER 'CREATEW 'CREATESCROLLBARWINDOW)
    (CL:WHEN (BOUNDP 'TEDIT.READTABLE)

        (* ;; "These actions are invoked when the caret is in the Tedit window.  Otherwise the generic function is called on the Tedit window if the cursor is inside it.")


        (TEDIT.SETFUNCTION 520 [FUNCTION (LAMBDA NIL
                                           (\TEDIT.WHEELSCROLL
 T]
               TEDIT.READTABLE)
        (TEDIT.SETFUNCTION 521 [FUNCTION (LAMBDA NIL
                                           (\TEDIT.WHEELSCROLL
 NIL]
               TEDIT.READTABLE))
    (CL:WHEN (GETP 'SEDIT 'FILEDATES)
        (SEDIT:ADD-COMMAND 520 '(WHEELSCROLL
 T))
        (SEDIT:ADD-COMMAND 521 '(WHEELSCROLL
))
        (SEDIT:RESET-COMMANDS))])

(LISPINTERRUPTS.WHEELSCROLL

  [LAMBDA NIL
                                           (* ; "Edited 15-Feb-2021 14:50 by rmk:")


    (* ;; "So wheelscroll interrupts will be installed in every process")


    (APPEND [LIST (LIST 520 '(WHEELSCROLL
 T))
                  (LIST 521 '(WHEELSCROLL
]
           (LISPINTERRUPTS.WSORIG])

(CREATESCROLLBARWINDOW

  [LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS)
     (* ; "Edited 16-Feb-2021 14:37 by rmk:")


    (* ;; "This replaces CREATEW inside SCROLL.HANDLER.  WINDOW should be bound to the window that this scroll bar will control.  The purpose is to create an unreferenced (LOC) pointer from the controller to the controllee, so that wheel scrolling in the scrollbar can be redirected to the controllee.")


    (DECLARE
 (USEDFREE WINDOW))
    (LET ((SBW (CREATEW REGION TITLE BORDERSIZE NOOPENFLG PROPS)))
         (WINDOWPROP SBW 'CONTROLLEELOC (LOC WINDOW))
         SBW])

(\SCROLLBARTOMAIN?

  [LAMBDA NIL
                                           (* ; "Edited 16-Feb-2021 15:37 by rmk:")


    (* ;; "Returns the window that that should be wheel scrolled, moving from a scrollbar to its scrollee if necessary.")


    (LET ((W (WHICHW)))
         (CL:WHEN W
             (CL:WHEN (WINDOWPROP W 'CONTROLLEELOC)
                 [SETQ W (VAG (WINDOWPROP W 'CONTROLLEELOC]
                 (GETMOUSESTATE)
                 (\CURSORPOSITION [IPLUS 10 (FETCH
 LEFT OF
 (WINDOWPROP W 'REGION]
                        LASTMOUSEY)
                 (SETCURSOR DEFAULTCURSOR)
                 (GETMOUSESTATE)))
         W])
)
(DEFINEQ

(\TEDIT.WHEELSCROLL

  [LAMBDA (UP)
                                          (* ; "Edited 16-Feb-2021 15:35 by rmk:")


    (* ;; "Called from the TEDIT.READTABLE when the wheel moves and the caret is in the TEDIT (WHICHW) window.")


    (\TEDIT.SCROLLFN (\SCROLLBARTOMAIN?
)
           0
           (CL:IF UP
               (IMINUS WHEELSCROLLDELTA)
               WHEELSCROLLDELTA)])
)

(RPAQ? WHEELSCROLLDELTA
 10)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(INSTALL-WHEELSCROLL
)

(ENABLEWHEELSCROLL
 T)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (929 4504 (ENABLEWHEELSCROLL 939 . 1364) (WHEELSCROLL 1366 . 1690) (INSTALL-WHEELSCROLL 
1692 . 2873) (LISPINTERRUPTS.WHEELSCROLL 2875 . 3224) (CREATESCROLLBARWINDOW 3226 . 3839) (
\SCROLLBARTOMAIN? 3841 . 4502)) (4505 4919 (\TEDIT.WHEELSCROLL 4515 . 4917)))))
STOP
\ No newline at end of file
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "16-Feb-2021 22:36:05" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;11
 5620   

      changes to%:  (FNS \TEDIT.WHEELSCROLL \SCROLLBARTOMAIN?)

      previous date%: "16-Feb-2021 16:10:43" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;8)


(PRETTYCOMPRINT WHEELSCROLLCOMS)

(RPAQQ WHEELSCROLLCOMS
 [(FNS ENABLEWHEELSCROLL WHEELSCROLL INSTALL-WHEELSCROLL 
                                 LISPINTERRUPTS.WHEELSCROLL CREATESCROLLBARWINDOW \SCROLLBARTOMAIN?)
                            (FNS \TEDIT.WHEELSCROLL)
                            (INITVARS (WHEELSCROLLDELTA 10))
                            (DECLARE%: DONTEVAL@LOAD DOCOPY (P (INSTALL-WHEELSCROLL)
                                                               (ENABLEWHEELSCROLL T])
(DEFINEQ

(ENABLEWHEELSCROLL

  [LAMBDA (ON
)
                                      (* ; "Edited 15-Feb-2021 18:17 by rmk:")


    (* ;; "So we can toggle this scrolling, for experimentation.")


    (IF
 ON
        THEN
 [KEYACTION 'PAD1 '((520 520) . IGNORE]
              [KEYACTION 'PAD2 '((521 521) . IGNORE]
      ELSE
 (KEYACTION 'PAD1 '(IGNORE . IGNORE))
            (KEYACTION 'PAD2 '(IGNORE . IGNORE])

(WHEELSCROLL

  [LAMBDA (UP)
                                          (* ; "Edited 16-Feb-2021 15:35 by rmk:")

    (LET ((W (\SCROLLBARTOMAIN?
)))
         (CL:WHEN W
             (SCROLLW W 0 (CL:IF UP
                              (IMINUS WHEELSCROLLDELTA)
                              WHEELSCROLLDELTA)))])

(INSTALL-WHEELSCROLL

  [LAMBDA NIL
                                           (* ; "Edited 16-Feb-2021 14:38 by rmk:")

    (CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL)
        (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG)
        (MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS))
    (INTERRUPTCHAR 520 '(WHEELSCROLL
 T)
           T)
    (INTERRUPTCHAR 521 '(WHEELSCROLL
 NIL)
           T)
    (CHANGENAME 'SCROLL.HANDLER 'CREATEW 'CREATESCROLLBARWINDOW)
    (CL:WHEN (BOUNDP 'TEDIT.READTABLE)

        (* ;; "These actions are invoked when the caret is in the Tedit window.  Otherwise the generic function is called on the Tedit window if the cursor is inside it.")


        (TEDIT.SETFUNCTION 520 [FUNCTION (LAMBDA NIL
                                           (\TEDIT.WHEELSCROLL
 T]
               TEDIT.READTABLE)
        (TEDIT.SETFUNCTION 521 [FUNCTION (LAMBDA NIL
                                           (\TEDIT.WHEELSCROLL
 NIL]
               TEDIT.READTABLE))
    (CL:WHEN (GETP 'SEDIT 'FILEDATES)
        (SEDIT:ADD-COMMAND 520 '(WHEELSCROLL
 T))
        (SEDIT:ADD-COMMAND 521 '(WHEELSCROLL
))
        (SEDIT:RESET-COMMANDS))])

(LISPINTERRUPTS.WHEELSCROLL

  [LAMBDA NIL
                                           (* ; "Edited 15-Feb-2021 14:50 by rmk:")


    (* ;; "So wheelscroll interrupts will be installed in every process")


    (APPEND [LIST (LIST 520 '(WHEELSCROLL
 T))
                  (LIST 521 '(WHEELSCROLL
]
           (LISPINTERRUPTS.WSORIG])

(CREATESCROLLBARWINDOW

  [LAMBDA (REGION TITLE BORDERSIZE NOOPENFLG PROPS)
     (* ; "Edited 16-Feb-2021 14:37 by rmk:")


    (* ;; "This replaces CREATEW inside SCROLL.HANDLER.  WINDOW should be bound to the window that this scroll bar will control.  The purpose is to create an unreferenced (LOC) pointer from the controller to the controllee, so that wheel scrolling in the scrollbar can be redirected to the controllee.")


    (DECLARE
 (USEDFREE WINDOW))
    (LET ((SBW (CREATEW REGION TITLE BORDERSIZE NOOPENFLG PROPS)))
         (WINDOWPROP SBW 'CONTROLLEELOC (LOC WINDOW))
         SBW])

(\SCROLLBARTOMAIN?

  [LAMBDA NIL
                                           (* ; "Edited 16-Feb-2021 22:13 by rmk:")


    (* ;; "Returns the window that should be wheel scrolled, moving from a scrollbar to its scrollee if necessary.")


    (LET ((W (WHICHW)))
         (CL:WHEN W
             (CL:WHEN (WINDOWPROP W 'CONTROLLEELOC)
                 [SETQ W (VAG (WINDOWPROP W 'CONTROLLEELOC]
                 (GETMOUSESTATE)
                 (\CURSORPOSITION [IPLUS 10 (FETCH
 LEFT OF
 (WINDOWPROP W 'REGION]
                        LASTMOUSEY)
                 (SETCURSOR DEFAULTCURSOR)
                 (GETMOUSESTATE)))

         (* ;; "IN/SCROLL/BAR? in WINDOWSCROLL does nothing if the window doesn't have a SCROLLFN, even though SCROLLW applies SCROLLBYREPAINTFN as a default in that case.  So a direct call to SCROLLW might scroll a window that can't be scrolled by moving the mouse into the scrollbar (or so it seems).  If we don't exclude this, then odd things like menus would be scrolled that shouldn't be.")


         (AND (WINDOWPROP W 'SCROLLFN)
              W])
)
(DEFINEQ

(\TEDIT.WHEELSCROLL

  [LAMBDA (UP)
                                          (* ; "Edited 16-Feb-2021 22:35 by rmk:")


    (* ;; "Called from the TEDIT.READTABLE when the wheel moves and the caret is in the TEDIT (WHICHW) window or its scrollbar.")


    (LET ((WINDOW (\SCROLLBARTOMAIN?
)))
         (CL:WHEN WINDOW
             [PROCESS.EVAL (FIND.PROCESS 'MOUSE)
                    `(SCROLLW ,WINDOW 0 ,(CL:IF UP
                                             (IMINUS WHEELSCROLLDELTA)
                                             WHEELSCROLLDELTA)])])
)

(RPAQ? WHEELSCROLLDELTA
 10)
(DECLARE%: DONTEVAL@LOAD DOCOPY 

(INSTALL-WHEELSCROLL
)

(ENABLEWHEELSCROLL
 T)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (875 4891 (ENABLEWHEELSCROLL 885 . 1310) (WHEELSCROLL 1312 . 1636) (INSTALL-WHEELSCROLL 
1638 . 2819) (LISPINTERRUPTS.WHEELSCROLL 2821 . 3170) (CREATESCROLLBARWINDOW 3172 . 3785) (
\SCROLLBARTOMAIN? 3787 . 4889)) (4892 5475 (\TEDIT.WHEELSCROLL 4902 . 5473)))))
STOP
\ No newline at end of file
diff --git a/lispusers/WHEELSCROLL.LCOM b/lispusers/WHEELSCROLL.LCOM
index 16e609ed7adac2b132880cd1193583644c71d3af..4dca4a1dcb9ed46a749d9d56e26f087b90b278cf 100644
GIT binary patch
delta 376
zcmX>s`BZX3B!`iam9d$Xf$7A=2qr_riM#Z~VnSS9JVW%tJzQOVf}Ml>eS8!$^Ask_
zGU_w(PWE9mLTD-UP%<=BFf}tWP)N>5%u7!#Rw&6=wNlV<^9xqsg_<+@KclR=rb0nc
zYFTD}X|X~|Vo54cjgq06u3Ku7u91O}p@N~Am7#%^iSfij4@Qg4^O?T0$tEx|GB9v3
z0D&MQgGb6HuXGTb3q)+PoxGXTN@2eTCx~}aZVR)A0E32wg+h#{UvOxUYq+PMi+{Mn
z<d2-UIRg|76u|t+7nv36^?`;m!VTS`0yYzD3Yg`Q<uExV@Mc3`h7=Hh?E)HXVxkZb
z<nQbn9IWRW=IEmU^sO7v20f^tf{8*5B$%8WgF^g$9X<W*HF-6ROcfxa;R=SP3cmiK
N!LFK{^|_}o0sw`GTj&4)

delta 361
zcmaDVd028nB!{7?m9e>%sl~*^2uAaXyY=M4JzQOVf}Ml>eS8#RAheTXP>8>;qo<#}
z!sLlu!YrA23cM5l>rd8aG(zYv^r$yiFf}kUQAo~6%u7!#Rw&6=wNlUsa|{Yr;6*ak
z+21!<Q$fScFIWLd6pLLkA+9c-A$mxPG!+VpQp+;)ON$j!5=&Bn#`7u}n(4ZwCg~a(
z81Wb?0DWU<WMycgq%b*$(Us9`a{|+MHrY@{Mg|5B1|Se*WbjDY<e3g)bAgCWHj_&@
ztynw+7&IoI<Gk(VsbHWG8ld0?q>$`&arFst)Kp*)VPIrn1RIp)FgYdQW<vls$Pl1r
XLvsbFb0I<I<~R8cv+U+j?g@+l%?w>I