diff --git a/hemlock/charmacs.lisp b/hemlock/charmacs.lisp
index aaf6bde2fbfc0d42ed16fcbc6996092e0dd7f09c..d6a684d769cf670ea6b8a374e4091bfba7e968b9 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.")
@@ -88,89 +83,8 @@
   `(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)
-
-		("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/diredcoms.lisp b/hemlock/diredcoms.lisp
index a7ff58aec342124e8af2dca19554620c6ad5d858..97911dd011d8eaa0230162ae7d634c86a6e5a91f 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.
diff --git a/hemlock/echocoms.lisp b/hemlock/echocoms.lisp
index 47ea1d66323bc9517e2ca0b2a0fe4ab664022e74..ae63b837d7f9cdd170899720b6625e9153408cc5 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.")))))
diff --git a/hemlock/filecoms.lisp b/hemlock/filecoms.lisp
index e7f76abe0ef9618248e0fef0327d5ac4fc03cbfe..8bd09342957b9a2772115f05722ddd720cd74185 100644
--- a/hemlock/filecoms.lisp
+++ b/hemlock/filecoms.lisp
@@ -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/fill.lisp b/hemlock/fill.lisp
index 6ee99082d8f487cb19633ad5cf960fefef6710bc..a120c6adf3e684488d59d7855ffb72970217264a 100644
--- a/hemlock/fill.lisp
+++ b/hemlock/fill.lisp
@@ -125,7 +125,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)))
@@ -144,7 +144,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)))
diff --git a/hemlock/input.lisp b/hemlock/input.lisp
index 7dc4e34aecb4f0ce5bbaa59c353dd9a518399655..296430693c75997a8cf2f0925aef6b0f52133d21 100644
--- a/hemlock/input.lisp
+++ b/hemlock/input.lisp
@@ -223,7 +223,7 @@
 
 
 ;;;; Editor input from windowing system.
-
+#|
 (defstruct (windowed-editor-input
 	    (:include editor-input
 		      (:get #'windowed-get-key-event)
@@ -263,7 +263,7 @@
       ;; Don't service anymore events if we just got some input.
       (return t))))
 
-
+|#
 
 ;;;; Editor input from a tty.
 
diff --git a/hemlock/lispmode.lisp b/hemlock/lispmode.lisp
index 6e8a0d9d78f4f0c22a8e7d0dedb33837e666af69..d115cdc7515280af6f74a9ae90f4f7e89dde47f7 100644
--- a/hemlock/lispmode.lisp
+++ b/hemlock/lispmode.lisp
@@ -1165,6 +1165,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/morecoms.lisp b/hemlock/morecoms.lisp
index 52b86e0b5991fa386fa2fc83749ed29011f9fc82..332eeee15489f9d5434d6b824840b3ad2ed98da2 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)))
@@ -816,9 +814,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/register.lisp b/hemlock/register.lisp
index 7180dafb3e422d9326082ddb3ec3b224b77b3be9..bd11402617bea50192ba0ba4188769739c7a41cb 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))
@@ -133,7 +133,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 9020d4a7059c3b63032a62448bd0765ad22b6bee..0bf967da99c1fda7c7b8b98dc8e320477805b904 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*)
@@ -232,6 +220,9 @@
     "/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
@@ -241,7 +232,7 @@
   (setf *editor-windowed-input* nil)
   (cond #+nil(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 +244,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*)
 
@@ -499,7 +490,7 @@
   (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))))
@@ -519,425 +510,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
-
-
-
-;;;; 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))
+;;;; Line Wrap Char.
 
+(defvar *line-wrap-char* #\!
+  "The character to be displayed to indicate wrapped lines.")
 
 
-;;;; 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))
+;;;; Current terminal character translation.
 
-|#
+(defconstant termcap-file "/etc/termcap")
 
-;;; 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 +631,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 +642,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 +670,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)))
@@ -1100,7 +683,7 @@
 
 #|
 (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)
@@ -1113,53 +696,6 @@
 	(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.
 
@@ -1357,7 +893,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 +907,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/shell.lisp b/hemlock/shell.lisp
index 8f8cb6580eaf4eacc43caad1181f90fa12a791bd..fc3af3f0bd48a8415388967452839031bdb28791 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.
diff --git a/hemlock/streams.lisp b/hemlock/streams.lisp
index c719b9aad7834d1ca91f4c01f50988b2d8aadc18..efe2312f3f2b35eff9f35cc09e4c392553027327 100644
--- a/hemlock/streams.lisp
+++ b/hemlock/streams.lisp
@@ -262,52 +262,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 550ed0ca76a6bac45824824882600230070bf75d..56471736cc9726d8f9c0a4cfe6f147571a37d1d3 100644
--- a/hemlock/struct.lisp
+++ b/hemlock/struct.lisp
@@ -589,7 +589,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/tty-display.lisp b/hemlock/tty-display.lisp
index 1473c85d57e968538ba2997a55b5e6a77eebc34c..a3dc628179a907ccd7f2d69f1042c30c6217f8d7 100644
--- a/hemlock/tty-display.lisp
+++ b/hemlock/tty-display.lisp
@@ -218,7 +218,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)))
@@ -711,7 +712,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)))
diff --git a/tools/hemcom.lisp b/tools/hemcom.lisp
index 2093f8fb8580843737511973a81d618b631fbd64..55c55c333f71d485103ea46288ea1bd6349f21aa 100644
--- a/tools/hemcom.lisp
+++ b/tools/hemcom.lisp
@@ -36,27 +36,11 @@
 (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")
 
-
 (pushnew :command-bits *features*)
 (pushnew :buffered-lines *features*)
 
-
 (with-compiler-log-file ("hem:lossage.log")
 
 (comf "code:globals" :always-once t)
@@ -65,10 +49,18 @@
 (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:key-event" :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)
+(comf "hem:keysym-defs" :load t)
+(comf "hem:input.lisp")
 (comf "hem:macros" :always-once t)
 (comf "hem:line" :always-once t)
 (comf "hem:ring")