Skip to content

Commit 9b82f1a

Browse files
masintermasinter
authored
lmm57 interrupts clipboard wheelscroll (#1634)
* Changes to interrupt initialization for CLIPBOARD and WHEELSCROLL * fixed initialization
1 parent e92381b commit 9b82f1a

File tree

6 files changed

+175
-188
lines changed

6 files changed

+175
-188
lines changed

‎library/CLIPBOARD‎

Lines changed: 26 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,21 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED "19-Oct-2023 00:20:01" {WMEDLEY}<library>CLIPBOARD.;8 9130
3+
(FILECREATED "31-Mar-2024 06:51:14" {DSK}<home>larry>il>medley>library>CLIPBOARD.;2 8932
44

5-
:EDIT-BY rmk
5+
:EDIT-BY "lmm"
66

7-
:CHANGES-TO (FNS TEDIT.EXTRACTTOCLIPBOARD)
7+
:CHANGES-TO (FNS INSTALL-CLIPBOARD)
8+
(VARS CLIPBOARDCOMS)
89

9-
:PREVIOUS-DATE " 7-Jul-2022 23:53:01" {WMEDLEY}<library>CLIPBOARD.;7)
10+
:PREVIOUS-DATE "19-Oct-2023 00:20:01" {DSK}<home>larry>il>medley>library>CLIPBOARD.;1)
1011

1112

1213
(PRETTYCOMPRINT CLIPBOARDCOMS)
1314

1415
(RPAQQ CLIPBOARDCOMS
1516
[ (* ; "Enable copy and paste")
16-
(FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE
17-
CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM)
17+
(FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD CLIPBOARD-COPY-STREAM
18+
CLIPBOARD-PASTE-STREAM)
1819
(FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD)
1920
(FNS SEDIT.COPYTOCLIPBOARD)
2021
(DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD)
@@ -31,19 +32,22 @@
3132
(DEFINEQ
3233

3334
(INSTALL-CLIPBOARD
34-
[LAMBDA NIL (* ; "Edited 24-Jun-2021 21:14 by rmk:")
35-
(* ; "Edited 19-Apr-2020 12:15 by rmk:")
36-
(* ; "Edited 18-Apr-2018 23:00 by rmk:")
37-
(CL:WHEN (GETD 'LISPINTERRUPTS.PASTE)
38-
(MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.ORIG)
39-
(MOVD 'LISPINTERRUPTS.PASTE 'LISPINTERRUPTS))
35+
[LAMBDA NIL (* ; "Edited 30-Mar-2024 22:22 by lmm")
36+
(* ; "Edited 24-Jun-2021 21:14 by rmk:")
37+
(* ; "Edited 19-Apr-2020 12:15 by rmk:")
38+
(* ; "Edited 18-Apr-2018 23:00 by rmk:")
4039
(INTERRUPTCHAR (CHARCODE "Meta,v")
4140
'(PASTEFROMCLIPBOARD))
4241
(INTERRUPTCHAR (CHARCODE "Meta,V")
4342
'(PASTEFROMCLIPBOARD))
44-
(CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT")
43+
(/PUTASSOC 'PASTE [LIST (LIST (CHARCODE "1,v")
44+
'(PASTEFROMCLIPBOARD))
45+
(LIST (CHARCODE "1,V")
46+
'(PASTEFROMCLIPBOARD]
47+
LISPINTERRUPTS)
48+
(CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT")
4549

46-
(* ;; "Paste")
50+
(* ;; "Paste")
4751

4852
(TEDIT.SETFUNCTION (CHARCODE "Meta,v")
4953
(FUNCTION PASTEFROMCLIPBOARD)
@@ -52,7 +56,7 @@
5256
(FUNCTION PASTEFROMCLIPBOARD)
5357
TEDIT.READTABLE)
5458

55-
(* ;; "Copy")
59+
(* ;; "Copy")
5660

5761
(TEDIT.SETFUNCTION (CHARCODE "Meta,c")
5862
(FUNCTION TEDIT.COPYTOCLIPBOARD)
@@ -61,16 +65,16 @@
6165
(FUNCTION TEDIT.COPYTOCLIPBOARD)
6266
TEDIT.READTABLE)
6367

64-
(* ;; "Extract")
68+
(* ;; "Extract")
6569

6670
(TEDIT.SETFUNCTION (CHARCODE "Meta,X")
6771
(FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
6872
TEDIT.READTABLE)
6973
(TEDIT.SETFUNCTION (CHARCODE "Meta,x")
7074
(FUNCTION TEDIT.EXTRACTTOCLIPBOARD)
7175
TEDIT.READTABLE))
72-
(CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;
73-
 "SEDIT copy: INTERRUPTCHAR does paste")
76+
(CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ;
77+
 "SEDIT copy: INTERRUPTCHAR does paste")
7478
(SEDIT:ADD-COMMAND "Meta,c" 'SEDIT.COPYTOCLIPBOARD "M-c" "Copy to clipboard")
7579
(SEDIT:ADD-COMMAND "Meta,C" 'SEDIT.COPYTOCLIPBOARD)
7680
(SEDIT:RESET-COMMANDS))])
@@ -104,17 +108,6 @@
104108
THEN (COPYINSERT STR)
105109
ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C])
106110

107-
(LISPINTERRUPTS.PASTE
108-
[LAMBDA NIL (* ; "Edited 18-Apr-2018 22:59 by rmk:")
109-
110-
(* ;; "So paste interrupts will be installed in every process")
111-
112-
(APPEND [LIST (LIST (CHARCODE "1,v")
113-
'(PASTEFROMCLIPBOARD))
114-
(LIST (CHARCODE "1,V")
115-
'(PASTEFROMCLIPBOARD]
116-
(LISPINTERRUPTS.ORIG])
117-
118111
(CLIPBOARD-COPY-STREAM
119112
[LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk")
120113
(* ; "Edited 23-Feb-2021 22:11 by rmk:")
@@ -196,10 +189,9 @@
196189

197190
(ADDTOVAR LAMA )
198191
)
199-
(PUTPROPS CLIPBOARD COPYRIGHT (NONE))
200192
(DECLARE%: DONTCOPY
201-
(FILEMAP (NIL (1196 6505 (INSTALL-CLIPBOARD 1206 . 3138) (GETCLIPBOARD 3140 . 3514) (PUTCLIPBOARD 3516
202-
. 3921) (PASTEFROMCLIPBOARD 3923 . 4841) (LISPINTERRUPTS.PASTE 4843 . 5264) (CLIPBOARD-COPY-STREAM
203-
5266 . 5781) (CLIPBOARD-PASTE-STREAM 5783 . 6503)) (6506 7273 (TEDIT.COPYTOCLIPBOARD 6516 . 6797) (
204-
TEDIT.EXTRACTTOCLIPBOARD 6799 . 7271)) (7274 8813 (SEDIT.COPYTOCLIPBOARD 7284 . 8811)))))
193+
(FILEMAP (NIL (1243 6345 (INSTALL-CLIPBOARD 1253 . 3401) (GETCLIPBOARD 3403 . 3777) (PUTCLIPBOARD 3779
194+
. 4184) (PASTEFROMCLIPBOARD 4186 . 5104) (CLIPBOARD-COPY-STREAM 5106 . 5621) (CLIPBOARD-PASTE-STREAM
195+
5623 . 6343)) (6346 7113 (TEDIT.COPYTOCLIPBOARD 6356 . 6637) (TEDIT.EXTRACTTOCLIPBOARD 6639 . 7111)) (
196+
7114 8653 (SEDIT.COPYTOCLIPBOARD 7124 . 8651)))))
205197
STOP

‎library/CLIPBOARD.LCOM‎

-269 Bytes
Binary file not shown.

‎lispusers/WHEELSCROLL‎

Lines changed: 10 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,19 @@
11
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
22

3-
(FILECREATED " 2-Oct-2023 10:15:55" {WMEDLEY}<lispusers>WHEELSCROLL.;24 10480
3+
(FILECREATED "31-Mar-2024 06:57:25" {DSK}<home>larry>il>medley>lispusers>WHEELSCROLL.;2 9911
44

5-
:EDIT-BY rmk
5+
:EDIT-BY "lmm"
66

77
:CHANGES-TO (VARS WHEELSCROLLCOMS)
88
(FNS ENABLEWHEELSCROLL)
99

10-
:PREVIOUS-DATE " 6-Apr-2023 18:34:48" {WMEDLEY}<lispusers>WHEELSCROLL.;22)
10+
:PREVIOUS-DATE " 2-Oct-2023 10:15:55" {DSK}<home>larry>il>medley>lispusers>WHEELSCROLL.;1)
1111

1212

1313
(PRETTYCOMPRINT WHEELSCROLLCOMS)
1414

1515
(RPAQQ WHEELSCROLLCOMS
16-
[(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL
17-
LISPINTERRUPTS.WHEELSCROLL)
16+
[(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL)
1817

1918
(* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys")
2019

@@ -35,19 +34,16 @@
3534
(DEFINEQ
3635

3736
(ENABLEWHEELSCROLL
38-
[LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 2-Oct-2023 10:05 by rmk")
37+
[LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 31-Mar-2024 06:30 by lmm")
38+
(* ; "Edited 2-Oct-2023 10:05 by rmk")
3939
(* ; "Edited 23-Oct-2021 16:31 by larry")
4040
(* ; "Edited 11-Jun-2021 12:50 by rmk:")
4141
(* ; "Edited 28-May-2021 11:46 by rmk:")
4242

4343
(* ;; "So we can toggle this scrolling.")
4444

4545
(if ON
46-
then (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS)
47-
(GETD 'LISPINTERRUPTS.WHEELSCROLL))
48-
(CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL) (* ; "In case of LOADFROM?")
49-
(MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG)
50-
(MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS)))
46+
then (/PUTASSOC 'WHEELSCROLL WHEELSCROLLINTERRUPTS LISPINTERRUPTS)
5147

5248
(* ;; "In some situations these other keyactions seem to be installed, hit them all.")
5349

@@ -73,9 +69,7 @@
7369
(CADR I)
7470
(CADDR I)))
7571
(SETQ WHEELSCROLLENABLED T)
76-
else (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL)
77-
(GETD 'LISPINTERRUPTS))
78-
(MOVD 'LISPINTERRUPTS.WSORIG 'LISPINTERRUPTS))
72+
else (/PUTASSOC 'WHEELSCROLL NIL LISPINTERRUPTS)
7973
(for I in WHEELSCROLLINTERRUPTS do (INTERRUPTCHAR (CAR I)
8074
NIL))
8175
(for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION)
@@ -159,13 +153,6 @@
159153
(,\WSRIGHT (WHEELSCROLL 'HORIZONTAL (OR HWHEELSCROLLDELTA
160154
WHEELSCROLLDELTA)
161155
WHEELSCROLLDELTA T])
162-
163-
(LISPINTERRUPTS.WHEELSCROLL
164-
[LAMBDA NIL (* ; "Edited 17-Feb-2021 11:09 by rmk:")
165-
166-
(* ;; "So wheelscroll interrupts will be installed in every process")
167-
168-
(APPEND WHEELSCROLLINTERRUPTS (LISPINTERRUPTS.WSORIG])
169156
)
170157

171158

@@ -227,6 +214,6 @@
227214
(ENABLEWHEELSCROLL T)
228215
)
229216
(DECLARE%: DONTCOPY
230-
(FILEMAP (NIL (1459 9251 (ENABLEWHEELSCROLL 1469 . 4512) (WHEELSCROLL 4514 . 7115) (WHEELSCROLL.DOIT
231-
7117 . 7753) (INSTALL-WHEELSCROLL 7755 . 8972) (LISPINTERRUPTS.WHEELSCROLL 8974 . 9249)))))
217+
(FILEMAP (NIL (1452 8682 (ENABLEWHEELSCROLL 1462 . 4220) (WHEELSCROLL 4222 . 6823) (WHEELSCROLL.DOIT
218+
6825 . 7461) (INSTALL-WHEELSCROLL 7463 . 8680)))))
232219
STOP

‎lispusers/WHEELSCROLL.LCOM‎

-460 Bytes
Binary file not shown.

0 commit comments

Comments
 (0)