Merge pull request #1487 from Interlisp/mth-LockXorShift-issue-1486
change for CapsLock & Shift to be XOR vs OR.
This commit is contained in:
Matt Heffron
GitHub
643
sources/LLKEY
643
sources/LLKEY
@@ -1,18 +1,20 @@
|
||||
(DEFINE-FILE-INFO PACKAGE "INTERLISP" READTABLE "INTERLISP" BASE 10)
|
||||
(FILECREATED "27-Aug-2021 16:18:18" {DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLKEY.;9 199890
|
||||
|
||||
previous date%: "24-Aug-2021 16:54:52"
|
||||
{DSK}<Users>kaplan>Local>medley3.5>git-medley>sources>LLKEY.;7)
|
||||
(FILECREATED " 3-Jan-2024 16:10:17" {MEDLEY}<SOURCES>LLKEY.;4 199503
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (FNS \DECODETRANSITION SHIFTDOWNP)
|
||||
(VARS LLKEYCOMS)
|
||||
(RECORDS KEYBOARDEVENT)
|
||||
|
||||
:PREVIOUS-DATE " 3-Jan-2024 12:32:52" {MEDLEY}<SOURCES>LLKEY.;3)
|
||||
|
||||
(* ; "
|
||||
Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Corporation.
|
||||
")
|
||||
|
||||
(PRETTYCOMPRINT LLKEYCOMS)
|
||||
|
||||
(RPAQQ LLKEYCOMS
|
||||
[(COMS (* ; "Access to keyboard")
|
||||
[(COMS (* ; "Access to keyboard")
|
||||
(FNS BKSYSCHARCODE \CLEARSYSBUF \GETKEY \NSYSBUFCHARS \SAVESYSBUF \SYSBUFP \GETSYSBUF
|
||||
\PUTSYSBUF \PEEKSYSBUF)
|
||||
(INITVARS (\LONGSYSBUF))
|
||||
@@ -20,10 +22,10 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(DECLARE%: DONTCOPY (RESOURCES \KEYBOARDWAITBOX))
|
||||
(DECLARE%: DONTCOPY (CONSTANTS (\SYSBUFSIZE 200))
|
||||
(MACROS \GETREALSYSBUF)))
|
||||
[DECLARE%: DOCOPY DONTEVAL@LOAD (COMS (* ;
|
||||
"Here because it must be done in init before PROC loaded")
|
||||
[DECLARE%: DOCOPY DONTEVAL@LOAD (COMS (* ;
|
||||
"Here because it must be done in init before PROC loaded")
|
||||
(P (MOVD? 'NILL 'CARET]
|
||||
(COMS (* ; "Key handler")
|
||||
(COMS (* ; "Key handler")
|
||||
(FNS \KEYBOARDINIT \KEYBOARDEVENTFN \ALLOCLOCKED \SETIOPOINTERS \KEYBOARDOFF
|
||||
\KEYBOARDON \KEYHANDLER \KEYHANDLER1 \RESETKEYBOARD \DOMOUSECHORDING
|
||||
\DOTRANSITIONS \DECODETRANSITION MOUSECHORDWAIT \TRACKCURSOR)
|
||||
@@ -32,7 +34,8 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(\SUN.JLEKEYBOARD 2)
|
||||
(\TOSHIBA.JIS 7))
|
||||
(INITVARS (\MOUSECHORDTICKS)
|
||||
(\MOUSECHORDMILLISECONDS 50))
|
||||
(\MOUSECHORDMILLISECONDS 50)
|
||||
(SHIFTXORLOCKFLG NIL))
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\KEYBOARDINIT)))
|
||||
[DECLARE%: DONTCOPY (MACROS .NOTELASTUSERACTION)
|
||||
(CONSTANTS ALLUP \CTRLMASK \METABIT)
|
||||
@@ -44,8 +47,8 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(EXPORT (RECORDS KEYACTION)
|
||||
(CONSTANTS \NKEYS))
|
||||
(RECORDS RING)
|
||||
(COMS (* ;
|
||||
"can get rid of shiftstate after clients have been fixed")
|
||||
(COMS (* ;
|
||||
"can get rid of shiftstate after clients have been fixed")
|
||||
(RECORDS SHIFTSTATE)
|
||||
(GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP))
|
||||
(CONSTANTS NRINGINDEXWORDS)
|
||||
@@ -53,7 +56,7 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE]
|
||||
(DECLARE%: EVAL@COMPILE (VARS \KEYNAMES))
|
||||
|
||||
(* ;; "\maikokeyactions does not contain keyactions of the form %"2,50%" because it breaks the loadup process on the sun.")
|
||||
(* ;; "\maikokeyactions does not contain keyactions of the form %"2,50%" because it breaks the loadup process on the sun.")
|
||||
|
||||
(VARS \ORIGKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DORADOKEYACTIONS
|
||||
\DOVEKEYACTIONS \DOVEOSDKEYACTIONS \MAIKOKEYACTIONS \MAIKOKEYACTIONST4
|
||||
@@ -67,33 +70,33 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
\MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION
|
||||
\COMMANDKEYACTION \DEFAULTKEYACTION \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS
|
||||
\KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS
|
||||
\DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS))
|
||||
(COMS (* ; "Key interpretation")
|
||||
\DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS SHIFTXORLOCKFLG))
|
||||
(COMS (* ; "Key interpretation")
|
||||
(FNS KEYACTION KEYACTIONTABLE KEYBOARDTYPE RESETKEYACTION
|
||||
\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS \KEYACTION1 KEYDOWNP KEYNUMBERP
|
||||
\KEYNAMETONUMBER \KEYNUMBERTONAME MODIFY.KEYACTIONS METASHIFT SHIFTDOWNP)
|
||||
(* ;
|
||||
"To support office style 1108 & 1186 keyboards")
|
||||
(* ;
|
||||
"To support office style 1108 & 1186 keyboards")
|
||||
(FNS SETUP.OFFICE.KEYBOARD)
|
||||
(OPTIMIZERS)
|
||||
(MACROS \TEMPCOPYTIMER)
|
||||
(* ;
|
||||
"Don't copy this optimizer since it expands out to \getbasebit, but do exportit.")
|
||||
(* ;
|
||||
"Don't copy this optimizer since it expands out to \getbasebit, but do exportit.")
|
||||
(DECLARE%: DONTCOPY (EXPORT (OPTIMIZERS KEYDOWNP)))
|
||||
(EXPORT (MACROS XKEYDOWNP KEYDOWNP1 \NEWKEYDOWNP)))
|
||||
(COMS (* ; "A raw keyboard device/stream")
|
||||
(COMS (* ; "A raw keyboard device/stream")
|
||||
(FNS \INIT.KEYBOARD.STREAM)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY (P (\INIT.KEYBOARD.STREAM)))
|
||||
(EXPORT (GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM)))
|
||||
(COMS (* ; "Hook for a periodic interrupt")
|
||||
(COMS (* ; "Hook for a periodic interrupt")
|
||||
(FNS \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME \PERIODIC.INTERRUPTFRAME)
|
||||
(INITVARS (\KEYBUFFERING)
|
||||
(\PERIODIC.INTERRUPT)
|
||||
(\TIMER.INTERRUPT.PENDING)
|
||||
(\PERIODIC.INTERRUPT.FREQUENCY 77)))
|
||||
(LOCALVARS . T)
|
||||
[COMS (* ;
|
||||
"cursor and mouse related functions.")
|
||||
[COMS (* ;
|
||||
"cursor and mouse related functions.")
|
||||
(FNS \HARDCURSORUP \HARDCURSORPOSITION \HARDCURSORDOWN)
|
||||
(FNS CURSOR.INIT \CURSORDESTINATION \SOFTCURSORUP \SOFTCURSORUPCURRENT
|
||||
\SOFTCURSORPOSITION \SOFTCURSORDOWN CURSORPROP GETCURSORPROP PUTCURSORPROP
|
||||
@@ -147,7 +150,7 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
\KEYBOARDEVENT.SIZE
|
||||
383]
|
||||
(COMS (FNS MACHINETYPE SETMAINTPANEL)
|
||||
(* ; "DLion beeper")
|
||||
(* ; "DLion beeper")
|
||||
(FNS BEEPON BEEPOFF))
|
||||
(EXPORT (GLOBALVARS \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY \EM.UTILIN \EM.REALUTILIN
|
||||
\EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.KBDAD4 \EM.KBDAD5
|
||||
@@ -155,8 +158,8 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
\DEFAULTKEYACTION \COMMANDKEYACTION \CURRENTKEYACTION \PERIODIC.INTERRUPT
|
||||
\PERIODIC.INTERRUPT.FREQUENCY))
|
||||
(FNS WITHOUT-INTERRUPTS)
|
||||
(COMS (* ;
|
||||
"Compile locked fns together for locality")
|
||||
(COMS (* ;
|
||||
"Compile locked fns together for locality")
|
||||
(BLOCKS (NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR
|
||||
\PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS
|
||||
\DOTRANSITIONS \DECODETRANSITION \EVENTKEYS \HARDCURSORUP \DOMOUSECHORDING
|
||||
@@ -382,9 +385,9 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(AND [EQ (fetch (RING WRITE) of \SYSBUFFER)
|
||||
(replace (RING READ) of \SYSBUFFER
|
||||
with (COND
|
||||
((EQ \SYSBUFFER.LAST R)
|
||||
\SYSBUFFER.FIRST)
|
||||
(T (ADD1 R]
|
||||
((EQ \SYSBUFFER.LAST R)
|
||||
\SYSBUFFER.FIRST)
|
||||
(T (ADD1 R]
|
||||
(replace (RING READ) of \SYSBUFFER with 0)))])
|
||||
)
|
||||
)
|
||||
@@ -851,7 +854,8 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
T])
|
||||
|
||||
(\DECODETRANSITION
|
||||
[LAMBDA (KEYNUMBER DOWNFLG) (* ; "Edited 19-Nov-87 16:29 by Snow")
|
||||
[LAMBDA (KEYNUMBER DOWNFLG) (* ; "Edited 3-Jan-2024 16:04 by mth")
|
||||
(* ; "Edited 19-Nov-87 16:29 by Snow")
|
||||
|
||||
(* ;; "KEYNUMBER is the key number in the hardware keyboard layout, DOWNFLG is T if the key just went down. PENDINGINTERRUPT, bound in \KEYHANDLER, is set to the decoded character if it is an interrupt.")
|
||||
|
||||
@@ -861,14 +865,18 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
ASCIICODE SHIFTED)
|
||||
(SELECTC (TRANSITIONFLAGS \CURRENTKEYACTION TI)
|
||||
(IGNORE.TF (RETURN))
|
||||
(LOCKSHIFT.TF (* ;
|
||||
"Take shift action if either Shift or Caps Lock is down")
|
||||
(IF (fetch (KEYBOARDEVENT SHIFTORLOCK) of KEYSTATE)
|
||||
THEN (SETQ SHIFTED T)))
|
||||
(NOLOCKSHIFT.TF (* ;
|
||||
"Take shift action only when Shift is down")
|
||||
(IF (fetch (KEYBOARDEVENT SHIFT) of KEYSTATE)
|
||||
THEN (SETQ SHIFTED T)))
|
||||
(LOCKSHIFT.TF
|
||||
(* ;; "Take shift action if either Shift or Caps Lock is down. ")
|
||||
|
||||
(* ;; "If SHIFTXORLOCKFLG, but not both!")
|
||||
|
||||
(IF SHIFTXORLOCKFLG
|
||||
THEN (SETQ SHIFTED (fetch (KEYBOARDEVENT SHIFTXORLOCK) of KEYSTATE))
|
||||
ELSE (SETQ SHIFTED (fetch (KEYBOARDEVENT SHIFTORLOCK) of KEYSTATE))))
|
||||
(NOLOCKSHIFT.TF
|
||||
(* ;; "Take shift action only when Shift is down")
|
||||
|
||||
(SETQ SHIFTED (fetch (KEYBOARDEVENT SHIFT) of KEYSTATE)))
|
||||
(EVENT.TF (RETURN))
|
||||
(1SHIFTUP.TF (replace (KEYBOARDEVENT 1SHIFT) of KEYSTATE with NIL)
|
||||
(RETURN))
|
||||
@@ -907,8 +915,9 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(replace (KEYBOARDEVENT USERMODE1) of KEYSTATE with T)
|
||||
(RETURN))
|
||||
(USERMODE1TOGGLE.TF
|
||||
(replace (KEYBOARDEVENT USERMODE1) of KEYSTATE
|
||||
with (NOT (fetch (KEYBOARDEVENT USERMODE1) of KEYSTATE)))
|
||||
(replace (KEYBOARDEVENT USERMODE1) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT
|
||||
USERMODE1)
|
||||
of KEYSTATE)))
|
||||
(RETURN))
|
||||
(USERMODE2UP.TF
|
||||
(replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with NIL)
|
||||
@@ -917,8 +926,9 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with T)
|
||||
(RETURN))
|
||||
(USERMODE2TOGGLE.TF
|
||||
(replace (KEYBOARDEVENT USERMODE2) of KEYSTATE
|
||||
with (NOT (fetch (KEYBOARDEVENT USERMODE2) of KEYSTATE)))
|
||||
(replace (KEYBOARDEVENT USERMODE2) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT
|
||||
USERMODE2)
|
||||
of KEYSTATE)))
|
||||
(RETURN))
|
||||
(USERMODE3UP.TF
|
||||
(replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with NIL)
|
||||
@@ -927,13 +937,14 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with T)
|
||||
(RETURN))
|
||||
(USERMODE3TOGGLE.TF
|
||||
(replace (KEYBOARDEVENT USERMODE3) of KEYSTATE
|
||||
with (NOT (fetch (KEYBOARDEVENT USERMODE3) of KEYSTATE)))
|
||||
(replace (KEYBOARDEVENT USERMODE3) of KEYSTATE with (NOT (fetch (KEYBOARDEVENT
|
||||
USERMODE3)
|
||||
of KEYSTATE)))
|
||||
(RETURN))
|
||||
(SHOULDNT))
|
||||
|
||||
(* ;;
|
||||
"Only the LOCKSHIFT and NOLOCKSHIFT cases make it to here, having set SHIFTED if appropriate.")
|
||||
"Only the LOCKSHIFT and NOLOCKSHIFT cases make it to here, having set SHIFTED if appropriate.")
|
||||
|
||||
[SETQ ASCIICODE (COND
|
||||
(SHIFTED (TRANSITIONSHIFTCODE \CURRENTKEYACTION TI))
|
||||
@@ -944,12 +955,11 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(fetch (KEYBOARDEVENT FONT) of KEYSTATE))
|
||||
[IF (IGREATERP ASCIICODE 127)
|
||||
THEN
|
||||
(* ;; "Non-ascii interpretation--what is cntrl/meta supposed to mean? Try using the original interpretation. This way we can type ^E or Meta-D even if Russian keyboard is set, but doesn't mess up simple ascii remappings, such as bs->del.")
|
||||
|
||||
(* ;; "Non-ascii interpretation--what is cntrl/meta supposed to mean? Try using the original interpretation. This way we can type ^E or Meta-D even if Russian keyboard is set, but doesn't mess up simple ascii remappings, such as bs->del.")
|
||||
|
||||
(SETQ ASCIICODE (COND
|
||||
(SHIFTED (TRANSITIONSHIFTCODE \COMMANDKEYACTION TI))
|
||||
(T (TRANSITIONCODE \COMMANDKEYACTION TI]
|
||||
(SETQ ASCIICODE (COND
|
||||
(SHIFTED (TRANSITIONSHIFTCODE \COMMANDKEYACTION TI))
|
||||
(T (TRANSITIONCODE \COMMANDKEYACTION TI]
|
||||
[COND
|
||||
((fetch (KEYBOARDEVENT CTRL) of KEYSTATE)
|
||||
(SETQ ASCIICODE (LOGAND ASCIICODE \CTRLMASK]
|
||||
@@ -1069,6 +1079,8 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(RPAQ? \MOUSECHORDTICKS )
|
||||
|
||||
(RPAQ? \MOUSECHORDMILLISECONDS 50)
|
||||
|
||||
(RPAQ? SHIFTXORLOCKFLG NIL)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\KEYBOARDINIT)
|
||||
@@ -1076,9 +1088,9 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(DECLARE%: DONTCOPY
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS .NOTELASTUSERACTION MACRO (NIL (\BLT \LASTUSERACTION (LOCF (fetch SECONDSTMP
|
||||
of \MISCSTATS))
|
||||
WORDSPERCELL)))
|
||||
(PUTPROPS .NOTELASTUSERACTION MACRO (NIL (\BLT \LASTUSERACTION (LOCF (fetch SECONDSTMP of \MISCSTATS)
|
||||
)
|
||||
WORDSPERCELL)))
|
||||
)
|
||||
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
@@ -1095,10 +1107,10 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
|
||||
|
||||
(RPAQQ DLMOUSEBITS ((\MOUSE.LEFTBIT 4)
|
||||
(\MOUSE.RIGHTBIT 2)
|
||||
(\MOUSE.MIDDLEBIT 1)
|
||||
(\MOUSE.ALLBITS 7)
|
||||
(\MOUSE.LRBIT 6)))
|
||||
(\MOUSE.RIGHTBIT 2)
|
||||
(\MOUSE.MIDDLEBIT 1)
|
||||
(\MOUSE.ALLBITS 7)
|
||||
(\MOUSE.LRBIT 6)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \MOUSE.LEFTBIT 4)
|
||||
@@ -1121,11 +1133,11 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
|
||||
|
||||
(RPAQQ DLMOUSESTATES ((\DLMOUSE.UP 0)
|
||||
(\DLMOUSE.WAITING 1)
|
||||
(\DLMOUSE.NORMAL 2)
|
||||
(\DLMOUSE.MIDDLE 3)
|
||||
(\DLMOUSE.MIDDLE&LEFT 4)
|
||||
(\DLMOUSE.MIDDLE&RIGHT 5)))
|
||||
(\DLMOUSE.WAITING 1)
|
||||
(\DLMOUSE.NORMAL 2)
|
||||
(\DLMOUSE.MIDDLE 3)
|
||||
(\DLMOUSE.MIDDLE&LEFT 4)
|
||||
(\DLMOUSE.MIDDLE&RIGHT 5)))
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(RPAQQ \DLMOUSE.UP 0)
|
||||
@@ -1231,97 +1243,95 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \TRANSINDEX MACRO ((KEYNUMBER DOWNFLG)
|
||||
(COND
|
||||
(DOWNFLG (IPLUS \NKEYS KEYNUMBER))
|
||||
(T KEYNUMBER))))
|
||||
(COND
|
||||
(DOWNFLG (IPLUS \NKEYS KEYNUMBER))
|
||||
(T KEYNUMBER))))
|
||||
|
||||
(PUTPROPS ARMEDCODE MACRO ((TABLE CHAR)
|
||||
(\GETBASEBIT (fetch (KEYACTION ARMED)
|
||||
TABLE)
|
||||
CHAR)))
|
||||
(\GETBASEBIT (fetch (KEYACTION ARMED)
|
||||
TABLE)
|
||||
CHAR)))
|
||||
|
||||
(PUTPROPS TRANSITIONALTGRCODE MACRO ((TABLE CHAR)
|
||||
(\GETBASE (fetch (KEYACTION ALTGRAPHCODES)
|
||||
of TABLE)
|
||||
CHAR)))
|
||||
(\GETBASE (fetch (KEYACTION ALTGRAPHCODES) of TABLE)
|
||||
CHAR)))
|
||||
|
||||
(PUTPROPS TRANSITIONSHIFTCODE MACRO ((TABLE CHAR)
|
||||
(\GETBASE (fetch (KEYACTION SHIFTCODES)
|
||||
TABLE)
|
||||
CHAR)))
|
||||
(\GETBASE (fetch (KEYACTION SHIFTCODES)
|
||||
TABLE)
|
||||
CHAR)))
|
||||
|
||||
(PUTPROPS TRANSITIONCODE MACRO ((TABLE CHAR)
|
||||
(\GETBASE (fetch (KEYACTION CODES)
|
||||
TABLE)
|
||||
CHAR)))
|
||||
(\GETBASE (fetch (KEYACTION CODES)
|
||||
TABLE)
|
||||
CHAR)))
|
||||
|
||||
(PUTPROPS TRANSITIONFLAGS MACRO ((TABLE CHAR)
|
||||
(\GETBASEBYTE (fetch (KEYACTION FLAGS)
|
||||
TABLE)
|
||||
CHAR)))
|
||||
(\GETBASEBYTE (fetch (KEYACTION FLAGS)
|
||||
TABLE)
|
||||
CHAR)))
|
||||
|
||||
(PUTPROPS TRANSITIONDEADLIST MACRO ((TABLE CHAR SHIFTED)
|
||||
(\GETBASEPTR (fetch (KEYACTION DEADKEYLIST)
|
||||
of TABLE)
|
||||
(LLSH (COND
|
||||
(SHIFTED (IPLUS CHAR \NKEYS \NKEYS))
|
||||
(T CHAR))
|
||||
1))))
|
||||
(\GETBASEPTR (fetch (KEYACTION DEADKEYLIST) of TABLE)
|
||||
(LLSH (COND
|
||||
(SHIFTED (IPLUS CHAR \NKEYS \NKEYS))
|
||||
(T CHAR))
|
||||
1))))
|
||||
|
||||
(PUTPROPS CHECKFORDEADKEY MACRO
|
||||
[(KEYCODE TABLE CHAR SHIFTED)
|
||||
(LET ((CODE KEYCODE))
|
||||
(COND
|
||||
[(IEQP CODE 65535)
|
||||
`(DEADKEY ,(\GETBASEPTR (fetch (KEYACTION DEADKEYLIST) of TABLE)
|
||||
(LLSH (COND
|
||||
(SHIFTED (IPLUS CHAR \NKEYS \NKEYS))
|
||||
(T CHAR))
|
||||
1]
|
||||
(T CODE])
|
||||
(PUTPROPS CHECKFORDEADKEY MACRO [(KEYCODE TABLE CHAR SHIFTED)
|
||||
(LET ((CODE KEYCODE))
|
||||
(COND
|
||||
[(IEQP CODE 65535)
|
||||
`(DEADKEY ,(\GETBASEPTR (fetch (KEYACTION DEADKEYLIST)
|
||||
of TABLE)
|
||||
(LLSH (COND
|
||||
(SHIFTED (IPLUS CHAR \NKEYS
|
||||
\NKEYS))
|
||||
(T CHAR))
|
||||
1]
|
||||
(T CODE])
|
||||
)
|
||||
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD KEYACTION (
|
||||
(* ;; "KEYACTION Table: For interpreting keystrokes. Stored as a 8-cell block of untyped pointer hunk storage.")
|
||||
(* ;; "KEYACTION Table: For interpreting keystrokes. Stored as a 8-cell block of untyped pointer hunk storage.")
|
||||
|
||||
FLAGS (* ; "Flag byte per key# (one for down-transtion, 1 for up-.) to describe whether lockshifting occrrs, you ignore the transition, etc.")
|
||||
CODES (* ;
|
||||
"Table of character codes generated by each key when no shift key is pressed.")
|
||||
SHIFTCODES (* ;
|
||||
"Table of character codes generated by each key when the shift key is pressed.")
|
||||
ARMED (* ; "Not sure...")
|
||||
INTERRUPTLIST (* ; "List of armed interrupts?")
|
||||
ALTGRAPHCODES (* ;
|
||||
"Table of codes to be generated when the ALT-GRAPH key is pressed.")
|
||||
DEADKEYLIST (* ; "Block of dead-key handlers, with the nominal up-transition fields filled by the shifted-case tables. Each %"table%" is an ALIST of orignal code => accented code. no entry means punt the accent..")
|
||||
)
|
||||
FLAGS _ (\ALLOCBLOCK (FOLDHI (IPLUS \NKEYS \NKEYS)
|
||||
BYTESPERCELL))
|
||||
CODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS)
|
||||
WORDSPERCELL))
|
||||
SHIFTCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS)
|
||||
WORDSPERCELL))
|
||||
ARMED _ (\ALLOCBLOCK (FOLDHI (ADD1 \MAXTHINCHAR)
|
||||
BITSPERCELL))
|
||||
ALTGRAPHCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS)
|
||||
WORDSPERCELL))
|
||||
DEADKEYLIST _ (\ALLOCBLOCK (PLUS \NKEYS \NKEYS \NKEYS \NKEYS)
|
||||
T)
|
||||
(CREATE (\ALLOCBLOCK 7 PTRBLOCK.GCT))
|
||||
[TYPE? (AND (\BLOCKDATAP DATUM)
|
||||
(IGEQ (\#BLOCKDATACELLS DATUM)
|
||||
5)
|
||||
(OR (NULL (FETCH (KEYACTION INTERRUPTLIST)
|
||||
OF DATUM))
|
||||
(LISTP (FETCH INTERRUPTLIST OF DATUM)))
|
||||
(\BLOCKDATAP (FETCH (KEYACTION FLAGS)
|
||||
DATUM))
|
||||
(\BLOCKDATAP (FETCH (KEYACTION CODES)
|
||||
DATUM))
|
||||
(\BLOCKDATAP (FETCH (KEYACTION ARMED)
|
||||
DATUM])
|
||||
FLAGS (* ; "Flag byte per key# (one for down-transtion, 1 for up-.) to describe whether lockshifting occrrs, you ignore the transition, etc.")
|
||||
CODES (* ;
|
||||
"Table of character codes generated by each key when no shift key is pressed.")
|
||||
SHIFTCODES (* ;
|
||||
"Table of character codes generated by each key when the shift key is pressed.")
|
||||
ARMED (* ; "Not sure...")
|
||||
INTERRUPTLIST (* ; "List of armed interrupts?")
|
||||
ALTGRAPHCODES (* ;
|
||||
"Table of codes to be generated when the ALT-GRAPH key is pressed.")
|
||||
DEADKEYLIST (* ; "Block of dead-key handlers, with the nominal up-transition fields filled by the shifted-case tables. Each %"table%" is an ALIST of orignal code => accented code. no entry means punt the accent..")
|
||||
)
|
||||
FLAGS _ (\ALLOCBLOCK (FOLDHI (IPLUS \NKEYS \NKEYS)
|
||||
BYTESPERCELL))
|
||||
CODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS)
|
||||
WORDSPERCELL))
|
||||
SHIFTCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS)
|
||||
WORDSPERCELL))
|
||||
ARMED _ (\ALLOCBLOCK (FOLDHI (ADD1 \MAXTHINCHAR)
|
||||
BITSPERCELL))
|
||||
ALTGRAPHCODES _ (\ALLOCBLOCK (FOLDHI (PLUS \NKEYS \NKEYS)
|
||||
WORDSPERCELL))
|
||||
DEADKEYLIST _ (\ALLOCBLOCK (PLUS \NKEYS \NKEYS \NKEYS \NKEYS)
|
||||
T)
|
||||
(CREATE (\ALLOCBLOCK 7 PTRBLOCK.GCT))
|
||||
[TYPE? (AND (\BLOCKDATAP DATUM)
|
||||
(IGEQ (\#BLOCKDATACELLS DATUM)
|
||||
5)
|
||||
(OR (NULL (FETCH (KEYACTION INTERRUPTLIST) OF DATUM))
|
||||
(LISTP (FETCH INTERRUPTLIST OF DATUM)))
|
||||
(\BLOCKDATAP (FETCH (KEYACTION FLAGS)
|
||||
DATUM))
|
||||
(\BLOCKDATAP (FETCH (KEYACTION CODES)
|
||||
DATUM))
|
||||
(\BLOCKDATAP (FETCH (KEYACTION ARMED)
|
||||
DATUM])
|
||||
)
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
@@ -1337,7 +1347,7 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(BLOCKRECORD RING ((READ WORD)
|
||||
(WRITE WORD)))
|
||||
(WRITE WORD)))
|
||||
)
|
||||
|
||||
|
||||
@@ -1348,88 +1358,77 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(ACCESSFNS SHIFTSTATE [[DUMMYSHIFT (NOT (EQ 0 (LOGAND (\GETBASEBYTE DATUM 0)
|
||||
(LOGOR 1 2]
|
||||
[DUMMY1SHIFT [NOT (EQ 0 (LOGAND 1 (\GETBASEBYTE DATUM 0]
|
||||
(\PUTBASEBYTE DATUM 0 (COND
|
||||
(NEWVALUE (LOGOR 1 (\GETBASEBYTE DATUM 0))
|
||||
)
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 0)
|
||||
(LOGXOR \CHARMASK 1]
|
||||
[DUMMY2SHIFT [NOT (EQ 0 (LOGAND 2 (\GETBASEBYTE DATUM 0]
|
||||
(\PUTBASEBYTE DATUM 0 (COND
|
||||
(NEWVALUE (LOGOR 2 (\GETBASEBYTE DATUM 0))
|
||||
)
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 0)
|
||||
(LOGXOR \CHARMASK 2]
|
||||
[DUMMYLOCK [NOT (EQ 0 (LOGAND 4 (\GETBASEBYTE DATUM 0]
|
||||
(\PUTBASEBYTE DATUM 0 (COND
|
||||
(NEWVALUE (LOGOR 4 (\GETBASEBYTE DATUM 0))
|
||||
)
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 0)
|
||||
(LOGXOR \CHARMASK 4]
|
||||
[DUMMYSHIFTORLOCK (NOT (EQ 0 (\GETBASEBYTE DATUM 0)))
|
||||
(\PUTBASEBYTE DATUM 0 (COND
|
||||
(NEWVALUE (HELP
|
||||
" Can't turn on SHIFTORLOCK"
|
||||
))
|
||||
(T 0]
|
||||
[DUMMYCTRL (NOT (EQ 0 (\GETBASEBYTE DATUM 1)))
|
||||
(\PUTBASEBYTE DATUM 1 (COND
|
||||
(NEWVALUE 1)
|
||||
(T 0]
|
||||
[DUMMYMETA (NOT (EQ 0 (\GETBASEBYTE DATUM 2)))
|
||||
(\PUTBASEBYTE DATUM 2 (COND
|
||||
(NEWVALUE 1)
|
||||
(T 0]
|
||||
[DUMMYFONT (NEQ 0 (LOGAND (LLSH 1 3)
|
||||
(LOGOR 1 2]
|
||||
[DUMMY1SHIFT [NOT (EQ 0 (LOGAND 1 (\GETBASEBYTE DATUM 0]
|
||||
(\PUTBASEBYTE DATUM 0 (COND
|
||||
(NEWVALUE (LOGOR 1 (\GETBASEBYTE DATUM 0)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 0)
|
||||
(LOGXOR \CHARMASK 1]
|
||||
[DUMMY2SHIFT [NOT (EQ 0 (LOGAND 2 (\GETBASEBYTE DATUM 0]
|
||||
(\PUTBASEBYTE DATUM 0 (COND
|
||||
(NEWVALUE (LOGOR 2 (\GETBASEBYTE DATUM 0)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 0)
|
||||
(LOGXOR \CHARMASK 2]
|
||||
[DUMMYLOCK [NOT (EQ 0 (LOGAND 4 (\GETBASEBYTE DATUM 0]
|
||||
(\PUTBASEBYTE DATUM 0 (COND
|
||||
(NEWVALUE (LOGOR 4 (\GETBASEBYTE DATUM 0)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 0)
|
||||
(LOGXOR \CHARMASK 4]
|
||||
[DUMMYSHIFTORLOCK (NOT (EQ 0 (\GETBASEBYTE DATUM 0)))
|
||||
(\PUTBASEBYTE DATUM 0 (COND
|
||||
(NEWVALUE (HELP " Can't turn on SHIFTORLOCK"))
|
||||
(T 0]
|
||||
[DUMMYCTRL (NOT (EQ 0 (\GETBASEBYTE DATUM 1)))
|
||||
(\PUTBASEBYTE DATUM 1 (COND
|
||||
(NEWVALUE 1)
|
||||
(T 0]
|
||||
[DUMMYMETA (NOT (EQ 0 (\GETBASEBYTE DATUM 2)))
|
||||
(\PUTBASEBYTE DATUM 2 (COND
|
||||
(NEWVALUE 1)
|
||||
(T 0]
|
||||
[DUMMYFONT (NEQ 0 (LOGAND (LLSH 1 3)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 3)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK (LLSH 1 3]
|
||||
[DUMMYUSERMODE1 (NEQ 0 (LOGAND (LLSH 1 0)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 0)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK (LLSH 1 0]
|
||||
[DUMMYUSERMODE2 (NEQ 0 (LOGAND (LLSH 1 1)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 1)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK (LLSH 1 1]
|
||||
[DUMMYUSERMODE3 (NEQ 0 (LOGAND (LLSH 1 2)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 2)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK (LLSH 1 2]
|
||||
[DUMMYALTGRAPH (NEQ 0 (LOGAND (LLSH 1 4)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 3)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK
|
||||
(LLSH 1 3]
|
||||
[DUMMYUSERMODE1 (NEQ 0 (LOGAND (LLSH 1 0)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 0)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK
|
||||
(LLSH 1 0]
|
||||
[DUMMYUSERMODE2 (NEQ 0 (LOGAND (LLSH 1 1)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 1)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK
|
||||
(LLSH 1 1]
|
||||
[DUMMYUSERMODE3 (NEQ 0 (LOGAND (LLSH 1 2)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 2)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK
|
||||
(LLSH 1 2]
|
||||
[DUMMYALTGRAPH (NEQ 0 (LOGAND (LLSH 1 4)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 4)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK
|
||||
(LLSH 1 4]
|
||||
(DUMMYDEADKEYPENDING (NEQ 0 (LOGAND (LLSH 1 5)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 5)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK
|
||||
(LLSH 1 5]
|
||||
(CREATE (\ALLOCBLOCK (FOLDHI 3 BYTESPERCELL))))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 4)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK (LLSH 1 4]
|
||||
(DUMMYDEADKEYPENDING (NEQ 0 (LOGAND (LLSH 1 5)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(\PUTBASEBYTE DATUM 3 (COND
|
||||
(NEWVALUE (LOGOR (LLSH 1 5)
|
||||
(\GETBASEBYTE DATUM 3)))
|
||||
(T (LOGAND (\GETBASEBYTE DATUM 3)
|
||||
(LOGXOR \CHARMASK (LLSH 1 5]
|
||||
(CREATE (\ALLOCBLOCK (FOLDHI 3 BYTESPERCELL))))
|
||||
)
|
||||
(DECLARE%: DOEVAL@COMPILE DONTCOPY
|
||||
|
||||
@@ -1737,8 +1736,8 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(47 ("Function,^R" "Function,62" NOLOCKSHIFT))))
|
||||
|
||||
(RPAQQ \DOVEOSDKEYACTIONS ((56 LOCKDOWN . LOCKUP)
|
||||
(36 CTRLDOWN . CTRLUP)
|
||||
(CAPSLOCK ("Function,^E" "Function,%%" NOLOCKSHIFT))))
|
||||
(36 CTRLDOWN . CTRLUP)
|
||||
(CAPSLOCK ("Function,^E" "Function,%%" NOLOCKSHIFT))))
|
||||
|
||||
(RPAQQ \MAIKOKEYACTIONS
|
||||
((61 ("^E" "Bell" NOLOCKSHIFT))
|
||||
@@ -1965,7 +1964,8 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \MOUSECHORDTICKS
|
||||
\KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION \COMMANDKEYACTION \DEFAULTKEYACTION
|
||||
\TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS \KEYBOARD.META \MOUSECHORDMILLISECONDS
|
||||
\DORADOKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)
|
||||
\DORADOKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS
|
||||
SHIFTXORLOCKFLG)
|
||||
)
|
||||
|
||||
|
||||
@@ -2356,9 +2356,9 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(T OLDSETTING])
|
||||
|
||||
(SHIFTDOWNP
|
||||
[LAMBDA (SHIFT) (* lmm "18-Apr-85 01:07")
|
||||
(* Tells whether a given shift is
|
||||
down)
|
||||
[LAMBDA (SHIFT) (* ; "Edited 3-Jan-2024 00:09 by mth")
|
||||
(* lmm "18-Apr-85 01:07")
|
||||
(* Tells whether a given shift is down)
|
||||
(SELECTQ SHIFT
|
||||
(LOCK (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE))
|
||||
(META (fetch (KEYBOARDEVENT META) of \LASTKEYSTATE))
|
||||
@@ -2369,6 +2369,9 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(SHIFTORLOCK (OR (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE)
|
||||
(fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE)
|
||||
(fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE)))
|
||||
(SHIFTXORLOCK (NEQ (NULL (OR (fetch (KEYBOARDEVENT 1SHIFT) of \LASTKEYSTATE)
|
||||
(fetch (KEYBOARDEVENT 2SHIFT) of \LASTKEYSTATE)))
|
||||
(NULL (fetch (KEYBOARDEVENT LOCK) of \LASTKEYSTATE))))
|
||||
(CTRL (fetch (KEYBOARDEVENT CTRL) of \LASTKEYSTATE))
|
||||
(FONT (fetch (KEYBOARDEVENT FONT) of \LASTKEYSTATE))
|
||||
(USERMODE1 (fetch (KEYBOARDEVENT USERMODE1) of \LASTKEYSTATE))
|
||||
@@ -2393,9 +2396,9 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \TEMPCOPYTIMER MACRO ((X)
|
||||
(PROGN (\BLT \MOUSETIMERTEMP (LOCF X)
|
||||
WORDSPERCELL)
|
||||
\MOUSETIMERTEMP)))
|
||||
(PROGN (\BLT \MOUSETIMERTEMP (LOCF X)
|
||||
WORDSPERCELL)
|
||||
\MOUSETIMERTEMP)))
|
||||
)
|
||||
|
||||
|
||||
@@ -2405,7 +2408,7 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(DECLARE%: DONTCOPY
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")
|
||||
(DEFOPTIMIZER KEYDOWNP (KEYNAME)
|
||||
`(\NEWKEYDOWNP (\KEYNAMETONUMBER ,KEYNAME)))
|
||||
`(\NEWKEYDOWNP (\KEYNAMETONUMBER ,KEYNAME)))
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
|
||||
@@ -2413,35 +2416,35 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS XKEYDOWNP MACRO ((KEYNAME)
|
||||
(KEYDOWNP1 (\KEYNAMETONUMBER KEYNAME))))
|
||||
(KEYDOWNP1 (\KEYNAMETONUMBER KEYNAME))))
|
||||
|
||||
(PUTPROPS KEYDOWNP1 MACRO
|
||||
[OPENLAMBDA (KEYNUMBER)
|
||||
(DECLARE (GLOBALVARS \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 \EM.UTILIN
|
||||
\EM.KBDAD4 \EM.KBDAD5))
|
||||
(PROG NIL
|
||||
(RETURN (EQ 0 (LOGAND (LRSH (LLSH 1 15)
|
||||
(PROGN (* (IMOD KEYNUMBER BITSPERWORD) -
|
||||
GETD cause IMOD and BITSPERWORD not
|
||||
exported to user)
|
||||
(LOGAND KEYNUMBER 15)))
|
||||
(\GETBASE (SELECTQ (PROGN
|
||||
(* (FOLDLO KEYNUMBER BITSPERWORD)
|
||||
GETD follows since FOLDLO and
|
||||
BITSPERWORD not exported to user)
|
||||
(LRSH KEYNUMBER 4))
|
||||
(0 \EM.KBDAD0)
|
||||
(1 \EM.KBDAD1)
|
||||
(2 \EM.KBDAD2)
|
||||
(3 \EM.KBDAD3)
|
||||
(4 \EM.UTILIN)
|
||||
(5 (OR \EM.KBDAD4 (RETURN)))
|
||||
(6 (OR \EM.KBDAD5 (RETURN)))
|
||||
(RETURN))
|
||||
0])
|
||||
(PUTPROPS KEYDOWNP1 MACRO [OPENLAMBDA (KEYNUMBER)
|
||||
(DECLARE (GLOBALVARS \EM.KBDAD0 \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3
|
||||
\EM.UTILIN \EM.KBDAD4 \EM.KBDAD5))
|
||||
(PROG NIL
|
||||
(RETURN (EQ 0 (LOGAND (LRSH (LLSH 1 15)
|
||||
(PROGN
|
||||
(* (IMOD KEYNUMBER BITSPERWORD) -
|
||||
GETD cause IMOD and BITSPERWORD not
|
||||
exported to user)
|
||||
(LOGAND KEYNUMBER 15)))
|
||||
(\GETBASE (SELECTQ (PROGN
|
||||
(* (FOLDLO KEYNUMBER BITSPERWORD) GETD
|
||||
follows since FOLDLO and BITSPERWORD
|
||||
not exported to user)
|
||||
(LRSH KEYNUMBER 4))
|
||||
(0 \EM.KBDAD0)
|
||||
(1 \EM.KBDAD1)
|
||||
(2 \EM.KBDAD2)
|
||||
(3 \EM.KBDAD3)
|
||||
(4 \EM.UTILIN)
|
||||
(5 (OR \EM.KBDAD4 (RETURN)))
|
||||
(6 (OR \EM.KBDAD5 (RETURN)))
|
||||
(RETURN))
|
||||
0])
|
||||
|
||||
(PUTPROPS \NEWKEYDOWNP MACRO ((KEYNUMBER)
|
||||
(EQ 0 (\GETBASEBIT \LASTKEYSTATE KEYNUMBER))))
|
||||
(EQ 0 (\GETBASEBIT \LASTKEYSTATE KEYNUMBER))))
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@@ -3683,34 +3686,29 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(* "FOLLOWING DEFINITIONS EXPORTED")(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \SETMOUSEXY MACRO [(XPOS YPOS)
|
||||
(PROGN (SELECTC \MACHINETYPE
|
||||
(\DAYBREAK (\DoveMisc.SetMousePosition XPOS YPOS))
|
||||
(\MAIKO (SUBRCALL SETMOUSEXY XPOS YPOS))
|
||||
(\DANDELION (do (PROGN (replace (IOPAGE
|
||||
NEWMOUSEX)
|
||||
of \IOPAGE
|
||||
with XPOS)
|
||||
(replace (IOPAGE
|
||||
NEWMOUSEY)
|
||||
of \IOPAGE
|
||||
with YPOS))
|
||||
repeatuntil
|
||||
(ILESSP (fetch (IOPAGE
|
||||
(PROGN (SELECTC \MACHINETYPE
|
||||
(\DAYBREAK (\DoveMisc.SetMousePosition XPOS YPOS))
|
||||
(\MAIKO (SUBRCALL SETMOUSEXY XPOS YPOS))
|
||||
(\DANDELION (do (PROGN (replace (IOPAGE NEWMOUSEX)
|
||||
of \IOPAGE with XPOS)
|
||||
(replace (IOPAGE NEWMOUSEY)
|
||||
of \IOPAGE with YPOS))
|
||||
repeatuntil (ILESSP (fetch (IOPAGE
|
||||
NEWMOUSESTATE
|
||||
)
|
||||
of \IOPAGE)
|
||||
32768))
|
||||
(* ;
|
||||
"smash position until mouse says it is not busy")
|
||||
(replace (IOPAGE NEWMOUSEX)
|
||||
of \IOPAGE with XPOS)
|
||||
(replace (IOPAGE NEWMOUSEY)
|
||||
of \IOPAGE with YPOS)
|
||||
(replace (IOPAGE NEWMOUSESTATE)
|
||||
of \IOPAGE with 32768))
|
||||
NIL)
|
||||
(PROGN (\PUTBASE \EM.MOUSEX 0 XPOS)
|
||||
(\PUTBASE \EM.MOUSEY 0 YPOS])
|
||||
of \IOPAGE)
|
||||
32768))
|
||||
(* ;
|
||||
"smash position until mouse says it is not busy")
|
||||
(replace (IOPAGE NEWMOUSEX) of \IOPAGE
|
||||
with XPOS)
|
||||
(replace (IOPAGE NEWMOUSEY) of \IOPAGE
|
||||
with YPOS)
|
||||
(replace (IOPAGE NEWMOUSESTATE) of \IOPAGE
|
||||
with 32768))
|
||||
NIL)
|
||||
(PROGN (\PUTBASE \EM.MOUSEX 0 XPOS)
|
||||
(\PUTBASE \EM.MOUSEY 0 YPOS])
|
||||
)
|
||||
|
||||
(* "END EXPORTED DEFINITIONS")
|
||||
@@ -3719,12 +3717,11 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(DECLARE%: EVAL@COMPILE
|
||||
|
||||
(PUTPROPS \XMOUSECOORD MACRO (NIL (IPLUS \CURSORHOTSPOTX (SIGNED (\GETBASE \EM.CURSORX 0)
|
||||
BITSPERWORD))))
|
||||
BITSPERWORD))))
|
||||
|
||||
(PUTPROPS \YMOUSECOORD MACRO [NIL (IDIFFERENCE (SUB1 \CURSORDESTHEIGHT)
|
||||
(IPLUS \CURSORHOTSPOTY (SIGNED (\GETBASE \EM.CURSORY
|
||||
0)
|
||||
BITSPERWORD])
|
||||
(IPLUS \CURSORHOTSPOTY (SIGNED (\GETBASE \EM.CURSORY 0)
|
||||
BITSPERWORD])
|
||||
)
|
||||
)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
@@ -3759,12 +3756,12 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(USERMODE2 FLAG)
|
||||
(USERMODE3 FLAG)
|
||||
(ALTGRAPH FLAG)
|
||||
(DEADKEYPENDING FLAG) (* ; "T if the last key was a dead (accent) key, and we should generate an accented character if possible.")
|
||||
(DEADKEYPENDING FLAG) (* ; "T if the last key was a dead (accent) key, and we should generate an accented character if possible.")
|
||||
(NIL BITS 2)
|
||||
(MOUSEX WORD)
|
||||
(MOUSEY WORD)
|
||||
(DEADKEY-ALIST XPOINTER) (* ;
|
||||
"The ALIST describing accents possible from teh last dead key.")
|
||||
(DEADKEY-ALIST XPOINTER) (* ;
|
||||
"The ALIST describing accents possible from teh last dead key.")
|
||||
)
|
||||
(CREATE (\ALLOCBLOCK (FOLDHI \KEYBOARDEVENT.SIZE WORDSPERCELL)))
|
||||
W0 _ ALLUP W1 _ ALLUP W2 _ ALLUP W3 _ ALLUP W4 _ ALLUP W5 _ ALLUP WU _ ALLUP MOUSESTATE
|
||||
@@ -3773,12 +3770,16 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
DATUM)
|
||||
(fetch (KEYBOARDEVENT 2SHIFT)
|
||||
DATUM)))
|
||||
(SHIFTORLOCK (OR (fetch (KEYBOARDEVENT
|
||||
SHIFT)
|
||||
(SHIFTORLOCK (OR (fetch (KEYBOARDEVENT SHIFT)
|
||||
DATUM)
|
||||
(fetch (KEYBOARDEVENT
|
||||
LOCK)
|
||||
DATUM]
|
||||
(fetch (KEYBOARDEVENT LOCK)
|
||||
DATUM)))
|
||||
(SHIFTXORLOCK (NEQ (NULL (fetch (KEYBOARDEVENT
|
||||
SHIFT)
|
||||
DATUM))
|
||||
(NULL (fetch (KEYBOARDEVENT
|
||||
LOCK)
|
||||
DATUM]
|
||||
LOCK _ (XKEYDOWNP 'LOCK)
|
||||
TIME _ 0 DEADKEYPENDING _ NIL)
|
||||
)
|
||||
@@ -3919,36 +3920,34 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
|
||||
(ADDTOVAR LAMA CURSORPROP METASHIFT MOUSECHORDWAIT)
|
||||
)
|
||||
(PUTPROPS LLKEY COPYRIGHT ("Venue & Xerox Corporation" 1982 1983 1984 1985 1986 1987 1988 1989 1990
|
||||
1992 1999 1920 2000 2018 2021))
|
||||
(DECLARE%: DONTCOPY
|
||||
(FILEMAP (NIL (14696 22012 (BKSYSCHARCODE 14706 . 15055) (\CLEARSYSBUF 15057 . 15615) (\GETKEY 15617
|
||||
. 16792) (\NSYSBUFCHARS 16794 . 17536) (\SAVESYSBUF 17538 . 19147) (\SYSBUFP 19149 . 19453) (
|
||||
\GETSYSBUF 19455 . 19635) (\PUTSYSBUF 19637 . 20850) (\PEEKSYSBUF 20852 . 22010)) (23309 60143 (
|
||||
\KEYBOARDINIT 23319 . 25039) (\KEYBOARDEVENTFN 25041 . 29741) (\ALLOCLOCKED 29743 . 30333) (
|
||||
\SETIOPOINTERS 30335 . 34871) (\KEYBOARDOFF 34873 . 35287) (\KEYBOARDON 35289 . 35668) (\KEYHANDLER
|
||||
35670 . 35801) (\KEYHANDLER1 35803 . 43249) (\RESETKEYBOARD 43251 . 44899) (\DOMOUSECHORDING 44901 .
|
||||
48721) (\DOTRANSITIONS 48723 . 49400) (\DECODETRANSITION 49402 . 56091) (MOUSECHORDWAIT 56093 . 56757)
|
||||
(\TRACKCURSOR 56759 . 60141)) (95847 117397 (KEYACTION 95857 . 96710) (KEYACTIONTABLE 96712 . 97894)
|
||||
(KEYBOARDTYPE 97896 . 98998) (RESETKEYACTION 99000 . 100759) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS
|
||||
100761 . 102663) (\KEYACTION1 102665 . 112781) (KEYDOWNP 112783 . 113118) (KEYNUMBERP 113120 . 113318)
|
||||
(\KEYNAMETONUMBER 113320 . 114014) (\KEYNUMBERTONAME 114016 . 114206) (MODIFY.KEYACTIONS 114208 .
|
||||
115069) (METASHIFT 115071 . 116015) (SHIFTDOWNP 116017 . 117395)) (117460 117756 (
|
||||
SETUP.OFFICE.KEYBOARD 117470 . 117754)) (120459 122171 (\INIT.KEYBOARD.STREAM 120469 . 122169)) (
|
||||
122436 138813 (\DOBUFFEREDTRANSITIONS 122446 . 137876) (\TIMER.INTERRUPTFRAME 137878 . 138603) (
|
||||
\PERIODIC.INTERRUPTFRAME 138605 . 138811)) (139067 143144 (\HARDCURSORUP 139077 . 140959) (
|
||||
\HARDCURSORPOSITION 140961 . 142997) (\HARDCURSORDOWN 142999 . 143142)) (143145 167205 (CURSOR.INIT
|
||||
143155 . 146855) (\CURSORDESTINATION 146857 . 149175) (\SOFTCURSORUP 149177 . 154431) (
|
||||
\SOFTCURSORUPCURRENT 154433 . 161469) (\SOFTCURSORPOSITION 161471 . 162236) (\SOFTCURSORDOWN 162238 .
|
||||
162946) (CURSORPROP 162948 . 163290) (GETCURSORPROP 163292 . 163480) (PUTCURSORPROP 163482 . 164637) (
|
||||
\CURSORBITSPERPIXEL 164639 . 166755) (\CURSORIMAGEPROPNAME 166757 . 166981) (\CURSORMASKPROPNAME
|
||||
166983 . 167203)) (167206 185156 (CURSORCREATE 167216 . 169891) (CURSOR 169893 . 171705) (
|
||||
\CURSOR-VALID-P 171707 . 172794) (\CURSORUP 172796 . 174511) (\CURSORPOSITION 174513 . 177041) (
|
||||
\CURSORDOWN 177043 . 177276) (ADJUSTCURSORPOSITION 177278 . 177856) (CURSORPOSITION 177858 . 179400) (
|
||||
CURSORSCREEN 179402 . 180058) (CURSOREXIT 180060 . 181451) (FLIPCURSOR 181453 . 182579) (FLIPCURSORBAR
|
||||
182581 . 183561) (LASTMOUSEX 183563 . 183817) (LASTMOUSEY 183819 . 184073) (CREATEPOSITION 184075 .
|
||||
184281) (POSITIONP 184283 . 184567) (CURSORHOTSPOT 184569 . 185154)) (186394 187942 (GETMOUSESTATE
|
||||
186404 . 187063) (\EVENTKEYS 187065 . 187940)) (194369 195165 (MACHINETYPE 194379 . 194779) (
|
||||
SETMAINTPANEL 194781 . 195163)) (195195 196334 (BEEPON 195205 . 195858) (BEEPOFF 195860 . 196332)) (
|
||||
196785 197048 (WITHOUT-INTERRUPTS 196795 . 197046)))))
|
||||
(FILEMAP (NIL (14744 22060 (BKSYSCHARCODE 14754 . 15103) (\CLEARSYSBUF 15105 . 15663) (\GETKEY 15665
|
||||
. 16840) (\NSYSBUFCHARS 16842 . 17584) (\SAVESYSBUF 17586 . 19195) (\SYSBUFP 19197 . 19501) (
|
||||
\GETSYSBUF 19503 . 19683) (\PUTSYSBUF 19685 . 20898) (\PEEKSYSBUF 20900 . 22058)) (23345 60763 (
|
||||
\KEYBOARDINIT 23355 . 25075) (\KEYBOARDEVENTFN 25077 . 29777) (\ALLOCLOCKED 29779 . 30369) (
|
||||
\SETIOPOINTERS 30371 . 34907) (\KEYBOARDOFF 34909 . 35323) (\KEYBOARDON 35325 . 35704) (\KEYHANDLER
|
||||
35706 . 35837) (\KEYHANDLER1 35839 . 43285) (\RESETKEYBOARD 43287 . 44935) (\DOMOUSECHORDING 44937 .
|
||||
48757) (\DOTRANSITIONS 48759 . 49436) (\DECODETRANSITION 49438 . 56711) (MOUSECHORDWAIT 56713 . 57377)
|
||||
(\TRACKCURSOR 57379 . 60761)) (95222 117095 (KEYACTION 95232 . 96085) (KEYACTIONTABLE 96087 . 97269)
|
||||
(KEYBOARDTYPE 97271 . 98373) (RESETKEYACTION 98375 . 100134) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS
|
||||
100136 . 102038) (\KEYACTION1 102040 . 112156) (KEYDOWNP 112158 . 112493) (KEYNUMBERP 112495 . 112693)
|
||||
(\KEYNAMETONUMBER 112695 . 113389) (\KEYNUMBERTONAME 113391 . 113581) (MODIFY.KEYACTIONS 113583 .
|
||||
114444) (METASHIFT 114446 . 115390) (SHIFTDOWNP 115392 . 117093)) (117158 117454 (
|
||||
SETUP.OFFICE.KEYBOARD 117168 . 117452)) (120433 122145 (\INIT.KEYBOARD.STREAM 120443 . 122143)) (
|
||||
122410 138787 (\DOBUFFEREDTRANSITIONS 122420 . 137850) (\TIMER.INTERRUPTFRAME 137852 . 138577) (
|
||||
\PERIODIC.INTERRUPTFRAME 138579 . 138785)) (139041 143118 (\HARDCURSORUP 139051 . 140933) (
|
||||
\HARDCURSORPOSITION 140935 . 142971) (\HARDCURSORDOWN 142973 . 143116)) (143119 167179 (CURSOR.INIT
|
||||
143129 . 146829) (\CURSORDESTINATION 146831 . 149149) (\SOFTCURSORUP 149151 . 154405) (
|
||||
\SOFTCURSORUPCURRENT 154407 . 161443) (\SOFTCURSORPOSITION 161445 . 162210) (\SOFTCURSORDOWN 162212 .
|
||||
162920) (CURSORPROP 162922 . 163264) (GETCURSORPROP 163266 . 163454) (PUTCURSORPROP 163456 . 164611) (
|
||||
\CURSORBITSPERPIXEL 164613 . 166729) (\CURSORIMAGEPROPNAME 166731 . 166955) (\CURSORMASKPROPNAME
|
||||
166957 . 167177)) (167180 185130 (CURSORCREATE 167190 . 169865) (CURSOR 169867 . 171679) (
|
||||
\CURSOR-VALID-P 171681 . 172768) (\CURSORUP 172770 . 174485) (\CURSORPOSITION 174487 . 177015) (
|
||||
\CURSORDOWN 177017 . 177250) (ADJUSTCURSORPOSITION 177252 . 177830) (CURSORPOSITION 177832 . 179374) (
|
||||
CURSORSCREEN 179376 . 180032) (CURSOREXIT 180034 . 181425) (FLIPCURSOR 181427 . 182553) (FLIPCURSORBAR
|
||||
182555 . 183535) (LASTMOUSEX 183537 . 183791) (LASTMOUSEY 183793 . 184047) (CREATEPOSITION 184049 .
|
||||
184255) (POSITIONP 184257 . 184541) (CURSORHOTSPOT 184543 . 185128)) (186368 187916 (GETMOUSESTATE
|
||||
186378 . 187037) (\EVENTKEYS 187039 . 187914)) (194115 194911 (MACHINETYPE 194125 . 194525) (
|
||||
SETMAINTPANEL 194527 . 194909)) (194941 196080 (BEEPON 194951 . 195604) (BEEPOFF 195606 . 196078)) (
|
||||
196531 196794 (WITHOUT-INTERRUPTS 196541 . 196792)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user