change for CapsLock & Shift to be XOR vs OR.
This commit is contained in:
Matt Heffron
628
sources/LLKEY
628
sources/LLKEY
@@ -1,18 +1,19 @@
|
||||
(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 " 2-Jan-2024 19:32:54" {MEDLEY}<sources>LLKEY.;2 199388
|
||||
|
||||
:EDIT-BY "mth"
|
||||
|
||||
:CHANGES-TO (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 +21,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)
|
||||
@@ -44,8 +45,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 +54,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
|
||||
@@ -68,32 +69,32 @@ Copyright (c) 1982-1990, 1992, 1999, 1920, 2000, 2018, 2021 by Venue & Xerox Cor
|
||||
\COMMANDKEYACTION \DEFAULTKEYACTION \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS
|
||||
\KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS
|
||||
\DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS))
|
||||
(COMS (* ; "Key interpretation")
|
||||
(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 +148,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 +156,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 +383,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 +852,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 2-Jan-2024 19:28 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 +863,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
|
||||
(* ;;
|
||||
"(IF (fetch (KEYBOARDEVENT SHIFTORLOCK) of KEYSTATE) THEN (SETQ SHIFTED T))")
|
||||
|
||||
(* ;;
|
||||
"Take shift action if either Shift or Caps Lock is down, but not both!")
|
||||
|
||||
(IF (fetch (KEYBOARDEVENT SHIFTXORLOCK) 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 +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]
|
||||
@@ -1076,9 +1086,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 +1105,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 +1131,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 +1241,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 +1345,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 +1356,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 +1734,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))
|
||||
@@ -2356,9 +2353,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 2-Jan-2024 19:24 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 +2366,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 +2393,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 +2405,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 +2413,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 +3683,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 +3714,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 +3753,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 +3767,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 +3917,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 (14650 21966 (BKSYSCHARCODE 14660 . 15009) (\CLEARSYSBUF 15011 . 15569) (\GETKEY 15571
|
||||
. 16746) (\NSYSBUFCHARS 16748 . 17490) (\SAVESYSBUF 17492 . 19101) (\SYSBUFP 19103 . 19407) (
|
||||
\GETSYSBUF 19409 . 19589) (\PUTSYSBUF 19591 . 20804) (\PEEKSYSBUF 20806 . 21964)) (23251 60705 (
|
||||
\KEYBOARDINIT 23261 . 24981) (\KEYBOARDEVENTFN 24983 . 29683) (\ALLOCLOCKED 29685 . 30275) (
|
||||
\SETIOPOINTERS 30277 . 34813) (\KEYBOARDOFF 34815 . 35229) (\KEYBOARDON 35231 . 35610) (\KEYHANDLER
|
||||
35612 . 35743) (\KEYHANDLER1 35745 . 43191) (\RESETKEYBOARD 43193 . 44841) (\DOMOUSECHORDING 44843 .
|
||||
48663) (\DOTRANSITIONS 48665 . 49342) (\DECODETRANSITION 49344 . 56653) (MOUSECHORDWAIT 56655 . 57319)
|
||||
(\TRACKCURSOR 57321 . 60703)) (95107 116980 (KEYACTION 95117 . 95970) (KEYACTIONTABLE 95972 . 97154)
|
||||
(KEYBOARDTYPE 97156 . 98258) (RESETKEYACTION 98260 . 100019) (\KEYBOARD.MACHINE-SPECIFIC-KEYACTIONS
|
||||
100021 . 101923) (\KEYACTION1 101925 . 112041) (KEYDOWNP 112043 . 112378) (KEYNUMBERP 112380 . 112578)
|
||||
(\KEYNAMETONUMBER 112580 . 113274) (\KEYNUMBERTONAME 113276 . 113466) (MODIFY.KEYACTIONS 113468 .
|
||||
114329) (METASHIFT 114331 . 115275) (SHIFTDOWNP 115277 . 116978)) (117043 117339 (
|
||||
SETUP.OFFICE.KEYBOARD 117053 . 117337)) (120318 122030 (\INIT.KEYBOARD.STREAM 120328 . 122028)) (
|
||||
122295 138672 (\DOBUFFEREDTRANSITIONS 122305 . 137735) (\TIMER.INTERRUPTFRAME 137737 . 138462) (
|
||||
\PERIODIC.INTERRUPTFRAME 138464 . 138670)) (138926 143003 (\HARDCURSORUP 138936 . 140818) (
|
||||
\HARDCURSORPOSITION 140820 . 142856) (\HARDCURSORDOWN 142858 . 143001)) (143004 167064 (CURSOR.INIT
|
||||
143014 . 146714) (\CURSORDESTINATION 146716 . 149034) (\SOFTCURSORUP 149036 . 154290) (
|
||||
\SOFTCURSORUPCURRENT 154292 . 161328) (\SOFTCURSORPOSITION 161330 . 162095) (\SOFTCURSORDOWN 162097 .
|
||||
162805) (CURSORPROP 162807 . 163149) (GETCURSORPROP 163151 . 163339) (PUTCURSORPROP 163341 . 164496) (
|
||||
\CURSORBITSPERPIXEL 164498 . 166614) (\CURSORIMAGEPROPNAME 166616 . 166840) (\CURSORMASKPROPNAME
|
||||
166842 . 167062)) (167065 185015 (CURSORCREATE 167075 . 169750) (CURSOR 169752 . 171564) (
|
||||
\CURSOR-VALID-P 171566 . 172653) (\CURSORUP 172655 . 174370) (\CURSORPOSITION 174372 . 176900) (
|
||||
\CURSORDOWN 176902 . 177135) (ADJUSTCURSORPOSITION 177137 . 177715) (CURSORPOSITION 177717 . 179259) (
|
||||
CURSORSCREEN 179261 . 179917) (CURSOREXIT 179919 . 181310) (FLIPCURSOR 181312 . 182438) (FLIPCURSORBAR
|
||||
182440 . 183420) (LASTMOUSEX 183422 . 183676) (LASTMOUSEY 183678 . 183932) (CREATEPOSITION 183934 .
|
||||
184140) (POSITIONP 184142 . 184426) (CURSORHOTSPOT 184428 . 185013)) (186253 187801 (GETMOUSESTATE
|
||||
186263 . 186922) (\EVENTKEYS 186924 . 187799)) (194000 194796 (MACHINETYPE 194010 . 194410) (
|
||||
SETMAINTPANEL 194412 . 194794)) (194826 195965 (BEEPON 194836 . 195489) (BEEPOFF 195491 . 195963)) (
|
||||
196416 196679 (WITHOUT-INTERRUPTS 196426 . 196677)))))
|
||||
STOP
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user