diff --git a/hemlock/input.lisp b/hemlock/input.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..7dc4e34aecb4f0ce5bbaa59c353dd9a518399655
--- /dev/null
+++ b/hemlock/input.lisp
@@ -0,0 +1,442 @@
+;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the Spice Lisp project at
+;;; Carnegie-Mellon University, and has been placed in the public domain.
+;;; Spice Lisp is currently incomplete and under active development.
+;;; If you want to use this code or any part of Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC).
+;;; **********************************************************************
+;;;
+;;; This file contains the code that handles input to Hemlock.
+;;;
+(in-package "HEMLOCK-INTERNALS")
+
+(export '(get-key-event unget-key-event clear-editor-input listen-editor-input
+	  *last-key-event-typed* *key-event-history* *editor-input*
+	  *real-editor-input* input-waiting last-key-event-cursorpos))
+;;;
+;;; INPUT-WAITING is exported solely as a hack for the kbdmac definition
+;;; mechanism.
+;;;
+
+
+;;; These are public variables users hand to the four basic editor input
+;;; routines for method dispatching:
+;;;    GET-KEY-EVENT
+;;;    UNGET-KEY-EVENT
+;;;    LISTEN-EDITOR-INPUT
+;;;    CLEAR-EDITOR-INPUT
+;;;
+(defvar *editor-input* nil
+  "A structure used to do various operations on terminal input.")
+
+(defvar *real-editor-input* ()
+  "Useful when we want to read from the terminal when *editor-input* is
+   rebound.")
+
+
+
+;;;; editor-input structure.
+
+(defstruct (editor-input (:print-function
+			  (lambda (s stream d)
+			    (declare (ignore s d))
+			    (write-string "#<Editor-Input stream>" stream))))
+  get          ; A function that returns the next key-event in the queue.
+  unget        ; A function that puts a key-event at the front of the queue.
+  listen       ; A function that tells whether the queue is empty.
+  clear        ; A function that empties the queue.
+  ;;
+  ;; Queue of events on this stream.  The queue always contains at least one
+  ;; one element, which is the key-event most recently read.  If no event has
+  ;; been read, the event is a dummy with a nil key-event.
+  head
+  tail)
+
+
+;;; These are the elements of the editor-input event queue.
+;;;
+(defstruct (input-event (:constructor make-input-event ())) 
+  next		; Next queued event, or NIL if none.
+  hunk		; Screen hunk event was read from.
+  key-event     ; Key-event read.
+  x		; X and Y character position of mouse cursor.
+  y
+  unread-p)
+
+(defvar *free-input-events* ())
+
+(defun new-event (key-event x y hunk next &optional unread-p)
+  (let ((res (if *free-input-events*
+		 (shiftf *free-input-events*
+			 (input-event-next *free-input-events*))
+		 (make-input-event))))
+    (setf (input-event-key-event res) key-event)
+    (setf (input-event-x res) x)
+    (setf (input-event-y res) y)
+    (setf (input-event-hunk res) hunk)
+    (setf (input-event-next res) next)
+    (setf (input-event-unread-p res) unread-p)
+    res))
+
+;;; This is a public variable.
+;;;
+(defvar *last-key-event-typed* ()
+  "This variable contains the last key-event typed by the user and read as
+   input.")
+
+;;; This is a public variable.  SITE-INIT initializes this.
+;;;
+(defvar *key-event-history* nil
+  "This ring holds the last 60 key-events read by the command interpreter.")
+
+(proclaim '(special *input-transcript*))
+
+;;; DQ-EVENT is used in editor stream methods for popping off input.
+;;; If there is an event not yet read in Stream, then pop the queue
+;;; and return the character.  If there is none, return NIL.
+;;;
+(defun dq-event (stream)
+  (without-interrupts
+   (let* ((head (editor-input-head stream))
+	  (next (input-event-next head)))
+     (if next
+	 (let ((key-event (input-event-key-event next)))
+	   (setf (editor-input-head stream) next)
+	   (shiftf (input-event-next head) *free-input-events* head)
+	   (ring-push key-event *key-event-history*)
+	   (setf *last-key-event-typed* key-event)
+	   (when *input-transcript* 
+	     (vector-push-extend key-event *input-transcript*))
+	   key-event)))))
+
+;;; Q-EVENT is used in low level input fetching routines to add input to the
+;;; editor stream.
+;;; 
+(defun q-event (stream key-event &optional x y hunk)
+  (without-interrupts
+   (let ((new (new-event key-event x y hunk nil))
+	 (tail (editor-input-tail stream)))
+     (setf (input-event-next tail) new)
+     (setf (editor-input-tail stream) new))))
+
+(defun un-event (key-event stream)
+  (without-interrupts
+   (let* ((head (editor-input-head stream))
+	  (next (input-event-next head))
+	  (new (new-event key-event (input-event-x head) (input-event-y head)
+			  (input-event-hunk head) next t)))
+     (setf (input-event-next head) new)
+     (unless next (setf (editor-input-tail stream) new)))))
+
+
+
+;;;; Keyboard macro hacks.
+
+(defvar *input-transcript* ()
+  "If this variable is non-null then it should contain an adjustable vector
+  with a fill pointer into which all keyboard input will be pushed.")
+
+;;; INPUT-WAITING  --  Internal
+;;;
+;;;    An Evil hack that tells us whether there is an unread key-event on
+;;; *editor-input*.  Note that this is applied to the real *editor-input*
+;;; rather than to a kbdmac stream.
+;;;
+(defun input-waiting ()
+  "Returns true if there is a key-event which has been unread-key-event'ed
+   on *editor-input*.  Used by the keyboard macro stuff."
+  (let ((next (input-event-next
+	       (editor-input-head *real-editor-input*))))
+    (and next (input-event-unread-p next))))
+
+
+
+;;;; Input method macro.
+
+(defvar *in-hemlock-stream-input-method* nil
+  "This keeps us from undefined nasties like re-entering Hemlock stream
+   input methods from input hooks and scheduled events.")
+
+(proclaim '(special *screen-image-trashed*))
+
+;;; These are the characters GET-KEY-EVENT notices when it pays attention
+;;; to aborting input.  This happens via EDITOR-INPUT-METHOD-MACRO.
+;;;
+(defparameter editor-abort-key-events (list #k"Control-g" #k"Control-G"))
+
+(defmacro abort-key-event-p (key-event)
+  `(member ,key-event editor-abort-key-events))
+
+;;; EDITOR-INPUT-METHOD-MACRO  --  Internal.
+;;;
+;;; WINDOWED-GET-KEY-EVENT and TTY-GET-KEY-EVENT use this.  Somewhat odd stuff
+;;; goes on here because this is the place where Hemlock waits, so this is
+;;; where we redisplay, check the time for scheduled events, etc.  In the loop,
+;;; we call the input hook when we get a character and leave the loop.  If
+;;; there isn't any input, invoke any scheduled events whose time is up.
+;;; Unless SERVE-EVENT returns immediately and did something, (serve-event 0),
+;;; call redisplay, note that we are going into a read wait, and call
+;;; SERVE-EVENT with a wait or infinite timeout.  Upon exiting the loop, turn
+;;; off the read wait note and check for the abort character.  Return the
+;;; key-event we got.  We bind an error condition handler here because the
+;;; default Hemlock error handler goes into a little debugging prompt loop, but
+;;; if we got an error in getting input, we should prompt the user using the
+;;; input method (recursively even).
+;;;
+(eval-when (compile eval)
+(defmacro editor-input-method-macro (&optional screen-image-trashed-concern)
+  `(handler-bind ((error #'(lambda (condition)
+			     (let ((device (device-hunk-device
+					    (window-hunk (current-window)))))
+			       (funcall (device-exit device) device))
+			     (invoke-debugger condition))))
+;     (when *in-hemlock-stream-input-method*
+;       (error "Entering Hemlock stream input method recursively!"))
+     (let ((*in-hemlock-stream-input-method* t)
+	   (nrw-fun (device-note-read-wait
+		     (device-hunk-device (window-hunk (current-window)))))
+	   key-event)
+       (loop
+	 (when (setf key-event (dq-event stream))
+	   (dolist (f (variable-value 'ed::input-hook)) (funcall f))
+	   (return))
+	 (invoke-scheduled-events)
+	 (unless (system:serve-event 0)
+	   (internal-redisplay)
+	   ,@(if screen-image-trashed-concern
+		 '((when *screen-image-trashed* (internal-redisplay))))
+	   (when nrw-fun (funcall nrw-fun t))
+	   (let ((wait (next-scheduled-event-wait)))
+	     (if wait (system:serve-event wait) (system:serve-event)))))
+       (when nrw-fun (funcall nrw-fun nil))
+       (when (and (abort-key-event-p key-event)
+		  ;; ingore-abort-attempts-p must exist outside the macro.
+		  ;; in this case it is bound in GET-KEY-EVENT.
+		  (not ignore-abort-attempts-p))
+	 (beep)
+	 (throw 'editor-top-level-catcher nil))
+       key-event)))
+) ;eval-when
+
+
+
+;;;; Editor input from windowing system.
+
+(defstruct (windowed-editor-input
+	    (:include editor-input
+		      (:get #'windowed-get-key-event)
+		      (:unget #'windowed-unget-key-event)
+		      (:listen #'windowed-listen)
+		      (:clear #'windowed-clear-input))
+	    (:print-function
+	     (lambda (s stream d)
+	       (declare (ignore s d write))
+	       (write-string "#<Editor-Window-Input stream>" stream)))
+	    (:constructor make-windowed-editor-input
+			  (&optional (head (make-input-event)) (tail head))))
+  hunks)      ; List of bitmap-hunks which input to this stream.
+
+(defun windowed-get-key-event (stream ignore-abort-attempts-p)
+  (editor-input-method-macro))
+
+(defun windowed-unget-key-event (key-event stream)
+  (un-event key-event stream))
+
+(defun windowed-clear-input (stream)
+  (loop (unless (system:serve-event 0) (return)))
+  (without-interrupts
+   (let* ((head (editor-input-head stream))
+	  (next (input-event-next head)))
+     (when next
+       (setf (input-event-next head) nil)
+       (shiftf (input-event-next (editor-input-tail stream))
+	       *free-input-events* next)
+       (setf (editor-input-tail stream) head)))))
+
+(defun windowed-listen (stream)
+  (loop (unless (system:serve-event 0)
+	  ;; If nothing is pending, check the queued input.
+	  (return (not (null (input-event-next (editor-input-head stream))))))
+    (when (input-event-next (editor-input-head stream))
+      ;; Don't service anymore events if we just got some input.
+      (return t))))
+
+
+
+;;;; Editor input from a tty.
+
+(defstruct (tty-editor-input
+	    (:include editor-input
+		      (:get #'tty-get-key-event)
+		      (:unget #'tty-unget-key-event)
+		      (:listen #'tty-listen)
+		      (:clear #'tty-clear-input))
+	    (:print-function
+	     (lambda (obj stream n)
+	       (declare (ignore obj n))
+	       (write-string "#<Editor-Tty-Input stream>" stream)))
+	    (:constructor make-tty-editor-input
+			  (fd &optional (head (make-input-event)) (tail head))))
+  fd)
+
+(defun tty-get-key-event (stream ignore-abort-attempts-p)
+  (editor-input-method-macro t))
+
+(defun tty-unget-key-event (key-event stream)
+  (un-event key-event stream))
+
+(defun tty-clear-input (stream)
+  (without-interrupts
+   (let* ((head (editor-input-head stream))
+	  (next (input-event-next head)))
+     (when next
+       (setf (input-event-next head) nil)
+       (shiftf (input-event-next (editor-input-tail stream))
+	       *free-input-events* next)
+       (setf (editor-input-tail stream) head)))))
+
+(defun tty-listen (stream)
+  (cond ((input-event-next (editor-input-head stream)) t)
+	((editor-tty-listen stream) t)
+	(t nil)))
+
+
+
+;;;; GET-KEY-EVENT, UNGET-KEY-EVENT, LISTEN-EDITOR-INPUT, CLEAR-EDITOR-INPUT.
+
+;;; GET-KEY-EVENT -- Public.
+;;;
+(defun get-key-event (editor-input &optional ignore-abort-attempts-p)
+  "This function returns a key-event as soon as it is available on
+   editor-input.  Editor-input is either *editor-input* or *real-editor-input*.
+   Ignore-abort-attempts-p indicates whether #k\"C-g\" and #k\"C-G\" throw to
+   the editor's top-level command loop; when this is non-nil, this function
+   returns those key-events when the user types them.  Otherwise, it aborts the
+   editor's current state, returning to the command loop."
+  (funcall (editor-input-get editor-input) editor-input ignore-abort-attempts-p))
+
+;;; UNGET-KEY-EVENT -- Public.
+;;;
+(defun unget-key-event (key-event editor-input)
+  "This function returns the key-event to editor-input, so the next invocation
+   of GET-KEY-EVENT will return the key-event.  If the key-event is #k\"C-g\"
+   or #k\"C-G\", then whether GET-KEY-EVENT returns it depends on its second
+   argument.  Editor-input is either *editor-input* or *real-editor-input*."
+  (funcall (editor-input-unget editor-input) key-event editor-input))
+
+;;; CLEAR-EDITOR-INPUT -- Public.
+;;;
+(defun clear-editor-input (editor-input)
+  "This function flushes any pending input on editor-input.  Editor-input
+   is either *editor-input* or *real-editor-input*."
+  (funcall (editor-input-clear editor-input) editor-input))
+
+;;; LISTEN-EDITOR-INPUT -- Public.
+;;;
+(defun listen-editor-input (editor-input)
+  "This function returns whether there is any input available on editor-input.
+   Editor-input is either *editor-input* or *real-editor-input*."
+  (funcall (editor-input-listen editor-input) editor-input))
+
+
+
+;;;; LAST-KEY-EVENT-CURSORPOS and WINDOW-INPUT-HANDLER.
+
+;;; LAST-KEY-EVENT-CURSORPOS  --  Public
+;;;
+;;; Just look up the saved info in the last read key event.
+;;;
+(defun last-key-event-cursorpos ()
+  "Return as values, the (X, Y) character position and window where the
+   last key event happened.  If this cannot be determined, Nil is returned.
+   If in the modeline, return a Y position of NIL and the correct X and window.
+   Returns nil for terminal input."
+  (let* ((ev (editor-input-head *real-editor-input*))
+	 (hunk (input-event-hunk ev))
+	 (window (and hunk (device-hunk-window hunk))))
+    (when window
+      (values (input-event-x ev) (input-event-y ev) window))))
+
+;;; WINDOW-INPUT-HANDLER  --  Internal
+;;;
+;;; This is the input-handler function for hunks that implement windows.  It
+;;; just queues the events on *real-editor-input*.
+;;;
+(defun window-input-handler (hunk char x y)
+  (q-event *real-editor-input* char x y hunk))
+
+
+
+;;;; Random typeout input routines.
+
+(defun wait-for-more (stream)
+  (let ((key-event (more-read-key-event)))
+    (cond ((logical-key-event-p key-event :yes))
+	  ((or (logical-key-event-p key-event :do-all)
+	       (logical-key-event-p key-event :exit))
+	   (setf (random-typeout-stream-no-prompt stream) t)
+	   (random-typeout-cleanup stream))
+	  ((logical-key-event-p key-event :keep)
+	   (setf (random-typeout-stream-no-prompt stream) t)
+	   (maybe-keep-random-typeout-window stream)
+	   (random-typeout-cleanup stream))
+	  ((logical-key-event-p key-event :no)
+	   (random-typeout-cleanup stream)
+	   (throw 'more-punt nil))
+	  (t
+	   (unget-key-event key-event *editor-input*)
+	   (random-typeout-cleanup stream)
+	   (throw 'more-punt nil)))))
+
+(proclaim '(special *more-prompt-action*))
+
+(defun maybe-keep-random-typeout-window (stream)
+  (let* ((window (random-typeout-stream-window stream))
+	 (buffer (window-buffer window))
+	 (start (buffer-start-mark buffer)))
+    (when (typep (hi::device-hunk-device (hi::window-hunk window))
+		 'hi::bitmap-device)
+      (let ((*more-prompt-action* :normal))
+	(update-modeline-field buffer window :more-prompt)
+	(random-typeout-redisplay window))
+      (buffer-start (buffer-point buffer))
+      (unless (make-window start :window (make-xwindow-like-hwindow window))
+	(editor-error "Could not create random typeout window.")))))
+
+(defun end-random-typeout (stream)
+  (let ((*more-prompt-action* :flush)
+	(window (random-typeout-stream-window stream)))
+    (update-modeline-field (window-buffer window) window :more-prompt)
+    (random-typeout-redisplay window))
+  (unless (random-typeout-stream-no-prompt stream)
+    (let* ((key-event (more-read-key-event))
+	   (keep-p (logical-key-event-p key-event :keep)))
+      (when keep-p (maybe-keep-random-typeout-window stream))
+      (random-typeout-cleanup stream)
+      (unless (or (logical-key-event-p key-event :do-all)
+		  (logical-key-event-p key-event :exit)
+		  (logical-key-event-p key-event :no)
+		  (logical-key-event-p key-event :yes)
+		  keep-p)
+	(unget-key-event key-event *editor-input*)))))
+
+;;; MORE-READ-KEY-EVENT -- Internal.
+;;;
+;;; This gets some input from the type of stream bound to *editor-input*.  Need
+;;; to loop over SERVE-EVENT since it returns on any kind of event (not
+;;; necessarily a key or button event).
+;;;
+;;; Currently this does not work for keyboard macro streams!
+;;; 
+(defun more-read-key-event ()
+  (clear-editor-input *editor-input*)
+  (let ((key-event (loop
+		     (let ((key-event (dq-event *editor-input*)))
+		       (when key-event (return key-event))
+		       (system:serve-event)))))
+    (when (abort-key-event-p key-event)
+      (beep)
+      (throw 'editor-top-level-catcher nil))
+    key-event))
diff --git a/hemlock/key-event.lisp b/hemlock/key-event.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..3576754fe692c0987f68916de942a8755e2b02e9
--- /dev/null
+++ b/hemlock/key-event.lisp
@@ -0,0 +1,742 @@
+;;; -*- Log: hemlock.log; Package: extensions -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the Spice Lisp project at
+;;; Carnegie-Mellon University, and has been placed in the public domain.
+;;; Spice Lisp is currently incomplete and under active development.
+;;; If you want to use this code or any part of Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; **********************************************************************
+;;;
+;;; This file implements key-events for representing editor input.  It also
+;;; provides a couple routines to interface this to X11.
+;;;
+;;; Written by Blaine Burks and Bill Chiles.
+;;;
+
+;;; The following are the implementation dependent parts of this code (what
+;;; you would have to change if you weren't using X11):
+;;;    *modifier-translations*
+;;;    DEFINE-CLX-MODIFIER
+;;;    TRANSLATE-KEY-EVENT
+;;;    TRANSLATE-MOUSE-KEY-EVENT
+;;;    DEFINE-KEYSYM
+;;;    DEFINE-MOUSE-KEYSYM
+;;;    DO-ALPHA-KEY-EVENTS
+;;; If the window system didn't use a keysym mechanism to represent keys, you
+;;; would also need to write something that mapped whatever did encode the
+;;; keys to the keysyms defined with DEFINE-KEYSYM.
+;;;
+
+(in-package "EXTENSIONS")
+
+(export '( define-keysym define-mouse-keysym name-keysym keysym-names
+	   keysym-preferred-name define-key-event-modifier define-clx-modifier
+	   make-key-event-bits key-event-modifier-mask key-event-bits-modifiers
+	   *all-modifier-names* translate-key-event translate-mouse-key-event
+	   make-key-event key-event key-event-p key-event-bits key-event-keysym
+	   char-key-event key-event-char key-event-bit-p do-alpha-key-events
+	   print-pretty-key print-pretty-key-event))
+
+
+
+;;;; Keysym <==> Name translation.
+
+;;; Keysyms are named by case-insensitive names.  However, if the name
+;;; consists of a single character, the name is case-sensitive.
+;;;
+
+;;; This table maps a keysym to a list of names.  The first name is the
+;;; preferred printing name.
+;;;
+(defvar *keysyms-to-names* (make-hash-table :test #'eql))
+ 
+;;; This table maps all keysym names to the appropriate keysym.
+;;;
+(defvar *names-to-keysyms* (make-hash-table :test #'equal))
+
+(proclaim '(inline name-keysym keysym-names keysym-preferred-name))
+
+(defun name-keysym (name)
+  "This returns the keysym named name.  If name is unknown, this returns nil."
+  (gethash (get-name-case-right name) *names-to-keysyms*))
+
+(defun keysym-names (keysym)
+  "This returns the list of all names for keysym.  If keysym is undefined,
+   this returns nil."
+  (gethash keysym *keysyms-to-names*))
+
+(defun keysym-preferred-name (keysym)
+  "This returns the preferred name for keysym, how it is typically printed.
+   If keysym is undefined, this returns nil."
+  (car (gethash keysym *keysyms-to-names*)))
+
+
+
+;;;; Character key-event stuff.
+
+;;; GET-NAME-CASE-RIGHT -- Internal.
+;;;
+;;; This returns the canonical string for a keysym name for use with
+;;; hash tables.
+;;;
+(defun get-name-case-right (string)
+  (if (= (length string) 1) string (string-downcase string)))
+
+;;; DEFINE-KEYSYM -- Public.
+;;;
+(defun define-keysym (keysym preferred-name &rest other-names)
+  "This establishes a mapping from preferred-name to keysym for purposes of
+   specifying key-events in #k syntax.  Other-names also map to keysym, but the
+   system uses preferred-name when printing key-events.  The names are
+   case-insensitive simple-strings.  Redefining a keysym or re-using names has
+   undefined effects."
+  (setf (gethash keysym *keysyms-to-names*) (cons preferred-name other-names))
+  (dolist (name (cons preferred-name other-names))
+    (setf (gethash (get-name-case-right name) *names-to-keysyms*) keysym)))
+
+;;; This is an a-list mapping CLX modifier masks to defined key-event
+;;; modifier names.  DEFINE-CLX-MODIFIER fills this in, so TRANSLATE-KEY-EVENT
+;;; and TRANSLATE-MOUSE-KEY-EVENT can work.
+;;;
+(defvar *modifier-translations* ())
+
+;;; This is an ordered a-list mapping defined key-event modifier names to the
+;;; appropriate mask for the modifier.  Modifier names have a short and a long
+;;; version.  For each pair of names for the same mask, the names are
+;;; contiguous in this list, and the short name appears first.
+;;; PRINT-PRETTY-KEY-EVENT and KEY-EVENT-BITS-MODIFIERS rely on this.
+;;;
+(defvar *modifiers-to-internal-masks* ())
+
+;;; TRANSLATE-KEY-EVENT -- Public.
+;;;
+(defun translate-key-event (display scan-code bits)
+  "Translates the X scan-code and X bits to a key-event.  First this maps
+   scan-code to an X keysym using XLIB:KEYCODE->KEYSYM looking at bits and
+   supplying index as 1 if the X shift bit is on, 0 otherwise.
+
+   If the resulting keysym is undefined, and it is not a modifier keysym, then
+   this signals an error.  If the keysym is a modifier key, then this returns
+   nil.
+
+   If the following conditions are satisfied
+      the keysym is defined
+      the X shift bit is off
+      the X lock bit is on
+      the X keysym represents a lowercase letter
+   then this maps the scan-code again supplying index as 1 this time, treating
+   the X lock bit as a caps-lock bit.  If this results in an undefined keysym,
+   this signals an error.  Otherwise, this makes a key-event with the keysym
+   and bits formed by mapping the X bits to key-event bits.
+
+   Otherwise, this makes a key-event with the keysym and bits formed by mapping
+   the X bits to key-event bits."
+  (let ((new-bits 0)
+	shiftp lockp)
+    (dolist (map *modifier-translations*)
+      (unless (zerop (logand (car map) bits))
+	(cond
+	 ((string-equal (cdr map) "Shift")
+	  (setf shiftp t))
+	 ((string-equal (cdr map) "Lock")
+	  (setf lockp t))
+	 (t (setf new-bits
+		  (logior new-bits (key-event-modifier-mask (cdr map))))))))
+    (let ((keysym (xlib:keycode->keysym display scan-code (if shiftp 1 0))))
+      (cond ((null (keysym-names keysym))
+	     (if (<= 65505 keysym 65518) ;modifier keys.
+		 nil
+		 (error "Undefined keysym ~S, describe EXT:DEFINE-KEYSYM."
+			keysym)))
+	    ((and (not shiftp) lockp (<= 97 keysym 122)) ; small-alpha-char-p
+	     (let ((keysym (xlib:keycode->keysym display scan-code 1)))
+	       (unless (keysym-names keysym)
+		 (error "Undefined keysym ~S, describe EXT:DEFINE-KEYSYM."
+			keysym))
+	       (make-key-event keysym new-bits)))
+	    (t
+	     (make-key-event keysym new-bits))))))
+
+
+
+;;;; Mouse key-event stuff.
+
+;;; Think of this data as a three dimensional array indexed by the following
+;;; domains:
+;;;    1-5
+;;;       for the mouse scan-codes (button numbers) delivered by X.
+;;;    :button-press or :button-release
+;;;       whether the button was pressed or released.
+;;;    :keysym or :shifted-modifier-name
+;;;       whether the X shift bit was set.
+;;; For each button, pressed and released, we store a keysym to be used in a
+;;; key-event representing the button and whether it was pressed or released.
+;;; We also store a modifier name that TRANSLATE-MOUSE-KEY-EVENT turns on
+;;; whenever a mouse event occurs with the X shift bit on.  This is basically
+;;; an archaic feature since we now can specify key-events like the following:
+;;;    #k"shift-leftdown"
+;;; Previously we couldn't, so we mapped the shift bit to a bit we could
+;;; talke about, such as super.
+;;;
+(defvar *mouse-translation-info* (make-array 6 :initial-element nil))
+
+(eval-when (compile eval)
+  (defmacro button-press-info (event-dispatch) `(car ,event-dispatch))
+  (defmacro button-release-info (event-dispatch) `(cdr ,event-dispatch))
+  (defmacro button-keysym (info) `(car ,info))
+  (defmacro button-shifted-modifier-name (info) `(cdr ,info))
+) ;eval-when
+
+;;; MOUSE-TRANSLATION-INFO -- Internal.
+;;;
+;;; This returns the requested information, :keysym or :shifted-modifier-name,
+;;; for the button cross event-key.  If the information is undefined, this
+;;; signals an error.
+;;;
+(defun mouse-translation-info (button event-key info)
+  (let ((event-dispatch (svref *mouse-translation-info* button)))
+    (unless event-dispatch
+      (error "No defined mouse translation information for button ~S." button))
+    (let ((data (ecase event-key
+		  (:button-press (button-press-info event-dispatch))
+		  (:button-release (button-release-info event-dispatch)))))
+      (unless data
+	(error
+	 "No defined mouse translation information for button ~S and event ~S."
+	 button event-key))
+      (ecase info
+	(:keysym (button-keysym data))
+	(:shifted-modifier-name (button-shifted-modifier-name data))))))
+
+;;; %SET-MOUSE-TRANSLATION-INFO -- Internal.
+;;;
+;;; This walks into *mouse-translation-info* the same way MOUSE-TRANSLATION-INFO
+;;; does, filling in the data structure on an as-needed basis, and stores
+;;; the value for the indicated info.
+;;;
+(defun %set-mouse-translation-info (button event-key info value)
+  (let ((event-dispatch (svref *mouse-translation-info* button)))
+    (unless event-dispatch
+      (setf event-dispatch
+	    (setf (svref *mouse-translation-info* button) (cons nil nil))))
+    (let ((data (ecase event-key
+		  (:button-press (button-press-info event-dispatch))
+		  (:button-release (button-release-info event-dispatch)))))
+      (unless data
+	(setf data
+	      (ecase event-key
+		(:button-press
+		 (setf (button-press-info event-dispatch) (cons nil nil)))
+		(:button-release
+		 (setf (button-release-info event-dispatch) (cons nil nil))))))
+      (ecase info
+	(:keysym
+	 (setf (button-keysym data) value))
+	(:shifted-modifier-name
+	 (setf (button-shifted-modifier-name data) value))))))
+;;;
+(defsetf mouse-translation-info %set-mouse-translation-info)
+
+;;; DEFINE-MOUSE-KEYSYM -- Public.
+;;;
+(defun define-mouse-keysym (button keysym name shifted-bit event-key)
+  "This defines keysym named name for the X button cross the X event-key.
+   Shifted-bit is a defined modifier name that TRANSLATE-MOUSE-KEY-EVENT sets
+   in the key-event it returns whenever the X shift bit is on."
+  (unless (<= 1 button 5)
+    (error "Buttons are number 1-5, not ~D." button))
+  (setf (gethash keysym *keysyms-to-names*) (list name))
+  (setf (gethash  (get-name-case-right name) *names-to-keysyms*) keysym)
+  (setf (mouse-translation-info button event-key :keysym) keysym)
+  (setf (mouse-translation-info button event-key :shifted-modifier-name)
+	shifted-bit))
+
+;;; TRANSLATE-MOUSE-KEY-EVENT -- Public.
+;;;
+(defun translate-mouse-key-event (scan-code bits event-key)
+  "This translates the X button code, scan-code, and modifier bits, bits, for
+   the X event-key into a key-event.  See DEFINE-MOUSE-KEYSYM."
+  (let ((keysym (mouse-translation-info scan-code event-key :keysym))
+	(new-bits 0))
+    (dolist (map *modifier-translations*)
+      (when (logtest (car map) bits)
+	(setf new-bits
+	      (if (string-equal (cdr map) "Shift")
+		  (logior new-bits
+			  (key-event-modifier-mask
+			   (mouse-translation-info
+			    scan-code event-key :shifted-modifier-name)))
+		  (logior new-bits
+			  (key-event-modifier-mask (cdr map)))))))
+    (make-key-event keysym new-bits)))
+
+
+
+;;;; Stuff for parsing #k syntax.
+
+(defstruct (key-event (:print-function %print-key-event)
+		      (:constructor %make-key-event (keysym bits)))
+  (bits :type fixnum)
+  (keysym :type :fixnum))
+
+(defun %print-key-event (object stream ignore)
+  (declare (ignore ignore))
+  (write-string "#<Key-Event " stream)
+  (print-pretty-key-event object stream)
+  (write-char #\> stream))
+
+;;; This maps Common Lisp CHAR-CODE's to character classes for parsing #k
+;;; syntax.
+;;;
+(defvar *key-character-classes* (make-array char-code-limit
+					    :initial-element :other))
+
+;;; These characters are special:
+;;;    #\<  ..........  :ISO-start - Signals start of an ISO character.
+;;;    #\>  ..........  :ISO-end - Signals end of an ISO character.
+;;;    #\-  ..........  :modifier-terminator - Indicates last *id-namestring*
+;;;                                            was a modifier.
+;;;    #\"  ..........  :EOF - Means we have come to the end of the character.
+;;;    #\{a-z, A-Z} ..  :letter - Means the char is a letter.
+;;;    #\space .......  :event-terminator- Indicates the last *id-namestring*
+;;;                                        was a character name.
+;;;
+;;; Every other character has class :other.
+;;;
+(hi::do-alpha-chars (char :both)
+  (setf (svref *key-character-classes* (char-code char)) :letter))
+(setf (svref *key-character-classes* (char-code #\<)) :ISO-start)
+(setf (svref *key-character-classes* (char-code #\>)) :ISO-end)
+(setf (svref *key-character-classes* (char-code #\-)) :modifier-terminator)
+(setf (svref *key-character-classes* (char-code #\space)) :event-terminator)
+(setf (svref *key-character-classes* (char-code #\")) :EOF)
+  
+;;; This holds the characters built up while lexing a potential keysym or
+;;; modifier identifier.
+;;;
+(defvar *id-namestring*
+  (make-array 30 :adjustable t :fill-pointer 0 :element-type 'string-char))
+
+;;; PARSE-KEY-FUN -- Internal.
+;;;
+;;; This is the #k dispatch macro character reader.  It is a FSM that parses
+;;; key specifications.  It returns either a VECTOR form or a MAKE-KEY-EVENT
+;;; form.  Since key-events are unique at runtime, we cannot create them at
+;;; readtime, returning the constant object from READ.  Wherever a #k appears,
+;;; there's a for that at loadtime or runtime will return the unique key-event
+;;; or vector of unique key-events.
+;;;
+(defun parse-key-fun (stream sub-char count)
+  (declare (ignore sub-char count))
+  (setf (fill-pointer *id-namestring*) 0)
+  (prog ((bits 0)
+	 (key-event-list ())
+	 char class)
+	(unless (char= (read-char stream) #\")
+	  (error "Keys must be delimited by ~S." #\"))
+	;; Skip any leading spaces in the string.
+	(skip-whitespace stream)
+	(multiple-value-setq (char class) (get-key-char stream))
+	(ecase class
+	  ((:letter :other :escaped) (go ID))
+	  (:ISO-start (go ISOCHAR))
+	  (:ISO-end (error "Angle brackets must be escaped."))
+	  (:modifier-terminator (error "Dash must be escaped."))
+	  (:EOF (error "No key to read.")))
+	ID
+	(vector-push-extend char *id-namestring*)
+	(multiple-value-setq (char class) (get-key-char stream))
+	(ecase class
+	  ((:letter :other :escaped) (go ID))
+	  (:event-terminator (go GOT-CHAR))
+	  (:modifier-terminator (go GOT-MODIFIER))
+	  ((:ISO-start :ISO-end) (error "Angle brackets must be escaped."))
+	  (:EOF (go GET-LAST-CHAR)))
+	GOT-CHAR
+	(push `(make-key-event ,(copy-seq *id-namestring*) ,bits)
+	      key-event-list)
+	(setf (fill-pointer *id-namestring*) 0)
+	(setf bits 0)
+	;; Skip any whitespace between characters.
+	(skip-whitespace stream)
+	(multiple-value-setq (char class) (get-key-char stream))
+	(ecase class
+	  ((:letter :other :escaped) (go ID))
+	  (:ISO-start (go ISOCHAR))
+	  (:ISO-end (error "Angle brackets must be escaped."))
+	  (:modifier-terminator (error "Dash must be escaped."))
+	  (:EOF (go FINAL)))
+	GOT-MODIFIER
+	(let ((modifier-name (car (assoc *id-namestring*
+					 *modifiers-to-internal-masks*
+					 :test #'string-equal))))
+	  (unless modifier-name
+	    (error "~S is not a defined modifier." *id-namestring*))
+	  (setf (fill-pointer *id-namestring*) 0)
+	  (setf bits (logior bits (key-event-modifier-mask modifier-name))))
+	(multiple-value-setq (char class) (get-key-char stream))
+	(ecase class
+	  ((:letter :other :escaped) (go ID))
+	  (:ISO-start (go ISOCHAR))
+	  (:ISO-end (error "Angle brackets must be escaped."))
+	  (:modifier-terminator (error "Dash must be escaped."))
+	  (:EOF (error "Expected something naming a key-event, got EOF.")))
+	ISOCHAR
+	(multiple-value-setq (char class) (get-key-char stream))
+	(ecase class
+	  ((:letter :event-terminator :other :escaped)
+	   (vector-push-extend char *id-namestring*)
+	   (go ISOCHAR))
+	  (:ISO-start (error "Open Angle must be escaped."))
+	  (:modifier-terminator (error "Dash must be escaped."))
+	  (:EOF (error "Bad syntax in key specification, hit eof."))
+	  (:ISO-end (go GOT-CHAR)))
+	GET-LAST-CHAR
+	(push `(make-key-event ,(copy-seq *id-namestring*) ,bits)
+	      key-event-list)
+	FINAL
+	(return (if (cdr key-event-list)
+		    `(vector ,@(nreverse key-event-list))
+		    `,(car key-event-list)))))
+
+(set-dispatch-macro-character #\# #\k #'parse-key-fun)
+
+(defconstant key-event-escape-char #\\
+  "The escape character that #k uses.")
+
+;;; GET-KEY-CHAR -- Internal.
+;;;
+;;; This is used by PARSE-KEY-FUN.
+;;;
+(defun get-key-char (stream)
+  (let ((char (read-char stream t nil t)))
+    (cond ((char= char key-event-escape-char)
+	   (let ((char (read-char stream t nil t)))
+	     (values char :escaped)))
+	  (t (values char (svref *key-character-classes* (char-code char)))))))
+
+
+
+;;;; Code to deal with modifiers.
+
+(defvar *modifier-count* 0
+  "The number of modifiers that is currently defined.")
+
+(defconstant modifier-count-limit 6
+  "The maximum number of modifiers supported.")
+
+;;; This is purely a list for users.
+;;;
+(defvar *all-modifier-names* ()
+  "A list of all the names of defined modifiers.")
+
+;;; DEFINE-KEY-EVENT-MODIFIER -- Public.
+;;;
+;;; Note that short-name is pushed into *modifiers-to-internal-masks* after
+;;; long-name.  PRINT-PRETTY-KEY-EVENT and KEY-EVENT-BITS-MODIFIERS rely on
+;;; this feature.
+;;;
+(defun define-key-event-modifier (long-name short-name)
+  "This establishes long-name and short-name as modifier names for purposes
+   of specifying key-events in #k syntax.  The names are case-insensitive and
+   must be strings.  If either name is already defined, this signals an error."
+  (when (= *modifier-count* modifier-count-limit)
+    (error "Maximum of ~D modifiers allowed." modifier-count-limit))
+  (let ((long-name (string-capitalize long-name))
+	(short-name (string-capitalize short-name)))
+    (flet ((frob (name)
+	     (when (assoc name *modifiers-to-internal-masks*
+			  :test #'string-equal)
+	       (restart-case
+		   (error "Modifier name has already been defined -- ~S" name)
+		 (blow-it-off ()
+		  :report "Go on without defining this modifier."
+		  (return-from define-key-event-modifier nil))))))
+      (frob long-name)
+      (frob short-name))
+    (unwind-protect
+	(let ((new-bits (ash 1 *modifier-count*)))
+	  (push (cons long-name new-bits) *modifiers-to-internal-masks*)
+	  (push (cons short-name new-bits) *modifiers-to-internal-masks*)
+	  (pushnew long-name *all-modifier-names* :test #'string-equal)
+	  ;; Sometimes the long-name is the same as the short-name.
+	  (pushnew short-name *all-modifier-names* :test #'string-equal))
+      (incf *modifier-count*))))
+
+;;;
+;;; RE-INITIALIZE-KEY-EVENTS at the end of this file defines the system
+;;; default key-event modifiers.
+;;; 
+
+;;; DEFINE-CLX-MODIFIER -- Public.
+;;;
+(defun define-clx-modifier (clx-mask modifier-name)
+  "This establishes a mapping from clx-mask to a define key-event modifier-name.
+   TRANSLATE-KEY-EVENT and TRANSLATE-MOUSE-KEY-EVENT can only return key-events
+   with bits defined by this routine."
+  (let ((map (assoc modifier-name *modifiers-to-internal-masks*
+		    :test #'string-equal)))
+    (unless map (error "~S an undefined modifier name." modifier-name))
+    (push (cons clx-mask (car map)) *modifier-translations*)))
+
+;;;
+;;; RE-INITIALIZE-KEY-EVENTS at the end of this file defines the system
+;;; default clx modifiers, mapping them to some system default key-event
+;;; modifiers.
+;;; 
+
+;;; MAKE-KEY-EVENT-BITS -- Public.
+;;;
+(defun make-key-event-bits (&rest modifier-names)
+  "This returns bits suitable for MAKE-KEY-EVENT from the supplied modifier
+   names.  If any name is undefined, this signals an error."
+  (let ((mask 0))
+    (dolist (mod modifier-names mask)
+      (let ((this-mask (cdr (assoc mod *modifiers-to-internal-masks*
+				   :test #'string-equal))))
+	(unless this-mask (error "~S is an undefined modifier name." mod))
+	(setf mask (logior mask this-mask))))))
+
+;;; KEY-EVENT-BITS-MODIFIERS -- Public.
+;;;
+(defun key-event-bits-modifiers (bits)
+  "This returns a list of key-event modifier names, one for each modifier
+   set in bits."
+  (let ((res nil))
+    (do ((map (cdr *modifiers-to-internal-masks*) (cddr map)))
+	((null map) res)
+      (when (logtest bits (cdar map))
+	(push (caar map) res)))))
+
+;;; KEY-EVENT-MODIFIER-MASK -- Public.
+;;;
+(defun key-event-modifier-mask (modifier-name)
+  "This function returns a mask for modifier-name.  This mask is suitable
+   for use with KEY-EVENT-BITS.  If modifier-name is undefined, this signals
+   an error."
+  (let ((res (cdr (assoc modifier-name *modifiers-to-internal-masks*
+			 :test #'string-equal))))
+    (unless res (error "Undefined key-event modifier -- ~S." modifier-name))
+    res))
+
+
+
+;;;; Key event lookup -- GET-KEY-EVENT and MAKE-KEY-EVENT.
+
+(defvar *keysym-high-bytes* (make-array 256 :initial-element nil))
+
+(defconstant modifier-bits-limit (ash 1 modifier-count-limit))
+
+;;; GET-KEY-EVENT -- Internal.
+;;;
+;;; This finds the key-event specified by keysym and bits.  If the key-event
+;;; does not already exist, this creates it.  This assumes keysym is defined,
+;;; and if it isn't, this will make a key-event anyway that will cause an
+;;; error when the system tries to print it.
+;;;
+(defun get-key-event (keysym bits)
+  (let* ((high-byte (ash keysym -8))
+	 (low-byte-vector (svref *keysym-high-bytes* high-byte)))
+    (unless low-byte-vector
+      (let ((new-vector (make-array 256)))
+	(setf (svref *keysym-high-bytes* high-byte) new-vector)
+	(setf low-byte-vector new-vector)))
+    (let* ((low-byte (ldb (byte 8 0) keysym))
+	   (bit-vector (svref low-byte-vector low-byte)))
+      (unless bit-vector
+	(let ((new-vector (make-array modifier-bits-limit)))
+	  (setf (svref low-byte-vector low-byte) new-vector)
+	  (setf bit-vector new-vector)))
+      (let ((key-event (svref bit-vector bits)))
+	(if key-event
+	    key-event
+	    (setf (svref bit-vector bits) (%make-key-event keysym bits)))))))
+
+;;; MAKE-KEY-EVENT --  Public.
+;;;
+(defun make-key-event (object &optional (bits 0))
+  "This returns a key-event described by object with bits.  Object is one of
+   keysym, string, or key-event.  When object is a key-event, this uses
+   KEY-EVENT-KEYSYM.  You can form bits with MAKE-KEY-EVENT-BITS or
+   KEY-EVENT-MODIFIER-MASK."
+  (etypecase object
+    (integer
+     (unless (keysym-names object)
+       (error "~S is an undefined keysym." object))
+     (get-key-event object bits))
+    #|(character
+     (let* ((name (char-name object))
+	    (keysym (name-keysym (or name (string object)))))
+       (unless keysym
+	 (error "~S is an undefined keysym." object))
+       (get-key-event keysym bits)))|#
+    (string
+     (let ((keysym (name-keysym object)))
+       (unless keysym
+	 (error "~S is an undefined keysym." object))
+       (get-key-event keysym bits)))
+    (key-event
+     (get-key-event (key-event-keysym object) bits))))
+
+;;; KEY-EVENT-BIT-P -- Public.
+;;;
+(defun key-event-bit-p (key-event bit-name)
+  "This returns whether key-event has the bit set named by bit-name.  This
+   signals an error if bit-name is undefined."
+  (let ((mask (cdr (assoc bit-name *modifiers-to-internal-masks*
+			  :test #'string-equal))))
+    (unless mask
+      (error "~S is not a defined modifier." bit-name))
+    (not (zerop (logand (key-event-bits key-event) mask)))))
+
+
+
+;;;; KEY-EVENT-CHAR and CHAR-KEY-EVENT.
+
+;;; This maps key-events to characters.  Users modify this by SETF'ing
+;;; KEY-EVENT-CHAR.
+;;;
+(defvar *key-event-characters* (make-hash-table))
+
+(defun key-event-char (key-event)
+  "Returns the character associated with key-event. This is SETF'able."
+  (check-type key-event key-event)
+  (gethash key-event *key-event-characters*))
+
+(defun %set-key-event-char (key-event character)
+  (check-type character character)
+  (check-type key-event key-event)
+  (setf (gethash key-event *key-event-characters*) character))
+;;;
+(defsetf key-event-char %set-key-event-char)
+
+
+;;; This maps characters to key-events.  Users modify this by SETF'ing
+;;; CHAR-KEY-EVENT.
+;;;
+(defvar *character-key-events*
+  (make-array char-code-limit :initial-element nil))
+
+(defun char-key-event (char)
+  "Returns the key-event associated with char.  This is SETF'able."
+  (check-type char character)
+  (svref *character-key-events* (char-code char)))
+
+(defun %set-char-key-event (char key-event)
+  (check-type char character)
+  (check-type key-event key-event)
+  (setf (svref *character-key-events* (char-code char)) key-event))
+;;;
+(defsetf char-key-event %set-char-key-event)
+
+
+
+;;;; DO-ALPHA-KEY-EVENTS.
+
+(defmacro alpha-key-events-loop (var start-keysym end-keysym result body)
+  (let ((n (gensym)))
+    `(do ((,n ,start-keysym (1+ ,n)))
+	 ((> ,n ,end-keysym) ,result)
+       (let ((,var (make-key-event ,n 0)))
+	 (when (alpha-char-p (key-event-char ,var))
+	   ,@body)))))
+
+(defmacro do-alpha-key-events ((var kind &optional result) &rest forms)
+  "(DO-ALPHA-CHARS (var kind [result]) {form}*)
+   This macro evaluates each form with var bound to a key-event representing an
+   alphabetic character.  Kind is one of :lower, :upper, or :both, and this
+   binds var to each key-event in order as specified in the X11 protocol
+   specification.  When :both is specified, this processes lowercase letters
+   first."
+  (case kind
+    (:both
+     `(progn (alpha-key-events-loop ,var 97 122 nil ,forms)
+	     (alpha-key-events-loop ,var 65 90 ,result ,forms)))
+    (:lower
+     `(alpha-key-events-loop ,var 97 122 ,result ,forms))
+    (:upper
+     `(alpha-key-events-loop ,var 65 90 ,result ,forms))
+    (t (error "Kind argument not one of :lower, :upper, or :both -- ~S."
+	      kind))))
+
+
+
+;;;; PRINT-PRETTY-KEY and PRINT-PRETTY-KEY-EVENT.
+
+;;; PRINT-PRETTY-KEY -- Public.
+;;;
+(defun print-pretty-key (key &optional (stream *standard-output*) long-names-p)
+  "This prints key, a key-event or vector of key-events, to stream in a
+   user-expected fashion.  Long-names-p indicates whether modifiers should
+   print with their long or short name."
+  (etypecase key
+    (structure (print-pretty-key-event key stream long-names-p))
+    (vector
+     (let ((length-1 (1- (length key))))
+       (dotimes (i (length key))
+	 (let ((key-event (aref key i)))
+	   (print-pretty-key-event key-event stream long-names-p)
+	   (unless (= i length-1) (write-char #\space stream))))))))
+
+;;; PRINT-PRETTY-KEY-EVENT -- Public.
+;;;
+;;; Note, this makes use of the ordering in the a-list
+;;; *modifiers-to-internal-masks* by CDDR'ing down it by starting on a short
+;;; name or a long name.
+;;;
+(defun print-pretty-key-event (key-event &optional (stream *standard-output*)
+					 long-names-p)
+  "This prints key-event to stream.  Long-names-p indicates whether modifier
+   names should appear using the long name or short name."
+  (do ((map (if long-names-p
+		(cdr *modifiers-to-internal-masks*)
+		*modifiers-to-internal-masks*)
+	    (cddr map)))
+      ((null map))
+    (when (not (zerop (logand (cdar map) (key-event-bits key-event))))
+      (write-string (caar map) stream)
+      (write-char #\- stream)))
+  (let* ((name (keysym-preferred-name (key-event-keysym key-event)))
+	 (spacep (position #\space (the simple-string name))))
+    (when spacep (write-char #\< stream))
+    (write-string name stream)
+    (when spacep (write-char #\> stream))))
+
+
+
+;;;; Re-initialization.
+
+;;; RE-INITIALIZE-KEY-EVENTS -- Internal.
+;;;
+(defun re-initialize-key-events ()
+  "This blows away all data associated with keysyms, modifiers, mouse
+   translations, and key-event/characters mapping.  Then it re-establishes
+   the system defined key-event modifiers and the system defined CLX
+   modifier mappings to some of those key-event modifiers.
+
+   When recompiling this file, you should load it and call this function
+   before using any part of the key-event interface, especially before
+   defining all your keysyms and using #k syntax."
+  (setf *keysyms-to-names* (make-hash-table :test #'eql))
+  (setf *names-to-keysyms* (make-hash-table :test #'equal))
+  (setf *modifier-translations* ())
+  (setf *modifiers-to-internal-masks* ())
+  (setf *mouse-translation-info* (make-array 6 :initial-element nil))
+  (setf *modifier-count* 0)
+  (setf *all-modifier-names* ())
+  (setf *keysym-high-bytes* (make-array 256 :initial-element nil))
+  (setf *key-event-characters* (make-hash-table))
+  (setf *character-key-events* (make-array char-code-limit :initial-element nil))
+  
+  (define-key-event-modifier "Hyper" "H")
+  (define-key-event-modifier "Super" "S")
+  (define-key-event-modifier "Meta" "M")
+  (define-key-event-modifier "Control" "C")
+  (define-key-event-modifier "Shift" "Shift")
+  (define-key-event-modifier "Lock" "Lock")
+  
+  (define-clx-modifier (xlib:make-state-mask :shift) "Shift")
+  (define-clx-modifier (xlib:make-state-mask :mod-1) "Meta")
+  (define-clx-modifier (xlib:make-state-mask :control) "Control")
+  (define-clx-modifier (xlib:make-state-mask :lock) "Lock"))
diff --git a/hemlock/keysym-defs.lisp b/hemlock/keysym-defs.lisp
new file mode 100644
index 0000000000000000000000000000000000000000..74ee51ae81b8d57c4ad877d43343aa877db25007
--- /dev/null
+++ b/hemlock/keysym-defs.lisp
@@ -0,0 +1,248 @@
+;;; -*- Log: hemlock.log; Mode: Lisp; Package: Hemlock-Internals -*-
+;;;
+;;; **********************************************************************
+;;; This code was written as part of the Spice Lisp project at
+;;; Carnegie-Mellon University, and has been placed in the public domain.
+;;; Spice Lisp is currently incomplete and under active development.
+;;; If you want to use this code or any part of Spice Lisp, please contact
+;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; **********************************************************************
+;;;
+;;; This file defines all the definitions of keysyms (see key-event.lisp).
+;;; These keysyms match those for X11.
+;;;
+;;; Written by Bill Chiles
+;;; Modified by Blaine Burks.
+;;;
+
+(in-package "HEMLOCK-INTERNALS")
+
+
+;;; The IBM RT keyboard has X11 keysyms defined for the following modifier
+;;; keys, but we leave them mapped to nil indicating that they are non-events
+;;; to be ignored:
+;;;    ctrl		65507
+;;;    meta (left)	65513
+;;;    meta (right)	65514
+;;;    shift (left)	65505
+;;;    shift (right)	65506
+;;;    lock		65509
+;;;
+
+
+;;; Function keys for the RT.
+;;;
+(ext:define-keysym 65470 "F1")
+(ext:define-keysym 65471 "F2")
+(ext:define-keysym 65472 "F3")
+(ext:define-keysym 65473 "F4")
+(ext:define-keysym 65474 "F5")
+(ext:define-keysym 65475 "F6")
+(ext:define-keysym 65476 "F7")
+(ext:define-keysym 65477 "F8")
+(ext:define-keysym 65478 "F9")
+(ext:define-keysym 65479 "F10")
+(ext:define-keysym 65480 "F11" "L1")
+(ext:define-keysym 65481 "F12" "L2")
+
+;;; Function keys for the Sun (and other keyboards) -- L1-L10 and R1-R15.
+;;;
+(ext:define-keysym 65482 "F13" "L3")
+(ext:define-keysym 65483 "F14" "L4")
+(ext:define-keysym 65484 "F15" "L5")
+(ext:define-keysym 65485 "F16" "L6")
+(ext:define-keysym 65486 "F17" "L7")
+(ext:define-keysym 65487 "F18" "L8")
+(ext:define-keysym 65488 "F19" "L9")
+(ext:define-keysym 65489 "F20" "L10")
+(ext:define-keysym 65490 "F21" "R1")
+(ext:define-keysym 65491 "F22" "R2")
+(ext:define-keysym 65492 "F23" "R3")
+(ext:define-keysym 65493 "F24" "R4")
+(ext:define-keysym 65494 "F25" "R5")
+(ext:define-keysym 65495 "F26" "R6")
+(ext:define-keysym 65496 "F27" "R7")
+(ext:define-keysym 65497 "F28" "R8")
+(ext:define-keysym 65498 "F29" "R9")
+(ext:define-keysym 65499 "F30" "R10")
+(ext:define-keysym 65500 "F31" "R11")
+(ext:define-keysym 65501 "F32" "R12")
+(ext:define-keysym 65502 "F33" "R13")
+(ext:define-keysym 65503 "F34" "R14")
+(ext:define-keysym 65504 "F35" "R15")
+
+;;; Upper right key bank.
+;;;
+(ext:define-keysym 65377 "Printscreen")
+;; Couldn't type scroll lock.
+(ext:define-keysym 65299 "Pause")
+
+;;; Middle right key bank.
+;;;
+(ext:define-keysym 65379 "Insert")
+(ext:define-keysym 65535 "Delete" "Rubout" (string (code-char 127)))
+(ext:define-keysym 65360 "Home")
+(ext:define-keysym 65365 "Pageup")
+(ext:define-keysym 65367 "End")
+(ext:define-keysym 65366 "Pagedown")
+
+;;; Arrows.
+;;;
+(ext:define-keysym 65361 "Leftarrow")
+(ext:define-keysym 65362 "Uparrow")
+(ext:define-keysym 65364 "Downarrow")
+(ext:define-keysym 65363 "Rightarrow")
+
+;;; Number pad.
+;;;
+(ext:define-keysym 65407 "Numlock")
+(ext:define-keysym 65421 "Numpad\-Return" "Numpad\-Enter")	;num-pad-enter
+(ext:define-keysym 65455 "Numpad/") 				;num-pad-/
+(ext:define-keysym 65450 "Numpad*")				;num-pad-*
+(ext:define-keysym 65453 "Numpad-")				;num-pad--
+(ext:define-keysym 65451 "Numpad+")				;num-pad-+
+(ext:define-keysym 65456 "Numpad0")				;num-pad-0
+(ext:define-keysym 65457 "Numpad1")				;num-pad-1
+(ext:define-keysym 65458 "Numpad2")				;num-pad-2
+(ext:define-keysym 65459 "Numpad3")				;num-pad-3
+(ext:define-keysym 65460 "Numpad4")				;num-pad-4
+(ext:define-keysym 65461 "Numpad5")				;num-pad-5
+(ext:define-keysym 65462 "Numpad6")				;num-pad-6
+(ext:define-keysym 65463 "Numpad7")				;num-pad-7
+(ext:define-keysym 65464 "Numpad8")				;num-pad-8
+(ext:define-keysym 65465 "Numpad9")				;num-pad-9
+(ext:define-keysym 65454 "Numpad.")				;num-pad-.
+
+;;; "Named" keys.
+;;;
+(ext:define-keysym 65289 "Tab")
+(ext:define-keysym 65307 "Escape" "Altmode" "Alt")		;escape
+(ext:define-keysym 65288 "Backspace")				;backspace
+(ext:define-keysym 65293 "Return" "Enter")			;enter
+(ext:define-keysym 65512 "Linefeed" "Action" "Newline")		;action
+(ext:define-keysym 32 "Space" " ")
+
+;;; Letters.
+;;;
+(ext:define-keysym 97 "a") (ext:define-keysym 65 "A")
+(ext:define-keysym 98 "b") (ext:define-keysym 66 "B")
+(ext:define-keysym 99 "c") (ext:define-keysym 67 "C")
+(ext:define-keysym 100 "d") (ext:define-keysym 68 "D")
+(ext:define-keysym 101 "e") (ext:define-keysym 69 "E")
+(ext:define-keysym 102 "f") (ext:define-keysym 70 "F")
+(ext:define-keysym 103 "g") (ext:define-keysym 71 "G")
+(ext:define-keysym 104 "h") (ext:define-keysym 72 "H")
+(ext:define-keysym 105 "i") (ext:define-keysym 73 "I")
+(ext:define-keysym 106 "j") (ext:define-keysym 74 "J")
+(ext:define-keysym 107 "k") (ext:define-keysym 75 "K")
+(ext:define-keysym 108 "l") (ext:define-keysym 76 "L")
+(ext:define-keysym 109 "m") (ext:define-keysym 77 "M")
+(ext:define-keysym 110 "n") (ext:define-keysym 78 "N")
+(ext:define-keysym 111 "o") (ext:define-keysym 79 "O")
+(ext:define-keysym 112 "p") (ext:define-keysym 80 "P")
+(ext:define-keysym 113 "q") (ext:define-keysym 81 "Q")
+(ext:define-keysym 114 "r") (ext:define-keysym 82 "R")
+(ext:define-keysym 115 "s") (ext:define-keysym 83 "S")
+(ext:define-keysym 116 "t") (ext:define-keysym 84 "T")
+(ext:define-keysym 117 "u") (ext:define-keysym 85 "U")
+(ext:define-keysym 118 "v") (ext:define-keysym 86 "V")
+(ext:define-keysym 119 "w") (ext:define-keysym 87 "W")
+(ext:define-keysym 120 "x") (ext:define-keysym 88 "X")
+(ext:define-keysym 121 "y") (ext:define-keysym 89 "Y")
+(ext:define-keysym 122 "z") (ext:define-keysym 90 "Z")
+
+;;; Standard number keys.
+;;;
+(ext:define-keysym 49 "1") (ext:define-keysym 33 "!")
+(ext:define-keysym 50 "2") (ext:define-keysym 64 "@")
+(ext:define-keysym 51 "3") (ext:define-keysym 35 "#")
+(ext:define-keysym 52 "4") (ext:define-keysym 36 "$")
+(ext:define-keysym 53 "5") (ext:define-keysym 37 "%")
+(ext:define-keysym 54 "6") (ext:define-keysym 94 "^")
+(ext:define-keysym 55 "7") (ext:define-keysym 38 "&")
+(ext:define-keysym 56 "8") (ext:define-keysym 42 "*")
+(ext:define-keysym 57 "9") (ext:define-keysym 40 "(")
+(ext:define-keysym 48 "0") (ext:define-keysym 41 ")")
+
+;;; "Standard" symbol keys.
+;;;
+(ext:define-keysym 96 "`") (ext:define-keysym 126 "~")
+(ext:define-keysym 45 "-") (ext:define-keysym 95 "_")
+(ext:define-keysym 61 "=") (ext:define-keysym 43 "+")
+(ext:define-keysym 91 "[") (ext:define-keysym 123 "{")
+(ext:define-keysym 93 "]") (ext:define-keysym 125 "}")
+(ext:define-keysym 92 "\\") (ext:define-keysym 124 "|")
+(ext:define-keysym 59 ";") (ext:define-keysym 58 ":")
+(ext:define-keysym 39 "'") (ext:define-keysym 34 "\"")
+(ext:define-keysym 44 ",") (ext:define-keysym 60 "<")
+(ext:define-keysym 46 ".") (ext:define-keysym 62 ">")
+(ext:define-keysym 47 "/") (ext:define-keysym 63 "?")
+
+;;; Standard Mouse keysyms.
+;;;
+(ext::define-mouse-keysym 1 25601 "Leftdown" "Super" :button-press)
+(ext::define-mouse-keysym 1 25602 "Leftup" "Super" :button-release)
+
+(ext::define-mouse-keysym 2 25603 "Middledown" "Super" :button-press)
+(ext::define-mouse-keysym 2 25604 "Middleup" "Super" :button-release)
+
+(ext::define-mouse-keysym 3 25605 "Rightdown" "Super" :button-press)
+(ext::define-mouse-keysym 3 25606 "Rightup" "Super" :button-release)
+
+;;; Sun keyboard.
+;;;
+(ext:define-keysym 65387 "break")			;alternate (Sun).
+;(ext:define-keysym 65290 "linefeed")
+
+
+
+;;;; SETFs of KEY-EVANT-CHAR and CHAR-KEY-EVENT.
+
+;;; Converting ASCII control characters to Common Lisp control characters:
+;;; ASCII control character codes are separated from the codes of the
+;;; "non-controlified" characters by the code of atsign.  The ASCII control
+;;; character codes range from ^@ (0) through ^_ (one less than the code of
+;;; space).  We iterate over this range adding the ASCII code of atsign to
+;;; get the "non-controlified" character code.  With each of these, we turn
+;;; the code into a Common Lisp character and set its :control bit.  Certain
+;;; ASCII control characters have to be translated to special Common Lisp
+;;; characters outside of the loop.
+;;;    With the advent of Hemlock running under X, and all the key bindings
+;;; changing, we also downcase each Common Lisp character (where normally
+;;; control characters come in upcased) in an effort to obtain normal command
+;;; bindings.  Commands bound to uppercase modified characters will not be
+;;; accessible to terminal interaction.
+;;; 
+(let ((@-code (char-code #\@)))
+  (dotimes (i (char-code #\space))
+    (setf (ext:char-key-event (code-char i))
+	  (ext::make-key-event (string (char-downcase (code-char (+ i @-code))))
+			       (key-event-modifier-mask "control")))))
+(setf (ext:char-key-event (code-char 9)) (ext::make-key-event #k"Tab"))
+(setf (ext:char-key-event (code-char 10)) (ext::make-key-event #k"Linefeed"))
+(setf (ext:char-key-event (code-char 13)) (ext::make-key-event #k"Return"))
+(setf (ext:char-key-event (code-char 27)) (ext::make-key-event #k"Alt"))
+(setf (ext:char-key-event (code-char 8)) (ext::make-key-event #k"Backspace"))
+;;;
+;;; Other ASCII codes are exactly the same as the Common Lisp codes.
+;;; 
+(do ((i (char-code #\space) (1+ i)))
+    ((= i 128))
+  (setf (ext:char-key-event (code-char i))
+	(ext::make-key-event (string (code-char i)))))
+
+;;; This makes KEY-EVENT-CHAR the inverse of CHAR-KEY-EVENT from the start.
+;;; It need not be this way, but it is.
+;;;
+(dotimes (i 128)
+  (let ((character (code-char i)))
+    (setf (ext::key-event-char (ext:char-key-event character)) character)))
+
+;;; Since we treated these characters specially above when setting
+;;; EXT:CHAR-KEY-EVENT above, we must set these EXT:KEY-EVENT-CHAR's specially
+;;; to make quoting characters into Hemlock buffers more obvious for users.
+;;;
+(setf (ext:key-event-char #k"C-h") #\backspace)
+(setf (ext:key-event-char #k"C-i") #\tab)
+(setf (ext:key-event-char #k"C-j") #\linefeed)
+(setf (ext:key-event-char #k"C-m") #\return)