From 08d066bdaa1227e7e22accfd990862b5a94a0806 Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Fri, 13 Jul 1990 15:15:13 +0000
Subject: [PATCH] *** empty log message ***

---
 hemlock/bindings.lisp    | 1232 ++++++++++++++++++--------------------
 hemlock/bit-screen.lisp  |    4 +-
 hemlock/buffer.lisp      |    4 +-
 hemlock/charmacs.lisp    |  105 +---
 hemlock/command.lisp     |   44 +-
 hemlock/completion.lisp  |   21 +-
 hemlock/diredcoms.lisp   |   25 +-
 hemlock/doccoms.lisp     |   66 +-
 hemlock/echo.lisp        |  351 +++++------
 hemlock/echocoms.lisp    |    8 +-
 hemlock/filecoms.lisp    |   28 +-
 hemlock/files.lisp       |    2 +
 hemlock/fill.lisp        |    7 +-
 hemlock/gosmacs.lisp     |   18 +-
 hemlock/hemlock.log      |  315 ++++++++++
 hemlock/icom.lisp        |    2 +-
 hemlock/interp.lisp      |  364 +++++------
 hemlock/kbdmac.lisp      |   37 +-
 hemlock/lispmode.lisp    |   27 +
 hemlock/macros.lisp      |   86 +--
 hemlock/main.lisp        |    3 +-
 hemlock/mh.lisp          |   14 +-
 hemlock/morecoms.lisp    |   48 +-
 hemlock/overwrite.lisp   |    2 +-
 hemlock/register.lisp    |    5 +-
 hemlock/rompsite.lisp    |  599 ++----------------
 hemlock/scribe.lisp      |  222 ++++---
 hemlock/searchcoms.lisp  |   82 +--
 hemlock/shell.lisp       |  117 +++-
 hemlock/spellcoms.lisp   |   87 +--
 hemlock/srccom.lisp      |    4 +-
 hemlock/streams.lisp     |   64 +-
 hemlock/struct.lisp      |    5 +-
 hemlock/termcap.lisp     |   62 +-
 hemlock/ts-buf.lisp      |   18 +-
 hemlock/tty-display.lisp |   22 +-
 tools/hemcom.lisp        |  255 ++++----
 37 files changed, 2119 insertions(+), 2236 deletions(-)

diff --git a/hemlock/bindings.lisp b/hemlock/bindings.lisp
index 4a0e72300..1d7089ceb 100644
--- a/hemlock/bindings.lisp
+++ b/hemlock/bindings.lisp
@@ -16,72 +16,15 @@
 
 ;;;; Default key translations:
 
-;;; This page first maps all uppercase characters with all modifier bit
-;;; combinations to the equivalent lowercase letter.  This saves many
-;;; duplicated BIND-KEY forms and tends to support what users expect out of a
-;;; BIND-KEY call.
+;;; This page defines prefix characters that set specified modifier bits on
+;;; the next character typed.
 ;;;
-;;; Secondly, this page defines prefix characters that set specified modifier
-;;; bits on the next character typed.
-;;;
-
-;;; Case insensitivize:
-;;;
-(defun case-insensitivize (bits)
-  "Make key translations from all the lowercase characters with specified bits
-  to the corresponding uppercase characters."
-  (do-alpha-chars (lower :lower)
-    (setf (key-translation (make-char (char-upcase lower) bits))
-	  (make-char lower bits))))
-
-(case-insensitivize 0)
-(case-insensitivize 1)
-(case-insensitivize 2)
-(case-insensitivize 3)
-
-(case-insensitivize 8)
-(case-insensitivize 9)
-(case-insensitivize 10)
-(case-insensitivize 11)
-
-
-;;; Prefix characters:
-;;;
-(setf (key-translation #\escape) '(:bits :meta))
-(setf (key-translation #\control-z) '(:bits :control :meta))
-(setf (key-translation #\control-\z) '(:bits :control :meta))
-(setf (key-translation #\control-^) '(:bits :control))
-(setf (key-translation #\control-c) '(:bits :hyper))
-(setf (key-translation #\control-\c) '(:bits :hyper))
-
-
-
-;;;; Void some key translations.
-
-;;; This page kills some key translations so we can make use of case sensitive
-;;; bindings.  These translations must be voided for each modifier bit
-;;; combination we are interested in.  Characters with nil translations, used
-;;; in bindings for which the translation is desired, must be bound to both the
-;;; lower and upper case characters separately.  For examples, see "Delete Next
-;;; Character" and "Previous Undeleted Message".
-;;;
-
-(setf (key-translation #\control-meta-s) nil)
-(setf (key-translation #\control-meta-a) nil)
-(setf (key-translation #\control-meta-v) nil)
-(setf (key-translation #\control-meta-f) nil)
-(setf (key-translation #\control-meta-l) nil)
-(setf (key-translation #\control-meta-c) nil)
-
-(setf (key-translation #\control-d) nil)
-(setf (key-translation #\control-m) nil)
-
-(setf (key-translation #\meta-p) nil)
-
-(setf (key-translation #\D) nil)
-(setf (key-translation #\U) nil)
-(setf (key-translation #\R) nil)
-(setf (key-translation #\C) nil)
+(setf (key-translation #k"escape") '(:bits :meta))
+(setf (key-translation #k"control-z") '(:bits :control :meta))
+(setf (key-translation #k"control-Z") '(:bits :control :meta))
+(setf (key-translation #k"control-^") '(:bits :control))
+(setf (key-translation #k"control-c") '(:bits :hyper))
+(setf (key-translation #k"control-C") '(:bits :hyper))
 
 
 
@@ -89,234 +32,220 @@
 
 ;;; Self insert letters:
 ;;;
-(do-alpha-chars (upper :upper)
-  (bind-key "Self Insert" upper))
-
-;;; Add these lowercase letters since we killed the uppercase translations
-;;; on the previous page.
-;;;
-(bind-key "Self Insert" #\d)
-(bind-key "Self Insert" #\u)
-(bind-key "Self Insert" #\r)
-(bind-key "Self Insert" #\c)
-
-
-(bind-key "Beginning of Line" #\control-a)
-(bind-key "Delete Next Character" #\control-\d)
-(bind-key "Delete Next Character" #\control-d)
-(bind-key "End of Line" #\control-e)
-(bind-key "Forward Character" #\control-f)
-(bind-key "Forward Character" #\rightarrow)
-(bind-key "Backward Character" #\control-b)
-(bind-key "Backward Character" #\leftarrow)
-(bind-key "Kill Line" #\control-k)
-(bind-key "Refresh Screen" #\control-l)
-(bind-key "Next Line" #\control-n)
-(bind-key "Next Line" #\downarrow)
-(bind-key "Previous Line" #\control-p)
-(bind-key "Previous Line" #\uparrow)
-(bind-key "Query Replace" #\meta-%)
-(bind-key "Reverse Incremental Search" #\control-r)
-(bind-key "Incremental Search" #\control-s)
-(bind-key "Forward Search" #\meta-s)
-(bind-key "Reverse Search" #\meta-r)
-(bind-key "Transpose Characters" #\control-t)
-(bind-key "Universal Argument" #\control-u)
-(bind-key "Scroll Window Down" #\control-v)
-(bind-key "Scroll Window Up" #\meta-v)
-(bind-key "Scroll Next Window Down" #\control-meta-\v)
-
-(bind-key "Scroll Next Window Up" #\control-meta-V)
-
-(bind-key "Help" #\home)
-(bind-key "Help" #\control-_)
-(bind-key "Describe Key" #\meta-?)
-
-
-(bind-key "Here to Top of Window" #\leftdown)
-(bind-key "Do Nothing" #\leftup)
-(bind-key "Top Line to Here" #\rightdown)
-(bind-key "Do Nothing" #\rightup)
-(bind-key "Point to Here" #\middledown)
-(bind-key "Point to Here" #\super-leftdown)
-(bind-key "Generic Pointer Up" #\middleup)
-(bind-key "Generic Pointer Up" #\super-leftup)
-(bind-key "Do Nothing" #\super-rightup)
-(bind-key "Insert Kill Buffer" #\super-rightdown)
-
-
-(bind-key "Insert File" '#(#\control-x #\control-r))
-(bind-key "Save File" '#(#\control-x #\control-s))
-(bind-key "Visit File" '#(#\control-x #\control-v))
-(bind-key "Write File" '#(#\control-x #\control-w))
-(bind-key "Find File" '#(#\control-x #\control-f))
-(bind-key "Backup File" '#(#\control-x #\meta-b))
-(bind-key "Save All Files" '#(#\control-x #\control-\m))
-(bind-key "Save All Files" '#(#\control-x #\control-m))
-(bind-key "Save All Files" '#(#\control-x #\return))
-(bind-key "Save All Files and Exit" '#(#\control-x #\meta-z))
-
-(bind-key "List Buffers" '#(#\control-x #\control-b))
-(bind-key "Buffer Not Modified" #\meta-~)
-(bind-key "Check Buffer Modified" '#(#\control-x #\~))
-(bind-key "Select Buffer" '#(#\control-x #\b))
-(bind-key "Select Previous Buffer" #\control-meta-\l)
-(bind-key "Circulate Buffers" #\control-meta-l)
-(bind-key "Create Buffer" '#(#\control-x #\meta-b))
-(bind-key "Kill Buffer" '#(#\control-x #\k))
-(bind-key "Select Random Typeout Buffer" #\hyper-t)
-
-(bind-key "Next Window" '#(#\control-x #\n))
-(bind-key "Next Window" '#(#\control-x #\o))
-(bind-key "Previous Window" '#(#\control-x #\p))
-(bind-key "Split Window" '#(#\control-x #\2))
-(bind-key "New Window" '#(#\control-x #\control-n))
-(bind-key "Delete Window" '#(#\control-x #\d))
-(bind-key "Delete Window" '#(#\control-x #\D))
-(bind-key "Delete Next Window" '#(#\control-x #\1))
-(bind-key "Line to Top of Window" #\meta-!)
-(bind-key "Line to Center of Window" #\meta-\#)
-(bind-key "Top of Window" #\meta-\,)
-(bind-key "Bottom of Window" #\meta-\.)
-
-(bind-key "Exit Hemlock" '#(#\control-x #\control-z))
-(bind-key "Exit Hemlock" '#(#\control-x #\control-\z))
-(bind-key "Exit Recursive Edit" #\control-meta-z)
-(bind-key "Abort Recursive Edit" #\control-])
-
-(bind-key "Delete Previous Character" #\Delete)
-(bind-key "Delete Previous Character" #\Backspace)
-(bind-key "Kill Next Word" #\meta-d)
-(bind-key "Kill Previous Word" #\meta-delete)
-(bind-key "Kill Previous Word" #\meta-backspace)
-(bind-key "Exchange Point and Mark" '#(#\control-x #\control-x))
-(bind-key "Mark Whole Buffer" '#(#\control-x #\h))
-(bind-key "Set/Pop Mark" #\control-@)
-(bind-key "Set/Pop Mark" #\control-space)
-(bind-key "Pop and Goto Mark" #\meta-space)
-(bind-key "Pop and Goto Mark" #\meta-@)
-(bind-key "Pop Mark" #\control-meta-space)  ;#\c-m-@ is "Mark Form".
-(bind-key "Kill Region" #\control-w)
-(bind-key "Save Region" #\meta-w)
-(bind-key "Un-Kill" #\control-y)
-(bind-key "Rotate Kill Ring" #\meta-y)
-
-(bind-key "Forward Word" #\meta-f)
-(bind-key "Backward Word" #\meta-b)
-
-(bind-key "Forward Paragraph" #\meta-])
-(bind-key "Forward Sentence" #\meta-e)
-(bind-key "Backward Paragraph" #\meta-[)
-(bind-key "Backward Sentence" #\meta-a)
-
-(bind-key "Mark Paragraph" #\meta-h)
-
-(bind-key "Forward Kill Sentence" #\meta-k)
-(bind-key "Backward Kill Sentence" '#(#\control-x #\delete))
-(bind-key "Backward Kill Sentence" '#(#\control-x #\backspace))
-
-(bind-key "Beginning of Buffer" #\meta-<)
-(bind-key "End of Buffer" #\meta->)
-(bind-key "Mark to Beginning of Buffer" #\control-<)
-(bind-key "Mark to End of Buffer" #\control->)
-
-(bind-key "Extended Command" #\meta-x)
-
-(bind-key "Uppercase Word" '#\meta-u)
-(bind-key "Lowercase Word" '#\meta-l)
-(bind-key "Capitalize Word" '#\meta-c)
-
-(bind-key "Previous Page" '#(#\control-x #\[))
-(bind-key "Next Page" '#(#\control-x #\]))
-(bind-key "Mark Page" '#(#\control-x #\control-p))
-(bind-key "Count Lines Page" '#(#\control-x #\l))
+(do-alpha-key-events (key-event :both)
+  (bind-key "Self Insert" key-event))
+
+(bind-key "Beginning of Line" #k"control-a")
+(bind-key "Delete Next Character" #k"control-d")
+(bind-key "End of Line" #k"control-e")
+(bind-key "Forward Character" #k"control-f")
+(bind-key "Forward Character" #k"rightarrow")
+(bind-key "Backward Character" #k"control-b")
+(bind-key "Backward Character" #k"leftarrow")
+(bind-key "Kill Line" #k"control-k")
+(bind-key "Refresh Screen" #k"control-l")
+(bind-key "Next Line" #k"control-n")
+(bind-key "Next Line" #k"downarrow")
+(bind-key "Previous Line" #k"control-p")
+(bind-key "Previous Line" #k"uparrow")
+(bind-key "Query Replace" #k"meta-%")
+(bind-key "Reverse Incremental Search" #k"control-r")
+(bind-key "Incremental Search" #k"control-s")
+(bind-key "Forward Search" #k"meta-s")
+(bind-key "Reverse Search" #k"meta-r")
+(bind-key "Transpose Characters" #k"control-t")
+(bind-key "Universal Argument" #k"control-u")
+(bind-key "Scroll Window Down" #k"control-v")
+(bind-key "Scroll Window Up" #k"meta-v")
+(bind-key "Scroll Next Window Down" #k"control-meta-v")
+(bind-key "Scroll Next Window Up" #k"control-meta-V")
+
+(bind-key "Help" #k"home")
+(bind-key "Help" #k"control-_")
+(bind-key "Describe Key" #k"meta-?")
+
+
+(bind-key "Here to Top of Window" #k"leftdown")
+(bind-key "Do Nothing" #k"leftup")
+(bind-key "Top Line to Here" #k"rightdown")
+(bind-key "Do Nothing" #k"rightup")
+(bind-key "Point to Here" #k"middledown")
+(bind-key "Point to Here" #k"super-leftdown")
+(bind-key "Generic Pointer Up" #k"middleup")
+(bind-key "Generic Pointer Up" #k"super-leftup")
+(bind-key "Do Nothing" #k"super-rightup")
+(bind-key "Insert Kill Buffer" #k"super-rightdown")
+
+
+(bind-key "Insert File" #k"control-x control-r")
+(bind-key "Save File" #k"control-x control-s")
+(bind-key "Visit File" #k"control-x control-v")
+(bind-key "Write File" #k"control-x control-w")
+(bind-key "Find File" #k"control-x control-f")
+(bind-key "Backup File" #k"control-x meta-b")
+(bind-key "Save All Files" #k"control-x control-m")
+(bind-key "Save All Files" #k"control-x return")
+(bind-key "Save All Files and Exit" #k"control-x meta-z")
+
+(bind-key "List Buffers" #k"control-x control-b")
+(bind-key "Buffer Not Modified" #k"meta-~")
+(bind-key "Check Buffer Modified" #k"control-x ~")
+(bind-key "Select Buffer" #k"control-x b")
+(bind-key "Select Previous Buffer" #k"control-meta-l")
+(bind-key "Circulate Buffers" #k"control-meta-L")
+(bind-key "Create Buffer" #k"control-x meta-b")
+(bind-key "Kill Buffer" #k"control-x k")
+(bind-key "Select Random Typeout Buffer" #k"hyper-t")
+
+(bind-key "Next Window" #k"control-x n")
+(bind-key "Next Window" #k"control-x o")
+(bind-key "Previous Window" #k"control-x p")
+(bind-key "Split Window" #k"control-x 2")
+(bind-key "New Window" #k"control-x control-n")
+(bind-key "Delete Window" #k"control-x d")
+(bind-key "Delete Next Window" #k"control-x 1")
+(bind-key "Line to Top of Window" #k"meta-!")
+(bind-key "Line to Center of Window" #k"meta-#")
+(bind-key "Top of Window" #k"meta-,")
+(bind-key "Bottom of Window" #k"meta-.")
+
+(bind-key "Exit Hemlock" #k"control-x control-z")
+(bind-key "Exit Recursive Edit" #k"control-meta-z")
+(bind-key "Abort Recursive Edit" #k"control-]")
+
+(bind-key "Delete Previous Character" #k"delete")
+(bind-key "Delete Previous Character" #k"backspace")
+(bind-key "Kill Next Word" #k"meta-d")
+(bind-key "Kill Previous Word" #k"meta-delete")
+(bind-key "Kill Previous Word" #k"meta-backspace")
+(bind-key "Exchange Point and Mark" #k"control-x control-x")
+(bind-key "Mark Whole Buffer" #k"control-x h")
+(bind-key "Set/Pop Mark" #k"control-@")
+(bind-key "Set/Pop Mark" #k"control-space")
+(bind-key "Pop and Goto Mark" #k"meta-space")
+(bind-key "Pop and Goto Mark" #k"meta-@")
+(bind-key "Pop Mark" #k"control-meta-space")  ;#k"control-meta-@" = "Mark Form".
+(bind-key "Kill Region" #k"control-w")
+(bind-key "Save Region" #k"meta-w")
+(bind-key "Un-Kill" #k"control-y")
+(bind-key "Rotate Kill Ring" #k"meta-y")
+
+(bind-key "Forward Word" #k"meta-f")
+(bind-key "Backward Word" #k"meta-b")
+
+(bind-key "Forward Paragraph" #k"meta-]")
+(bind-key "Forward Sentence" #k"meta-e")
+(bind-key "Backward Paragraph" #k"meta-[")
+(bind-key "Backward Sentence" #k"meta-a")
+
+(bind-key "Mark Paragraph" #k"meta-h")
+
+(bind-key "Forward Kill Sentence" #k"meta-k")
+(bind-key "Backward Kill Sentence" #k"control-x delete")
+(bind-key "Backward Kill Sentence" #k"control-x backspace")
+
+(bind-key "Beginning of Buffer" #k"meta-\<")
+(bind-key "End of Buffer" #k"meta-\>")
+(bind-key "Mark to Beginning of Buffer" #k"control-\<")
+(bind-key "Mark to End of Buffer" #k"control-\>")
+
+(bind-key "Extended Command" #k"meta-x")
+
+(bind-key "Uppercase Word" #k"meta-u")
+(bind-key "Lowercase Word" #k"meta-l")
+(bind-key "Capitalize Word" #k"meta-c")
+
+(bind-key "Previous Page" #k"control-x ["))
+(bind-key "Next Page" #k"control-x ]"))
+(bind-key "Mark Page" #k"control-x control-p")
+(bind-key "Count Lines Page" #k"control-x l")
 
 
 
 ;;;; Argument Digit and Negative Argument.
 
-(bind-key "Negative Argument" #\meta--)
-(bind-key "Argument Digit" #\meta-0)
-(bind-key "Argument Digit" #\meta-1)
-(bind-key "Argument Digit" #\meta-2)
-(bind-key "Argument Digit" #\meta-3)
-(bind-key "Argument Digit" #\meta-4)
-(bind-key "Argument Digit" #\meta-5)
-(bind-key "Argument Digit" #\meta-6)
-(bind-key "Argument Digit" #\meta-7)
-(bind-key "Argument Digit" #\meta-8)
-(bind-key "Argument Digit" #\meta-9)
-(bind-key "Negative Argument" #\control--)
-(bind-key "Argument Digit" #\control-0)
-(bind-key "Argument Digit" #\control-1)
-(bind-key "Argument Digit" #\control-2)
-(bind-key "Argument Digit" #\control-3)
-(bind-key "Argument Digit" #\control-4)
-(bind-key "Argument Digit" #\control-5)
-(bind-key "Argument Digit" #\control-6)
-(bind-key "Argument Digit" #\control-7)
-(bind-key "Argument Digit" #\control-8)
-(bind-key "Argument Digit" #\control-9)
-(bind-key "Negative Argument" #\control-meta--)
-(bind-key "Argument Digit" #\control-meta-0)
-(bind-key "Argument Digit" #\control-meta-1)
-(bind-key "Argument Digit" #\control-meta-2)
-(bind-key "Argument Digit" #\control-meta-3)
-(bind-key "Argument Digit" #\control-meta-4)
-(bind-key "Argument Digit" #\control-meta-5)
-(bind-key "Argument Digit" #\control-meta-6)
-(bind-key "Argument Digit" #\control-meta-7)
-(bind-key "Argument Digit" #\control-meta-8)
-(bind-key "Argument Digit" #\control-meta-9)
+(bind-key "Negative Argument" #k"meta-\-")
+(bind-key "Argument Digit" #k"meta-0")
+(bind-key "Argument Digit" #k"meta-1")
+(bind-key "Argument Digit" #k"meta-2")
+(bind-key "Argument Digit" #k"meta-3")
+(bind-key "Argument Digit" #k"meta-4")
+(bind-key "Argument Digit" #k"meta-5")
+(bind-key "Argument Digit" #k"meta-6")
+(bind-key "Argument Digit" #k"meta-7")
+(bind-key "Argument Digit" #k"meta-8")
+(bind-key "Argument Digit" #k"meta-9")
+(bind-key "Negative Argument" #k"control-\-")
+(bind-key "Argument Digit" #k"control-0")
+(bind-key "Argument Digit" #k"control-1")
+(bind-key "Argument Digit" #k"control-2")
+(bind-key "Argument Digit" #k"control-3")
+(bind-key "Argument Digit" #k"control-4")
+(bind-key "Argument Digit" #k"control-5")
+(bind-key "Argument Digit" #k"control-6")
+(bind-key "Argument Digit" #k"control-7")
+(bind-key "Argument Digit" #k"control-8")
+(bind-key "Argument Digit" #k"control-9")
+(bind-key "Negative Argument" #k"control-meta-\-")
+(bind-key "Argument Digit" #k"control-meta-0")
+(bind-key "Argument Digit" #k"control-meta-1")
+(bind-key "Argument Digit" #k"control-meta-2")
+(bind-key "Argument Digit" #k"control-meta-3")
+(bind-key "Argument Digit" #k"control-meta-4")
+(bind-key "Argument Digit" #k"control-meta-5")
+(bind-key "Argument Digit" #k"control-meta-6")
+(bind-key "Argument Digit" #k"control-meta-7")
+(bind-key "Argument Digit" #k"control-meta-8")
+(bind-key "Argument Digit" #k"control-meta-9")
 
 
 ;;;; Self Insert and Quoted Insert.
 
-(bind-key "Quoted Insert" #\control-q)
-
-(bind-key "Self Insert" " ")
-(bind-key "Self Insert" "!")
-(bind-key "Self Insert" "@")
-(bind-key "Self Insert" "#")
-(bind-key "Self Insert" "$")
-(bind-key "Self Insert" "%")
-(bind-key "Self Insert" "^")
-(bind-key "Self Insert" "&")
-(bind-key "Self Insert" "*")
-(bind-key "Self Insert" "(")
-(bind-key "Self Insert" ")")
-(bind-key "Self Insert" "_")
-(bind-key "Self Insert" "+")
-(bind-key "Self Insert" "~")
-(bind-key "Self Insert" "1")
-(bind-key "Self Insert" "2")
-(bind-key "Self Insert" "3")
-(bind-key "Self Insert" "4")
-(bind-key "Self Insert" "5")
-(bind-key "Self Insert" "6")
-(bind-key "Self Insert" "7")
-(bind-key "Self Insert" "8")
-(bind-key "Self Insert" "9")
-(bind-key "Self Insert" "0")
-(bind-key "Self Insert" "[")
-(bind-key "Self Insert" "]")
-(bind-key "Self Insert" "\\")
-(bind-key "Self Insert" "|")
-(bind-key "Self Insert" ":")
-(bind-key "Self Insert" ";")
-(bind-key "Self Insert" "\"")
-(bind-key "Self Insert" "'")
-(bind-key "Self Insert" "-")
-(bind-key "Self Insert" "=")
-(bind-key "Self Insert" "`")
-(bind-key "Self Insert" "<")
-(bind-key "Self Insert" ">")
-(bind-key "Self Insert" ",")
-(bind-key "Self Insert" ".")
-(bind-key "Self Insert" "?")
-(bind-key "Self Insert" "/")
-(bind-key "Self Insert" "{")
-(bind-key "Self Insert" "}")
+(bind-key "Quoted Insert" #k"control-q")
+
+(bind-key "Self Insert" #k"space")
+(bind-key "Self Insert" #k"!")
+(bind-key "Self Insert" #k"@")
+(bind-key "Self Insert" #k"#")
+(bind-key "Self Insert" #k"$")
+(bind-key "Self Insert" #k"%")
+(bind-key "Self Insert" #k"^")
+(bind-key "Self Insert" #k"&")
+(bind-key "Self Insert" #k"*")
+(bind-key "Self Insert" #k"(")
+(bind-key "Self Insert" #k")")
+(bind-key "Self Insert" #k"_")
+(bind-key "Self Insert" #k"+")
+(bind-key "Self Insert" #k"~")
+(bind-key "Self Insert" #k"1")
+(bind-key "Self Insert" #k"2")
+(bind-key "Self Insert" #k"3")
+(bind-key "Self Insert" #k"4")
+(bind-key "Self Insert" #k"5")
+(bind-key "Self Insert" #k"6")
+(bind-key "Self Insert" #k"7")
+(bind-key "Self Insert" #k"8")
+(bind-key "Self Insert" #k"9")
+(bind-key "Self Insert" #k"0")
+(bind-key "Self Insert" #k"[")
+(bind-key "Self Insert" #k"]")
+(bind-key "Self Insert" #k"\\")
+(bind-key "Self Insert" #k"|")
+(bind-key "Self Insert" #k":")
+(bind-key "Self Insert" #k";")
+(bind-key "Self Insert" #k"\"")
+(bind-key "Self Insert" #k"'")
+(bind-key "Self Insert" #k"\-")
+(bind-key "Self Insert" #k"=")
+(bind-key "Self Insert" #k"`")
+(bind-key "Self Insert" #k"\<")
+(bind-key "Self Insert" #k"\>")
+(bind-key "Self Insert" #k",")
+(bind-key "Self Insert" #k".")
+(bind-key "Self Insert" #k"?")
+(bind-key "Self Insert" #k"/")
+(bind-key "Self Insert" #k"{")
+(bind-key "Self Insert" #k"}")
 
 
 
@@ -324,304 +253,299 @@
 
 ;;; Basic echo-area commands.
 ;;; 
-(bind-key "Help on Parse" #\home :mode "Echo Area")
-(bind-key "Help on Parse" #\control-_ :mode "Echo Area")
+(bind-key "Help on Parse" #k"home" :mode "Echo Area")
+(bind-key "Help on Parse" #k"control-_" :mode "Echo Area")
 
-(bind-key "Complete Keyword" #\escape :mode "Echo Area")
-(bind-key "Complete Field" #\space :mode "Echo Area")
-(bind-key "Confirm Parse" #\return :mode "Echo Area")
+(bind-key "Complete Keyword" #k"escape" :mode "Echo Area")
+(bind-key "Complete Field" #k"space" :mode "Echo Area")
+(bind-key "Confirm Parse" #k"return" :mode "Echo Area")
 
 ;;; Rebind some standard commands to behave better.
 ;;; 
-(bind-key "Kill Parse" #\control-u :mode "Echo Area")
-(bind-key "Insert Parse Default" #\control-i :mode "Echo Area")
-(bind-key "Insert Parse Default" #\tab :mode "Echo Area")
-(bind-key "Echo Area Delete Previous Character" #\delete :mode "Echo Area")
-(bind-key "Echo Area Delete Previous Character" #\backspace :mode "Echo Area")
-(bind-key "Echo Area Kill Previous Word" #\meta-h :mode "Echo Area")
-(bind-key "Echo Area Kill Previous Word" #\meta-delete :mode "Echo Area")
-(bind-key "Echo Area Kill Previous Word" #\meta-backspace :mode "Echo Area")
-(bind-key "Echo Area Kill Previous Word" #\control-w :mode "Echo Area")
-(bind-key "Beginning of Parse" #\control-a :mode "Echo Area")
-(bind-key "Beginning of Parse" #\meta-< :mode "Echo Area")
-(bind-key "Echo Area Backward Character" #\control-b :mode "Echo Area")
-(bind-key "Echo Area Backward Word" #\meta-b :mode "Echo Area")
-(bind-key "Next Parse" #\control-n :mode "Echo Area")
-(bind-key "Previous Parse" #\control-p :mode "Echo Area")
-
-;;; Nuke some dangerous standard bindings.
+(bind-key "Kill Parse" #k"control-u" :mode "Echo Area")
+(bind-key "Insert Parse Default" #k"control-i" :mode "Echo Area")
+(bind-key "Insert Parse Default" #k"tab" :mode "Echo Area")
+(bind-key "Echo Area Delete Previous Character" #k"delete" :mode "Echo Area")
+(bind-key "Echo Area Delete Previous Character" #k"backspace" :mode "Echo Area")
+(bind-key "Echo Area Kill Previous Word" #k"meta-h" :mode "Echo Area")
+(bind-key "Echo Area Kill Previous Word" #k"meta-delete" :mode "Echo Area")
+(bind-key "Echo Area Kill Previous Word" #k"meta-backspace" :mode "Echo Area")
+(bind-key "Echo Area Kill Previous Word" #k"control-w" :mode "Echo Area")
+(bind-key "Beginning of Parse" #k"control-a" :mode "Echo Area")
+(bind-key "Beginning of Parse" #k"meta-\<" :mode "Echo Area")
+(bind-key "Echo Area Backward Character" #k"control-b" :mode "Echo Area")
+(bind-key "Echo Area Backward Word" #k"meta-b" :mode "Echo Area")
+(bind-key "Next Parse" #k"control-n" :mode "Echo Area")
+(bind-key "Previous Parse" #k"control-p" :mode "Echo Area")
+
+;;; Remove some dangerous standard bindings.
 ;;; 
-(bind-key "Illegal" #\control-x :mode "Echo Area")
-(bind-key "Illegal" #\control-meta-c :mode "Echo Area")
-(bind-key "Illegal" #\control-meta-\c :mode "Echo Area")
-(bind-key "Illegal" #\control-meta-l :mode "Echo Area")
-(bind-key "Illegal" #\control-meta-\l :mode "Echo Area")
-(bind-key "Illegal" #\meta-x :mode "Echo Area")
-(bind-key "Illegal" #\control-s :mode "Echo Area")
-(bind-key "Illegal" #\control-r :mode "Echo Area")
-(bind-key "Illegal" #\middledown :mode "Echo Area")
-(bind-key "Do Nothing" #\middleup :mode "Echo Area")
-(bind-key "Illegal" #\super-leftdown :mode "Echo Area")
-(bind-key "Do Nothing" #\super-leftup :mode "Echo Area")
-(bind-key "Illegal" #\super-rightdown :mode "Echo Area")
-(bind-key "Do Nothing" #\super-rightup :mode "Echo Area")
+(bind-key "Illegal" #k"control-x" :mode "Echo Area")
+(bind-key "Illegal" #k"control-meta-c" :mode "Echo Area")
+(bind-key "Illegal" #k"control-meta-l" :mode "Echo Area")
+(bind-key "Illegal" #k"meta-x" :mode "Echo Area")
+(bind-key "Illegal" #k"control-s" :mode "Echo Area")
+(bind-key "Illegal" #k"control-r" :mode "Echo Area")
+(bind-key "Illegal" #k"hyper-t" :mode "Echo Area")
+(bind-key "Illegal" #k"middledown" :mode "Echo Area")
+(bind-key "Do Nothing" #k"middleup" :mode "Echo Area")
+(bind-key "Illegal" #k"super-leftdown" :mode "Echo Area")
+(bind-key "Do Nothing" #k"super-leftup" :mode "Echo Area")
+(bind-key "Illegal" #k"super-rightdown" :mode "Echo Area")
+(bind-key "Do Nothing" #k"super-rightup" :mode "Echo Area")
 
 
 
 ;;;; Eval and Editor Modes.
 
-(bind-key "Confirm Eval Input" #\return :mode "Eval")
-(bind-key "Previous Interactive Input" #\meta-\p :mode "Eval")
-(bind-key "Search Previous Interactive Input" #\meta-p :mode "Eval")
-(bind-key "Next Interactive Input" #\meta-n :mode "Eval")
-(bind-key "Kill Interactive Input" #\meta-i :mode "Eval")
-(bind-key "Abort Eval Input" #\control-meta-i :mode "Eval")
-(bind-key "Interactive Beginning of Line" #\control-a :mode "Eval")
-(bind-key "Reenter Interactive Input" #\control-return :mode "Eval")
-
-(bind-key "Editor Evaluate Expression" #\control-meta-escape)
-(bind-key "Editor Evaluate Expression" #\meta-escape  :mode "Editor")
-(bind-key "Editor Evaluate Defun" '#(#\control-x #\control-e) :mode "Editor")
-(bind-key "Editor Compile Defun" '#(#\control-x #\control-c) :mode "Editor")
-(bind-key "Editor Compile Defun" '#(#\control-x #\control-\c) :mode "Editor")
-(bind-key "Editor Macroexpand Expression" #\control-M :mode "Editor")
-(bind-key "Editor Describe Function Call" #\control-meta-A :mode "Editor")
-(bind-key "Editor Describe Symbol" #\control-meta-S :mode "Editor")
+(bind-key "Confirm Eval Input" #k"return" :mode "Eval")
+(bind-key "Previous Interactive Input" #k"meta-p" :mode "Eval")
+(bind-key "Search Previous Interactive Input" #k"meta-P" :mode "Eval")
+(bind-key "Next Interactive Input" #k"meta-n" :mode "Eval")
+(bind-key "Kill Interactive Input" #k"meta-i" :mode "Eval")
+(bind-key "Abort Eval Input" #k"control-meta-i" :mode "Eval")
+(bind-key "Interactive Beginning of Line" #k"control-a" :mode "Eval")
+(bind-key "Reenter Interactive Input" #k"control-return" :mode "Eval")
+
+(bind-key "Editor Evaluate Expression" #k"control-meta-escape")
+(bind-key "Editor Evaluate Expression" #k"meta-escape"  :mode "Editor")
+(bind-key "Editor Evaluate Defun" #k"control-x control-e" :mode "Editor")
+(bind-key "Editor Compile Defun" #k"control-x control-c" :mode "Editor")
+(bind-key "Editor Compile Defun" #k"control-x control-C" :mode "Editor")
+(bind-key "Editor Macroexpand Expression" #k"control-m" :mode "Editor")
+(bind-key "Editor Describe Function Call" #k"control-meta-A" :mode "Editor")
+(bind-key "Editor Describe Symbol" #k"control-meta-S" :mode "Editor")
 
 
 
 ;;;; Typescript.
 
-(bind-key "Confirm Typescript Input" #\return :mode "Typescript")
-(bind-key "Interactive Beginning of Line" #\control-a :mode "Typescript")
-(bind-key "Kill Interactive Input" #\meta-i :mode "Typescript")
-;(bind-key "Abort Typescript Input" #\control-meta-i :mode "Typescript")
-(bind-key "Previous Interactive Input" #\meta-\p :mode "Typescript")
-(bind-key "Search Previous Interactive Input" #\meta-p :mode "Typescript")
-(bind-key "Next Interactive Input" #\meta-n :mode "Typescript")
-(bind-key "Reenter Interactive Input" #\control-return :mode "Typescript")
-(bind-key "Typescript Slave Break" #\hyper-b :mode "Typescript")
-(bind-key "Typescript Slave to Top Level" #\hyper-g :mode "Typescript")
-(bind-key "Select Slave" #\control-meta-\c)
-(bind-key "Select Background" #\control-meta-C)
+(bind-key "Confirm Typescript Input" #k"return" :mode "Typescript")
+(bind-key "Interactive Beginning of Line" #k"control-a" :mode "Typescript")
+(bind-key "Kill Interactive Input" #k"meta-i" :mode "Typescript")
+(bind-key "Previous Interactive Input" #k"meta-p" :mode "Typescript")
+(bind-key "Search Previous Interactive Input" #k"meta-P" :mode "Typescript")
+(bind-key "Next Interactive Input" #k"meta-n" :mode "Typescript")
+(bind-key "Reenter Interactive Input" #k"control-return" :mode "Typescript")
+(bind-key "Typescript Slave Break" #k"hyper-b" :mode "Typescript")
+(bind-key "Typescript Slave to Top Level" #k"hyper-g" :mode "Typescript")
+(bind-key "Select Slave" #k"control-meta-\c")
+(bind-key "Select Background" #k"control-meta-C")
 
-(bind-key "Abort Operations" #\hyper-a)
-(bind-key "List Operations" #\hyper-l)
+(bind-key "Abort Operations" #k"hyper-a")
+(bind-key "List Operations" #k"hyper-l")
 
-(bind-key "Next Compiler Error" #\hyper-n)
-(bind-key "Previous Compiler Error" #\hyper-p)
+(bind-key "Next Compiler Error" #k"hyper-n")
+(bind-key "Previous Compiler Error" #k"hyper-p")
 
 
 
 ;;;; Lisp (some).
 
-(bind-key "Indent Form" #\control-meta-q)
-(bind-key "Defindent" #\control-meta-\#)
-(bind-key "Beginning of Defun" #\control-meta-[)
-(bind-key "End of Defun" #\control-meta-])
-(bind-key "Beginning of Defun" #\control-meta-\a)
-(bind-key "End of Defun" #\control-meta-e)
-(bind-key "Forward Form" #\control-meta-\f)
-(bind-key "Backward Form" #\control-meta-b)
-(bind-key "Forward List" #\control-meta-n)
-(bind-key "Backward List" #\control-meta-p)
-(bind-key "Transpose Forms" #\control-meta-t)
-(bind-key "Forward Kill Form" #\control-meta-k)
-(bind-key "Backward Kill Form" #\control-meta-backspace)
-(bind-key "Backward Kill Form" #\control-meta-delete)
-(bind-key "Mark Form" #\control-meta-@)
-(bind-key "Mark Defun" #\control-meta-h)
-(bind-key "Insert ()" #\meta-\()
-(bind-key "Move over )" #\meta-\))
-(bind-key "Backward Up List" #\control-meta-\()
-(bind-key "Backward Up List" #\control-meta-u)
-(bind-key "Forward Up List" #\control-meta-\))
-(bind-key "Down List" #\control-meta-d)
-(bind-key "Extract List" #\control-meta-x)
-(bind-key "Lisp Insert )" #\) :mode "Lisp")
-(bind-key "Delete Previous Character Expanding Tabs" #\backspace :mode "Lisp")
-(bind-key "Delete Previous Character Expanding Tabs" #\delete :mode "Lisp")
-
-(bind-key "Evaluate Expression" #\meta-escape)
-(bind-key "Evaluate Defun" '#(#\control-x #\control-e))
-(bind-key "Compile Defun" '#(#\control-x #\control-c))
-(bind-key "Compile Defun" '#(#\control-x #\control-\c))
-(bind-key "Compile Buffer File" '#(#\control-x #\c))
-(bind-key "Compile Buffer File" '#(#\control-x #\C))
-(bind-key "Macroexpand Expression" #\control-M)
-
-(bind-key "Describe Function Call" #\control-meta-A)
-(bind-key "Describe Symbol" #\control-meta-S)
-
-(bind-key "Goto Definition" #\control-meta-F)
+(bind-key "Indent Form" #k"control-meta-q")
+(bind-key "Defindent" #k"control-meta-#")
+(bind-key "Beginning of Defun" #k"control-meta-[")
+(bind-key "End of Defun" #k"control-meta-]")
+(bind-key "Beginning of Defun" #k"control-meta-a")
+(bind-key "End of Defun" #k"control-meta-e")
+(bind-key "Forward Form" #k"control-meta-f")
+(bind-key "Backward Form" #k"control-meta-b")
+(bind-key "Forward List" #k"control-meta-n")
+(bind-key "Backward List" #k"control-meta-p")
+(bind-key "Transpose Forms" #k"control-meta-t")
+(bind-key "Forward Kill Form" #k"control-meta-k")
+(bind-key "Backward Kill Form" #k"control-meta-backspace")
+(bind-key "Backward Kill Form" #k"control-meta-delete")
+(bind-key "Mark Form" #k"control-meta-@")
+(bind-key "Mark Defun" #k"control-meta-h")
+(bind-key "Insert ()" #k"meta-(")
+(bind-key "Move over )" #k"meta-)")
+(bind-key "Backward Up List" #k"control-meta-(")
+(bind-key "Backward Up List" #k"control-meta-u")
+(bind-key "Forward Up List" #k"control-meta-)")
+(bind-key "Down List" #k"control-meta-d")
+(bind-key "Extract List" #k"control-meta-x")
+(bind-key "Lisp Insert )" #k")" :mode "Lisp")
+(bind-key "Delete Previous Character Expanding Tabs" #k"backspace" :mode "Lisp")
+(bind-key "Delete Previous Character Expanding Tabs" #k"delete" :mode "Lisp")
+
+(bind-key "Evaluate Expression" #k"meta-escape")
+(bind-key "Evaluate Defun" #k"control-x control-e")
+(bind-key "Compile Defun" #k"control-x control-c")
+(bind-key "Compile Buffer File" #k"control-x c")
+(bind-key "Macroexpand Expression" #k"control-M")
+
+(bind-key "Describe Function Call" #k"control-meta-A")
+(bind-key "Describe Symbol" #k"control-meta-S")
+
+(bind-key "Goto Definition" #k"control-meta-F")
 
 
 
 ;;;; More Miscellaneous bindings.
 
-(bind-key "Open Line" #\Control-O)
-(bind-key "New Line" #\return)
-
-(bind-key "Transpose Words" #\meta-t)
-(bind-key "Transpose Lines" '#(#\control-x #\control-t))
-(bind-key "Transpose Regions" '#(#\control-x #\t))
-
-(bind-key "Uppercase Region" '#(#\control-x #\control-u))
-(bind-key "Lowercase Region" '#(#\control-x #\control-l))
-
-(bind-key "Delete Indentation" #\meta-^)
-(bind-key "Delete Indentation" #\control-meta-^)
-(bind-key "Delete Horizontal Space" #\meta-\\)
-(bind-key "Delete Blank Lines" '#(#\control-x #\control-o) :global)
-(bind-key "Just One Space" #\meta-\|)
-(bind-key "Back to Indentation" #\meta-m)
-(bind-key "Back to Indentation" #\control-meta-m)
-(bind-key "Indent Rigidly" '#(#\control-x #\tab))
-(bind-key "Indent Rigidly" '#(#\control-x #\control-i))
-
-(bind-key "Indent New Line" #\linefeed)
-(bind-key "Indent" #\tab)
-(bind-key "Indent" #\control-i)
-(bind-key "Indent Region" #\control-meta-\\)
-(bind-key "Quote Tab" #\meta-tab)
-
-(bind-key "Directory" '#(#\control-x #\control-\d))
-(bind-key "Verbose Directory" '#(#\control-x #\control-D))
-
-(bind-key "Activate Region" '#(#\control-x #\control-@))
-(bind-key "Activate Region" '#(#\control-x #\control-space))
-
-(bind-key "Save Position" '#(#\control-x #\s))
-(bind-key "Jump to Saved Position" '#(#\control-x #\j))
-(bind-key "Put Register" '#(#\control-x #\x))
-(bind-key "Get Register" '#(#\control-x #\g))
-
-(bind-key "Delete Previous Character Expanding Tabs" #\backspace :mode "Pascal")
-(bind-key "Delete Previous Character Expanding Tabs" #\delete :mode "Pascal")
-(bind-key "Scribe Insert Bracket" #\) :mode "Pascal")
-(bind-key "Scribe Insert Bracket" #\] :mode "Pascal")
-(bind-key "Scribe Insert Bracket" #\} :mode "Pascal")
+(bind-key "Open Line" #k"Control-o")
+(bind-key "New Line" #k"return")
+
+(bind-key "Transpose Words" #k"meta-t")
+(bind-key "Transpose Lines" #k"control-x control-t")
+(bind-key "Transpose Regions" #k"control-x t"))
+
+(bind-key "Uppercase Region" #k"control-x control-u")
+(bind-key "Lowercase Region" #k"control-x control-l")
+
+(bind-key "Delete Indentation" #k"meta-^")
+(bind-key "Delete Indentation" #k"control-meta-^")
+(bind-key "Delete Horizontal Space" #k"meta-\\")
+(bind-key "Delete Blank Lines" #k"control-x control-o" :global)
+(bind-key "Just One Space" #k"meta-\|")
+(bind-key "Back to Indentation" #k"meta-m")
+(bind-key "Back to Indentation" #k"control-meta-m")
+(bind-key "Indent Rigidly" #k"control-x tab")
+(bind-key "Indent Rigidly" #k"control-x control-i")
+
+(bind-key "Indent New Line" #k"linefeed")
+(bind-key "Indent" #k"tab")
+(bind-key "Indent" #k"control-i")
+(bind-key "Indent Region" #k"control-meta-\\")
+(bind-key "Quote Tab" #k"meta-tab")
+
+(bind-key "Directory" #k"control-x control-\d")
+(bind-key "Verbose Directory" #k"control-x control-D")
+
+(bind-key "Activate Region" #k"control-x control-@")
+(bind-key "Activate Region" #k"control-x control-space")
+
+(bind-key "Save Position" #k"control-x s")
+(bind-key "Jump to Saved Position" #k"control-x j")
+(bind-key "Put Register" #k"control-x x")
+(bind-key "Get Register" #k"control-x g")
+
+(bind-key "Delete Previous Character Expanding Tabs" #k"backspace"
+	  :mode "Pascal")
+(bind-key "Delete Previous Character Expanding Tabs" #k"delete" :mode "Pascal")
+(bind-key "Scribe Insert Bracket" #k")" :mode "Pascal")
+(bind-key "Scribe Insert Bracket" #k"]" :mode "Pascal")
+(bind-key "Scribe Insert Bracket" #k"}" :mode "Pascal")
 
 
 ;;;; Auto Fill Mode.
 
-(bind-key "Fill Paragraph" #\meta-q)
-(bind-key "Fill Region" #\meta-g)
-(bind-key "Set Fill Prefix" '#(#\control-x #\.))
-(bind-key "Set Fill Column" '#(#\control-x #\f))
-(bind-key "Auto Fill Return" #\return :mode "Fill")
-(bind-key "Auto Fill Space" #\space :mode "Fill")
-(bind-key "Auto Fill Linefeed" #\linefeed :mode "Fill")
+(bind-key "Fill Paragraph" #k"meta-q")
+(bind-key "Fill Region" #k"meta-g")
+(bind-key "Set Fill Prefix" #k"control-x ."))
+(bind-key "Set Fill Column" #k"control-x f")
+(bind-key "Auto Fill Return" #k"return" :mode "Fill")
+(bind-key "Auto Fill Space" #k"space" :mode "Fill")
+(bind-key "Auto Fill Linefeed" #k"linefeed" :mode "Fill")
 
 
 
 ;;;; Keyboard macro bindings.
 
-(bind-key "Define Keyboard Macro" '#(#\control-x #\())
-(bind-key "Define Keyboard Macro Key" '#(#\control-x #\meta-\())
-(bind-key "End Keyboard Macro" '#(#\control-x #\)))
-(bind-key "End Keyboard Macro" '#(#\control-x #\hyper-\)))
-(bind-key "Last Keyboard Macro" '#(#\control-x #\e))
-(bind-key "Keyboard Macro Query" '#(#\control-x #\q))
+(bind-key "Define Keyboard Macro" #k"control-x (")
+(bind-key "Define Keyboard Macro Key" #k"control-x meta-(")
+(bind-key "End Keyboard Macro" #k"control-x )")
+(bind-key "End Keyboard Macro" #k"control-x hyper-)")
+(bind-key "Last Keyboard Macro" #k"control-x e")
+(bind-key "Keyboard Macro Query" #k"control-x q")
 
 
 
 ;;;; Spell bindings.
 
-(bind-key "Check Word Spelling" #\meta-$)
-(bind-key "Add Word to Spelling Dictionary" '#(#\control-x #\$))
+(bind-key "Check Word Spelling" #k"meta-$")
+(bind-key "Add Word to Spelling Dictionary" #k"control-x $")
 
-(dolist (c (command-bindings (getstring "Self Insert" *command-names*)))
-  (let ((ch (svref (car c) 0)))
-    (unless (or (alpha-char-p ch) (char= ch #\'))
-      (bind-key "Auto Check Word Spelling" (car c) :mode "Spell"))))
-(bind-key "Auto Check Word Spelling" #\return :mode "Spell")
-(bind-key "Auto Check Word Spelling" #\tab :mode "Spell")
-(bind-key "Auto Check Word Spelling" #\linefeed :mode "Spell")
-(bind-key "Correct Last Misspelled Word" #\meta-\:)
-(bind-key "Undo Last Spelling Correction" '#(#\control-x #\a))
+(dolist (info (command-bindings (getstring "Self Insert" *command-names*)))
+  (let* ((key-event (car info))
+	 (character (key-event-char (svref (car info) 0))))
+    (unless (or (alpha-char-p character) (eq key-event #k"'"))
+      (bind-key "Auto Check Word Spelling" (car info) :mode "Spell"))))
+(bind-key "Auto Check Word Spelling" #k"return" :mode "Spell")
+(bind-key "Auto Check Word Spelling" #k"tab" :mode "Spell")
+(bind-key "Auto Check Word Spelling" #k"linefeed" :mode "Spell")
+(bind-key "Correct Last Misspelled Word" #k"meta-:")
+(bind-key "Undo Last Spelling Correction" #k"control-x a")
 
 
 
 ;;;; Overwrite Mode.
 
-(bind-key "Overwrite Delete Previous Character" #\delete :mode "Overwrite")
-(bind-key "Overwrite Delete Previous Character" #\backspace :mode "Overwrite")
+(bind-key "Overwrite Delete Previous Character" #k"delete" :mode "Overwrite")
+(bind-key "Overwrite Delete Previous Character" #k"backspace" :mode "Overwrite")
 
-;;; do up the printing characters ...
-(do* ((i 33 (1+ i))
-      (char (code-char i) (code-char i)))
-     ((= i 126))
-  (bind-key "Self Overwrite" char :mode "Overwrite"))
+;;; Do up the printing characters ...
+(do ((i 33 (1+ i)))
+    ((= i 126))
+  (let ((key-event (char-key-event (code-char i))))
+    (bind-key "Self Overwrite" key-event :mode "Overwrite")))
 
-(bind-key "Self Overwrite" #\space :mode "Overwrite")
+(bind-key "Self Overwrite" #k"space" :mode "Overwrite")
 
 
 
 ;;;; Comment bindings.
 
-(bind-key "Indent for Comment" #\meta-\;)
-(bind-key "Set Comment Column" '#(#\control-x #\;))
-(bind-key "Kill Comment" #\control-meta-\;)
-(bind-key "Down Comment Line" #\meta-n)
-(bind-key "Up Comment Line" #\meta-p)
-(bind-key "Up Comment Line" #\meta-\p)
-(bind-key "Indent New Comment Line" #\meta-j)
-(bind-key "Indent New Comment Line" #\meta-linefeed)
+(bind-key "Indent for Comment" #k"meta-;")
+(bind-key "Set Comment Column" #k"control-x ;")
+(bind-key "Kill Comment" #k"control-meta-;")
+(bind-key "Down Comment Line" #k"meta-n")
+(bind-key "Up Comment Line" #k"meta-p")
+(bind-key "Indent New Comment Line" #k"meta-j")
+(bind-key "Indent New Comment Line" #k"meta-linefeed")
 
 
 ;;;; Word Abbrev Mode.
 
-(bind-key "Add Mode Word Abbrev" '#(#\Control-X #\Control-A))
-(bind-key "Add Global Word Abbrev" '#(#\Control-X #\+))
-(bind-key "Inverse Add Mode Word Abbrev" '#(#\Control-X #\Control-H))
-(bind-key "Inverse Add Global Word Abbrev" '#(#\Control-X #\-))
+(bind-key "Add Mode Word Abbrev" #k"control-x control-a")
+(bind-key "Add Global Word Abbrev" #k"control-x +")
+(bind-key "Inverse Add Mode Word Abbrev" #k"control-x control-h")
+(bind-key "Inverse Add Global Word Abbrev" #k"control-x \-")
 ;; Removed in lieu of "Pop and Goto Mark".
-;;(bind-key "Abbrev Expand Only" #\meta-space)
-(bind-key "Word Abbrev Prefix Mark" #\meta-\")
-(bind-key "Unexpand Last Word" '#(#\Control-X #\u))
-(bind-key "Unexpand Last Word" '#(#\Control-X #\U))
+;;(bind-key "Abbrev Expand Only" #k"meta-space")
+(bind-key "Word Abbrev Prefix Mark" #k"meta-\"")
+(bind-key "Unexpand Last Word" #k"control-x u")
 
-(dolist (x '(#\! #\~ #\@ #\# #\; #\$ #\% #\^ #\& #\* #\- #\_ #\= #\+ #\[ #\]
-	     #\( #\) #\/ #\| #\: #\' #\" #\{ #\} #\, #\< #\. #\> #\` #\\ #\?
-	     #\return #\newline #\tab #\space))
-  (bind-key "Abbrev Expand Only" x :mode "Abbrev"))
+(dolist (key (list #k"!" #k"~" #k"@" #k"#" #k";" #k"$" #k"%" #k"^" #k"&" #k"*"
+		   #k"\-" #k"_" #k"=" #k"+" #k"[" #k"]" #k"(" #k")" #k"/" #k"|"
+		   #k":" #k"'" #k"\"" #k"{" #k"}" #k"," #k"\<" #k"." #k"\>"
+		   #k"`" #k"\\" #k"?" #k"return" #k"newline" #k"tab" #k"space"))
+  (bind-key "Abbrev Expand Only" key :mode "Abbrev"))
 
 
 
 ;;;; Scribe Mode.
 
-(dolist (ch '(#\] #\) #\} #\>))
-  (bind-key "Scribe Insert Bracket" ch :mode "Scribe"))
+(dolist (key (list #k"]" #k")" #k"}" #k"\>"))
+  (bind-key "Scribe Insert Bracket" key :mode "Scribe"))
 
-(bind-key "Scribe Buffer File" '#(#\control-x #\c) :mode "Scribe")
-(bind-key "Scribe Buffer File" '#(#\control-x #\C) :mode "Scribe")
-(bind-key "Select Scribe Warnings" #\control-meta-C :mode "Scribe")
+(bind-key "Scribe Buffer File" #k"control-x c" :mode "Scribe")
+(bind-key "Select Scribe Warnings" #k"control-meta-C" :mode "Scribe")
 
-(bind-key "Insert Scribe Directive" #\hyper-i :mode "Scribe")
+(bind-key "Insert Scribe Directive" #k"hyper-i" :mode "Scribe")
 
 
 
 ;;;; X commands:
 
-(bind-key "Insert Cut Buffer" #\insert)
-(bind-key "Region to Cut Buffer" #\meta-insert)
+(bind-key "Insert Cut Buffer" #k"insert")
+(bind-key "Region to Cut Buffer" #k"meta-insert")
 
 
 
 ;;;; Mailer commands.
 
-(do-alpha-chars (c :both)
-  (bind-key "Illegal" c :mode "Headers")
-  (bind-key "Illegal" c :mode "Message"))
+(do-alpha-key-events (key-event :both)
+  (bind-key "Illegal" key-event :mode "Headers")
+  (bind-key "Illegal" key-event :mode "Message"))
 
 
 ;;; Global.
 
-(bind-key "Incorporate and Read New Mail" '#(#\control-x #\i))
-(bind-key "Send Message" '#(#\control-x #\m))
-(bind-key "Message Headers" '#(#\control-x #\r))
-(bind-key "Message Headers" '#(#\control-x #\R))
+(bind-key "Incorporate and Read New Mail" #k"control-x i")
+(bind-key "Send Message" #k"control-x m")
+(bind-key "Message Headers" #k"control-x r")
 
 
 ;;; Both Headers and Message modes.
@@ -630,180 +554,169 @@
 ;;; and one for "Headers" mode.
 ;;;
 
-(bind-key "Next Message" #\meta-n :mode "Message")
-(bind-key "Previous Message" #\meta-p :mode "Message")
-(bind-key "Previous Message" #\meta-\p :mode "Message")
-(bind-key "Next Undeleted Message" #\n :mode "Message")
-(bind-key "Previous Undeleted Message" #\p :mode "Message")
-(bind-key "Send Message" #\s :mode "Message")
-(bind-key "Send Message" #\m :mode "Message")
-(bind-key "Forward Message" #\f :mode "Message")
-(bind-key "Headers Delete Message" #\k :mode "Message")
-(bind-key "Headers Undelete Message" #\u :mode "Message")
-(bind-key "Headers Undelete Message" #\U :mode "Message")
-(bind-key "Headers Refile Message" #\o :mode "Message")
-(bind-key "List Mail Buffers" #\l :mode "Message")
-(bind-key "Quit Headers" #\q :mode "Message")
-(bind-key "Incorporate and Read New Mail" #\i :mode "Message")
-(bind-key "Beginning of Buffer" #\< :mode "Message")
-(bind-key "End of Buffer" #\> :mode "Message")
-
-(bind-key "Next Message" #\meta-n :mode "Headers")
-(bind-key "Previous Message" #\meta-p :mode "Headers")
-(bind-key "Previous Message" #\meta-\p :mode "Headers")
-(bind-key "Next Undeleted Message" #\n :mode "Headers")
-(bind-key "Previous Undeleted Message" #\p :mode "Headers")
-(bind-key "Send Message" #\s :mode "Headers")
-(bind-key "Send Message" #\m :mode "Headers")
-(bind-key "Forward Message" #\f :mode "Headers")
-(bind-key "Headers Delete Message" #\k :mode "Headers")
-(bind-key "Headers Undelete Message" #\u :mode "Headers")
-(bind-key "Headers Undelete Message" #\U :mode "Headers")
-(bind-key "Headers Refile Message" #\o :mode "Headers")
-(bind-key "List Mail Buffers" #\l :mode "Headers")
-(bind-key "Quit Headers" #\q :mode "Headers")
-(bind-key "Incorporate and Read New Mail" #\i :mode "Headers")
-(bind-key "Beginning of Buffer" #\< :mode "Headers")
-(bind-key "End of Buffer" #\> :mode "Headers")
+(bind-key "Next Message" #k"meta-n" :mode "Message")
+(bind-key "Previous Message" #k"meta-p" :mode "Message")
+(bind-key "Next Undeleted Message" #k"n" :mode "Message")
+(bind-key "Previous Undeleted Message" #k"p" :mode "Message")
+(bind-key "Send Message" #k"s" :mode "Message")
+(bind-key "Send Message" #k"m" :mode "Message")
+(bind-key "Forward Message" #k"f" :mode "Message")
+(bind-key "Headers Delete Message" #k"k" :mode "Message")
+(bind-key "Headers Undelete Message" #k"u" :mode "Message")
+(bind-key "Headers Refile Message" #k"o" :mode "Message")
+(bind-key "List Mail Buffers" #k"l" :mode "Message")
+(bind-key "Quit Headers" #k"q" :mode "Message")
+(bind-key "Incorporate and Read New Mail" #k"i" :mode "Message")
+(bind-key "Beginning of Buffer" #k"\<" :mode "Message")
+(bind-key "End of Buffer" #k"\>" :mode "Message")
+
+(bind-key "Next Message" #k"meta-n" :mode "Headers")
+(bind-key "Previous Message" #k"meta-p" :mode "Headers")
+(bind-key "Next Undeleted Message" #k"n" :mode "Headers")
+(bind-key "Previous Undeleted Message" #k"p" :mode "Headers")
+(bind-key "Send Message" #k"s" :mode "Headers")
+(bind-key "Send Message" #k"m" :mode "Headers")
+(bind-key "Forward Message" #k"f" :mode "Headers")
+(bind-key "Headers Delete Message" #k"k" :mode "Headers")
+(bind-key "Headers Undelete Message" #k"u" :mode "Headers")
+(bind-key "Headers Refile Message" #k"o" :mode "Headers")
+(bind-key "List Mail Buffers" #k"l" :mode "Headers")
+(bind-key "Quit Headers" #k"q" :mode "Headers")
+(bind-key "Incorporate and Read New Mail" #k"i" :mode "Headers")
+(bind-key "Beginning of Buffer" #k"\<" :mode "Headers")
+(bind-key "End of Buffer" #k"\>" :mode "Headers")
 
 
 ;;; Headers mode.
 
-(bind-key "Delete Message and Down Line" #\d :mode "Headers")
-(bind-key "Delete Message and Down Line" #\D :mode "Headers")
-(bind-key "Pick Headers" #\h :mode "Headers")
-(bind-key "Show Message" #\space :mode "Headers")
-(bind-key "Show Message" #\. :mode "Headers")
-(bind-key "Reply to Message" #\r :mode "Headers")
-(bind-key "Reply to Message" #\R :mode "Headers")
-(bind-key "Expunge Messages" #\! :mode "Headers")
-(bind-key "Headers Help" #\? :mode "Headers")
+(bind-key "Delete Message and Down Line" #k"d" :mode "Headers")
+(bind-key "Pick Headers" #k"h" :mode "Headers")
+(bind-key "Show Message" #k"space" :mode "Headers")
+(bind-key "Show Message" #k"." :mode "Headers")
+(bind-key "Reply to Message" #k"r" :mode "Headers")
+(bind-key "Expunge Messages" #k"!" :mode "Headers")
+(bind-key "Headers Help" #k"?" :mode "Headers")
 
 
 ;;; Message mode.
 
-(bind-key "Delete Message and Show Next" #\d :mode "Message")
-(bind-key "Delete Message and Show Next" #\D :mode "Message")
-(bind-key "Goto Headers Buffer" #\^ :mode "Message")
-(bind-key "Scroll Message" #\space :mode "Message")
-(bind-key "Scroll Message" #\control-v :mode "Message")
-(bind-key "Scroll Window Up" #\backspace :mode "Message")
-(bind-key "Scroll Window Up" #\delete :mode "Message")
-(bind-key "Reply to Message in Other Window" #\r :mode "Message")
-(bind-key "Reply to Message in Other Window" #\R :mode "Message")
-(bind-key "Edit Message Buffer" #\e :mode "Message")
-(bind-key "Insert Message Region" #\hyper-y :mode "Message")
-(bind-key "Message Help" #\? :mode "Message")
+(bind-key "Delete Message and Show Next" #k"d" :mode "Message")
+(bind-key "Goto Headers Buffer" #k"^" :mode "Message")
+(bind-key "Scroll Message" #k"space" :mode "Message")
+(bind-key "Scroll Message" #k"control-v" :mode "Message")
+(bind-key "Scroll Window Up" #k"backspace" :mode "Message")
+(bind-key "Scroll Window Up" #k"delete" :mode "Message")
+(bind-key "Reply to Message in Other Window" #k"r" :mode "Message")
+(bind-key "Edit Message Buffer" #k"e" :mode "Message")
+(bind-key "Insert Message Region" #k"hyper-y" :mode "Message")
+(bind-key "Message Help" #k"?" :mode "Message")
 
 
 ;;; Draft mode.
 
-(bind-key "Goto Headers Buffer" #\hyper-^ :mode "Draft")
-(bind-key "Goto Message Buffer" #\hyper-m :mode "Draft")
-(bind-key "Deliver Message" #\hyper-s :mode "Draft")
-(bind-key "Deliver Message" #\hyper-c :mode "Draft")
-(bind-key "Insert Message Buffer" #\hyper-y :mode "Draft")
-(bind-key "Delete Draft and Buffer" #\hyper-q :mode "Draft")
-(bind-key "List Mail Buffers" #\hyper-l :mode "Draft")
-(bind-key "Draft Help" #\hyper-? :mode "Draft")
+(bind-key "Goto Headers Buffer" #k"hyper-^" :mode "Draft")
+(bind-key "Goto Message Buffer" #k"hyper-m" :mode "Draft")
+(bind-key "Deliver Message" #k"hyper-s" :mode "Draft")
+(bind-key "Deliver Message" #k"hyper-c" :mode "Draft")
+(bind-key "Insert Message Buffer" #k"hyper-y" :mode "Draft")
+(bind-key "Delete Draft and Buffer" #k"hyper-q" :mode "Draft")
+(bind-key "List Mail Buffers" #k"hyper-l" :mode "Draft")
+(bind-key "Draft Help" #k"hyper-?" :mode "Draft")
 
 
 
 ;;;; Process (Shell).
 
-(bind-key "Confirm Process Input" #\return :mode "Process")
-(bind-key "Shell" #\control-meta-\s)
-(bind-key "Interrupt Buffer Subprocess" #\hyper-c :mode "Process")
-(bind-key "Stop Buffer Subprocess" #\hyper-z :mode "Process")
-(bind-key "Quit Buffer Subprocess" #\hyper-\\)
-(bind-key "Send EOF to Process" #\hyper-d)
+(bind-key "Confirm Process Input" #k"return" :mode "Process")
+(bind-key "Shell" #k"control-meta-s")
+(bind-key "Interrupt Buffer Subprocess" #k"hyper-c" :mode "Process")
+(bind-key "Stop Buffer Subprocess" #k"hyper-z" :mode "Process")
+(bind-key "Quit Buffer Subprocess" #k"hyper-\\")
+(bind-key "Send EOF to Process" #k"hyper-d")
 
-(bind-key "Previous Interactive Input" #\meta-\p :mode "Process")
-(bind-key "Search Previous Interactive Input" #\meta-P :mode "Process")
-(bind-key "Interactive Beginning of Line" #\control-a :mode "Process")
-(bind-key "Kill Interactive Input" #\meta-i :mode "Process")
-(bind-key "Next Interactive Input" #\meta-n :mode "Process")
-(bind-key "Reenter Interactive Input" #\control-return :mode "Process")
+(bind-key "Previous Interactive Input" #k"meta-p" :mode "Process")
+(bind-key "Search Previous Interactive Input" #k"meta-P" :mode "Process")
+(bind-key "Interactive Beginning of Line" #k"control-a" :mode "Process")
+(bind-key "Kill Interactive Input" #k"meta-i" :mode "Process")
+(bind-key "Next Interactive Input" #k"meta-n" :mode "Process")
+(bind-key "Reenter Interactive Input" #k"control-return" :mode "Process")
 
 
 
 ;;;; Bufed.
 
-(bind-key "Bufed" '#(#\control-x #\control-meta-b))
-(bind-key "Bufed Delete" #\d :mode "Bufed")
-(bind-key "Bufed Delete" #\D :mode "Bufed")
-(bind-key "Bufed Delete" #\control-d :mode "Bufed")
-(bind-key "Bufed Delete" #\control-\d :mode "Bufed")
-(bind-key "Bufed Undelete" #\u :mode "Bufed")
-(bind-key "Bufed Undelete" #\U :mode "Bufed")
-(bind-key "Bufed Expunge" #\! :mode "Bufed")
-(bind-key "Bufed Quit" #\q :mode "Bufed")
-(bind-key "Bufed Goto" #\space :mode "Bufed")
-(bind-key "Bufed Goto and Quit" #\super-leftdown :mode "Bufed")
-(bind-key "Bufed Save File" #\s :mode "Bufed")
-(bind-key "Next Line" #\n :mode "Bufed")
-(bind-key "Previous Line" #\p :mode "Bufed")
+(bind-key "Bufed" #k"control-x control-meta-b"))
+(bind-key "Bufed Delete" #k"d" :mode "Bufed")
+(bind-key "Bufed Delete" #k"control-d" :mode "Bufed")
+(bind-key "Bufed Undelete" #k"u" :mode "Bufed")
+(bind-key "Bufed Expunge" #k"!" :mode "Bufed")
+(bind-key "Bufed Quit" #k"q" :mode "Bufed")
+(bind-key "Bufed Goto" #k"space" :mode "Bufed")
+(bind-key "Bufed Goto and Quit" #k"super-leftdown" :mode "Bufed")
+(bind-key "Bufed Save File" #k"s" :mode "Bufed")
+(bind-key "Next Line" #k"n" :mode "Bufed")
+(bind-key "Previous Line" #k"p" :mode "Bufed")
 
 
-(bind-key "Bufed Help" #\? :mode "Bufed")
+(bind-key "Bufed Help" #k"?" :mode "Bufed")
 
 
 
 ;;;; Dired.
 
-(bind-key "Dired" '#(#\control-x #\control-meta-\d))
+(bind-key "Dired" #k"control-x control-meta-d"))
 
-(bind-key "Dired Delete File and Down Line" #\d :Mode "Dired")
-(bind-key "Dired Delete File with Pattern" #\D :Mode "Dired")
-(bind-key "Dired Delete File" #\control-\d :Mode "Dired")
-(bind-key "Dired Delete File" #\control-d :Mode "Dired")
-(bind-key "Dired Delete File" #\k :Mode "Dired")
+(bind-key "Dired Delete File and Down Line" #k"d" :mode "Dired")
+(bind-key "Dired Delete File with Pattern" #k"D" :mode "Dired")
+(bind-key "Dired Delete File" #k"control-d" :mode "Dired")
+(bind-key "Dired Delete File" #k"k" :mode "Dired")
 
-(bind-key "Dired Undelete File and Down Line" #\u :Mode "Dired")
-(bind-key "Dired Undelete File with Pattern" #\U :Mode "Dired")
-(bind-key "Dired Undelete File" #\control-u :Mode "Dired")
+(bind-key "Dired Undelete File and Down Line" #k"u" :mode "Dired")
+(bind-key "Dired Undelete File with Pattern" #k"U" :mode "Dired")
+(bind-key "Dired Undelete File" #k"control-u" :mode "Dired")
 
-(bind-key "Dired Expunge Files" #\! :Mode "Dired")
-(bind-key "Dired Update Buffer" #\hyper-u :Mode "Dired")
-(bind-key "Dired View File" #\space :Mode "Dired")
-(bind-key "Dired Edit File" #\e :Mode "Dired")
-(bind-key "Dired Quit" #\q :Mode "Dired")
-(bind-key "Dired Help" #\? :Mode "Dired")
+(bind-key "Dired Expunge Files" #k"!" :mode "Dired")
+(bind-key "Dired Update Buffer" #k"hyper-u" :mode "Dired")
+(bind-key "Dired View File" #k"space" :mode "Dired")
+(bind-key "Dired Edit File" #k"e" :mode "Dired")
+(bind-key "Dired Up Directory" #k"^" :mode "Dired")
+(bind-key "Dired Quit" #k"q" :mode "Dired")
+(bind-key "Dired Help" #k"?" :mode "Dired")
 
-(bind-key "Dired Copy File" #\c :Mode "Dired")
-(bind-key "Dired Copy with Wildcard" #\C :Mode "Dired")
-(bind-key "Dired Rename File" #\r :Mode "Dired")
-(bind-key "Dired Rename with Wildcard" #\R :Mode "Dired")
+(bind-key "Dired Copy File" #k"c" :mode "Dired")
+(bind-key "Dired Copy with Wildcard" #k"C" :mode "Dired")
+(bind-key "Dired Rename File" #k"r" :mode "Dired")
+(bind-key "Dired Rename with Wildcard" #k"R" :mode "Dired")
 
-(bind-key "Next Line" #\n :mode "Dired")
-(bind-key "Previous Line" #\p :mode "Dired")
+(bind-key "Next Line" #k"n" :mode "Dired")
+(bind-key "Previous Line" #k"p" :mode "Dired")
 
 
 
 ;;;; View Mode.
 
-(bind-key "View Scroll Down" #\space :mode "View")
-(bind-key "Scroll Window Up" #\b :mode "View")
-(bind-key "Scroll Window Up" #\backspace :Mode "View")
-(bind-key "Scroll Window Up" #\delete :Mode "View")
-(bind-key "View Return" #\^ :mode "View")
-(bind-key "View Quit" #\q :mode "View")
-(bind-key "View Edit File" #\e :mode "View")
-(bind-key "View Help" #\? :mode "View")
-(bind-key "Beginning of Buffer" #\< :Mode "View")
-(bind-key "End of Buffer" #\> :Mode "View")
+(bind-key "View Scroll Down" #k"space" :mode "View")
+(bind-key "Scroll Window Up" #k"b" :mode "View")
+(bind-key "Scroll Window Up" #k"backspace" :mode "View")
+(bind-key "Scroll Window Up" #k"delete" :mode "View")
+(bind-key "View Return" #k"^" :mode "View")
+(bind-key "View Quit" #k"q" :mode "View")
+(bind-key "View Edit File" #k"e" :mode "View")
+(bind-key "View Help" #k"?" :mode "View")
+(bind-key "Beginning of Buffer" #k"\<" :mode "View")
+(bind-key "End of Buffer" #k"\>" :mode "View")
 
 
 
 ;;;; Lisp Library.
 
 
-(bind-key "Describe Pointer Library Entry" #\leftdown :Mode "Lisp-Lib")
-(bind-key "Load Pointer Library Entry" #\rightdown :Mode "Lisp-Lib")
-(bind-key "Describe Library Entry" #\space :Mode "Lisp-Lib")
-(bind-key "Load Library Entry" #\l :Mode "Lisp-Lib")
-(bind-key "Exit Lisp Library" #\q :Mode "Lisp-Lib")
-(bind-key "Lisp Library Help" #\? :Mode "Lisp-Lib")
+(bind-key "Describe Pointer Library Entry" #k"leftdown" :mode "Lisp-Lib")
+(bind-key "Load Pointer Library Entry" #k"rightdown" :mode "Lisp-Lib")
+(bind-key "Describe Library Entry" #k"space" :mode "Lisp-Lib")
+(bind-key "Load Library Entry" #k"l" :mode "Lisp-Lib")
+(bind-key "Exit Lisp Library" #k"q" :mode "Lisp-Lib")
+(bind-key "Lisp Library Help" #k"?" :mode "Lisp-Lib")
 
 
 
@@ -812,38 +725,43 @@
 (dolist (c (command-bindings (getstring "Self Insert" *command-names*)))
   (bind-key "Completion Self Insert" (car c) :mode "Completion"))
 
-(bind-key "Completion Self Insert" #\Space :mode "Completion")
-(bind-key "Completion Self Insert" #\Tab :mode "Completion")
-(bind-key "Completion Self Insert" #\Return :mode "Completion")
-(bind-key "Completion Self Insert" #\Linefeed :mode "Completion")
+(bind-key "Completion Self Insert" #k"space" :mode "Completion")
+(bind-key "Completion Self Insert" #k"tab" :mode "Completion")
+(bind-key "Completion Self Insert" #k"return" :mode "Completion")
+(bind-key "Completion Self Insert" #k"linefeed" :mode "Completion")
 
-(bind-key "Completion Complete Word" #\End)
-(bind-key "Completion Rotate Completions" #\Meta-End)
+(bind-key "Completion Complete Word" #k"end")
+(bind-key "Completion Rotate Completions" #k"meta-end")
 
 
 
-;;;; Logical characters.
+;;;; Caps-Lock mode.
+
+(do-alpha-key-events (key-event :lower)
+  (bind-key "Self Insert Caps Lock" key-event :mode "CAPS-LOCK"))
 
-(setf (logical-char= #\control-s :forward-search) t)
-(setf (logical-char= #\control-r :backward-search) t)
-(setf (logical-char= #\control-r :recursive-edit) t)
-(setf (logical-char= #\delete :cancel) t)
-(setf (logical-char= #\backspace :cancel) t)
-(setf (logical-char= #\control-g :abort) t)
-(setf (logical-char= #\escape :exit) t)
-(setf (logical-char= #\Y :yes) t)
-(setf (logical-char= #\space :yes) t)
-(setf (logical-char= #\N :no) t)
-(setf (logical-char= #\backspace :no) t)
-(setf (logical-char= #\delete :no) t)
-(setf (logical-char= #\! :do-all) t)
-(setf (logical-char= #\. :do-once) t)
-(setf (logical-char= #\home :help) t)
-(setf (logical-char= #\H :help) t)
-(setf (logical-char= #\? :help) t)
-(setf (logical-char= #\control-_ :help) t)
-(setf (logical-char= #\return :confirm) t)
-(setf (logical-char= #\control-q :quote) t)
-(setf (logical-char= #\K :keep) t)
 
+
+;;;; Logical characters.
 
+(setf (logical-key-event-p #k"control-s" :forward-search) t)
+(setf (logical-key-event-p #k"control-r" :backward-search) t)
+(setf (logical-key-event-p #k"control-r" :recursive-edit) t)
+(setf (logical-key-event-p #k"delete" :cancel) t)
+(setf (logical-key-event-p #k"backspace" :cancel) t)
+(setf (logical-key-event-p #k"control-g" :abort) t)
+(setf (logical-key-event-p #k"escape" :exit) t)
+(setf (logical-key-event-p #k"y" :yes) t)
+(setf (logical-key-event-p #k"space" :yes) t)
+(setf (logical-key-event-p #k"n" :no) t)
+(setf (logical-key-event-p #k"backspace" :no) t)
+(setf (logical-key-event-p #k"delete" :no) t)
+(setf (logical-key-event-p #k"!" :do-all) t)
+(setf (logical-key-event-p #k"." :do-once) t)
+(setf (logical-key-event-p #k"home" :help) t)
+(setf (logical-key-event-p #k"h" :help) t)
+(setf (logical-key-event-p #k"?" :help) t)
+(setf (logical-key-event-p #k"control-_" :help) t)
+(setf (logical-key-event-p #k"return" :confirm) t)
+(setf (logical-key-event-p #k"control-q" :quote) t)
+(setf (logical-key-event-p #k"k" :keep) t)
diff --git a/hemlock/bit-screen.lisp b/hemlock/bit-screen.lisp
index 715a39c60..c6fa137d4 100644
--- a/hemlock/bit-screen.lisp
+++ b/hemlock/bit-screen.lisp
@@ -509,7 +509,7 @@
   (declare (ignore event-key event-window root child same-screen-p root-x
 		   root-y time send-event-p))
   (hunk-process-input hunk
-		      (ext:translate-character
+		      (ext:translate-key-event
 		       (bitmap-device-display (device-hunk-device hunk))
 		       key-code modifiers)
 		      x y))
@@ -521,7 +521,7 @@
   (declare (ignore event-window root child same-screen-p root-x root-y
 		   time send-event-p))
   (hunk-process-input hunk
-		      (ext:translate-mouse-character key-code modifiers
+		      (ext:translate-mouse-key-event key-code modifiers
 						     event-key)
 		      x y))
 ;;;
diff --git a/hemlock/buffer.lisp b/hemlock/buffer.lisp
index bb36a49b7..bf6aa1750 100644
--- a/hemlock/buffer.lisp
+++ b/hemlock/buffer.lisp
@@ -487,7 +487,7 @@
 	       name " Mode."))
       (setq mode (make-mode-object
 		  :variables (make-string-table)
-		  :bindings (make-key-table)
+		  :bindings (make-hash-table)
 		  :hook-name (getstring hook-str *global-variable-names*)))
       (setf (getstring name *mode-names*) mode)))
 
@@ -547,7 +547,7 @@
 			 :%region region
 			 :modes (list (mode-object-name object))
 			 :mode-objects (list object)
-			 :bindings (make-key-table)
+			 :bindings (make-hash-table)
 			 :point (copy-mark (region-end region))
 			 :display-start (copy-mark (region-start region))
 			 :delete-hook delete-hook
diff --git a/hemlock/charmacs.lisp b/hemlock/charmacs.lisp
index aaf6bde2f..8f21fc171 100644
--- a/hemlock/charmacs.lisp
+++ b/hemlock/charmacs.lisp
@@ -32,14 +32,9 @@
 ;;; is a reasonable read-syntax and print-representation for all
 ;;; characters a user might run across.
 
-
-;;; All the meaningful bit names in this implementation.
-;;; 
-(defconstant all-bit-names '(:control :meta :super :hyper))
-
-
+
 ;;;; Stuff for the Syntax table functions (syntax)
-;;;
+
 (defconstant syntax-char-code-limit 128
   "The highest char-code which a character argument to the syntax
   table functions may have.")
@@ -47,7 +42,7 @@
   "Mask we AND with characters given to syntax table functions to blow away
   bits we don't want.")
 (defmacro syntax-char-code (char)
-  `(logand syntax-char-code-mask (char-code ,char)))
+  `(logand syntax-char-code-mask (lisp::%sp-make-fixnum ,char)))
 
 ;;;; Stuff for the command interpreter (interp)
 ;;;
@@ -61,9 +56,10 @@
 (defconstant command-char-bits-limit 16
   "The maximum value of character bits supported for key bindings.")
 (defmacro key-char-bits (char)
-  `(logand (char-bits ,char) #xF))
+  `(ash (logand #x+F00 (lisp::%sp-make-fixnum ,char)) -8))
 (defmacro key-char-code (char)
   `(char-code ,char))
+;;; `(logand #x+7f (lisp::%sp-make-fixnum ,char))) can't use with X scan-codes.
 
 
 ;;;; Stuff used by the searching primitives (search)
@@ -71,7 +67,7 @@
 (defconstant search-char-code-limit 128
   "The exclusive upper bound on significant char-codes for searching.")
 (defmacro search-char-code (ch)
-  `(logand (char-code ,ch) #x+7F))
+  `(logand (lisp::%sp-make-fixnum ,ch) #x+7F))
 ;;;
 ;;;    search-hash-code must be a function with the following properties:
 ;;; given any character it returns a number between 0 and 
@@ -80,97 +76,16 @@
 ;;;    In ASCII this is can be done by ANDing out the 5'th bit.
 ;;;
 (defmacro search-hash-code (ch)
-  `(logand (char-code ,ch) #x+5F))
+  `(logand (lisp::%sp-make-fixnum ,ch) #x+5F))
 
 ;;; Doesn't do anything special, but it should fast and not waste any time
 ;;; checking type and whatnot.
 (defmacro search-char-upcase (ch)
-  `(char-upcase (the string-char ,ch)))
-
-
-;;; Specal RT and Sun keys:
-
-(eval-when (compile load eval)
-
-(push (cons "DELETE" #\delete) lisp::char-name-alist)
-(push (cons "ESCAPE" #\escape) lisp::char-name-alist)
-(push (cons "F1" (code-char 1)) lisp::char-name-alist)
-(push (cons "F2" (code-char 2)) lisp::char-name-alist)
-(push (cons "F3" (code-char 3)) lisp::char-name-alist)
-(push (cons "F4" (code-char 4)) lisp::char-name-alist)
-(push (cons "F5" (code-char 5)) lisp::char-name-alist)
-(push (cons "F6" (code-char 6)) lisp::char-name-alist)
-(push (cons "F7" (code-char 7)) lisp::char-name-alist)
-(push (cons "F8" (code-char 11)) lisp::char-name-alist)
-(push (cons "F9" (code-char 12)) lisp::char-name-alist)
-(push (cons "F10" (code-char 14)) lisp::char-name-alist)
-(push (cons "F11" (code-char 17)) lisp::char-name-alist)
-(push (cons "F12" (code-char 18)) lisp::char-name-alist)
-(push (cons "LEFTARROW" (code-char 19)) lisp::char-name-alist)
-(push (cons "RIGHTARROW" (code-char 20)) lisp::char-name-alist)
-(push (cons "UPARROW" (code-char 22)) lisp::char-name-alist)
-(push (cons "DOWNARROW" (code-char 23)) lisp::char-name-alist)
-(push (cons "LEFTDOWN" (code-char 24)) lisp::char-name-alist)
-(push (cons "MIDDLEDOWN" (code-char 25)) lisp::char-name-alist)
-(push (cons "RIGHTDOWN" (code-char 128)) lisp::char-name-alist)
-(push (cons "LEFTUP" (code-char 129)) lisp::char-name-alist)
-(push (cons "MIDDLEUP" (code-char 130)) lisp::char-name-alist)
-(push (cons "RIGHTUP" (code-char 131)) lisp::char-name-alist)
-(push (cons "INSERT" (code-char 132)) lisp::char-name-alist)
-(push (cons "PRINTSCREEN" (code-char 133)) lisp::char-name-alist)
-(push (cons "PAUSE" (code-char 134)) lisp::char-name-alist)
-(push (cons "HOME" (code-char 135)) lisp::char-name-alist)
-(push (cons "END" (code-char 136)) lisp::char-name-alist)
-(push (cons "PAGEUP" (code-char 137)) lisp::char-name-alist)
-(push (cons "PAGEDOWN" (code-char 138)) lisp::char-name-alist)
-(push (cons "NUMLOCK" (code-char 139)) lisp::char-name-alist)
-(push (cons "F13" (code-char 140)) lisp::char-name-alist)
-(push (cons "F14" (code-char 141)) lisp::char-name-alist)
-(push (cons "F15" (code-char 142)) lisp::char-name-alist)
-(push (cons "F16" (code-char 143)) lisp::char-name-alist)
-(push (cons "F17" (code-char 144)) lisp::char-name-alist)
-(push (cons "F18" (code-char 145)) lisp::char-name-alist)
-(push (cons "F19" (code-char 146)) lisp::char-name-alist)
-(push (cons "F20" (code-char 147)) lisp::char-name-alist)
-(push (cons "F21" (code-char 148)) lisp::char-name-alist)
-(push (cons "F22" (code-char 149)) lisp::char-name-alist)
-(push (cons "F23" (code-char 150)) lisp::char-name-alist)
-(push (cons "F24" (code-char 151)) lisp::char-name-alist)
-(push (cons "F25" (code-char 152)) lisp::char-name-alist)
-(push (cons "F26" (code-char 153)) lisp::char-name-alist)
-(push (cons "F27" (code-char 154)) lisp::char-name-alist)
-(push (cons "F28" (code-char 155)) lisp::char-name-alist)
-(push (cons "F29" (code-char 156)) lisp::char-name-alist)
-(push (cons "F30" (code-char 157)) lisp::char-name-alist)
-(push (cons "F31" (code-char 158)) lisp::char-name-alist)
-(push (cons "F32" (code-char 159)) lisp::char-name-alist)
-(push (cons "F33" (code-char 160)) lisp::char-name-alist)
-(push (cons "F34" (code-char 161)) lisp::char-name-alist)
-(push (cons "F35" (code-char 162)) lisp::char-name-alist)
-;; ALTERNATE key on Sun keyboard.
-(push (cons "BREAK" (code-char 163)) lisp::char-name-alist)
-
-) ;eval-when (compile load eval)
-
-;;; Stick them on the end so that they don't print this way.
-;;; Use two separate EVAL-WHEN forms, so the #\f<13-35> characters can be
-;;; read at this point.
-;;;
-(eval-when (compile load eval)
-(setq lisp::char-name-alist
-      (append lisp::char-name-alist
-	      '(("ENTER" . #\return) ("ACTION" . #\linefeed)
-
-		("L1" . #\F11) ("L2" . #\F12) ("L3" . #\F13) ("L4" . #\F14)
-		("L5" . #\F15) ("L6" . #\F16) ("L7" . #\F17) ("L8" . #\F18)
-		("L9" . #\F19) ("L10" . #\F20)
+  `(lisp::fast-char-upcase ,ch))
 
-		("R1" . #\F21) ("R2" . #\F22) ("R3" . #\F23) ("R4" . #\F24)
-		("R5" . #\F25) ("R6" . #\F26) ("R7" . #\F27) ("R8" . #\F28)
-		("R9" . #\F29) ("R10" . #\F30) ("R11" . #\F31) ("R12" . #\F32)
-		("R13" . #\F33) ("R14" . #\F34) ("R15" . #\F35))))
-) ;eval-when
 
+
+;;;; DO-ALPHA-CHARS.
 
 ;;; ALPHA-CHARS-LOOP loops from start-char through end-char binding var
 ;;; to the alphabetic characters and executing body.  Note that the manual
diff --git a/hemlock/command.lisp b/hemlock/command.lisp
index 2e3675494..d7a34dd2c 100644
--- a/hemlock/command.lisp
+++ b/hemlock/command.lisp
@@ -49,7 +49,7 @@
   "Insert the last character typed.
   With prefix argument insert the character that many times."
   "Implements ``Self Insert'', calling this function is not meaningful."
-  (let ((char (text-character *last-character-typed*)))
+  (let ((char (ext:key-event-char *last-key-event-typed*)))
     (unless char (editor-error "Can't insert that character."))
     (if (and p (> p 1))
 	(insert-string
@@ -60,8 +60,8 @@
 (defcommand "Quoted Insert" (p)
   "Read a character from the terminal and insert it.
   With prefix argument, insert the character that many times."
-  "Reads a character from *editor-input* and inserts it at the point."
-  (let ((char (text-character (read-char *editor-input* nil)))
+  "Reads a key-event from *editor-input* and inserts it at the point."
+  (let ((char (ext:key-event-char (get-key-event *editor-input* t)))
 	(point (current-point)))
     (unless char (editor-error "Can't insert that character."))
     (if (and p (> p 1))
@@ -399,16 +399,17 @@
   (declare (ignore p))
   (clear-echo-area)
   (write-string "C-U " *echo-area-stream*)
-  (let ((char (read-char *editor-input*)))
+  (let* ((key-event (get-key-event *editor-input*))
+	 (char (ext:key-event-char key-event)))
     (multiple-value-call #'universal-argument-loop
       (case (char-code char)
 	(#.(char-code #\-)
 	 (write-char #\- *echo-area-stream*)
-	 (values (read-char *editor-input*) -1))
+	 (values (get-key-event *editor-input*) -1))
 	(#.(char-code #\+) ;Just in case.
 	 (write-char #\+ *echo-area-stream*)
-	 (values (read-char *editor-input*) 1))
-	(t (values char 1))))))
+	 (values (get-key-event *editor-input*) 1))
+	(t (values key-event 1))))))
 
 (defcommand "Negative Argument" (p)
   "This command is equivalent to invoking \"Universal Argument\" and typing
@@ -418,7 +419,7 @@
   (when p (editor-error "Must type minus sign first."))
   (clear-echo-area)
   (write-string "C-U -" *echo-area-stream*)
-  (universal-argument-loop (read-char *editor-input*) -1))
+  (universal-argument-loop (get-key-event *editor-input*) -1))
 
 (defcommand "Argument Digit" (p)
   "This command is equivalent to invoking \"Universal Argument\" and typing
@@ -428,9 +429,9 @@
   (declare (ignore p))
   (clear-echo-area)
   (write-string "C-U " *echo-area-stream*)
-  (universal-argument-loop *last-character-typed* 1))
+  (universal-argument-loop *last-key-event-typed* 1))
 
-(defun universal-argument-loop (char sign &optional (multiplier 1))
+(defun universal-argument-loop (key-event sign &optional (multiplier 1))
   (flet ((prefix (sign multiplier read-some-digit-p result)
 	   ;; read-some-digit-p and (zerop result) are not
 	   ;; equivalent if the user invokes this and types 0.
@@ -438,26 +439,29 @@
 	      (if read-some-digit-p
 		  result
 		  (value universal-argument-default)))))
-    (let* ((display-char (make-char char))
-	   (digit (digit-char-p display-char))
+    (let* ((stripped-key-event (if key-event (ext:make-key-event key-event)))
+	   (char (ext:key-event-char stripped-key-event))
+	   (digit (if char (digit-char-p char)))
 	   (result 0)
 	   (read-some-digit-p nil))
       (loop
 	(cond (digit
 	       (setf read-some-digit-p t)
-	       (write-char display-char *echo-area-stream*)
-	       (setq result (+ digit (* 10 result)))
-	       (setf char (read-char *editor-input*))
-	       (setf display-char (make-char char))
-	       (setf digit (digit-char-p display-char)))
-	      ((or (char= char #\c-u) (char= char #\c-\u))
+	       (write-char char *echo-area-stream*)
+	       (setf result (+ digit (* 10 result)))
+	       (setf key-event (get-key-event *editor-input*))
+	       (setf stripped-key-event (if key-event
+					    (ext:make-key-event key-event)))
+	       (setf char (ext:key-event-char stripped-key-event))
+	       (setf digit (if char (digit-char-p char))))
+	      ((or (eq key-event #k"C-u") (eq key-event #k"C-U"))
 	       (write-string " C-U " *echo-area-stream*)
 	       (universal-argument-loop
-		(read-char *editor-input*) 1
+		(get-key-event *editor-input*) 1
 		(prefix sign multiplier read-some-digit-p result))
 	       (return))
 	      (t
-	       (unread-char char *editor-input*)
+	       (unget-key-event key-event *editor-input*)
 	       (setf (prefix-argument)
 		     (prefix sign multiplier read-some-digit-p result))
 	       (return))))))
diff --git a/hemlock/completion.lisp b/hemlock/completion.lisp
index d47a7e6d5..5d706d2de 100644
--- a/hemlock/completion.lisp
+++ b/hemlock/completion.lisp
@@ -219,7 +219,7 @@
    argument insert the character that many times."
   "Implements \"Completion Self Insert\". Calling this function is not
    meaningful."
-  (let ((char (text-character *last-character-typed*)))
+  (let ((char (ext:key-event-char *last-key-event-typed*)))
     (unless char (editor-error "Can't insert that character."))
     (cond ((completion-char-p char)
 	   ;; If start of word not already in *completion-prefix*, put it 
@@ -328,13 +328,20 @@
 	  (let* ((first (position-if #'alpha-char-p string))
 		 (next (if first (position-if #'alpha-char-p string
 					      :start (1+ first)))))
+	    ;; Often completions start with asterisks when hacking on Lisp
+	    ;; code, so we look for alphabetic characters.
 	    (insert-string point
-			   (cond ((and first (lower-case-p (char string first)))
-				  completion)
-				 ((and next (lower-case-p (char string next)))
-				  (word-capitalize completion))
-				 (t
-				  (string-upcase completion))))))))))
+			   ;; Leave the cascading IF's alone.
+			   ;; Writing this as a COND, using LOWER-CASE-P as
+			   ;; the test is not equivalent to this code since
+			   ;; numbers (and such) are nil for LOWER-CASE-P and
+			   ;; UPPER-CASE-P.
+			   (if (and first (upper-case-p (schar string first)))
+			       (if (and next
+					(upper-case-p (schar string next)))
+				   (string-upcase completion)    
+				   (word-capitalize completion))
+			       completion))))))))
 
 
 ;;; WORD-CAPITALIZE is like STRING-CAPITALIZE except that it treats apostrophes
diff --git a/hemlock/diredcoms.lisp b/hemlock/diredcoms.lisp
index a7ff58aec..6c427ed6b 100644
--- a/hemlock/diredcoms.lisp
+++ b/hemlock/diredcoms.lisp
@@ -64,13 +64,14 @@
      "  Type ? for help.  "))
 
 (defcommand "Dired" (p &optional directory)
-  "Prompt for a directory and edit it.  If a dired for that directory already
+  "Prompts for a directory and edits it.  If a dired for that directory already
    exists, go to that buffer, otherwise create one.  With an argument, include
    UNIX dot files."
-  "Prompt for a directory and edit it.  If a dired for that directory already
+  "Prompts for a directory and edits it.  If a dired for that directory already
    exists, go to that buffer, otherwise create one.  With an argument, include
    UNIX dot files."
-  (let ((info (if directory (value dired-information))))
+  (let ((info (if (hemlock-bound-p 'dired-information)
+		  (value dired-information))))
     (dired-guts nil
 		;; Propagate dot-files property to subdirectory edits.
 		(or (and info (dired-info-dot-files-p info))
@@ -320,6 +321,22 @@
 	(dired-command p (directory-namestring pathname))
 	(editor-error "No pathname associated with buffer."))))
 
+(defcommand "Dired Up Directory" (p)
+  "Invokes \"Dired\" on the directory up one level from the current Dired
+   buffer."
+  "Invokes \"Dired\" on the directory up one level from the current Dired
+   buffer."
+  (declare (ignore p))
+  (unless (hemlock-bound-p 'dired-information)
+    (editor-error "Not in Dired buffer."))
+  (let ((dirs (pathname-directory
+	       (dired-info-pathname (value dired-information)))))
+    (declare (simple-vector dirs))
+    (dired-command nil
+		   (make-pathname
+		    :device :absolute
+		    :directory (subseq dirs 0 (1- (length dirs)))))))
+
 
 
 ;;;; Dired misc. commands -- update, help, line motion.
@@ -417,12 +434,14 @@
 (defcommand "Dired Next File" (p)
   "Moves to next undeleted file."
   "Moves to next undeleted file."
+  (declare (ignore p))
   (unless (dired-line-offset (current-point) (or p 1))
     (editor-error "Not enough lines.")))
 
 (defcommand "Dired Previous File" (p)
   "Moves to previous undeleted file."
   "Moves to next undeleted file."
+  (declare (ignore p))
   (unless (dired-line-offset (current-point) (or p -1))
     (editor-error "Not enough lines.")))
 
diff --git a/hemlock/doccoms.lisp b/hemlock/doccoms.lisp
index 1a937c2d4..a7288b037 100644
--- a/hemlock/doccoms.lisp
+++ b/hemlock/doccoms.lisp
@@ -27,27 +27,27 @@
   (declare (ignore p))
   (command-case (:prompt "Doc (Help for Help): "
 		 :help "Type a Help option to say what kind of help you want:")
-    (#\A "List all commands, variables and attributes Apropos a keyword."
+    (#\a "List all commands, variables and attributes Apropos a keyword."
      (apropos-command nil))
-    (#\D "Describe a command, given its name."
+    (#\d "Describe a command, given its name."
      (describe-command-command nil))
-    (#\G "Generic describe, any Hemlock thing (e.g., variables, keys, attributes)."
+    (#\g "Generic describe, any Hemlock thing (e.g., variables, keys, attributes)."
      (generic-describe-command nil))
-    (#\V "Describe variable and show its values."
+    (#\v "Describe variable and show its values."
      (describe-and-show-variable-command nil))
-    (#\C "Describe the command bound to a Character."
+    (#\c "Describe the command bound to a Character."
      (describe-key-command nil))
-    (#\L "List the last 60 characters typed."
+    (#\l "List the last 60 characters typed."
      (what-lossage-command nil))
-    (#\M "Describe a mode."
+    (#\m "Describe a mode."
      (describe-mode-command nil))
-    (#\P "Describe commands with mouse/pointer bindings."
+    (#\p "Describe commands with mouse/pointer bindings."
      (describe-pointer-command nil))
-    (#\W "Find out Where a command is bound."
+    (#\w "Find out Where a command is bound."
      (where-is-command nil))
-    (#\T "Describe a Lisp object."
+    (#\t "Describe a Lisp object."
      (editor-describe-command nil))
-    ((#\Q :no) "Quits, You don't really want help.")))
+    ((#\q :no) "Quits, You don't really want help.")))
 
 (defcommand "Where Is" (p)
   "Find what key a command is bound to.
@@ -172,8 +172,10 @@
   "Prompt for a sequence of characters.  When the first character is typed that
    terminates a key binding in the current context, describe the command bound
    to it.  When the first character is typed that no longer allows a correct
-   key to be entered, tell the user that this sequence is not bound to anything."
-  "Print out the command documentation for a key which is prompted for."
+   key to be entered, tell the user that this sequence is not bound to
+   anything."
+  "Print out the command documentation for a key
+  which is prompted for."
   (declare (ignore p))
   (let ((old-window (current-window)))
     (unwind-protect
@@ -182,20 +184,21 @@
 	  (hi::display-prompt-nicely "Describe key: " nil)
 	  (setf (fill-pointer hi::*prompt-key*) 0)
 	  (loop
-	    (let ((char (read-char hi::*editor-input*)))
-	      (vector-push-extend char hi::*prompt-key*)
+	    (let ((key-event (get-key-event hi::*editor-input*)))
+	      (vector-push-extend key-event hi::*prompt-key*)
 	      (let ((res (get-command hi::*prompt-key* :current)))
-		(format hi::*echo-area-stream* "~:C " char)
+		(ext:print-pretty-key-event key-event *echo-area-stream*)
+		(write-char #\space *echo-area-stream*)
 		(cond ((commandp res)
 		       (with-pop-up-display (s)
-			 (sub-print-key (copy-seq hi::*prompt-key*) s)
+			 (print-pretty-key (copy-seq hi::*prompt-key*) s)
 			 (format s " is bound to ~S.~%" (command-name res))
 			 (format s "Documentation for this command:~%   ~A"
 				 (command-documentation res)))
 		       (return))
 		      ((not (eq res :prefix))
 		       (with-pop-up-display (s :height 1)
-			 (sub-print-key (copy-seq hi::*prompt-key*) s)
+			 (print-pretty-key (copy-seq hi::*prompt-key*) s)
 			 (write-string " is not bound to anything." s))
 		       (return)))))))
       (setf (current-window) old-window))))
@@ -227,9 +230,9 @@
         (let ((key (car b)))
           (declare (simple-vector key))
 	  (when (dotimes (i (length key) nil)
-		  (when (member (make-char (svref key i))
-				'(#\leftdown #\leftup #\middledown #\middleup
-					     #\rightdown #\rightup))
+		  (when (member (ext:make-key-event (svref key i))
+				(list #k"Leftdown" #k"Leftup" #k"Middledown"
+				      #k"Middleup" #k"Rightdown" #k"Rightup"))
 		    (push cmd result)
 		    (return t)))
 	    (return)))))))
@@ -365,7 +368,7 @@
 		    
 (defun key-to-string (key)
   (with-output-to-string (s)
-    (sub-print-key key s)))
+    (print-pretty-key key s)))
 
 
 
@@ -376,11 +379,11 @@
   "Display the last 60 characters typed."
   (declare (ignore p))
   (with-pop-up-display (s :height 7)
-    (let ((num (ring-length *character-history*)))
+    (let ((num (ring-length *key-event-history*)))
       (format s "The last ~D characters typed:~%" num)
       (do ((i (1- num) (1- i)))
 	  ((minusp i))
-	(print-pretty-character (ring-ref *character-history* i) s)
+	(ext:print-pretty-key-event (ring-ref *key-event-history* i) s)
 	(write-char #\space s)))))
 
 (defun print-command-bindings (bindings stream)
@@ -418,17 +421,6 @@
 (defun print-some-keys (keys stream)
   (do ((key keys (cdr key)))
       ((null (cdr key))
-       (sub-print-key (car key) stream))
-    (sub-print-key (car key) stream)
+       (print-pretty-key (car key) stream))
+    (print-pretty-key (car key) stream)
     (write-string ", " stream)))
-
-;;; SUB-PRINT-KEY writes key on stream as a serious pretty printed characters
-;;; separated by spaces.
-;;;
-(defun sub-print-key (key stream)
-  (declare (simple-vector key))
-  (let ((last (1- (length key))))
-    (dotimes (i last)
-      (print-pretty-character (svref key i) stream)
-      (write-char #\space stream))
-    (print-pretty-character (svref key last) stream)))
diff --git a/hemlock/echo.lisp b/hemlock/echo.lisp
index bea9cacad..47c1e62c6 100644
--- a/hemlock/echo.lisp
+++ b/hemlock/echo.lisp
@@ -12,7 +12,7 @@
 ;;; Written by Skef Wholey and Rob MacLachlan.
 ;;; Modified by Bill Chiles.
 ;;;
-(in-package 'hemlock-internals)
+(in-package "HEMLOCK-INTERNALS")
 (export '(*echo-area-buffer* *echo-area-stream* *echo-area-window*
 	  *parse-starting-mark* *parse-input-region*
 	  *parse-verification-function* *parse-string-tables*
@@ -21,10 +21,10 @@
 	  prompt-for-buffer prompt-for-file prompt-for-integer
 	  prompt-for-keyword prompt-for-expression prompt-for-string
 	  prompt-for-variable prompt-for-yes-or-no prompt-for-y-or-n
-	  prompt-for-character prompt-for-key *logical-character-names*
-	  logical-char= logical-character-documentation
-	  logical-character-name logical-character-characters
-	  define-logical-character *parse-type* current-variable-tables))
+	  prompt-for-key-event prompt-for-key *logical-key-event-names*
+	  logical-key-event-p logical-key-event-documentation
+	  logical-key-event-name logical-key-event-key-events
+	  define-logical-key-event *parse-type* current-variable-tables))
 
 
 (defmode "Echo Area" :major-p t)
@@ -463,43 +463,45 @@
   "Prompts for Y or N."
   (let ((old-window (current-window)))
     (unwind-protect
-      (progn
-       (setf (current-window) *echo-area-window*)
-       (display-prompt-nicely prompt (or default-string
-					 (if defaultp (if default "Y" "N"))))
-       (do ((char (read-char *editor-input*) (read-char *editor-input*)))
-	   (())
-	 (cond ((or (char= char #\y) (char= char #\Y))
-		(return t))
-	       ((or (char= char #\n) (char= char #\N))
-		(return nil))
-	       ((logical-char= char :confirm)
-		(if defaultp
-		    (return default)
-		    (beep)))
-	       ((logical-char= char :help)
-		(ed::help-on-parse-command ()))
-	       (t
-		(unless must-exist (return char))
-		(beep)))))
+	(progn
+	  (setf (current-window) *echo-area-window*)
+	  (display-prompt-nicely prompt (or default-string
+					    (if defaultp (if default "Y" "N"))))
+	  (loop
+	    (let ((key-event (get-key-event *editor-input*)))
+	      (cond ((or (eq key-event #k"y")
+			 (eq key-event #k"Y"))
+		     (return t))
+		    ((or (eq key-event #k"n")
+			 (eq key-event #k"N"))
+		     (return nil))
+		    ((logical-key-event-p key-event :confirm)
+		     (if defaultp
+			 (return default)
+			 (beep)))
+		    ((logical-key-event-p key-event :help)
+		     (ed::help-on-parse-command ()))
+		    (t
+		     (unless must-exist (return key-event))
+		     (beep))))))
       (setf (current-window) old-window))))
 
 
 
-;;;; Character and key prompting.
+;;;; Key-event and key prompting.
 
-(defun prompt-for-character (&key (prompt "Character: ") (change-window t))
-  "Prompts for a character."
-  (prompt-for-character* prompt change-window))
+(defun prompt-for-key-event (&key (prompt "Key-event: ") (change-window t))
+  "Prompts for a key-event."
+  (prompt-for-key-event* prompt change-window))
 
-(defun prompt-for-character* (prompt change-window)
+(defun prompt-for-key-event* (prompt change-window)
   (let ((old-window (current-window)))
     (unwind-protect
-      (progn
-       (when change-window
-	 (setf (current-window) *echo-area-window*))
-       (display-prompt-nicely prompt)
-       (read-char *editor-input* nil))
+	(progn
+	  (when change-window
+	    (setf (current-window) *echo-area-window*))
+	  (display-prompt-nicely prompt)
+	  (get-key-event *editor-input* t))
       (when change-window (setf (current-window) old-window)))))
 
 (defvar *prompt-key* (make-array 10 :adjustable t :fill-pointer 0))
@@ -514,175 +516,177 @@
 			  (format nil "~:C~{ ~:C~}" (car l) (cdr l)))))))
 
     (unwind-protect
-      (progn
-       (setf (current-window) *echo-area-window*)
-       (display-prompt-nicely prompt string)
-       (setf (fill-pointer *prompt-key*) 0)
-       (prog ((key *prompt-key*) char)
-	 (declare (vector key))
-	TOP
-	 (setq char (read-char *editor-input*))
-	 (cond ((logical-char= char :quote)
-		(setq char (read-char *editor-input* nil)))
-	       ((logical-char= char :confirm)
-		(cond ((and default (zerop (length key)))
-		       (let ((res (get-command default :current)))
-			 (unless (commandp res) (go FLAME))
-			 (return (values default res))))
-		      ((and (not must-exist) (plusp (length key)))
-		       (return (copy-seq key)))
-		      (t 
-		       (go FLAME))))
-	       ((logical-char= char :help)
-		(ed::help-on-parse-command ())
+	(progn
+	  (setf (current-window) *echo-area-window*)
+	  (display-prompt-nicely prompt string)
+	  (setf (fill-pointer *prompt-key*) 0)
+	  (prog ((key *prompt-key*) key-event)
+		(declare (vector key))
+		TOP
+		(setf key-event (get-key-event *editor-input*))
+		(cond ((logical-key-event-p key-event :quote)
+		       (setf key-event (get-key-event *editor-input* t)))
+		      ((logical-key-event-p key-event :confirm)
+		       (cond ((and default (zerop (length key)))
+			      (let ((res (get-command default :current)))
+				(unless (commandp res) (go FLAME))
+				(return (values default res))))
+			     ((and (not must-exist) (plusp (length key)))
+			      (return (copy-seq key)))
+			     (t 
+			      (go FLAME))))
+		      ((logical-key-event-p key-event :help)
+		       (ed::help-on-parse-command ())
+		       (go TOP)))
+		(vector-push-extend key-event key)	 
+		(when must-exist
+		  (let ((res (get-command key :current)))
+		    (cond ((commandp res)
+			   (ext:print-pretty-key-event key-event
+						       *echo-area-stream*
+						       t)
+			   (write-char #\space *echo-area-stream*)
+			   (return (values (copy-seq key) res)))
+			  ((not (eq res :prefix))
+			   (vector-pop key)
+			   (go FLAME)))))
+		(print-pretty-key key-event *echo-area-stream* t)
+		(write-char #\space *echo-area-stream*)
+		(go TOP)
+		FLAME
+		(beep)
 		(go TOP)))
-	 (vector-push-extend char key)	 
-	 (when must-exist
-	   (let ((res (get-command key :current)))
-	     (cond ((commandp res) 
-		    (format *echo-area-stream* "~:C " char)
-		    (return (values (copy-seq key) res)))
-		   ((not (eq res :prefix))
-		    (vector-pop key)
-		    (go FLAME)))))
-	 (format *echo-area-stream* "~:C " char)
-	 (go TOP)
-	FLAME
-	 (beep)
-	 (go TOP)))
       (force-output *echo-area-stream*)
       (setf (current-window) old-window))))
 
 
 
-;;;; Logical character stuff.
+;;;; Logical key-event stuff.
 
-(defvar *logical-character-names* (make-string-table)
-  "This variable holds a string-table from logical-character names to the
-  corresponding keywords.")
+(defvar *logical-key-event-names* (make-string-table)
+  "This variable holds a string-table from logical-key-event names to the
+   corresponding keywords.")
 
-(defvar *real-to-logical-characters* (make-hash-table :test #'eql)
-  "A hashtable from real characters to their corresponding logical
-  character keywords.")
+(defvar *real-to-logical-key-events* (make-hash-table :test #'eql)
+  "A hashtable from real key-events to their corresponding logical
+   key-event keywords.")
 
-(defvar *logical-character-descriptors* (make-hash-table :test #'eq)
-  "A hashtable from logical-characters to logical-character-descriptors.")
+(defvar *logical-key-event-descriptors* (make-hash-table :test #'eq)
+  "A hashtable from logical-key-events to logical-key-event-descriptors.")
 
-(defstruct (logical-character-descriptor
-	    (:constructor make-logical-character-descriptor ()))
+(defstruct (logical-key-event-descriptor
+	    (:constructor make-logical-key-event-descriptor ()))
   name
-  characters
+  key-events
   documentation)
 
-;;; Logical-Char=  --  Public
+;;; LOGICAL-KEY-EVENT-P  --  Public
 ;;;
-;;;    Just look up the character in the hashtable.
+(defun logical-key-event-p (key-event keyword)
+  "Return true if key-event has been defined to have Keyword as its
+   logical key-event.  The relation between logical and real key-events
+   is defined by using SETF on LOGICAL-KEY-EVENT-P.  If it is set to
+   true then calling LOGICAL-KEY-EVENT-P with the same key-event and
+   Keyword, will result in truth.  Setting to false produces the opposite
+   result.  See DEFINE-LOGICAL-KEY-EVENT and COMMAND-CASE."
+  (not (null (memq keyword (gethash key-event *real-to-logical-key-events*)))))
+
+;;; GET-LOGICAL-KEY-EVENT-DESC  --  Internal
 ;;;
-(defun logical-char= (character keyword)
-  "Return true if Character has been defined to have Keyword as its
-  logical character.  The relation between logical and real characters
-  is defined by using Setf on Logical-Char=.  If it is set to
-  true then calling Logical-Char= with the same Character and
-  Keyword, will result in truth.  Setting to false produces the opposite
-  result.  See Define-Logical-Character and Command-Case."
-  (not (null (memq keyword (gethash (char-upcase character)
-				    *real-to-logical-characters*)))))
-
-;;; Get-Logical-Char-Desc  --  Internal
-;;;
-;;;    Return the descriptor for the logical character Kwd, or signal
+;;;    Return the descriptor for the logical key-event keyword, or signal
 ;;; an error if it isn't defined.
 ;;;
-(defun get-logical-char-desc (kwd)
-  (let ((res (gethash kwd *logical-character-descriptors*)))
+(defun get-logical-key-event-desc (keyword)
+  (let ((res (gethash keyword *logical-key-event-descriptors*)))
     (unless res
-      (error "~S is not a defined logical-character keyword." kwd))
+      (error "~S is not a defined logical-key-event keyword." keyword))
     res))
 
-;;; %Set-Logical-Char=  --  Internal
+;;; %SET-LOGICAL-KEY-EVENT-P  --  Internal
 ;;;
-;;;    Add or remove a logical character link by adding to or deleting from
+;;;    Add or remove a logical key-event link by adding to or deleting from
 ;;; the list in the from-char hashtable and the descriptor.
 ;;;
-(defun %set-logical-char= (character keyword new-value)
-  (let* ((character (char-upcase character))
-	 (entry (get-logical-char-desc keyword)))
+(defun %set-logical-key-event-p (key-event keyword new-value)
+  (let ((entry (get-logical-key-event-desc keyword)))
     (cond
      (new-value
-      (pushnew keyword (gethash character *real-to-logical-characters*))
-      (pushnew character (logical-character-descriptor-characters entry)))
+      (pushnew keyword (gethash key-event *real-to-logical-key-events*))
+      (pushnew key-event (logical-key-event-descriptor-key-events entry)))
      (t
-      (setf (gethash character *real-to-logical-characters*)
-	    (delete keyword (gethash character *real-to-logical-characters*)))
-      (setf (logical-character-descriptor-characters entry)
-	    (delete keyword (logical-character-descriptor-characters entry))))))
+      (setf (gethash key-event *real-to-logical-key-events*)
+	    (delete keyword (gethash key-event *real-to-logical-key-events*)))
+      (setf (logical-key-event-descriptor-key-events entry)
+	    (delete keyword (logical-key-event-descriptor-key-events entry))))))
   new-value)
 
-;;; Logical-Character-Documentation, Name, Characters  --  Public
+;;; LOGICAL-KEY-EVENT-DOCUMENTATION, NAME, KEY-EVENTS  --  Public
 ;;;
 ;;;    Grab the right field out of the descriptor and return it.
 ;;;
-(defun logical-character-documentation (keyword)
-  "Return the documentation for the logical character Keyword."
-  (logical-character-descriptor-documentation (get-logical-char-desc keyword)))
+(defun logical-key-event-documentation (keyword)
+  "Return the documentation for the logical key-event Keyword."
+  (logical-key-event-descriptor-documentation
+   (get-logical-key-event-desc keyword)))
 ;;;
-(defun logical-character-name (keyword)
-  "Return the string name for the logical character Keyword."
-  (logical-character-descriptor-name (get-logical-char-desc keyword)))
+(defun logical-key-event-name (keyword)
+  "Return the string name for the logical key-event Keyword."
+  (logical-key-event-descriptor-name (get-logical-key-event-desc keyword)))
 ;;;
-(defun logical-character-characters (keyword)
-  "Return the list of characters for which Keyword is the logical character."
-  (logical-character-descriptor-characters (get-logical-char-desc keyword)))
+(defun logical-key-event-key-events (keyword)
+  "Return the list of key-events for which Keyword is the logical key-event."
+  (logical-key-event-descriptor-key-events
+   (get-logical-key-event-desc keyword)))
 
-;;; Define-Logical-Character  --  Public
+;;; DEFINE-LOGICAL-KEY-EVENT  --  Public
 ;;;
 ;;;    Make the entries in the two hashtables and the string-table.
 ;;;
-(defun define-logical-character (name documentation)
-  "Define a logical character having the specified Name and Documentation.
-  See Logical-Char= and Command-Case."
+(defun define-logical-key-event (name documentation)
+  "Define a logical key-event having the specified Name and Documentation.
+  See LOGICAL-KEY-EVENT-P and COMMAND-CASE."
   (check-type name string)
   (check-type documentation (or string function))
   (let* ((keyword (string-to-keyword name))
-	 (entry (or (gethash keyword *logical-character-descriptors*)
-		    (setf (gethash keyword *logical-character-descriptors*)
-			  (make-logical-character-descriptor)))))
-    (setf (logical-character-descriptor-name entry) name)
-    (setf (logical-character-descriptor-documentation entry) documentation)
-    (setf (getstring name *logical-character-names*) keyword)))
+	 (entry (or (gethash keyword *logical-key-event-descriptors*)
+		    (setf (gethash keyword *logical-key-event-descriptors*)
+			  (make-logical-key-event-descriptor)))))
+    (setf (logical-key-event-descriptor-name entry) name)
+    (setf (logical-key-event-descriptor-documentation entry) documentation)
+    (setf (getstring name *logical-key-event-names*) keyword)))
 
 
 
-;;;; Some standard logical-characters:
-
-(define-logical-character "Forward Search"
-  "This character is used to indicate that a forward search should be made.")
-(define-logical-character "Backward Search"
-  "This character is used to indicate that a backward search should be made.")
-(define-logical-character "Recursive Edit"
-  "This character indicates that a recursive edit should be entered.")
-(define-logical-character "Cancel"
-  "This character is used  to cancel a previous character of input.")
-(define-logical-character "Abort"
-  "This character is used to abort the command in progress.")
-(define-logical-character "Exit"
-  "This character is used to exit normally the command in progress.")
-(define-logical-character "Yes"
-  "This character is used to indicate a positive response.")
-(define-logical-character "No"
-  "This character is used to indicate a negative response.")
-(define-logical-character "Do All"
-  "This character means do it as many times as you can.")
-(define-logical-character "Do Once"
-  "This character means, do it this time, then exit.")
-(define-logical-character "Help"
-  "This character is used to ask for help.")
-(define-logical-character "Confirm"
-  "This character is used to confirm some choice.")
-(define-logical-character "Quote"
-  "This character is used to quote the next character of input.")
-(define-logical-character "Keep"
-  "This character means exit but keep something around.")
+;;;; Some standard logical-key-events:
+
+(define-logical-key-event "Forward Search"
+  "This key-event is used to indicate that a forward search should be made.")
+(define-logical-key-event "Backward Search"
+  "This key-event is used to indicate that a backward search should be made.")
+(define-logical-key-event "Recursive Edit"
+  "This key-event indicates that a recursive edit should be entered.")
+(define-logical-key-event "Cancel"
+  "This key-event is used  to cancel a previous key-event of input.")
+(define-logical-key-event "Abort"
+  "This key-event is used to abort the command in progress.")
+(define-logical-key-event "Exit"
+  "This key-event is used to exit normally the command in progress.")
+(define-logical-key-event "Yes"
+  "This key-event is used to indicate a positive response.")
+(define-logical-key-event "No"
+  "This key-event is used to indicate a negative response.")
+(define-logical-key-event "Do All"
+  "This key-event means do it as many times as you can.")
+(define-logical-key-event "Do Once"
+  "This key-event means, do it this time, then exit.")
+(define-logical-key-event "Help"
+  "This key-event is used to ask for help.")
+(define-logical-key-event "Confirm"
+  "This key-event is used to confirm some choice.")
+(define-logical-key-event "Quote"
+  "This key-event is used to quote the next key-event of input.")
+(define-logical-key-event "Keep"
+  "This key-event means exit but keep something around.")
 
 
 
@@ -697,16 +701,18 @@
        (get-output-stream-string s))
     (let ((char (car chars)))
       (if (characterp char)
-	  (print-pretty-character char s)
-	  (do ((chars (logical-character-characters char) (cdr chars)))
-	      ((null chars))
-	    (print-pretty-character (car chars) s)
-	    (unless (null (cdr chars))
+	  (write-char char s)
+	  (do ((key-events
+		(logical-key-event-key-events char)
+		(cdr key-events)))
+	      ((null key-events))
+	    (ext:print-pretty-key (car key-events) s)
+	    (unless (null (cdr key-events))
 	      (write-string ", " s))))
       (unless (null (cdr chars))
 	(write-string ", " s)))))
 
-;;; Command-Case-Help  --  Internal
+;;; COMMAND-CASE-HELP  --  Internal
 ;;;
 ;;;    Print out a help message derived from the options in a
 ;;; random-typeout window.
@@ -721,11 +727,8 @@
 	  ((null o))
 	(let ((string (chars-to-string (caar o))))
 	  (declare (simple-string string))
-	  (cond ((= (length string) 1)
-		 (write-char (char string 0) s)
-		 (write-string "  - " s)
-		 (write-line (cdar o) s))
-		(t
-		 (write-line string s)
-		 (write-string "   - " s)
-		 (write-line (cdar o) s))))))))
+	  (if (= (length string) 1)
+	      (write-char (char string 0) s)
+	      (write-line string s))
+	  (write-string "  - " s)
+	  (write-line (cdar o) s))))))
diff --git a/hemlock/echocoms.lisp b/hemlock/echocoms.lisp
index 47ea1d663..ab47e05fe 100644
--- a/hemlock/echocoms.lisp
+++ b/hemlock/echocoms.lisp
@@ -162,7 +162,8 @@
       (:keyword
        (let ((point (current-point)))
 	 (unless (blank-after-p point)
-	   (insert-character point *last-character-typed*)))
+	   (insert-character point
+			     (ext:key-event-char *last-key-event-typed*))))
        (multiple-value-bind
 	   (prefix key value field ambig)
 	   (complete-string typein *parse-string-tables*)
@@ -173,7 +174,9 @@
 			       (subseq prefix 0 field)
 			       (concatenate 'string
 					    (subseq prefix 0 field)
-					    (string *last-character-typed*)))))
+					    (string
+					     (ext:key-event-char
+					      *last-key-event-typed*))))))
 	   (insert-string (region-start *parse-input-region*) new-typein))))
       (t
        (editor-error "Cannot complete input for this prompt.")))))
@@ -212,6 +215,7 @@
   "Pop the *echo-area-history* ring buffer."
   (let ((length (ring-length *echo-area-history*))
 	(p (or p 1)))
+    (declare (simple-string current))
     (when (zerop length) (editor-error))
     (cond
      ((eq (last-command-type) :echo-history)
diff --git a/hemlock/filecoms.lisp b/hemlock/filecoms.lisp
index e7f76abe0..554a7217a 100644
--- a/hemlock/filecoms.lisp
+++ b/hemlock/filecoms.lisp
@@ -369,13 +369,13 @@
 		     :key #'buffer-pathname :test #'equal)))
     (cond ((not found)
 	   (let* ((name (pathname-to-buffer-name trial-pathname))
-		  (found (getstring name *buffer-names*))
-		  (use (if found
+		  (buffer (getstring name *buffer-names*))
+		  (use (if buffer
 			   (prompt-for-buffer
 			    :prompt "Buffer to use: "
 			    :help
   "Buffer name in use; give another buffer name, or confirm to reuse."
-			    :default found :must-exist nil)
+			    :default buffer :must-exist nil)
 			   (make-buffer name)))
 		  (buffer (if (stringp use) (make-buffer use) use)))
 	     (when (and (buffer-modified buffer)
@@ -429,7 +429,7 @@
 	     (:no
 	      "Change to the buffer without reading the new version."
 	      t)
-	     (#\R
+	     (#\r
 	      "Read in the new version, clobbering the changes in the buffer."
 	      nil)))
 	   (t
@@ -1032,6 +1032,26 @@
       (editor-error "Cannot delete only window")
       (delete-window (next-window (current-window)))))
 
+(defcommand "Go to One Window" (p)
+  "Deletes all windows leaving one with the \"Default Initial Window X\",
+   \"Default Initial Window Y\", \"Default Initial Window Width\", and
+   \"Default Initial Window Height\"."
+  "Deletes all windows leaving one with the \"Default Initial Window X\",
+   \"Default Initial Window Y\", \"Default Initial Window Width\", and
+   \"Default Initial Window Height\"."
+  (declare (ignore p))
+  (let ((win (make-window (window-display-start (current-window))
+			  :ask-user t
+			  :x (value default-initial-window-x)
+			  :y (value default-initial-window-y)
+			  :width (value default-initial-window-width)
+			  :height (value default-initial-window-height))))
+    (setf (current-window) win)
+    (dolist (w *window-list*)
+      (unless (or (eq w win)
+		  (eq w *echo-area-window*))
+	(delete-window w)))))
+
 (defcommand "Line to Center of Window" (p)
   "Moves current line to the center of the window."
   "Moves current line to the center of the window."
diff --git a/hemlock/files.lisp b/hemlock/files.lisp
index 1c94de5aa..14167a352 100644
--- a/hemlock/files.lisp
+++ b/hemlock/files.lisp
@@ -137,6 +137,8 @@
 	  (error "Could not set access code: ~S"
 		 (mach:get-unix-error-msg code)))))))
 
+(proclaim '(special vm_page_size))
+
 (ext:def-c-variable "vm_page_size" int)
 
 (defvar *vm-page-size* (system:alien-access vm_page_size)
diff --git a/hemlock/fill.lisp b/hemlock/fill.lisp
index 6ee99082d..c609f764a 100644
--- a/hemlock/fill.lisp
+++ b/hemlock/fill.lisp
@@ -118,6 +118,7 @@
 (defcommand "Auto Fill Linefeed" (p)
   "Does an immediate CRLF inserting Fill Prefix if it exists."
   "Does an immediate CRLF inserting Fill Prefix if it exists."
+  (declare (ignore p))
   (let ((point (current-point)))
     (check-fill-prefix (value fill-prefix) (value fill-column) point)
     (%auto-fill-space point nil)
@@ -125,7 +126,7 @@
     ;; transparent key bindings are per binding instead of
     ;; per mode.
     (multiple-value-bind (command t-bindings)
-			 (get-command #\linefeed :current)
+			 (get-command #k"Linefeed" :current)
       (declare (ignore command)) ;command is this one, so don't invoke it
       (dolist (c t-bindings) (funcall *invoke-hook* c p)))
     (indent-new-line-command nil)))
@@ -137,6 +138,7 @@
    followed by a newline."
   "Does an Auto Fill Space with a prefix argument of 0
    followed by a newline."
+  (declare (ignore p))
   (let ((point (current-point)))
     (check-fill-prefix (value fill-prefix) (value fill-column) point)
     (%auto-fill-space point nil)
@@ -144,7 +146,7 @@
     ;; transparent key bindings are per binding instead of
     ;; per mode.
     (multiple-value-bind (command t-bindings)
-			 (get-command #\return :current)
+			 (get-command #k"Return" :current)
       (declare (ignore command)) ;command is this one, so don't invoke it
       (dolist (c t-bindings) (funcall *invoke-hook* c p)))
     (new-line-command nil)))
@@ -186,6 +188,7 @@
 (defcommand "Fill Region" (p)
   "Fill text from point to mark."
   "Fill text from point to mark."
+  (declare (ignore p))
   (let* ((region (current-region))
 	 (prefix (value fill-prefix))
 	 (column (if p (abs p) (value fill-column))))
diff --git a/hemlock/gosmacs.lisp b/hemlock/gosmacs.lisp
index d65bc7ddc..056e5dddd 100644
--- a/hemlock/gosmacs.lisp
+++ b/hemlock/gosmacs.lisp
@@ -3,7 +3,7 @@
 ;;;    Stuff in this file provides some degree of upward compatibility
 ;;; for incurable Gosling Emacs users.
 ;;;
-(in-package 'hemlock)
+(in-package "HEMLOCK")
 
 (defcommand "Gosmacs Permute Characters" (p)
   "Transpose the two characters before the point."
@@ -14,11 +14,11 @@
       (editor-error "NIB     You have addressed a character not in the buffer?"))
     (rotatef (previous-character m) (next-character m))))
 
-(bind-key "Gosmacs Permute Characters" #\control-t)
-(bind-key "Kill Previous Word" #\meta-h)
-(bind-key "Replace String" #\meta-r)
-(bind-key "Query Replace" #\meta-q)
-(bind-key "Fill Paragraph" #\meta-j)
-(bind-key "Visit File" '#(#\control-x #\control-r))
-(bind-key "Find File" '#(#\control-x #\control-v))
-(bind-key "Insert File" '#(#\control-x #\control-i))
+(bind-key "Gosmacs Permute Characters" #k"control-t")
+(bind-key "Kill Previous Word" #k"meta-h")
+(bind-key "Replace String" #k"meta-r")
+(bind-key "Query Replace" #k"meta-q")
+(bind-key "Fill Paragraph" #k"meta-j")
+(bind-key "Visit File" #k"control-x control-r")
+(bind-key "Find File" #k"control-x control-v")
+(bind-key "Insert File" #k"control-x control-i")
diff --git a/hemlock/hemlock.log b/hemlock/hemlock.log
index 395487657..e28ad8fb8 100644
--- a/hemlock/hemlock.log
+++ b/hemlock/hemlock.log
@@ -1,3 +1,318 @@
+.../systems-work/hemlock/keysym-defs.lisp, 04-Jul-90 12:14:09, Edit by Chiles.
+  Added a few key-event to character translations at the end of the file to
+  make quoting characters work better when running under X.
+
+/usr2/mbb/lisp/work/diredcoms.lisp, 02-Jul-90 10:12:28, Edit by Mbb.
+  Fixed a bug in "Dired" where it was incorrectly assuming that the current
+  buffer was a DIRED buffer.
+
+.../systems-work/hemlock/searchcoms.lisp, 27-Jun-90 18:27:38, Edit by Chiles.
+.../systems-work/hemlock/kbdmac.lisp, 27-Jun-90 18:19:09, Edit by Chiles.
+  Fixed "Keyboard Macro Query" to realize the :bind arg to COMMAND-CASE is a
+  key-event, not a charcter.
+
+.../systems-work/hemlock/macros.lisp, 27-Jun-90 18:04:12, Edit by Chiles.
+  Fixed COMMAND-CASE to bind key-events, not characters.  It also doesn't make
+  N calls to mapping functions everytime someone was to map one way or the
+  other.  It also no longer makes erroneous assumptions about characters and
+  key-events having a one-to-one mapping.
+
+.../systems-work/hemlock/key-event.lisp, 27-Jun-90 17:34:57, Edit by Chiles.
+  Fixed bugs in character/key-event mapping that allowed bogus typed objects to
+  fall through as if they mapped to meaningful values.
+
+.../systems-work/hemlock/interp.lisp, 26-Jun-90 09:54:52, Edit by Chiles.
+  Fixed some documentation.
+
+  Fixed a bug in KEY-TRANSLATION.  Someone changed a type-spec from '(or
+  simple-vector null) to '(simple-vector null).
+
+  Fixed a bug in TRANSLATE-KEY.  It returned the wrong thing and by accident
+  didn't go into an infinite loop if there were any key translations to
+  multiple key-event keys.
+
+
+.../systems-work/hemlock/echo.lisp, 25-Jun-90 11:44:05, Edit by Chiles.
+  Fixed default prompt of PROMPT-FOR-KEY-EVENT to be "Key-event: ", not
+  "Character: ".
+
+.../systems-work/hemlock/interp.lisp, 24-Jun-90 12:28:02, Edit by Chiles.
+  Removed silly KEYIFY definition, and I put Blaine's name on the file since he
+  modified half of the contents to get the new key tables stuff to work.
+
+.../systems-work/hemlock/input.lisp, 21-Jun-90 19:52:01, Edit by Chiles.
+  Added doc strings to public routines.  Documented some code.  Moved some
+  silly things around.
+
+.../systems-work/hemlock/srccom.lisp, 21-Jun-90 18:53:46, Edit by Chiles.
+.../systems-work/hemlock/spellcoms.lisp, 21-Jun-90 18:52:56, Edit by Chiles.
+.../systems-work/hemlock/macros.lisp, 21-Jun-90 18:51:19, Edit by Chiles.
+.../systems-work/hemlock/filecoms.lisp, 21-Jun-90 18:49:14, Edit by Chiles.
+.../systems-work/hemlock/doccoms.lisp, 21-Jun-90 18:45:55, Edit by Chiles.
+  Made COMMAND-CASE specify lowercase letters.
+
+.../systems-work/hemlock/key-event.lisp, 20-Jun-90 23:11:18, Edit by Chiles.
+  Fixed a bug in TRANSLATE-KEY-EVENT.
+
+.../systems-work/hemlock/bindings.lisp, 20-Jun-90 23:03:22, Edit by Chiles.
+  Bound #k"H-t" to "Illegal" in the echo area.  This is normally bound to a
+  command that makes the current window display the most recently used
+  random-typeout buffer.
+
+.../systems-work/hemlock/macros.lisp, 20-Jun-90 20:45:07, Edit by Chiles.
+  Fixed an extra paren bug that prevented successful compilation.  That's what
+  I get for Blaine's failure to use "Extract Form".
+
+.../systems-work/hemlock/lispmode.lisp, 20-Jun-90 20:47:57, Edit by Chiles.
+  Added "Extract Form", a more useful and intuitive and consistent command to
+  use instead of "Extract List" which is archaic, confusing, erroneously bound
+  by default, and bound to old Lisp ideals that lists are something to focus
+  on.
+
+.../hemlock/ts-buf.lisp, 20-Jun-90 17:40:51, Edit by Wlott.
+  Made typescript commands more robust in light of the possibility of being
+  executed while in a buffer other than the slave buffer.
+
+.../systems-work/hemlock/key-event.lisp, 20-Jun-90 17:00:33, Edit by Chiles.
+  Totally rewrote mouse translation code.  Fixed multiple bugs MAKE-KEY-EVENT.
+
+.../systems-work/hemlock/macros.lisp, 20-Jun-90 13:55:48, Edit by Chiles.
+  Removed :character argument to COMMAND-CASE.  Stopped case-folding and
+  eliminated variables used for that.
+
+.../systems-work/hemlock/fill.lisp, 16-Jun-90 14:07:48, Edit by Chiles.
+  Fixed "Auto Fill Linefeed" and "Auto Fill Return" to use #k syntax instead of
+  characters for keys.
+
+.../systems-work/hemlock/key-event.lisp, 16-Jun-90 13:59:23, Edit by Chiles.
+  Added missing exports.
+
+  Fixed a couple bugs with DEFINE-KEY-EVENT-MODIFIER.  It was using EQL to
+  compare strings.  Stuck an UNWIND-PROTECT in there to keep things consistent.
+  Added restart for already defined modifiers allowing the user to go on
+  blowing it off; this helps reloading the file.
+
+
+.../systems-work/hemlock/echo.lisp, 16-Jun-90 11:11:17, Edit by Chiles.
+  Fixed two GET-KEY-EVENT calls to ignore abort attempts in PROMPT-FOR-KEY
+  and PROMPT-FOR-KEY-EVENT.
+
+.../systems-work/hemlock/keysym-defs.lisp, 15-Jun-90 18:17:38, Edit by Chiles.
+  This file used to be called keytrandefs.lisp.
+
+.../systems-work/hemlock/key-event.lisp, 15-Jun-90 18:34:10, Edit by Chiles.
+  This file used to be called keytran.lisp.  It now implements key-events in
+  the "EXTENSIONS" package.
+
+.../systems-work/hemlock/bit-screen.lisp, 14-Jun-90 14:28:58, Edit by Chiles.
+  Replaced calls to EXT:TRANSLATE-CHARACTER and EXT:TRANSLATE-MOUSE-CHARACTER
+  with EXT:TRANSLATE-KEY-EVENT and EXT:TRANSLATE-MOUSE-KEY-EVENT.
+
+.../systems-work/hemlock/shell.lisp, 15-Jun-90 16:27:42, Edit by Chiles.
+  Picked up Blaine's new shell hacks and documented them.  Added "Current
+  Shell" and "Ask about Old Shells" variables.  Changed "Shell" to be more like
+  "Select Slave" and wrote "Shell Command Line in Buffer".
+
+/usr2/mbb/lisp/work/doccoms.lisp, 14-Jun-90 21:19:46, Edit by Mbb.
+  Made a quoted list of #k mouse-keys be a call to LIST on the mouse-keys
+  instead so they would get evaluated.
+
+/usr2/mbb/lisp/work/input.lisp, 12-Jun-90 21:00:12, Edit by Mbb.
+  input.lisp is a new file.  It contains code to implement input to
+  hemlock.  Similar code previously resided in rompsite.lisp
+
+/usr2/mbb/lisp/work/icom.lisp, 12-Jun-90 16:15:00, Edit by Mbb.
+/usr2/mbb/lisp/work/gosmacs.lisp, 12-Jun-90 16:15:00, Edit by Mbb.
+  Changed BIND-KEY calls to use #k format instead of characters.
+
+.../systems-work/hemlock/filecoms.lisp, 13-Jun-90 15:17:06, Edit by Chiles.
+  Wrote "Go to One Window" which makes a default initial window and deletes all
+  other windows.  This is useful with losing window managers like twm, and it
+  is useful in case you ever resize or move the main Hemlock window which
+  happens by accident to some people.
+
+/usr2/mbb/lisp/work/keytran.lisp, 13-Jun-90 14:01:58, Edit by Mbb.
+  Changed all the BIND-KEY forms in this file to use #k format.
+
+/usr2/mbb/lisp/work/files.lisp, 12-Jun-90 10:26:58, Edit by Mbb.
+  Inserted the form (proclaim '(special vm_page_size)) so the compiler
+  wouldn't whine about vm_page_size not being declared or bound. 
+
+/usr2/mbb/lisp/work/buffer.lisp, 11-Jun-90 11:58:39, Edit by Mbb.
+  Modified DEFMODE -- The default mode-bindings slot is now a hash-table
+  whereas it used to be a key-table.  Did the same for buffer-bindings in
+  MAKE-BUFFER.
+
+/usr2/mbb/lisp/work/keytrandefs.lisp, 11-Jun-90 13:17:59, Edit by Mbb.
+  Made all calls to "EXTENSIONS" use an ext: prefix.
+
+/usr2/mbb/lisp/work/scribe.lisp, 08-Jun-90 17:33:31, Edit by Mbb.
+/usr2/mbb/lisp/work/register.lisp, 08-Jun-90 17:29:23, Edit by Mbb.
+/usr2/mbb/lisp/work/interp.lisp, 08-Jun-90 17:27:44, Edit by Mbb.
+  Changed all calls to PRINT-PRETTY-CHARACTER to calls to
+  PRINT-PRETTY-KEY-EVENT. 
+
+/usr2/mbb/lisp/work/kbdmac.lisp, 08-Jun-90 17:25:50, Edit by Mbb.
+  Made all calls to SUB-PRINT-KEY be calls to PRINT-PRETTY-KEY.
+
+/usr2/mbb/lisp/work/doccoms.lisp, 08-Jun-90 17:15:46, Edit by Mbb.
+  Removed SUB-PRINT-KEY in favor of PRINT-PRETTY-KEY.
+
+/usr2/mbb/lisp/work/searchcoms.lisp, 08-Jun-90 14:38:55, Edit by Mbb.
+/usr2/mbb/lisp/work/overwrite.lisp, 08-Jun-90 14:38:38, Edit by Mbb.
+/usr2/mbb/lisp/work/morecoms.lisp, 08-Jun-90 14:37:43, Edit by Mbb.
+/usr2/mbb/lisp/work/completion.lisp, 08-Jun-90 14:37:10, Edit by Mbb.
+/usr2/mbb/lisp/work/command.lisp, 08-Jun-90 14:36:12, Edit by Mbb.
+  Changed all calls to TEXT-CHARACTER to calls to KEY-EVENT-CHAR.
+
+/usr2/mbb/lisp/work/rompsite.lisp, 08-Jun-90 12:15:17, Edit by Mbb.
+/usr2/mbb/lisp/work/termcap.lisp, 08-Jun-90 12:15:17, Edit by Mbb.
+  Commented out CL-TERMCAP-CHAR as it is no longer needed.  
+  GET-TERMCAP-STRING-CHAR does the conversion to a character now.
+
+/usr2/mbb/lisp/work/doccoms.lisp, 08-Jun-90 11:08:09, Edit by Mbb.
+  Removed from GET-MOUSE-COMMANDS a call to MAKE-CHAR in favor of
+  MAKE-KEY-EVENT and also fixed a list to use the new #k"foo" format.
+
+/usr2/mbb/lisp/work/bindings.lisp, 08-Jun-90 10:44:49, Edit by Mbb.
+  Chnaged all bindings to #k"foo" format.
+
+/usr2/mbb/lisp/work/charmacs.lisp, 07-Jun-90 14:44:36, Edit by Mbb.
+  Removed the declaration of the constant all-bit-names, as bit names are
+  no longer supported in Common Lisp.
+
+/usr2/mbb/lisp/work/charmacs.lisp, 07-Jun-90 14:41:23, Edit by Mbb.
+  Changed ALPHA-CHAR-LOOP and DO-ALPHA-CHARS to ALPHA-KEY-EVENTS-LOOP and
+  DO-ALPHA-KEY-EVENTS respectively.
+
+/usr2/mbb/lisp/work/tty-display.lisp, 06-Jun-90 10:38:07, Edit by Mbb.
+/usr2/mbb/lisp/work/searchcoms.lisp, 06-Jun-90 10:36:39, Edit by Mbb.
+/usr2/mbb/lisp/work/searchcoms.lisp, 06-Jun-90 10:21:58, Edit by Mbb.
+/usr2/mbb/lisp/work/rompsite.lisp, 06-Jun-90 10:09:11, Edit by Mbb.
+/usr2/mbb/lisp/work/morecoms.lisp, 06-Jun-90 10:16:52, Edit by Mbb.
+/usr2/mbb/lisp/work/mh.lisp, 06-Jun-90 10:14:12, Edit by Mbb.
+/usr2/mbb/lisp/work/doccoms.lisp, 06-Jun-90 10:04:45, Edit by Mbb.
+/usr2/mbb/lisp/work/macros.lisp, 05-Jun-90 15:11:03, Edit by Mbb.
+/usr2/mbb/lisp/work/kbdmac.lisp, 05-Jun-90 15:08:37, Edit by Mbb.
+/usr2/mbb/lisp/work/interp.lisp, 05-Jun-90 11:02:59, Edit by Mbb.
+/usr2/mbb/lisp/work/echo.lisp, 05-Jun-90 10:58:55, Edit by Mbb.
+/usr2/mbb/lisp/work/doccoms.lisp, 05-Jun-90 15:05:40, Edit by Mbb.
+/usr2/mbb/lisp/work/command.lisp, 05-Jun-90 15:02:21, Edit by Mbb.
+  Fixed all references to *editor-input*.
+
+/usr2/mbb/lisp/work/main.lisp, 06-Jun-90 10:07:41, Edit by Mbb.
+  *editor-input* used to be exported from this file, event though it is
+  also exported in input.lisp.  Removed export from main.lisp.
+
+/usr2/mbb/lisp/work/rompsite.lisp, 05-Jun-90 14:31:55, Edit by Mbb.
+  Changed reference to *character-history* in SITE-INIT to
+  *key-event-history*.
+
+/usr2/mbb/lisp/work/mh.lisp, 05-Jun-90 14:30:28, Edit by Mbb.
+  Changed a reference to *character-history* to *key-event-history*.
+
+/usr2/mbb/lisp/work/main.lisp, 05-Jun-90 14:27:23, Edit by Mbb.
+  Removed export of *character-history* from this file in favor of putting
+  it in input.lisp and changing the name to *key-event-history*.
+
+/usr2/mbb/lisp/work/doccoms.lisp, 05-Jun-90 14:19:41, Edit by Mbb.
+  Made "What Lossage" command reference *key-event-history* instead of
+  *character-history*.
+
+/usr2/mbb/lisp/work/streams.lisp, 05-Jun-90 14:10:43, Edit by Mbb.
+  Made KBDMAC-GET use *last-key-event-typed* instead of
+  *last-character-typed*.  Also changed stream definition of kbdmac-stream
+  to coincide with the new editor-input like streams.
+
+/usr2/mbb/lisp/work/spellcoms.lisp, 05-Jun-90 14:08:57, Edit by Mbb.
+  Made SUB-CORRECT-LAST-MISSPELLED-WORD work with *last-key-event-typed*.
+
+/usr2/mbb/lisp/work/scribe.lisp, 05-Jun-90 14:07:23, Edit by Mbb.
+  Fixed "Scribe Insert bracket" to work with *last-key-event-typed*.
+
+/usr2/mbb/lisp/work/rompsite.lisp, 05-Jun-90 13:59:46, Edit by Mbb.
+  Removed all Input queue management and Random Typeout input routines and
+  put them in a input.lisp, a new hemlock file.
+
+/usr2/mbb/lisp/work/rompsite.lisp, 05-Jun-90 13:45:23, Edit by Mbb.
+  Changed DEFVAR of *last-character-typed* to *last-key-event-typed*.  Also
+  fixed setting of *last-character-typed* in DQ-EVENT.  For some reason,
+  *last-character-typed* was exported from both main.lisp and
+  rompsite.lisp.  This remains under the new name.
+
+/usr2/mbb/lisp/work/overwrite.lisp, 05-Jun-90 13:43:23, Edit by Mbb.
+  Made "Self Overwrite" use *last-key-event-typed* instead of
+  *last-character-typed*.
+
+/usr2/mbb/lisp/work/morecoms.lisp, 05-Jun-90 13:41:58, Edit by Mbb.
+  Made "Self Insert Caps Lock" deal with *last-key-event-typed* instead of
+  *last-character-typed*.
+
+/usr2/mbb/lisp/work/main.lisp, 05-Jun-90 13:40:48, Edit by Mbb.
+  Changed export of *last-character-typed* to *last-key-event-typed*.
+
+/usr2/mbb/lisp/work/kbdmac.lisp, 05-Jun-90 13:37:38, Edit by Mbb.
+  Made DEFAULT-KBDMAC-TRANSFORM and SELF-INSERT-KBDMAC-TRANSFORM use
+  *last-key-event-typed* instead of *last-character-typed*.
+
+/usr2/mbb/lisp/work/echocoms.lisp, 05-Jun-90 13:34:52, Edit by Mbb.
+  Made "Complete Field" work with *last-key-event-typed*.
+/usr2/mbb/lisp/work/completion.lisp, 05-Jun-90 13:28:07, Edit by Mbb.
+  Made "Completion Self Insert" deal with *last-key-event-typed* instead of
+  *last-character-typed*.
+
+/usr2/mbb/lisp/work/command.lisp, 05-Jun-90 13:24:55, Edit by Mbb.
+  Changed UNIVERSAL-ARGUMENT-LOOP to deal with *last-key-event-typed*
+  instead of *last-character-typed*.  Also made "Self Insert" do the same.
+
+/usr2/mbb/lisp/work/spellcoms.lisp, 05-Jun-90 12:58:02, Edit by Mbb.
+  Changed calls to PROMPT-FOR-CHARACTER to calls to PROMPT-FOR-KEY-EVENT.
+  Since what we wanted was the number of the correction choice, simply wrap
+  a call to KEY-EVENT-CHAR around the PROMPT-FOR-KEY-EVENT.
+
+/usr2/mbb/lisp/work/scribe.lisp, 05-Jun-90 11:59:46, Edit by Mbb.
+  Made ADD-SCRIBE-DIRECTIVE and INSERT-SCRIBE-DIRECTIVE use PROMPT-FOR-KEY
+  instead of PROMPT-FOR-CHARACTER.  They used to HASH on the result of
+  PROMPT-FOR-CHARACTER, so key-events will work just as well.
+
+/usr2/mbb/lisp/work/scribe.lisp, 05-Jun-90 11:59:46, Edit by Mbb.
+  Changed all top-level ADD-SCRIBE-DIRECTIVE-COMMAND calls to use #k syntax
+  when binding dispatches.
+
+/usr2/mbb/lisp/work/struct.lisp, 05-Jun-90 11:08:20, Edit by Mbb.
+  Changed DEFSETF for %SET-LOGICAL-CHAR= to %SET-LOGICAL-KEY-EVENT-P in
+  order to maintain consistency.
+
+/usr2/mbb/lisp/work/macros.lisp, 05-Jun-90 09:23:41, Edit by Mbb.
+  Fixed COMMAND-CASE to bind key-events instead of characters.
+
+/usr2/mbb/lisp/work/register.lisp, 05-Jun-90 09:31:41, Edit by Mbb.
+  Made PROMPT-FOR-REGISTER return a key-event instead of a character.  The
+  rest of the code code just hashes on what PROMPT-FOR-REGISTER returns, so
+  since key-events are unique, nothing else had to be changed.
+
+/usr2/mbb/lisp/work/keytrandefs.lisp, 04-Jun-90 13:16:13, Edit by Mbb.
+  Completely changed this file to conform to new key syntax.
+
+/usr2/mbb/lisp/work/charmacs.lisp, 04-Jun-90 13:10:55, Edit by Mbb.
+  Removed all pushes into lisp::char-name-alist.
+
+.../systems-work/hemlock/completion.lisp, 29-May-90 13:54:48, Edit by Chiles.
+  Changed test in DO-COMPLETION to explicitly test for uppercase characters.
+  Testing for lowercase characters caused ID's to be uppercased when they began
+  with non-alphabetic characters (such as digit-chars).
+
+.../systems-work/hemlock/bindings.lisp, 21-May-90 10:22:28, Edit by Chiles.
+.../systems-work/hemlock/morecoms.lisp, 21-May-90 10:19:13, Edit by Chiles.
+  Added "CAPS-LOCK" mode, "Caps Lock Mode" and "Caps Lock Self Insert".
+
+  Added bindings for lowercase letters.
+
+
+.../systems-work/hemlock/bindings.lisp, 21-May-90 10:14:10, Edit by Chiles.
+.../systems-work/hemlock/diredcoms.lisp, 21-May-90 10:03:16, Edit by Chiles.
+  Wrote "Dired Up Directory" and added binding to #\^ in "Dired" mode.
+
 .../systems-work/hemlock/diredcoms.lisp, 08-May-90 15:38:28, Edit by Chiles.
   Fixed :help string in file prompt for "Delete File".
 
diff --git a/hemlock/icom.lisp b/hemlock/icom.lisp
index e74acd50f..a5a106466 100644
--- a/hemlock/icom.lisp
+++ b/hemlock/icom.lisp
@@ -62,4 +62,4 @@
      1
      :left-inserting)))
 
-(bind-key "Start Italic Comment" #\; :mode "Italic")
+(bind-key "Start Italic Comment" #k";" :mode "Italic")
diff --git a/hemlock/interp.lisp b/hemlock/interp.lisp
index 194b4018a..2cbbb2037 100644
--- a/hemlock/interp.lisp
+++ b/hemlock/interp.lisp
@@ -8,7 +8,7 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-;;;    Written by Rob MacLachlan
+;;; Written by Rob MacLachlan and Blaine Burks.
 ;;;
 ;;; This file contains the routines which define hemlock commands and
 ;;; the command interpreter.
@@ -32,64 +32,37 @@
 ;;;; Key Tables:
 ;;;
 ;;;    A key table provides a way to translate a sequence of characters to some
-;;; lisp object.  It is currently represented by a tree of vectors, with
-;;; alternating levels being indexed by the bits and code.  We wrap a Key-Table
-;;; structure around the table so that we can discriminate bewteen a key table
-;;; and a value.
-;;; 
+;;; lisp object.  It is currently represented by a tree of hash-tables, where
+;;; each level is a hashing from a key to either another hash-table or a value.
 
-(defstruct (key-table
-	    (:print-function
-	     (lambda (x stream y)
-	       (declare (ignore x y))
-	       (write-string "#<Key-Table>" stream))))
-  (table (make-array command-char-bits-limit :initial-element nil)
-	 :type simple-vector)) 
 
-
-;;; GET-TABLE-ENTRY  --  Internal
-;;;
-;;;   Return the value found by walking down a tree of command tables as
-;;; specified by a key.  If no such entry return NIL.
+;;; GET-TABLE-ENTRY returns the value at the end of a series of hashings.  For
+;;; our purposes it is presently used to look up commands and key-translations.
 ;;;
 (defun get-table-entry (table key)
-  (let ((current table))
-    (dotimes (i (length key) current)
-      (unless (key-table-p current) (return nil))
-      (let* ((char (aref key i))
-	     (bits-vec (key-table-table current))
-	     (code-vec (svref bits-vec (key-char-bits char))))
-	(unless code-vec (return nil))
-	(setq current (svref code-vec (key-char-code char)))))))
-
+  (let ((foo nil))
+    (dotimes (i (length key) foo)
+      (let ((key-event (aref key i)))
+	(setf foo (gethash key-event table))
+	(unless (hash-table-p foo) (return foo))
+	(setf table foo)))))
 
-;;; SET-TABLE-ENTRY  --  Internal
-;;;
-;;;    Set the entry for Key in Table to Val, creating new key tables as
-;;; needed.
+;;; SET-TABLE-ENTRY sets the entry for key in table to val, creating new
+;;; tables as needed.  If val is nil, then use REMHASH to remove this element
+;;; from the hash-table.
 ;;;
 (defun set-table-entry (table key val)
-  (do ((keylast (1- (length key)))
-       (index 0 (1+ index))
-       (current table))
-      (())
-    (let* ((char (aref key index))
-	   (bits (key-char-bits char))
-	   (code (key-char-code char))
-	   (bits-vec (key-table-table current))
-	   (code-vec (or (svref bits-vec bits)
-			 (setf (svref bits-vec bits)
-			       (make-array command-char-code-limit
-					   :initial-element nil))))
-	   (next (svref code-vec code)))
-      (cond ((= index keylast)
-	     (setf (svref code-vec code) val)
-	     (return val))
-	    ((key-table-p next)
-	     (setq current next))
-	    (t
-	     (setq current (make-key-table))
-	     (setf (svref code-vec code) current))))))
+  (dotimes (i (1- (length key)))
+    (let* ((key-event (aref key i))
+	   (foo (gethash key-event table)))
+      (if (hash-table-p foo)
+	  (setf table foo)
+	  (let ((new-table (make-hash-table)))
+	    (setf (gethash key-event table) new-table)
+	    (setf table new-table)))))
+  (if (null val)
+      (remhash (aref key (1- (length key))) table)
+      (setf (gethash (aref key (1- (length key))) table) val)))
 
 
 ;;;; Key Translation:
@@ -98,7 +71,7 @@
 ;;; integer, then it is prefix bits to be OR'ed with the next character.  If it
 ;;; is a key, then we translate to that key.
 
-(defvar *key-translations* (make-key-table))
+(defvar *key-translations* (make-hash-table))
 (defvar *translate-key-temp* (make-array 10 :fill-pointer 0 :adjustable t))
 
 
@@ -110,7 +83,8 @@
 ;;; key ends in the prefix of a translation, we just return that part
 ;;; untranslated and return the second value true.
 ;;;
-(defun translate-key (key &optional (result (make-array 4 :fill-pointer 0
+(defun translate-key (key &optional (result (make-array (length key)
+							:fill-pointer 0
 							:adjustable t)))
   (let ((key-len (length key))
 	(temp *translate-key-temp*)
@@ -121,83 +95,75 @@
     (setf (fill-pointer result) 0)
     (loop
       (when (= try-pos key-len) (return))
-      (let ((ch (aref key try-pos)))
-	(vector-push-extend (make-char ch (logior (char-bits ch) prefix))
-			    temp)
-	(setq prefix 0))
+      (let ((key-event (aref key try-pos)))
+	(vector-push-extend
+	 (ext:make-key-event key-event (logior (ext:key-event-bits key-event)
+					       prefix))
+	 temp)
+	(setf prefix 0))
       (let ((entry (get-table-entry *key-translations* temp)))
-	(unless (key-table-p entry)
-	  (etypecase entry
-	    (null
-	     (vector-push-extend (aref temp 0) result)
-	     (incf start))
-	    (simple-vector
-	     (dotimes (i (length entry))
-	       (vector-push-extend (aref entry i) result))
-	     (setq start (1+ try-pos)))
-	    (integer
-	     (setq start (1+ try-pos))
-	     (when (= start key-len) (return))
-	     (setq prefix (logior entry prefix))))
-	  (setq try-pos start)
-	  (setf (fill-pointer temp) 0))))
-
+	(cond ((hash-table-p entry)
+	       (incf try-pos))
+	      (t
+	       (etypecase entry
+		 (null
+		  (vector-push-extend (aref temp 0) result)
+		  (incf start))
+		 (simple-vector
+		  (dotimes (i (length entry))
+		    (vector-push-extend (aref entry i) result))
+		  (setf start (1+ try-pos)))
+		 (integer
+		  (setf start (1+ try-pos))
+		  (when (= start key-len) (return))
+		  (setf prefix (logior entry prefix))))
+	       (setq try-pos start)
+	       (setf (fill-pointer temp) 0)))))
     (dotimes (i (length temp))
       (vector-push-extend (aref temp i) result))
     (values result (not (zerop (length temp))))))
 
 
-;;; KEY-TRANSLATION  --  Public
-;;;
-;;;    Set the value, dealing with translating to and from symbolic bit names. 
+;;; KEY-TRANSLATION -- Public.
 ;;;
 (defun key-translation (key)
   "Return the key translation for Key, or NIL if there is none.  If Key is a
-  prefix of a translation, then :Prefix is returned.  Whenever Key appears as a
-  subsequence of a key argument to the binding manipulation functions, that
-  portion will be replaced with the translation.  A key translation may also be
-  a list (:Bits {Bit-Name}*).  In this case, the named bits will be set in the
-  next character in the key being translated."
+   prefix of a translation, then :Prefix is returned.  Whenever Key appears as a
+   subsequence of a key argument to the binding manipulation functions, that
+   portion will be replaced with the translation.  A key translation may also be
+   a list (:Bits {Bit-Name}*).  In this case, the named bits will be set in the
+   next character in the key being translated."
   (let ((entry (get-table-entry *key-translations* (crunch-key key))))
     (etypecase entry
-      (key-table :prefix)
+      (hash-table :prefix)
       ((or simple-vector null) entry)
       (integer
-       (let ((ch (make-char #\? entry))
-	     (res ()))
-	 (dolist (bit all-bit-names)
-	   (when (char-bit ch bit)
-	     (push bit res)))
-	 (cons :bits res))))))
-
-(defsetf key-translation %set-key-translation
-  "Set the key translation for a key.  If set to null, deletes any
-  translation.")
+       (cons :bits (ext:key-event-bits-modifiers entry))))))
 
 ;;; %SET-KEY-TRANSLATION  --  Internal
 ;;;
-;;;    Setf inverse for Key-Translation.
-;;;
 (defun %set-key-translation (key new-value)
-  (let ((entry (cond ((and (consp new-value) (eq (first new-value) :bits))
-		      (let ((res #\?))
-			(dolist (bit (rest new-value) (char-bits res))
-			  (setf (char-bit res bit) t))))
-		     ((null new-value) new-value)
-		     (t
-		      (crunch-key new-value)))))
+  (let ((entry (cond ((and (consp new-value) (eq (car new-value) :bits))
+		      (apply #'ext:make-key-event-bits (cdr new-value)))
+		     (new-value (crunch-key new-value))
+		     (t new-value))))
     (set-table-entry *key-translations* (crunch-key key) entry)
     new-value))
+;;;
+(defsetf key-translation %set-key-translation
+  "Set the key translation for a key.  If set to null, deletes any
+  translation.")
+
 
 
 ;;;; Interface Utility Functions:
 
-(defvar *global-command-table* (make-key-table)
+(defvar *global-command-table* (make-hash-table)
   "The command table for global key bindings.")
 
 ;;; GET-RIGHT-TABLE  --  Internal
 ;;;
-;;;    Return a key-table depending on "kind" and checking for errors.
+;;;    Return a hash-table depending on "kind" and checking for errors.
 ;;;
 (defun get-right-table (kind where)
   (case kind
@@ -216,37 +182,36 @@
      (t (error "~S is not a valid binding type." kind))))
 
 
-;;; CRUNCH-KEY  --  Internal
+;;; CRUNCH-KEY  --  Internal.
 ;;;
-;;;    Take a key in one of the various specifications and turn it
-;;; into the standard one: a simple-vector of characters.
+;;; Take a key in one of the various specifications and turn it into the
+;;; standard one: a simple-vector of characters.
 ;;;
 (defun crunch-key (key)
   (typecase key
-    (character (vector key))
-    ((or list vector)
+    (ext:key-event (vector key))
+    ((or list vector) ;List thrown in gratuitously.
      (when (zerop (length key))
-       (error "Zero length key is illegal."))
-     (unless (every #'characterp key)
-       (error "Key ~S has a non-character element." key))
+       (error "A zero length key is illegal."))
+     (unless (every #'ext:key-event-p key)
+       (error "A Key ~S must contain only key-events." key))
      (coerce key 'simple-vector))
     (t
-     (error "Key ~S is not a character or sequence." key))))
+     (error "Key ~S is not a key-event or sequence of key-events." key))))
+
 
 
 ;;;; Exported Primitives:
 
 (proclaim '(special *command-names*))
 
-;;; BIND-KEY  --  Public
-;;;
-;;;    Put the command specified in the correct key table.
+;;; BIND-KEY  --  Public.
 ;;;
 (defun bind-key (name key &optional (kind :global) where)
   "Bind a Hemlock command to some key somewhere.  Name is the string name
-   of a Hemlock command, Key is either a character or a vector of characters.
-   Kind is one of :Global, :Mode or :Buffer, Where is the mode name or buffer
-   concerned.  Kind defaults to :Global."
+   of a Hemlock command, Key is either a key-event or a vector of key-events.
+   Kind is one of :Global, :Mode or :Buffer, and where is the mode name or
+   buffer concerned.  Kind defaults to :Global."
   (let ((cmd (getstring name *command-names*))
 	(table (get-right-table kind where))
 	(key (copy-seq (translate-key (crunch-key key)))))
@@ -264,10 +229,9 @@
 ;;;    Stick NIL in the key table specified.
 ;;;
 (defun delete-key-binding (key &optional (kind :global) where)
-  "Remove a Hemlock key binding somewhere.  Name is the string name of
-  a Hemlock command, Key is either a character or a vector of
-  characters.  Kind is one of :Global, :Mode or :Buffer, Where is the
-  mode name or buffer concerned.  Kind defaults to :Global."
+  "Remove a Hemlock key binding somewhere.  Key is either a key-event or a
+   vector of key-events.  Kind is one of :Global, :Mode or :Buffer, andl where
+   is the mode name or buffer concerned.  Kind defaults to :Global."
   (set-table-entry (get-right-table kind where)
 		   (translate-key (crunch-key key))
 		   nil))
@@ -295,17 +259,14 @@
 		(return (values res (nreverse t-bindings)))))))))))
 
 
-;;; GET-COMMAND  --  Public
-;;;
-;;;    Look up the key binding, checking for :Prefix.
+;;; GET-COMMAND -- Public.
 ;;;
 (defun get-command (key &optional (kind :global) where)
   "Return the command object for the command bound to key somewhere.
-  If key is not bound return NIL, if Key is a prefix of a key-binding
-  then reutrn :Prefix.  Name is the string name of a Hemlock command,
-  Key is either a character or a vector of characters.  Kind is one of
-  :Global, :Mode or :Buffer, Where is the mode name or buffer
-  concerned.  Kind defaults to :Global."
+   If key is not bound, return nil.  Key is either a key-event or a vector of
+   key-events.  If key is a prefix of a key-binding, then return :prefix.
+   Kind is one of :global, :mode or :buffer, and where is the mode name or
+   buffer concerned.  Kind defaults to :Global."
   (multiple-value-bind (key prefix-p)
 		       (translate-key (crunch-key key))
     (let ((entry (if (eq kind :current)
@@ -314,45 +275,32 @@
       (etypecase entry
 	(null (if prefix-p :prefix nil))
 	(command entry)
-	(key-table :prefix)))))
+	(hash-table :prefix)))))
 
+(defvar *map-bindings-key* (make-array 5 :adjustable t :fill-pointer 0))
 
-;;; MAP-BINDINGS  --  Public
-;;;
-;;;    map over a key table.
-;;;
-(defun map-bindings (fun kind &optional where)
-  "Map Fun over the bindings in some place.  The function is passed the
-  Key and the command to which it is bound."
-  (sub-map-bindings fun (key-table-table (get-right-table kind where)) '#()))
+;;; MAP-BINDINGS -- Public.
 ;;;
-(defun sub-map-bindings (fun tab key)
-  (declare (simple-vector tab key))
-  (let ((key (concatenate 'simple-vector key '#(#\space)))
-	(index (length key)))
-    (dotimes (bits command-char-bits-limit)
-      (let ((vec (svref tab bits)))
-	(when vec
-	  (dotimes (code command-char-code-limit)
-	    (setf (svref key index) (code-char code bits))
-	    (let ((val (svref vec code)))
-	      (cond ((null val))
-		    ((commandp val)
-		     (funcall fun key val))
-		    (t
-		     (sub-map-bindings fun (key-table-table val)
-				       key))))))))))
+(defun map-bindings (function kind &optional where)
+  "Map function over the bindings in some place.  The function is passed the
+   key and the command to which it is bound."
+  (labels ((mapping-fun (hash-key hash-value)
+	     (vector-push-extend hash-key *map-bindings-key*)
+	     (etypecase hash-value
+	       (command (funcall function *map-bindings-key* hash-value))
+	       (hash-table (maphash #'mapping-fun hash-value)))
+	     (decf (fill-pointer *map-bindings-key*))))
+    (setf (fill-pointer *map-bindings-key*) 0)
+    (maphash #'mapping-fun (get-right-table kind where))))
 
-
-;;; MAKE-COMMAND  --  Public
+;;; MAKE-COMMAND -- Public.
 ;;;
-;;;    If the command is already defined then alter the command object, 
-;;; otherwise make a new command object and enter it into the 
-;;; *command-names*.
+;;; If the command is already defined, then alter the command object;
+;;; otherwise, make a new command object and enter it into the *command-names*.
 ;;;
 (defun make-command (name documentation function)
   "Create a new Hemlock command with Name and Documentation which is
-  implemented by calling the function-value of the symbol Function"
+   implemented by calling the function-value of the symbol Function"
   (let ((entry (getstring name *command-names*)))
     (cond
      (entry
@@ -364,9 +312,7 @@
 	    (internal-make-command name documentation function))))))
 
 
-;;; COMMAND-NAME, %SET-COMMAND-NAME  --  Public
-;;;
-;;;    Filter the slot, updating *command-names* if it is set. 
+;;; COMMAND-NAME, %SET-COMMAND-NAME -- Public.
 ;;;
 (defun command-name (command)
   "Returns the string which is the name of Command."
@@ -381,33 +327,21 @@
   (setf (command-%name command) new-name))
 
 
-;;; COMMAND-BINDINGS  --  Public
+;;; COMMAND-BINDINGS -- Public.
 ;;;
-;;;    Check that all the supposed bindings really exists.  Bindings which
+;;; Check that all the supposed bindings really exists.  Bindings which
 ;;; were once made may have been overwritten.  It is easier to filter
 ;;; out bogus bindings here than to catch all the cases that can make a
 ;;; binding go away.
 ;;;
-(defun binding= (b1 b2)
-  (and (eq (second b1) (second b2))
-       (equal (third b1) (third b2))
-       (let* ((k1 (first b2))
-	      (l1 (length k1))
-	      (k2 (first b1)))
-	 (declare (simple-vector k1 k2))
-	 (if (= l1 (length k2))
-	     (dotimes (i l1 t)
-	       (when (char/= (svref k1 i) (svref k2 i))
-		 (return nil)))))))
-;;;
 (defun command-bindings (command)
   "Return a list of lists of the form (key kind where) describing
-  all the places there Command is bound."
+   all the places where Command is bound."
   (check-type command command)
-  (let (res)
-    (declare (list res))
+  (let (result)
+    (declare (list result))
     (dolist (place (command-%bindings command))
-      (let ((tab (case (cadr place)
+      (let ((table (case (cadr place)
 		   (:global *global-command-table*)
 		   (:mode
 		    (let ((m (getstring (caddr place) *mode-names*)))
@@ -415,10 +349,11 @@
 		   (t
 		    (when (memq (caddr place) *buffer-list*)
 		      (buffer-bindings (caddr place)))))))
-	(when (and tab (eq (get-table-entry tab (car place)) command)
-		   (not (find place res :test #'binding=)))
-	  (push place res))))
-    res))
+	(when (and table
+		   (eq (get-table-entry table (car place)) command)
+		   (not (member place result :test #'equalp)))
+	  (push place result))))
+    result))
 
 
 (defvar *last-command-type* ()
@@ -451,8 +386,7 @@
 ;;;
 ;;;
 (defun prefix-argument ()
-  "Return the current value of the prefix argument.  This can be set
-  with Setf."
+  "Return the current value of prefix argument.  This can be set with SETF."
   *prefix-argument*)
 
 ;;; %SET-PREFIX-ARGUMENT  --  Internal
@@ -506,40 +440,38 @@
 	  (unless (or (zerop (length cmd))
 		      (not (value ed::key-echo-delay)))
 	    (editor-sleep (value ed::key-echo-delay))
-	    (unless (listen *editor-input*)
+	    (unless (listen-editor-input *editor-input*)
 	      (clear-echo-area)
 	      (dotimes (i (length cmd))
-		(print-pretty-character (aref cmd i) *echo-area-stream*)
+		(ext:print-pretty-key (aref cmd i) *echo-area-stream*)
 		(write-char #\space *echo-area-stream*)))))
-	(vector-push-extend (read-char *editor-input*) cmd)
-	
+	(vector-push-extend (get-key-event *editor-input*) cmd)
 	(multiple-value-bind (trans-result prefix-p)
 			     (translate-key cmd trans)
 	  (multiple-value-bind (res t-bindings)
 			       (get-current-binding trans-result)
-	    (cond
-	     ((commandp res)
-	      (let ((punt t))
-		(catch 'command-loop-catcher
-		  (dolist (c t-bindings)
-		    (funcall *invoke-hook* c *prefix-argument*))
-		  (funcall *invoke-hook* res *prefix-argument*)
-		  (setf punt nil))
-		(when punt (invoke-hook ed::command-abort-hook)))
-	      (if *command-type-set*
-		  (setq *command-type-set* nil)
-		  (setq *last-command-type* nil))
-	      (if *prefix-argument-supplied*
-		  (setq *prefix-argument-supplied* nil)
-		  (setq *prefix-argument* nil))
-	      (setf (fill-pointer cmd) 0))
-	     ((null res)
-	      (unless prefix-p
-		(beep)
-		(setq *prefix-argument* nil)
-		(setf (fill-pointer cmd) 0)))
-	     ((not (key-table-p res))
-	      (error "Bad thing in key table: ~S" res)))))))))
+	    (etypecase res
+	      (command 
+	       (let ((punt t))
+		 (catch 'command-loop-catcher
+		   (dolist (c t-bindings)
+		     (funcall *invoke-hook* c *prefix-argument*))
+		   (funcall *invoke-hook* res *prefix-argument*)
+		   (setf punt nil))
+		 (when punt (invoke-hook ed::command-abort-hook)))
+	       (if *command-type-set*
+		   (setq *command-type-set* nil)
+		   (setq *last-command-type* nil))
+	       (if *prefix-argument-supplied*
+		   (setq *prefix-argument-supplied* nil)
+		   (setq *prefix-argument* nil))
+	       (setf (fill-pointer cmd) 0))
+	      (null
+	       (unless prefix-p
+		 (beep)
+		 (setq *prefix-argument* nil)
+		 (setf (fill-pointer cmd) 0)))
+	      (hash-table))))))))
 
 
 ;;; EXIT-HEMLOCK  --  Public
diff --git a/hemlock/kbdmac.lisp b/hemlock/kbdmac.lisp
index 775bfcd34..c97a20ae3 100644
--- a/hemlock/kbdmac.lisp
+++ b/hemlock/kbdmac.lisp
@@ -13,7 +13,8 @@
 ;;; implementation dependant, but it uses some hooks in the stream
 ;;; system and other stuff.
 ;;;
-(in-package 'hemlock)
+
+(in-package "HEMLOCK")
 
 ;;; We have "Keyboard Macro Transforms" that help in making a keyboard
 ;;; macro.  What they do is turn the sequence of commands into equivalent
@@ -63,7 +64,7 @@
 
 (defun trash-character ()
   "Throw away a character on *editor-input*."
-  (read-char *editor-input*))
+  (get-key-event *editor-input*))
 
 ;;; Save-Kbdmac-Input  --  Internal
 ;;;
@@ -93,11 +94,11 @@
     (:invoke
      (let ((fun (command-function command))
 	   (arg (prefix-argument))
-	   (lastc *last-character-typed*))
+	   (lastc *last-key-event-typed*))
        (save-kbdmac-input
 	 (let ((*invoke-hook* *old-invoke-hook*))
 	   (funcall fun arg))
-	 (kbdmac-emit `(set *last-character-typed* ,lastc))
+	 (kbdmac-emit `(set *last-key-event-typed* ,lastc))
 	 (kbdmac-emit `(,fun ,arg)))))))
 
 ;;;; Self insert transform:
@@ -106,15 +107,18 @@
 ;;; insert it all at once.
 ;;;
 
-(defvar *kbdmac-text* (make-array 100 :element-type 'string-char
-				  :fill-pointer 0
-				  :adjustable t))
+(defvar *kbdmac-text* (make-array 100 :fill-pointer 0 :adjustable t))
 
 (defun insert-string-at-point (string)
   (insert-string (buffer-point (current-buffer)) string))
 (defun insert-character-at-point (character)
   (insert-character (buffer-point (current-buffer)) character))
 
+(defun key-vector-to-string (key-vector)
+  (let ((string (make-array (length key-vector) :element-type 'string-char)))
+    (dotimes (i (length key-vector) string)
+      (setf (aref string i) (key-event-char (aref key-vector i))))))
+
 (defun self-insert-kbdmac-transform (command key)
   (case key
     (:start
@@ -123,12 +127,13 @@
      (let ((p (or (prefix-argument) 1)))
        (funcall (command-function command) p)
        (dotimes (i p)
-	 (vector-push-extend *last-character-typed* *kbdmac-text*))))
+	 (vector-push-extend *last-key-event-typed* *kbdmac-text*))))
     (:finish
-     (if (> (length (the string *kbdmac-text*)) 1)
+     (if (> (length *kbdmac-text*) 1)
 	 (kbdmac-emit `(insert-string-at-point
-			,(copy-seq (the string *kbdmac-text*))))
-	 (kbdmac-emit `(insert-character-at-point ,(char *kbdmac-text* 0)))))))
+			,(key-vector-to-string *kbdmac-text*)))
+	 (kbdmac-emit `(insert-character-at-point
+			,(key-event-char (aref *kbdmac-text* 0))))))))
 ;;;
 (define-kbdmac-transform "Self Insert" #'self-insert-kbdmac-transform)
 (define-kbdmac-transform "Lisp Insert )" #'self-insert-kbdmac-transform)
@@ -344,7 +349,7 @@
 		      (define-keyboard-macro))
 	(bind-key name key kind where)
 	(message "~A bound to ~A."
-		 (with-output-to-string (s) (sub-print-key key s))
+		 (with-output-to-string (s) (print-pretty-key key s))
 		 name)))))
 
 ;;; GET-KEYBOARD-MACRO-KEY gets a key from the user and confirms clobbering it
@@ -364,7 +369,7 @@
 	       (if (prompt-for-y-or-n
 		    :prompt `("~A is bound to ~A.  Rebind it? "
 			      ,(with-output-to-string (s)
-				 (sub-print-key key s))
+				 (print-pretty-key key s))
 			      ,(command-name cmd))
 		    :default nil)
 		   (values key kind where)
@@ -374,7 +379,7 @@
 		    :prompt `("~A is a prefix for more than one command.  ~
 			       Clobber it? "
 			      ,(with-output-to-string (s)
-				 (sub-print-key key s)))
+				 (print-pretty-key key s)))
 		    :default nil)
 		   (values key kind where)
 		   nil)))))))
@@ -440,7 +445,7 @@
       (command-case (:prompt "Keyboard Macro Query: "
 		     :help "Type one of these characters to say what to do:"
 		     :change-window nil
-		     :bind ch)
+		     :bind key-event)
 	(:exit
 	 "Exit this keyboard macro immediately."
 	 (throw 'exit-kbdmac nil))
@@ -460,5 +465,5 @@
 	 (do-recursive-edit)
 	 (reprompt))
 	(t
-	 (unread-char ch *editor-input*)
+	 (unget-key-event key-event *editor-input*)
 	 (throw 'exit-kbdmac nil))))))
diff --git a/hemlock/lispmode.lisp b/hemlock/lispmode.lisp
index 6e8a0d9d7..5fab8263b 100644
--- a/hemlock/lispmode.lisp
+++ b/hemlock/lispmode.lisp
@@ -1016,6 +1016,7 @@ according to the FORWARDP flag."
   of special arguments for the form.  Examples: 2 for Do, 1 for Dolist.
   If a prefix argument is supplied, then delete the indentation information."
   "Do a defindent, man!"
+  (declare (ignore p))
   (with-mark ((m (current-point)))
     (pre-command-parse-check m)
     (unless (backward-up-list m) (editor-error))
@@ -1165,6 +1166,32 @@ according to the FORWARDP flag."
   "Kill the previous Form."
   (forward-kill-form-command (- (or p 1))))
 
+(defcommand "Extract Form" (p)
+  "Replace the current containing list with the next form.  The entire affected
+   area is pushed onto the kill ring.  If an argument is supplied, that many
+   upward levels of list nesting is replaced by the next form."
+  "Replace the current containing list with the next form.  The entire affected
+   area is pushed onto the kill ring.  If an argument is supplied, that many
+   upward levels of list nesting is replaced by the next form."
+  (let ((point (current-point)))
+    (pre-command-parse-check point)
+    (with-mark ((form-start point :right-inserting)
+		(form-end point))
+      (unless (form-offset form-end 1) (editor-error))
+      (form-offset (move-mark form-start form-end) -1)
+      (with-mark ((containing-start form-start :left-inserting)
+		  (containing-end form-end :left-inserting))
+	(dotimes (i (or p 1))
+	  (unless (and (forward-up-list containing-end)
+		       (backward-up-list containing-start))
+	    (editor-error)))
+	(let ((r (copy-region (region form-start form-end))))
+	  (ring-push (delete-and-save-region
+		      (region containing-start containing-end))
+		     *kill-ring*)
+	  (ninsert-region point r)
+	  (move-mark point form-start))))))
+
 (defcommand "Extract List" (p)
   "Extract the current list.
   The current list replaces the surrounding list.  The entire affected
diff --git a/hemlock/macros.lisp b/hemlock/macros.lisp
index f29561c55..d15f4527d 100644
--- a/hemlock/macros.lisp
+++ b/hemlock/macros.lisp
@@ -372,60 +372,73 @@
 
 ;;;; COMMAND-CASE
 
-;;; Command-Case  --  Public
+;;; COMMAND-CASE  --  Public
 ;;;
 ;;;    Grovel the awful thing and spit out the corresponding Cond.  See Echo
-;;; for the definition of command-case-help and logical char stuff.
+;;; for the definition of COMMAND-CASE-HELP and logical char stuff.
 ;;;
 (eval-when (compile load eval)
-(defun command-case-tag (tag char)
+(defun command-case-tag (tag key-event char)
   (cond ((and (characterp tag) (standard-char-p tag))
-	 `(char= ,char ,(char-upcase tag)))
+	 `(char= ,char ,tag))
 	((and (symbolp tag) (keywordp tag))
-	 `(logical-char= ,char ,tag))
+	 `(logical-key-event-p ,key-event ,tag))
 	(t
-	 (error "Tag in Command-Case is not a standard character or keyword:~S"
+	 (error "Tag in COMMAND-CASE is not a standard character or keyword: ~S"
 		tag))))
 ); eval-when (compile load eval)
 ;;;  
-(defmacro command-case ((&key (change-window t) character
+(defmacro command-case ((&key (change-window t)
 			      (prompt "Command character: ")
 			      (help "Choose one of the following characters:")
 			      (bind (gensym)))
 			&body forms)
+  "This is analogous to the Common Lisp CASE macro.  Commands such as \"Query
+   Replace\" use this to get a key-event, translate it to a character, and
+   then to dispatch on the character to the specified case.  The syntax is
+   as follows:
+      (COMMAND-CASE ( {key value}* )
+        {( {( {tag}* )  |  tag}  help  {form}* )}*
+        )
+   Each tag is either a character or a logical key-event.  The user's typed
+   key-event is compared using either EXT:LOGICAL-KEY-EVENT-P or CHAR= of
+   EXT:KEY-EVENT-CHAR.
+
+   The legal keys of the key/value pairs are :help, :prompt, :change-window,
+   and :bind.  See the manual for details."
   (do* ((forms forms (cdr forms))
 	(form (car forms) (car forms))
 	(cases ())
 	(bname (gensym))
-	(upper (gensym))
 	(again (gensym))
 	(n-prompt (gensym))
 	(n-change (gensym))
+	(bind-char (gensym))
 	(docs ())
 	(t-case `(t (beep) (reprompt))))
        ((atom forms)
 	`(macrolet ((reprompt ()
 		      `(progn
-			(setq ,',bind (prompt-for-character*
-				       ,',n-prompt ,',n-change))
-			(go ,',AGAIN))))
+			 (setf ,',bind
+			       (prompt-for-key-event* ,',n-prompt ,',n-change))
+			 (setf ,',bind-char (ext:key-event-char ,',bind))
+			 (go ,',AGAIN))))
 	   (block ,bname
 	     (let* ((,n-prompt ,prompt)
 		    (,n-change ,change-window)
-		    (,bind ,(or character
-				`(prompt-for-character* ,n-prompt ,n-change))))
+		    (,bind (prompt-for-key-event* ,n-prompt ,n-change))
+		    (,bind-char (ext:key-event-char ,bind)))
 	       (tagbody
 		,AGAIN
-		 (let ((,upper (char-upcase ,bind)))
-		   (return-from
-		    ,bname
-		    (cond
-		     ,@(nreverse cases)
-		     ((logical-char= ,upper :abort) (editor-error))
-		     ((logical-char= ,upper :help)
-		      (command-case-help ,help ',(nreverse docs))
-		      (reprompt))
-		     ,t-case))))))))
+		(return-from
+		 ,bname
+		 (cond ,@(nreverse cases)
+		       ((logical-key-event-p ,bind :abort)
+			(editor-error))
+		       ((logical-key-event-p ,bind :help)
+			(command-case-help ,help ',(nreverse docs))
+			(reprompt))
+		       ,t-case)))))))
     
     (cond ((atom form)
 	   (error "Malformed Command-Case clause: ~S" form))
@@ -438,16 +451,19 @@
 	   (let ((tag (car form))
 		 (rest (cddr form)))
 	     (cond ((atom tag)
-		    (push (cons (command-case-tag tag upper) rest) cases)
+		    (push (cons (command-case-tag tag bind bind-char) rest)
+			  cases)
 		    (setq tag (list tag)))
 		   (t
 		    (do ((tag tag (cdr tag))
-			 (res () (cons (command-case-tag (car tag) upper) res)))
+			 (res ()
+			      (cons (command-case-tag (car tag) bind bind-char)
+				    res)))
 			((null tag)
 			 (push `((or ,@res) . ,rest) cases)))))
 	     (push (cons tag (second form)) docs))))))
 
-
+    
 
 ;;;; Some random macros used everywhere.
 
@@ -617,18 +633,18 @@
 			      :format-string
 			      "Error in error handler; Hemlock broken.")))))
     (clear-echo-area)
-    (clear-input *editor-input*)
+    (clear-editor-input *editor-input*)
     (beep)
     (if internalp (write-string "Internal error: " *echo-area-stream*))
     (princ condition *echo-area-stream*)
     (let* ((*editor-input* *real-editor-input*)
-	   (ch (read-char *editor-input*)))
-      (if (char= ch #\?)
+	   (key-event (get-key-event *editor-input*)))
+      (if (eq key-event #k"?")
 	  (loop 
 	    (command-case (:prompt "Debug: "
 			   :help
 			   "Type one of the Hemlock debug command characters:")
-	      ((#\D #\d) "Enter a break loop."
+	      (#\d "Enter a break loop."
 	       (let ((device (device-hunk-device
 			      (window-hunk (current-window)))))
 		 (funcall (device-exit device) device)
@@ -637,15 +653,15 @@
 			 (continue "Return to Hemlock's debug loop.")
 		       (invoke-debugger condition))
 		   (funcall (device-init device) device))))
-	      (#\B "Do a stack backtrace."
+	      (#\b "Do a stack backtrace."
 		 (with-pop-up-display (*debug-io* :height 100)
 		 (debug:backtrace)))
-	      (#\E "Show the error."
+	      (#\e "Show the error."
 	       (with-pop-up-display (*standard-output*)
 		 (princ condition)))
-	      ((#\Q :exit) "Throw back to Hemlock top-level."
+	      ((#\q :exit) "Throw back to Hemlock top-level."
 	       (throw 'editor-top-level-catcher nil))
-	      ((#\r #\R) "Try to restart from this error."
+	      (#\r "Try to restart from this error."
 	       (let ((cases (compute-restarts)))
 		 (declare (list cases))
 		 (with-pop-up-display (s :height (1+ (length cases)))
@@ -653,7 +669,7 @@
 		 (invoke-restart-interactively
 		  (nth (prompt-for-integer :prompt "Restart number: ")
 		       cases))))))
-	  (unread-char ch *editor-input*))
+	  (unget-key-event key-event *editor-input*))
       (throw 'editor-top-level-catcher nil))))
 
 (defmacro handle-lisp-errors (&body body)
diff --git a/hemlock/main.lisp b/hemlock/main.lisp
index 3a84d8076..381293cee 100644
--- a/hemlock/main.lisp
+++ b/hemlock/main.lisp
@@ -17,8 +17,7 @@
 
 (export '(*global-variable-names* *mode-names* *buffer-names*
 	  *character-attribute-names* *command-names* *buffer-list*
-	  *window-list* *editor-input* *last-character-typed*
-	  *character-history* after-editor-initializations))
+	  *window-list* *last-key-event-typed* after-editor-initializations))
 
 
 (in-package "EXTENSIONS")
diff --git a/hemlock/mh.lisp b/hemlock/mh.lisp
index 66e331747..278f0e7e4 100644
--- a/hemlock/mh.lisp
+++ b/hemlock/mh.lisp
@@ -2558,14 +2558,16 @@
 	    (let ((result ()))
 	      (declare (list result))
 	      (loop
-		(let ((char (read-char *editor-input*)))
-		  (ring-pop hi::*character-history*)
- 		  (cond ((char= char #\return)
-			 (return (prog1 (coerce (nreverse result) 'simple-string)
+		(let ((key-event (get-key-event *editor-input*)))
+		  (ring-pop hi::*key-event-history*)
+		  (cond ((eq key-event #k"return")
+			 (return (prog1 (coerce (nreverse result)
+						'simple-string)
 				   (fill result nil))))
-			((or (char= char #\control-u) (char= char #\control-\u))
+			((or (eq key-event #k"control-u")
+			     (eq key-event #k"control-U"))
 			 (setf result nil))
-			(t (push char result)))))))
+			(t (push (ext:key-event-char key-event) result)))))))
 	(setf (current-window) start-window)))))
 
 
diff --git a/hemlock/morecoms.lisp b/hemlock/morecoms.lisp
index 52b86e0b5..a07e07a23 100644
--- a/hemlock/morecoms.lisp
+++ b/hemlock/morecoms.lisp
@@ -171,7 +171,7 @@
   "Prompt for stuff to do a bind-key."
   (declare (ignore p))
   (multiple-value-call #'bind-key 
-    (values (prompt-for-keyword 
+    (values (prompt-for-keyword
 	     (list *command-names*)
 	     :prompt "Command to bind: "
 	     :help "Name of command to bind to a key."))
@@ -429,9 +429,8 @@
 		       (last-key-event-cursorpos)
     (unless y (editor-error))
     (cond ((< x 2)
-	   (do ((ch (read-char-no-hang *editor-input*)
-		    (read-char-no-hang *editor-input*)))
-	       (ch)
+	   (loop
+	     (when (listen-editor-input *editor-input*) (return))
 	     (scroll-window window -1)
 	     (redisplay)
 	     (editor-finish-output window)))
@@ -448,9 +447,8 @@
 		       (last-key-event-cursorpos)
     (unless y (editor-error))
     (cond ((< x 2)
-	   (do ((ch (read-char-no-hang *editor-input*)
-		    (read-char-no-hang *editor-input*)))
-	       (ch)
+	   (loop
+	     (when (listen-editor-input *editor-input*) (return))
 	     (scroll-window window 1)
 	     (redisplay)
 	     (editor-finish-output window)))
@@ -620,6 +618,7 @@
    directory at point."
   "Insert a listing of the first non-blank line after each page mark at
    the beginning of the buffer."
+  (declare (ignore p))
   (let ((point (current-point)))
     (unless p
       (push-buffer-mark (copy-mark point))
@@ -816,9 +815,44 @@
   (declare (ignore p))
   (setf (buffer-major-mode (current-buffer)) "Fundamental"))
 
+;;;
+;;; Text mode.
+;;;
+
 (defmode "Text" :major-p t)
+
 (defcommand "Text Mode" (p)
   "Put the current buffer into \"Text\" mode."
   "Put the current buffer into \"Text\" mode."
   (declare (ignore p))
   (setf (buffer-major-mode (current-buffer)) "Text"))
+
+;;;
+;;; Caps-lock mode.
+;;;
+
+(defmode "CAPS-LOCK")
+
+(defcommand "Caps Lock Mode" (p)
+  "Simulate having a CAPS LOCK key.  Toggle CAPS-LOCK mode.  Zero or a
+   negative argument turns it off, while a positive argument turns it
+   on."
+  "Simulate having a CAPS LOCK key.  Toggle CAPS-LOCK mode.  Zero or a
+   negative argument turns it off, while a positive argument turns it
+   on."
+  (setf (buffer-minor-mode (current-buffer) "CAPS-LOCK")
+	(if p
+	    (plusp p)
+	    (not (buffer-minor-mode (current-buffer) "CAPS-LOCK")))))
+
+(defcommand "Self Insert Caps Lock" (p)
+  "Insert the last character typed, or the argument number of them.
+   If the last character was an alphabetic character, then insert its
+   capital form."
+  "Insert the last character typed, or the argument number of them.
+   If the last character was an alphabetic character, then insert its
+   capital form."
+  (let ((char (char-upcase (ext:key-event-char *last-key-event-typed*))))
+    (if (and p (> p 1))
+	(insert-string (current-point) (make-string p :initial-element char))
+	(insert-character (current-point) char))))
diff --git a/hemlock/overwrite.lisp b/hemlock/overwrite.lisp
index 7d8d139fc..09a3605eb 100644
--- a/hemlock/overwrite.lisp
+++ b/hemlock/overwrite.lisp
@@ -33,7 +33,7 @@
   "Replace the next character with the last character typed,
    but insert at end of line.  With prefix argument, do it that many times."
   "Implements ``Self Overwrite'', calling this function is not meaningful."
-  (let ((char (text-character *last-character-typed*))
+  (let ((char (ext:key-event-char *last-key-event-typed*))
 	(point (current-point)))
     (unless char (editor-error "Can't insert that character."))
     (do ((n (or p 1) (1- n)))
diff --git a/hemlock/register.lisp b/hemlock/register.lisp
index 7180dafb3..89dda633c 100644
--- a/hemlock/register.lisp
+++ b/hemlock/register.lisp
@@ -42,7 +42,7 @@
        (setf (gethash ,name *registers*) ,value))))
 
 (defun prompt-for-register (&optional (prompt "Register: ") must-exist)
-  (let ((reg-name (char-upcase (prompt-for-character :prompt prompt))))
+  (let ((reg-name (prompt-for-key-event :prompt prompt)))
     (unless (or (not must-exist) (gethash reg-name *registers*))
       (editor-error "Register ~A is empty." reg-name))
     reg-name))
@@ -71,6 +71,7 @@
 ;;; 
 (defun flush-reg-references-to-deleted-buffer (buffer)
   (do-registers (name value)
+    (declare (ignore name))
     (etypecase value
       (mark (when (eq (line-buffer (mark-line value)) buffer)
 	      (free-register name)))
@@ -133,7 +134,7 @@
   (with-pop-up-display (f :height (* 2 (register-count)))
     (do-registers (name val :sorted)
       (write-string "Reg " f)
-      (print-pretty-character name f)
+      (ext:print-pretty-key-event name f)
       (write-string ":  " f)
       (etypecase val
 	(mark
diff --git a/hemlock/rompsite.lisp b/hemlock/rompsite.lisp
index 9020d4a70..093542e3d 100644
--- a/hemlock/rompsite.lisp
+++ b/hemlock/rompsite.lisp
@@ -18,13 +18,10 @@
 
 (in-package "HEMLOCK-INTERNALS" :nicknames '("HI"))
 
-(export '(show-mark editor-sleep text-character print-pretty-character
-	  *input-transcript* *real-editor-input* input-waiting
-	  fun-defined-from-pathname editor-describe-function pause-hemlock
-	  store-cut-string fetch-cut-string schedule-event
-	  remove-scheduled-event enter-window-autoraise directoryp
-	  last-key-event-cursorpos merge-relative-pathnames *editor-input*
-	  *last-character-typed* *character-history*
+(export '(show-mark editor-sleep *input-transcript* fun-defined-from-pathname
+	  editor-describe-function pause-hemlock store-cut-string
+	  fetch-cut-string schedule-event remove-scheduled-event
+	  enter-window-autoraise directoryp merge-relative-pathnames
 	  ;;
 	  ;; Export default-font to prevent a name conflict that occurs due to
 	  ;; the Hemlock variable "Default Font" defined in SITE-INIT below.
@@ -53,11 +50,10 @@
 
 ;;;; SITE-INIT.
 
-;;; *character-history* is defined much later in this file, but it needs to
-;;; be set in SITE-INIT, since MAKE-RING doesn't exist at load time for this
-;;; file.
+;;; *key-event-history* is defined in input.lisp, but it needs to be set in
+;;; SITE-INIT, since MAKE-RING doesn't exist at load time for this file.
 ;;;
-(proclaim '(special *character-history*))
+(proclaim '(special *key-event-history*))
 
 ;;; SITE-INIT  --  Internal
 ;;;
@@ -128,7 +124,7 @@
      a ruler in the bottom border of the window."
     :value t)
 
-  (setf *character-history* (make-ring 60))
+  (setf *key-event-history* (make-ring 60))
   nil)
 
 
@@ -174,14 +170,6 @@
 
 ;;;; I/O specials and initialization
 
-(defvar *editor-input* nil
-  "Input stream to get unechoed unbuffered terminal input.")
-
-(defvar *real-editor-input* ()
-  "The real editor input stream.  Useful when we want to read from the
-  terminal when *editor-input* is rebound.")
-
-
 ;;; File descriptor for the terminal.
 ;;; 
 (defvar *editor-file-descriptor*)
@@ -193,7 +181,7 @@
 ;;; 
 (defvar *editor-windowed-input* nil)
 
-#|
+
 ;;; These are used for selecting X events.
 ;;; 
 ;;; This says to send :key-press, :button-press, :button-release, :enter-notify,
@@ -231,7 +219,9 @@
   '("/usr/misc/.lisp/lib/fonts/"
     "/afs/cs.cmu.edu/unix/rt_mach/omega/usr/misc/.lisp/lib/fonts/"))
 
-|#
+
+(proclaim '(special *editor-input* *real-editor-input*))
+
 ;;; INIT-RAW-IO  --  Internal
 ;;;
 ;;;    This function should be called whenever the editor is entered in a new
@@ -239,9 +229,9 @@
 ;;;
 (defun init-raw-io (display)
   (setf *editor-windowed-input* nil)
-  (cond #+nil(display
+  (cond (display
 	 (setf *editor-windowed-input* (ext:open-clx-display display))
-	 (setf *editor-input* (make-editor-window-input-stream))
+	 (setf *editor-input* (make-windowed-editor-input))
 	 (ext:carefully-add-font-paths *editor-windowed-input*
 				       lisp-fonts-pathnames)
 	 (setup-font-family *editor-windowed-input*
@@ -253,7 +243,7 @@
 	   ;; take care of this.
 	   ;;
 	 (setf *editor-file-descriptor* 0)
-	 (setf *editor-input* (make-editor-tty-input-stream 0))))
+	 (setf *editor-input* (make-tty-editor-input 0))))
   (setf *real-editor-input* *editor-input*)
   *editor-windowed-input*)
 
@@ -263,7 +253,6 @@
 (proclaim '(declaration values))
 (proclaim '(special *default-font-family*))
 
-#|
 ;;; font-map-size should be defined in font.lisp, but SETUP-FONT-FAMILY would
 ;;; assume it to be special, issuing a nasty warning.
 ;;;
@@ -323,7 +312,7 @@
      (warn "Cannot open font -- ~S" font-name)
      nil)))
 
-|#
+
 
 ;;;; HEMLOCK-BEEP.
 
@@ -339,31 +328,29 @@
 
 (proclaim '(special *current-window*))
 
-#|
 ;;; BITMAP-BEEP is used in Hemlock for beeping when running under windowed
 ;;; input.
 ;;;
-(defun bitmap-beep (device stream)
+(defun bitmap-beep (display stream)
   (declare (ignore stream))
-  (let ((display (bitmap-device-display device)))
-    (ecase (variable-value 'ed::bell-style)
-      (:border-flash
-       (flash-window-border *current-window*))
-      (:feep
-       (xlib:bell display)
-       (xlib:display-force-output display))
-      (:border-flash-and-feep
-       (xlib:bell display)
-       (xlib:display-force-output display)
-       (flash-window-border *current-window*))
-      (:flash
-       (flash-window *current-window*))
-      (:flash-and-feep
-       (xlib:bell display)
-       (xlib:display-force-output display)
-       (flash-window *current-window*))
-      ((nil) ;Do nothing.
-       ))))
+  (ecase (variable-value 'ed::bell-style)
+    (:border-flash
+     (flash-window-border *current-window*))
+    (:feep
+     (xlib:bell display)
+     (xlib:display-force-output display))
+    (:border-flash-and-feep
+     (xlib:bell display)
+     (xlib:display-force-output display)
+     (flash-window-border *current-window*))
+    (:flash
+     (flash-window *current-window*))
+    (:flash-and-feep
+     (xlib:bell display)
+     (xlib:display-force-output display)
+     (flash-window *current-window*))
+    ((nil) ;Do nothing.
+     )))
 
 (proclaim '(special *foreground-background-xor*))
 
@@ -408,12 +395,12 @@
       (xlib:draw-rectangle xwin gcontext 0 0 width height t)
       (xlib:display-force-output display))))
 
-|#
+
 
 (defun hemlock-beep (stream)
   "Using the current window, calls the device's beep function on stream."
   (let ((device (device-hunk-device (window-hunk (current-window)))))
-    (funcall (device-beep device) device stream)))
+    (funcall (device-beep device) (bitmap-device-display device) stream)))
 
 
 
@@ -476,7 +463,6 @@
 	 (cond ((not *editor-windowed-input*)
 		,@body)
 	       (t
-#+nil
 		(ext:with-clx-event-handling
 		    (*editor-windowed-input* #'ext:object-set-event-handler)
 		  ,@body)))))
@@ -491,7 +477,6 @@
 
 (proclaim '(special *echo-area-window*))
 
-#|
 ;;; Maybe bury/unbury hemlock window when we go to and from Lisp.
 ;;; This should do something more sophisticated when we know what that is.
 ;;; 
@@ -499,14 +484,13 @@
   (let ((win (bitmap-hunk-xwindow (window-hunk *current-window*)))
 	(ewin (bitmap-hunk-xwindow (window-hunk *echo-area-window*))))
     (cond (on (setf (xlib:window-priority ewin) :above)
-	      (clear-input *editor-input*)
+	      (clear-editor-input *editor-input*)
 	      (setf (xlib:window-priority win) :above))
 	  (t (setf (xlib:window-priority ewin) :below)
 	     (setf (xlib:window-priority win) :below))))
   (xlib:display-force-output display))
-|#
 
-(defvar *hemlock-window-mngt* nil;#'default-hemlock-window-mngt
+(defvar *hemlock-window-mngt* #'default-hemlock-window-mngt
   "This function is called by HEMLOCK-WINDOW, passing its arguments.  This may
    be nil.")
 
@@ -519,425 +503,16 @@
 
 
 
-;;;; Current terminal character translation.
-
-(defvar *terminal-translation-table* (make-array 128))
-
-;;; 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 (svref *terminal-translation-table* i)
-	  (set-char-bit (char-downcase (code-char (+ i @-code))) :control t))))
-(setf (svref *terminal-translation-table* 9) #\tab)
-(setf (svref *terminal-translation-table* 10) #\linefeed)
-(setf (svref *terminal-translation-table* 13) #\return)
-(setf (svref *terminal-translation-table* 27) #\alt)
-(setf (svref *terminal-translation-table* 8) #\backspace)
-;;;
-;;; Other ASCII codes are exactly the same as the Common Lisp codes.
-;;; 
-(do ((i (char-code #\space) (1+ i)))
-    ((= i 128))
-  (setf (svref *terminal-translation-table* i) (code-char i)))
-
-;;; TRANSLATE-TTY-CHAR is our interface to be used in GET-EDITOR-INPUT.
-;;; 
-(proclaim '(inline translate-tty-char))
-(defun translate-tty-char (char)
-  (svref *terminal-translation-table* char))
-
-
-(defconstant termcap-file "/etc/termcap")
-
-(defun cl-termcap-char (char)
-  (if (char-bit char :control)
-      (code-char (the fixnum
-		      (- (the fixnum (char-code char))
-			 64))) ;(char-code #\@)
-      (case char
-	(#\alt (code-char 27))
-	(#\newline (code-char 10))
-	(#\return (code-char 13))
-	(#\tab (code-char 9))
-	(#\backspace (code-char 8))
-	(#\formfeed (code-char 12))
-	(t char))))
-
-
-
-;;;; Common editor input: stream def, event queue mngt, kbdmac waiting,
-;;;; more prompt, input method macro.
-
-;;; This is the basic editor stream definition.  More particular stream
-;;; definitions below include this.
-;;; 
-(defstruct (editor-input-stream
-	    (:include stream)
-	    (:print-function
-	     (lambda (s stream d)
-	       (declare (ignore s d))
-	       (write-string "#<Editor-Input stream>" stream)))
-	    (:constructor make-editor-input-stream
-			  (head &optional (tail head))))
-  ;;
-  ;; FIFO queue of events on this stream.  The queue always contains
-  ;; at least one one element, which is the character most recently read.
-  ;; If no event has been read, the event is a dummy with a NIL char.
-  head		; First key event in queue.
-  tail)		; Last event in queue.
-
-
-;;; Key event queue.
-;;; 
-
-(defstruct (key-event
-	    (:constructor make-key-event ())) 
-  next		; Next queued event, or NIL if none.
-  hunk		; Screen hunk event was read from.
-  char		; Character read.
-  x		; X and Y character position of mouse cursor.
-  y
-  unread-p)
-
-(defvar *free-key-events* ())
-
-(defun new-event (char x y hunk next &optional unread-p)
-  (let ((res (if *free-key-events*
-		 (shiftf *free-key-events* (key-event-next *free-key-events*))
-		 (make-key-event))))
-    (setf (key-event-char res) char)
-    (setf (key-event-x res) x)
-    (setf (key-event-y res) y)
-    (setf (key-event-hunk res) hunk)
-    (setf (key-event-next res) next)
-    (setf (key-event-unread-p res) unread-p)
-    res))
-
-(defvar *last-character-typed* ()
-  "This variable contains the last character typed to the command
-  interpreter.") 
-
-;;; *character-history* is setup in SITE-INIT.
-;;;
-(defvar *character-history* nil
-  "This ring holds the last 60 characters 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-stream-head stream))
-	  (next (key-event-next head)))
-     (if next
-	 (let ((char (key-event-char next)))
-	   (setf (editor-input-stream-head stream) next)
-	   (shiftf (key-event-next head) *free-key-events* head)
-	   (ring-push char *character-history*)
-	   (setq *last-character-typed* char)
-	   (when *input-transcript* 
-	     (vector-push-extend char *input-transcript*))
-	   char)))))
-
-;;; Q-EVENT is used in low level input fetching routines to add input to the
-;;; editor stream.
-;;; 
-(defun q-event (stream char &optional x y hunk)
-  (without-interrupts
-   (let ((new (new-event char x y hunk nil))
-	 (tail (editor-input-stream-tail stream)))
-     (setf (key-event-next tail) new)
-     (setf (editor-input-stream-tail stream) new))))
-
-(defun un-event (char stream)
-  (without-interrupts
-   (let* ((head (editor-input-stream-head stream))
-	  (next (key-event-next head))
-	  (new (new-event char (key-event-x head) (key-event-y head)
-			  (key-event-hunk head) next t)))
-     (setf (key-event-next head) new)
-     (unless next (setf (editor-input-stream-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 character 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 character which has been unread-char'ed
-   on *editor-input*.  Used by the keyboard macro stuff."
-  (let ((next (key-event-next (editor-input-stream-head *real-editor-input*))))
-    (and next (key-event-unread-p next))))
-
-
-;;; Random typeout hacks.
-;;; 
-
-(defun wait-for-more (stream)
-  (let ((ch (more-read-ch)))
-    (cond ((logical-char= ch :yes))
-	  ((or (logical-char= ch :do-all)
-	       (logical-char= ch :exit))
-	   (setf (random-typeout-stream-no-prompt stream) t)
-	   (random-typeout-cleanup stream))
-	  ((logical-char= ch :keep)
-	   (setf (random-typeout-stream-no-prompt stream) t)
-	   (maybe-keep-random-typeout-window stream)
-	   (random-typeout-cleanup stream))
-	  ((logical-char= ch :no)
-	   (random-typeout-cleanup stream)
-	   (throw 'more-punt nil))
-	  (t
-	   (unread-char ch *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* ((ch (more-read-ch))
-	   (keep-p (logical-char= ch :keep)))
-      (when keep-p (maybe-keep-random-typeout-window stream))
-      (random-typeout-cleanup stream)
-      (unless (or (logical-char= ch :do-all)
-		  (logical-char= ch :exit)
-		  (logical-char= ch :no)
-		  (logical-char= ch :yes)
-		  keep-p)
-	(unread-char ch *editor-input*)))))
-
-;;; MORE-READ-CH 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-ch ()
-  (clear-input *editor-input*)
-  (let ((ch (do ((ch (dq-event *editor-input*) (dq-event *editor-input*)))
-		(ch ch)
-	      (system:serve-event))))
-    (when (or (char= ch #\control-g) (char= ch #\control-\g))
-      (beep)
-      (throw 'editor-top-level-catcher nil))
-    ch))
-
-
-;;; 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*))
-
-;;; EDITOR-INPUT-METHOD-MACRO is used in EDITOR-TTY-IN and EDITOR-WINDOW-IN.
-;;; 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 character 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)))))
-	   char)
-       (loop
-	 (when (setf char (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 (or (char= char #\control-g) (char= char #\control-\g))
-		  eof-error-p)
-	 (beep)
-	 (throw 'editor-top-level-catcher nil))
-       char)))
-) ;eval-when
+;;;; Line Wrap Char.
 
+(defvar *line-wrap-char* #\!
+  "The character to be displayed to indicate wrapped lines.")
 
 
-;;;; Editor tty input streams.
-
-(defstruct (editor-tty-input-stream
-	    (:include editor-input-stream
-		      (:in #'editor-tty-in)
-		      (:misc #'editor-tty-misc))
-	    (:print-function
-	     (lambda (obj stream n)
-	       (declare (ignore obj n))
-	       (write-string "#<Editor-Tty-Input stream>" stream)))
-	    (:constructor make-editor-tty-input-stream
-			  (fd &optional (head (make-key-event)) (tail head))))
-  fd)
-
-
-(defun editor-tty-misc (stream operation &optional arg1 arg2)
-  (declare (ignore arg2))
-  (case operation
-    (:listen (cond ((key-event-next (editor-input-stream-head stream)) t)
-		   ((editor-tty-listen stream) t)
-		   (t nil)))
-    (:unread
-     (un-event arg1 stream))
-    (:clear-input
-     (without-interrupts
-      (let* ((head (editor-input-stream-head stream))
-	     (next (key-event-next head)))
-	(when next
-	  (setf (key-event-next head) nil)
-	  (shiftf (key-event-next (editor-input-stream-tail stream))
-		  *free-key-events* next)
-	  (setf (editor-input-stream-tail stream) head)))))
-    (:element-type 'character)))
-
-
-(defun editor-tty-in (stream eof-error-p eof-value)
-  (declare (ignore eof-value))
-  (editor-input-method-macro t))
+;;;; Current terminal character translation.
 
+(defconstant termcap-file "/etc/termcap")
 
-
-;;;; Editor window input streams.
-
-#|
-(defstruct (editor-window-input-stream
-	    (:include editor-input-stream
-		      (:in #'editor-window-in)
-		      (:misc #'editor-window-misc))
-	    (:print-function
-	     (lambda (s stream d)
-	       (declare (ignore s d))
-	       (write-string "#<Editor-Window-Input stream>" stream)))
-	    (:constructor make-editor-window-input-stream
-			  (&optional (head (make-key-event)) (tail head))))
-  hunks)    ; List of bitmap-hunks which input to this stream.
-
-
-(defun editor-window-misc (stream operation &optional arg1 arg2)
-  (declare (ignore arg2))
-  (case operation
-    (:listen
-     (loop (unless (system:serve-event 0)
-	     ;; If nothing is pending, check the queued input.
-	     (return (not (null (key-event-next
-				 (editor-input-stream-head stream))))))
-           (when (key-event-next (editor-input-stream-head stream))
-	     ;; Don't service anymore events if we just got some input.
-	     (return t))))
-    (:unread
-     (un-event arg1 stream))
-    (:clear-input
-     (loop (unless (system:serve-event 0) (return)))
-     (without-interrupts
-      (let* ((head (editor-input-stream-head stream))
-	     (next (key-event-next head)))
-	(when next
-	  (setf (key-event-next head) nil)
-	  (shiftf (key-event-next (editor-input-stream-tail stream))
-		  *free-key-events* next)
-	  (setf (editor-input-stream-tail stream) head)))))
-    (:element-type 'character)))
-
-
-(defun editor-window-in (stream eof-error-p eof-value)
-  (declare (ignore eof-value))
-  (editor-input-method-macro))
-
-|#
-
-;;; 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-stream-head *real-editor-input*))
-	 (hunk (key-event-hunk ev))
-	 (window (and hunk (device-hunk-window hunk))))
-    (when window
-      (values (key-event-x ev) (key-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 the *real-editor-input* stream.
-;;;
-(defun window-input-handler (hunk char x y)
-  (q-event *real-editor-input* char x y hunk))
 
 
 ;;;; Event scheduling.
@@ -1049,7 +624,7 @@
 
 (defun editor-sleep (time)
   "Sleep for approximately Time seconds."
-  (unless (or (zerop time) (listen *editor-input*))
+  (unless (or (zerop time) (listen-editor-input *editor-input*))
     (internal-redisplay)
     (sleep-for-time time)
     nil))
@@ -1060,7 +635,8 @@
 	(end (+ (get-internal-real-time)
 		(truncate (* time internal-time-units-per-second)))))
     (loop
-      (when (listen *editor-input*) (return))
+      (when (listen-editor-input *editor-input*)
+	(return))
       (let ((left (- end (get-internal-real-time))))
 	(unless (plusp left) (return nil))
 	(when nrw-fun (funcall nrw-fun t))
@@ -1087,7 +663,7 @@
     result))
 
 (defun tty-show-mark (window x y time)
-  (cond ((listen *editor-input*))
+  (cond ((listen-editor-input *editor-input*))
 	(x (internal-redisplay)
 	   (let* ((hunk (window-hunk window))
 		  (device (device-hunk-device hunk)))
@@ -1098,9 +674,8 @@
 	   t)
 	(t nil)))
 
-#|
 (defun bitmap-show-mark (window x y time)
-  (cond ((listen *editor-input*))
+  (cond ((listen-editor-input *editor-input*))
 	(x (let* ((hunk (window-hunk window))
 		  (display (bitmap-device-display (device-hunk-device hunk))))
 	     (internal-redisplay)
@@ -1112,53 +687,6 @@
 	     t))
 	(t nil)))
 
-|#
-
-;;;; Funny character stuff.
-
-;;; TEXT-CHARACTER and PRINT-PRETTY-CHARACTER are documented Hemlock primitives.
-;;;
-
-(defun text-character (char)
-  "Translate a character as read from *editor-input* into one suitable for
-   inserting into text.  If this is not possible, nil is returned."
-  (cond ((or (char-bit char :meta)
-	     (char-bit char :super)
-	     (char-bit char :hyper))
-	 nil)
-	((char= char #\return) #\newline)
-	((char-bit char :control)
-	 (let* ((nchar (char-upcase (make-char char)))
-		(code (char-code nchar)))
-	   (if (<= 64 code 95)
-	       (code-char (- code 64))
-	       nil)))
-	(t char)))
-
-(defun print-pretty-character (char stream)
-  "Prints char to stream suitably for documentation, data displays, etc.
-   Control, Meta, Super, and Hyper bits are shown as C-, M-, S-, and H-,
-   respectively.  If the character is not a standard character other than
-   #\space or #\newline, and it has a name, then the name is printed."
-  (when (char-bit char :control) (write-string "C-" stream))
-  (when (char-bit char :meta) (write-string "M-" stream))
-  (when (char-bit char :super) (write-string "S-" stream))
-  (when (char-bit char :hyper) (write-string "H-" stream))
-  (let ((code (char-code char))
-	(safe-char (make-char char)))
-    (if (<= (char-code #\!) code (char-code #\~))
-	(write-char safe-char stream)
-	(let ((name (char-name (code-char code))))
-	  (cond (name (write-string (string-capitalize name) stream))
-		((< code (char-code #\space))
-		 (write-char #\^ stream)
-		 (write-char (code-char (+ code (char-code #\@))) stream))
-		(t
-		 (write-char safe-char stream)))))))
-
-(defvar *line-wrap-char* #\!
-  "The character to be displayed to indicate wrapped lines.")
-
 
 
 ;;;; Function description and defined-from.
@@ -1173,15 +701,17 @@
   (typecase function
     (symbol (fun-defined-from-pathname (careful-symbol-function function)))
     (compiled-function
-     (let* ((source
-	     (first
-	      (c::compiled-debug-info-source
-	       (%primitive header-ref
-			   (%primitive header-ref function
-				       system:%function-entry-constants-slot)
-			   %function-constants-debug-info-slot)))))
-       (when (eq (c::debug-source-from source) :file)
-	 (c::debug-source-name source))))
+     (let* ((string (%primitive header-ref function
+				system:%function-defined-from-slot))
+	    (file (subseq string 0 (position #\space string :test #'char=))))
+       (declare (simple-string file))
+       (if (or (char= #\# (schar file 0))
+	       (string-equal file "lisp"))
+	   nil
+	   (if (string= file "/.." :end1 3)
+	       (pathname (subseq file
+				 (position #\/ file :test #'char= :start 4)))
+	       (pathname file)))))
     (t nil)))
 
 
@@ -1206,7 +736,6 @@
    then this also outputs any 'function documentation for sym to
    *standard-output*."
   (describe fun)
-  #+nil
   (when (and (compiled-function-p fun)
 	     (not (eq (%primitive header-ref fun %function-name-slot) sym)))
     (let ((doc (documentation sym 'function)))
@@ -1222,7 +751,7 @@
 
 
 ;;;; X Stuff.
-#|
+
 ;;; Setting window cursors ...
 ;;; 
 
@@ -1324,7 +853,7 @@
   (xlib:set-standard-properties (bitmap-hunk-xwindow (window-hunk window))
 				:icon-name (buffer-name new-buffer)))
 
-|#
+
 
 ;;;; Some hacks for supporting Hemlock under Mach.
 
@@ -1357,7 +886,7 @@
     (loop
       (when (>= i len) (return t))
       (q-event *real-editor-input*
-	       (translate-tty-char (char-code (schar buf i))))
+	       (ext:char-key-event (schar buf i)))
       (incf i))))
 
 ;;; This is used to get listening during smart redisplay to pick up input
@@ -1371,7 +900,7 @@
   (mach::with-trap-arg-block mach::int1 nc
     (dotimes (i listen-iterations-hack nil)
       (multiple-value-bind (val err) 
-			   (mach::Unix-ioctl (editor-tty-input-stream-fd stream)
+			   (mach::Unix-ioctl (tty-editor-input-fd stream)
 					     mach::FIONREAD
 					     (lisp::alien-value-sap
 					      mach::int1))
diff --git a/hemlock/scribe.lisp b/hemlock/scribe.lisp
index fdca55675..c7f7bc0bb 100644
--- a/hemlock/scribe.lisp
+++ b/hemlock/scribe.lisp
@@ -8,7 +8,8 @@
 ;;; Scott Fahlman (FAHLMAN@CMUC). 
 ;;; **********************************************************************
 ;;;
-(in-package 'hemlock)
+
+(in-package "HEMLOCK")
 
 
 
@@ -56,11 +57,11 @@
 
 (defattribute "Scribe Syntax" 
   "For Scribe Syntax, Possible types are:
-  :ESCAPE           ; basically #\@.
-  :OPEN-PAREN       ; Characters that open a Scribe paren:  #\[, #\{, #\(, #\<.
-  :CLOSE-PAREN      ; Characters that close a Scribe paren:  #\], #\}, #\), #\>.
-  :SPACE            ; Delimits end of a Scribe command.
-  :NEWLINE          ; Delimits end of a Scribe command."
+   :ESCAPE           ; basically #\@.
+   :OPEN-PAREN       ; Characters that open a Scribe paren:  #\[, #\{, #\(, #\<.
+   :CLOSE-PAREN      ; Characters that close a Scribe paren:  #\], #\}, #\), #\>.
+   :SPACE            ; Delimits end of a Scribe command.
+   :NEWLINE          ; Delimits end of a Scribe command."
   'symbol nil)
 
 (setf (character-attribute :SCRIBE-SYNTAX #\)) :CLOSE-PAREN) 
@@ -142,7 +143,8 @@
   "Inserts a the bracket it is bound to and then shows the matching bracket."
   "Inserts a the bracket it is bound to and then shows the matching bracket."
   (declare (ignore p))
-  (scribe-insert-paren (current-point) *last-character-typed*))
+  (scribe-insert-paren (current-point)
+		       (ext:key-event-char *last-key-event-typed*)))
 
 
 (defhvar "Scribe Command Table"
@@ -158,7 +160,7 @@
 
 (defcommand "Add Scribe Directive" (p &optional
 				      (command-name nil command-name-p)
-				      type key (mode "Scribe"))
+				      type key-event mode)
   "Adds a new scribe function to put into \"Scribe Command Table\"."
   "Adds a new scribe function to put into \"Scribe Command Table\"."
   (declare (ignore p))
@@ -175,9 +177,16 @@
 			      :help "Enter Command or Environment."
 			      :prompt "Command or Environment: "))
       (declare (ignore ignore))
-      (let ((key (or key
-		     (prompt-for-character :prompt "Dispatch Character: "))))
-	(setf (gethash key (variable-value 'scribe-command-table :mode mode))
+      (let ((key-event (or key-event
+			   (prompt-for-key-event :prompt
+						 "Dispatch Character: "))))
+	(setf (gethash key-event
+		       (cond (mode
+			      (variable-value 'scribe-command-table :mode mode))
+			     ((hemlock-bound-p 'scribe-command-table)
+			      (value scribe-command-table))
+			     (t (editor-error
+				 "Could not find \"Scribe Command Table\"."))))
 	      (cons type command-name))))))
 
 (defcommand "Insert Scribe Directive" (p)
@@ -190,14 +199,19 @@
    Character\"."
   "Wrap some text with some stuff."
   (declare (ignore p))
-  (command-case (:bind key :prompt "Dispatch Character: ")
-    (:help "help" 
-	   (directive-help)
-	   (reprompt))
-    (t (let ((table-entry (gethash key (value scribe-command-table))))
-	 (if (eq (car table-entry) :command)
-	     (insert-scribe-directive (current-point) (cdr table-entry))
-	     (enclose-with-environment (current-point) (cdr table-entry)))))))
+  (loop
+    (let ((key-event (prompt-for-key-event :prompt "Dispatch Character: ")))
+      (if (logical-key-event-p key-event :help)
+	  (directive-help)
+	  (let ((table-entry (gethash key-event (value scribe-command-table))))
+	    (ecase (car table-entry)
+	      (:command
+	       (insert-scribe-directive (current-point) (cdr table-entry))
+	       (return))
+	      (:environment
+	       (enclose-with-environment (current-point) (cdr table-entry))
+	       (return))
+	      ((nil) (editor-error "Unknown dispatch character."))))))))
 
 
 
@@ -211,9 +225,9 @@
 		 (if (eql (car v) :command)
 		     (push (cons k (cdr v)) commands)
 		     (push (cons k (cdr v)) environments)))
-	     (variable-value 'Scribe-Command-Table :mode "Scribe"))
-    (setq commands (sort commands #'string< :key #'cdr))
-    (setq environments (sort environments #'string< :key #'cdr))
+	     (value scribe-command-table))
+    (setf commands (sort commands #'string< :key #'cdr))
+    (setf environments (sort environments #'string< :key #'cdr))
     (with-pop-up-display (s :height (1+ (max (length commands)
 					     (length environments))))
       (format s "~2TCommands~47TEnvironments~%")
@@ -228,16 +242,60 @@
 	       (env-name (rest environment)))
 	  (write-string "  " s)
 	  (when cmd-char
-	    (print-pretty-character cmd-char s)
+	    (ext:print-pretty-key-event cmd-char s)
 	    (format s "~7T")
 	    (write-string (or cmd-name "<prompts for command name>") s))
 	  (when env-char
 	    (format s "~47T")
-	    (print-pretty-character env-char s)
+	    (ext:print-pretty-key-event env-char s)
 	    (format s "~51T")
 	    (write-string (or env-name "<prompts for command name>") s))
 	  (terpri s))))))
 
+;;;
+;;; Inserting and extending :command directives.
+;;;
+
+(defhvar "Insert Scribe Directive Function"
+  "\"Insert Scribe Directive\" calls this function when the directive type
+   is :command.  The function takes four arguments: a mark pointing to the word
+   start, the formatting command string, the open-paren character to use, and a
+   mark pointing to the word end."
+  :value 'scribe-insert-scribe-directive-fun
+  :mode "Scribe")
+
+(defun scribe-insert-scribe-directive-fun (word-start command-string
+					   open-paren-char word-end)
+  (insert-character word-start (value escape-character))
+  (insert-string word-start command-string)
+  (insert-character word-start open-paren-char)
+  (insert-character word-end (value close-paren-character)))
+
+(defhvar "Extend Scribe Directive Function"
+  "\"Insert Scribe Directive\" calls this function when the directive type is
+   :command to extend the the commands effect.  This function takes a string
+   and three marks: the first on pointing before the open-paren character for
+   the directive.  The string is the command-string to selected by the user
+   which this function uses to determine if it is actually extending a command
+   or inserting a new one.  The function must move the first mark before any
+   command text for the directive and the second mark to the end of any command
+   text.  It moves the third mark to the previous word's start where the
+   command region should be.  If this returns non-nil \"Insert Scribe
+   Directive\" moves the command region previous one word, and otherwise it
+   inserts the directive."
+  :value 'scribe-extend-scribe-directive-fun
+  :mode "Scribe")
+
+(defun scribe-extend-scribe-directive-fun (command-string
+					   command-end command-start word-start)
+  (word-offset (move-mark command-start command-end) -1)
+  (when (string= (the simple-string (region-to-string
+				     (region command-start command-end)))
+		 command-string)
+    (mark-before command-start)
+    (mark-after command-end)
+    (word-offset (move-mark word-start command-start) -1)))
+
 ;;; INSERT-SCRIBE-DIRECTIVE first looks for the current or previous word at
 ;;; mark.  Word-p says if we found one.  If mark is immediately before a word,
 ;;; we use that word instead of the previous.  This is because if mark
@@ -266,30 +324,34 @@
 			       :trim t :prompt "Environment: "
 			       :help "Name of environment to enclose with."))))
       (declare (simple-string command-string))
-      (when word-p
+      (cond
+       (word-p
 	(word-offset (move-mark word-end word-start) 1)
-	(when (test-char (next-character word-end) :scribe-syntax
-			 :close-paren)
-	  (with-mark ((command-start word-start)
-		      (command-end word-end))
-	    (balance-paren (mark-after command-end))
-	    (word-offset (move-mark command-start command-end) -1)
-	    (when (string= (the simple-string
-				(region-to-string (region command-start
-							  command-end)))
-			   command-string)
-	      (mark-before command-start)
-	      (mark-after command-end)
-	      (setf open-paren-char
-		    (opposing-bracket (next-character word-end)))
-	      (delete-region (region command-start command-end))
-	      (delete-characters word-end)
-	      (word-offset (move-mark word-start command-start) -1)))))
-      (insert-character word-start (value escape-character))
-      (insert-string word-start command-string)
-      (insert-character word-start open-paren-char)
-      (insert-character word-end (value close-paren-character))
-      (unless word-p (mark-before mark)))))
+	(if (test-char (next-character word-end) :scribe-syntax
+		       :close-paren)
+	    (with-mark ((command-start word-start :left-inserting)
+			(command-end word-end :left-inserting))
+	      ;; Move command-end from word-end to open-paren of command.
+	      (balance-paren (mark-after command-end))
+	      (if (funcall (value extend-scribe-directive-function)
+			   command-string command-end command-start word-start)
+		  (let ((region (delete-and-save-region
+				 (region command-start command-end))))
+		    (word-offset (move-mark word-start command-start) -1)
+		    (ninsert-region word-start region))
+		  (funcall (value insert-scribe-directive-function)
+			   word-start command-string open-paren-char
+			   word-end)))
+	    (funcall (value insert-scribe-directive-function)
+		     word-start command-string open-paren-char word-end)))
+	(t
+	 (funcall (value insert-scribe-directive-function)
+		  word-start command-string open-paren-char word-end)
+	 (mark-before mark))))))
+
+;;;
+;;; Inserting :environment directives.
+;;;
 
 (defun enclose-with-environment (mark &optional environment)
   (if (region-active-p)
@@ -324,8 +386,8 @@
 			 (prompt-for-string
 			  :trim t :prompt "Environment: "
 			  :help "Name of environment to enclose with."))))
-    (insert-environment top-mark "Begin" environment)
-    (insert-environment bottom-mark "End" environment)))
+    (insert-environment top-mark "begin" environment)
+    (insert-environment bottom-mark "end" environment)))
 
 (defun insert-environment (mark command environment)
   (let ((esc-char (value escape-character))
@@ -338,37 +400,37 @@
       (insert-character mark close-paren)))
 
 
-(Add-Scribe-Directive-Command nil nil :Environment #\Control-\l)
-(Add-Scribe-Directive-Command nil nil :Command #\Control-\w)
-(Add-Scribe-Directive-Command nil "Begin" :Command #\b)
-(Add-Scribe-Directive-Command nil "End" :Command #\e)
-(Add-Scribe-Directive-Command nil "Center" :Environment #\c)
-(Add-Scribe-Directive-Command nil "Description" :Environment #\d)
-(Add-Scribe-Directive-Command nil "Display" :Environment #\Control-\d)
-(Add-Scribe-Directive-Command nil "Enumerate" :Environment #\n)
-(Add-Scribe-Directive-Command nil "Example" :Environment #\x)
-(Add-Scribe-Directive-Command nil "FileExample" :Environment #\y)
-(Add-Scribe-Directive-Command nil "FlushLeft" :Environment #\l)
-(Add-Scribe-Directive-Command nil "FlushRight" :Environment #\r)
-(Add-Scribe-Directive-Command nil "Format" :Environment #\f)
-(Add-Scribe-Directive-Command nil "Group" :Environment #\g)
-(Add-Scribe-Directive-Command nil "Itemize" :Environment #\Control-\i)
-(Add-Scribe-Directive-Command nil "Multiple" :Environment #\m)
-(Add-Scribe-Directive-Command nil "ProgramExample" :Environment #\p)
-(Add-Scribe-Directive-Command nil "Quotation" :Environment #\q)
-(Add-Scribe-Directive-Command nil "Text" :Environment #\t)
-(Add-Scribe-Directive-Command nil "i" :Command #\i)
-(Add-Scribe-Directive-Command nil "b" :Command #\Control-\b)
-(Add-Scribe-Directive-Command nil "-" :Command #\-)
-(Add-Scribe-Directive-Command nil "+" :Command #\+)
-(Add-Scribe-Directive-Command nil "u" :Command #\Control-\j)
-(Add-Scribe-Directive-Command nil "p" :Command #\Control-\p)
-(Add-Scribe-Directive-Command nil "r" :Command #\Control-\r)
-(Add-Scribe-Directive-Command nil "t" :Command #\Control-\t) 
-(Add-Scribe-Directive-Command nil "g" :Command #\Control-\a)  
-(Add-Scribe-Directive-Command nil "un" :Command #\Control-\n)
-(Add-Scribe-Directive-Command nil "ux" :Command #\Control-\x) 
-(Add-Scribe-Directive-Command nil "c" :Command #\Control-\k) 
+(add-scribe-directive-command nil nil :Environment #k"Control-l" "Scribe")
+(add-scribe-directive-command nil nil :Command #k"Control-w" "Scribe")
+(add-scribe-directive-command nil "Begin" :Command #k"b" "Scribe")
+(add-scribe-directive-command nil "End" :Command #k"e" "Scribe")
+(add-scribe-directive-command nil "Center" :Environment #k"c" "Scribe")
+(add-scribe-directive-command nil "Description" :Environment #k"d" "Scribe")
+(add-scribe-directive-command nil "Display" :Environment #k"Control-d" "Scribe")
+(add-scribe-directive-command nil "Enumerate" :Environment #k"n" "Scribe")
+(add-scribe-directive-command nil "Example" :Environment #k"x" "Scribe")
+(add-scribe-directive-command nil "FileExample" :Environment #k"y" "Scribe")
+(add-scribe-directive-command nil "FlushLeft" :Environment #k"l" "Scribe")
+(add-scribe-directive-command nil "FlushRight" :Environment #k"r" "Scribe")
+(add-scribe-directive-command nil "Format" :Environment #k"f" "Scribe")
+(add-scribe-directive-command nil "Group" :Environment #k"g" "Scribe")
+(add-scribe-directive-command nil "Itemize" :Environment #k"Control-i" "Scribe")
+(add-scribe-directive-command nil "Multiple" :Environment #k"m" "Scribe")
+(add-scribe-directive-command nil "ProgramExample" :Environment #k"p" "Scribe")
+(add-scribe-directive-command nil "Quotation" :Environment #k"q" "Scribe")
+(add-scribe-directive-command nil "Text" :Environment #k"t" "Scribe")
+(add-scribe-directive-command nil "i" :Command #k"i" "Scribe")
+(add-scribe-directive-command nil "b" :Command #k"Control-b" "Scribe")
+(add-scribe-directive-command nil "-" :Command #k"\-" "Scribe")
+(add-scribe-directive-command nil "+" :Command #k"+" "Scribe")
+(add-scribe-directive-command nil "u" :Command #k"Control-j" "Scribe")
+(add-scribe-directive-command nil "p" :Command #k"Control-p" "Scribe")
+(add-scribe-directive-command nil "r" :Command #k"Control-r" "Scribe")
+(add-scribe-directive-command nil "t" :Command #k"Control-t" "Scribe")
+(add-scribe-directive-command nil "g" :Command #k"Control-a" "Scribe")
+(add-scribe-directive-command nil "un" :Command #k"Control-n" "Scribe")
+(add-scribe-directive-command nil "ux" :Command #k"Control-x" "Scribe")
+(add-scribe-directive-command nil "c" :Command #k"Control-k" "Scribe")
 
 
 
diff --git a/hemlock/searchcoms.lisp b/hemlock/searchcoms.lisp
index 448323ec2..d2d23bcdf 100644
--- a/hemlock/searchcoms.lisp
+++ b/hemlock/searchcoms.lisp
@@ -174,54 +174,57 @@
 ;;;
 (defun %i-search (string point trailer direction failure)
   (do* ((curr-point (copy-mark point :temporary))
-	(curr-trailer (copy-mark trailer :temporary))
-	(next-char (read-char *editor-input* nil)
-		   (read-char *editor-input* nil)))
+	(curr-trailer (copy-mark trailer :temporary)))
        (nil)
-    (case (%i-search-char-eval next-char string point trailer direction failure)
-      (:cancel
-       (%i-search-echo-refresh string direction failure)
-       (unless (zerop (length string))
-	 (i-search-pattern string direction)))
-      (:return-cancel
-       (unless (zerop (length string)) (return :cancel))
-       (beep))
-      (:control-g
-       (when failure (return :control-g))
-       (%i-search-echo-refresh string direction nil)
-       (unless (zerop (length string))
-	 (i-search-pattern string direction))))
-    (move-mark point curr-point)
-    (move-mark trailer curr-trailer)))
+    (let ((next-key-event (get-key-event *editor-input* t)))
+      (case (%i-search-char-eval next-key-event string point trailer
+				 direction failure)
+	(:cancel
+	 (%i-search-echo-refresh string direction failure)
+	 (unless (zerop (length string))
+	   (i-search-pattern string direction)))
+	(:return-cancel
+	 (unless (zerop (length string)) (return :cancel))
+	 (beep))
+	(:control-g
+	 (when failure (return :control-g))
+	 (%i-search-echo-refresh string direction nil)
+	 (unless (zerop (length string))
+	   (i-search-pattern string direction))))
+      (move-mark point curr-point)
+      (move-mark trailer curr-trailer))))
 
 ;;;      %I-SEARCH-CHAR-EVAL evaluates the last character typed and takes
 ;;; necessary actions.
 ;;;
-(defun %i-search-char-eval (char string point trailer direction failure)
+(defun %i-search-char-eval (key-event string point trailer direction failure)
   (declare (simple-string string))
-  (cond ((standard-char-p char)
-	 (%i-search-printed-char char string point trailer direction failure))
-	((or (logical-char= char :forward-search)
-	     (logical-char= char :backward-search))
-	 (%i-search-control-s-or-r char string point trailer direction failure))
-	((logical-char= char :cancel) :return-cancel)
-	((logical-char= char :abort)
+  (cond ((let ((character (key-event-char key-event)))
+	   (and character (standard-char-p character)))
+	 (%i-search-printed-char key-event string point trailer
+				 direction failure))
+	((or (logical-key-event-p key-event :forward-search)
+	     (logical-key-event-p key-event :backward-search))
+	 (%i-search-control-s-or-r key-event string point trailer
+				   direction failure))
+	((logical-key-event-p key-event :cancel) :return-cancel)
+	((logical-key-event-p key-event :abort)
 	 (unless failure
 	   (clear-echo-area)
 	   (message "Search aborted.")
 	   (throw 'exit-i-search :control-g))
 	 :control-g)
-	((logical-char= char :quote)
-	 (%i-search-printed-char (read-char *editor-input* nil)
+	((logical-key-event-p key-event :quote)
+	 (%i-search-printed-char (get-key-event *editor-input* t)
 				 string point trailer direction failure))
-	((and (zerop (length string)) (logical-char= char :exit))
+	((and (zerop (length string)) (logical-key-event-p key-event :exit))
 	 (if (eq direction :forward)
 	     (forward-search-command nil)
 	     (reverse-search-command nil))
 	 (throw 'exit-i-search nil))
 	(t
-	 (unless (logical-char= char :exit)
-	   (unread-char char *editor-input*))
+	 (unless (logical-key-event-p key-event :exit)
+	   (unget-key-event key-event *editor-input*))
 	 (unless (zerop (length string))
 	   (setf *last-search-string* string))
 	 (throw 'exit-i-search nil))))
@@ -231,9 +234,10 @@
 ;;; has just been changed, there cannot be a failure before trying a new
 ;;; direction.
 ;;;
-(defun %i-search-control-s-or-r (char string point trailer direction failure)
+(defun %i-search-control-s-or-r (key-event string point trailer
+					   direction failure)
   (let ((forward-direction-p (eq direction :forward))
-	(forward-character-p (logical-char= char :forward-search)))
+	(forward-character-p (logical-key-event-p key-event :forward-search)))
     (cond ((zerop (length string))
 	   (%i-search-empty-string point trailer direction forward-direction-p
 				   forward-character-p))
@@ -273,10 +277,10 @@
 ;;; the end of the buffer or to include the next character at the beginning
 ;;; of the search.
 ;;;
-(defun %i-search-printed-char (char string point trailer
-			       direction failure)
-  (let ((tchar (text-character char)))
-    (unless tchar (editor-error "Not a text character -- ~S" char))
+(defun %i-search-printed-char (key-event string point trailer direction failure)
+  (let ((tchar (ext:key-event-char key-event)))
+    (unless tchar (editor-error "Not a text character -- ~S" (key-event-char
+							      key-event)))
     (when (interactive)
       (insert-character (buffer-point *echo-area-buffer*) tchar)
       (force-output *echo-area-stream*))
@@ -475,7 +479,7 @@
 		   (:prompt
 		    "Query replace: "
 		    :help "Type one of the following single-character commands:"
-		    :change-window nil :bind ch)
+		    :change-window nil :bind key-event)
 		 (:yes "Replace this occurrence."
 		       (replace-that-case replacement cap upper point length
 					  dumb))
@@ -494,7 +498,7 @@
 		  (get-search-pattern target :forward))
 		 (:exit "Exit immediately."
 			(return nil))
-		 (t (unread-char ch *editor-input*)
+		 (t (unget-key-event key-event *editor-input*)
 		    (return nil))))))
        (length (the list *query-replace-undo-data*))))))
 
diff --git a/hemlock/shell.lisp b/hemlock/shell.lisp
index 8f8cb6580..1ca0e0405 100644
--- a/hemlock/shell.lisp
+++ b/hemlock/shell.lisp
@@ -69,41 +69,104 @@
 ;;;; Some Global Variables.
 
 (defhvar "Current Shell"
-  "The shell that  \"Select Shell\" will zap you to.")
+  "The shell to which \"Select Shell\" goes."
+  :value nil)
 
+(defhvar "Ask about Old Shells"
+  "When set (the default), Hemlock prompts for an existing shell buffer in
+   preference to making a new one when there is no \"Current Shell\"."
+  :value t)
+  
 (defhvar "Kill Process Confirm"
-  "When non-nil, ask the user whether he really wants to blow away the shell. ~
-   Otherwise, just blow it away."
-  :value T)
+  "When set, Hemlock prompts for confirmation before killing a buffer's process."
+  :value t)
 
 (defhvar "Shell Utility"
-  "The shell command uses this as the default command line."
+  "The \"Shell\" command uses this as the default command line."
   :value "/bin/csh")
 
 (defhvar "Shell Utility Switches"
-  "This is list of strings that are the default command line arguments to the
-   utility in \"Shell Utility\"."
-  :value nil)
+  "This is a string containing the default command line arguments to the
+   utility in \"Shell Utility\".  This is a string since the utility is
+   typically \"/bin/csh\", and this string can contain I/O redirection and
+   other shell directives."
+  :value "")
 
 
 
-;;;; The Shell and New Shell Commands.
+;;;; The Shell, New Shell, and Set Current Shell Commands.
+
+(defvar *shell-names* (make-string-table)
+  "A string-table of the string-name of all process buffers and corresponding
+   buffer structures.")
+
+(defcommand "Set Current Shell" (p)
+  "Sets the value of \"Current Shell\", which the \"Shell\" command uses."
+  "Sets the value of \"Current Shell\", which the \"Shell\" command uses."
+  (declare (ignore p))
+  (set-current-shell))
+
+;;; SET-CURRENT-SHELL -- Internal.
+;;;
+;;; This prompts for a known shell buffer to which it sets "Current Shell".
+;;; It signals an error if there are none.
+;;;
+(defun set-current-shell ()
+  (let ((old-buffer (value current-shell))
+	(first-old-shell (do-strings (var val *shell-names* nil)
+			   (declare (ignore var val))
+			   (return var))))
+    (when (and (not old-buffer) (not first-old-shell))
+      (editor-error "Nothing to set current shell to."))
+    (let ((default-shell (if old-buffer
+			     (buffer-name old-buffer)
+			     first-old-shell)))
+      (multiple-value-bind
+	  (new-buffer-name new-buffer) 
+	  (prompt-for-keyword (list *shell-names*)
+			      :must-exist t
+			      :default default-shell
+			      :default-string default-shell
+			      :prompt "Existing Shell: "
+			      :help "Enter the name of an existing shell.")
+	(declare (ignore new-buffer-name))
+	(setf (value current-shell) new-buffer)))))
 
 (defcommand "Shell" (p)
-  "If a shell buffer exists, pop to it.  Otherwise creates a new one and pop to
-   it.  With an argument, prompt for a command and buffer to execute it in."
-  "If a shell buffer exists, pop to it.  Otherwise creates a new one and pop to
-   it.  With an argument, prompt for a command and buffer to execute it in."
-  (let ((shell (value current-shell)))
-    (if shell (change-to-buffer shell) (make-new-shell p))))
-
-(defcommand "New Shell" (p)
-  "Creates a new shell and puts you in it."
-  "Creates a new shell and puts you in it."
-  (make-new-shell p))
-
-(defun make-new-shell (prompt-for-command-p
-		       &optional (command-line (get-command-line) clp))
+  "This spawns a shell in a buffer.  If there already is a \"Current Shell\",
+   this goes to that buffer.  If there is no \"Current Shell\", there are
+   shell buffers, and \"Ask about Old Shells\" is set, this prompts for one
+   of them, setting \"Current Shell\" to that shell.  Supplying an argument
+   forces the creation of a new shell buffer."
+  "This spawns a shell in a buffer.  If there already is a \"Current Shell\",
+   this goes to that buffer.  If there is no \"Current Shell\", there are
+   shell buffers, and \"Ask about Old Shells\" is set, this prompts for one
+   of them, setting \"Current Shell\" to that shell.  Supplying an argument
+   forces the creation of a new shell buffer."
+  (let ((shell (value current-shell))
+	(no-shells-p (do-strings (var val *shell-names* t)
+		       (declare (ignore var val))
+		       (return nil))))
+    (cond (p (make-new-shell nil no-shells-p))
+	  (shell (change-to-buffer shell))
+	  ((and (value ask-about-old-shells) (not no-shells-p))
+	   (set-current-shell)
+	   (change-to-buffer (value current-shell)))
+	  (t (make-new-shell nil)))))
+
+(defcommand "Shell Command Line in Buffer" (p)
+  "Prompts the user for a process and a buffer in which to run the process."
+  "Prompts the user for a process and a buffer in which to run the process."
+  (declare (ignore p))
+  (make-new-shell t))
+
+;;; MAKE-NEW-SHELL -- Internal.
+;;;
+;;; This makes new shells for us dealing with prompting for various things and
+;;; setting "Current Shell" according to user documentation.
+;;;
+(defun make-new-shell (prompt-for-command-p &optional (set-current-shell-p t)
+		       (command-line (get-command-line) clp))
   (let* ((command (or (and clp command-line)
 		      (if prompt-for-command-p
 			  (prompt-for-string
@@ -127,6 +190,7 @@
 		  (list #'(lambda (buffer)
 			    (when (eq (value current-shell) buffer)
 			      (setf (value current-shell) nil))
+			    (delete-string (buffer-name buffer) *shell-names*)
 			    (kill-process (variable-value 'process
 							  :buffer buffer)))))))
     (unless buffer
@@ -145,8 +209,9 @@
 						(declare (ignore process))
 						(update-process-buffer buffer))
 			       :input t :output t))
+    (setf (getstring buffer-name *shell-names*) buffer)
     (update-process-buffer buffer)
-    (unless (value current-shell)
+    (when (and (not (value current-shell)) set-current-shell-p)
       (setf (value current-shell) buffer))
     (change-to-buffer buffer)))
 
@@ -218,7 +283,8 @@
   (let ((process (variable-value 'process :buffer buffer)))
     (unless (ext:process-alive-p process)
       (ext:process-close process)
-      (setf (value current-shell) nil))))
+      (when (eq (value current-shell) buffer)
+	(setf (value current-shell) nil)))))
 
 
 ;;;; Supporting Commands.
@@ -319,6 +385,7 @@
 (defcommand "Stop Buffer Subprocess" (p)
   "Stop the subprocess currently executing in this shell."
   "Stop the subprocess currently executing in this shell."
+  (declare (ignore p))
   (unless (hemlock-bound-p 'process :buffer (current-buffer))
     (editor-error "Not in a process buffer."))  
   (deliver-signal-to-subprocess (if p :SIGSTOP :SIGTSTP) (value process)))
diff --git a/hemlock/spellcoms.lisp b/hemlock/spellcoms.lisp
index 2bf777757..8b8d35840 100644
--- a/hemlock/spellcoms.lisp
+++ b/hemlock/spellcoms.lisp
@@ -210,16 +210,17 @@
 	 (delete-mark (ring-pop missed))
 	 (return-from sub-correct-last-misspelled-word t))
        (move-mark point (region-end region))
-       (command-case (:prompt "Action: "  :change-window nil
+       (command-case (:prompt "Action: "
+		      :change-window nil
  :help "Type a single character command to do something to the misspelled word.")
-	 (#\C "Try to find a correction for this word."
+	 (#\c "Try to find a correction for this word."
 	  (unless (get-word-correction (region-start region) word folded)
 	    (reprompt)))
-	 (#\I "Insert this word in the dictionary."
+	 (#\i "Insert this word in the dictionary."
 	  (spell:spell-add-entry folded)
 	  (push folded (spell-info-insertions info))
 	  (message "~A inserted in the dictionary." word))
-	 (#\R "Prompt for a word to replace this word with."
+	 (#\r "Prompt for a word to replace this word with."
 	  (let ((s (prompt-for-string :prompt "Replace with: "
 				      :default word
  :help "Type a string to replace occurrences of this word with.")))
@@ -231,10 +232,10 @@
 	 (:recursive-edit
 	  "Go into a recursive edit and leave when it exits."
 	  (do-recursive-edit))
-	 ((:exit #\Q) "Exit and forget about this word.")
+	 ((:exit #\q) "Exit and forget about this word.")
 	 ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
 	  "Choose this numbered word as the correct spelling."
-	  (let ((num (digit-char-p *last-character-typed*))
+	  (let ((num (digit-char-p (ext:key-event-char *last-key-event-typed*)))
 		(close-words (spell:spell-collect-close-words folded)))
 	    (cond ((> num (length close-words))
 		   (editor-error "Choice out of range."))
@@ -322,8 +323,9 @@
 	      ((null words))
 	    (format s "~36R=~A " i (car words)))
 	  (finish-output s)
-	  (let* ((char (prompt-for-character :prompt "Correction choice: "))
-		 (num (digit-char-p char 36)))
+	  (let* ((key-event (prompt-for-key-event
+			     :prompt "Correction choice: "))
+		 (num (digit-char-p (ext:key-event-char key-event) 36)))
 	    (cond ((not num) (return-from get-word-correction nil))
 		  ((> num (length close-words))
 		   (editor-error "Choice out of range."))
@@ -522,40 +524,41 @@
        (:prompt "Action: "
         :help "Type a single letter command, or help character for help."
         :change-window nil)
-     (#\I "Insert unknown word into dictionary for future lookup."
-      (spell:spell-add-entry word)
-      (push word (spell-info-insertions info))
-      (format t "~S added to dictionary.~2%" word))
-     (#\C "Correct the unknown word with possible correct spellings."
-      (unless close-words
-	(write-line "There are no possible corrections.")
-	(reprompt))
-      (let ((num (if (= close-words-len 1) 0
-		     (digit-char-p (prompt-for-character
-				    :prompt "Correction choice: ")
-				   36))))
-	(unless num (reprompt))
-	(when (> num close-words-len)
-	  (beep)
-	  (write-line "Response out of range.")
-	  (reprompt))
-	(let ((choice (nth num close-words)))
-	  (setf (gethash word *spelling-corrections*) choice)
-	  (spell-replace-word mark unfolded-word choice)))
-      (terpri))
-     (#\A "Accept the word as correct (that is, ignore it)."
-      (character-offset mark wordlen))
-     (#\R "Replace the unknown word with a supplied replacement."
-      (let ((s (prompt-for-string
-		:prompt "Replacement Word: "
-		:default unfolded-word
-		:help "String to replace the unknown word with.")))
-	(setf (gethash word *spelling-corrections*) s)
-	(spell-replace-word mark unfolded-word s))
-      (terpri))
-     (:recursive-edit
-      "Go into a recursive edit and resume correction where the point is left."
-      (do-recursive-edit)))))
+      (#\i "Insert unknown word into dictionary for future lookup."
+	 (spell:spell-add-entry word)
+	 (push word (spell-info-insertions info))
+	 (format t "~S added to dictionary.~2%" word))
+      (#\c "Correct the unknown word with possible correct spellings."
+	 (unless close-words
+	   (write-line "There are no possible corrections.")
+	   (reprompt))
+	 (let ((num (if (= close-words-len 1) 0
+			(digit-char-p (ext:key-event-char
+				       (prompt-for-key-event
+					:prompt "Correction choice: "))
+				      36))))
+	   (unless num (reprompt))
+	   (when (> num close-words-len)
+	     (beep)
+	     (write-line "Response out of range.")
+	     (reprompt))
+	   (let ((choice (nth num close-words)))
+	     (setf (gethash word *spelling-corrections*) choice)
+	     (spell-replace-word mark unfolded-word choice)))
+	 (terpri))
+      (#\a "Accept the word as correct (that is, ignore it)."
+	 (character-offset mark wordlen))
+      (#\r "Replace the unknown word with a supplied replacement."
+	 (let ((s (prompt-for-string
+		   :prompt "Replacement Word: "
+		   :default unfolded-word
+		   :help "String to replace the unknown word with.")))
+	   (setf (gethash word *spelling-corrections*) s)
+	   (spell-replace-word mark unfolded-word s))
+	 (terpri))
+      (:recursive-edit
+       "Go into a recursive edit and resume correction where the point is left."
+       (do-recursive-edit)))))
 
 ;;; Spell-Replace-Word  --  Internal
 ;;;
diff --git a/hemlock/srccom.lisp b/hemlock/srccom.lisp
index 246b68ae1..87a14ea4e 100644
--- a/hemlock/srccom.lisp
+++ b/hemlock/srccom.lisp
@@ -153,12 +153,12 @@
 		      (region temp-b
 			      (line-start temp-a
 					  (line-next (mark-line temp-b))))))
-		(#\B "Insert both versions with **** MERGE LOSSAGE **** around them."
+		(#\b "Insert both versions with **** MERGE LOSSAGE **** around them."
 		     (insert-string temp-a "
 		     **** MERGE LOSSAGE ****")
 		     (insert-string dest-point "
 		     **** END OF MERGE LOSSAGE ****"))
-		(#\A "Align window at start of difference display."
+		(#\a "Align window at start of difference display."
 		     (line-start
 		      (move-mark
 		       (window-display-start
diff --git a/hemlock/streams.lisp b/hemlock/streams.lisp
index c719b9aad..0cfea3093 100644
--- a/hemlock/streams.lisp
+++ b/hemlock/streams.lisp
@@ -207,9 +207,7 @@
 	 (length (length chars))
 	 (last (region-end (hemlock-region-stream-region stream)))
 	 (last-line (mark-line last))
-	 (buffer (lisp::stream-in-buffer stream))
-	 (start 0)
-	 (len 0))
+	 (buffer (lisp::stream-in-buffer stream)) start len)
     (declare (fixnum length charpos last-charpos start len)
 	     (simple-string chars))
     (cond 
@@ -248,6 +246,7 @@
     (schar buffer start)))
 
 (defun region-misc (stream operation &optional arg1 arg2)
+  (declare (ignore arg1 arg2))
   (case operation
     (:listen (mark< (hemlock-region-stream-mark stream)
 		    (region-end (hemlock-region-stream-region stream))))
@@ -262,52 +261,33 @@
 
 ;;;; Stuff to support keyboard macros.
 
-;;; Note that the buffers in these streams must be general vectors, because
-;;; the characters may have bits.
-
 (defstruct (kbdmac-stream
-	    (:include stream
-		      (:in #'kbdmac-in)
-		      (:listen #'kbdmac-listen)
-		      (:misc #'kbdmac-misc))
+	    (:include editor-input
+		      (:get #'kbdmac-get)
+		      (:unget #'kbdmac-unget)
+		      (:listen #'kbdmac-listen))
 	    (:constructor make-kbdmac-stream ()))
-  ;;
-  ;; The simple-vector that holds the characters.
-  buffer
-  ;;
-  ;; Index of the next character.
-  index)
+  buffer    ; The simple-vector that holds the characters.
+  index)    ; Index of the next character.
 
-;;; Kbdmac-In  --  Internal
-;;;
-;;;    This is the input method for a kbdmac stream.  It just grabs a character
-;;; and returns it, bumping the index.
-;;;
-(defun kbdmac-in (stream eof-errorp eof-value)
-  (declare (ignore eof-errorp eof-value))
+(defun kbdmac-get (stream ignore-abort-attempts-p)
+  (declare (ignore ignore-abort-attempts-p))
   (let ((index (kbdmac-stream-index stream)))
-    (prog1 (setq *last-character-typed*
-		 (svref (kbdmac-stream-buffer stream) index))
-	   (setf (kbdmac-stream-index stream) (1+ index)))))
+    (setf (kbdmac-stream-index stream) (1+ index))
+    (setq *last-key-event-typed*
+	  (svref (kbdmac-stream-buffer stream) index))))
 
-;;; Kbdmac-Misc --  Internal
-;;;
-;;;    This is the misc method for kbdmac streams.  Since any character
-;;; that might have been read is included in the simulated input, listen
-;;; will always return T.
-;;;
-(defun kbdmac-misc (stream operation &optional arg1 arg2)
-  (declare (ignore arg1 arg2))
-  (case operation
-    (:unread
-     (if (plusp (kbdmac-stream-index stream))
-	 (decf (kbdmac-stream-index stream))
-	 (error "Nothing to unread.")))
-    (:listen t)
-    (:element-type 'string-char))
+(defun kbdmac-unget (ignore stream)
+  (declare (ignore ignore))
+  (if (plusp (kbdmac-stream-index stream))
+      (decf (kbdmac-stream-index stream))
+      (error "Nothing to unread.")))
+
+(defun kbdmac-listen (stream)
+  (declare (ignore stream))
   t)
 
-;;; Modify-Kbdmac-Stream  --  Internal
+;;; MODIFY-KBDMAC-STREAM  --  Internal
 ;;;
 ;;;    Bash the kbdmac-stream Stream so that it will return the Input.
 ;;;
diff --git a/hemlock/struct.lisp b/hemlock/struct.lisp
index 550ed0ca7..fa4c7f313 100644
--- a/hemlock/struct.lisp
+++ b/hemlock/struct.lisp
@@ -57,7 +57,8 @@
   font)
 
 (defmacro fast-font-mark-p (s)
-  `(typep ,s 'font-mark))
+  `(eq (svref ,s 0) 'font-mark))
+
 
 
 ;;;; Regions, buffers, modeline fields.
@@ -589,7 +590,7 @@
   "Set the Last-Command-Type for use by the next command.")
 (defsetf prefix-argument %set-prefix-argument
   "Set the prefix argument for the next command.")
-(defsetf logical-char= %set-logical-char=
+(defsetf logical-key-event-p %set-logical-key-event-p
   "Change what Logical-Char= returns for the specified arguments.")
 (defsetf window-font %set-window-font
   "Change the font-object associated with a font-number in a window.")
diff --git a/hemlock/termcap.lisp b/hemlock/termcap.lisp
index 8d57c2f76..f0270cc27 100644
--- a/hemlock/termcap.lisp
+++ b/hemlock/termcap.lisp
@@ -374,39 +374,37 @@
 	(setf (cdr ele) nil)))
     (return termcap)))
 
-;;; GET-TERMCAP-STRING-CHAR parses/lexes a character out of the termcap
-;;; file, converting it first into the appropriate Common Lisp character.
-;;; The Common Lisp character is then converted by CL-TERMCAP-CHAR into
-;;; another Common Lisp character but one that will eventually have the
-;;; right bits on (or be the necessary fixnum) for sending to terminals.
-;;; If this function needs to look ahead to determine any characters, it
-;;; unreads the character.
-;;; 
+;;; GET-TERMCAP-STRING-CHAR -- Internal.
+;;;
+;;; This parses/lexes an ASCII character out of the termcap file and converts
+;;; it into the appropriate Common Lisp character.  This is a Common Lisp
+;;; character with the same CHAR-CODE code as the ASCII code, so writing the
+;;; character to the tty will have the desired effect.  If this function needs
+;;; to look ahead to determine any characters, it unreads the character.
+;;;
 (defun get-termcap-string-char (stream char)
-  (cl-termcap-char
-   (case char
-     (#\\
-      (case (getchar)
-	(#\E #\alt)
-	(#\n #\newline)
-	(#\r #\return)
-	(#\t #\tab)
-	(#\b #\backspace)
-	(#\f #\formfeed)
-	(#\^ #\^)
-	(#\\ #\\)
-	((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
-	 (let ((result 0)
-	       (digit (digit-char-p char)))
-	   (loop (setf result (+ digit (* 8 result)))
-		 (unless (setf digit (digit-char-p (getchar)))
-		   (ungetchar char)
-		   (return (translate-tty-char (ldb (byte 7 0) result)))))))
-	(t (error "Bad termcap format -- unknown backslash character."))))
-     (#\^
-      (set-char-bit (char-upcase (getchar)) :control t))
-     (t char))))
-
+  (case char
+    (#\\
+     (case (getchar)
+       (#\E (code-char 27))
+       (#\n (code-char 10))
+       (#\r (code-char 13))
+       (#\t (code-char 9))
+       (#\b (code-char 8))
+       (#\f (code-char 12))
+       (#\^ #\^)
+       (#\\ #\\)
+       ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
+	(let ((result 0)
+	      (digit (digit-char-p char)))
+	  (loop (setf result (+ digit (* 8 result)))
+	    (unless (setf digit (digit-char-p (getchar)))
+	      (ungetchar char)
+	      (return (code-char (ldb (byte 7 0) result)))))))
+       (t (error "Bad termcap format -- unknown backslash character."))))
+    (#\^
+     (code-char (- (char-code (char-upcase (getchar))) 64)))
+    (t char)))
 
 
 ;;;; Initialization file string.
diff --git a/hemlock/ts-buf.lisp b/hemlock/ts-buf.lisp
index e20b44ee2..7157c1625 100644
--- a/hemlock/ts-buf.lisp
+++ b/hemlock/ts-buf.lisp
@@ -246,13 +246,23 @@
   :value "Cause the slave to throw to the top level? "
   :mode "Typescript")
 
+;;; TYPESCRIPT-DATA-OR-LOSE -- internal
+;;;
+;;; Return the typescript-data for the current buffer, or die trying.
+;;; 
+(defun typescript-data-or-lose ()
+  (if (hemlock-bound-p 'typescript-data)
+      (let ((ts (value typescript-data)))
+	(if ts
+	    ts
+	    (editor-error "Can't find the typescript data?")))
+      (editor-error "Not in a typescript buffer.")))
+
 (defcommand "Confirm Typescript Input" (p)
   "Send the current input to the slave typescript."
   "Send the current input to the slave typescript."
   (declare (ignore p))
-  (let ((ts (value typescript-data)))
-    (unless ts
-      (editor-error "This buffer has no typescript data!"))
+  (let ((ts (typescript-data-or-lose)))
     (let ((input (get-interactive-input)))
       (when input
 	(let ((string (region-to-string input)))
@@ -284,7 +294,7 @@
   (send-oob-to-slave "T"))
 
 (defun send-oob-to-slave (string)
-  (let* ((ts (value typescript-data))
+  (let* ((ts (typescript-data-or-lose))
 	 (wire (ts-data-wire ts))
 	 (socket (wire:wire-fd wire)))
     (unless socket
diff --git a/hemlock/tty-display.lisp b/hemlock/tty-display.lisp
index 1473c85d5..f555e2d16 100644
--- a/hemlock/tty-display.lisp
+++ b/hemlock/tty-display.lisp
@@ -193,6 +193,7 @@
   (let* ((dl first-changed)
 	 flags ;(dis-line-flags (car dl))) flags bound for NEXT-DIS-LINE.
 	 prev)
+    (declare (ignore flags))
     ;;
     ;; Skip old, unchanged, unmoved lines.
     ;; (loop
@@ -218,7 +219,8 @@
   (let* ((dl-chars (dis-line-chars dl))
 	 (dl-len (dis-line-length dl)))
     (declare (fixnum dl-len) (simple-string dl-chars))
-    (when (listen *editor-input*) (throw 'redisplay-catcher :editor-input))
+    (when (listen-editor-input *editor-input*)
+      (throw 'redisplay-catcher :editor-input))
     (select-hunk hunk)
     (let* ((screen-image-line (si-line (tty-device-screen-image device)
 				       (+ *hunk-top-line* dl-pos)))
@@ -226,7 +228,7 @@
 	   (si-line-length (si-line-length screen-image-line))
 	   (findex (string/= dl-chars si-line-chars
 			     :end1 dl-len :end2 si-line-length)))
-      (declare (type (or fixnum null) findex) (simple-string si-line-chars))
+      (declare (fixnum findex) (simple-string si-line-chars))
       ;;
       ;; When the dis-line and screen chars are not string=.
       (when findex
@@ -711,7 +713,8 @@
   (let* ((dl-chars (dis-line-chars dl))
 	 (dl-len (dis-line-length dl)))
     (declare (fixnum dl-len) (simple-string dl-chars))
-    (when (listen *editor-input*) (throw 'redisplay-catcher :editor-input))
+    (when (listen-editor-input *editor-input*)
+      (throw 'redisplay-catcher :editor-input))
     (select-hunk hunk)
     (let* ((screen-image-line (si-line (tty-device-screen-image device)
 				       (+ *hunk-top-line* dl-pos)))
@@ -719,7 +722,7 @@
 	   (si-line-length (si-line-length screen-image-line))
 	   (findex (string/= dl-chars si-line-chars
 			      :end1 dl-len :end2 si-line-length)))
-      (declare (type (or fixnum null) findex) (simple-string si-line-chars))
+      (declare (fixnum findex) (simple-string si-line-chars))
       ;;
       ;; When the dis-line and screen chars are not string=.
       (when findex
@@ -928,7 +931,7 @@
 	(device (device-hunk-device hunk)))
     (if upos
 	(let ((previous start)
-	      (after-pos 0))
+	      after-pos)
 	  (declare (fixnum previous after-pos))
 	  (loop (device-write-string string previous upos)
 		(setf after-pos (do ((i (1+ upos) (1+ i)))
@@ -1027,7 +1030,7 @@
 	 (char-end-string (tty-device-insert-char-end-string device))
 	 (ces-len (if char-end-string (length char-end-string)))
 	 (end-string (tty-device-insert-end-string device)))
-    (declare (type (or simple-string null) char-init-string char-end-string))
+    (declare (simple-string char-init-string char-end-string))
     (when init-string (device-write-string init-string))
     (if char-init-string
 	(do ((i start (1+ i)))
@@ -1058,7 +1061,7 @@
     (when end-string (incf cost (length (the simple-string end-string))))
     (< cost insert-char-num)))
 
-(defun delete-char (hunk x y &optional (n 1))
+(defun delete-char (hunk x y &optional n)
   (declare (fixnum x y n))
   (update-cursor hunk x y)
   (let* ((device (device-hunk-device hunk))
@@ -1071,14 +1074,13 @@
     (when end-string (device-write-string end-string))))
 
 (defun worth-using-delete-mode (device delete-char-num clear-char-num)
-  (declare (fixnum delete-char-num clear-char-num))
+  (declare (fixnum num))
   (let ((init-string (tty-device-delete-init-string device))
 	(end-string (tty-device-delete-end-string device))
 	(delete-char-string (tty-device-delete-char-string device))
 	(clear-to-eol-string (tty-device-clear-to-eol-string device))
 	(cost 0))
-    (declare (type (or simple-string null) init-string end-string
-		   delete-char-string)
+    (declare (simple-string init-string end-string delete-char-string)
 	     (fixnum cost))
     (when init-string (incf cost (the fixnum (length init-string))))
     (when end-string (incf cost (the fixnum (length end-string))))
diff --git a/tools/hemcom.lisp b/tools/hemcom.lisp
index 2093f8fb8..bbf59b8ea 100644
--- a/tools/hemcom.lisp
+++ b/tools/hemcom.lisp
@@ -2,8 +2,6 @@
 ;;; This file compiles all of Hemlock.
 ;;;
 
-(c::%proclaim '(optimize (debug-info 2)))
-#|
 (when (ext:get-command-line-switch "slave")
   (error "Cannot compile Hemlock in a slave due to its clobbering needed
 	  typescript routines by renaming the package."))
@@ -12,12 +10,12 @@
 ;;; Blast the old packages in case they are around.  We do this solely to
 ;;; prove Hemlock can compile cleanly without its having to exist already.
 ;;;
-(unless (find-package "OLD-ED")
-  (when (find-package "ED")
-    (rename-package (find-package "ED") "OLD-ED"))
-  (when (find-package "HI")
-    (rename-package (find-package "HI") "OLD-HI")))
-|#
+(when (find-package "ED")
+  (rename-package (find-package "ED") "OLD-ED"))
+;;;
+(when (find-package "HI")
+  (rename-package (find-package "HI") "OLD-HI"))
+
 
 ;;; Stuff to set up the packages Hemlock uses.
 ;;;
@@ -33,126 +31,137 @@
 (export '(%sp-byte-blt %sp-find-character %sp-find-character-with-attribute
 		       %sp-reverse-find-character-with-attribute))
 
-(in-package "C")
-(export 'compile-from-stream)
-
-(in-package "HI")
-
-;;; ### bootstrap hack...
-(defmacro parse-forms ((decls-var forms-var forms) &body gorms)
-  "Parse-Forms (Decls-Var Forms-Var Forms) {Form}*
-  Binds Decls-Var to leading declarations off of Forms and Forms-Var
-  to what is left."
-  `(do ((,forms-var ,forms (cdr ,forms-var))
-	(,decls-var ()))
-       ((or (atom ,forms-var) (atom (car ,forms-var))
-	    (not (eq (caar ,forms-var) 'declare)))
-	,@gorms)
-     (push (car ,forms-var) ,decls-var)))
-
-(in-package "USER")
+(in-package "HEMLOCK-INTERNALS")
 
 
 (pushnew :command-bits *features*)
 (pushnew :buffered-lines *features*)
 
+(defparameter the-log-file "hem:lossage.log")
 
-(with-compiler-log-file ("hem:lossage.log")
+(when (probe-file the-log-file)
+  (delete-file the-log-file))
 
-(comf "code:globals" :always-once t)
-(comf "code:struct" :always-once t)
-(comf "hem:struct" :always-once t)
-(comf "hem:struct-ed" :always-once t)
-(comf "hem:rompsite" :always-once t)
-(comf "hem:charmacs" :always-once t)
-;; keytran and keytrandefs used to be in rompsite, but they are too big now.
-;; They also need to go after charmacs due to the funny characters named.
-;(comf "hem:keytran")
-;(comf "hem:keytrandefs")
-(comf "hem:macros" :always-once t)
-(comf "hem:line" :always-once t)
-(comf "hem:ring")
-(comf "hem:table")
-(comf "hem:htext1")
-(comf "hem:htext2")
-(comf "hem:htext3")
-(comf "hem:htext4")
-(comf "hem:search1")
-(comf "hem:search2")
-(comf "hem:linimage")
-(comf "hem:cursor")
-(comf "hem:syntax")
-(comf "hem:winimage")
-;(comf "hem:hunk-draw")
-;(comf "hem:bit-stream")
-(comf "hem:termcap")
-(comf "hem:display")
-;(comf "hem:bit-display")
-(comf "hem:tty-disp-rt")
-(comf "hem:tty-display")
-;(comf "hem:tty-stream")
-(comf "hem:pop-up-stream")
-(comf "hem:screen")
-;(comf "hem:bit-screen")
-(comf "hem:tty-screen")
-(comf "hem:window")
-(comf "hem:font")
-(comf "hem:interp")
-(comf "hem:vars")
-(comf "hem:buffer")
-(comf "hem:files")
-(comf "hem:streams")
-(comf "hem:echo")
-(comf "hem:main")
-(comf "hem:echocoms")
-(comf "hem:defsyn")
-(comf "hem:command")
-(comf "hem:morecoms")
-(comf "hem:undo")
-(comf "hem:killcoms")
-(comf "hem:searchcoms")
-(comf "hem:filecoms")
-(comf "hem:indent")
-(comf "hem:lispmode")
-(comf "hem:comments")
-(comf "hem:fill")
-(comf "hem:text")
-(comf "hem:doccoms")
-(comf "hem:srccom")
-(comf "hem:group")
-(comf "hem:spell-rt")
-(comf "hem:spell-corr")
-(comf "hem:spell-aug")
-(comf "hem:spell-build")
-(comf "hem:spellcoms")
-(comf "hem:abbrev")
-(comf "hem:overwrite")
-(comf "hem:gosmacs")
-(comf "hem:ts-buf")
-(comf "hem:ts-stream")
-(comf "hem:eval-server")
-(comf "hem:lispbuf")
-(comf "hem:lispeval")
-(comf "hem:kbdmac")
-(comf "hem:icom")
-(comf "hem:hi-integrity")
-(comf "hem:ed-integrity")
-(comf "hem:scribe")
-(comf "hem:pascal")
-(comf "hem:edit-defs")
-(comf "hem:auto-save")
-(comf "hem:register")
-(comf "hem:xcoms")
-(comf "hem:unixcoms")
-(comf "hem:mh")
-(comf "hem:highlight")
-(comf "hem:dired")
-(comf "hem:diredcoms")
-(comf "hem:bufed")
-(comf "hem:lisp-lib")
-(comf "hem:completion")
-(comf "hem:shell")
-(comf "hem:bindings")
-(comf "hem:hacks")
+(defun cf (file &key load)
+  (write-line file)
+  (finish-output nil)
+  (let ((*error-output* (open the-log-file
+			      :direction :output 
+			      :if-exists :append
+			      :if-does-not-exist :create)))
+    (unwind-protect
+	(progn
+	  (compile-file file :error-file nil)
+	  (terpri *error-output*) (terpri *error-output*)
+	  (when load
+	    (let ((fasl (make-pathname :device (pathname-device file)
+				       :directory (pathname-directory file)
+				       :name (pathname-name file)
+				       :type "fasl")))
+	      (write-string "Loading ")
+	      (write-line (namestring fasl))
+	      (load fasl))))
+      (close *error-output*))))
+
+(cf "hem:struct.lisp")
+(cf "hem:struct-ed.lisp")
+(cf "hem:rompsite.lisp")
+(cf "hem:charmacs.lisp")
+
+(cf "hem:key-event.lisp" :load t)
+;;;
+;;; This is necessary since all the #k uses in Hemlock will expand into
+;;; EXT:MAKE-KEY-EVENT calls with keysyms and bits from the compiling Lisp, not
+;;; for the Lisp new code will run in.  This destroys the compiling Lisp with
+;;; respect to running code with #k's compiled for it, but it causes the
+;;; compilation to see new keysyms, modifiers, and CLX modifier maps correctly
+;;; for the new system.
+;;;
+(ext::re-initialize-key-events)
+(cf "hem:keysym-defs.lisp" :load t)
 
-); With-Compiler-Log-File
+(cf "hem:input.lisp")
+(cf "hem:macros.lisp")
+(cf "hem:line.lisp")
+(cf "hem:ring.lisp")
+(cf "hem:table.lisp")
+(cf "hem:htext1.lisp")
+(cf "hem:htext2.lisp")
+(cf "hem:htext3.lisp")
+(cf "hem:htext4.lisp")
+(cf "hem:search1.lisp")
+(cf "hem:search2.lisp")
+(cf "hem:linimage.lisp")
+(cf "hem:cursor.lisp")
+(cf "hem:syntax.lisp")
+(cf "hem:winimage.lisp")
+(cf "hem:hunk-draw.lisp")
+;(cf "hem:bit-stream.lisp")
+(cf "hem:termcap.lisp")
+(cf "hem:display.lisp")
+(cf "hem:bit-display.lisp")
+(cf "hem:tty-disp-rt.lisp")
+(cf "hem:tty-display.lisp")
+;(cf "hem:tty-stream.lisp")
+(cf "hem:pop-up-stream.lisp")
+(cf "hem:screen.lisp")
+(cf "hem:bit-screen.lisp")
+(cf "hem:tty-screen.lisp")
+(cf "hem:window.lisp")
+(cf "hem:font.lisp")
+(cf "hem:interp.lisp")
+(cf "hem:vars.lisp")
+(cf "hem:buffer.lisp")
+(cf "hem:files.lisp")
+(cf "hem:streams.lisp")
+(cf "hem:echo.lisp")
+(cf "hem:main.lisp")
+(cf "hem:echocoms.lisp")
+(cf "hem:defsyn.lisp")
+(cf "hem:command.lisp")
+(cf "hem:morecoms.lisp")
+(cf "hem:undo.lisp")
+(cf "hem:killcoms.lisp")
+(cf "hem:searchcoms.lisp")
+(cf "hem:filecoms.lisp")
+(cf "hem:indent.lisp")
+(cf "hem:lispmode.lisp")
+(cf "hem:comments.lisp")
+(cf "hem:fill.lisp")
+(cf "hem:text.lisp")
+(cf "hem:doccoms.lisp")
+(cf "hem:srccom.lisp")
+(cf "hem:group.lisp")
+(cf "hem:spell-rt.lisp")
+(cf "hem:spell-corr.lisp")
+(cf "hem:spell-aug.lisp")
+(cf "hem:spell-build.lisp")
+(cf "hem:spellcoms.lisp")
+(cf "hem:abbrev.lisp")
+(cf "hem:overwrite.lisp")
+(cf "hem:gosmacs.lisp")
+(cf "hem:ts-buf.lisp")
+(cf "hem:ts-stream.lisp")
+(cf "hem:eval-server.lisp")
+(cf "hem:lispbuf.lisp")
+(cf "hem:lispeval.lisp")
+(cf "hem:kbdmac.lisp")
+(cf "hem:icom.lisp")
+(cf "hem:hi-integrity.lisp")
+(cf "hem:ed-integrity.lisp")
+(cf "hem:scribe.lisp")
+(cf "hem:pascal.lisp")
+(cf "hem:edit-defs.lisp")
+(cf "hem:auto-save.lisp")
+(cf "hem:register.lisp")
+(cf "hem:xcoms.lisp")
+(cf "hem:unixcoms.lisp")
+(cf "hem:mh.lisp")
+(cf "hem:highlight.lisp")
+(cf "hem:dired.lisp")
+(cf "hem:diredcoms.lisp")
+(cf "hem:bufed.lisp")
+(cf "hem:lisp-lib.lisp")
+(cf "hem:completion.lisp")
+(cf "hem:shell.lisp")
+(cf "hem:bindings.lisp")
-- 
GitLab