(FILECREATED "11-Nov-85 00:37:02" {ERIS}<LISPCORE>SOURCES>LLKEY.;76
 104314 

      changes to:  (FNS \KEYBOARDEVENTFN)

      previous date: "31-Oct-85 16:13:11" {ERIS}<LISPCORE>SOURCES>LLKEY.;75)


(* Copyright (c) 1982, 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT LLKEYCOMS)

(RPAQQ LLKEYCOMS
 [(COMS (* Access to keyboard)
			  (FNS BKSYSCHARCODE \CLEARSYSBUF \GETKEY \NSYSBUFCHARS \SAVESYSBUF \SYSBUFP 
			       \GETSYSBUF \PUTSYSBUF \PEEKSYSBUF)
			  (INITVARS (\LONGSYSBUF))
			  (INITVARS (\\KEYBOARDWAITBOX.GLOBALRESOURCE))
			  (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)
					     (P (MOVD? (QUOTE NILL)
						       (QUOTE CARET]
	(COMS (* Key handler)
	      (FNS \KEYBOARDINIT \KEYBOARDEVENTFN \ALLOCLOCKED \SETIOPOINTERS \KEYBOARDOFF 
		   \KEYBOARDON \KEYHANDLER \KEYHANDLER1 \RESETKEYBOARD \DOMOUSECHORDING 
		   \DOTRANSITIONS \DECODETRANSITION MOUSECHORDWAIT \TRACKCURSOR)
	      (INITVARS (\MOUSECHORDTICKS)
			(\MOUSECHORDMILLISECONDS 50))
	      (DECLARE: DONTEVAL@LOAD DOCOPY (P (\KEYBOARDINIT)))
	      [DECLARE: DONTCOPY (MACROS .NOTELASTUSERACTION)
			(CONSTANTS ALLUP \CTRLMASK \METABIT)
			(CONSTANTS * DLMOUSEBITS)
			(CONSTANTS * DLMOUSESTATES)
			(CONSTANTS * TRANSITIONFLAGS)
			(MACROS \TRANSINDEX ARMEDCODE TRANSITIONSHIFTCODE TRANSITIONCODE 
				TRANSITIONFLAGS)
			(EXPORT (RECORDS KEYACTION)
				(CONSTANTS \NKEYS))
			(RECORDS RING)
			(COMS (* can get rid of shiftstate after clients have been fixed)
			      (RECORDS SHIFTSTATE)
			      (GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP))
			(CONSTANTS NRINGINDEXWORDS)
			(CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD))
				   (\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE]
	      (DECLARE: EVAL@COMPILE (VARS \KEYNAMES))
	      (VARS \ORIGKEYACTIONS \DLIONKEYACTIONS \DLIONOSDKEYACTIONS \DORADOKEYACTIONS 
		    \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)
	      (INITVARS (\KEYBOARD.META 256)
			(\MODIFIED.KEYACTIONS))
	      (GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \RCLKSECOND 
			  \LASTUSERACTION \MOUSECHORDTICKS \LASTKEYSTATE \KEYBOARDEVENTQUEUE 
			  \KEYBUFFERING \CURRENTKEYACTION \DEFAULTKEYACTION \COLORCURSORHEIGHT 
			  SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING \ORIGKEYACTIONS 
			  \KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS 
			  \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS))
	(COMS (* Key interpretation)
	      (FNS KEYACTION KEYACTIONTABLE \KEYACTION1 KEYDOWNP \KEYNAMETONUMBER MODIFY.KEYACTIONS 
		   METASHIFT SHIFTDOWNP)
	      (FNS SETUP.OFFICE.KEYBOARD)
	      (* To support office style 1108 & 1186 keyboards)
	      (MACROS \KEYNAMETONUMBER \TEMPCOPYTIMER)
	      (EXPORT (MACROS XKEYDOWNP KEYDOWNP KEYDOWNP1 \NEWKEYDOWNP)))
	[COMS (FNS \SHOWCOLORCURSOR)
	      (INITVARS (\COLORCURSORBM)
			(\COLORCURSORDOWN)
			(\ColorCursorBBT)
			(\COLORCURSOR))
	      (EXPORT (MACROS COLORNUMBERBITSPERPIXEL \BITADDRESSOFPIXEL .TAKE.DOWN.COLOR.CURSOR)
		      (CONSTANTS (COLORSCREENWIDTH 640)
				 (COLORSCREENHEIGHT 480]
	(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)
	      (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.)
	      (FNS ADJUSTCURSORPOSITION CREATEPOSITION CURSOR CURSORCREATE CURSORHOTSPOT 
		   CURSORPOSITION \SETCURSORPOSITION FLIPCURSOR FLIPCURSORBAR LASTMOUSEX LASTMOUSEY 
		   POSITIONP SETCURSOR)
	      (FNS GETMOUSESTATE \EVENTKEYS)
	      [EXPORT (CONSTANTS (CURSORHEIGHT 16)
				 (CURSORWIDTH 16))
		      (DECLARE: EVAL@COMPILE (ADDVARS (GLOBALVARS LASTMOUSEX LASTMOUSEY 
								  LASTMOUSEBUTTONS LASTMOUSETIME 
								  LASTKEYBOARD]
	      (INITVARS (\MOUSEHOTSPOTX 0)
			(\MOUSEHOTSPOTY 15))
	      (GLOBALVARS \MOUSEHOTSPOTX \MOUSEHOTSPOTY \MOUSETIMEBOX \COLORCURSOR)
	      (DECLARE: DONTCOPY (EXPORT (MACROS \SETMOUSEXY))
			(MACROS \XMOUSECOORD \YMOUSECOORD))
	      [DECLARE: DONTEVAL@LOAD DOCOPY (VARS (\SFPosition (CREATEPOSITION]
	      (DECLARE: DOEVAL@COMPILE (VARS (SCREENHEIGHT 808]
	[COMS (DECLARE: DONTCOPY (RECORDS KEYBOARDEVENT)
			(CONSTANTS (\KEYBOARDEVENT.FIRST NRINGINDEXWORDS)
				   \KEYBOARDEVENT.SIZE
				   (\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES 
									      \KEYBOARDEVENT.SIZE 383]
	(COMS (FNS MACHINETYPE SETMAINTPANEL)
	      (* 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 
			    \EM.DISPINTERRUPT \EM.DISPLAYHEAD \EM.CURSORBITMAP \MACHINETYPE 
			    \COLORCURSORBM \COLORCURSOR \COLORCURSORDOWN \ColorCursorBBT 
			    \COLORCURSORWIDTH \COLORSCREENCURSORLINEBASE \COLORSCREENCURSORLINE 
			    \COLORCURSORBASE \COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH 
			    \COLORCURSORRASTERWIDTH \DEFAULTKEYACTION \CURRENTKEYACTION 
			    \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY))
	(FNS WITHOUT-INTERRUPTS)
	(COMS (* Compile locked fns together for locality)
	      (BLOCKS (NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR \DOMOUSECHORDING 
			   \PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS 
			   \DOTRANSITIONS \DECODETRANSITION \EVENTKEYS)))
	[DECLARE: DONTCOPY
		  (ADDVARS [INEWCOMS (ALLOCAL (ADDVARS (LOCKEDFNS \KEYHANDLER \KEYHANDLER1 
								  \DOMOUSECHORDING \CONTEXTAPPLY 
								  \LOCKPAGES \SMASHLINK \INCUSECOUNT 
								  LLSH \MAKEFREEBLOCK \DECUSECOUNT 
								  \MAKENUMBER \ADDBASE 
								  \PERIODIC.INTERRUPTFRAME 
								  \DOBUFFEREDTRANSITIONS 
								  \TIMER.INTERRUPTFRAME \TRACKCURSOR 
								  FLIPCURSORBAR)
						       (LOCKEDVARS \InterfacePage \MOUSEHOTSPOTX 
								   \MOUSEHOTSPOTY \PENDINGINTERRUPT 
								   \COLORCURSORBM \COLORCURSORDOWN 
								   \COLORDISPLAYBITSPERPIXEL 
								   \ColorCursorBBT \COLORCURSORWIDTH 
								   \COLORSCREENCURSORLINE 
								   \COLORSCREENCURSORLINEBASE 
								   \COLORCURSORBASE 
								   \COLORSCREENWIDTHINBITS 
								   \COLORSCREENRASTERWIDTH 
								   \COLORCURSORRASTERWIDTH 
								   \PERIODIC.INTERRUPT 
								   \PERIODIC.INTERRUPT.FREQUENCY 
								   \LASTUSERACTION \MOUSECHORDTICKS 
								   \KEYBOARDEVENTQUEUE \KEYBUFFERING 
								   SCREENWIDTH SCREENHEIGHT 
								   \TIMER.INTERRUPT.PENDING 
								   \EM.MOUSEX \EM.MOUSEY \EM.CURSORX 
								   \EM.CURSORY \EM.UTILIN 
								   \EM.REALUTILIN \EM.KBDAD0 
								   \EM.KBDAD1 \EM.KBDAD2 \EM.KBDAD3 
								   \EM.DISPINTERRUPT \EM.CURSORBITMAP 
								   \EM.KBDAD4 \EM.KBDAD5 \MISCSTATS 
								   \RCLKSECOND]
			   (RDCOMS (FNS \SETIOPOINTERS]
	(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA)
									      (NLAML 
									       WITHOUT-INTERRUPTS)
									      (LAMA METASHIFT 
										   MOUSECHORDWAIT])



(* Access to keyboard)


(DEFINEQ

(BKSYSCHARCODE

  [LAMBDA (CHAR)                                             (* rrb "30-Dec-83 11:56")

    (
OR
 (\PUTSYSBUF
 CHAR)
	(
PROGN
 (
SETQ
 \LONGSYSBUF (
NCONC
 \LONGSYSBUF (bind
 C while
 (
SETQ
 C (\GETREALSYSBUF))
						       collect
 C)))
	       (\PUTSYSBUF
 CHAR])

(\CLEARSYSBUF

  [LAMBDA (ALLFLG)                                           (* mpl "27-Jun-85 20:04")

    (DECLARE
 (
GLOBALVARS
 \PROCESSES))
    (
COND

      ((
OR
 ALLFLG (
TTY.PROCESSP
))
	(
SETQ
 \LONGSYSBUF)
	(replace
 (RING READ) of
 \SYSBUFFER with
 0)))
    (
COND

      (ALLFLG (for
 PROC in
 \PROCESSES do
 (replace
 PROCTYPEAHEAD of
 PROC with
 NIL)))
      ((
THIS.PROCESS
)
	(replace
 PROCTYPEAHEAD of
 (
THIS.PROCESS
) with
 NIL])

(\GETKEY

  [LAMBDA NIL                                                (* lmm "18-Apr-85 00:07")

    (DECLARE
 (
GLOBALVARS
 \KEYBOARDWAIT1 \KEYBOARDWAIT2))
    (
COND

      [(
AND
 (
THIS.PROCESS
)
	    (fetch
 PROCTYPEAHEAD of
 (
THIS.PROCESS
)))
	(pop
 (fetch
 PROCTYPEAHEAD of
 (
THIS.PROCESS
]
      (T (
WAIT.FOR.TTY
)
	 (
OR
 (\GETSYSBUF
)
	     (GLOBALRESOURCE (\KEYBOARDWAITBOX)              (* Busy-wait loop that gets next character)

			     (
\CLOCK0
 \KEYBOARDWAITBOX)
			     (bind
 C
				do
 (
COND

				     ((
SETQ
 C (\GETSYSBUF
))
				       (
\BOXIPLUS
 (LOCF (fetch
 KEYBOARDWAITTIME of
 \MISCSTATS))
						  (
CLOCKDIFFERENCE
 \KEYBOARDWAITBOX))
				       (
RETURN
 C)))
				   (
\TTYBACKGROUND
)
				   (
\WAIT.FOR.TTY
])

(\NSYSBUFCHARS

  [LAMBDA NIL                                                (* JonL " 7-May-84 01:50")

                                                             (* Tells how many characters can be \GETSYSBUFed.

							     Used by \SAVESYSBUF.)

    (
IPLUS
 (
LENGTH
 \LONGSYSBUF)
	   (
PROG
 ((R (fetch
 (RING READ) of
 \SYSBUFFER))
		  (W (fetch
 (RING WRITE) of
 \SYSBUFFER)))
	         (
RETURN
 (
COND

			   ((
EQ
 0 R)
			     0)
			   ((
IGREATERP
 W R)
			     (
IDIFFERENCE
 W R))
			   (T (
IDIFFERENCE
 W (
IDIFFERENCE
 R \SYSBUFSIZE])

(\SAVESYSBUF

  [LAMBDA NIL                                                (* JonL " 7-May-84 01:50")

    (DECLARE
 (
GLOBALVARS
 \SAVEDSYSBUFFER))
    (
PROG
 (TA (BUF \SAVEDSYSBUFFER)
	      (NC (\NSYSBUFCHARS
))
	      (J 0))
          [
COND

	    ((
TTY.PROCESSP
)
	      [
COND

		([
AND
 (
THIS.PROCESS
)
		      (
SETQ
 TA (fetch
 PROCTYPEAHEAD of
 (
THIS.PROCESS
]
		  (replace
 PROCTYPEAHEAD of
 (
THIS.PROCESS
) with
 NIL)
		  (add
 NC (
LENGTH
 TA))
		  [
COND

		    ((
IGREATERP
 NC (
NCHARS
 BUF))
		      (
SETQ
 BUF (
ALLOCSTRING
 NC]
		  (for
 CH in
 TA do
 (
RPLCHARCODE
 BUF (add
 J 1)
						CH)))
		((
IGREATERP
 NC (
NCHARS
 BUF))
		  (
SETQ
 BUF (
ALLOCSTRING
 NC]
	      (for
 I from
 (
ADD1
 J) to
 NC
		 do
 

          (* Test on J means that we'll ignore extra chars typed since we got the length. Test on \GETSYSBUF so we don't get 

	  screwed if buffer gets cleared while during this loop)



		    (
RPLCHARCODE
 BUF I (
OR
 (\GETSYSBUF
)
					   (
PROGN
 (
SETQ
 NC (
SUB1
 I))
						  (
RETURN
]
          (
RETURN
 (
AND
 (
NOT
 (
EQ
 0 NC))
		       (
SUBSTRING
 BUF 1 NC])

(\SYSBUFP

  [LAMBDA NIL                                                (* JonL " 7-May-84 01:52")

    (
OR
 [
AND
 (
TTY.PROCESSP
)
	     (
OR
 \LONGSYSBUF (
NOT
 (
EQ
 0 (fetch
 (RING READ) of
 \SYSBUFFER]
	(
AND
 (
THIS.PROCESS
)
	     (fetch
 PROCTYPEAHEAD of
 (
THIS.PROCESS
])

(\GETSYSBUF

  [LAMBDA NIL                                                (* lmm " 9-JUL-83 00:56")

    (
OR
 (
AND
 \LONGSYSBUF (pop
 \LONGSYSBUF))
	(\GETREALSYSBUF])

(\PUTSYSBUF

  [LAMBDA (CHAR)                                             (* rmk: "27-Nov-84 17:51")

    (
PROG
 ((R (fetch
 (RING READ) of
 \SYSBUFFER))
	   (W (fetch
 (RING WRITE) of
 \SYSBUFFER)))
          (
RETURN
 (
COND

		    ((
EQ
 R W)                                (* Full)

		      NIL)
		    (T (\PUTBASEFAT \SYSBUFFER W CHAR)
		       (
AND
 (
EQ
 0 R)
			    (replace
 (RING READ) of
 \SYSBUFFER with
 W))
                                                             (* Return random non-NIL value to indicate success for 

							     BKSYSBUF)

		       [replace
 (RING WRITE) of
 \SYSBUFFER with
 (
COND

								  ((
EQ
 \SYSBUFFER.LAST W)
								    \SYSBUFFER.FIRST)
								  (T (
ADD1
 W]
		       T])

(\PEEKSYSBUF

  [LAMBDA (STREAM)                                           (* bvm: " 8-Feb-85 17:50")

    (
PROG
 (R)
      WAIT(until
 (\SYSBUFP
) do
 (
BLOCK
))
          (
RETURN
 (if
 (
TTY.PROCESSP
)
		      then
 (if
 \LONGSYSBUF
			       then
 (
CAR
 \LONGSYSBUF)
			     elseif
 (
NEQ
 (
SETQ
 R (fetch
 (RING READ) of
 \SYSBUFFER))
					 0)
			       then
                          (* Here's the vanilla case)

				    (\GETBASEFAT \SYSBUFFER R)
			     else
                            (* Foo an interrupt could have sneaked in here and 

							     gobbled down the remaining characters)

				  (
GO
 WAIT))
		    elseif
 (
THIS.PROCESS
)
		      then
 (
CAR
 (fetch
 PROCTYPEAHEAD of
 (
THIS.PROCESS
)))
		    else
 (
SHOULDNT
])
)

(RPAQ? \LONGSYSBUF
 )

(RPAQ? \\KEYBOARDWAITBOX.GLOBALRESOURCE
 )
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 
[PUTDEF (QUOTE \KEYBOARDWAITBOX)
	(QUOTE RESOURCES)
	(QUOTE (NEW (CREATECELL \FIXP]
)
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 

(RPAQQ \SYSBUFSIZE
 200)

(CONSTANTS (\SYSBUFSIZE 200))
)

(DECLARE: EVAL@COMPILE 
[PUTPROPS \GETREALSYSBUF MACRO
	  (NIL (PROG ((R (fetch (RING READ)
				of \SYSBUFFER)))
		     (RETURN (AND (NOT (EQ 0 R))
				  (PROG1 (\GETBASEFAT \SYSBUFFER R)
					 (AND [EQ (fetch (RING WRITE)
							 of \SYSBUFFER)
						  (replace (RING READ)
							   of \SYSBUFFER with (COND
							     ((EQ \SYSBUFFER.LAST R)
							      \SYSBUFFER.FIRST)
							     (T (ADD1 R]
					      (replace (RING READ)
						       of \SYSBUFFER with 0]
)
)
(DECLARE: DOCOPY DONTEVAL@LOAD 



(* Here because it must be done in init before PROC loaded)


(MOVD? (QUOTE NILL)
       (QUOTE CARET))
)



(* Key handler)


(DEFINEQ

(\KEYBOARDINIT

  [LAMBDA NIL                                                (* lmm "23-May-85 15:57")

    (DECLARE
 (
GLOBALVARS
 \SAVEDSYSBUFFER))                   (* Sets up keyboard decoding tables.)

    (
SETQ
 \CURRENTKEYACTION (
SETQ
 \DEFAULTKEYACTION (create
 KEYACTION)))
    (for
 X in
 \ORIGKEYACTIONS do
 (KEYACTION
 (
CAR
 X)
					    (
CDR
 X)))
    (
SETQ
 \INTERRUPTSTATE (\ALLOCLOCKED
 2))
    (
PROGN
 (
SETQ
 \SYSBUFFER (
\ALLOCBLOCK
 (FOLDHI (
ADD1
 \SYSBUFFER.LAST)
						 WORDSPERCELL)))
	   (replace
 (RING READ) of
 \SYSBUFFER with
 0)
	   (replace
 (RING WRITE) of
 \SYSBUFFER with
 \SYSBUFFER.FIRST))
    (
SETQ
 \SAVEDSYSBUFFER (
ALLOCSTRING
 \SYSBUFSIZE NIL NIL T))
    (
SETQ
 \LASTUSERACTION (LOCF (fetch
 LASTUSERACTION of
 \MISCSTATS)))
    (
PROGN
 (
SETQ
 \KEYBOARDEVENTQUEUE (\ALLOCLOCKED
 (FOLDHI (
PLUS
 \KEYBOARDEVENT.LAST 
								 \KEYBOARDEVENT.SIZE)
							   WORDSPERCELL)))
	   (replace
 (RING READ) of
 \KEYBOARDEVENTQUEUE with
 0)
	   (replace
 (RING WRITE) of
 \KEYBOARDEVENTQUEUE with
 \KEYBOARDEVENT.FIRST))
    (
SETQ
 \LASTKEYSTATE (create
 KEYBOARDEVENT))
    (
SETQ
 \SHIFTSTATE (create
 SHIFTSTATE))
    (
SETQ
 \MOUSETIMERTEMP (
SETUPTIMER
 0 NIL (
QUOTE
 TICKS)))
    (MOUSECHORDWAIT
 \MOUSECHORDMILLISECONDS)
    (\KEYBOARDON
])

(\KEYBOARDEVENTFN

  [LAMBDA (FDEV EVENT EXTRA)                                 (* jds "11-Nov-85 00:30")

    (DECLARE
 (
GLOBALVARS
 \KEYBOARD.BEFORETYPE \DORADOKEYACTIONS \DLIONKEYACTIONS))
    (
SELECTQ
 EVENT
	       ((BEFORELOGOUT BEFOREMAKESYS BEFORESYSOUT BEFORESAVEVM)
		 (
SETQ
 \KEYBOARD.BEFORETYPE \MACHINETYPE))
	       [(AFTERLOGOUT AFTERMAKESYS AFTERSYSOUT AFTERSAVEVM)
                                                             (* Restarting a world. If we changed machines, fix up 

							     the key actions to match the new machine.)

		 (
COND

		   ((
NEQ
 \MACHINETYPE \KEYBOARD.BEFORETYPE)
                                                             (* Changed machines. Change Keyactions.)

		     (for
 X in
 (
SELECTC
 \MACHINETYPE
					      (\DORADO \DORADOKEYACTIONS)
					      (\DANDELION \DLIONKEYACTIONS)
					      (\DAYBREAK     (* Moving to a daybreak. Need to distinguish among the

							     various kinds of keyboard.)


          (* For now, we only distinguish between the office keyboards (1 = US, 2 = Euro, 3 = Japanese, 4 = ADM-3), and some 

	  yet-to-be-determined Lisp-keyboard number)



							 (
COND

							   ((
ILEQ
 (
\DoveMisc.ReadKeyboardType
)
								    4)
                                                             (* It's an office keyboard.

							     Set it up right!)

							     (
APPEND
 \DOVEKEYACTIONS 
								       \DOVEOSDKEYACTIONS))
							   (T 
                                                             (* Lisp keyboard. Leave the Dove keyactions as they 

							     were.)

							      \DOVEKEYACTIONS)))
					      NIL)
			do
 (KEYACTION
 (
CAR
 X)
					  (
CDR
 X)
					  \DEFAULTKEYACTION))
		     (MOUSECHORDWAIT
 (MOUSECHORDWAIT
]
	       ((AFTERDOSAVEVM AFTERDOMAKESYS)
		 NIL)
	       NIL])

(\ALLOCLOCKED

  [LAMBDA (NCELLS)                                           (* lmm "20-Apr-85 13:08")

                                                             (* allocate a block of NCELLS cells and lock it)

    (
PROG
 [(
BLOCK
 (
\ALLOCBLOCK
 NCELLS NIL (
IMIN
 NCELLS CELLSPERPAGE]
          (
\LOCKCELL
 BLOCK (FOLDHI (
IPLUS
 (fetch
 (POINTER WORDINPAGE) of
 BLOCK)
					  (UNFOLD NCELLS WORDSPERCELL))
				   WORDSPERPAGE))
          (
RETURN
 BLOCK])

(\SETIOPOINTERS

  [LAMBDA NIL                                                (* bvm: " 9-Oct-85 11:49")

    (
SELECTC
 (
SETTOPVAL
 (
QUOTE
 \MACHINETYPE)
			    (fetch
 MachineType of
 \InterfacePage))
	       ((
LIST
 \DOLPHIN \DORADO)
		 (
SETTOPVAL
 (
QUOTE
 \EM.MOUSEX)
			      (EMADDRESS MOUSEX.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.MOUSEY)
			      (EMADDRESS MOUSEY.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.CURSORX)
			      (EMADDRESS CURSORX.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.CURSORY)
			      (EMADDRESS CURSORY.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.REALUTILIN)
			      (EMADDRESS UTILIN.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD0)
			      (EMADDRESS KBDAD0.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD1)
			      (EMADDRESS KBDAD1.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD2)
			      (EMADDRESS KBDAD2.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD3)
			      (EMADDRESS KBDAD3.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD4)
			      (LOCF (fetch
 FAKEKBDAD4 of
 \InterfacePage)))
		 (
\PUTBASE
 \EM.KBDAD4 0 ALLUP)
		 (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD5)
			      (LOCF (fetch
 FAKEKBDAD5 OF
 \InterfacePage)))
		 (
\PUTBASE
 \EM.KBDAD5 0 ALLUP)
		 (
SETTOPVAL
 (
QUOTE
 \EM.DISPINTERRUPT)
			      (EMADDRESS DISPINTERRUPT.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.CURSORBITMAP)
			      (EMADDRESS CURSORBITMAP.EM))
		 (
SETTOPVAL
 (
QUOTE
 \EM.DISPLAYHEAD)
			      (EMADDRESS DCB.EM))
		 (
SETTOPVAL
 (
QUOTE
 SCREENWIDTH)
			      (UNFOLD (fetch
 ScreenWidth of
 \InterfacePage)
				      BITSPERWORD)))
	       (\DANDELION (
SETTOPVAL
 (
QUOTE
 \EM.MOUSEX)
					(fetch
 DLMOUSEXPTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.MOUSEY)
					(fetch
 DLMOUSEYPTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.CURSORX)
					(fetch
 DLCURSORXPTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.CURSORY)
					(fetch
 DLCURSORYPTR of
 \IOPAGE))
			   (
PROGN
 (
SETTOPVAL
 (
QUOTE
 \EM.REALUTILIN)
						 (fetch
 DLUTILINPTR of
 \IOPAGE))
                                                             (* Where the hardware bits live, vs.

							     where the Lisp software sees them after 

							     reinterpretation by keyhandler)

				    )
			   (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD0)
					(fetch
 DLKBDAD0PTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD1)
					(fetch
 DLKBDAD1PTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD2)
					(fetch
 DLKBDAD2PTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD3)
					(fetch
 DLKBDAD3PTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD4)
					(fetch
 DLKBDAD4PTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD5)
					(fetch
 DLKBDAD5PTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.DISPINTERRUPT)
					(fetch
 DLDISPINTERRUPTPTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.CURSORBITMAP)
					(fetch
 DLCURSORBITMAPPTR of
 \IOPAGE))
			   (
SETTOPVAL
 (
QUOTE
 \EM.DISPLAYHEAD)
					NIL)
			   (
SETTOPVAL
 (
QUOTE
 SCREENWIDTH)
					1024))
	       [\DAYBREAK (
PROG
 ((KBDBASE (
\DoveMisc.GetKBDBase
)))
			          (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD0)
					       (
\ADDBASE
 KBDBASE 1))
			          (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD1)
					       (
\ADDBASE
 KBDBASE 2))
			          (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD2)
					       (
\ADDBASE
 KBDBASE 3))
			          (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD3)
					       (
\ADDBASE
 KBDBASE 4))
			          (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD4)
					       (
\ADDBASE
 KBDBASE 5))
			          (
SETTOPVAL
 (
QUOTE
 \EM.KBDAD5)
					       (
\ADDBASE
 KBDBASE 6))
			          (
SETTOPVAL
 (
QUOTE
 \EM.MOUSEX)
					       (
\DoveMisc.GetMouseXBase
))
			          (
SETTOPVAL
 (
QUOTE
 \EM.MOUSEY)
					       (
\DoveMisc.GetMouseYBase
))
			          (
SETTOPVAL
 (
QUOTE
 \EM.CURSORBITMAP)
					       (
\DoveDisplay.GetCursorBitmapBase
))
                                                             (* These three set this way to prevent address faults)

			          (
SETTOPVAL
 (
QUOTE
 \EM.DISPINTERRUPT)
					       (fetch
 DLDISPINTERRUPTPTR of
 \IOPAGE))
			          (
SETTOPVAL
 (
QUOTE
 \EM.CURSORX)
					       (fetch
 DLCURSORXPTR of
 \IOPAGE))
			          (
SETTOPVAL
 (
QUOTE
 \EM.CURSORY)
					       (fetch
 DLCURSORYPTR of
 \IOPAGE))
			          (
PROGN
 (
SETTOPVAL
 (
QUOTE
 \EM.REALUTILIN)
							KBDBASE)
                                                             (* Where the hardware bits live, vs.

							     where the Lisp software sees them after 

							     reinterpretation by keyhandler)

					   )
			          (
SETTOPVAL
 (
QUOTE
 SCREENWIDTH)
					       (
\DoveDisplay.ScreenWidth
]
	       (
RAID
))
    (
SETTOPVAL
 (
QUOTE
 \EM.UTILIN)
		 (LOCF (fetch
 (IFPAGE FAKEMOUSEBITS) of
 \InterfacePage])

(\KEYBOARDOFF

  [LAMBDA NIL                                                (* lmm "30-MAR-83 20:40")

    (
\PUTBASE
 \EM.DISPINTERRUPT 0 (
LOGAND
 (
LOGXOR
 65535 \LispKeyMask)
					  (
\GETBASE
 \EM.DISPINTERRUPT 0])

(\KEYBOARDON

  [LAMBDA (NOCHECK)                                          (* lmm "30-MAR-83 20:39")

    (\SETIOPOINTERS
)
    (
\PUTBASE
 \EM.DISPINTERRUPT 0 (
LOGOR
 \LispKeyMask (
\GETBASE
 \EM.DISPINTERRUPT 0])

(\KEYHANDLER

  [LAMBDA NIL                                                (* lmm "30-MAR-83 20:40")

    (\KEYHANDLER1
])

(\KEYHANDLER1

  [LAMBDA NIL                                                (* bvm: " 9-Oct-85 12:46")

    (
PROG
 ((OLD0 ALLUP)
	     (OLD1 ALLUP)
	     (OLD2 ALLUP)
	     (OLD3 ALLUP)
	     (OLD4 ALLUP)
	     (OLD5 ALLUP)
	     (OLDU ALLUP)
	     (OLDFAKEU ALLUP)
	     (LOOPCNT 10)
	     (PERIODCNT 60)
	     (MOUSESTATE \DLMOUSE.UP)
	     (MOUSETIMER (LOCF (fetch
 DLMOUSETIMER of
 \MISCSTATS)))
	     (MOUSETEMP (LOCF (fetch
 DLMOUSETEMP of
 \MISCSTATS)))
	     CURSORX CURSORY YHOT)
	    (
SETQ
 \KEYBUFFERING NIL)
	    (replace
 (RING READ) of
 \KEYBOARDEVENTQUEUE with
 0)
	LP  (
\CONTEXTSWITCH
 \KbdFXP)
	    [
COND

	      (\PERIODIC.INTERRUPT                           (* eventually can be replaced with general timer 

							     mechanism)

				   (
COND

				     ((
IGREATERP
 PERIODCNT 0)
                                                             (* Continue counting down to zero)

				       (
SETQ
 PERIODCNT (
SUB1
 PERIODCNT)))
				     ((
\CAUSEINTERRUPT
 \KbdFXP (
FUNCTION
 \PERIODIC.INTERRUPTFRAME)
							 )   (* When we've counted down, then keep trying to cause 

							     the interrupt, and reset the counter when it finally 

							     happens)

				       (
SETQ
 PERIODCNT (
SUB1
 (
OR
 \PERIODIC.INTERRUPT.FREQUENCY 
								       1]
	    [
COND

	      ((
OR
 (
NEQ
 (
\GETBASE
 \EM.MOUSEX 0)
			    CURSORX)
		     (
NEQ
 (
\GETBASE
 \EM.MOUSEY 0)
			    CURSORY))
		(\TRACKCURSOR
 (
SETQ
 CURSORX (
\GETBASE
 \EM.MOUSEX 0))
				(
SETQ
 CURSORY (
\GETBASE
 \EM.MOUSEY 0]
	    [
COND

	      ((
OR
 [
COND

		       ((
OR
 (
NEQ
 OLDU (
\GETBASE
 \EM.REALUTILIN 0))
			      (
COND

				((
AND
 (
EQ
 MOUSESTATE \DLMOUSE.WAITING)
					(
IGREATERP
 (
\BOXIDIFFERENCE
 (\RCLK MOUSETEMP)
									MOUSETIMER)
						     0))     (* Timer expired on seeing both left and right down, 

							     so set state to normal)

				  (
SETQ
 MOUSESTATE \DLMOUSE.NORMAL)
				  T)))
			 (
SETQ
 MOUSESTATE (\DOMOUSECHORDING
 (
SETQ
 OLDU (
\GETBASE
 
										   \EM.REALUTILIN 0))
								MOUSESTATE))
			 (
NEQ
 OLDFAKEU (
\GETBASE
 \EM.UTILIN 0]
		     (
NEQ
 OLD0 (
\GETBASE
 \EM.KBDAD0 0))
		     (
NEQ
 OLD1 (
\GETBASE
 \EM.KBDAD1 0))
		     (
NEQ
 OLD2 (
\GETBASE
 \EM.KBDAD2 0))
		     (
NEQ
 OLD3 (
\GETBASE
 \EM.KBDAD3 0))
		     (
NEQ
 OLD4 (
\GETBASE
 \EM.KBDAD4 0))
		     (
NEQ
 OLD5 (
\GETBASE
 \EM.KBDAD5 0)))
		(
COND

		  ((
EQ
 0 (
LOGAND
 (
\GETBASE
 \EM.KBDAD2 0)
				     2114))                  (* Ctrl-shift-DEL panic interrupt -- switch to 

							     TeleRaid immediately)

		    (swap
 (fetch
 (IFPAGE TELERAIDFXP) of
 \InterfacePage)
			    (fetch
 (IFPAGE KbdFXP) of
 \InterfacePage))
		    (\KEYBOARDOFF
)
		    (
SETQ
 OLD2 (
\GETBASE
 \EM.KBDAD2 0))
		    (
GO
 LP)))
		[
PROG
 ((W (fetch
 (RING WRITE) of
 \KEYBOARDEVENTQUEUE))
			 (R (fetch
 (RING READ) of
 \KEYBOARDEVENTQUEUE))
			 WPTR)
		        (
COND

			  ((
EQ
 R W)                        (* eventqueue full!)

			    (
RETURN
)))
		        (
SETQ
 WPTR (
\ADDBASE
 \KEYBOARDEVENTQUEUE W))
		        (\RCLK (LOCF (fetch
 TIME of
 WPTR)))
		        [with
 KEYBOARDEVENT WPTR (
PROGN
 (
SETQ
 W0 (
SETQ
 OLD0 (
\GETBASE

								  \EM.KBDAD0 0)))
							    (
SETQ
 W1 (
SETQ
 OLD1 (
\GETBASE

								  \EM.KBDAD1 0)))
							    (
SETQ
 W2 (
SETQ
 OLD2 (
\GETBASE

								  \EM.KBDAD2 0)))
							    (
SETQ
 W3 (
SETQ
 OLD3 (
\GETBASE

								  \EM.KBDAD3 0)))
							    (
SETQ
 W4 (
SETQ
 OLD4 (
\GETBASE

								  \EM.KBDAD4 0)))
							    (
SETQ
 W5 (
SETQ
 OLD5 (
\GETBASE

								  \EM.KBDAD5 0)))
							    (
SETQ
 WU (
SETQ
 OLDFAKEU
								(
\GETBASE
 \EM.UTILIN 0]
		        (
COND

			  ((
EQ
 R 0)                        (* Queue was empty)

			    (replace
 (RING READ) of
 \KEYBOARDEVENTQUEUE with
 W)))
		        (replace
 (RING WRITE) of
 \KEYBOARDEVENTQUEUE
			   with
 (
COND

				    ((
IGEQ
 W \KEYBOARDEVENT.LAST)
				      \KEYBOARDEVENT.FIRST)
				    (T (
IPLUS
 W \KEYBOARDEVENT.SIZE]
		(
OR
 \KEYBUFFERING (
SETQ
 \KEYBUFFERING T]
	    [
COND

	      [\KEYBUFFERING (
COND

			       ((
EQ
 \KEYBUFFERING T)
				 (
COND

				   ((
\CAUSEINTERRUPT
 \KbdFXP (
FUNCTION
 \DOBUFFEREDTRANSITIONS))
				     (
SETQ
 \KEYBUFFERING (
QUOTE
 STARTED))
                                                             (* don't call until \DOBUFFEREDTRANSITIONS is done)

				     ]
	      (T (
COND

		   (\PENDINGINTERRUPT (
COND

					((
\CAUSEINTERRUPT
 \KbdFXP (
FUNCTION
 \INTERRUPTFRAME))
					  (
SETQ
 \PENDINGINTERRUPT]
	    [
COND

	      ((
ILEQ
 (
SETQ
 LOOPCNT (
SUB1
 LOOPCNT))
		       0)                                    (* Only do this once in a while)

		(
SETQ
 LOOPCNT (
COND

		    ((\UPDATETIMERS)                         (* Timer was updated, so do it next time around, too, 

							     in case we just came back from RAID or other bcpl 

							     code)

		      1)
		    (T 20]
	    (
COND

	      ([
AND
 NIL \TIMER.INTERRUPT.PENDING (
IGREATERP
 (
\BOXIDIFFERENCE

								  (\RCLK (LOCF (fetch
 DLMOUSETEMP
										  of
 \MISCSTATS)))
								  (LOCF (fetch
 DLMOUSETIMER
									   of
 \MISCSTATS)))
								0)
		      (
COND

			((
EQ
 \TIMER.INTERRUPT.PENDING (
QUOTE
 \MOUSECHANGE))
			  (
SETQ
 OLDU NIL)
			  T)
			(T (
\CAUSEINTERRUPT
 \KbdFXP (
FUNCTION
 \TIMER.INTERRUPTFRAME]
		(
SETQ
 \TIMER.INTERRUPT.PENDING)))
	    (
GO
 LP])

(\RESETKEYBOARD

  [LAMBDA NIL                                                (* bvm: "30-Oct-85 17:06")

    (\SETIOPOINTERS
)                                       (* Called with lisp keyboard disabled whenever Lisp is

							     resumed from bcpl logout or copysys.)

    (
SETQ
 \KEYBUFFERING NIL)
    (
COND

      ((
OR
 (
EQ
 \MACHINETYPE \DANDELION)
	     (
EQ
 \MACHINETYPE \DAYBREAK))                  (* Initialize fake mouse bits to all up)

	(
\PUTBASE
 \EM.UTILIN 0 ALLUP)))
    (with
 KEYBOARDEVENT \LASTKEYSTATE (
SETQ
 W0 (
\GETBASE
 \EM.KBDAD0 0))
	    (
SETQ
 W1 (
\GETBASE
 \EM.KBDAD1 0))
	    (
SETQ
 W2 (
\GETBASE
 \EM.KBDAD2 0))
	    (
SETQ
 W3 (
\GETBASE
 \EM.KBDAD3 0))
	    (
SETQ
 W4 (
\GETBASE
 \EM.KBDAD4 0))
	    (
SETQ
 W5 (
\GETBASE
 \EM.KBDAD5 0))
	    (
SETQ
 WU (
\GETBASE
 \EM.REALUTILIN 0))
	    (
SETQ
 LOCK (XKEYDOWNP (
QUOTE
 LOCK)))
	    (
SETQ
 MOUSESTATE \DLMOUSE.UP))
    (
SETQ
 \TIMER.INTERRUPT.PENDING)
    (replace
 (RING READ) of
 \KEYBOARDEVENTQUEUE with
 0)
    (replace
 (RING READ) of
 \SYSBUFFER with
 0)
    (
SETQ
 \LONGSYSBUF)
    (
\DAYTIME0
 \LASTUSERACTION)
    (\KEYBOARDON
])

(\DOMOUSECHORDING

  [LAMBDA (REALUTILIN STATE)                                 (* bvm: " 9-Oct-85 11:24")


          (* Handles mouse transitions on a DLion. REALUTILIN is the actual util word from the processor.

	  STATE is our internal state. Sets contents of \EM.UTILIN to reflect the virtual mouse state, which may contain a 

	  middle mouse button even where there is only a two-button mouse. Returns new state)



    (
PROG
 (LRSTATE)
	    [
COND

	      ((
OR
 (
NULL
 \MOUSECHORDTICKS)
		     (
EQ
 (
SETQ
 LRSTATE (
LOGXOR
 (
LOGAND
 REALUTILIN \MOUSE.ALLBITS)
						     \MOUSE.ALLBITS))
			   0))                               (* Not interpreting chording, or both LEFT and RIGHT 

							     are up -- real state and virtual state the same)

		(
SETQ
 STATE \DLMOUSE.UP))
	      (T                                             (* Either L or R or both are down, so have to decide 

							     about Middle)

		 (
SELECTC
 STATE
			    [(
LIST
 \DLMOUSE.UP \DLMOUSE.WAITING)
			      (
SETQ
 REALUTILIN (
LOGOR
 REALUTILIN \MOUSE.LRBIT))
                                                             (* Turn off the L and/or R bits)

			      (
COND

				((
EQ
 LRSTATE \MOUSE.LRBIT)
                                                             (* Both L and R down at once, interpret as MIDDLE 

							     without waiting)

				  (
SETQ
 REALUTILIN (
LOGAND
 (
LOGXOR
 ALLUP \MOUSE.MIDDLEBIT)
							       REALUTILIN))
				  (
SETQ
 STATE \DLMOUSE.MIDDLE))
				((
NEQ
 STATE \DLMOUSE.WAITING)
                                                             (* Only one of L and R down.

							     Set timer, and ignore the down bit for now)

				  (
\BOXIPLUS
 (\RCLK (LOCF (fetch
 DLMOUSETIMER of
 \MISCSTATS)))
					       \MOUSECHORDTICKS)
				  (
SETQ
 STATE \DLMOUSE.WAITING]
			    (\DLMOUSE.MIDDLE                 (* State is middle and at least one of L and R is 

							     still down, so consider it to be still only middle)

					     (
SETQ
 REALUTILIN (
LOGAND
 (
LOGXOR
 ALLUP 
										 \MOUSE.MIDDLEBIT)
									  (
LOGOR
 REALUTILIN 
										   \MOUSE.LRBIT)))
					     (
SELECTC
 LRSTATE
							(\MOUSE.LEFTBIT 
                                                             (* Right came up. Henceforth treat right 

							     transparently)

									(
SETQ
 STATE 
									  \DLMOUSE.MIDDLE&RIGHT))
							(\MOUSE.RIGHTBIT 
                                                             (* Left came up. Henceforth treat left transparently)

									 (
SETQ
 STATE 
									   \DLMOUSE.MIDDLE&LEFT))
							NIL))
			    [\DLMOUSE.MIDDLE&RIGHT           (* Only ignore LEFT)

						   (
SETQ
 REALUTILIN (
LOGAND
 (
LOGXOR
 ALLUP 
										 \MOUSE.MIDDLEBIT)
										(
LOGOR
 REALUTILIN 
										   \MOUSE.LEFTBIT]
			    [\DLMOUSE.MIDDLE&LEFT            (* Only ignore RIGHT)

						  (
SETQ
 REALUTILIN (
LOGAND
 (
LOGXOR
 ALLUP 
										 \MOUSE.MIDDLEBIT)
									       (
LOGOR
 REALUTILIN 
										  \MOUSE.RIGHTBIT]
			    (
PROGN
                         (* Remaining state is \DLMOUSE.NORMAL which means 

							     treat mouse normally, and the only interesting 

							     transition is back to \DLMOUSE.UP)
]
	    (
\PUTBASE
 \EM.UTILIN 0 REALUTILIN)
	    (
RETURN
 STATE])

(\DOTRANSITIONS

  [LAMBDA (KEYBASE OLD NEW)                                  (* lmm "22-Apr-85 16:04")


          (* OLD and NEW are keyboard state words that are known to have changed. KEYBASE is the number in hardware order of 

	  the key corresponding to the first bit in these words. This function figures out the indices of transitioning keys 

	  and calls the decoder.)



    (for
 I (BITMASK _(
LLSH
 1 15)) from
 0 to
 15
       do
 [
OR
 (
EQ
 0 (
LOGAND
 BITMASK (
LOGXOR
 OLD NEW)))
	      (\DECODETRANSITION
 (
IPLUS
 I KEYBASE)
				 (
EQ
 0 (
LOGAND
 NEW BITMASK]
	  (
SETQ
 BITMASK (
LRSH
 BITMASK 1)))
    T])

(\DECODETRANSITION

  [LAMBDA (KEYNUMBER DOWNFLG)                                (* lmm "23-Apr-85 10:08")


          (* 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.)



    (.NOTELASTUSERACTION)
    (
PROG
 (ASCIICODE (TI (\TRANSINDEX KEYNUMBER DOWNFLG)))
          (
SELECTC
 (TRANSITIONFLAGS \CURRENTKEYACTION TI)
		   (IGNORE.TF (
RETURN
))
		   [LOCKSHIFT.TF (
SETQ
 ASCIICODE (
COND

				     ((fetch
 (KEYBOARDEVENT SHIFTORLOCK) of
 \LASTKEYSTATE)
				       (TRANSITIONSHIFTCODE \CURRENTKEYACTION TI))
				     (T (TRANSITIONCODE \CURRENTKEYACTION TI]
		   [NOLOCKSHIFT.TF (
SETQ
 ASCIICODE (
COND

				       ((fetch
 (KEYBOARDEVENT SHIFT) of
 \LASTKEYSTATE)
					 (TRANSITIONSHIFTCODE \CURRENTKEYACTION TI))
				       (T (TRANSITIONCODE \CURRENTKEYACTION TI]
		   (EVENT.TF (
RETURN
))
		   (1SHIFTUP.TF (replace
 (KEYBOARDEVENT 1SHIFT) of
 \LASTKEYSTATE with
 NIL)
				(
RETURN
))
		   (1SHIFTDOWN.TF (replace
 (KEYBOARDEVENT 1SHIFT) of
 \LASTKEYSTATE with
 T)
				  (
RETURN
))
		   (2SHIFTUP.TF (replace
 (KEYBOARDEVENT 2SHIFT) of
 \LASTKEYSTATE with
 NIL)
				(
RETURN
))
		   (2SHIFTDOWN.TF (replace
 (KEYBOARDEVENT 2SHIFT) of
 \LASTKEYSTATE with
 T)
				  (
RETURN
))
		   (LOCKUP.TF (replace
 (KEYBOARDEVENT LOCK) of
 \LASTKEYSTATE with
 NIL)
			      (
RETURN
))
		   (LOCKDOWN.TF (replace
 (KEYBOARDEVENT LOCK) of
 \LASTKEYSTATE with
 T)
				(
RETURN
))
		   (LOCKTOGGLE.TF (replace
 (KEYBOARDEVENT LOCK) of
 \LASTKEYSTATE
				     with
 (
NOT
 (fetch
 (KEYBOARDEVENT LOCK) of
 \LASTKEYSTATE)))
				  (
RETURN
))
		   (CTRLUP.TF (replace
 (KEYBOARDEVENT CTRL) of
 \LASTKEYSTATE with
 NIL)
			      (
RETURN
))
		   (CTRLDOWN.TF (replace
 (KEYBOARDEVENT CTRL) of
 \LASTKEYSTATE with
 T)
				(
RETURN
))
		   (METAUP.TF (replace
 (KEYBOARDEVENT META) of
 \LASTKEYSTATE with
 NIL)
			      (
RETURN
))
		   (METADOWN.TF (replace
 (KEYBOARDEVENT META) of
 \LASTKEYSTATE with
 T)
				(
RETURN
))
		   (FONTUP.TF (replace
 (KEYBOARDEVENT FONT) of
 \LASTKEYSTATE with
 NIL)
			      (
RETURN
))
		   (FONTDOWN.TF (replace
 (KEYBOARDEVENT FONT) of
 \LASTKEYSTATE with
 T)
				(
RETURN
))
		   (FONTTOGGLE.TF (replace
 (KEYBOARDEVENT FONT) of
 \LASTKEYSTATE
				     with
 (
NOT
 (fetch
 (KEYBOARDEVENT FONT) of
 \LASTKEYSTATE)))
				  (
RETURN
))
		   (USERMODE1UP.TF (replace
 (KEYBOARDEVENT USERMODE1) of
 \LASTKEYSTATE with
 NIL)
				   (
RETURN
))
		   (USERMODE1DOWN.TF (replace
 (KEYBOARDEVENT USERMODE1) of
 \LASTKEYSTATE
					with
 T)
				     (
RETURN
))
		   (USERMODE1TOGGLE.TF (replace
 (KEYBOARDEVENT USERMODE1) of
 \LASTKEYSTATE
					  with
 (
NOT
 (fetch
 (KEYBOARDEVENT USERMODE1) of
 \LASTKEYSTATE)
						    ))
				       (
RETURN
))
		   (USERMODE2UP.TF (replace
 (KEYBOARDEVENT USERMODE2) of
 \LASTKEYSTATE with
 NIL)
				   (
RETURN
))
		   (USERMODE2DOWN.TF (replace
 (KEYBOARDEVENT USERMODE2) of
 \LASTKEYSTATE
					with
 T)
				     (
RETURN
))
		   (USERMODE2TOGGLE.TF (replace
 (KEYBOARDEVENT USERMODE2) of
 \LASTKEYSTATE
					  with
 (
NOT
 (fetch
 (KEYBOARDEVENT USERMODE2) of
 \LASTKEYSTATE)
						    ))
				       (
RETURN
))
		   (USERMODE3UP.TF (replace
 (KEYBOARDEVENT USERMODE3) of
 \LASTKEYSTATE with
 NIL)
				   (
RETURN
))
		   (USERMODE3DOWN.TF (replace
 (KEYBOARDEVENT USERMODE3) of
 \LASTKEYSTATE
					with
 T)
				     (
RETURN
))
		   (USERMODE3TOGGLE.TF (replace
 (KEYBOARDEVENT USERMODE3) of
 \LASTKEYSTATE
					  with
 (
NOT
 (fetch
 (KEYBOARDEVENT USERMODE3) of
 \LASTKEYSTATE)
						    ))
				       (
RETURN
))
		   (
SHOULDNT
))
          (
AND
 (fetch
 (KEYBOARDEVENT CTRL) of
 \LASTKEYSTATE)
	       (
SETQ
 ASCIICODE (
LOGAND
 ASCIICODE \CTRLMASK)))
          [
COND

	    ((
AND
 (
OR
 (fetch
 (KEYBOARDEVENT META) of
 \LASTKEYSTATE)
		      (fetch
 (KEYBOARDEVENT FONT) of
 \LASTKEYSTATE))
		  (
ILESSP
 ASCIICODE \KEYBOARD.META))
	      (
SETQ
 ASCIICODE (
LOGOR
 ASCIICODE \KEYBOARD.META]
          (
COND

	    ((
ASSOC
 ASCIICODE (fetch
 INTERRUPTLIST of
 \CURRENTKEYACTION))
	      (
SETQ
 PENDINGINTERRUPT T)
	      (replace
 WAITINGINTERRUPT of
 \INTERRUPTSTATE with
 T)
	      (replace
 INTCHARCODE of
 \INTERRUPTSTATE with
 ASCIICODE))
	    (T (\PUTSYSBUF
 ASCIICODE])

(MOUSECHORDWAIT

  [LAMBDA MSECS                                              (* MPL "21-Jun-85 16:31")

    (DECLARE
 (
GLOBALVARS
 \RCLKMILLISECOND))
    (
PROG1
 (
AND
 \MOUSECHORDTICKS \MOUSECHORDMILLISECONDS)
	   (
COND

	     ((
IGREATERP
 MSECS 0)
	       (
SETQ
 \MOUSECHORDTICKS (
AND
 (
ARG
 MSECS 1)
					   (
IMIN
 MAX.SMALLP (
ITIMES
 (
SETQ
 \MOUSECHORDMILLISECONDS
								      (
OR
 (
SMALLP
 (
ARG
 MSECS 1))
									  50))
								    \RCLKMILLISECOND])

(\TRACKCURSOR

  [LAMBDA (CURSORX CURSORY)                                  (* rrb " 3-Oct-85 12:00")

    (DECLARE
 (
GLOBALVARS
 SCREENHEIGHT SCREENWIDTH))
    (.NOTELASTUSERACTION)
    (
COND

      (\COLORCURSORBM                                        (* cursor is on the color screen.)

		      [
COND

			((
IGREATERP
 CURSORX COLORSCREENWIDTH)
                                                             (* Large cursor values are either out of bounds to the

							     right or are negative values 

							     (16-bit bcpl signed numbers))

			  (
COND

			    ((
IGREATERP
 CURSORX 32767)     (* Cursor value is negative)

			      (
SETQ
 CURSORX 0))
			    (T (
SETQ
 CURSORX COLORSCREENWIDTH]
		      [
COND

			((
IGREATERP
 CURSORY (
SUB1
 COLORSCREENHEIGHT))
                                                             (* Large cursor values are either out of bounds to the

							     bottom or are negative values 

							     (16-bit bcpl signed numbers))

			  (
COND

			    ((
IGREATERP
 CURSORY 32767)     (* Cursor value is negative)

			      (
SETQ
 CURSORY 0))
			    (T (
SETQ
 CURSORY (
SUB1
 COLORSCREENHEIGHT]
		      (
COND

			((
NULL
 \COLORCURSORDOWN)           (* unless the cursor is down, take it down from it 

							     current position.)

			  (.TAKE.DOWN.COLOR.CURSOR)          (* put the cursor image up in its new position.)

			  (\SHOWCOLORCURSOR
 CURSORX CURSORY)))
                                                             (* update the cursor position.)

		      (
\PUTBASE
 \EM.MOUSEX 0 CURSORX)
		      (
\PUTBASE
 \EM.CURSORX 0 CURSORX)
		      (
\PUTBASE
 \EM.MOUSEY 0 CURSORY)
		      (
\PUTBASE
 \EM.CURSORY 0 CURSORY))
      (T                                                     (* move cursor if the mouse position has changed.)

	 (
COND

	   ((
OR
 [
COND

		    ((
IGEQ
 CURSORX (
IDIFFERENCE
 SCREENWIDTH \MOUSEHOTSPOTX))
                                                             (* Large cursor values are either out of bounds to the

							     right or are negative values 

							     (16-bit bcpl signed numbers))

		      (
COND

			[(
IGREATERP
 CURSORX 32767)         (* Cursor value is negative)

			  (
COND

			    ((
ILESSP
 (
IPLUS
 (
SUB1
 (
IDIFFERENCE
 CURSORX 65535))
						\MOUSEHOTSPOTX)
				       0)

          (* Cursor pos + hotspot is still off to the left (the IPLUS is an optimization of (\XMOUSECOORD)), so clip to 

	  effective zero)



			      (
SETQ
 CURSORX (
COND

				  ((
EQ
 \MACHINETYPE \DANDELION)
                                                             (* Temporary workaround)

				    0)
				  (T (UNSIGNED (
IMINUS
 \MOUSEHOTSPOTX)
					       BITSPERWORD]
			(T (
SETQ
 CURSORX (
SUB1
 (
IDIFFERENCE
 SCREENWIDTH \MOUSEHOTSPOTX]
		  (
IGEQ
 CURSORY (
IDIFFERENCE
 SCREENHEIGHT CURSORHEIGHT)))
                                                             (* repeat test so that both X and Y will get clipped 

							     each cycle. This keeps the cursor from moving off the 

							     screen.)

	     [
COND

	       ((
IGEQ
 CURSORY (
IDIFFERENCE
 SCREENHEIGHT CURSORHEIGHT))
                                                             (* Large cursor values are either out of bounds to the

							     bottom or are negative values 

							     (16-bit bcpl signed numbers))

		 (LET [(YHOT (
IDIFFERENCE
 \MOUSEHOTSPOTY (
SUB1
 CURSORHEIGHT]
                                                             (* Negative distance of CURSORY hotspot from top of 

							     cursor)

		      (
COND

			[(
IGREATERP
 CURSORY 32767)         (* Cursor value is negative)

			  (
COND

			    ((
ILESSP
 (
IDIFFERENCE
 (
SUB1
 (
IDIFFERENCE
 CURSORY 65535))
						      YHOT)
				       0)                    (* Cursor pos + hotspot is still off to the top, so 

							     clip to effective zero)

			      (
SETQ
 CURSORY (
COND

				  ((
OR
 (
EQ
 \MACHINETYPE \DANDELION)
					 (
EQ
 \MACHINETYPE \DAYBREAK))
                                                             (* Temporary workaround)

				    0)
				  (T (UNSIGNED YHOT BITSPERWORD]
			((
IGEQ
 CURSORY (
SETQ
 YHOT (
IPLUS
 SCREENHEIGHT YHOT)))
			  (
SETQ
 CURSORY (
SUB1
 YHOT]

          (* If need to clip mouse, do so here. (* rrb 3/oct/85, I removed the simple optimization only checks for one 

	  dimension per click, click. This keeps the cursor on the screen even when moving out in the corners.

	  This might allow simplification of \SETMOUSEXY MACRO that takes dlion complexities into account.))



	     (\SETMOUSEXY CURSORX CURSORY)))                 (* Now track mouse by copying mouse position into 

							     cursor position)

	 (
\PUTBASE
 \EM.CURSORX 0 CURSORX)
	 (
\PUTBASE
 \EM.CURSORY 0 CURSORY)

          (* * The daybreak is special. We have to kick the IOP to track the cursor)



	 (
COND

	   ((
EQ
 \MACHINETYPE \DAYBREAK)
	     (
\DoveDisplay.SetCursorPosition
 CURSORX CURSORY])
)

(RPAQ? \MOUSECHORDTICKS
 )

(RPAQ? \MOUSECHORDMILLISECONDS
 50)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\KEYBOARDINIT)
)
(DECLARE: DONTCOPY 
(DECLARE: EVAL@COMPILE 
(PUTPROPS .NOTELASTUSERACTION MACRO (NIL (\BLT \LASTUSERACTION (LOCF (fetch SECONDSTMP of \MISCSTATS))
					       WORDSPERCELL)))
)

(DECLARE: EVAL@COMPILE 

(RPAQQ ALLUP
 65535)

(RPAQQ \CTRLMASK
 159)

(RPAQQ \METABIT
 128)

(CONSTANTS ALLUP \CTRLMASK \METABIT)
)


(RPAQQ DLMOUSEBITS
 ((\MOUSE.LEFTBIT 4)
		      (\MOUSE.RIGHTBIT 2)
		      (\MOUSE.MIDDLEBIT 1)
		      (\MOUSE.ALLBITS 7)
		      (\MOUSE.LRBIT 6)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \MOUSE.LEFTBIT
 4)

(RPAQQ \MOUSE.RIGHTBIT
 2)

(RPAQQ \MOUSE.MIDDLEBIT
 1)

(RPAQQ \MOUSE.ALLBITS
 7)

(RPAQQ \MOUSE.LRBIT
 6)

(CONSTANTS (\MOUSE.LEFTBIT 4)
	   (\MOUSE.RIGHTBIT 2)
	   (\MOUSE.MIDDLEBIT 1)
	   (\MOUSE.ALLBITS 7)
	   (\MOUSE.LRBIT 6))
)


(RPAQQ DLMOUSESTATES
 ((\DLMOUSE.UP 0)
			(\DLMOUSE.WAITING 1)
			(\DLMOUSE.NORMAL 2)
			(\DLMOUSE.MIDDLE 3)
			(\DLMOUSE.MIDDLE&LEFT 4)
			(\DLMOUSE.MIDDLE&RIGHT 5)))
(DECLARE: EVAL@COMPILE 

(RPAQQ \DLMOUSE.UP
 0)

(RPAQQ \DLMOUSE.WAITING
 1)

(RPAQQ \DLMOUSE.NORMAL
 2)

(RPAQQ \DLMOUSE.MIDDLE
 3)

(RPAQQ \DLMOUSE.MIDDLE&LEFT
 4)

(RPAQQ \DLMOUSE.MIDDLE&RIGHT
 5)

(CONSTANTS (\DLMOUSE.UP 0)
	   (\DLMOUSE.WAITING 1)
	   (\DLMOUSE.NORMAL 2)
	   (\DLMOUSE.MIDDLE 3)
	   (\DLMOUSE.MIDDLE&LEFT 4)
	   (\DLMOUSE.MIDDLE&RIGHT 5))
)


(RPAQQ TRANSITIONFLAGS
 (CTRLDOWN.TF CTRLUP.TF IGNORE.TF EVENT.TF LOCKDOWN.TF LOCKSHIFT.TF 
				      LOCKTOGGLE.TF LOCKUP.TF NOLOCKSHIFT.TF 1SHIFTDOWN.TF 
				      1SHIFTUP.TF 2SHIFTDOWN.TF 2SHIFTUP.TF METADOWN.TF METAUP.TF 
				      FONTDOWN.TF FONTUP.TF FONTTOGGLE.TF USERMODE1UP.TF 
				      USERMODE1DOWN.TF USERMODE1TOGGLE.TF USERMODE2UP.TF 
				      USERMODE2DOWN.TF USERMODE2TOGGLE.TF USERMODE3UP.TF 
				      USERMODE3DOWN.TF USERMODE3TOGGLE.TF))
(DECLARE: EVAL@COMPILE 

(RPAQQ CTRLDOWN.TF
 5)

(RPAQQ CTRLUP.TF
 4)

(RPAQQ IGNORE.TF
 0)

(RPAQQ EVENT.TF
 1)

(RPAQQ LOCKDOWN.TF
 8)

(RPAQQ LOCKSHIFT.TF
 2)

(RPAQQ LOCKTOGGLE.TF
 14)

(RPAQQ LOCKUP.TF
 7)

(RPAQQ NOLOCKSHIFT.TF
 3)

(RPAQQ 1SHIFTDOWN.TF
 6)

(RPAQQ 1SHIFTUP.TF
 9)

(RPAQQ 2SHIFTDOWN.TF
 11)

(RPAQQ 2SHIFTUP.TF
 10)

(RPAQQ METADOWN.TF
 13)

(RPAQQ METAUP.TF
 12)

(RPAQQ FONTDOWN.TF
 24)

(RPAQQ FONTUP.TF
 25)

(RPAQQ FONTTOGGLE.TF
 26)

(RPAQQ USERMODE1UP.TF
 15)

(RPAQQ USERMODE1DOWN.TF
 16)

(RPAQQ USERMODE1TOGGLE.TF
 17)

(RPAQQ USERMODE2UP.TF
 18)

(RPAQQ USERMODE2DOWN.TF
 19)

(RPAQQ USERMODE2TOGGLE.TF
 20)

(RPAQQ USERMODE3UP.TF
 21)

(RPAQQ USERMODE3DOWN.TF
 22)

(RPAQQ USERMODE3TOGGLE.TF
 23)

(CONSTANTS CTRLDOWN.TF CTRLUP.TF IGNORE.TF EVENT.TF LOCKDOWN.TF LOCKSHIFT.TF LOCKTOGGLE.TF LOCKUP.TF 
	   NOLOCKSHIFT.TF 1SHIFTDOWN.TF 1SHIFTUP.TF 2SHIFTDOWN.TF 2SHIFTUP.TF METADOWN.TF METAUP.TF 
	   FONTDOWN.TF FONTUP.TF FONTTOGGLE.TF USERMODE1UP.TF USERMODE1DOWN.TF USERMODE1TOGGLE.TF 
	   USERMODE2UP.TF USERMODE2DOWN.TF USERMODE2TOGGLE.TF USERMODE3UP.TF USERMODE3DOWN.TF 
	   USERMODE3TOGGLE.TF)
)

(DECLARE: EVAL@COMPILE 
[PUTPROPS \TRANSINDEX MACRO ((KEYNUMBER DOWNFLG)
	   (COND (DOWNFLG (IPLUS \NKEYS KEYNUMBER))
		 (T KEYNUMBER]
(PUTPROPS ARMEDCODE MACRO ((TABLE CHAR)
	   (\GETBASEBIT (fetch (KEYACTION ARMED)
			       TABLE)
			CHAR)))
(PUTPROPS TRANSITIONSHIFTCODE MACRO ((TABLE CHAR)
	   (\GETBASE (fetch (KEYACTION SHIFTCODES)
			    TABLE)
		     CHAR)))
(PUTPROPS TRANSITIONCODE MACRO ((TABLE CHAR)
	   (\GETBASE (fetch (KEYACTION CODES)
			    TABLE)
		     CHAR)))
(PUTPROPS TRANSITIONFLAGS MACRO ((TABLE CHAR)
	   (\GETBASEBYTE (fetch (KEYACTION FLAGS)
				TABLE)
			 CHAR)))
)

(* FOLLOWING DEFINITIONS EXPORTED)


[DECLARE: EVAL@COMPILE 

(BLOCKRECORD KEYACTION
 (FLAGS CODES SHIFTCODES ARMED INTERRUPTLIST)
			 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))
			 (CREATE
 (
\ALLOCBLOCK
 5 PTRBLOCK.GCT))
			 [TYPE?
 (
AND
 (
\BLOCKDATAP
 DATUM)
					 (
EQ
 (
\#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 

(RPAQQ \NKEYS
 112)

(CONSTANTS \NKEYS)
)


(* END EXPORTED DEFINITIONS)


[DECLARE: EVAL@COMPILE 

(BLOCKRECORD RING
 ((
READ
 WORD)
		     (WRITE WORD)))
]




(* can get rid of shiftstate after clients have been fixed)


[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)
						       (
\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]
			(CREATE
 (
\ALLOCBLOCK
 (FOLDHI 3 BYTESPERCELL))))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \SHIFTSTATE \MOUSETIMERTEMP)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ NRINGINDEXWORDS
 2)

(CONSTANTS NRINGINDEXWORDS)
)

(DECLARE: EVAL@COMPILE 

(RPAQ \SYSBUFFER.FIRST
 (UNFOLD NRINGINDEXWORDS BYTESPERWORD))

(RPAQ \SYSBUFFER.LAST
 (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE)))

[CONSTANTS (\SYSBUFFER.FIRST (UNFOLD NRINGINDEXWORDS BYTESPERWORD))
	   (\SYSBUFFER.LAST (IPLUS \SYSBUFFER.FIRST (SUB1 \SYSBUFSIZE]
)
)
(DECLARE: EVAL@COMPILE 

(RPAQQ \KEYNAMES
 ((5 %% FIVE)
		    (4 $ FOUR)
		    (6 ~ SIX)
		    (e E)
		    (7 & SEVEN)
		    (d D)
		    (u U)
		    (v V)
		    (0 %) ZERO)
		    (k K)
		    (- %)
		    (p P)
		    (/ ?)
		    (\ %| FONT LOOKS)
		    (LF SAME)
		    (BS <-)
		    (3 # THREE)
		    (2 @ TWO)
		    (w W)
		    (q Q)
		    (s S)
		    (a A)
		    (9 %( NINE)
		    (i I)
		    (x X)
		    (o O)
		    (l L)
		    (, <)
		    (' %")
		    (%] })
		    (BLANK-MIDDLE OPEN DBK-HELP)
		    (BLANK-TOP KEYBOARD DBK-META)
		    (1 ! ONE)
		    (ESC ESCAPE ->)
		    (TAB =>)
		    (f F)
		    (CTRL PROP'S EDIT)
		    (c C)
		    (j J)
		    (b B)
		    (z Z)
		    (LSHIFT)
		    (%. >)
		    (; :)
		    (CR <-%|)
		    (_ ^)
		    (DEL DELETE)
		    (SKIP NEXT)
		    (r R)
		    (t T)
		    (g G)
		    (y Y)
		    (h H)
		    (8 * EIGHT)
		    (n N)
		    (m M)
		    (LOCK)
		    (SPACE)
		    (%[ {)
		    (= +)
		    (RSHIFT)
		    (BLANK-BOTTOM STOP)
		    (MOVE)
		    (UNDO)
		    (UTIL0)
		    (UTIL1)
		    (UTIL2 SUPER/SUB)
		    (UTIL3 CASE)
		    (UTIL4 STRIKEOUT)
		    (UTIL5 KEYPAD2)
		    (UTIL6 KEYPAD3 PGDN)
		    (UTIL7)
		    (PAD1 LEFTKEY CAPSLOCK KEYPAD+)
		    (PAD2 LEFTMIDDLEKEY NUMLOCK KEYPAD-)
		    (PAD3 MIDDLEKEY SCROLLLOCK KEYPAD*)
		    (PAD4 RIGHTMIDDLEKEY BREAK KEYPAD/)
		    (PAD5 RIGHTKEY DOIT PRTSC)
		    (LEFT RED MOUSERED)
		    (RIGHT BLUE MOUSEBLUE)
		    (MIDDLE YELLOW MOUSEYELLOW)
		    (MARGINS)
		    (K41 KEYPAD7 HOME)
		    (K42 KEYPAD8)
		    (K43 KEYPAD9 PGUP)
		    (K44 KEYPAD4)
		    (K45 KEYPAD5)
		    (K46)
		    (K47 KEYPAD6)
		    (K48)
		    (COPY)
		    (FIND)
		    (AGAIN)
		    (HELP)
		    (DEF'N EXPAND)
		    (K4E KEYPAD1 END)
		    (ALWAYS-ON-1)
		    (ALWAYS-ON-2)
		    (CENTER)
		    (K52 KEYPAD0 INS)
		    (BOLD)
		    (ITALICS)
		    (UNDERLINE)
		    (SUPERSCRIPT)
		    (SUBSCRIPT)
		    (LARGER SMALLER)
		    (K59 KEYPAD%| KEYPAD.)
		    (K5A KEYPAD\ KEYPAD,)
		    (K5B)
		    (K5C)
		    (DEFAULTS)
		    (K5E)
		    (K5F)))
)

(RPAQQ \ORIGKEYACTIONS
 ((0 (53 %% NOLOCKSHIFT))
			  (1 (52 $ NOLOCKSHIFT))
			  (2 (54 ~ NOLOCKSHIFT))
			  (3 (e E LOCKSHIFT))
			  (4 (55 & NOLOCKSHIFT))
			  (5 (d D LOCKSHIFT))
			  (6 (u U LOCKSHIFT))
			  (7 (v V LOCKSHIFT))
			  (8 (48 %) NOLOCKSHIFT))
			  (9 (k K LOCKSHIFT))
			  (10 (- - NOLOCKSHIFT))
			  (11 (p P LOCKSHIFT))
			  (12 (/ ? NOLOCKSHIFT))
			  (13 (\ %| NOLOCKSHIFT))
			  (14 (10 96 NOLOCKSHIFT))
			  (15 (8 8 NOLOCKSHIFT))
			  (16 (51 # NOLOCKSHIFT))
			  (17 (50 @ NOLOCKSHIFT))
			  (18 (w W LOCKSHIFT))
			  (19 (q Q LOCKSHIFT))
			  (20 (s S LOCKSHIFT))
			  (21 (a A LOCKSHIFT))
			  (22 (57 %( NOLOCKSHIFT))
			  (23 (i I LOCKSHIFT))
			  (24 (x X LOCKSHIFT))
			  (25 (o O LOCKSHIFT))
			  (26 (l L LOCKSHIFT))
			  (27 (, < NOLOCKSHIFT))
			  (28 (' %" NOLOCKSHIFT))
			  (29 (%] } NOLOCKSHIFT))
			  (30 (194 194 NOLOCKSHIFT))
			  (31 (193 193 NOLOCKSHIFT))
			  (32 (49 ! NOLOCKSHIFT))
			  (33 (27 27 NOLOCKSHIFT))
			  (34 (9 9 NOLOCKSHIFT))
			  (35 (f F LOCKSHIFT))
			  (36 CTRLDOWN . CTRLUP)
			  (37 (c C LOCKSHIFT))
			  (38 (j J LOCKSHIFT))
			  (39 (b B LOCKSHIFT))
			  (40 (z Z LOCKSHIFT))
			  (41 1SHIFTDOWN . 1SHIFTUP)
			  (42 (%. > NOLOCKSHIFT))
			  (43 (; : NOLOCKSHIFT))
			  (44 (13 13 NOLOCKSHIFT))
			  (45 (_ ^ NOLOCKSHIFT))
			  (46 (127 535 NOLOCKSHIFT))
			  (47 (%( %[ NOLOCKSHIFT))
			  (48 (r R LOCKSHIFT))
			  (49 (t T LOCKSHIFT))
			  (50 (g G LOCKSHIFT))
			  (51 (y Y LOCKSHIFT))
			  (52 (h H LOCKSHIFT))
			  (53 (56 * NOLOCKSHIFT))
			  (54 (n N LOCKSHIFT))
			  (55 (m M LOCKSHIFT))
			  (56 LOCKDOWN . LOCKUP)
			  (57 (32 32 NOLOCKSHIFT))
			  (58 (%[ { NOLOCKSHIFT))
			  (59 (= + NOLOCKSHIFT))
			  (60 2SHIFTDOWN . 2SHIFTUP)
			  (61 (195 195 NOLOCKSHIFT))
			  (63 (%) %] NOLOCKSHIFT))
			  (77 EVENT . EVENT)
			  (78 EVENT . EVENT)
			  (79 EVENT . EVENT)
			  (102 LOCKDOWN)
			  (103 LOCKUP)))

(RPAQQ \DLIONKEYACTIONS
 ((2 (54 ^ NOLOCKSHIFT))
			   (10 (- _ NOLOCKSHIFT))
			   (33 (\ %| NOLOCKSHIFT))
			   (45 (96 ~ NOLOCKSHIFT))
			   (OPEN METADOWN . METAUP)
			   (PROP'S CTRLDOWN . CTRLUP)
			   (SAME METADOWN . METAUP)
			   (FIND (2,3 2,43 NOLOCKSHIFT))
			   (UNDO (2,4 2,44 NOLOCKSHIFT))
			   (STOP (5 7 NOLOCKSHIFT))
			   (MOVE)
			   (COPY)
			   (AGAIN (2,10 2,50 NOLOCKSHIFT))
			   (CENTER (2,101 2,141 NOLOCKSHIFT))
			   (BOLD (2,102 2,142 NOLOCKSHIFT))
			   (ITALICS (2,103 2,143 NOLOCKSHIFT))
			   (UNDERLINE (2,106 2,146 NOLOCKSHIFT))
			   (SUPERSCRIPT (2,113 2,153 NOLOCKSHIFT))
			   (SUBSCRIPT (2,114 2,154 NOLOCKSHIFT))
			   (LARGER (2,110 2,150 NOLOCKSHIFT))
			   (DEFAULTS (2,115 2,155 NOLOCKSHIFT))
			   (93 (27 2,64 NOLOCKSHIFT))
			   (47 (2,22 2,62 NOLOCKSHIFT))
			   (31 (2,5 2,45 NOLOCKSHIFT))
			   (92 (2,1 2,41 NOLOCKSHIFT))
			   (80 (2,13 2,53 NOLOCKSHIFT))
			   (FONT (2,112 2,152 NOLOCKSHIFT))))

(RPAQQ \DLIONOSDKEYACTIONS
 ((56 LOCKTOGGLE)))

(RPAQQ \DORADOKEYACTIONS
 ((2 (54 ~ NOLOCKSHIFT))
			    (10 (- - NOLOCKSHIFT))
			    (13 (\ %| NOLOCKSHIFT))
			    (14 (10 96 NOLOCKSHIFT))
			    (33 (27 27 NOLOCKSHIFT))
			    (45 (_ ^ NOLOCKSHIFT))))

(RPAQQ \DOVEKEYACTIONS
 ((2 (54 ^ NOLOCKSHIFT))
			  (10 (- _ NOLOCKSHIFT))
			  (33 (27 27 NOLOCKSHIFT))
			  (56 CTRLDOWN . CTRLUP)
			  (65 (27 27 NOLOCKSHIFT))
			  (71 (39 34 NOLOCKSHIFT))
			  (93 (2,24 2,64 NOLOCKSHIFT))
			  (108 (96 126 NOLOCKSHIFT))
			  (DBK-META METADOWN . METAUP)
			  (DBK-HELP (2,1 2,41 NOLOCKSHIFT))
			  (SAME METADOWN . METAUP)
			  (FIND (2,3 2,43 NOLOCKSHIFT))
			  (UNDO (2,4 2,44 NOLOCKSHIFT))
			  (STOP (5 7 NOLOCKSHIFT))
			  (EDIT (2,5 2,45 NOLOCKSHIFT))
			  (MOVE)
			  (COPY)
			  (AGAIN (2,10 2,50 NOLOCKSHIFT))
			  (CENTER (2,101 2,141 NOLOCKSHIFT))
			  (BOLD (2,102 2,142 NOLOCKSHIFT))
			  (ITALICS (2,103 2,143 NOLOCKSHIFT))
			  (CASE (2,104 2,144 NOLOCKSHIFT))
			  (STRIKEOUT (2,105 2,145 NOLOCKSHIFT))
			  (UNDERLINE (2,106 2,146 NOLOCKSHIFT))
			  (SUPER/SUB (2,107 2,147 NOLOCKSHIFT))
			  (LARGER (2,110 2,150 NOLOCKSHIFT))
			  (MARGINS (2,111 2,151 NOLOCKSHIFT))
			  (LOOKS (2,112 2,152 NOLOCKSHIFT))
			  (CAPSLOCK LOCKTOGGLE)
			  (NUMLOCK (2,11 - NOLOCKSHIFT))
			  (SCROLLLOCK (2,12 180 NOLOCKSHIFT))
			  (BREAK (2 184 NOLOCKSHIFT))
			  (DOIT (2,13 2,53 NOLOCKSHIFT))
			  (KEYPAD7 (2,14 55 NOLOCKSHIFT))
			  (KEYPAD8 (173 56 NOLOCKSHIFT))
			  (KEYPAD9 (2,15 57 NOLOCKSHIFT))
			  (KEYPAD4 (172 52 NOLOCKSHIFT))
			  (KEYPAD5 (2,16 53 NOLOCKSHIFT))
			  (KEYPAD6 (174 54 NOLOCKSHIFT))
			  (KEYPAD1 (2,17 49 NOLOCKSHIFT))
			  (KEYPAD2 (175 50 NOLOCKSHIFT))
			  (KEYPAD3 (2,20 51 NOLOCKSHIFT))
			  (KEYPAD0 (2,21 48 NOLOCKSHIFT))
			  (KEYPAD%| (%| 46 NOLOCKSHIFT))
			  (KEYPAD\ (\ 44 NOLOCKSHIFT))
			  (47 (2,22 2,62 NOLOCKSHIFT))))

(RPAQQ \DOVEOSDKEYACTIONS
 ((56 LOCKDOWN . LOCKUP)
			     (36 CTRLDOWN . CTRLUP)
			     (CAPSLOCK (2,5 2,45 NOLOCKSHIFT))))

(RPAQ? \KEYBOARD.META
 256)

(RPAQ? \MODIFIED.KEYACTIONS
 )
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \SYSBUFFER \LONGSYSBUF \INTERRUPTSTATE \MODIFIED.KEYACTIONS \RCLKSECOND \LASTUSERACTION 
	    \MOUSECHORDTICKS \LASTKEYSTATE \KEYBOARDEVENTQUEUE \KEYBUFFERING \CURRENTKEYACTION 
	    \DEFAULTKEYACTION \COLORCURSORHEIGHT SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING 
	    \ORIGKEYACTIONS \KEYBOARD.META \MOUSECHORDMILLISECONDS \DORADOKEYACTIONS \DLIONKEYACTIONS 
	    \DLIONOSDKEYACTIONS \DOVEKEYACTIONS \DOVEOSDKEYACTIONS)
)



(* Key interpretation)


(DEFINEQ

(KEYACTION

  [LAMBDA (KEYNAME ACTIONS TABLE)                            (* lmm "22-May-85 07:41")

    (LET ((NUMB (
OR
 (
SMALLP
 KEYNAME)
		    (\KEYNAMETONUMBER
 KEYNAME)))
       (TABLE (
OR
 TABLE \DEFAULTKEYACTION)))
      (
CONS
 (\KEYACTION1
 (\TRANSINDEX NUMB T)
			 (
AND
 ACTIONS (
OR
 (
CAR
 ACTIONS)
					  (
QUOTE
 IGNORE)))
			 TABLE)
	    (\KEYACTION1
 (\TRANSINDEX NUMB NIL)
			 (
AND
 ACTIONS (
OR
 (
CDR
 ACTIONS)
					  (
QUOTE
 IGNORE)))
			 TABLE])

(KEYACTIONTABLE

  [LAMBDA (OLD
)
    (if
 OLD
	then
 (create
 KEYACTION copying
 OLD)
      else
 (
PROG1
 (
SETQ
 OLD (create
 KEYACTION))
		  (for
 X in
 \ORIGKEYACTIONS do
 (KEYACTION
 (
CAR
 X)
							  (
CDR
 X)
							  OLD])

(\KEYACTION1

  [LAMBDA (TI ACTION TABLE)                                  (* lmm "18-Apr-85 06:14")

    (
PROG1
 (
SELECTC
 (TRANSITIONFLAGS TABLE TI)
		    (IGNORE.TF (
QUOTE
 IGNORE))
		    [(
LIST
 LOCKSHIFT.TF NOLOCKSHIFT.TF)
		      (
LIST
 (TRANSITIONCODE TABLE TI)
			    (TRANSITIONSHIFTCODE TABLE TI)
			    (
COND

			      ((
EQ
 LOCKSHIFT.TF (TRANSITIONFLAGS TABLE TI))
				(
QUOTE
 LOCKSHIFT))
			      (T (
QUOTE
 NOLOCKSHIFT]
		    (EVENT.TF (
QUOTE
 EVENT))
		    (CTRLDOWN.TF (
QUOTE
 CTRLDOWN))
		    (CTRLUP.TF (
QUOTE
 CTRLUP))
		    (1SHIFTDOWN.TF (
QUOTE
 1SHIFTDOWN))
		    (1SHIFTUP.TF (
QUOTE
 1SHIFTUP))
		    (2SHIFTDOWN.TF (
QUOTE
 2SHIFTDOWN))
		    (2SHIFTUP.TF (
QUOTE
 2SHIFTUP))
		    (LOCKDOWN.TF (
QUOTE
 LOCKDOWN))
		    (LOCKUP.TF (
QUOTE
 LOCKUP))
		    (LOCKTOGGLE.TF (
QUOTE
 LOCKTOGGLE))
		    (METADOWN.TF (
QUOTE
 METADOWN))
		    (METAUP.TF (
QUOTE
 METAUP))
		    (FONTUP.TF (
QUOTE
 FONTUP))
		    (FONTDOWN.TF (
QUOTE
 FONTDOWN))
		    (FONTTOGGLE.TF (
QUOTE
 FONTTOGGLE))
		    (USERMODE1UP.TF (
QUOTE
 USERMODE1UP))
		    (USERMODE1DOWN.TF (
QUOTE
 USERMODE1DOWN))
		    (USERMODE1TOGGLE.TF (
QUOTE
 USERMODE1TOGGLE))
		    (USERMODE2UP.TF (
QUOTE
 USERMODE2UP))
		    (USERMODE2DOWN.TF (
QUOTE
 USERMODE2DOWN))
		    (USERMODE2TOGGLE.TF (
QUOTE
 USERMODE2TOGGLE))
		    (USERMODE3UP.TF (
QUOTE
 USERMODE3UP))
		    (USERMODE3DOWN.TF (
QUOTE
 USERMODE3DOWN))
		    (USERMODE3TOGGLE.TF (
QUOTE
 USERMODE3TOGGLE))
		    (
SHOULDNT
))
	   (
SELECTQ
 ACTION
		    ((NIL NOCHANGE))
		    (IGNORE (change
 (TRANSITIONFLAGS TABLE TI)
				    IGNORE.TF))
		    (EVENT (change
 (TRANSITIONFLAGS TABLE TI)
				   EVENT.TF))
		    (CTRLUP (change
 (TRANSITIONFLAGS TABLE TI)
				    CTRLUP.TF))
		    (CTRLDOWN (change
 (TRANSITIONFLAGS TABLE TI)
				      CTRLDOWN.TF))
		    (1SHIFTUP (change
 (TRANSITIONFLAGS TABLE TI)
				      1SHIFTUP.TF))
		    (1SHIFTDOWN (change
 (TRANSITIONFLAGS TABLE TI)
					1SHIFTDOWN.TF))
		    (2SHIFTUP (change
 (TRANSITIONFLAGS TABLE TI)
				      2SHIFTUP.TF))
		    (2SHIFTDOWN (change
 (TRANSITIONFLAGS TABLE TI)
					2SHIFTDOWN.TF))
		    (LOCKUP (change
 (TRANSITIONFLAGS TABLE TI)
				    LOCKUP.TF))
		    (LOCKDOWN (change
 (TRANSITIONFLAGS TABLE TI)
				      LOCKDOWN.TF))
		    (LOCKTOGGLE (change
 (TRANSITIONFLAGS TABLE TI)
					LOCKTOGGLE.TF))
		    (METAUP (change
 (TRANSITIONFLAGS TABLE TI)
				    METAUP.TF))
		    (METADOWN (change
 (TRANSITIONFLAGS TABLE TI)
				      METADOWN.TF))
		    (FONTUP (change
 (TRANSITIONFLAGS TABLE TI)
				    FONTUP.TF))
		    (FONTDOWN (change
 (TRANSITIONFLAGS TABLE TI)
				      FONTDOWN.TF))
		    (FONTTOGGLE (change
 (TRANSITIONFLAGS TABLE TI)
					FONTTOGGLE.TF))
		    (USERMODE1UP (change
 (TRANSITIONFLAGS TABLE TI)
					 USERMODE1UP.TF))
		    (USERMODE1DOWN (change
 (TRANSITIONFLAGS TABLE TI)
					   USERMODE1DOWN.TF))
		    (USERMODE1TOGGLE (change
 (TRANSITIONFLAGS TABLE TI)
					     USERMODE1TOGGLE.TF))
		    (USERMODE2UP (change
 (TRANSITIONFLAGS TABLE TI)
					 USERMODE2UP.TF))
		    (USERMODE2DOWN (change
 (TRANSITIONFLAGS TABLE TI)
					   USERMODE2DOWN.TF))
		    (USERMODE2TOGGLE (change
 (TRANSITIONFLAGS TABLE TI)
					     USERMODE2TOGGLE.TF))
		    (USERMODE3UP (change
 (TRANSITIONFLAGS TABLE TI)
					 USERMODE3UP.TF))
		    (USERMODE3DOWN (change
 (TRANSITIONFLAGS TABLE TI)
					   USERMODE3DOWN.TF))
		    (USERMODE3TOGGLE (change
 (TRANSITIONFLAGS TABLE TI)
					     USERMODE3TOGGLE.TF))
		    (
PROG
 (CODE SHIFTCODE ACT)
		          (
COND

			    ((
AND
 [
OR
 [\CHARCODEP (
SETQ
 CODE (
\GETCHARCODE
 (
CAR
 (
LISTP
 ACTION]
				      (
SETQ
 CODE (
APPLY*
 (
FUNCTION
 CHARCODE)
							 (
CAR
 (
LISTP
 ACTION]
				  [
OR
 [\CHARCODEP (
SETQ
 SHIFTCODE
						    (
\GETCHARCODE
 (
CAR
 (
SETQ
 ACT (
LISTP
 (
CDR
 ACTION]
				      (
SETQ
 SHIFTCODE (
APPLY*
 (
FUNCTION
 CHARCODE)
							      (
CAR
 ACT]
				  (
OR
 (
NULL
 (
SETQ
 ACT (
CDR
 ACT)))
				      (
LISTP
 ACT))
				  (
SELECTQ
 (
CAR
 ACT)
					   ((LOCKSHIFT T)
					     (change
 (TRANSITIONFLAGS TABLE TI)
						     LOCKSHIFT.TF))
					   ((NOLOCKSHIFT NIL)
					     (change
 (TRANSITIONFLAGS TABLE TI)
						     NOLOCKSHIFT.TF))
					   NIL))
			      (change
 (TRANSITIONCODE TABLE TI)
				      CODE)
			      (change
 (TRANSITIONSHIFTCODE TABLE TI)
				      SHIFTCODE))
			    (T (
\ILLEGAL.ARG
 ACTION])

(KEYDOWNP

  [LAMBDA (KEYNAME)                                          (* lmm "18-Apr-85 02:09")

                                                             (* T if the indicated key is instantaneously down.)

    (\NEWKEYDOWNP (\KEYNAMETONUMBER
 KEYNAME])

(\KEYNAMETONUMBER

  [LAMBDA (KEYNAME)                                          (* rmk: " 2-SEP-83 10:29")

    (DECLARE
 (
GLOBALVARS
 \KEYNAMES))                         (* The fast case is when KEYNAME is lower-case)

    (for
 X N in
 \KEYNAMES as
 I from
 0 when
 (
EQMEMB
 KEYNAME X) do
 (
RETURN
 I)
       finally
 (
RETURN
 (
OR
 (
AND
 (
NEQ
 KEYNAME (
SETQ
 N (
L-CASE
 KEYNAME)))
				(for
 Y in
 \KEYNAMES as
 I from
 0 when
 (
EQMEMB
 N Y)
				   do
 (
RETURN
 I)))
			   (
\ILLEGAL.ARG
 KEYNAME])

(MODIFY.KEYACTIONS

  [LAMBDA (KeyActions SaveCurrent?)                          (* JonL "11-MAY-83 18:29")

    (
PROG1
 [if
 SaveCurrent?
	       then
 (
SETQ
 \MODIFIED.KEYACTIONS (for
 ITEM in
 KeyActions
						  collect
 (
CONS
 (
CAR
 ITEM)
								(KEYACTION
 (
CAR
 ITEM]
	   (for
 X in
 KeyActions do
 (KEYACTION
 (
CAR
 X)
					      (
CDR
 X])

(METASHIFT

  [LAMBDA FLG                                                (* bvm: "29-APR-82 15:22")

                                                             (* Sets interpretation of swat key to first arg, where 

							     T means meta-shift, NIL means original setting.

							     Returns previous setting)

    (
PROG
 ((METASTATUS (
QUOTE
 (METADOWN . METAUP)))
	   OLDSETTING)
          [
SETQ
 OLDSETTING (KEYACTION
 (
QUOTE
 BLANK-BOTTOM)
				      (
AND
 (
IGREATERP
 FLG 0)
					   (
COND

					     ((
EQ
 (
ARG
 FLG 1)
						  T)
					       METASTATUS)
					     (T (
OR
 (
ARG
 FLG 1)
						    (
CDR
 (
ASSOC
 (
QUOTE
 BLANK-BOTTOM)
								\ORIGKEYACTIONS]
          (
RETURN
 (
COND

		    ((
EQUAL
 OLDSETTING METASTATUS)
		      T)
		    (T OLDSETTING])

(SHIFTDOWNP

  [LAMBDA (SHIFT)                                            (* 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))
	     (SHIFT (
OR
 (fetch
 (KEYBOARDEVENT 1SHIFT) of
 \LASTKEYSTATE)
			(fetch
 (KEYBOARDEVENT 2SHIFT) of
 \LASTKEYSTATE)))
	     (1SHIFT (fetch
 (KEYBOARDEVENT 1SHIFT) of
 \LASTKEYSTATE))
	     (2SHIFT (fetch
 (KEYBOARDEVENT 2SHIFT) of
 \LASTKEYSTATE))
	     (SHIFTORLOCK (
OR
 (fetch
 (KEYBOARDEVENT 1SHIFT) of
 \LASTKEYSTATE)
			      (fetch
 (KEYBOARDEVENT 2SHIFT) of
 \LASTKEYSTATE)
			      (fetch
 (KEYBOARDEVENT LOCK) of
 \LASTKEYSTATE)))
	     (CTRL (fetch
 (KEYBOARDEVENT CTRL) of
 \LASTKEYSTATE))
	     (FONT (fetch
 (KEYBOARDEVENT FONT) of
 \LASTKEYSTATE))
	     (USERMODE1 (fetch
 (KEYBOARDEVENT USERMODE1) of
 \LASTKEYSTATE))
	     (USERMODE2 (fetch
 (KEYBOARDEVENT USERMODE2) of
 \LASTKEYSTATE))
	     (USERMODE3 (fetch
 (KEYBOARDEVENT USERMODE3) of
 \LASTKEYSTATE))
	     (
\ILLEGAL.ARG
 SHIFT])
)
(DEFINEQ

(SETUP.OFFICE.KEYBOARD

  [LAMBDA NIL                                                (* jds " 8-Oct-85 16:27")

    (
SELECTQ
 (MACHINETYPE
)
	       (DANDELION (MODIFY.KEYACTIONS
 \DLIONOSDKEYACTIONS))
	       (DOVE (MODIFY.KEYACTIONS
 \DOVEOSDKEYACTIONS))
	       NIL])
)



(* To support office style 1108 & 1186 keyboards)


(DECLARE: EVAL@COMPILE 
[PUTPROPS \KEYNAMETONUMBER MACRO (X (LET [(CE (CONSTANTEXPRESSIONP (CAR X]
					 (COND (CE (\KEYNAMETONUMBER (CAR CE)))
					       (T (QUOTE IGNOREMACRO]
(PUTPROPS \TEMPCOPYTIMER MACRO ((X)
	   (PROGN (\BLT \MOUSETIMERTEMP (LOCF X)
			WORDSPERCELL)
		  \MOUSETIMERTEMP)))
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 
[PUTPROPS XKEYDOWNP MACRO ((KEYNAME)
	   (KEYDOWNP1 (\KEYNAMETONUMBER KEYNAME]
[PUTPROPS KEYDOWNP MACRO ((KEYNAME)
	   (\NEWKEYDOWNP (\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 \NEWKEYDOWNP MACRO ((KEYNUMBER)
	   (EQ 0 (\GETBASEBIT \LASTKEYSTATE KEYNUMBER]
)


(* END EXPORTED DEFINITIONS)

(DEFINEQ

(\SHOWCOLORCURSOR

  [LAMBDA (X Y)                                              (* rrb "25-FEB-83 10:15")

                                                             (* puts the cursor bitmap on the screen at location X 

							     Y)

    (DECLARE
 (
GLOBALVARS
 \MOUSEHOTSPOTX \MOUSEHOTSPOTY \COLORCURSORWIDTH \COLORSCREENCURSORLINEBASE 
			 \COLORSCREENCURSORLINE \COLORCURSORBASE \COLORSCREENWIDTHINBITS 
			 \COLORSCREENRASTERWIDTH \COLORCURSORRASTERWIDTH \ColorCursorBBT))

          (* The coordinate operations may seem weird in this function because they are done in Alto bitmap coordinates {the 

	  ones that the cursor positions are kept in} that has Y as 0 at the top of the screen.)



    (
PROG
 ((X (
IDIFFERENCE
 X \MOUSEHOTSPOTX))
	   (Y (
IDIFFERENCE
 Y (
IDIFFERENCE
 (
SUB1
 \COLORCURSORHEIGHT)
					  \MOUSEHOTSPOTY)))
	   (XBASE 0)
	   (YBASE 0)
	   (WIDTH \COLORCURSORWIDTH)
	   (HEIGHT \COLORCURSORHEIGHT))
          [
COND

	    ((
IGREATERP
 0 X)                                 (* cursor is to the left of the screen.)

	      (
SETQ
 XBASE (
ITIMES
 (
IMINUS
 X)
				  (COLORNUMBERBITSPERPIXEL)))
	      (
SETQ
 WIDTH (
IDIFFERENCE
 WIDTH XBASE))
	      (
SETQ
 X 0))
	    ((
IGREATERP
 (
IPLUS
 (
SETQ
 X (\BITADDRESSOFPIXEL (COLORNUMBERBITSPERPIXEL)
							   X))
			       WIDTH)
			\COLORSCREENWIDTHINBITS)             (* some of the cursor is off the screen to the right.)

	      (
SETQ
 WIDTH (
IDIFFERENCE
 \COLORSCREENWIDTHINBITS X]
          [
COND

	    ((
IGREATERP
 0 Y)                                 (* cursor is to the above of the screen.)

	      (
SETQ
 YBASE (
IMINUS
 Y))
	      (
SETQ
 HEIGHT (
IPLUS
 \COLORCURSORHEIGHT Y))
	      (
SETQ
 Y 0))
	    ((
IGREATERP
 (
IPLUS
 Y \COLORCURSORHEIGHT)
			COLORSCREENHEIGHT)                   (* some of the cursor is off the screen to the right.)

	      (
SETQ
 HEIGHT (
IDIFFERENCE
 COLORSCREENHEIGHT Y]
          (UNINTERRUPTABLY
              [
COND

		((
EQ
 \COLORSCREENCURSORLINE Y)

          (* the base address of the cursor destination in the color screen bitmap is incremented to avoid large number 

	  arithmetic that results because the color screen is more that one segment.)



		  )
		[(
IGREATERP
 \COLORSCREENCURSORLINE Y)        (* subtract the line length from the base enough times)

		  (bind
 (MINUSRW _(
IMINUS
 \COLORSCREENRASTERWIDTH)) until
 (
EQ
 \COLORSCREENCURSORLINE 
									      Y)
		     do
 (
SETQ
 \COLORSCREENCURSORLINE (
SUB1
 \COLORSCREENCURSORLINE))
			(SETQ.NOREF \COLORSCREENCURSORLINEBASE (
\ADDBASE
 \COLORSCREENCURSORLINEBASE 
									 MINUSRW]
		(T                                           (* add line length to base)

		   (until
 (
EQ
 \COLORSCREENCURSORLINE Y)
		      do
 (
SETQ
 \COLORSCREENCURSORLINE (
ADD1
 \COLORSCREENCURSORLINE))
			 (SETQ.NOREF \COLORSCREENCURSORLINEBASE (
\ADDBASE
 \COLORSCREENCURSORLINEBASE 
									  \COLORSCREENRASTERWIDTH]
	      (replace
 (PILOTBBT PBTWIDTH) of
 \ColorCursorBBT with
 WIDTH)
	      (replace
 (PILOTBBT PBTHEIGHT) of
 \ColorCursorBBT with
 HEIGHT)
	      (replace
 (PILOTBBT PBTDEST) of
 \ColorCursorBBT with
 (
\ADDBASE
 
								       \COLORSCREENCURSORLINEBASE
									    (FOLDLO X BITSPERWORD)))
	      (replace
 (PILOTBBT PBTDESTBIT) of
 \ColorCursorBBT with
 (
IMOD
 X BITSPERWORD))
	      [replace
 (PILOTBBT PBTSOURCE) of
 \ColorCursorBBT with
 (
\ADDBASE
 \COLORCURSORBASE
									      (
IPLUS
 (
ITIMES
 YBASE 
									  \COLORCURSORRASTERWIDTH)
										     (FOLDLO XBASE 
										      BITSPERWORD]
	      [replace
 (PILOTBBT PBTSOURCEBIT) of
 \ColorCursorBBT with
 (
COND

									 ((
EQ
 XBASE 0)
									   0)
									 (T (
IMOD
 XBASE BITSPERWORD]
	      (\PILOTBITBLT \ColorCursorBBT 0))])
)

(RPAQ? \COLORCURSORBM
 )

(RPAQ? \COLORCURSORDOWN
 )

(RPAQ? \ColorCursorBBT
 )

(RPAQ? \COLORCURSOR
 )
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 
(PUTPROPS COLORNUMBERBITSPERPIXEL MACRO (NIL (DECLARE (GLOBALVARS \COLORDISPLAYBITSPERPIXEL))
					     \COLORDISPLAYBITSPERPIXEL))
[PUTPROPS \BITADDRESSOFPIXEL MACRO (OPENLAMBDA (BITSPERPIXEL PIXEL)
					       (COND ((EQ BITSPERPIXEL 4)
						      (LLSH PIXEL 2))
						     (T (LLSH PIXEL 3]
(PUTPROPS .TAKE.DOWN.COLOR.CURSOR MACRO (NIL (* uses same bitblt table that the cursor was put up 
						with to take it down.)
					     (\PILOTBITBLT \ColorCursorBBT 0)))
)
(DECLARE: EVAL@COMPILE 

(RPAQQ COLORSCREENWIDTH
 640)

(RPAQQ COLORSCREENHEIGHT
 480)

(CONSTANTS (COLORSCREENWIDTH 640)
	   (COLORSCREENHEIGHT 480))
)


(* END EXPORTED DEFINITIONS)




(* A raw keyboard device/stream)


(DEFINEQ

(\INIT.KEYBOARD.STREAM

  [LAMBDA NIL                                                (* lmm "23-May-85 15:47")

    (DECLARE
 (
GLOBALVARS
 \KEYBOARD.DEVICE \KEYBOARD.STREAM))
    [
\DEFINEDEVICE
 (
QUOTE
 KEYBOARD)
		   (
SETQ
 \KEYBOARD.DEVICE (create
 FDEV
						  DEVICENAME _(
QUOTE
 KEYBOARD)
						  CLOSEFILE _(
FUNCTION
 NILL)
						  EVENTFN _(
FUNCTION
 \KEYBOARDEVENTFN)
						  BIN _(
FUNCTION
 \GETKEY)
						  PEEKBIN _(
FUNCTION
 \PEEKSYSBUF)
						  READP _(
FUNCTION
 \SYSBUFP)
						  EOFP _(
FUNCTION
 NILL)
						  GETFILENAME _(
FUNCTION
 (LAMBDA (X MODE)
						      (if
 (
EQ
 MODE (
QUOTE
 INPUT))
							  then
 \KEYBOARD.STREAM]
    (
SETQ
 \KEYBOARD.STREAM (create
 STREAM
				   USERCLOSEABLE _ NIL
				   USERVISIBLE _ NIL
				   FULLFILENAME _(
QUOTE
 {KEYBOARD})
				   DEVICE _ \KEYBOARD.DEVICE
				   ACCESS _(
QUOTE
 INPUT])
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(\INIT.KEYBOARD.STREAM)
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \KEYBOARD.DEVICE \KEYBOARD.STREAM)
)


(* END EXPORTED DEFINITIONS)




(* Hook for a periodic interrupt)


(DEFINEQ

(\DOBUFFEREDTRANSITIONS

  [LAMBDA (\INTERRUPTABLE)
    (DECLARE
 (
SPECVARS
 \INTERRUPTABLE))                  (* bvm: " 8-Oct-85 17:47")

    (
SETQ
 \KEYBUFFERING (
QUOTE
 INPROGRESS))
    (LET ((PENDINGINTERRUPT))
         (DECLARE
 (
SPECVARS
 PENDINGINTERRUPT))           (* Used by \DECODETRANSITION)

         [bind
 R RPTR until
 (
EQ
 0 (
SETQ
 R (fetch
 (RING READ) of
 \KEYBOARDEVENTQUEUE)))
	    do
 (
SETQ
 RPTR (
\ADDBASE
 \KEYBOARDEVENTQUEUE R)) 
                                                             (* get pointer to this event)

                                                             (* handle simple keyboard words by calling 

							     \DOTRANSITIONS for each word)

		 [
COND

		   ((
NEQ
 (fetch
 (KEYBOARDEVENT W0) of
 RPTR)
			   (fetch
 (KEYBOARDEVENT W0) of
 \LASTKEYSTATE))
		     (\DOTRANSITIONS
 0 (fetch
 (KEYBOARDEVENT W0) of
 \LASTKEYSTATE)
				       (fetch
 (KEYBOARDEVENT W0) of
 RPTR))
		     (replace
 (KEYBOARDEVENT W0) of
 \LASTKEYSTATE with
 (fetch
 (KEYBOARDEVENT
											W0)
										of
 RPTR]
		 [
COND

		   ((
NEQ
 (fetch
 (KEYBOARDEVENT W1) of
 RPTR)
			   (fetch
 (KEYBOARDEVENT W1) of
 \LASTKEYSTATE))
		     (\DOTRANSITIONS
 16 (fetch
 (KEYBOARDEVENT W1) of
 \LASTKEYSTATE)
				       (fetch
 (KEYBOARDEVENT W1) of
 RPTR))
		     (replace
 (KEYBOARDEVENT W1) of
 \LASTKEYSTATE with
 (fetch
 (KEYBOARDEVENT
											W1)
										of
 RPTR]
		 [
COND

		   ((
NEQ
 (fetch
 (KEYBOARDEVENT W2) of
 RPTR)
			   (fetch
 (KEYBOARDEVENT W2) of
 \LASTKEYSTATE))
		     (\DOTRANSITIONS
 32 (fetch
 (KEYBOARDEVENT W2) of
 \LASTKEYSTATE)
				       (fetch
 (KEYBOARDEVENT W2) of
 RPTR))
		     (replace
 (KEYBOARDEVENT W2) of
 \LASTKEYSTATE with
 (fetch
 (KEYBOARDEVENT
											W2)
										of
 RPTR]
		 [
COND

		   ((
NEQ
 (fetch
 (KEYBOARDEVENT W3) of
 RPTR)
			   (fetch
 (KEYBOARDEVENT W3) of
 \LASTKEYSTATE))
		     (\DOTRANSITIONS
 48 (fetch
 (KEYBOARDEVENT W3) of
 \LASTKEYSTATE)
				       (fetch
 (KEYBOARDEVENT W3) of
 RPTR))
		     (replace
 (KEYBOARDEVENT W3) of
 \LASTKEYSTATE with
 (fetch
 (KEYBOARDEVENT
											W3)
										of
 RPTR]
		 [
COND

		   ((
NEQ
 (fetch
 (KEYBOARDEVENT W4) of
 RPTR)
			   (fetch
 (KEYBOARDEVENT W4) of
 \LASTKEYSTATE))
		     (\DOTRANSITIONS
 80 (fetch
 (KEYBOARDEVENT W4) of
 \LASTKEYSTATE)
				       (fetch
 (KEYBOARDEVENT W4) of
 RPTR))
		     (replace
 (KEYBOARDEVENT W4) of
 \LASTKEYSTATE with
 (fetch
 (KEYBOARDEVENT
											W4)
										of
 RPTR]
		 [
COND

		   ((
NEQ
 (fetch
 (KEYBOARDEVENT W5) of
 RPTR)
			   (fetch
 (KEYBOARDEVENT W5) of
 \LASTKEYSTATE))
		     (\DOTRANSITIONS
 96 (fetch
 (KEYBOARDEVENT W5) of
 \LASTKEYSTATE)
				       (fetch
 (KEYBOARDEVENT W5) of
 RPTR))
		     (replace
 (KEYBOARDEVENT W5) of
 \LASTKEYSTATE with
 (fetch
 (KEYBOARDEVENT
											W5)
										of
 RPTR]
		 [
COND

		   ((
NEQ
 (fetch
 (KEYBOARDEVENT WU) of
 RPTR)
			   (fetch
 (KEYBOARDEVENT WU) of
 \LASTKEYSTATE))
		     (\DOTRANSITIONS
 64 (fetch
 (KEYBOARDEVENT WU) of
 \LASTKEYSTATE)
				       (fetch
 (KEYBOARDEVENT WU) of
 RPTR))
		     (replace
 (KEYBOARDEVENT WU) of
 \LASTKEYSTATE with
 (fetch
 (KEYBOARDEVENT
											WU)
										of
 RPTR]

          (* * now remove event from queue)



		 (
COND

		   ((
EQ
 [replace
 (RING READ) of
 \KEYBOARDEVENTQUEUE
			     with
 (
COND

				      ((
IGEQ
 R \KEYBOARDEVENT.LAST)
					\KEYBOARDEVENT.FIRST)
				      (T (
IPLUS
 \KEYBOARDEVENT.SIZE R]
			  (fetch
 (RING WRITE) of
 \KEYBOARDEVENTQUEUE))
		     (replace
 (RING READ) of
 \KEYBOARDEVENTQUEUE with
 0]
         (
PROGN
                                            (* update dummy shift state)

		  (replace
 DUMMY1SHIFT of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT 1SHIFT)
								    of
 \LASTKEYSTATE))
		  (replace
 DUMMY2SHIFT of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT 2SHIFT)
								    of
 \LASTKEYSTATE))
		  (replace
 DUMMYLOCK of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT LOCK)
								  of
 \LASTKEYSTATE))
		  (replace
 DUMMYCTRL of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT CTRL)
								  of
 \LASTKEYSTATE))
		  (replace
 DUMMYMETA of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT META)
								  of
 \LASTKEYSTATE))
		  (replace
 DUMMYFONT of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT FONT)
								  of
 \LASTKEYSTATE))
		  (replace
 DUMMYUSERMODE1 of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT USERMODE1)
								       of
 \LASTKEYSTATE))
		  (replace
 DUMMYUSERMODE2 of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT USERMODE2)
								       of
 \LASTKEYSTATE))
		  (replace
 DUMMYUSERMODE3 of
 \SHIFTSTATE with
 (fetch
 (KEYBOARDEVENT USERMODE3)
								       of
 \LASTKEYSTATE)))

          (* Note: there is a window between the test of READ above and the setting of \KEYBUFFERING below where a keyboard 

	  transition can be ignored until the next transition causes \KEYBUFFERING to be set again)



         (
COND

	   ((
NOT
 (
OR
 PENDINGINTERRUPT \PENDINGINTERRUPT))
                                                             (* No interrupt noticed this time or on any previous 

							     invocation)

	     (
SETQ
 \KEYBUFFERING NIL))
	   ((
NOT
 (
\GETBASEPTR
 (
\STKSCAN
 (
QUOTE
 \INTERRUPTABLE))
				  0))                        (* We're not interruptable, so try again later)

	     (
SETQ
 \PENDINGINTERRUPT T)
	     (
SETQ
 \KEYBUFFERING NIL))
	   (T (
SETQ
 \PENDINGINTERRUPT NIL)
	      (
SETQ
 \KEYBUFFERING NIL)
	      (LET ((\INTERRUPTABLE T))
	           (
INTERRUPTED
])

(\TIMER.INTERRUPTFRAME

  [LAMBDA NIL                                                (* lmm "22-Apr-85 09:47")

                                                             (* place holder for periodic interrupts)

    (if
 NIL
	then
 (
APPLY*
 \PERIODIC.INTERRUPT)
	     (if
 \PERIODIC.INTERRUPT
		 then
 (
SETUPTIMER
 (
QUOTIENT
 (
TIMES
 \PERIODIC.INTERRUPT.FREQUENCY \RCLKSECOND)
					    77)
				  (LOCF (fetch
 DLMOUSETIMER of
 \MISCSTATS))
				  (
QUOTE
 TICKS))
		      (
SETQ
 \TIMER.INTERRUPT.PENDING T])

(\PERIODIC.INTERRUPTFRAME

  [LAMBDA NIL
    (DECLARE
 (
GLOBALVARS
 \PERIODIC.INTERRUPT))               (* lmm "16-Jul-85 16:22")

    (LET ((FN \PERIODIC.INTERRUPT))
         (
AND
 FN (SPREADAPPLY* FN])
)

(RPAQ? \KEYBUFFERING
 )

(RPAQ? \PERIODIC.INTERRUPT
 )

(RPAQ? \TIMER.INTERRUPT.PENDING
 )

(RPAQ? \PERIODIC.INTERRUPT.FREQUENCY
 77)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)



(* cursor and mouse related functions.)


(DEFINEQ

(ADJUSTCURSORPOSITION

  [LAMBDA (DELTAX DELTAY)                                    (* rrb " 3-Oct-85 11:44")

    (
COND

      [(POSITIONP
 DELTAX)
	(\SETCURSORPOSITION
 (
IPLUS
 (fetch
 XCOORD of
 DELTAX)
				       (\XMOUSECOORD))
			      (
IPLUS
 (fetch
 YCOORD of
 DELTAX)
				       (\YMOUSECOORD]
      (T (\SETCURSORPOSITION
 (
IPLUS
 (
OR
 DELTAX 0)
					(\XMOUSECOORD))
			       (
IPLUS
 (
OR
 DELTAY 0)
					(\YMOUSECOORD])

(CREATEPOSITION

  [LAMBDA (XCOORD YCOORD)                                    (* rmk: " 6-Aug-84 13:43")

    (create
 POSITION
	    XCOORD _(
OR
 XCOORD 0)
	    YCOORD _(
OR
 YCOORD 0])

(CURSOR

  [LAMBDA (NEWCURSOR INVERTFLG)                              (* rrb " 4-DEC-82 17:51")

                                                             (* installs NEWCURSOR as the cursor and returns the 

							     current cursor state. If INVERTFLG is non-NIL, the 

							     cursor image is inverted during installation.)

    (DECLARE
 (
GLOBALVARS
 DEFAULTCURSOR))
    (
PROG1
 (create
 CURSOR
		   CURSORBITMAP _[
BITMAPCOPY
 (
COND

					       (\COLORCURSORBM 
                                                             (* cursor is on color display, get bw copy of cursor 

							     bitmap since the hardware one is empty.)

							       \COLORCURSOR)
					       (T (
CURSORBITMAP
]
		   CURSORHOTSPOT _(CURSORHOTSPOT
))
	   (
COND

	     ((
EQ
 NEWCURSOR T)
	       (
SETQ
 NEWCURSOR DEFAULTCURSOR)))
	   (
COND

	     ((type?
 CURSOR NEWCURSOR)
	       (SETCURSOR
 NEWCURSOR INVERTFLG])

(CURSORCREATE

  [LAMBDA (BITMAP X Y)                                       (* lmm "11-MAR-82 00:57")

                                                             (* creates a cursor from a bitmap.

							     X and Y specify the hotspot.)

    (
PROG
 ((BM (
BITMAPCREATE
 CURSORWIDTH CURSORHEIGHT)))
          (
BITBLT
 (
OR
 BITMAP (
CURSORBITMAP
))
		  0 0 BM 0 0 CURSORWIDTH CURSORHEIGHT (
QUOTE
 INPUT)
		  (
QUOTE
 REPLACE))
          (
RETURN
 (create
 CURSOR
			  CURSORBITMAP _ BM
			  CURSORHOTSPOT _(create
 POSITION
						 XCOORD _(
COND

						   ((POSITIONP
 X)
						     (fetch
 XCOORD of
 X))
						   (T (
OR
 (
FIXP
 X)
							  0)))
						 YCOORD _(
COND

						   ((POSITIONP
 X)
						     (fetch
 YCOORD of
 X))
						   (T (
OR
 (
FIXP
 Y)
							  (
SUB1
 CURSORHEIGHT])

(CURSORHOTSPOT

  [LAMBDA (NEWPOSITION)                                      (* rrb "14-JAN-81 16:16")

                                                             (* returns the current cursor hot spot and sets the hot

							     spot to NEWPOSITON if one is given.)

    (
PROG1
 (create
 POSITION
		   XCOORD _ \MOUSEHOTSPOTX
		   YCOORD _ \MOUSEHOTSPOTY)
	   (
COND

	     ((POSITIONP
 NEWPOSITION)
	       (
SETQ
 \MOUSEHOTSPOTX (fetch
 XCOORD of
 NEWPOSITION))
	       (
SETQ
 \MOUSEHOTSPOTY (fetch
 YCOORD of
 NEWPOSITION])

(CURSORPOSITION

  [LAMBDA (NEWPOSITION DISPLAYSTREAM OLDPOSITION)            (* rrb " 3-Oct-85 11:44")

    (
PROG
 ((DD (\GETDISPLAYDATA DISPLAYSTREAM)))
	    (
OR
 (POSITIONP
 OLDPOSITION)
		  (
SETQ
 OLDPOSITION (create
 POSITION)))
	    (freplace
 XCOORD of
 OLDPOSITION with
 (
\DSPUNTRANSFORMX
 (\XMOUSECOORD)
									   DD))
	    (freplace
 YCOORD of
 OLDPOSITION with
 (
\DSPUNTRANSFORMY
 (\YMOUSECOORD)
									   DD))
	    (
COND

	      ((POSITIONP
 NEWPOSITION)
		(\SETCURSORPOSITION
 (\DSPTRANSFORMX (fetch
 XCOORD of
 NEWPOSITION)
						      DD)
				      (\DSPTRANSFORMY (fetch
 YCOORD of
 NEWPOSITION)
						      DD)))
	      (NEWPOSITION (
\ILLEGAL.ARG
 NEWPOSITION)))
	    (
RETURN
 OLDPOSITION])

(\SETCURSORPOSITION

  (LAMBDA (XPOS YPOS)                                        (* jwo: "23-Jul-85 02:49")

                                                             (* sets cursor position, adjusts for hotspot and tty 

							     region limits. XPOS and YPOS are the screen coordinates

							     of the hotspot location.)

    (DECLARE
 (
GLOBALVARS
 \MOUSEHOTSPOTX \MOUSEHOTSPOTY SCREENWIDTH SCREENHEIGHT))
                                                             (* if the color cursor is running, the position is the 

							     real position so don't correct for the hotspot.)

                                                             (* Clip coordinates to between 0 and 

							     SCREENWIDTH,CURSORYMAX)

    (
COND

      (\COLORCURSORBM (
SETQ
 XPOS (
COND

			  ((
ILESSP
 XPOS 0)
			    0)
			  ((
IGREATERP
 XPOS (
CONSTANT
 (
SUB1
 COLORSCREENWIDTH)))
			    (
CONSTANT
 (
SUB1
 COLORSCREENWIDTH)))
			  (T XPOS)))
		      (
SETQ
 YPOS (
IDIFFERENCE
 (
CONSTANT
 (
SUB1
 COLORSCREENHEIGHT))
					      (
COND

						((
ILESSP
 YPOS 0)
						  0)
						((
IGREATERP
 YPOS (
CONSTANT
 (
SUB1
 COLORSCREENHEIGHT)))
						  (
CONSTANT
 (
SUB1
 COLORSCREENHEIGHT)))
						(T YPOS)))))
      (T (
SETQ
 XPOS (UNSIGNED (
IDIFFERENCE
 (
COND

					     ((
ILESSP
 XPOS 0)
					       0)
					     ((
IGEQ
 XPOS SCREENWIDTH)
					       (
SUB1
 SCREENWIDTH))
					     (T XPOS))
					   \MOUSEHOTSPOTX)
			      BITSPERWORD))

          (* YPOS is reflected around CURSORYMAX because the screen has (0,0) as the upper left corner.

	  Complicated by the fact that it needs to position the upper left corner of the cursor. (IMINUS CURSORHEIGHT) allows 

	  the cursor to move off the bottom of the screen. When moved to LISP, cursor tracking should allow the hotspot to be 

	  anywhere on the screen.)



	 (
SETQ
 YPOS (UNSIGNED (
IDIFFERENCE
 (
IPLUS
 (
IDIFFERENCE
 SCREENHEIGHT CURSORHEIGHT)
						  \MOUSEHOTSPOTY)
					   (
COND

					     ((
ILESSP
 YPOS 0)
					       0)
					     ((
IGREATERP
 YPOS SCREENHEIGHT)
					       SCREENHEIGHT)
					     (T YPOS)))
			      BITSPERWORD))
	 (
COND

	   ((
OR
 (
EQ
 \MACHINETYPE \DANDELION)
		(
EQ
 \MACHINETYPE \DAYBREAK))                 (* Temporary workaround)

	     (
COND

	       ((
IGREATERP
 YPOS 32767)
		 (
SETQ
 YPOS 0)))
	     (
COND

	       ((
IGREATERP
 XPOS 32767)
		 (
SETQ
 XPOS 0)))))))
    (\SETMOUSEXY XPOS YPOS)
    (
PROGN
                                                   (* change the cursor position too so that GETMOUSESTATE

							     will get the correct values if it is called before the 

							     next 60 cycle interrupt.)

	   (
\PUTBASE
 \EM.CURSORX 0 XPOS)
	   (
\PUTBASE
 \EM.CURSORY 0 YPOS)
	   (
COND

	     ((
EQ
 \MACHINETYPE \DAYBREAK)                    (* Need to do special stuff for daybreak IOP)

	       (
\DoveDisplay.SetCursorPosition
 XPOS YPOS))))
    NIL))

(FLIPCURSOR

  [LAMBDA NIL                                                (* mpl "21-Jul-85 00:08")

    (
PROG
 ((ADDR \EM.CURSORBITMAP))
          (
FRPTQ
 CURSORHEIGHT [
\PUTBASE
 ADDR 0 (
LOGXOR
 (
\GETBASE
 ADDR 0)
						       (
CONSTANT
 (
SUB1
 (
EXPT
 2 CURSORWIDTH]
		 (
SETQ
 ADDR (
\ADDBASE
 ADDR 1)))
          (
COND

	    ((
EQ
 \MACHINETYPE \DAYBREAK)
	      (
\DoveDisplay.SetCursorShape
])

(FLIPCURSORBAR

  [LAMBDA (N)                                                (* bvm: "13-Aug-85 17:26")


          (* * Inverts the Nth line of the cursor, N = 0 being the top)



    (
\PUTBASE
 \EM.CURSORBITMAP N (
LOGXOR
 (
\GETBASE
 \EM.CURSORBITMAP N)
					 (
CONSTANT
 MAX.SMALL.INTEGER)))
    (
COND

      ((
EQ
 \MACHINETYPE \DAYBREAK)                           (* Notify IOP)

	(
\DoveDisplay.SetCursorShape
])

(LASTMOUSEX

  [LAMBDA (DS)                                               (* rmk: "30-AUG-83 13:07")

                                                             (* returns the mouse x position in the coordinates of 

							     the DisplayStream DS)

    (
\DSPUNTRANSFORMX
 LASTMOUSEX (\GETDISPLAYDATA DS])

(LASTMOUSEY

  [LAMBDA (DS)                                               (* rmk: "30-AUG-83 13:07")

                                                             (* returns the mouse y position in the coordinates of 

							     the DisplayStream DS)

    (
\DSPUNTRANSFORMY
 LASTMOUSEY (\GETDISPLAYDATA DS])

(POSITIONP

  [LAMBDA (X)                                                (* rrb "25-AUG-82 11:04")

                                                             (* is X a position? For now just a cons check but 

							     should be made a datatype.)

    (
AND
 (
LISTP
 X)
	 (
NUMBERP
 (
CAR
 X))
	 (
NUMBERP
 (
CDR
 X))
	 X])

(SETCURSOR

  [LAMBDA (NEWCURSOR INVERTFLG)                              (* MPL "21-Jun-85 16:40")

                                                             (* version of SETCURSOR that knows about the 

							     possibility of the cursor being on the color screen.)

    (
OR
 (type?
 CURSOR NEWCURSOR)
	(
\ILLEGAL.ARG
 NEWCURSOR))
    (
COND

      (\COLORCURSORBM                                        (* cursor is on the color screen)

		      (\TAKEDOWNCOLORCURSOR)
		      (
SETQ
 \MOUSEHOTSPOTY (fetch
 CURSORHOTSPOTY of
 NEWCURSOR))
		      (
SETQ
 \MOUSEHOTSPOTX (fetch
 CURSORHOTSPOTX of
 NEWCURSOR))
		      (\SETCOLORCURSORBM (fetch
 (CURSOR
 CURSORBITMAP) of
 NEWCURSOR)))
      (T [
SELECTC
 \MACHINETYPE
		  (\DAYBREAK (\DoveDisplay.SetCursorShape (fetch
 CURSORBITMAP of
 NEWCURSOR)))
		  (
PROGN
 (
BITBLT
 (fetch
 CURSORBITMAP of
 NEWCURSOR)
				 0 0 (
CURSORBITMAP
)
				 0 0 CURSORWIDTH CURSORHEIGHT (
COND

				   (INVERTFLG (
QUOTE
 INVERT))
				   (T (
QUOTE
 INPUT)))
				 (
QUOTE
 REPLACE]             (* don't need to adjust the color cursor because it is 

							     kept in hotspot independent terms.)

	 (ADJUSTCURSORPOSITION
 (
IDIFFERENCE
 \MOUSEHOTSPOTX (fetch
 CURSORHOTSPOTX of
 NEWCURSOR))
			       (
IDIFFERENCE
 \MOUSEHOTSPOTY (fetch
 CURSORHOTSPOTY of
 NEWCURSOR)))
                                                             (* set after adjustment to avoid confusion about 

							     hotspot during adjustment.)

	 (
SETQ
 \MOUSEHOTSPOTY (fetch
 CURSORHOTSPOTY of
 NEWCURSOR))
	 (
SETQ
 \MOUSEHOTSPOTX (fetch
 CURSORHOTSPOTX of
 NEWCURSOR])
)
(DEFINEQ

(GETMOUSESTATE

  [LAMBDA NIL                                                (* lmm "18-Apr-85 02:13")

                                                             (* Reads the current state of the mouse and keyboard)

    (
SETQ
 LASTMOUSEX (\XMOUSECOORD))
    (
SETQ
 LASTMOUSEY (\YMOUSECOORD))
    (
SETQ
 LASTMOUSEBUTTONS (
LOGXOR
 (
LOGAND
 (fetch
 WU \LASTKEYSTATE)
					   \MOUSE.ALLBITS)
				   \MOUSE.ALLBITS))
    (
SETQ
 LASTKEYBOARD (\EVENTKEYS
))
    NIL])

(\EVENTKEYS

  [LAMBDA NIL                                                (* rmk: " 4-JUN-81 22:58")

                                                             (* Returns the state of the various keys that are 

							     represented in mouse events)

    (
LOGOR
 (
COND

	     ((KEYDOWNP
 (
QUOTE
 LOCK))
	       128)
	     (T 0))
	   (
COND

	     ((KEYDOWNP
 (
QUOTE
 LSHIFT))
	       64)
	     (T 0))
	   (
COND

	     ((KEYDOWNP
 (
QUOTE
 CTRL))
	       32)
	     (T 0))
	   (
COND

	     ((KEYDOWNP
 (
QUOTE
 RSHIFT))
	       8)
	     (T 0))
	   (
COND

	     ((KEYDOWNP
 (
QUOTE
 BLANK-TOP))
	       4)
	     (T 0))
	   (
COND

	     ((KEYDOWNP
 (
QUOTE
 BLANK-MIDDLE))
	       2)
	     (T 0))
	   (
COND

	     ((KEYDOWNP
 (
QUOTE
 BLANK-BOTTOM))
	       1)
	     (T 0])
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 

(RPAQQ CURSORHEIGHT
 16)

(RPAQQ CURSORWIDTH
 16)

(CONSTANTS (CURSORHEIGHT 16)
	   (CURSORWIDTH 16))
)
(DECLARE: EVAL@COMPILE 

(ADDTOVAR GLOBALVARS
 LASTMOUSEX LASTMOUSEY LASTMOUSEBUTTONS LASTMOUSETIME LASTKEYBOARD)
)


(* END EXPORTED DEFINITIONS)


(RPAQ? \MOUSEHOTSPOTX
 0)

(RPAQ? \MOUSEHOTSPOTY
 15)
(DECLARE: DOEVAL@COMPILE DONTCOPY

(GLOBALVARS \MOUSEHOTSPOTX \MOUSEHOTSPOTY \MOUSETIMEBOX \COLORCURSOR)
)
(DECLARE: DONTCOPY 
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: EVAL@COMPILE 
[PUTPROPS \SETMOUSEXY MACRO ((XPOS YPOS)
	   (PROGN (SELECTC \MACHINETYPE (\DANDELION (do (PROGN (replace NEWMOUSEX of \IOPAGE with 
									XPOS)
							       (replace NEWMOUSEY of \IOPAGE with 
									YPOS))
							repeatuntil
							(ILESSP (fetch NEWMOUSESTATE of \IOPAGE)
								32768))
						    (* smash position until mouse says it is not busy)
						    (replace NEWMOUSEX of \IOPAGE with XPOS)
						    (replace NEWMOUSEY of \IOPAGE with YPOS)
						    (replace NEWMOUSESTATE of \IOPAGE with 32768))
			   (\DAYBREAK (\DoveMisc.SetMousePosition XPOS YPOS))
			   NIL)
		  (PROGN (\PUTBASE \EM.MOUSEX 0 XPOS)
			 (\PUTBASE \EM.MOUSEY 0 YPOS]
)


(* END EXPORTED DEFINITIONS)


(DECLARE: EVAL@COMPILE 
[PUTPROPS \XMOUSECOORD MACRO (NIL (COND (\COLORCURSORBM (\GETBASE \EM.CURSORX 0))
					(T (IPLUS \MOUSEHOTSPOTX (SIGNED (\GETBASE \EM.CURSORX 0)
									 BITSPERWORD]
[PUTPROPS \YMOUSECOORD MACRO (NIL (IDIFFERENCE [COND (\COLORCURSORBM (* color cursor is on.)
								     (CONSTANT (SUB1 
										COLORSCREENHEIGHT)))
						     (T (IPLUS \MOUSEHOTSPOTY (IDIFFERENCE 
										     SCREENHEIGHT 
										     CURSORHEIGHT]
					       (SIGNED (\GETBASE \EM.CURSORY 0)
						       BITSPERWORD]
)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 

(RPAQ \SFPosition
 (CREATEPOSITION))
)
(DECLARE: DOEVAL@COMPILE 

(RPAQQ SCREENHEIGHT
 808)
)
(DECLARE: DONTCOPY 
[DECLARE: EVAL@COMPILE 

(BLOCKRECORD KEYBOARDEVENT
 ((W0 WORD)
			      (W1 WORD)
			      (W2 WORD)
			      (W3 WORD)
			      (WU WORD)
			      (W4 WORD)
			      (W5 WORD)
			      (
TIME
 FIXP)
			      (MOUSESTATE BITS 3)
			      (1SHIFT FLAG)
			      (2SHIFT FLAG)
			      (LOCK FLAG)
			      (CTRL FLAG)
			      (META FLAG)
			      (FONT FLAG)
			      (USERMODE1 FLAG)
			      (USERMODE2 FLAG)
			      (USERMODE3 FLAG)
			      (NIL BITS 4)
			      (MOUSEX WORD)
			      (MOUSEY WORD))
			     (CREATE
 (
\ALLOCBLOCK
 (FOLDHI \KEYBOARDEVENT.SIZE WORDSPERCELL)))
			     W0 _ ALLUP W1 _ ALLUP W2 _ ALLUP W3 _ ALLUP W4 _ ALLUP W5 _ ALLUP WU _ 
			     ALLUP MOUSESTATE _ \DLMOUSE.UP
			     [
ACCESSFNS
 KEYBOARDEVENT ((SIZE (INDEXF (fetch
 MOUSEY of
 DATUM)))
					   (SHIFT (
OR
 (fetch
 (KEYBOARDEVENT 1SHIFT)
								 DATUM)
							(fetch
 (KEYBOARDEVENT 2SHIFT)
								 DATUM)))
					   (SHIFTORLOCK (
OR
 (fetch
 (KEYBOARDEVENT SHIFT)
								       DATUM)
							      (fetch
 (KEYBOARDEVENT LOCK)
								       DATUM]
			     LOCK _(XKEYDOWNP (
QUOTE
 LOCK))
			     TIME _ 0)
]

(DECLARE: EVAL@COMPILE 

(RPAQ \KEYBOARDEVENT.FIRST
 NRINGINDEXWORDS)

(RPAQQ \KEYBOARDEVENT.SIZE
 12)

(RPAQ \KEYBOARDEVENT.LAST
 (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383)))

[CONSTANTS (\KEYBOARDEVENT.FIRST NRINGINDEXWORDS)
	   \KEYBOARDEVENT.SIZE
	   (\KEYBOARDEVENT.LAST (PLUS \KEYBOARDEVENT.FIRST (TIMES \KEYBOARDEVENT.SIZE 383]
)
)
(DEFINEQ

(MACHINETYPE

  (LAMBDA NIL                                                (* mpl "27-Jun-85 20:57")

    (
SELECTQ
 (fetch
 MachineType of
 \InterfacePage)
	     (4 (
QUOTE
 DOLPHIN))
	     (5 (
QUOTE
 DORADO))
	     (6 (
QUOTE
 DANDELION))
	     (8                                              (* This is \DAYBREAK internally)

		(
QUOTE
 DOVE))
	     NIL)))

(SETMAINTPANEL

  [LAMBDA (N)                                                (* mpl "21-Jul-85 18:15")

    (
SELECTC
 \MACHINETYPE
	     (\DANDELION (replace
 DLMAINTPANEL of
 \IOPAGE with
 N))
	     [\DOLPHIN ((OPCODES MISC1 3)
			(
\DTEST
 N (
QUOTE
 SMALLP]
	     [\DAYBREAK ((OPCODES DOVEMISC 2)
			 (
\DTEST
 N (
QUOTE
 SMALLP]
	     NIL])
)



(* DLion beeper)


(DEFINEQ

(BEEPON

  [LAMBDA (FREQ)                                             (* MPL "27-Jul-85 21:48")

    (
SELECTC
 \MACHINETYPE
	     (\DANDELION (while
 (
IGEQ
 (fetch
 DLBEEPCMD of
 \IOPAGE)
				      32768)
			    do
 (
BLOCK
))
			 (replace
 DLBEEPFREQ of
 \IOPAGE with
 (
IQUOTIENT
 1843200 (
IMAX
 FREQ 29)))
			 (replace
 DLBEEPCMD of
 \IOPAGE with
 32768))
	     (\DAYBREAK (
\DoveMisc.BeepOn
 FREQ))
	     (
PROGN
 NIL))
    NIL])

(BEEPOFF

  [LAMBDA NIL                                                (* MPL "27-Jul-85 21:49")

    (
SELECTC
 \MACHINETYPE
	     (\DANDELION (while
 (
IGEQ
 (fetch
 DLBEEPCMD of
 \IOPAGE)
				      32768)
			    do
 (
BLOCK
))
			 (replace
 DLBEEPCMD of
 \IOPAGE with
 32769))
	     (\DAYBREAK (
\DoveMisc.BeepOff
))
	     (
PROGN
 NIL))
    NIL])
)
(* FOLLOWING DEFINITIONS EXPORTED)


(DECLARE: DOEVAL@COMPILE DONTCOPY

(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 \EM.DISPINTERRUPT \EM.DISPLAYHEAD 
	    \EM.CURSORBITMAP \MACHINETYPE \COLORCURSORBM \COLORCURSOR \COLORCURSORDOWN 
	    \ColorCursorBBT \COLORCURSORWIDTH \COLORSCREENCURSORLINEBASE \COLORSCREENCURSORLINE 
	    \COLORCURSORBASE \COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH \COLORCURSORRASTERWIDTH 
	    \DEFAULTKEYACTION \CURRENTKEYACTION \PERIODIC.INTERRUPT \PERIODIC.INTERRUPT.FREQUENCY)
)


(* END EXPORTED DEFINITIONS)

(DEFINEQ

(WITHOUT-INTERRUPTS

  [NLAMBDA (FORM)                                            (* lmm "18-Apr-85 02:53")

    (
PROG
 (VAL)
          (\KEYBOARDOFF
)
          (
SETQ
 VAL (
DISPLAYDOWN
 FORM))
          (\KEYBOARDON
)
          (
RETURN
 VAL])
)



(* Compile locked fns together for locality)


[DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY
(BLOCK: NIL FLIPCURSORBAR \KEYHANDLER \KEYHANDLER1 \TRACKCURSOR \DOMOUSECHORDING 
	\PERIODIC.INTERRUPTFRAME \TIMER.INTERRUPTFRAME \DOBUFFEREDTRANSITIONS \DOTRANSITIONS 
	\DECODETRANSITION \EVENTKEYS)
]
(DECLARE: DONTCOPY 

(ADDTOVAR INEWCOMS
 (ALLOCAL (ADDVARS (LOCKEDFNS \KEYHANDLER \KEYHANDLER1 \DOMOUSECHORDING 
						  \CONTEXTAPPLY \LOCKPAGES \SMASHLINK \INCUSECOUNT 
						  LLSH \MAKEFREEBLOCK \DECUSECOUNT \MAKENUMBER 
						  \ADDBASE \PERIODIC.INTERRUPTFRAME 
						  \DOBUFFEREDTRANSITIONS \TIMER.INTERRUPTFRAME 
						  \TRACKCURSOR FLIPCURSORBAR)
				       (LOCKEDVARS \InterfacePage \MOUSEHOTSPOTX \MOUSEHOTSPOTY 
						   \PENDINGINTERRUPT \COLORCURSORBM \COLORCURSORDOWN 
						   \COLORDISPLAYBITSPERPIXEL \ColorCursorBBT 
						   \COLORCURSORWIDTH \COLORSCREENCURSORLINE 
						   \COLORSCREENCURSORLINEBASE \COLORCURSORBASE 
						   \COLORSCREENWIDTHINBITS \COLORSCREENRASTERWIDTH 
						   \COLORCURSORRASTERWIDTH \PERIODIC.INTERRUPT 
						   \PERIODIC.INTERRUPT.FREQUENCY \LASTUSERACTION 
						   \MOUSECHORDTICKS \KEYBOARDEVENTQUEUE \KEYBUFFERING 
						   SCREENWIDTH SCREENHEIGHT \TIMER.INTERRUPT.PENDING 
						   \EM.MOUSEX \EM.MOUSEY \EM.CURSORX \EM.CURSORY 
						   \EM.UTILIN \EM.REALUTILIN \EM.KBDAD0 \EM.KBDAD1 
						   \EM.KBDAD2 \EM.KBDAD3 \EM.DISPINTERRUPT 
						   \EM.CURSORBITMAP \EM.KBDAD4 \EM.KBDAD5 \MISCSTATS 
						   \RCLKSECOND))))

(ADDTOVAR RDCOMS
 (FNS \SETIOPOINTERS))
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA
 )

(ADDTOVAR NLAML
 WITHOUT-INTERRUPTS)

(ADDTOVAR LAMA
 METASHIFT MOUSECHORDWAIT)
)
(PUTPROPS LLKEY COPYRIGHT ("Xerox Corporation" 1982 1983 1984 1985))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (7435 13071 (BKSYSCHARCODE 7445 . 7758) (\CLEARSYSBUF 7760 . 8269) (\GETKEY 8271 . 9096)
 (\NSYSBUFCHARS 9098 . 9696) (\SAVESYSBUF 9698 . 10937) (\SYSBUFP 10939 . 11258) (\GETSYSBUF 11260 . 
11441) (\PUTSYSBUF 11443 . 12233) (\PEEKSYSBUF 12235 . 13069)) (14024 44881 (\KEYBOARDINIT 14034 . 
15452) (\KEYBOARDEVENTFN 15454 . 17331) (\ALLOCLOCKED 17333 . 17825) (\SETIOPOINTERS 17827 . 22828) (
\KEYBOARDOFF 22830 . 23063) (\KEYBOARDON 23065 . 23295) (\KEYHANDLER 23297 . 23428) (\KEYHANDLER1 
23430 . 29157) (\RESETKEYBOARD 29159 . 30392) (\DOMOUSECHORDING 30394 . 33797) (\DOTRANSITIONS 33799
 . 34478) (\DECODETRANSITION 34480 . 39186) (MOUSECHORDWAIT 39188 . 39698) (\TRACKCURSOR 39700 . 44879
)) (60806 69551 (KEYACTION 60816 . 61326) (KEYACTIONTABLE 61328 . 61604) (\KEYACTION1 61606 . 66189) (
KEYDOWNP 66191 . 66462) (\KEYNAMETONUMBER 66464 . 67049) (MODIFY.KEYACTIONS 67051 . 67455) (METASHIFT 
67457 . 68289) (SHIFTDOWNP 68291 . 69549)) (69552 69852 (SETUP.OFFICE.KEYBOARD 69562 . 69850)) (71415 
75366 (\SHOWCOLORCURSOR 71425 . 75364)) (76248 77174 (\INIT.KEYBOARD.STREAM 76258 . 77172)) (77428 
84271 (\DOBUFFEREDTRANSITIONS 77438 . 83494) (\TIMER.INTERRUPTFRAME 83496 . 84049) (
\PERIODIC.INTERRUPTFRAME 84051 . 84269)) (84520 95082 (ADJUSTCURSORPOSITION 84530 . 85008) (
CREATEPOSITION 85010 . 85209) (CURSOR 85211 . 86180) (CURSORCREATE 86182 . 87046) (CURSORHOTSPOT 87048
 . 87619) (CURSORPOSITION 87621 . 88404) (\SETCURSORPOSITION 88406 . 91461) (FLIPCURSOR 91463 . 91902)
 (FLIPCURSORBAR 91904 . 92351) (LASTMOUSEX 92353 . 92677) (LASTMOUSEY 92679 . 93003) (POSITIONP 93005
 . 93359) (SETCURSOR 93361 . 95080)) (95083 96441 (GETMOUSESTATE 95093 . 95590) (\EVENTKEYS 95592 . 
96439)) (99898 100667 (MACHINETYPE 99908 . 100293) (SETMAINTPANEL 100295 . 100665)) (100693 101580 (
BEEPON 100703 . 101189) (BEEPOFF 101191 . 101578)) (102236 102515 (WITHOUT-INTERRUPTS 102246 . 102513)
))))
STOP