On Branch_medley-231217-3727653e: LLKEY
This commit is contained in:
Matt Heffron
639
sources/LLKEY
639
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 00:14:32" {MEDLEY}<SOURCES>LLKEY.;2 199648
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (VARS LLKEYCOMS)
|
||||
(RECORDS KEYBOARDEVENT)
|
||||
(FNS SHIFTDOWNP \DECODETRANSITION)
|
||||
|
||||
:PREVIOUS-DATE "27-Aug-2021 16:18:18" {MEDLEY}<SOURCES>LLKEY.;1)
|
||||
|
||||
(* ; "
|
||||
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)
|
||||
(KEYBOARD.SHIFTXORLOCK 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 KEYBOARD.SHIFTXORLOCK))
|
||||
(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 00:12 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,12 +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)
|
||||
(LOCKSHIFT.TF
|
||||
(* ;; "Take shift action if either Shift or Caps Lock is down. ")
|
||||
|
||||
(* ;; "If KEYBOARD.SHIFTXORLOCK then, but not both!")
|
||||
|
||||
(IF (OR (AND KEYBOARD.SHIFTXORLOCK (fetch (KEYBOARDEVENT SHIFTXORLOCK)
|
||||
of KEYSTATE))
|
||||
(fetch (KEYBOARDEVENT SHIFTORLOCK) of KEYSTATE))
|
||||
THEN (SETQ SHIFTED T)))
|
||||
(NOLOCKSHIFT.TF (* ;
|
||||
"Take shift action only when Shift is down")
|
||||
(NOLOCKSHIFT.TF
|
||||
(* ;; "Take shift action only when Shift is down")
|
||||
|
||||
(IF (fetch (KEYBOARDEVENT SHIFT) of KEYSTATE)
|
||||
THEN (SETQ SHIFTED T)))
|
||||
(EVENT.TF (RETURN))
|
||||
@@ -907,8 +917,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 +928,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 +939,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 +957,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 +1081,8 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
(RPAQ? \MOUSECHORDTICKS )
|
||||
|
||||
(RPAQ? \MOUSECHORDMILLISECONDS 50)
|
||||
|
||||
(RPAQ? KEYBOARD.SHIFTXORLOCK NIL)
|
||||
(DECLARE%: DONTEVAL@LOAD DOCOPY
|
||||
|
||||
(\KEYBOARDINIT)
|
||||
@@ -1076,9 +1090,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 +1109,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 +1135,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 +1245,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 +1349,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 +1360,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 +1738,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 +1966,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
|
||||
KEYBOARD.SHIFTXORLOCK)
|
||||
)
|
||||
|
||||
|
||||
@@ -2356,9 +2358,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 +2371,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 +2398,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 +2410,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 +2418,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 +3688,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 +3719,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 +3758,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 +3772,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 +3922,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 (14756 22072 (BKSYSCHARCODE 14766 . 15115) (\CLEARSYSBUF 15117 . 15675) (\GETKEY 15677
|
||||
. 16852) (\NSYSBUFCHARS 16854 . 17596) (\SAVESYSBUF 17598 . 19207) (\SYSBUFP 19209 . 19513) (
|
||||
\GETSYSBUF 19515 . 19695) (\PUTSYSBUF 19697 . 20910) (\PEEKSYSBUF 20912 . 22070)) (23357 60896 (
|
||||
\KEYBOARDINIT 23367 . 25087) (\KEYBOARDEVENTFN 25089 . 29789) (\ALLOCLOCKED 29791 . 30381) (
|
||||
\SETIOPOINTERS 30383 . 34919) (\KEYBOARDOFF 34921 . 35335) (\KEYBOARDON 35337 . 35716) (\KEYHANDLER
|
||||
35718 . 35849) (\KEYHANDLER1 35851 . 43297) (\RESETKEYBOARD 43299 . 44947) (\DOMOUSECHORDING 44949 .
|
||||
48769) (\DOTRANSITIONS 48771 . 49448) (\DECODETRANSITION 49450 . 56844) (MOUSECHORDWAIT 56846 . 57510)
|
||||
(\TRACKCURSOR 57512 . 60894)) (95367 117240 (KEYACTION 95377 . 96230) (KEYACTIONTABLE 96232 . 97414)
|
||||
(KEYBOARDTYPE 97416 . 98518) (RESETKEYACTION 98520 . 100279) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS
|
||||
100281 . 102183) (\KEYACTION1 102185 . 112301) (KEYDOWNP 112303 . 112638) (KEYNUMBERP 112640 . 112838)
|
||||
(\KEYNAMETONUMBER 112840 . 113534) (\KEYNUMBERTONAME 113536 . 113726) (MODIFY.KEYACTIONS 113728 .
|
||||
114589) (METASHIFT 114591 . 115535) (SHIFTDOWNP 115537 . 117238)) (117303 117599 (
|
||||
SETUP.OFFICE.KEYBOARD 117313 . 117597)) (120578 122290 (\INIT.KEYBOARD.STREAM 120588 . 122288)) (
|
||||
122555 138932 (\DOBUFFEREDTRANSITIONS 122565 . 137995) (\TIMER.INTERRUPTFRAME 137997 . 138722) (
|
||||
\PERIODIC.INTERRUPTFRAME 138724 . 138930)) (139186 143263 (\HARDCURSORUP 139196 . 141078) (
|
||||
\HARDCURSORPOSITION 141080 . 143116) (\HARDCURSORDOWN 143118 . 143261)) (143264 167324 (CURSOR.INIT
|
||||
143274 . 146974) (\CURSORDESTINATION 146976 . 149294) (\SOFTCURSORUP 149296 . 154550) (
|
||||
\SOFTCURSORUPCURRENT 154552 . 161588) (\SOFTCURSORPOSITION 161590 . 162355) (\SOFTCURSORDOWN 162357 .
|
||||
163065) (CURSORPROP 163067 . 163409) (GETCURSORPROP 163411 . 163599) (PUTCURSORPROP 163601 . 164756) (
|
||||
\CURSORBITSPERPIXEL 164758 . 166874) (\CURSORIMAGEPROPNAME 166876 . 167100) (\CURSORMASKPROPNAME
|
||||
167102 . 167322)) (167325 185275 (CURSORCREATE 167335 . 170010) (CURSOR 170012 . 171824) (
|
||||
\CURSOR-VALID-P 171826 . 172913) (\CURSORUP 172915 . 174630) (\CURSORPOSITION 174632 . 177160) (
|
||||
\CURSORDOWN 177162 . 177395) (ADJUSTCURSORPOSITION 177397 . 177975) (CURSORPOSITION 177977 . 179519) (
|
||||
CURSORSCREEN 179521 . 180177) (CURSOREXIT 180179 . 181570) (FLIPCURSOR 181572 . 182698) (FLIPCURSORBAR
|
||||
182700 . 183680) (LASTMOUSEX 183682 . 183936) (LASTMOUSEY 183938 . 184192) (CREATEPOSITION 184194 .
|
||||
184400) (POSITIONP 184402 . 184686) (CURSORHOTSPOT 184688 . 185273)) (186513 188061 (GETMOUSESTATE
|
||||
186523 . 187182) (\EVENTKEYS 187184 . 188059)) (194260 195056 (MACHINETYPE 194270 . 194670) (
|
||||
SETMAINTPANEL 194672 . 195054)) (195086 196225 (BEEPON 195096 . 195749) (BEEPOFF 195751 . 196223)) (
|
||||
196676 196939 (WITHOUT-INTERRUPTS 196686 . 196937)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user