From a8a9b69e948887b46e491a2729dadd657060d508 Mon Sep 17 00:00:00 2001 From: rmkaplan Date: Tue, 16 Feb 2021 15:44:08 -0800 Subject: [PATCH] Better behavior when the wheel moves inside a scroll bar --- lispusers/WHEELSCROLL | 2 +- lispusers/WHEELSCROLL.LCOM | Bin 2313 -> 3267 bytes 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/lispusers/WHEELSCROLL b/lispusers/WHEELSCROLL index d2a49393..256f0ee4 100644 --- a/lispusers/WHEELSCROLL +++ b/lispusers/WHEELSCROLL @@ -1 +1 @@ -(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "15-Feb-2021 18:24:12"  {DSK}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}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 +(DEFINE-FILE-INFO READTABLE "INTERLISP" PACKAGE "INTERLISP") (FILECREATED "16-Feb-2021 15:37:58"  {DSK}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}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 diff --git a/lispusers/WHEELSCROLL.LCOM b/lispusers/WHEELSCROLL.LCOM index f9f48f1dcff73a227a2a63755d6b0799db37e38c..16e609ed7adac2b132880cd1193583644c71d3af 100644 GIT binary patch delta 1342 zcmZ`(OK;Oa5VlJiN|7Z>LA(TvDj^a0)0$d70>VXUV13(<$pD; z#xKLNpgt29MuXPxgR%8vX?DC$ed}STSc9tR*z%Qr?#$?^|E8AT^^-@9Ir4WpVl{|8 z2Xba&R$kXF-FaJ^80a%&S>%U37xxZ9%1ec_@>JpUi0$dy@>!ubeOtpz-Q=gjie8uJ zCyx$l4kTH34cGVQy|CMLxevst?B=!W(54~+Qn4T(NkT;{<(^<62SRGQc})V%Fy(#( z3k1B5%iEN@T?#b?+Th=@_Jqyh~JE5lVGhM3^4DkF5BpHZy6Qt8vToJa3kbvyXe@ihC$k8pG(uAuB_n?p zzYTUz*YN8`DFPFcW*->X5XE7X;9CWF7)F%0f;L(fwjKL4PS`byCIP_&qGWh5rtNHC zEp+A(%b?Bax;A;mZF;^jnejBEYlDs=tG6$+_h+}x0j*RqAxcGlE~^Yy6@t(MV*c*3 zY?R0Xcp(>=o>ADLhpw_QrW^RvN?(ETY0FIm;iYjB#$_02DT30bvdRdjv-*Z9K+~Dy z&0>yD84BUH3f#Fn-BIS}qWiy%iaq*eg>En1%@qwG< zfUbg-&95{vKwOF4CYo=7ygYIEW*XrP&Cx%JPXpm1wTCoa(^cbluE^Es>(fY)i9^7R z8Ln-v$`(gCjnPy#I17xDe7E;S_dgOJKLe!}Pkv|rOWY;KnOJh;#E`wIMYUkBr;g}` I+@9+F0zg?wF#rGn delta 422 zcmZvYOG^S#9L1Tz85g?pQQ8Ck1fdd|_fG0KN-*j*2Zr%6*Thymln^YRwTsr#Ci#DW zHf?LuE@%;bf}mCV_Vo=?Xd%?%Y!2uA;GEasmFLFtB%;OkVU)%x0itSjOH(HMO@U0F zmfYi`-bue3YC-1|a8=m#{>c(L8I)uKN?cX(UDz<0rRPl6C^2T*`C8dD!LV$un`U&* zi$H(aKJWC-M$kGKx7RgTBlGB_mY^C{CxZoVw=?Q*&sAd?_3>7`6y!$9$d?+p>B!)~ zQJgA-pNsFo{Wed`& ze@vA?u3WbY6|BnnAXT7fn5>|4W=|<9*fR={INr<4Vw&KC9PklHC4WgZrWg3^4vac4 qya@u~xgilC3O+kOP;p(mA`mt#gYW7!8(r=!zBzoj=U&92yZQt7%yhc|