From 9b82f1a7c29ce2d603ce62450808fb97662e3ce8 Mon Sep 17 00:00:00 2001 From: Larry Masinter Date: Mon, 1 Apr 2024 15:18:40 -0700 Subject: [PATCH] lmm57 interrupts clipboard wheelscroll (#1634) * Changes to interrupt initialization for CLIPBOARD and WHEELSCROLL * fixed initialization --- library/CLIPBOARD | 60 ++++----- library/CLIPBOARD.LCOM | Bin 4808 -> 4539 bytes lispusers/WHEELSCROLL | 33 ++--- lispusers/WHEELSCROLL.LCOM | Bin 4842 -> 4382 bytes sources/AINTERRUPT | 254 +++++++++++++++++++------------------ sources/AINTERRUPT.LCOM | Bin 11671 -> 11907 bytes 6 files changed, 167 insertions(+), 180 deletions(-) diff --git a/library/CLIPBOARD b/library/CLIPBOARD index 2e2c381a..1572a634 100644 --- a/library/CLIPBOARD +++ b/library/CLIPBOARD @@ -1,20 +1,21 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED "19-Oct-2023 00:20:01" {WMEDLEY}CLIPBOARD.;8 9130 +(FILECREATED "31-Mar-2024 06:51:14" {DSK}larry>il>medley>library>CLIPBOARD.;2 8932 - :EDIT-BY rmk + :EDIT-BY "lmm" - :CHANGES-TO (FNS TEDIT.EXTRACTTOCLIPBOARD) + :CHANGES-TO (FNS INSTALL-CLIPBOARD) + (VARS CLIPBOARDCOMS) - :PREVIOUS-DATE " 7-Jul-2022 23:53:01" {WMEDLEY}CLIPBOARD.;7) + :PREVIOUS-DATE "19-Oct-2023 00:20:01" {DSK}larry>il>medley>library>CLIPBOARD.;1) (PRETTYCOMPRINT CLIPBOARDCOMS) (RPAQQ CLIPBOARDCOMS [ (* ; "Enable copy and paste") - (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD LISPINTERRUPTS.PASTE - CLIPBOARD-COPY-STREAM CLIPBOARD-PASTE-STREAM) + (FNS INSTALL-CLIPBOARD GETCLIPBOARD PUTCLIPBOARD PASTEFROMCLIPBOARD CLIPBOARD-COPY-STREAM + CLIPBOARD-PASTE-STREAM) (FNS TEDIT.COPYTOCLIPBOARD TEDIT.EXTRACTTOCLIPBOARD) (FNS SEDIT.COPYTOCLIPBOARD) (DECLARE%: DONTEVAL@LOAD DOEVAL@COMPILE DOCOPY (FILES (SYSLOAD) @@ -31,19 +32,22 @@ (DEFINEQ (INSTALL-CLIPBOARD - [LAMBDA NIL (* ; "Edited 24-Jun-2021 21:14 by rmk:") - (* ; "Edited 19-Apr-2020 12:15 by rmk:") - (* ; "Edited 18-Apr-2018 23:00 by rmk:") - (CL:WHEN (GETD 'LISPINTERRUPTS.PASTE) - (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.ORIG) - (MOVD 'LISPINTERRUPTS.PASTE 'LISPINTERRUPTS)) + [LAMBDA NIL (* ; "Edited 30-Mar-2024 22:22 by lmm") + (* ; "Edited 24-Jun-2021 21:14 by rmk:") + (* ; "Edited 19-Apr-2020 12:15 by rmk:") + (* ; "Edited 18-Apr-2018 23:00 by rmk:") (INTERRUPTCHAR (CHARCODE "Meta,v") '(PASTEFROMCLIPBOARD)) (INTERRUPTCHAR (CHARCODE "Meta,V") '(PASTEFROMCLIPBOARD)) - (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") + (/PUTASSOC 'PASTE [LIST (LIST (CHARCODE "1,v") + '(PASTEFROMCLIPBOARD)) + (LIST (CHARCODE "1,V") + '(PASTEFROMCLIPBOARD] + LISPINTERRUPTS) + (CL:WHEN (BOUNDP 'TEDIT.READTABLE) (* ; "TEDIT") - (* ;; "Paste") + (* ;; "Paste") (TEDIT.SETFUNCTION (CHARCODE "Meta,v") (FUNCTION PASTEFROMCLIPBOARD) @@ -52,7 +56,7 @@ (FUNCTION PASTEFROMCLIPBOARD) TEDIT.READTABLE) - (* ;; "Copy") + (* ;; "Copy") (TEDIT.SETFUNCTION (CHARCODE "Meta,c") (FUNCTION TEDIT.COPYTOCLIPBOARD) @@ -61,7 +65,7 @@ (FUNCTION TEDIT.COPYTOCLIPBOARD) TEDIT.READTABLE) - (* ;; "Extract") + (* ;; "Extract") (TEDIT.SETFUNCTION (CHARCODE "Meta,X") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) @@ -69,8 +73,8 @@ (TEDIT.SETFUNCTION (CHARCODE "Meta,x") (FUNCTION TEDIT.EXTRACTTOCLIPBOARD) TEDIT.READTABLE)) - (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ; - "SEDIT copy: INTERRUPTCHAR does paste") + (CL:WHEN (GETP 'SEDIT 'FILEDATES) (* ; + "SEDIT copy: INTERRUPTCHAR does paste") (SEDIT:ADD-COMMAND "Meta,c" 'SEDIT.COPYTOCLIPBOARD "M-c" "Copy to clipboard") (SEDIT:ADD-COMMAND "Meta,C" 'SEDIT.COPYTOCLIPBOARD) (SEDIT:RESET-COMMANDS))]) @@ -104,17 +108,6 @@ THEN (COPYINSERT STR) ELSE (BIND C WHILE (SETQ C (GNCCODE STR)) DO (BKSYSCHARCODE C]) -(LISPINTERRUPTS.PASTE - [LAMBDA NIL (* ; "Edited 18-Apr-2018 22:59 by rmk:") - - (* ;; "So paste interrupts will be installed in every process") - - (APPEND [LIST (LIST (CHARCODE "1,v") - '(PASTEFROMCLIPBOARD)) - (LIST (CHARCODE "1,V") - '(PASTEFROMCLIPBOARD] - (LISPINTERRUPTS.ORIG]) - (CLIPBOARD-COPY-STREAM [LAMBDA NIL (* ; "Edited 7-Jul-2022 23:51 by rmk") (* ; "Edited 23-Feb-2021 22:11 by rmk:") @@ -196,10 +189,9 @@ (ADDTOVAR LAMA ) ) -(PUTPROPS CLIPBOARD COPYRIGHT (NONE)) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1196 6505 (INSTALL-CLIPBOARD 1206 . 3138) (GETCLIPBOARD 3140 . 3514) (PUTCLIPBOARD 3516 - . 3921) (PASTEFROMCLIPBOARD 3923 . 4841) (LISPINTERRUPTS.PASTE 4843 . 5264) (CLIPBOARD-COPY-STREAM -5266 . 5781) (CLIPBOARD-PASTE-STREAM 5783 . 6503)) (6506 7273 (TEDIT.COPYTOCLIPBOARD 6516 . 6797) ( -TEDIT.EXTRACTTOCLIPBOARD 6799 . 7271)) (7274 8813 (SEDIT.COPYTOCLIPBOARD 7284 . 8811))))) + (FILEMAP (NIL (1243 6345 (INSTALL-CLIPBOARD 1253 . 3401) (GETCLIPBOARD 3403 . 3777) (PUTCLIPBOARD 3779 + . 4184) (PASTEFROMCLIPBOARD 4186 . 5104) (CLIPBOARD-COPY-STREAM 5106 . 5621) (CLIPBOARD-PASTE-STREAM +5623 . 6343)) (6346 7113 (TEDIT.COPYTOCLIPBOARD 6356 . 6637) (TEDIT.EXTRACTTOCLIPBOARD 6639 . 7111)) ( +7114 8653 (SEDIT.COPYTOCLIPBOARD 7124 . 8651))))) STOP diff --git a/library/CLIPBOARD.LCOM b/library/CLIPBOARD.LCOM index 6076ac5d4e82858dba19200d720b36e811ce707c..deb594126cc28937bb29c2545eaaf7ca4f0a93b7 100644 GIT binary patch delta 1350 zcma)5L2u(!5N=FJQWrH%wv@I@VQ{sQQ{mwE?6`?rDjeHcEE3!JIYpHgsc9RDNC_#S z2dWhWBo0VikRCsPD-yRoaNw{YE=Zg??gb$ZoOZ<>F;2T_wVT6U?B{RB-^};To8NBz zwE4|@V~r@S&Pbsu)j>7Pif&R}0$Dm94o-Xh?gh0mu!Xf#YBrVWuO*Q8t%$)CK#{BjW*E8qUeIQWgI$6|YD#c? zmRPNUs+v?aRYD~YpP|hub9smGFPHA}kLF+GrNS%xm-Gt%B6X90QmF9tVu9Z;WHMr6 z4da92%lz-cE&f7rBPH@u(d2)owr)ZL2sAwwdVcIiQ9F#W)49Lqgtg*nm2xX5g$NAT$A% zF6>DVyl#|KIHcE7Dn3`&w>3yiPUgx`TJ^#YAQgkZUsy|{E^>LG2LCy|DiDINmxP+Z zAEuXuDoI{r!?+ZW*Vu`zdeg-%fY4&Gixq(q6{J@8tn<1pp}qKF4^PkGYzW8w-s#b> zGr|QTwF)LF$9SqHrz9Oe^cu($qDB<7rnjdATJ;LgUkiv>fNv}){NeL=o+CAl2bsg1 z=zC33E{Xid%;p4qklD7%Q6!sssv#FItZ7fGs)z^(8?V{N1pY7dEOIdrz>7w=SYImIyDbP4hgrcUk z<)(9GBv|g6dv}*2UDVhk4NKsYbMZJ3oGOhSvx(~h1bv3YBe7A`^R|enS=%} zaze*(NjoG~OlZBi zjz{bO%b{SsBYK)I=M2=$CKq)XSdo~E5vpoTM1$PWlG^8F%}6F$S=H!CekE<-Sou`a zAh4pCbV9#7?Jm%bv(TmnSbrz3VI$bF)p7}_O>mtkm}V1!s>~p@gdcsJ#r@FPyo~~9 zaL{Ie2?1t}96IpbgX8{so5y~~pgkNtfa4(yjt)nA!~S@m;VN#b4tS6aHe=f{XlS%w zSk6LSrl*B*R>DfTU{y%bug`#AI2hE+a&aqD<`YJ7C%Xs z=pfQKo;)UFH7a!=+L2N&+L}!VDul;VQ}6Q|?RTyFL%OM8shJ zTDnNTng1d*Ada_dLFl(h6rm;9Y}4|fDAjtY;-vroSxS!=vuf`W2R^fR7#z;u8x(Y#o?phDb#7nTHq7%7uQG z(b61!k}u<*S%v` Vy}B*25VO1ygW&ld5k+Pd_ZKMtX9@rS diff --git a/lispusers/WHEELSCROLL b/lispusers/WHEELSCROLL index c36e8c81..300c5021 100644 --- a/lispusers/WHEELSCROLL +++ b/lispusers/WHEELSCROLL @@ -1,20 +1,19 @@ (DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10) -(FILECREATED " 2-Oct-2023 10:15:55" {WMEDLEY}WHEELSCROLL.;24 10480 +(FILECREATED "31-Mar-2024 06:57:25" {DSK}larry>il>medley>lispusers>WHEELSCROLL.;2 9911 - :EDIT-BY rmk + :EDIT-BY "lmm" :CHANGES-TO (VARS WHEELSCROLLCOMS) (FNS ENABLEWHEELSCROLL) - :PREVIOUS-DATE " 6-Apr-2023 18:34:48" {WMEDLEY}WHEELSCROLL.;22) + :PREVIOUS-DATE " 2-Oct-2023 10:15:55" {DSK}larry>il>medley>lispusers>WHEELSCROLL.;1) (PRETTYCOMPRINT WHEELSCROLLCOMS) (RPAQQ WHEELSCROLLCOMS - [(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL - LISPINTERRUPTS.WHEELSCROLL) + [(FNS ENABLEWHEELSCROLL WHEELSCROLL WHEELSCROLL.DOIT INSTALL-WHEELSCROLL) (* ;; "These are the highest meta-ctrl characters, they will be unaffected by teh state of ctrl and meta mode keys") @@ -35,7 +34,8 @@ (DEFINEQ (ENABLEWHEELSCROLL - [LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 2-Oct-2023 10:05 by rmk") + [LAMBDA (ON EXCLUDEHORIZONTAL) (* ; "Edited 31-Mar-2024 06:30 by lmm") + (* ; "Edited 2-Oct-2023 10:05 by rmk") (* ; "Edited 23-Oct-2021 16:31 by larry") (* ; "Edited 11-Jun-2021 12:50 by rmk:") (* ; "Edited 28-May-2021 11:46 by rmk:") @@ -43,11 +43,7 @@ (* ;; "So we can toggle this scrolling.") (if ON - then (CL:UNLESS (EQP (GETD 'LISPINTERRUPTS) - (GETD 'LISPINTERRUPTS.WHEELSCROLL)) - (CL:WHEN (GETD 'LISPINTERRUPTS.WHEELSCROLL) (* ; "In case of LOADFROM?") - (MOVD? 'LISPINTERRUPTS 'LISPINTERRUPTS.WSORIG) - (MOVD 'LISPINTERRUPTS.WHEELSCROLL 'LISPINTERRUPTS))) + then (/PUTASSOC 'WHEELSCROLL WHEELSCROLLINTERRUPTS LISPINTERRUPTS) (* ;; "In some situations these other keyactions seem to be installed, hit them all.") @@ -73,9 +69,7 @@ (CADR I) (CADDR I))) (SETQ WHEELSCROLLENABLED T) - else (CL:WHEN (EQP (GETD 'LISPINTERRUPTS.WHEELSCROLL) - (GETD 'LISPINTERRUPTS)) - (MOVD 'LISPINTERRUPTS.WSORIG 'LISPINTERRUPTS)) + else (/PUTASSOC 'WHEELSCROLL NIL LISPINTERRUPTS) (for I in WHEELSCROLLINTERRUPTS do (INTERRUPTCHAR (CAR I) NIL)) (for KAT in (LIST \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION) @@ -159,13 +153,6 @@ (,\WSRIGHT (WHEELSCROLL 'HORIZONTAL (OR HWHEELSCROLLDELTA WHEELSCROLLDELTA) WHEELSCROLLDELTA T]) - -(LISPINTERRUPTS.WHEELSCROLL - [LAMBDA NIL (* ; "Edited 17-Feb-2021 11:09 by rmk:") - - (* ;; "So wheelscroll interrupts will be installed in every process") - - (APPEND WHEELSCROLLINTERRUPTS (LISPINTERRUPTS.WSORIG]) ) @@ -227,6 +214,6 @@ (ENABLEWHEELSCROLL T) ) (DECLARE%: DONTCOPY - (FILEMAP (NIL (1459 9251 (ENABLEWHEELSCROLL 1469 . 4512) (WHEELSCROLL 4514 . 7115) (WHEELSCROLL.DOIT -7117 . 7753) (INSTALL-WHEELSCROLL 7755 . 8972) (LISPINTERRUPTS.WHEELSCROLL 8974 . 9249))))) + (FILEMAP (NIL (1452 8682 (ENABLEWHEELSCROLL 1462 . 4220) (WHEELSCROLL 4222 . 6823) (WHEELSCROLL.DOIT +6825 . 7461) (INSTALL-WHEELSCROLL 7463 . 8680))))) STOP diff --git a/lispusers/WHEELSCROLL.LCOM b/lispusers/WHEELSCROLL.LCOM index 3550ee114430b4cc515b9713869ac9d4682ff53e..53e77271cdc7df6551a392fe429f3328b755f097 100644 GIT binary patch delta 960 zcmaiyOKTHR6vs0uREbzDiglwLFA9l}cpr1;RSiyOZrjkw%rG;d6uW3>QX5Db2}LPI zvU4qrYZoruOZI*TzkzFa`U$+#SH?EbS)BQw$DH#!ckb_}U(lz`6-KJf_NYoRRRL=j z*DaMGD5Krs;BBwp?ZEH=5R{JHc;my1{o$Zn@3%*zqk6AjA9OqY?omB`sXQ2005Lr6 zM2SVP#S8?<37TQU6V+8|ItY3PP(pSX#*nYC)oKVj?L#?lMjw@;N~xSRa3WzR!j(n; zVsr{WypQiTa-j7dHg)-F**brN`lQaS!s7CUhs^&ea=R9IyX!wbUqE?v5H6tJz zhv#7{vEw*!fH3`X9_PB<1&XKD@+VNkO#dw28&ge(&~`acjx(VGWh@gEDA6)O#m|I63D2Nup zH(!LjEBFc2et^B|xA55~zkuLv+AV3iJlvc=_jk_uopbJI@z2Jmt_-;9_0OtU#srXT zAZk!5LRst&j!zF??C-(g1Vnh#Z86JXy|?$HfBD-ZtW-b{0VPl@8&o$4hdvwbUt;%P zpAKJc7;rK;dwzIw0EawQqvJS`hDwqo!rtx~&vjKyg@_fQ+^`*1511J;i#0ETE2;UyV2-S0+@2N33VoL)&wK5IwD7oYrKT(lFJ)c0(2f z9Y5r~3IHn@THX^2Fjj#*_W2({lZD)XW&+Z20vg3AMAI2-$}|KIJ_+>z6a+gKYuGNc zctCv`SDA)I(?6d&Q7HJPMS);#A}Bz3N-kiIQ6>TcT+`xEX2%I*!qNG);t1CW?9{zh z%XF=z4Or!O>zyEA?(}Zl987B9*lqukb{jCk8I#m)dx72LoYjm6u$(nXQff&6QQn=V z>jexD;oZFuK*h3_NDS~25h-rU8@Sl6$xB19v#bSDx^HeK7Fd@kp&OrBu;X!zqmysM_~GnX$COSources>AINTERRUPT.;4" 41128 - |changes| |to:| (FNS INTCHAR GETINTERRUPT) +(FILECREATED "31-Mar-2024 09:38:10" |{DSK}larry>il>medley>sources>AINTERRUPT.;7| 41133 - |previous| |date:| "28-Jun-90 18:45:07" "{Pele:mv:envos}Sources>AINTERRUPT.;3") + :EDIT-BY "lmm" + :CHANGES-TO (VARS AINTERRUPTCOMS) + + :PREVIOUS-DATE "31-Mar-2024 09:27:57" |{DSK}larry>il>medley>sources>AINTERRUPT.;5|) -; Copyright (c) 1982, 1983, 1984, 1985, 1986, 1987, 1989, 1990, 1992 by Venue & Xerox Corporation. All rights reserved. (PRETTYCOMPRINT AINTERRUPTCOMS) @@ -16,7 +17,14 @@ \\DOHELPINTERRUPT1 \\DOINTERRUPTHERE \\PROC.FINDREALFRAME \\SETPRINTLEVEL \\SETRECLAIMMIN GETINTERRUPT CURRENTINTERRUPTS SETINTERRUPT RESET.INTERRUPTS INTERRUPTABLE)) - (DECLARE\: DONTEVAL@LOAD DOCOPY (P (INTCHAR T))) + (INITVARS (LISPINTERRUPTS '((LISPINTERRUPTS (2 BREAK MOUSE) + (4 RESET MOUSE) + (5 ERROR MOUSE) + (7 HELP T) + (16 PRINTLEVEL) + (20 (CONTROL-T)) + (127 RUBOUT T))))) + (GLOBALVARS LISPINTERRUPTS) (COMS (* |;;| "^T this is actually not very useful any more, and the percentages are wrong") @@ -46,7 +54,8 @@ DONTCOPY (EXPORT (RECORDS INTERRUPTSTATE) (PROP DMACRO \\TAKEINTERRUPT)) - (MACROS \\SYSTEMINTERRUPTP)))) + (MACROS \\SYSTEMINTERRUPTP)) + (DECLARE\: DONTEVAL@LOAD DOCOPY (P (INTCHAR T))))) @@ -55,43 +64,44 @@ (DEFINEQ (INTCHAR - (LAMBDA (CHAR TYP/FORM HARDFLG TABLE) (* \; "Edited 17-Sep-92 10:41 by jds") + (LAMBDA (CHAR TYP/FORM HARDFLG TABLE) (* \; "Edited 31-Mar-2024 09:16 by lmm") + (* \; "Edited 17-Sep-92 10:41 by jds") (* |;;| "this function is the non-undoable version of INTERRUPTCHAR; INTERRUPTCHAR calls it") (PROG (VAL SYSDEF OLDINT) (SELECTQ CHAR (NIL (* \; - "this is illegal, so don't do anything about it") + "this is illegal, so don't do anything about it") (RETURN)) - (T (* \; - "(INTCHAR T) means restore interrupts to the 'standard' setting") - (UNINTERRUPTABLY - (|for| CHAR |in| (GETINTERRUPT NIL TABLE) - |do| (SETQ VAL (NCONC (INTCHAR CHAR NIL NIL TABLE) - VAL))) (* \; - "turn off all user interrupts --- (GETINTERRUPT) returns list of user interrupts") - (MAPC (LISPINTERRUPTS) - (FUNCTION (LAMBDA (LST) - (SETQ VAL (NCONC (INTCHAR (CAR LST) - (CADR LST) - (CADDR LST) - TABLE) - VAL))))) + (T + (* |;;| "(INTCHAR T) means restore interrupts to the 'standard' setting") - (* |;;| "and reset all SYSTEM interrupts to default --- (LISPINTERRUPTS) returns a list of argument lists for INTCHAR") + (|for| CHAR |in| (GETINTERRUPT NIL TABLE) + |do| (SETQ VAL (NCONC (INTCHAR CHAR NIL NIL TABLE) + VAL))) (* \; + "turn off all user interrupts --- (GETINTERRUPT) returns list of user interrupts") + (MAPC (LISPINTERRUPTS) + (FUNCTION (LAMBDA (LST) + (SETQ VAL (NCONC (INTCHAR (CAR LST) + (CADR LST) + (CADDR LST) + TABLE) + VAL))))) + + (* |;;| "and reset all SYSTEM interrupts to default --- (LISPINTERRUPTS) returns a list of argument lists for INTCHAR") (* \; - "and VAL has been set to a valid arg list for INTCHAR") - (RETURN VAL))) + "and VAL has been set to a valid arg list for INTCHAR") + (RETURN VAL)) NIL) (COND ((LISTP CHAR) (* \; - "Call from undoing or resetform. CHAR is a list of characters followed by typ/form arguments.") + "Call from undoing or resetform. CHAR is a list of characters followed by typ/form arguments.") (|while| CHAR |do| (SETQ VAL (NCONC (INTCHAR (|pop| CHAR) - (|pop| CHAR) - (|pop| CHAR) - TABLE) - VAL))) + (|pop| CHAR) + (|pop| CHAR) + TABLE) + VAL))) (RETURN VAL))) (COND ((NOT (FIXP CHAR)) @@ -103,26 +113,26 @@ (SETQ CHAR (OR (GETINTERRUPT CHAR TABLE) (ERRORX (LIST 27 CHAR))))) (T (* \; - "turn single character into character code") + "turn single character into character code") (SETQ CHAR (APPLY* 'CHARCODE CHAR)))))) (SETQ VAL (AND (SETQ OLDINT (GETINTERRUPT CHAR TABLE)) (LIST CHAR (CAR OLDINT) (CADR OLDINT)))) (COND ((EQ TYP/FORM T) (* \; - "just return value indicating what it was.") + "just return value indicating what it was.") (RETURN VAL)) ((AND TYP/FORM (LITATOM TYP/FORM) (SETQ SYSDEF (ASSOC TYP/FORM \\SYSTEMINTERRUPTS))) (* \; - "System interrupt -- get its default HARDFLG") + "System interrupt -- get its default HARDFLG") (OR HARDFLG (SETQ HARDFLG (CADR SYSDEF))))) (COND ((AND (EQ (CAR OLDINT) TYP/FORM) (EQ (CADR OLDINT) HARDFLG)) (* \; - "if the character is already set up, just return") + "if the character is already set up, just return") (RETURN))) (COND (OLDINT (SETINTERRUPT CHAR NIL TABLE))) @@ -251,20 +261,15 @@  "Couldn't build frame, so leave interrupt pending") (SETQ \\PENDINGINTERRUPT T))))))))))))) -(lispinterrupts - (lambda nil (* |jds| "30-Sep-85 12:35") - - (* * |Returns| \a |list| |of| |the| "standard" |interrupt-character| - |settings| |for| |Interlisp-D.| |These| |are| |used,| |e.g.,| |in| intchar - |to| |reset| |things| |to| |the| |default| |state.|) +(LISPINTERRUPTS + (LAMBDA NIL (* \; "Edited 31-Mar-2024 06:25 by lmm") + (* |jds| "30-Sep-85 12:35") - '((2 break mouse) - (4 reset mouse) - (5 error mouse) - (7 help t) - (16 printlevel) - (20 (control-t)) - (127 rubout t)))) + (* * |Returns| \a |list| |of| |the| "standard" |interrupt-character| |settings| + |for| |Interlisp-D.| |These| |are| |used,| |e.g.,| |in| INTCHAR |to| |reset| + |things| |to| |the| |default| |state.|) + + (FOR R IN LISPINTERRUPTS JOIN (APPEND (CDR R))))) (\\dohelpinterrupt (lambda nil (* |bvm:| "27-JUL-83 18:37") @@ -427,7 +432,8 @@ (setq \\linbuf olb)))) (GETINTERRUPT - (LAMBDA (CHAR TABLE) (* \; "Edited 17-Sep-92 10:41 by jds") + (LAMBDA (CHAR TABLE) (* \; "Edited 31-Mar-2024 09:20 by lmm") + (* \; "Edited 17-Sep-92 10:41 by jds") (* |;;| "Return the interrupt, if any, defined for CHAR in keyaction table TABLE.") @@ -438,20 +444,16 @@ (OR TABLE (SETQ TABLE \\CURRENTKEYACTION)) (SELECTQ CHAR (NIL (* \; "Non-system interrupts") - (|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) - TABLE) |unless| (\\SYSTEMINTERRUPTP (CADR X)) - |collect| (CAR X))) + (|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) OF TABLE) + |unless| (\\SYSTEMINTERRUPTP (CADR X)) |collect| (CAR X))) (T (* \; "All system interrupts") - (|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) - TABLE) |collect| (CAR X))) + (|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) OF TABLE) |collect| (CAR X))) (COND ((NUMBERP CHAR) - (CDR (FASSOC CHAR (|fetch| (KEYACTION INTERRUPTLIST) - TABLE)))) - (T (|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) - TABLE) |when| (EQ CHAR (CADR X)) - |do| (* \; "Find CHAR in system class.") - (RETURN (CAR X)))))))) + (CDR (FASSOC CHAR (|fetch| (KEYACTION INTERRUPTLIST) OF TABLE)))) + (T (|for| X |in| (|fetch| (KEYACTION INTERRUPTLIST) OF TABLE) + |when| (EQ CHAR (CADR X)) |do| (* \; "Find CHAR in system class.") + (RETURN (CAR X)))))))) (currentinterrupts (lambda (table) (* |bvm:| "18-Jul-85 12:37") @@ -535,9 +537,18 @@ (lambda (flag) (* |lmm| "18-APR-82 13:52") (prog1 \\interruptable (setq \\interruptable flag)))) ) -(DECLARE\: DONTEVAL@LOAD DOCOPY -(INTCHAR T) +(RPAQ? LISPINTERRUPTS + '((LISPINTERRUPTS (2 BREAK MOUSE) + (4 RESET MOUSE) + (5 ERROR MOUSE) + (7 HELP T) + (16 PRINTLEVEL) + (20 (CONTROL-T)) + (127 RUBOUT T)))) +(DECLARE\: DOEVAL@COMPILE DONTCOPY + +(GLOBALVARS LISPINTERRUPTS) ) @@ -679,16 +690,16 @@ (ADDTOVAR FONTVARS (INTERUPTMENUFONT DEFAULTFONT T)) (RPAQQ \\SYSTEMINTERRUPTS ((BREAK MOUSE) - (CONTROL-T) - (ERROR MOUSE) - (ERRORX) - (HELP T) - (OUTPUTBUFFER T) - (PRINTLEVEL) - (RAID T) - (RESET MOUSE) - (RUBOUT T) - (STORAGE))) + (CONTROL-T) + (ERROR MOUSE) + (ERRORX) + (HELP T) + (OUTPUTBUFFER T) + (PRINTLEVEL) + (RAID T) + (RESET MOUSE) + (RUBOUT T) + (STORAGE))) (DECLARE\: EVAL@COMPILE DONTCOPY (ADDTOVAR NOFIXFNSLST CONTROL-T) @@ -710,9 +721,9 @@ (PUTPROPS UNINTERRUPTABLY INFO EVAL) (PUTPROPS UNINTERRUPTABLY DMACRO ((X . Y) - ((LAMBDA (\\INTERRUPTABLE) - (PROGN X . Y)) - NIL))) + ((LAMBDA (\\INTERRUPTABLE) + (PROGN X . Y)) + NIL))) (ADDTOVAR PRETTYPRINTMACROS (UNINTERRUPTABLY @@ -731,57 +742,52 @@ DONTCOPY (* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE\: EVAL@COMPILE (BLOCKRECORD INTERRUPTSTATE ( - (* |;;| "This is the structure used to communicate between the emulator and Lisp re interrupts. There is a bit per interrupt type, plus space for the character code that caused a keyboard interrupt.") + (* |;;| "This is the structure used to communicate between the emulator and Lisp re interrupts. There is a bit per interrupt type, plus space for the character code that caused a keyboard interrupt.") - (* |;;| "This must match the INTSTAT definition in lispemul.h") + (* |;;| "This must match the INTSTAT definition in lispemul.h") - (* |;;| "PENDING-INTERRUPT FLAGS:") + (* |;;| "PENDING-INTERRUPT FLAGS:") - (LOGMSGSPENDING FLAG) (* \; - " Log/Console msgs need printing.") - (ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.") - (IOINTERRUPT FLAG) - (GCDISABLED FLAG) (* \; "No mroe room in GC tables.") - (VMEMFULL FLAG) (* \; "VMEM is full!!") - (STACKOVERFLOW FLAG) (* \; "Stack overflowed.") - (STORAGEFULL FLAG) (* \; - "Ran out of storage, atoms, etc.") - (WAITINGINTERRUPT FLAG) + (LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.") + (ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.") + (IOINTERRUPT FLAG) + (GCDISABLED FLAG) (* \; "No mroe room in GC tables.") + (VMEMFULL FLAG) (* \; "VMEM is full!!") + (STACKOVERFLOW FLAG) (* \; "Stack overflowed.") + (STORAGEFULL FLAG) (* \; "Ran out of storage, atoms, etc.") + (WAITINGINTERRUPT FLAG) - (* |;;| "INTERRUPTS-IN-PROCESS MASK:") + (* |;;| "INTERRUPTS-IN-PROCESS MASK:") - (P-LOGMSGSPENDING FLAG) (* \; - " Log/Console msgs need printing.") - (P-ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.") - (P-IOINTERRUPT FLAG) - (P-GCDISABLED FLAG) (* \; "No mroe room in GC tables.") - (P-VMEMFULL FLAG) (* \; "VMEM is full!!") - (P-STACKOVERFLOW FLAG) (* \; "Stack overflowed.") - (P-STORAGEFULL FLAG) (* \; - "Ran out of storage, atoms, etc.") - (P-WAITINGINTERRUPT FLAG) - (INTCHARCODE WORD)) - (BLOCKRECORD INTERRUPTSTATE ( - (* |;;| - "Alternative view of the structure:") + (P-LOGMSGSPENDING FLAG) (* \; " Log/Console msgs need printing.") + (P-ETHERINTERRUPT FLAG) (* \; "Ether packet read finished.") + (P-IOINTERRUPT FLAG) + (P-GCDISABLED FLAG) (* \; "No mroe room in GC tables.") + (P-VMEMFULL FLAG) (* \; "VMEM is full!!") + (P-STACKOVERFLOW FLAG) (* \; "Stack overflowed.") + (P-STORAGEFULL FLAG) (* \; "Ran out of storage, atoms, etc.") + (P-WAITINGINTERRUPT FLAG) + (INTCHARCODE WORD)) + (BLOCKRECORD INTERRUPTSTATE ( + (* |;;| "Alternative view of the structure:") - (PENDING BITS 8) + (PENDING BITS 8) (* \; "Pending-interrupt flags") - (IN-PROGRESS BITS 8) + (IN-PROGRESS BITS 8) (* \; - "Mask to prevent re-interrupt for an interrupt in progress") - (NIL WORD)))) + "Mask to prevent re-interrupt for an interrupt in progress") + (NIL WORD)))) ) (PUTPROPS \\TAKEINTERRUPT DMACRO ((PREFORM POSTFORM) - (DECLARE (GLOBALVARS \\PENDINGINTERRUPT)) - (COND - ((AND \\PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK)) - PREFORM - ((LAMBDA (\\INTERRUPTABLE) - (\\CALLINTERRUPTED)) - T) - POSTFORM)))) + (DECLARE (GLOBALVARS \\PENDINGINTERRUPT)) + (COND + ((AND \\PENDINGINTERRUPT (INTERRUPTABLE~=NILUPTHESTACK)) + PREFORM + ((LAMBDA (\\INTERRUPTABLE) + (\\CALLINTERRUPTED)) + T) + POSTFORM)))) (* "END EXPORTED DEFINITIONS") @@ -789,16 +795,18 @@ DONTCOPY (DECLARE\: EVAL@COMPILE (PUTPROPS \\SYSTEMINTERRUPTP MACRO ((KEY) - (ASSOC KEY \\SYSTEMINTERRUPTS))) + (ASSOC KEY \\SYSTEMINTERRUPTS))) ) ) -(PUTPROPS AINTERRUPT COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1989 1990 -1992)) +(DECLARE\: DONTEVAL@LOAD DOCOPY + +(INTCHAR T) +) (DECLARE\: DONTCOPY - (FILEMAP (NIL (2572 28843 (INTCHAR 2582 . 7650) (INTERRUPTCHAR 7652 . 7926) (INTERRUPTED 7928 . 15507) - (LISPINTERRUPTS 15509 . 16026) (\\DOHELPINTERRUPT 16028 . 16926) (\\DOHELPINTERRUPT1 16928 . 18326) ( -\\DOINTERRUPTHERE 18328 . 19508) (\\PROC.FINDREALFRAME 19510 . 20314) (\\SETPRINTLEVEL 20316 . 22268) -(\\SETRECLAIMMIN 22270 . 23143) (GETINTERRUPT 23145 . 24519) (CURRENTINTERRUPTS 24521 . 24731) ( -SETINTERRUPT 24733 . 26711) (RESET.INTERRUPTS 26713 . 28670) (INTERRUPTABLE 28672 . 28841)) (28991 -34975 (CONTROL-T 29001 . 34442) (\\CONTROL-T.PRINTRATIO 34444 . 34973))))) + (FILEMAP (NIL (2924 29142 (INTCHAR 2934 . 7957) (INTERRUPTCHAR 7959 . 8233) (INTERRUPTED 8235 . 15814) + (LISPINTERRUPTS 15816 . 16343) (\\DOHELPINTERRUPT 16345 . 17243) (\\DOHELPINTERRUPT1 17245 . 18643) ( +\\DOINTERRUPTHERE 18645 . 19825) (\\PROC.FINDREALFRAME 19827 . 20631) (\\SETPRINTLEVEL 20633 . 22585) +(\\SETRECLAIMMIN 22587 . 23460) (GETINTERRUPT 23462 . 24818) (CURRENTINTERRUPTS 24820 . 25030) ( +SETINTERRUPT 25032 . 27010) (RESET.INTERRUPTS 27012 . 28969) (INTERRUPTABLE 28971 . 29140)) (29562 +35546 (CONTROL-T 29572 . 35013) (\\CONTROL-T.PRINTRATIO 35015 . 35544))))) STOP diff --git a/sources/AINTERRUPT.LCOM b/sources/AINTERRUPT.LCOM index b615686143eb8be84d929102e979edf79cdeccb9..49635ec48e652f2a7b8d4a83e20f910d9e0e16a9 100644 GIT binary patch delta 2125 zcmbVM&rcgy5VkQ$bb$y`Fuy_=EeY%bw!B`0!Bm80_W>K$-p%fUaNkyIkhMQ3}BAZ0Ai2|%Bgp$i!p=cx;gUEP797_ly3mkhTzrMM;mdiqZ z16U~RD%Si5@2uq4bCYY!TU$Gmt80_%x$IhQXL37#W9v$8ds0$UHZjcw!wyfx3k?4n zcXTW+38e><*L8^}M&c|m|5fCX0?(l4c)tk=WsGq?tmT3{`1x9&ueN0> zFqOT%(wtrWo(b3T=$4CrjD-bcE5+TGRl?Y)(1blhj zTmm6heI|@TCX#@G*cfQ4Wq2842aJ`0V$=ghD{sPgk4ETS zR@$;j@<_Ze8UZSjtSbaUf+)NJgwd{;r3OAK>Fxl-3FGwE@>wMs$B4@Ru&?g(fS-Bz zxc+HPkt!BMse82<9@~&X?#|TpqTS*eXG;ebOv4L zo1lY1gg!^KvdBWIfj(*a1tISr%XQKGDatE*j+mrW=F4N>_z`u#`9@C(Wth4go>5Z@ z?i6jtl#(T&Be#5sxEC$Ib(C<}cZP|C8d)S-iEID(Ey{JX^*yxvt=(;SDZ)%5Ym%D8 zM=Zfkwk`SVsCbOC8|*&LRP?9Y`gej~V5Oqy-0k4qA(Pzn2f{t5> ztM)q&8v2m!hXysmQ-WDdpO!S2qN=s=kZwBQ2B9!9ft%S$pT2~ln>|72`Dp{cdiyhI z3;kEo{_NVb13CP@H$Xk@98G?QTSEICmqt6x&liDHXd9R$lK=&^Ba4zYrRkCajH1iB zkp|A7WtA47jXCnz{-z7h7pT~nSjQ(?w%AFocpuIKJk9KdUt3gf8 f=s?v)+}_Z6^iB-Z$GJUB(eXEy)b`wYOPyW2BtLM0@S0^^Mx3yb0D6O{!vLxiE zfR?Eb23(G$t`Xyupxo05qO>;|1}Aco;%r5`uyD4&vN+Nt#L|(x>F!@0|0U z@7!y@dFj^0caR@o?5z4=*`lLd+v<6LgN%4HHD#AQ*G;}S-{ zM6wlUHk;5aly;gx=e*6L_XhA1r!=k-ax4}@-sXDULlWIx=M%D!lBG1w?orLBILE7S z83FjXED5rhrh&e0c|}jYwk><5?Q-qLoPl~(qSx7_cc(2Fl}S7=q@lU7wO+dF)tW#x z>t(qK%wpaFY)xHKY&fmCoi15uR;u21q1-@nOD?i$Apo4MX)3TJ1<0%@Q_&+gI zJ!;xwMC`C#QO>3*|AR0awLpTkwN7>Al%cT@iVpPkg@+dU7dG!~4Q>|x{#?I5G#K{J z@B1kh$H{9J)j?(IE=GmGBG*aZ<}!bzCjCE1pk^K!&B7Sq(T| zB)07(VRXyl!12~-pBR08hGMXXPCl~N%f@>`xc5#Cyx$+9?)|*~+kFX=ZciJ8lh+OC zd#VpVWdehJxIh*u28YS`*{MnYt=S{~jVWn_T3gGSOPbMjqE*F@9r!*>F)7J^u>Y`s zh&oAQtSA7jm+D@%+NjjwwXMR&7F4Qbyo9xrcy#?YvDr3{igVpf^SYk_w%^ zmNZ)n`gnZs%Mh|Y9c+vTEXy|4*rJ}#;#0v`w3S>y^yh{?Lf)@Ke;f^Xc(5!R6B^n% z%?NTmeD*z(t9kfkp6E;hUGwUwtx&2Ly=|`uc%=X(;zTsp)>K2$b2z&oc;v`RNO)pT zJ9HQ4N$Bn?7+7>?_%_y5MxtmGcK_)Ce)^W=TD*b-+N95ce%?=YzXP4Z?fG|474+kBv6y5>XHVw`V zx_fc#-!LAR7bYI;GHo1@Dp7!#+2YHC5AE1;zpfRkhBu%d#vms+n_unT6(w6Zk~)f0??BNfxHBAbvc( zh8Uh9zh7zL4>KPAPBUcXHbaVr*cHSJ>?-0H>~e%f^ST8n#dvxmk`0Js^ySF#v0g$RpJUzqcOntY z{#E1{j;pPrXCRp4ugEBJo{mb0^HI{(-KdQCAUcg0<;I@T^NS{E=M)3kQSJh+-sFe} ze{xrLD9d!f#V@`9497(?$!X{D_|j-Cs<+PK`8O>Gx^F%pW3ctpOD?`P&v~VW2h*_P xRm-mfzI!U=>UzCUF44ee()f7Hq(uS}fdqjhffRuZ4DlI!iBO0F79$Uh{{VMt6)6A!