From 43706dc31128a82bcd50c3ccba364f6cafdc95ba Mon Sep 17 00:00:00 2001
From: rmkaplan <ron.kaplan@post.harvard.edu>
Date: Mon, 15 Feb 2021 20:31:14 -0800
Subject: [PATCH] First commit of wheel-mouse scrolling

---
 lispusers/WHEELSCROLL      |   1 +
 lispusers/WHEELSCROLL.LCOM | Bin 0 -> 2313 bytes
 2 files changed, 1 insertion(+)
 create mode 100644 lispusers/WHEELSCROLL
 create mode 100644 lispusers/WHEELSCROLL.LCOM

diff --git a/lispusers/WHEELSCROLL b/lispusers/WHEELSCROLL
new file mode 100644
index 00000000..d2a49393
--- /dev/null
+++ b/lispusers/WHEELSCROLL
@@ -0,0 +1 @@
+(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP")

(FILECREATED "15-Feb-2021 18:24:12" 
{DSK}<Users>kaplan>Local>medley3.5>git-medley>lispusers>WHEELSCROLL.;1
 3088   

      changes to%:  (VARS WHEELSCROLLCOMS)
                    (FNS ENABLEWHEELSCROLL INSTALL-WHEELSCROLL)

      previous date%: "15-Feb-2021 16:52:28" {DSK}<Users>kaplan>lisp>WHEELSCROLL.;8)


(PRETTYCOMPRINT WHEELSCROLLCOMS)

(RPAQQ WHEELSCROLLCOMS
 [(FNS ENABLEWHEELSCROLL WHEELSCROLL INSTALL-WHEELSCROLL 
                                 LISPINTERRUPTS.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 15-Feb-2021 16:23 by rmk:")

    (LET ((W (WHICHW)))
         (CL:WHEN W
             (SCROLLW W 0 (CL:IF UP
                              (IMINUS WHEELSCROLLDELTA)
                              WHEELSCROLLDELTA)))])

(INSTALL-WHEELSCROLL

  [LAMBDA NIL
                                           (* ; "Edited 15-Feb-2021 18:18 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)
    (CL:WHEN (BOUNDP 'TEDIT.READTABLE)

        (* ;; 

 "This doesn't seem to help the fact that it doesn't scroll when the caret is in the Tedit window.")


        (TEDIT.SETFUNCTION 520 [FUNCTION (LAMBDA NIL
                                           (WHEELSCROLL
 T]
               TEDIT.READTABLE)
        (TEDIT.SETFUNCTION 521 [FUNCTION (LAMBDA NIL
                                           (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])
)

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

(INSTALL-WHEELSCROLL
)

(ENABLEWHEELSCROLL
 T)
)
(DECLARE%: DONTCOPY
  (FILEMAP (NIL (792 2943 (ENABLEWHEELSCROLL 802 . 1227) (WHEELSCROLL 1229 . 1538) (INSTALL-WHEELSCROLL 
1540 . 2590) (LISPINTERRUPTS.WHEELSCROLL 2592 . 2941)))))
STOP
\ No newline at end of file
diff --git a/lispusers/WHEELSCROLL.LCOM b/lispusers/WHEELSCROLL.LCOM
new file mode 100644
index 0000000000000000000000000000000000000000..f9f48f1dcff73a227a2a63755d6b0799db37e38c
GIT binary patch
literal 2313
zcmb_d!EW0|5T$ZTS`bLDJ_Hj2LCJ#%?oyN}rBJ*kS2kgqq)Ez#fm~Eeu+=J(V95o7
zqCo$l*B<)?LGSsF{!M3>mc63X1_f%!lx8^lW@qNjj2ZGll<?*tig`0i1}VJCISWg6
z6mu}5q~v)V6`29AG8UY&<1MA7o8nx6CrTcILA>T*@_my!lmPL2wAFKc15D$3@nJcg
zO~$a8g8}-_VR8D)cf-}>Zq@&Bw49CR{djRbn)N?S#<R&s*Y^51({;0w`m^b3c`t1*
zPdJZ@AW!4ieoHKb>NeT(4*fZf@aK@8OA&u9{LQ`{!xY_}NlZXc7~IchP<&i1?$<zC
zPgk{V+ko+CjTbajJtaMl_FUKaa-2l?{eR*D*YSP0z8%ePCM#Gk-t@q{V0i($5`U1M
z6&9F-qyV0XS}E@!N{W)jaZ}M*u)Lf6G+o@UWT1$-U97f<lwz^=1tBWXSHSGIzNPQF
z?S;N>M&Ll2SfCwgn$|e{^!f(BwS{<mB_1{LWlgS$FEz96!YRLEK^dh9w0uQysUnch
zlYr&&T*z2R!S%&A0ZJ>mBSka-&j&L)PSTu%4b=||TJ9bt?SN@|NNN1H6k|fA-a);i
z=q<HQAd`||QZ7NHW|+YM2q?)6d0aBg*FmG9HJ*zUebdlR#=rk?_}lpWuV2r<7AnjG
zb)lmECA9E-6r5aIdJ@IDY3X|k&afwl^o};5N#N;=2P{v$z?V>H4dwPfqf|*4VE8yC
zqSAgGFc|h9TH}Ef684iJ86Y2$FQ4o3{MmEKrm0NK{MiddlC~8Npq&&mY4;foRk4Qp
z=j#oubh<&6f=nG2fV2q|;{Lsy7rbm@3!bqgEP#0JhZigiH)<R(STJe6rKLU`^D+a1
z?5VPWSc73w@w?mEqx1<JrNbo5phK{?aU$o#tPD<A4qm6GXi+#zFG8Sg`TY*M@V=Vx
zVTP<H$RaVZL!8%mapG531md*!O$|XJ3SHrKXQEUD>$K}N1-AoYV?1880BqE4jjiw>
zu(9fIi!_gpfwXHckoa}Wr;Q+bns@|E1=|9G13=Y4X+hiDR$+r!P&<ismj2Jqo?7CK
zXsHc(ZVwJN)WM(lk=&6iLISxhc+awoCpedAcPA7X^g}b^Hru+R1vrD0z~uGJEazo;
zg*?o1%(mLoay{r~p0V@ux*mtt{<Wdv?<qL^OFnQFMM+f3HKpED4mV_%g$5xHVwQ7U
zJz<I@zF_fToU#z5AkD78%)s0?$nfOus=?~uUlrgxHNZ!QxQTW-izoJB$uasj>i8oz

literal 0
HcmV?d00001