From 61ee3de2e546f55d7712214881b3ec0278bbf03e Mon Sep 17 00:00:00 2001
From: ram <ram>
Date: Fri, 11 Feb 1994 21:54:44 +0000
Subject: [PATCH] Copy new_compiler branch to trunk.

---
 hemlock/abbrev.lisp        |   2 +-
 hemlock/bindings.lisp      | 153 +++++++--
 hemlock/bit-stream.lisp    |   2 +-
 hemlock/charmacs.lisp      |  74 ++---
 hemlock/cursor.lisp        |   2 +-
 hemlock/dired.lisp         |   2 +-
 hemlock/diredcoms.lisp     |  34 +-
 hemlock/echocoms.lisp      |  41 ++-
 hemlock/eval-server.lisp   |   2 +-
 hemlock/filecoms.lisp      |  60 ++--
 hemlock/files.lisp         | 207 ++++++------
 hemlock/fill.lisp          |  18 +-
 hemlock/group.lisp         |   2 +-
 hemlock/htext2.lisp        |   2 +-
 hemlock/htext3.lisp        |   2 +-
 hemlock/input.lisp         |  64 ++--
 hemlock/kbdmac.lisp        |  15 +-
 hemlock/key-event.lisp     |   2 +-
 hemlock/killcoms.lisp      |   2 +-
 hemlock/line.lisp          |   2 +-
 hemlock/linimage.lisp      |   2 +-
 hemlock/lispbuf.lisp       |   2 +-
 hemlock/lispeval.lisp      |   2 +-
 hemlock/lispmode.lisp      | 606 +++++++++++++++++++++++++---------
 hemlock/mh.lisp            | 323 +++++++++----------
 hemlock/morecoms.lisp      |  20 +-
 hemlock/pop-up-stream.lisp |   2 +-
 hemlock/register.lisp      |  16 +-
 hemlock/ring.lisp          |   2 +-
 hemlock/rompsite.lisp      | 642 +++++++++++++++++++++----------------
 hemlock/screen.lisp        |  36 ++-
 hemlock/search1.lisp       |   2 +-
 hemlock/shell.lisp         | 193 ++++++++++-
 hemlock/spell-aug.lisp     |   2 +-
 hemlock/spell-build.lisp   |   2 +-
 hemlock/spell-corr.lisp    |   2 +-
 hemlock/spell-rt.lisp      |   2 +-
 hemlock/spellcoms.lisp     |  21 +-
 hemlock/streams.lisp       | 129 ++------
 hemlock/struct.lisp        |  47 +--
 hemlock/syntax.lisp        |   2 +-
 hemlock/table.lisp         |   2 +-
 hemlock/text.lisp          |   2 +-
 hemlock/ts-stream.lisp     |   2 +-
 hemlock/tty-disp-rt.lisp   |   2 +-
 hemlock/tty-display.lisp   | 459 ++++++++++++++++++--------
 hemlock/tty-stream.lisp    |   2 +-
 47 files changed, 2039 insertions(+), 1173 deletions(-)

diff --git a/hemlock/abbrev.lisp b/hemlock/abbrev.lisp
index 9ce843d0f..6cfc0e790 100644
--- a/hemlock/abbrev.lisp
+++ b/hemlock/abbrev.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/abbrev.lisp,v 1.1.1.4 1991/11/09 03:05:25 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/abbrev.lisp,v 1.2 1994/02/11 21:54:44 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/bindings.lisp b/hemlock/bindings.lisp
index 0a0734ac2..a323af9ec 100644
--- a/hemlock/bindings.lisp
+++ b/hemlock/bindings.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/bindings.lisp,v 1.4 1994/02/11 21:52:48 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Some bindings:
@@ -156,8 +159,8 @@
 (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 "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")
 
@@ -331,6 +334,7 @@
 (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 "Typescript Slave Status" #k"hyper-s" :mode "Typescript")
 (bind-key "Select Slave" #k"control-meta-\c")
 (bind-key "Select Background" #k"control-meta-C")
 
@@ -345,6 +349,7 @@
 ;;;; Lisp (some).
 
 (bind-key "Indent Form" #k"control-meta-q")
+(bind-key "Fill Lisp Comment Paragraph" #k"meta-q" :mode "Lisp")
 (bind-key "Defindent" #k"control-meta-#")
 (bind-key "Beginning of Defun" #k"control-meta-[")
 (bind-key "End of Defun" #k"control-meta-]")
@@ -382,6 +387,25 @@
 
 (bind-key "Goto Definition" #k"control-meta-F")
 
+(bind-key "Debug Up" #k"control-meta-hyper-u")
+(bind-key "Debug Down" #k"control-meta-hyper-d")
+(bind-key "Debug Top" #k"control-meta-hyper-t")
+(bind-key "Debug Bottom" #k"control-meta-hyper-b")
+(bind-key "Debug Frame" #k"control-meta-hyper-f")
+(bind-key "Debug Quit" #k"control-meta-hyper-q")
+(bind-key "Debug Go" #k"control-meta-hyper-g")
+(bind-key "Debug Abort" #k"control-meta-hyper-a")
+(bind-key "Debug Restart" #k"control-meta-hyper-r")
+(bind-key "Debug Help" #k"control-meta-hyper-h")
+(bind-key "Debug Error" #k"control-meta-hyper-e")
+(bind-key "Debug Backtrace" #k"control-meta-hyper-B")
+(bind-key "Debug Print" #k"control-meta-hyper-p")
+(bind-key "Debug Verbose Print" #k"control-meta-hyper-P")
+(bind-key "Debug List Locals" #k"control-meta-hyper-l")
+(bind-key "Debug Source" #k"control-meta-hyper-s")
+(bind-key "Debug Edit Source" #k"control-meta-hyper-S")
+(bind-key "Debug Flush Errors" #k"control-meta-hyper-F")
+
 
 
 ;;;; More Miscellaneous bindings.
@@ -391,7 +415,7 @@
 
 (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 "Transpose Regions" #k"control-x t")
 
 (bind-key "Uppercase Region" #k"control-x control-u")
 (bind-key "Lowercase Region" #k"control-x control-l")
@@ -435,7 +459,7 @@
 
 (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 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")
@@ -539,13 +563,16 @@
 
 ;;;; Mailer commands.
 
+;;; Clear everything user might hit to avoid getting the internal error
+;;; message about modifying read-only buffers.
+;;;
 (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" #k"control-x i")
 (bind-key "Send Message" #k"control-x m")
 (bind-key "Message Headers" #k"control-x r")
@@ -556,7 +583,6 @@
 ;;; The bindings in these two blocks should be the same, one for "Message" mode
 ;;; and one for "Headers" mode.
 ;;;
-
 (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")
@@ -572,7 +598,7 @@
 (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")
@@ -591,7 +617,7 @@
 
 
 ;;; Headers mode.
-
+;;;
 (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")
@@ -602,7 +628,7 @@
 
 
 ;;; Message mode.
-
+;;;
 (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")
@@ -616,7 +642,7 @@
 
 
 ;;; Draft mode.
-
+;;;
 (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")
@@ -627,11 +653,102 @@
 (bind-key "Draft Help" #k"hyper-?" :mode "Draft")
 
 
+
+;;;; Netnews.
+
+;;; Clear everything user might hit to avoid getting the internal error
+;;; message about modifying read-only buffers.
+;;;
+(do-alpha-key-events (key-event :both)
+  (bind-key "Illegal" key-event :mode "News-Headers")
+  (bind-key "Illegal" key-event :mode "News-Message"))
+
+
+;;; Global Netnews bindings
+;;;
+(bind-key "Netnews Post Message" #k"C-x P")
+
+
+;;; Both News-Headers and News-Message modes.
+;;;
+;;; The bindings in these two blocks should be the same, one for "News-Message"
+;;; mode and one for "News-Headers" mode.
+;;;
+(bind-key "List All Groups" #k"l" :mode "News-Headers")
+(bind-key "Netnews Append to File" #k"a" :mode "News-Headers")
+(bind-key "Netnews Forward Message" #k"f" :mode "News-Headers")
+(bind-key "Netnews Go to Next Group" #k"g" :mode "News-Headers")
+(bind-key "Netnews Next Article" #k"n" :mode "News-Headers")
+(bind-key "Netnews Previous Article" #k"p" :mode "News-Headers")
+(bind-key "Netnews Quit Starting Here" #k"." :mode "News-Headers")
+(bind-key "Netnews Group Punt Messages" #k"G" :mode "News-Headers")
+(bind-key "Netnews Show Whole Header" #k"w" :mode "News-Headers")
+(bind-key "Netnews Reply to Sender in Other Window" #k"r" :mode "News-Headers")
+(bind-key "Netnews Reply to Group in Other Window" #k"R" :mode "News-Headers")
+;;;
+(bind-key "List All Groups" #k"l" :mode "News-Message")
+(bind-key "Netnews Append to File" #k"a" :mode "News-Message")
+(bind-key "Netnews Forward Message" #k"f" :mode "News-Message")
+(bind-key "Netnews Go to Next Group" #k"g" :mode "News-Message")
+(bind-key "Netnews Next Article" #k"n" :mode "News-Message")
+(bind-key "Netnews Previous Article" #k"p" :mode "News-Message")
+(bind-key "Netnews Quit Starting Here" #k"." :mode "News-Message")
+(bind-key "Netnews Group Punt Messages" #k"G" :mode "News-Message")
+(bind-key "Netnews Show Whole Header" #k"w" :mode "News-Message")
+(bind-key "Netnews Reply to Sender in Other Window" #k"r" :mode "News-Message")
+(bind-key "Netnews Reply to Group in Other Window" #k"R" :mode "News-Message")
+
+
+;;; News-Headers.
+;;;
+(bind-key "Netnews Exit" #k"q" :mode "News-Headers")
+(bind-key "Netnews Headers File Message" #k"o" :mode "News-Headers")
+(bind-key "Netnews Headers Scroll Window Down" #k"c-v" :mode "News-Headers")
+(bind-key "Netnews Headers Scroll Window Up" #k"m-v" :mode "News-Headers")
+(bind-key "Netnews Next Line" #k"C-n" :mode "News-Headers")
+(bind-key "Netnews Next Line" #k"Downarrow" :mode "News-Headers")
+(bind-key "Netnews Previous Line" #k"C-p" :mode "News-Headers")
+(bind-key "Netnews Previous Line" #k"Uparrow" :mode "News-Headers")
+(bind-key "Netnews Select Message Buffer" #k"hyper-m" :mode "News-Headers")
+(bind-key "Netnews Show Article" #k"space" :mode "News-Headers")
+
+
+;;; News-Message.
+;;;
+(bind-key "Insert Message Region" #k"Hyper-y" :mode "News-Message")
+(bind-key "Netnews Message File Message" #k"o" :mode "News-Message")
+(bind-key "Netnews Message Keep Buffer" #k"k" :mode "News-Message")
+(bind-key "Netnews Message Quit" #k"q" :mode "News-Message")
+(bind-key "Netnews Message Scroll Down"  #k"space" :mode "News-Message")
+(bind-key "Netnews Goto Draft Buffer" #k"hyper-d" :mode "News-Message")
+(bind-key "Netnews Goto Headers Buffer" #k"^" :mode "News-Message")
+(bind-key "Netnews Goto Headers Buffer" #k"hyper-h" :mode "News-Message")
+(bind-key "Netnews Goto Post Buffer" #k"hyper-p" :mode "News-Message")
+(bind-key "Scroll Window Up" #k"backspace" :mode "News-Message")
+
+
+;;; Post.
+;;;
+(bind-key "Netnews Select Message Buffer" #k"hyper-m" :mode "Post")
+(bind-key "Netnews Deliver Post" #k"hyper-s" :mode "Post")
+(bind-key "Netnews Abort Post" #k"hyper-q" :mode "Post")
+(bind-key "Insert Message Buffer" #k"Hyper-y" :mode "Post")
+
+
+;;; News-Browse.
+
+(bind-key "Netnews Quit Browse" #k"q" :mode "News-Browse")
+(bind-key "Netnews Browse Add Group To File" #k"a" :mode "News-Browse")
+(bind-key "Netnews Browse Read Group" #k"space" :mode "News-Browse")
+(bind-key "Next Line" #k"n" :mode "News-Browse")
+(bind-key "Previous Line" #k"p" :mode "News-Browse")
+
 
 ;;;; Process (Shell).
 
-(bind-key "Confirm Process Input" #k"return" :mode "Process")
 (bind-key "Shell" #k"control-meta-s")
+(bind-key "Confirm Process Input" #k"return" :mode "Process")
+(bind-key "Shell Complete Filename" #k"M-escape" :mode "Process")
 (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-\\")
@@ -648,7 +765,7 @@
 
 ;;;; Bufed.
 
-(bind-key "Bufed" #k"control-x control-meta-b"))
+(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")
@@ -667,7 +784,7 @@
 
 ;;;; Dired.
 
-(bind-key "Dired" #k"control-x control-meta-d"))
+(bind-key "Dired" #k"control-x control-meta-d")
 
 (bind-key "Dired Delete File and Down Line" #k"d" :mode "Dired")
 (bind-key "Dired Delete File with Pattern" #k"D" :mode "Dired")
diff --git a/hemlock/bit-stream.lisp b/hemlock/bit-stream.lisp
index 2d9a3ba41..43c064348 100644
--- a/hemlock/bit-stream.lisp
+++ b/hemlock/bit-stream.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/bit-stream.lisp,v 1.1.1.5 1993/08/25 02:23:30 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/bit-stream.lisp,v 1.2 1994/02/11 21:52:51 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/charmacs.lisp b/hemlock/charmacs.lisp
index 8f21fc171..6b271f55c 100644
--- a/hemlock/charmacs.lisp
+++ b/hemlock/charmacs.lisp
@@ -1,65 +1,43 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/charmacs.lisp,v 1.3 1994/02/11 21:52:52 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Implementation specific character-hacking macros and constants.
 ;;;
-(in-package 'hemlock-internals)
-(export ' (syntax-char-code-limit command-char-bits-limit
-	   command-char-code-limit search-char-code-limit
-	   do-alpha-chars))
-
-;;; This file contains various constants and macros which are
-;;; implementation or ASCII dependant.  In particular it contains
-;;; all the character implementation parameters such as
-;;; Command-Char-Bits-Limit, and contains various versions
-;;; of char-code which don't check types and omit the top bit
-;;; so that various structures can be allocated 128 long instead
-;;; of 256, and we don't get errors if a loser visits a binary file.
+(in-package "HEMLOCK-INTERNALS")
+(export ' (syntax-char-code-limit search-char-code-limit do-alpha-chars))
 
-;;; There are so many different constants and macros that do the same
-;;; thing because in principle the char-code-limit for the syntax
-;;; functions is independant of that for the searching functions, etc.
+;;; This file contains various constants and macros which are implementation or
+;;; ASCII dependant.  It contains some versions of CHAR-CODE which do not check
+;;; types and ignore the top bit so that various structures can be allocated
+;;; 128 long instead of 256, and we don't get errors if a loser visits a binary
+;;; file.
+;;;
+;;; There are so many different constants and macros implemented the same.
+;;; This is to separate various mechanisms; for example, in principle the
+;;; char-code-limit for the syntax functions is independant of that for the
+;;; searching functions
+;;;
 
-;;; This file also contains code which adds any implementation specific
-;;; character names to the char file's Char-Name-Alist so that there
-;;; is a reasonable read-syntax and print-representation for all
-;;; characters a user might run across.
 
 
 ;;;; Stuff for the Syntax table functions (syntax)
 
-(defconstant syntax-char-code-limit 128
+(defconstant syntax-char-code-limit char-code-limit
   "The highest char-code which a character argument to the syntax
   table functions may have.")
-(defconstant syntax-char-code-mask #x+7f
-  "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 (lisp::%sp-make-fixnum ,char)))
 
-;;;; Stuff for the command interpreter (interp)
-;;;
-;;;    On the Perq we have bits for command bindings, on the VAX there 
-;;; aren't.  The code to interpret them is conditionally compiled
-;;; so that the VAX isnt't slowed down.
-;;;
-;;; Make command-char-code-limit 256 instead of 128 for X keyboard scan-codes.
-(defconstant command-char-code-limit 256
-  "The upper bound on character codes supported for key bindings.")
-(defconstant command-char-bits-limit 16
-  "The maximum value of character bits supported for key bindings.")
-(defmacro key-char-bits (char)
-  `(ash (logand #x+F00 (lisp::%sp-make-fixnum ,char)) -8))
-(defmacro key-char-code (char)
+(defmacro syntax-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)
@@ -67,7 +45,7 @@
 (defconstant search-char-code-limit 128
   "The exclusive upper bound on significant char-codes for searching.")
 (defmacro search-char-code (ch)
-  `(logand (lisp::%sp-make-fixnum ,ch) #x+7F))
+  `(logand (char-code ,ch) #x+7F))
 ;;;
 ;;;    search-hash-code must be a function with the following properties:
 ;;; given any character it returns a number between 0 and 
@@ -76,12 +54,12 @@
 ;;;    In ASCII this is can be done by ANDing out the 5'th bit.
 ;;;
 (defmacro search-hash-code (ch)
-  `(logand (lisp::%sp-make-fixnum ,ch) #x+5F))
+  `(logand (char-code ,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)
-  `(lisp::fast-char-upcase ,ch))
+  `(char-upcase (the base-char ,ch)))
 
 
 
diff --git a/hemlock/cursor.lisp b/hemlock/cursor.lisp
index c65901953..9173b0c80 100644
--- a/hemlock/cursor.lisp
+++ b/hemlock/cursor.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/cursor.lisp,v 1.1.1.6 1993/08/25 02:23:38 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/cursor.lisp,v 1.2 1994/02/11 21:52:53 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/dired.lisp b/hemlock/dired.lisp
index 1ce5e2511..2874018ce 100644
--- a/hemlock/dired.lisp
+++ b/hemlock/dired.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/dired.lisp,v 1.1.1.6 1993/09/01 09:47:37 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/dired.lisp,v 1.2 1994/02/11 21:52:54 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/diredcoms.lisp b/hemlock/diredcoms.lisp
index 6c427ed6b..f9bca8373 100644
--- a/hemlock/diredcoms.lisp
+++ b/hemlock/diredcoms.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC).
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/diredcoms.lisp,v 1.3 1994/02/11 21:52:56 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Simple directory editing support.
@@ -331,11 +334,8 @@
     (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)))))))
+		   (truename (make-pathname :directory (nconc dirs '(:UP)))))))
 
 
 
@@ -434,14 +434,12 @@
 (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.")))
 
@@ -760,15 +758,17 @@
 	      (push (cons pathname (file-write-date pathname))
 		    marked-files)))))))
 
-;;; ARRAY-ELEMENT-FROM-MARK counts the lines between it and the beginning
-;;; of the buffer.  The number is used to index vector as if each line
-;;; mapped to an element starting with the zero'th element (lines are
-;;; numbered starting at 1).
+;;; ARRAY-ELEMENT-FROM-MARK -- Internal Interface.
+;;;
+;;; This counts the lines between it and the beginning of the buffer.  The
+;;; number is used to index vector as if each line mapped to an element
+;;; starting with the zero'th element (lines are numbered starting at 1).
+;;; This must use AREF since some modes use this with extendable vectors.
 ;;;
 (defun array-element-from-mark (mark vector
 				&optional (error-msg "Invalid line."))
   (when (blank-line-p (mark-line mark)) (editor-error error-msg))
-  (svref vector
+  (aref vector
 	 (1- (count-lines (region
 			   (buffer-start-mark (line-buffer (mark-line mark)))
 			   mark)))))
@@ -787,7 +787,7 @@
 ;;; one directory.
 ;;;
 (defun dired-directorify (pathname)
-  (let ((directory (lisp::predict-name pathname t)))
+  (let ((directory (ext:unix-namestring pathname)))
     (if (directoryp directory)
 	directory
 	(pathname (concatenate 'simple-string (namestring directory) "/")))))
diff --git a/hemlock/echocoms.lisp b/hemlock/echocoms.lisp
index ab47e05fe..9b8ec8aca 100644
--- a/hemlock/echocoms.lisp
+++ b/hemlock/echocoms.lisp
@@ -1,18 +1,21 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/echocoms.lisp,v 1.3 1994/02/11 21:52:59 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Echo area commands.
 ;;;
 ;;; Written by Rob MacLachlan and Skef Wholey.
 ;;;
-(in-package 'hemlock)
+(in-package "HEMLOCK")
 
 (defhvar "Beep on Ambiguity"
   "If non-NIL, beep when completion of a parse is ambiguous."
@@ -21,7 +24,7 @@
 (defhvar "Ignore File Types"
   "File types to ignore when trying to complete a filename."
   :value
-  (list "fasl" "err"			    ; Lisp
+  (list "fasl" "pmaxf" "sparcf" "rtf" "hpf" "axpf" "err" ; Lisp
 	"BAK" "CKP"			    ; Backups & Checkpoints
 	"PS" "ps" "press" "otl" "dvi" "toc" ; Formatting
 	"bbl" "lof" "idx" "lot" "aux"	    ; Formatting
@@ -85,9 +88,20 @@
 	  (write-line help s)
 	  (cond (pns
 		 (write-line "Possible completions of what you have typed:" s)
-		 (dolist (pn pns)
-		   (format s " ~A~25T ~A~%" (file-namestring pn)
-			   (directory-namestring pn))))
+		 (let ((width (- (window-width (current-window)) 27)))
+		   (dolist (pn pns)
+		     (let* ((dir (directory-namestring pn))
+			    (len (length dir)))
+		       (unless (<= len width)
+			 (let ((slash (position #\/ dir
+						:start (+ (- len width) 3))))
+			   (setf dir
+				 (if slash
+				     (concatenate 'string "..."
+						  (subseq dir slash))
+				     "..."))))
+		       (format s " ~A~25T ~A~%"
+			       (file-namestring pn) dir)))))
 		(t
 		 (write-line 
  "There are no possible completions of what you have typed." s))))))
@@ -215,7 +229,6 @@
   "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)
@@ -251,6 +264,12 @@
   (declare (ignore p))
   (editor-error))
 
+(add-hook window-buffer-hook
+	  #'(lambda (window new-buff)
+	      (when (and (eq window *echo-area-window*)
+			 (not (eq new-buff *echo-area-buffer*)))
+		(editor-error "Can't change echo area window."))))
+
 (defcommand "Beginning Of Parse" (p)
   "Moves to immediately after the prompt when in the echo area."
   "Move the point of the echo area buffer to *parse-starting-mark*."
diff --git a/hemlock/eval-server.lisp b/hemlock/eval-server.lisp
index 6c9b3b059..9256e9f4b 100644
--- a/hemlock/eval-server.lisp
+++ b/hemlock/eval-server.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/eval-server.lisp,v 1.1.1.15 1994/02/04 15:20:29 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/eval-server.lisp,v 1.2 1994/02/11 21:53:00 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/filecoms.lisp b/hemlock/filecoms.lisp
index 599a9b1eb..1399dbac1 100644
--- a/hemlock/filecoms.lisp
+++ b/hemlock/filecoms.lisp
@@ -1,15 +1,19 @@
 ;;; -*- Package: Hemlock; Log: hemlock.log -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/filecoms.lisp,v 1.4 1994/02/11 21:53:02 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; This file contains file/buffer manipulating commands.
 ;;;
+
 (in-package "HEMLOCK")
 
 
@@ -271,8 +275,8 @@
       (unless (eq b buffer)
 	(let ((bpn (buffer-pathname b)))
 	  (when (equal bpn buffer-pn)
-	    (message "Buffer ~A also contains ~A."
-		     (buffer-name b) (namestring buffer-pn))
+	    (loud-message "Buffer ~A also contains ~A."
+			  (buffer-name b) (namestring buffer-pn))
 	    (return)))))))
 
 
@@ -282,15 +286,15 @@
 
 (defcommand "Revert File" (p)
   "Unless in Save Mode, reads in the last saved version of the file in
-  the current buffer. When in Save Mode, reads in the last checkpoint or
-  the last saved version, whichever is more recent. An argument will always
-  force Revert File to use the last saved version. In either case, if the
-  buffer has been modified and \"Revert File Confirm\" is true, then Revert
-  File will ask for confirmation beforehand. An attempt is made to maintain
-  the point's relative position."
+   the current buffer. When in Save Mode, reads in the last checkpoint or
+   the last saved version, whichever is more recent. An argument will always
+   force Revert File to use the last saved version. In either case, if the
+   buffer has been modified and \"Revert File Confirm\" is true, then Revert
+   File will ask for confirmation beforehand. An attempt is made to maintain
+   the point's relative position."
   "With an argument reverts to the last saved version of the file in the
-  current buffer. Without, reverts to the last checkpoint or last saved
-  version, whichever is more recent."
+   current buffer. Without, reverts to the last checkpoint or last saved
+   version, whichever is more recent."
   (let* ((buffer (current-buffer))
 	 (buffer-pn (buffer-pathname buffer))
 	 (point (current-point))
@@ -326,7 +330,8 @@
   (let* ((buffer-pn (buffer-pathname buffer))
 	 (buffer-pn-date (file-write-date buffer-pn))
 	 (checkpoint-pn (get-checkpoint-pathname buffer))
-	 (checkpoint-pn-date (file-write-date checkpoint-pn)))
+	 (checkpoint-pn-date (and checkpoint-pn
+				  (file-write-date checkpoint-pn))))
     (cond (checkpoint-pn-date
 	   (if (> checkpoint-pn-date (or buffer-pn-date 0))
 	       (values checkpoint-pn t)
@@ -340,11 +345,11 @@
 
 (defcommand "Find File" (p &optional pathname)
   "Visit a file in its own buffer.
-  If the file is already in some buffer, select that buffer,
-  otherwise make a new buffer with the same name as the file and
-  read the file into it."
+   If the file is already in some buffer, select that buffer,
+   otherwise make a new buffer with the same name as the file and
+   read the file into it."
   "Make a buffer containing the file Pathname current, creating a buffer
-  if necessary.  The buffer is returned."
+   if necessary.  The buffer is returned."
   (declare (ignore p))
   (let* ((pn (or pathname
 		 (prompt-for-file 
@@ -369,13 +374,13 @@
 		     :key #'buffer-pathname :test #'equal)))
     (cond ((not found)
 	   (let* ((name (pathname-to-buffer-name trial-pathname))
-		  (buffer (getstring name *buffer-names*))
-		  (use (if buffer
+		  (found (getstring name *buffer-names*))
+		  (use (if found
 			   (prompt-for-buffer
 			    :prompt "Buffer to use: "
 			    :help
   "Buffer name in use; give another buffer name, or confirm to reuse."
-			    :default buffer :must-exist nil)
+			    :default found :must-exist nil)
 			   (make-buffer name)))
 		  (buffer (if (stringp use) (make-buffer use) use)))
 	     (when (and (buffer-modified buffer)
@@ -456,6 +461,7 @@
    file exists, set the buffer's pathname to the probed pathname; else, set it
    to pathname merged with DEFAULT-DIRECTORY.  Set \"Pathname Defaults\" to the
    same thing.  Process the file options, and then invoke \"Read File Hook\"."
+  (setf (buffer-writable buffer) t)
   (delete-region (buffer-region buffer))
   (let* ((pathname (pathname pathname))
 	 (probed-pathname (probe-file pathname)))
@@ -778,6 +784,14 @@
 	     (buffer-name buffer)
 	     (setf (buffer-writable buffer) (not (buffer-writable buffer))))))
 
+(defcommand "Set Buffer Writable" (p)
+  "Make the current buffer modifiable."
+  "Make the current buffer modifiable."
+  (declare (ignore p))
+  (let ((buffer (current-buffer)))
+    (setf (buffer-writable buffer) t)
+    (message "Buffer ~S is now writable." (buffer-name buffer))))
+
 (defcommand "Kill Buffer" (p &optional buffer-name)
   "Prompts for a buffer to delete.
   If the buffer is modified, then let the user save the file before doing so.
diff --git a/hemlock/files.lisp b/hemlock/files.lisp
index 14167a352..f1cba3585 100644
--- a/hemlock/files.lisp
+++ b/hemlock/files.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/files.lisp,v 1.3 1994/02/11 21:53:04 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Hemlock File manipulation functions.
@@ -17,6 +20,21 @@
 (export '(read-file write-file))
 
 
+
+;;;; Utility functions.
+
+(defun find-char-from-sap (sap start end char)
+  (declare (type system-area-pointer sap)
+	   (type (integer 0 (#.most-positive-fixnum)) start end)
+	   (type base-char char))
+  (do ((index start (1+ index))
+       (code (char-code char)))
+      ((>= index end) nil)
+    (declare (type (integer 0 #.most-positive-fixnum) index)
+	     (type (unsigned-byte 8) code))
+    (when (= (sap-ref-8 sap index) code)
+      (return index))))
+
 
 ;;; Read-File:
 
@@ -25,36 +43,36 @@
   (with-mark ((mark mark :left-inserting))
     (let* ((tn (truename pathname))
 	   (name (namestring tn))
-	   (alien ())
+	   (sap nil)
 	   (size 0))
-      (declare (fixnum size))
-      (multiple-value-bind (fd err) (mach:unix-open name mach:o_rdonly 0)
-	(if (not (null fd))
-	    (multiple-value-bind (res dev ino mode nlnk uid gid rdev len)
-				 (mach:unix-fstat fd)
-	      (declare (ignore ino mode nlnk uid gid rdev))
-	      (setq err ())
-	      (if (null res)
-		  (setq err dev)
-		  (multiple-value-bind (gr addr)
-				       (mach::vm_allocate lisp::*task-self*
-							  0 len t)
-		    (gr-error 'mach::vm_allocate gr 'read-file)
-		    (setq alien (lisp::fixnum-to-sap addr))
-		    (setq size len)
-		    (multiple-value-bind
-			(bytes err3)
-			(mach:unix-read fd (lisp::fixnum-to-sap addr) len)
-		      (if (or (null bytes) (not (eq len bytes)))
-			  (setq err err3)))))
-	      (mach:unix-close fd)))
-	(if err (error "Reading file ~A, unix error ~A."
-		       name (mach:get-unix-error-msg err)))
-	(when (zerop size) (return-from read-file nil))
-	(let* ((sap alien)
-	       (first-line (mark-line mark))
+      (declare (fixnum size)
+	       (type (or null system-area-pointer) sap))
+      (multiple-value-bind (fd err) (unix:unix-open name unix:o_rdonly 0)
+	(when fd
+	  (multiple-value-bind (res dev ino mode nlnk uid gid rdev len)
+			       (unix:unix-fstat fd)
+	    (declare (ignore ino mode nlnk uid gid rdev))
+	    (cond ((null res)
+		   (setq err dev))
+		  (t
+		   (setf sap (system:allocate-system-memory len))
+		   (setf size len)
+		   (multiple-value-bind
+		       (bytes err3)
+		       (unix:unix-read fd sap len)
+		     (if (or (null bytes) (not (= len bytes)))
+			 (setq err err3)
+			 (setq err nil))))))
+	  (unix:unix-close fd))
+	(when err
+	  (error "Reading file ~A, unix error ~A."
+		 name (unix:get-unix-error-msg err)))
+	(when (zerop size)
+	  (return-from read-file nil))
+	(let* ((first-line (mark-line mark))
 	       (buffer (line-%buffer first-line))
-	       (index (%primitive find-character sap 0 size #\newline)))
+	       (index (find-char-from-sap sap 0 size #\newline)))
+	  (declare (type (or null (integer 0 (#.most-positive-fixnum))) index))
 	  (modifying-buffer buffer)
 	  (let* ((len (or index size))
 		 (chars (make-string len)))
@@ -62,11 +80,9 @@
 	    (insert-string mark chars))
 	  (when index
 	    (insert-character mark #\newline)
-	    (do* ((old-index (1+ (the fixnum index)) (1+ (the fixnum index)))
-		  (index (%primitive find-character sap old-index size
-				     #\newline)
-			 (%primitive find-character sap old-index size
-				     #\newline))
+	    (do* ((old-index (1+ index) (1+ index))
+		  (index (find-char-from-sap sap old-index size #\newline)
+			 (find-char-from-sap sap old-index size #\newline))
 		  (number (+ (line-number first-line) line-increment)
 			  (+ number line-increment))
 		  (previous first-line))
@@ -89,7 +105,7 @@
 			   :previous previous
 			   :%buffer buffer
 			   :number number
-			   :chars (%primitive sap+ sap old-index)
+			   :chars (system:sap+ sap old-index)
 			   :buffered-p
 			   (the fixnum (- (the fixnum index) old-index)))))
 		(setf (line-next previous) line)
@@ -109,18 +125,25 @@
 
 ;;; Write-File:
 
-(defun write-file (region pathname &key
+(defun write-file (region pathname &key append
 			  (keep-backup (value ed::keep-backup-files))
 			  access)
-  "Writes the characters in the Region to the file named by Pathname.
-   Region is written using a stream opened with :if-exists :rename-and-delete,
-   but keep-backup, when supplied as non-nil, causes :rename to be supplied
-   instead of :rename-and-delete.  Access is an implementation dependent value
-   that is suitable for setting pathname's access or protection bits."
-  (let ((if-exists-action (if keep-backup
-			      :rename
-			      :rename-and-delete)))
-    (with-open-file (file pathname :direction :output :element-type 'string-char
+  "Writes the characters in region to the file named by pathname.  This writes
+   region using a stream opened with :if-exists :rename-and-delete, unless
+   either append or keep-backup is supplied.  If append is supplied, this
+   writes the file opened with :if-exists :append.  If keep-backup is supplied,
+   this writes the file opened with :if-exists :rename.  This signals an error
+   if both append and keep-backup are supplied.  Access is an implementation
+   dependent value that is suitable for setting pathname's access or protection
+   bits."
+  (let ((if-exists-action (cond ((and keep-backup append)
+				 (error "Cannot supply non-nil values for ~
+				         both keep-backup and append."))
+				(keep-backup :rename)
+				(append :append)
+				(t :rename-and-delete))))
+    (with-open-file (file pathname :direction :output
+			  :element-type 'base-char
 			  :if-exists if-exists-action)
       (close-line)
       (fast-write-file region file))
@@ -132,17 +155,10 @@
 	  ;; If this is ever moved to the beginning of this function to use
 	  ;; Unix CREAT to create the file protected initially, they TRUENAME
 	  ;; will signal an error, and LISP::PREDICT-NAME will have to be used.
-	  (mach:unix-chmod (namestring (truename pathname)) access)
+	  (unix:unix-chmod (namestring (truename pathname)) access)
 	(unless winp
 	  (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)
-  "Size, in bytes, of each VM page.")
+		 (unix:get-unix-error-msg code)))))))
 
 (defun fast-write-file (region file)
   (let* ((start (region-start region))
@@ -159,44 +175,39 @@
 	(do ((line (line-next start-line) (line-next line)))
 	    ((eq line end-line))
 	  (incf length (1+ (line-length line))))
-	(let ((bytes (* *vm-page-size*
-			(ceiling length *vm-page-size*))))
-	  (system:gr-bind (address)
-			  (mach:vm_allocate system:*task-self* 0 bytes t)
-	    (unwind-protect
-		(let ((sap (system:int-sap address)))
-		  (macrolet ((chars (line)
-				    `(if (line-buffered-p ,line)
-				       (line-%chars ,line)
-				       (line-chars ,line))))
+	(let ((sap (system:allocate-system-memory length)))
+	  (unwind-protect
+	      (macrolet ((chars (line)
+				`(if (line-buffered-p ,line)
+				     (line-%chars ,line)
+				     (line-chars ,line))))
+		(system:%primitive byte-blt
+				   (chars start-line) start-charpos
+				   sap 0 first-length)
+		(setf (system:sap-ref-8 sap first-length)
+		      (char-code #\newline))
+		(let ((offset (1+ first-length)))
+		  (do ((line (line-next start-line)
+			     (line-next line)))
+		      ((eq line end-line))
+		    (let ((end (+ offset (line-length line))))
+		      (system:%primitive byte-blt
+					 (chars line) 0
+					 sap offset end)
+		      (setf (system:sap-ref-8 sap end)
+			    (char-code #\newline))
+		      (setf offset (1+ end))))
+		  (unless (zerop end-charpos)
 		    (system:%primitive byte-blt
-				       (chars start-line) start-charpos
-				       sap 0 first-length)
-		    (system:%primitive 8bit-system-set
-				       sap first-length #\newline)
-		    (let ((offset (1+ first-length)))
-		      (do ((line (line-next start-line)
-				 (line-next line)))
-			  ((eq line end-line))
-			(let ((end (+ offset (line-length line))))
-			  (system:%primitive byte-blt
-					     (chars line) 0
-					     sap offset end)
-			  (system:%primitive 8bit-system-set
-					     sap end #\newline)
-			  (setf offset (1+ end))))
-		      (unless (zerop end-charpos)
-			(system:%primitive byte-blt
-					   (chars end-line) 0
-					   sap offset
-					   (+ offset end-charpos)))))
-		  (multiple-value-bind
-		      (okay errno)
-		      (mach:unix-write (system:fd-stream-fd file)
-				       sap 0 length)
-		    (unless okay
-		      (error "Could not write ~S: ~A"
-			     file
-			     (mach:get-unix-error-msg errno))))
-		  (system:gr-call mach:vm_deallocate system:*task-self*
-				  address bytes)))))))))
+				       (chars end-line) 0
+				       sap offset
+				       (+ offset end-charpos))))
+		(multiple-value-bind
+		    (okay errno)
+		    (unix:unix-write (system:fd-stream-fd file)
+				     sap 0 length)
+		  (unless okay
+		    (error "Could not write ~S: ~A"
+			   file
+			   (unix:get-unix-error-msg errno)))))
+	    (system:deallocate-system-memory sap length)))))))
diff --git a/hemlock/fill.lisp b/hemlock/fill.lisp
index c609f764a..6d3d03b83 100644
--- a/hemlock/fill.lisp
+++ b/hemlock/fill.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/fill.lisp,v 1.3 1994/02/11 21:53:06 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;;    Written by Bill Chiles
@@ -82,7 +85,6 @@
 (setf (character-attribute :sentence-closing-char #\>) 1)
 
 
-
 ;;;; -- Commands --
 
 (defcommand "Auto Fill Mode" (p)
@@ -118,7 +120,6 @@
 (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)
@@ -138,7 +139,6 @@
    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)
@@ -188,7 +188,6 @@
 (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))))
@@ -226,6 +225,7 @@
 	  :value val  :buffer (current-buffer))
 	(message "Fill Prefix now ~:[empty~;~:*~S~]" val)))))
 
+(declaim (optimize (speed 2))); turn off byte compilation.
 
 ;;;; -- Auto Filling --
 
diff --git a/hemlock/group.lisp b/hemlock/group.lisp
index a7ba96fbe..9f587fe42 100644
--- a/hemlock/group.lisp
+++ b/hemlock/group.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/group.lisp,v 1.1.1.3 1993/08/25 02:08:50 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/group.lisp,v 1.2 1994/02/11 21:53:07 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/htext2.lisp b/hemlock/htext2.lisp
index 0294632f0..490ccee69 100644
--- a/hemlock/htext2.lisp
+++ b/hemlock/htext2.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/htext2.lisp,v 1.1.1.2 1991/02/08 16:35:07 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/htext2.lisp,v 1.2 1994/02/11 21:53:10 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/htext3.lisp b/hemlock/htext3.lisp
index 9f4078739..8a00bf79b 100644
--- a/hemlock/htext3.lisp
+++ b/hemlock/htext3.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/htext3.lisp,v 1.1.1.3 1991/11/09 03:05:36 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/htext3.lisp,v 1.2 1994/02/11 21:53:11 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/input.lisp b/hemlock/input.lisp
index fa549430f..205fb684c 100644
--- a/hemlock/input.lisp
+++ b/hemlock/input.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC).
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/input.lisp,v 1.3 1994/02/11 21:53:12 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; This file contains the code that handles input to Hemlock.
@@ -186,7 +189,7 @@
 ;;; input method (recursively even).
 ;;;
 (eval-when (compile eval)
-(defmacro editor-input-method-macro (&optional screen-image-trashed-concern)
+(defmacro editor-input-method-macro ()
   `(handler-bind ((error #'(lambda (condition)
 			     (let ((device (device-hunk-device
 					    (window-hunk (current-window)))))
@@ -203,10 +206,8 @@
 	   (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))))
+	 (unless (or (system:serve-event 0)
+		     (internal-redisplay))
 	   (when nrw-fun (funcall nrw-fun t))
 	   (let ((wait (next-scheduled-event-wait)))
 	     (if wait (system:serve-event wait) (system:serve-event)))))
@@ -223,7 +224,7 @@
 
 
 ;;;; Editor input from windowing system.
-
+#+clx
 (defstruct (windowed-editor-input
 	    (:include editor-input
 		      (:get #'windowed-get-key-event)
@@ -232,18 +233,22 @@
 		      (:clear #'windowed-clear-input))
 	    (:print-function
 	     (lambda (s stream d)
-	       (declare (ignore s d write))
+	       (declare (ignore s d))
 	       (write-string "#<Editor-Window-Input stream>" stream)))
 	    (:constructor make-windowed-editor-input
 			  (&optional (head (make-input-event)) (tail head))))
   hunks)      ; List of bitmap-hunks which input to this stream.
 
+#+clx
+;;; There's actually no difference from the TTY case...
 (defun windowed-get-key-event (stream ignore-abort-attempts-p)
-  (editor-input-method-macro))
+  (tty-get-key-event stream ignore-abort-attempts-p))
 
+#+clx
 (defun windowed-unget-key-event (key-event stream)
   (un-event key-event stream))
 
+#+clx
 (defun windowed-clear-input (stream)
   (loop (unless (system:serve-event 0) (return)))
   (without-interrupts
@@ -255,14 +260,16 @@
 	       *free-input-events* next)
        (setf (editor-input-tail stream) head)))))
 
+#+clx
 (defun windowed-listen (stream)
-  (loop (unless (system:serve-event 0)
-	  ;; If nothing is pending, check the queued input.
-	  (return (not (null (input-event-next (editor-input-head stream))))))
+  (loop
+    ;; Don't service anymore events if we just got some input.
     (when (input-event-next (editor-input-head stream))
-      ;; Don't service anymore events if we just got some input.
-      (return t))))
-
+      (return t))
+    ;;
+    ;; If nothing is pending, check the queued input.
+    (unless (system:serve-event 0)
+      (return (not (null (input-event-next (editor-input-head stream))))))))
 
 
 ;;;; Editor input from a tty.
@@ -282,7 +289,7 @@
   fd)
 
 (defun tty-get-key-event (stream ignore-abort-attempts-p)
-  (editor-input-method-macro t))
+  (editor-input-method-macro))
 
 (defun tty-unget-key-event (key-event stream)
   (un-event key-event stream))
@@ -297,11 +304,20 @@
 	       *free-input-events* next)
        (setf (editor-input-tail stream) head)))))
 
+;;; Note that we never return NIL as long as there are events to be served with
+;;; SERVE-EVENT.  Thus non-keyboard input (i.e. process output) 
+;;; effectively causes LISTEN to block until either all the non-keyboard input
+;;; has happened, or there is some real keyboard input.
+;;;
 (defun tty-listen (stream)
-  (cond ((input-event-next (editor-input-head stream)) t)
-	((editor-tty-listen stream) t)
-	(t nil)))
-
+  (loop
+    ;; Don't service anymore events if we just got some input.
+    (when (or (input-event-next (editor-input-head stream))
+	      (editor-tty-listen stream))
+      (return t))
+    ;; If nothing is pending, check the queued input.
+    (unless (system:serve-event 0)
+      (return (not (null (input-event-next (editor-input-head stream))))))))
 
 
 ;;;; GET-KEY-EVENT, UNGET-KEY-EVENT, LISTEN-EDITOR-INPUT, CLEAR-EDITOR-INPUT.
diff --git a/hemlock/kbdmac.lisp b/hemlock/kbdmac.lisp
index c97a20ae3..d72036436 100644
--- a/hemlock/kbdmac.lisp
+++ b/hemlock/kbdmac.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/kbdmac.lisp,v 1.3 1994/02/11 21:53:14 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;;    This file contains the implementation of keyboard macros for
@@ -115,7 +118,7 @@
   (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)))
+  (let ((string (make-array (length key-vector) :element-type 'base-char)))
     (dotimes (i (length key-vector) string)
       (setf (aref string i) (key-event-char (aref key-vector i))))))
 
diff --git a/hemlock/key-event.lisp b/hemlock/key-event.lisp
index 2534d4de5..ef709b237 100644
--- a/hemlock/key-event.lisp
+++ b/hemlock/key-event.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/key-event.lisp,v 1.1.1.11 1993/02/22 14:36:24 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/key-event.lisp,v 1.2 1994/02/11 21:53:15 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/killcoms.lisp b/hemlock/killcoms.lisp
index 5500d049d..37869ab73 100644
--- a/hemlock/killcoms.lisp
+++ b/hemlock/killcoms.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/killcoms.lisp,v 1.1.1.2 1991/02/08 16:35:51 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/killcoms.lisp,v 1.2 1994/02/11 21:53:17 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/line.lisp b/hemlock/line.lisp
index 535da8a24..6224c6212 100644
--- a/hemlock/line.lisp
+++ b/hemlock/line.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/line.lisp,v 1.1.1.4 1993/08/25 02:23:50 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/line.lisp,v 1.2 1994/02/11 21:53:19 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/linimage.lisp b/hemlock/linimage.lisp
index 3fb741f7c..cc7b53828 100644
--- a/hemlock/linimage.lisp
+++ b/hemlock/linimage.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/linimage.lisp,v 1.1.1.7 1993/08/25 02:23:53 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/linimage.lisp,v 1.2 1994/02/11 21:53:20 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/lispbuf.lisp b/hemlock/lispbuf.lisp
index c79d9734f..4fe80b3d5 100644
--- a/hemlock/lispbuf.lisp
+++ b/hemlock/lispbuf.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/lispbuf.lisp,v 1.1.1.4 1991/02/08 16:36:05 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/lispbuf.lisp,v 1.2 1994/02/11 21:53:21 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/lispeval.lisp b/hemlock/lispeval.lisp
index cec6a795c..811eb338c 100644
--- a/hemlock/lispeval.lisp
+++ b/hemlock/lispeval.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/lispeval.lisp,v 1.1.1.12 1993/09/01 03:29:44 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/lispeval.lisp,v 1.2 1994/02/11 21:53:23 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/lispmode.lisp b/hemlock/lispmode.lisp
index 5fab8263b..637522b77 100644
--- a/hemlock/lispmode.lisp
+++ b/hemlock/lispmode.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/lispmode.lisp,v 1.3 1994/02/11 21:53:25 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Hemlock LISP Mode commands
@@ -15,10 +18,11 @@
 
 (in-package "HEMLOCK")
 
+(declaim (optimize (speed 2))); turn off byte compilation.
 
 
-;;;;  ####  VARIABLES  ####
-;;;
+;;;; Variables and lisp-info structure.
+
 ;;; These routines are used to define, for standard LISP mode, the start and end
 ;;; of a block to parse.  If these need to be changed for a minor mode that sits
 ;;; on top of LISP mode, simply do a DEFHVAR with the minor mode and give the
@@ -35,10 +39,9 @@
   :value 'end-of-parse-block)
 
 	    
-;;;; #### STRUCTURES ####
-;;; 
-;;; LISP-INFO is the structure used to store the data about the line in its Plist.
-;;; 
+;;; LISP-INFO is the structure used to store the data about the line in its
+;;; Plist.
+;;;
 ;;;     -> BEGINS-QUOTED, ENDING-QUOTED are both Boolean slots that tell whether
 ;;;        or not a line's begining and/or ending are quoted.
 ;;; 
@@ -62,8 +65,8 @@
 
 
 
-;;;;  ####  MACROS  ####
-;;; 
+;;;; Macros.
+
 ;;; The following Macros exist to make it easy to acces the Syntax primitives
 ;;; without uglifying the code.  They were originally written by Maddox.
 ;;; 
@@ -154,10 +157,10 @@
       `(line-previous ,line)))
 
 
-;;;; #### PARSING FUNCTIONS ###
-;;;
-;;; PRE-COMMAND-PARSE-CHECK
+;;;; Parsing functions.
 
+;;; PRE-COMMAND-PARSE-CHECK -- Public.
+;;;
 (defun pre-command-parse-check (mark &optional (fer-sure-parse nil))
   "Parse the area before the command is actually executed."
   (with-mark ((top mark)
@@ -166,9 +169,8 @@
     (funcall (value parse-end-function) bottom)
     (parse-over-block (mark-line top) (mark-line bottom) fer-sure-parse)))
 
-;;; 
 ;;; PARSE-OVER-BLOCK
-
+;;;
 (defun parse-over-block (start-line end-line &optional (fer-sure-parse nil))
   "Parse over an area indicated from END-LINE to START-LINE."
   (let ((test-line start-line)
@@ -226,8 +228,7 @@
 	 (setq test-line (line-next test-line)))))))
 
 
-;;;;  ####  PARSE BLOCK FINDERS  ####
-;;; 
+;;;; Parse block finders.
 
 (defhvar "Minimum Lines Parsed"
   "The minimum number of lines before and after the point parsed by Lisp mode."
@@ -288,20 +289,23 @@
     (setq line (mark-line mark))))
 
 
-;;; PARSE-LISP-LINE-INFO parses through the line doing the following things:
-;;; 
+;;;; PARSE-LISP-LINE-INFO.
+
+;;; PARSE-LISP-LINE-INFO -- Internal.
+;;;
+;;; This parses through the line doing the following things:
+;;;
 ;;;      Counting/Setting the NET-OPEN-PARENS & NET-CLOSE-PARENS.
-;;; 
+;;;
 ;;;      Making all areas of the line that should be invalid (comments,
 ;;;      char-quotes, and the inside of strings) and such be in
 ;;;      RANGES-TO-IGNORE.
 ;;;
 ;;;      Set BEGINS-QUOTED and ENDING-QUOTED 
-;;; 
-
+;;;
 (defun parse-lisp-line-info (mark line-info prev-line-info)
   "Parse line and set line information like NET-OPEN-PARENS, NET-CLOSE-PARENS,
-RANGES-TO-INGORE, and ENDING-QUOTED."
+   RANGES-TO-INGORE, and ENDING-QUOTED."
   (let ((net-open-parens 0)
 	(net-close-parens 0))
     (declare (fixnum net-open-parens net-close-parens))
@@ -362,26 +366,23 @@ RANGES-TO-INGORE, and ENDING-QUOTED."
     (setf (lisp-info-net-close-parens line-info) net-close-parens)
     (setf (lisp-info-signature-slot line-info) 
 	  (line-signature (mark-line mark)))))
+
+
 
-;;;;  #### STRING QUOTE UTILITIES ####
-;;; 
-;;; 
- 
-;;; 
-;;; VALID-STRING-QUOTE-P
+;;;; String quote utilities.
 
+;;; VALID-STRING-QUOTE-P
+;;;
 (defmacro valid-string-quote-p (mark forwardp)
   "Return T if the string-quote indicated by MARK is valid."
   (let ((test-mark (gensym)))
     `(with-mark ((,test-mark ,mark))
-       
-       ,(unless forwardp              ; TEST-MARK should always be right before the
-	  `(mark-before ,test-mark))   ; String-quote to be checked.
-       
+       ,(unless forwardp
+	  ;; TEST-MARK should always be right before the String-quote to be
+	  ;; checked.
+	  `(mark-before ,test-mark))
        (when (test-char (next-character ,test-mark) :lisp-syntax :string-quote)
-	 
 	 (let ((slash-count 0))
-	   
 	   (loop
 	     (mark-before ,test-mark)
 	     (if (test-char (next-character ,test-mark) :lisp-syntax :char-quote)
@@ -418,45 +419,41 @@ RANGES-TO-INGORE, and ENDING-QUOTED."
 	
 	(neighbor-mark ,e-mark ,forwardp)))))
 
-;;; DEAL-WITH-STRING-QUOTE 
-;;; 
-;;; Called when a string is begun (i.e. parse hits a #\").  It checks for a
-;;; matching quote on the line that MARK points to, and puts the
-;;; appropriate area in the RANGES-TO-IGNORE slot and leaves MARK pointing
-;;; after this area.  The "appropriate area" is from MARK to the end of the
-;;; line or the matching string-quote, whichever comes first.
+;;;; DEAL-WITH-STRING-QUOTE.
 
+;;; DEAL-WITH-STRING-QUOTE
+;;;
+;;; Called when a string is begun (i.e. parse hits a #\").  It checks for a
+;;; matching quote on the line that MARK points to, and puts the appropriate
+;;; area in the RANGES-TO-IGNORE slot and leaves MARK pointing after this area.
+;;; The "appropriate area" is from MARK to the end of the line or the matching
+;;; string-quote, whichever comes first.
+;;;
 (defun deal-with-string-quote (mark info-struct)
   "Alter the current line's info struct as necessary as due to encountering a
-string quote character."
+   string quote character."
   (with-mark ((e-mark mark))
-    
     (cond ((find-valid-string-quote e-mark :forwardp t :cease-at-eol t)
-    
-	   ;; If matching quote is on this line then mark the area between 
-	   ;; the first quote (MARK) and the matching quote as invalid by 
-	   ;; pushing its begining and ending into the IGNORE-RANGE.
-	   
+	   ;; If matching quote is on this line then mark the area between the
+	   ;; first quote (MARK) and the matching quote as invalid by pushing
+	   ;; its begining and ending into the IGNORE-RANGE.
 	   (push-range (cons (mark-charpos mark) (mark-charpos e-mark))
 		       info-struct)
-		       
 	   (setf (lisp-info-ending-quoted info-struct) nil)
 	   (mark-after e-mark)
 	   (move-mark mark e-mark))
-	   
-	  ;; If the EOL has been hit before the matching quote then mark
-	  ;; the area from MARK to the EOL as invalid.
-	  
+	  ;; If the EOL has been hit before the matching quote then mark the
+	  ;; area from MARK to the EOL as invalid.
 	  (t
-	   (push-range (cons (mark-charpos mark) (1+ (line-length (mark-line mark))))
+	   (push-range (cons (mark-charpos mark)
+			     (1+ (line-length (mark-line mark))))
 		       info-struct)
-			 
 	   ;; The Ending is marked as still being quoted. 
-
 	   (setf (lisp-info-ending-quoted info-struct) t)
 	   (line-end mark)
 	   nil))))
-	     
+
+
 
 ;;;; Character validity checking:
 
@@ -469,7 +466,6 @@ string quote character."
 ;;; the buffer beginning or end), then return both values NIL.
 ;;;
 (defun find-ignore-region (mark forwardp)
-  (declare (fixnum pos))
   (flet ((scan (line pos)
 	   (declare (fixnum pos))
 	   (let ((info (getf (line-plist line) 'lisp-info)))
@@ -537,15 +533,15 @@ string quote character."
 	   (setq ,n-won t))))))
 
 
-;;;; #### LIST-OFFSETING ####
-;;; 
+;;;; List offseting.
+
 ;;; %LIST-OFFSET allows for BACKWARD-LIST and FORWARD-LIST to be built
 ;;; with the same existing structure, with the altering of one variable.
 ;;; This one variable being FORWARDP.
 ;;; 
 (defmacro %list-offset (actual-mark forwardp &key (extra-parens 0) )
   "Expand to code that will go forward one list either backward or forward, 
-according to the FORWARDP flag."
+   according to the FORWARDP flag."
   (let ((mark (gensym)))
     `(let ((paren-count ,extra-parens))
        (declare (fixnum paren-count))
@@ -559,8 +555,10 @@ according to the FORWARDP flag."
 	       (case (character-attribute :lisp-syntax ch)
 		 (:close-paren
 		  (decf paren-count)
-		  ,(when forwardp               ; When going forward, an unmatching
-		     `(when (<= paren-count 0)  ; close-paren means the end of list.
+		  ,(when forwardp
+		     ;; When going forward, an unmatching close-paren means the
+		     ;; end of list.
+		     `(when (<= paren-count 0)
 			(neighbor-mark ,mark ,forwardp)
 			(move-mark ,actual-mark ,mark)
 			(return t))))
@@ -573,10 +571,10 @@ according to the FORWARDP flag."
 			(return t))))
 		 
 		 (:newline 
-		  ;; When a #\Newline is hit, then the matching paren must lie on
-		  ;; some other line so drop down into the multiple line balancing
-		  ;; function:  QUEST-FOR-BALANCING-PAREN
-		  ;; If no paren seen yet, keep going.
+		  ;; When a #\Newline is hit, then the matching paren must lie
+		  ;; on some other line so drop down into the multiple line
+		  ;; balancing function: QUEST-FOR-BALANCING-PAREN If no paren
+		  ;; seen yet, keep going.
 		  (cond ((zerop paren-count))
 			((quest-for-balancing-paren ,mark paren-count ,forwardp)
 			 (move-mark ,actual-mark ,mark)
@@ -742,7 +740,7 @@ according to the FORWARDP flag."
 
 
 
-;;;; #### FORM OFFSETING ####
+;;;; Form offseting.
 
 (defmacro %form-offset (mark forwardp)
   `(with-mark ((m ,mark))
@@ -799,8 +797,7 @@ according to the FORWARDP flag."
 
 
 
-;;; Table of special forms with special indenting requirements.
-
+;;;; Table of special forms with special indenting requirements.
 
 (defhvar "Indent Defanything"
   "This is the number of special arguments implicitly assumed to be supplied
@@ -907,6 +904,47 @@ according to the FORWARDP flag."
 (defindent "abort" 1)
 (defindent "continue" 1)
 
+;;; Debug-internals forms.
+;;;
+(defindent "do-debug-function-blocks" 1)
+(defindent "di:do-debug-function-blocks" 1)
+(defindent "do-debug-function-variables" 1)
+(defindent "di:do-debug-function-variables" 1)
+(defindent "do-debug-block-locations" 1)
+(defindent "di:do-debug-block-locations" 1)
+;;;
+;;; Debug-internals conditions
+;;; (define these to make uses of HANDLER-CASE indent branches correctly.)
+;;;
+(defindent "debug-condition" 1)
+(defindent "di:debug-condition" 1)
+(defindent "no-debug-info" 1)
+(defindent "di:no-debug-info" 1)
+(defindent "no-debug-function-returns" 1)
+(defindent "di:no-debug-function-returns" 1)
+(defindent "no-debug-blocks" 1)
+(defindent "di:no-debug-blocks" 1)
+(defindent "lambda-list-unavailable" 1)
+(defindent "di:lambda-list-unavailable" 1)
+(defindent "no-debug-variables" 1)
+(defindent "di:no-debug-variables" 1)
+(defindent "invalid-value" 1)
+(defindent "di:invalid-value" 1)
+(defindent "ambiguous-variable-name" 1)
+(defindent "di:ambiguous-variable-name" 1)
+(defindent "debug-error" 1)
+(defindent "di:debug-error" 1)
+(defindent "unhandled-condition" 1)
+(defindent "di:unhandled-condition" 1)
+(defindent "unknown-code-location" 1)
+(defindent "di:unknown-code-location" 1)
+(defindent "unknown-debug-variable" 1)
+(defindent "di:unknown-debug-variable" 1)
+(defindent "invalid-control-stack-pointer" 1)
+(defindent "di:invalid-control-stack-pointer" 1)
+(defindent "frame-function-mismatch" 1)
+(defindent "di:frame-function-mismatch" 1)
+
 ;;; Xlib forms.
 ;;;
 (defindent "with-gcontext" 1)
@@ -935,22 +973,37 @@ according to the FORWARDP flag."
 (defindent "def-c-record" 1)
 (defindent "defrecord" 1)
 
+;;; Wire forms.
+(defindent "remote" 1)
+(defindent "wire:remote" 1)
+(defindent "remote-value" 1)
+(defindent "wire:remote-value" 1)
+(defindent "remote-value-bind" 3)
+(defindent "wire:remote-value-bind" 3)
+
 
 
-;;; Compute number of spaces which mark should be indented according to
-;;; local context and lisp grinding conventions.
+;;;; Indentation.
 
+;;; LISP-INDENTATION -- Internal Interface.
+;;;
 (defun lisp-indentation (mark)
+  "Compute number of spaces which mark should be indented according to
+   local context and lisp grinding conventions.  This assumes mark is at the
+   beginning of the line to be indented."
   (with-mark ((m mark)
 	      (temp mark))
+    ;; See if we are in a quoted context.
     (unless (valid-spot m nil)
-      (return-from lisp-indentation
-		   (lisp-generic-indentation m)))
+      (return-from lisp-indentation (lisp-generic-indentation m)))
+    ;; Look for the paren that opens the containing form.
     (unless (backward-up-list m)
       (return-from lisp-indentation 0))
+    ;; Move after the paren, save the start, and find the form name.
     (mark-after m)
     (with-mark ((start m))
-      (unless (and (scan-char m :lisp-syntax (not (or :space :prefix :char-quote)))
+      (unless (and (scan-char m :lisp-syntax
+			      (not (or :space :prefix :char-quote)))
 		   (test-char (next-character m) :lisp-syntax :constituent))
 	(return-from lisp-indentation (mark-column start)))
       (with-mark ((fstart m))
@@ -961,6 +1014,7 @@ according to the FORWARDP flag."
 				      (string= fname "DEF" :end1 3)
 				      (value indent-defanything)))))
 	  (declare (simple-string fname))
+	  ;; Now that we have the form name, did it have special syntax?
 	  (cond (special-args
 		 (with-mark ((spec m))
 		   (cond ((and (form-offset spec special-args)
@@ -970,28 +1024,96 @@ according to the FORWARDP flag."
 			  (mark-column m))
 			 (t
 			  (+ (mark-column start) 3)))))
+		;; See if the user seems to have altered the editor's
+		;; indentation, and if so, try to adhere to it.  This usually
+		;; happens when you type in a quoted list constant that line
+		;; wraps.  You want all the items on successive lines to fall
+		;; under the first character after the opening paren, not as if
+		;; you are calling a function.
 		((and (form-offset temp -1)
-		      (or (blank-before-p temp)
-			  (not (same-line-p temp fstart)))
+		      (or (blank-before-p temp) (not (same-line-p temp fstart)))
 		      (not (same-line-p temp mark)))
 		 (unless (blank-before-p temp)
 		   (line-start temp)
 		   (find-attribute temp :space #'zerop))
 		 (mark-column temp))
+		;; Appears to be a normal form.  Is the first arg on the same
+		;; line as the form name?
 		((skip-valid-space m)
-		 (mark-column m))
+		 (or (lisp-indentation-check-for-local-def
+		      mark temp fstart start t)
+		     (mark-column m)))
+		;; Okay, fall under the first character after the opening paren.
 		(t
-		 (mark-column start))))))))
+		 (or (lisp-indentation-check-for-local-def
+		      mark temp fstart start nil)
+		     (mark-column start)))))))))
+
+(defhvar "Lisp Indentation Local Definers"
+  "Forms with syntax like LABELS, MACROLET, etc."
+  :value '("LABELS" "MACROLET" "FLET"))
 
+;;; LISP-INDENTATION-CHECK-FOR-LOCAL-DEF -- Internal.
+;;;
+;;; This is a temporary hack to see how it performs.  When we are indenting
+;;; what appears to be a function call, let's look for FLET or MACROLET to see
+;;; if we really are indenting a local definition.  If we are, return the
+;;; indentation for a DEFUN; otherwise, nil
+;;;
+;;; Mark is the argument to LISP-INDENTATION.  Start is just inside the paren
+;;; of what looks like a function call.  If we are in an FLET, arg-list
+;;; indicates whether the local function's arg-list has been entered, that is,
+;;; whether we need to normally indent for a DEFUN body or indent specially for
+;;; the arg-list.
+;;;
+(defun lisp-indentation-check-for-local-def (mark temp1 temp2 start arg-list)
+  ;; We know this succeeds from LISP-INDENTATION.
+  (backward-up-list (move-mark temp1 mark)) ;Paren for local definition.
+  (cond ((and (backward-up-list temp1)	    ;Paren opening the list of defs
+	      (form-offset (move-mark temp2 temp1) -1)
+	      (mark-before temp2)
+	      (backward-up-list temp1)	    ;Paren for FLET or MACROLET.
+	      (mark= temp1 temp2))	    ;Must be in first arg form.
+	 ;; See if the containing form is named FLET or MACROLET.
+	 (mark-after temp1)
+	 (unless (and (scan-char temp1 :lisp-syntax
+				 (not (or :space :prefix :char-quote)))
+		      (test-char (next-character temp1) :lisp-syntax
+				 :constituent))
+	   (return-from lisp-indentation-check-for-local-def nil))
+	 (move-mark temp2 temp1)
+	 (scan-char temp2 :lisp-syntax (not :constituent))
+	 (let ((fname (nstring-upcase (region-to-string (region temp1 temp2)))))
+	   (cond ((not (member fname (value lisp-indentation-local-definers)
+			       :test #'string=))
+		  nil)
+		 (arg-list
+		  (1+ (mark-column start)))
+		 (t
+		  (+ (mark-column start) 3)))))))
+
+;;; LISP-GENERIC-INDENTATION -- Internal.
+;;;
+;;; LISP-INDENTATION calls this when mark is in a invalid spot, or quoted
+;;; context.  If we are inside a string, we return the column one greater
+;;; than the opening double quote.  Otherwise, we just use the indentation
+;;; of the first preceding non-blank line.
+;;;
 (defun lisp-generic-indentation (mark)
-  (let* ((line (mark-line mark))
-	 (prev (do ((line (line-previous line) (line-previous line)))
-		   ((or (null line) (not (blank-line-p line))) line))))
-    (cond (prev 
-	   (line-start mark prev)
-	   (find-attribute mark :space #'zerop)
-	   (mark-column mark))
-	  (t 0))))
+  (with-mark ((m mark))
+    (form-offset m -1)
+    (cond ((eq (character-attribute :lisp-syntax (next-character m))
+	       :string-quote)
+	   (1+ (mark-column m)))
+	  (t
+	   (let* ((line (mark-line mark))
+		  (prev (do ((line (line-previous line) (line-previous line)))
+			    ((not (and line (blank-line-p line))) line))))
+	     (cond (prev
+		    (line-start mark prev)
+		    (find-attribute mark :space #'zerop)
+		    (mark-column mark))
+		   (t 0)))))))
 
 ;;; Skip-Valid-Space  --  Internal
 ;;;
@@ -1007,8 +1129,10 @@ according to the FORWARDP flag."
 	    ((valid-spot mark t) (return mark))))
     (mark-after mark)))
 
+(declaim (optimize (speed 0))); byte compile again
+
 
-;;;; LISP Mode commands
+;;;; Indentation commands and hook functions.
 
 (defcommand "Defindent" (p)
   "Define the Lisp indentation for the current function.
@@ -1016,7 +1140,6 @@ 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))
@@ -1034,7 +1157,72 @@ according to the FORWARDP flag."
 	      (when (minusp i)
 		(editor-error "Indentation must be non-negative."))
 	      (defindent s i))))))
-  (indent-command ()))
+  (indent-command nil))
+
+(defcommand "Indent Form" (p)
+  "Indent Lisp code in the next form."
+  "Indent Lisp code in the next form."
+  (declare (ignore p))
+  (let ((point (current-point)))
+    (pre-command-parse-check point)
+    (with-mark ((m point))
+      (unless (form-offset m 1) (editor-error))
+      (lisp-indent-region (region point m) "Indent Form"))))
+
+;;; LISP-INDENT-REGION -- Internal.
+;;;
+;;; This indents a region of Lisp code without doing excessive redundant
+;;; computation.  We parse the entire region once, then scan through doing
+;;; indentation on each line.  We forcibly reparse each line that we indent so
+;;; that the list operations done to determine indentation of subsequent lines
+;;; will work.  This is done undoably with save1, save2, buf-region, and
+;;; undo-region.
+;;;
+(defun lisp-indent-region (region &optional (undo-text "Lisp region indenting"))
+  (check-region-query-size region)
+  (let ((start (region-start region))
+	(end (region-end region)))
+    (with-mark ((m1 start)
+		(m2 end))
+      (funcall (value parse-start-function) m1)
+      (funcall (value parse-end-function) m2)
+      (parse-over-block (mark-line m1) (mark-line m2)))
+    (let* ((first-line (mark-line start))
+	   (last-line (mark-line end))
+	   (prev (line-previous first-line))
+	   (prev-line-info
+	    (and prev (getf (line-plist prev) 'lisp-info)))
+	   (save1 (line-start (copy-mark start :right-inserting)))
+	   (save2 (line-end (copy-mark end :left-inserting)))
+	   (buf-region (region save1 save2))
+	   (undo-region (copy-region buf-region)))
+      (with-mark ((bol start :left-inserting))
+	(do ((line first-line (line-next line)))
+	    (nil)
+	  (line-start bol line)
+	  (insert-lisp-indentation bol)
+	  (let ((line-info (getf (line-plist line) 'lisp-info)))
+	    (parse-lisp-line-info bol line-info prev-line-info)
+	    (setq prev-line-info line-info))
+	  (when (eq line last-line) (return nil))))
+      (make-region-undo :twiddle undo-text buf-region undo-region))))
+
+;;; INDENT-FOR-LISP -- Internal.
+;;;
+;;; This is the value of "Indent Function" for "Lisp" mode.
+;;;
+(defun indent-for-lisp (mark)
+  (line-start mark)
+  (pre-command-parse-check mark)
+  (insert-lisp-indentation mark))
+
+(defun insert-lisp-indentation (m)
+  (delete-horizontal-space m)
+  (funcall (value indent-with-tabs) m (lisp-indentation m)))
+
+
+
+;;;; Most "Lisp" mode commands.
 
 (defcommand "Beginning of Defun" (p)
   "Move the point to the beginning of a top-level form.
@@ -1257,64 +1445,6 @@ according to the FORWARDP flag."
 	      (move-mark point s2)))))))
 
 
-(defcommand "Indent Form" (p)
-  "Indent Lisp code in the next form."
-  "Indent Lisp code in the next form."
-  (declare (ignore p))
-  (let ((point (current-point)))
-    (pre-command-parse-check point)
-    (with-mark ((m point))
-      (unless (form-offset m 1) (editor-error))
-      (lisp-indent-region (region point m) "Indent Form"))))
-
-;;; LISP-INDENT-REGION indents a region of Lisp code without doing excessive
-;;; redundant computation.  We parse the entire region once, then scan through
-;;; doing indentation on each line.  We forcibly reparse each line that we
-;;; indent so that the list operations done to determine indentation of
-;;; subsequent lines will work.  This is done undoably with save1, save2,
-;;; buf-region, and undo-region.
-;;;
-(defun lisp-indent-region (region &optional (undo-text "Lisp region indenting"))
-  (check-region-query-size region)
-  (let ((start (region-start region))
-	(end (region-end region)))
-    (with-mark ((m1 start)
-		(m2 end))
-      (funcall (value parse-start-function) m1)
-      (funcall (value parse-end-function) m2)
-      (parse-over-block (mark-line m1) (mark-line m2)))
-    (let* ((first-line (mark-line start))
-	   (last-line (mark-line end))
-	   (prev (line-previous first-line))
-	   (prev-line-info
-	    (and prev (getf (line-plist prev) 'lisp-info)))
-	   (save1 (line-start (copy-mark start :right-inserting)))
-	   (save2 (line-end (copy-mark end :left-inserting)))
-	   (buf-region (region save1 save2))
-	   (undo-region (copy-region buf-region)))
-      (with-mark ((bol start :left-inserting))
-	(do ((line first-line (line-next line)))
-	    (nil)
-	  (line-start bol line)
-	  (insert-lisp-indentation bol)
-	  (let ((line-info (getf (line-plist line) 'lisp-info)))
-	    (parse-lisp-line-info bol line-info prev-line-info)
-	    (setq prev-line-info line-info))
-	  (when (eq line last-line) (return nil))))
-      (make-region-undo :twiddle undo-text buf-region undo-region))))
-
-;;; INDENT-FOR-LISP is the value of "Indent Function" for "Lisp" mode.
-;;;
-(defun indent-for-lisp (mark)
-  (line-start mark)
-  (pre-command-parse-check mark)
-  (insert-lisp-indentation mark))
-
-(defun insert-lisp-indentation (m)
-  (delete-horizontal-space m)
-  (funcall (value indent-with-tabs) m (lisp-indentation m)))
-
-
 (defcommand "Insert ()" (p)
   "Insert a pair of parentheses ().
    With positive argument, puts parentheses around the next p
@@ -1342,13 +1472,16 @@ according to the FORWARDP flag."
   (declare (ignore p))
   (let ((point (current-point)))
     (pre-command-parse-check point)
-    (with-mark ((m point))
+    (with-mark ((m point :left-inserting))
       (cond ((scan-char m :lisp-syntax :close-paren)
 	     (delete-horizontal-space m)
 	     (mark-after m)
 	     (move-mark point m)
+	     (delete-mark m)
 	     (indent-new-line-command 1))
-	    (t (editor-error))))))
+	    (t 
+	     (delete-mark m)
+	     (editor-error))))))
 
 
 (defcommand "Forward Up List" (p)
@@ -1392,7 +1525,153 @@ according to the FORWARDP flag."
 
 
 
-;;;; "Lisp Mode".
+;;;; Filling Lisp comments, strings, and indented text.
+
+(defhvar "Fill Lisp Comment Paragraph Confirm"
+  "This determines whether \"Fill Lisp Comment Paragraph\" will prompt for
+   confirmation to fill contiguous lines with the same initial whitespace when
+   it is invoked outside of a comment or string."
+  :value t)
+
+(defcommand "Fill Lisp Comment Paragraph" (p)
+  "This fills a flushleft or indented Lisp comment.
+   This also fills Lisp string literals using the proper indentation as a
+   filling prefix.  When invoked outside of a comment or string, this tries
+   to fill all contiguous lines beginning with the same initial, non-empty
+   blankspace.  When filling a comment, the current line is used to determine a
+   fill prefix by taking all the initial whitespace on the line, the semicolons,
+   and any whitespace following the semicolons."
+  "Fills a flushleft or indented Lisp comment."
+  (declare (ignore p))
+  (let ((point (current-point)))
+    (pre-command-parse-check point)
+    (with-mark ((start point)
+		(end point)
+		(m point))
+      (let ((commentp (fill-lisp-comment-paragraph-prefix start end)))
+	(cond (commentp
+	       (fill-lisp-comment-or-indented-text start end))
+	      ((and (not (valid-spot m nil))
+		    (form-offset m -1)
+		    (eq (character-attribute :lisp-syntax (next-character m))
+			:string-quote))
+	       (fill-lisp-string m))
+	      ((or (not (value fill-lisp-comment-paragraph-confirm))
+		   (prompt-for-y-or-n
+		    :prompt '("Not in a comment or string.  Fill contiguous ~
+			       lines with the same initial whitespace? ")))
+	       (fill-lisp-comment-or-indented-text start end)))))))
+
+;;; FILL-LISP-STRING -- Internal.
+;;;
+;;; This fills the Lisp string containing mark as if it had been entered using
+;;; Hemlock's Lisp string indentation, "Indent Function" for "Lisp" mode.  This
+;;; assumes the area around mark has already been PRE-COMMAND-PARSE-CHECK'ed,
+;;; and it ensures the string ends before doing any filling.  This function
+;;; is undo'able.
+;;;
+(defun fill-lisp-string (mark)
+  (with-mark ((end mark))
+    (unless (form-offset end 1)
+      (editor-error "Attempted to fill Lisp string, but it doesn't end?"))
+    (let* ((mark (copy-mark mark :left-inserting))
+	   (end (copy-mark end :left-inserting))
+	   (string-region (region mark end))
+	   (undo-region (copy-region string-region))
+	   (hack (make-empty-region)))
+      ;; Generate prefix.
+      (funcall (value indent-with-tabs)
+	       (region-end hack) (1+ (mark-column mark)))
+      ;; Skip opening double quote and fill string starting on its own line.
+      (mark-after mark)
+      (insert-character mark #\newline)
+      (line-start mark)
+      (setf (mark-kind mark) :right-inserting)
+      (fill-region string-region (region-to-string hack))
+      ;; Clean up inserted prefix on first line, delete inserted newline, and
+      ;; move before the double quote for undo.
+      (with-mark ((text mark :left-inserting))
+	(find-attribute text :whitespace #'zerop)
+	(delete-region (region mark text)))
+      (delete-characters mark -1)
+      (mark-before mark)
+      ;; Save undo.
+      (make-region-undo :twiddle "Fill Lisp Comment Paragraph"
+			string-region undo-region))))
+
+;;; FILL-LISP-COMMENT-OR-INDENTED-TEXT -- Internal.
+;;;
+;;; This fills all contiguous lines around start and end containing fill prefix
+;;; designated by the region between start and end.  These marks can only be
+;;; equal when there is no comment and no initial whitespace.  This is a bad
+;;; situation since this function in that situation would fill the entire
+;;; buffer into one paragraph.  This function is undo'able.
+;;;
+(defun fill-lisp-comment-or-indented-text (start end)
+  (when (mark= start end)
+    (editor-error "This command only fills Lisp comments, strings, or ~
+		   indented text, but this line is flushleft."))
+  ;;
+  ;; Find comment block.
+  (let* ((prefix (region-to-string (region start end)))
+	 (length (length prefix)))
+    (declare (simple-string prefix))
+    (flet ((frob (mark direction)
+	     (loop
+	       (let* ((line (line-string (mark-line mark)))
+		      (line-len (length line)))
+		 (declare (simple-string line))
+		 (unless (string= line prefix :end1 (min line-len length))
+		   (when (= direction -1)
+		     (unless (same-line-p mark end) (line-offset mark 1 0)))
+		   (return)))
+	       (unless (line-offset mark direction 0)
+		 (when (= direction 1) (line-end mark))
+		 (return)))))
+      (frob start -1)
+      (frob end 1))
+    ;;
+    ;; Do it undoable.
+    (let* ((start1 (copy-mark start :right-inserting))
+	   (end2 (copy-mark end :left-inserting))
+	   (region (region start1 end2))
+	   (undo-region (copy-region region)))
+      (fill-region region prefix)
+      (make-region-undo :twiddle "Fill Lisp Comment Paragraph"
+			region undo-region))))
+
+;;; FILL-LISP-COMMENT-PARAGRAPH-PREFIX -- Internal.
+;;;
+;;; This sets start and end around the prefix to be used for filling.  We
+;;; assume we are dealing with a comment.  If there is no ";", then we try to
+;;; find some initial whitespace.  If there is a ";", we make sure the line is
+;;; blank before it to eliminate ";"'s in the middle of a line of text.
+;;; Finally, if we really have a comment instead of some indented text, we skip
+;;; the ";"'s and any immediately following whitespace.  We allow initial
+;;; whitespace, so we can fill strings with the same command.
+;;;
+(defun fill-lisp-comment-paragraph-prefix (start end)
+  (line-start start)
+  (let ((commentp t)) ; Assumes there's a comment.
+    (unless (to-line-comment (line-start end) ";")
+      (find-attribute end :whitespace #'zerop)
+      #|(when (start-line-p end)
+	(editor-error "No comment on line, and no initial whitespace."))|#
+      (setf commentp nil))
+    (when commentp
+      (unless (blank-before-p end)
+	(find-attribute (line-start end) :whitespace #'zerop)
+	#|(when (start-line-p end)
+	  (editor-error "Semicolon preceded by unindented text."))|#
+	(setf commentp nil)))
+    (when commentp
+      (find-attribute end :lisp-syntax #'(lambda (x) (not (eq x :comment))))
+      (find-attribute end :whitespace #'zerop))
+    commentp))
+
+
+
+;;;; "Lisp" mode.
 
 (defcommand "LISP Mode" (p)
   "Put current buffer in LISP mode." 
@@ -1456,6 +1735,23 @@ according to the FORWARDP flag."
   :mode "Lisp")
 
 
+(defhvar "Open Paren Finder Function"
+  "Should be a function that takes a mark for input and returns either NIL
+   if the mark is not after a close paren, or two (temporary) marks
+   surrounding the corresponding open paren."
+  :mode "Lisp"
+  :value 'lisp-open-paren-finder-function)
+
+(defun lisp-open-paren-finder-function (mark)
+  (when (eq (character-attribute :lisp-syntax (previous-character mark))
+	    :close-paren)
+    (with-mark ((mark mark))
+      (pre-command-parse-check mark)
+      (if (not (and (valid-spot mark nil) (list-offset mark -1)))
+	  (values nil nil)
+	  (values mark (mark-after (copy-mark mark)))))))
+
+
 
 ;;;; Some mode variables to coordinate with other stuff.
 
diff --git a/hemlock/mh.lisp b/hemlock/mh.lisp
index 05b7ea6ab..cf64122b0 100644
--- a/hemlock/mh.lisp
+++ b/hemlock/mh.lisp
@@ -1,13 +1,16 @@
 ;;; -*- Package: Hemlock; Log: hemlock.log -*-
-;;; 
+;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CS.CMU.EDU).
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/mh.lisp,v 1.4 1994/02/11 21:53:28 ram Exp $")
+;;;
 ;;; **********************************************************************
-;;; 
+;;;
 ;;; This is a mailer interface to MH.
 ;;; 
 ;;; Written by Bill Chiles.
@@ -206,7 +209,7 @@
 (defhvar "MH Scan Line Form"
   "This is a pathname of a file containing an MH format expression for headers
    lines."
-  :value (pathname "/usr/misc/.lisp/lib/mh-scan"))
+  :value (pathname "library:mh-scan"))
 
 ;;; MESSAGE-HEADERS-TO-REGION uses the MH "scan" utility output headers into
 ;;; buffer for folder and msgs.
@@ -219,7 +222,7 @@
     (with-output-to-mark (*standard-output* (region-end region) :full)
       (mh "scan"
 	  `(,folder ,@msgs
-	    "-form" ,(namestring (value mh-scan-line-form))
+	    "-form" ,(namestring (truename (value mh-scan-line-form)))
 	    "-width" ,(number-string (or width (value fill-column)))
 	    "-noheader")))
     region))
@@ -1124,39 +1127,41 @@
 	      (dolist (w (buffer-windows b))
 		(update-modeline-field b w :replied-to-message))))))
       (maybe-delete-extra-draft-window dbuffer (current-window))
-      (let* ((mbuf (value message-buffer))
-	     (minfo (if mbuf
-			(variable-value 'message-information :buffer mbuf))))
-	(when (and minfo (not (message-info-keep minfo)))
-	  (delete-buffer-if-possible mbuf)))
+      (let ((mbuf (value message-buffer)))
+	(when (and mbuf
+		   (not (hemlock-bound-p 'netnews-message-info :buffer mbuf)))
+	  (let ((minfo (variable-value 'message-information :buffer mbuf)))
+	    (when (and minfo (not (message-info-keep minfo)))
+	      (delete-buffer-if-possible mbuf)))))
       (delete-buffer-if-possible dbuffer))))
 
 (defcommand "Delete Draft and Buffer" (p)
-  "Delete the current draft message and buffer."
-  "Delete the current draft message and buffer."
+  "Delete the current draft and associated message and buffer."
+  "Delete the current draft and associated message and buffer."
   (declare (ignore p))
   (let ((dinfo (value draft-information))
 	(dbuffer (current-buffer)))
     (unless dinfo (editor-error "No draft associated with buffer."))
     (maybe-delete-extra-draft-window dbuffer (current-window))
     (delete-file (draft-info-pathname dinfo))
-    (let* ((mbuf (value message-buffer))
-	   (minfo (if mbuf
-		      (variable-value 'message-information :buffer mbuf))))
-      (when (and minfo (not (message-info-keep minfo)))
-	(delete-buffer-if-possible mbuf)))
-    (delete-buffer-if-possible dbuffer)))
-
-;;; MAYBE-DELETE-EXTRA-DRAFT-WINDOW takes a draft buffer and a window into it
-;;; that should not be deleted.  If "Split Window Draft" is bound in the buffer,
-;;; and there are more than two windows (two windows plus the echo area at
-;;; least), then we delete some window if it is not the dbuffer-window or the
-;;; echo area window.  Blow away the variable, so we don't think this is still
-;;; a split window draft buffer.
+    (let ((mbuf (value message-buffer)))
+      (when (and mbuf
+		 (not (hemlock-bound-p 'netnews-message-info :buffer mbuf)))
+	(let ((minfo (variable-value 'message-information :buffer mbuf)))
+	  (when (and minfo (not (message-info-keep minfo)))
+	    (delete-buffer-if-possible mbuf)))))
+    (delete-buffer-if-possible dbuffer)))    
+
+;;; MAYBE-DELETE-EXTRA-DRAFT-WINDOW -- Internal.
+;;;
+;;; This takes a draft buffer and a window into it that should not be deleted.
+;;; If "Split Window Draft" is bound in the buffer, and there are at least two
+;;; windows in dbuffer-window's group, then we delete some window.  Blow away
+;;; the variable, so we don't think this is still a split window draft buffer.
 ;;;
 (defun maybe-delete-extra-draft-window (dbuffer dbuffer-window)
   (when (and (hemlock-bound-p 'split-window-draft :buffer dbuffer)
-	     ;; Since we now bitmap devices have window groups, this loop is
+	     ;; Since we know bitmap devices have window groups, this loop is
 	     ;; more correct than testing the length of *window-list* and
 	     ;; accounting for *echo-area-window* being in there.
 	     (do ((start dbuffer-window)
@@ -1166,7 +1171,6 @@
     (delete-window (next-window dbuffer-window))
     (delete-variable 'split-window-draft :buffer dbuffer)))
 
-
 (defcommand "Remail Message" (p)
   "Prompts for a folder and message to remail.  Prompts for a resend-to
    address string and resend-cc address string.  When in a headers buffer,
@@ -1303,35 +1307,58 @@
   :value 75)
 
 (defcommand "Insert Message Region" (p)
-  "Copy the current region into the associated draft buffer.
-   When in a message buffer that has an associated draft buffer, the current
-   active region is copied into the draft buffer.  It is filled using \"Message
-   Insertion Prefix\" and \"Message Insertion Column\".  If an argument is
-   supplied, the filling is inhibited."
-  "When in a message buffer that has an associated draft buffer, the current
-   active region is copied into the draft buffer.  It is filled using
-   \"Message Insertion Prefix\" and \"Message Insertion Column\".  If an
-   argument is supplied, the filling is inhibited."
-  (let ((minfo (value message-information)))
-    (unless minfo (editor-error "Not in a message buffer."))
-    (let ((dbuf (message-info-draft-buf minfo)))
-      (unless dbuf
-	(editor-error "Message buffer not associated with any draft buffer."))
-      (let* ((region (copy-region (current-region)))
-	     (dbuf-point (buffer-point dbuf))
-	     (dbuf-mark (copy-mark dbuf-point)))
-	(if (and (hemlock-bound-p 'split-window-draft :buffer dbuf)
-		 (> (length (the list *window-list*)) 2)
-		 (buffer-windows dbuf))
-	    (setf (current-buffer) dbuf
-		  (current-window) (car (buffer-windows dbuf)))
-	    (change-to-buffer dbuf))
-	(push-buffer-mark dbuf-mark)
-	(ninsert-region dbuf-point region)
-	(unless p
-	  (fill-region-by-paragraphs (region dbuf-mark dbuf-point)
-				     (value message-insertion-prefix)
-				     (value message-insertion-column))))))
+  "Copy the current region into the associated draft or post buffer.  When
+   in a message buffer that has an associated draft or post buffer, the
+   current active region is copied into the draft or post buffer.  It is
+   filled using \"Message Insertion Prefix\" and \"Message Insertion
+   Column\".  If an argument is supplied, the filling is inhibited.
+   If both a draft buffer and post buffer are associated with this, then it
+   is inserted into the draft buffer."
+  "When in a message buffer that has an associated draft or post buffer,
+   the current active region is copied into the post or draft buffer.  It is
+   filled using \"Message Insertion Prefix\" and \"Message Insertion
+   Column\".  If an argument is supplied, the filling is inhibited."
+  (let* ((minfo (value message-information))
+	 (nm-info (if (hemlock-bound-p 'netnews-message-info)
+		      (value netnews-message-info)))
+	 (post-buffer (and nm-info (nm-info-post-buffer nm-info)))
+	 (post-info (and post-buffer
+			 (variable-value 'post-info :buffer post-buffer)))
+	 dbuf kind)
+    (cond (minfo
+	   (setf kind :mail)
+	   (setf dbuf (message-info-draft-buf minfo)))
+	  (nm-info
+	   (setf kind :netnews)
+	   (setf dbuf (or (nm-info-draft-buffer nm-info)
+			  (nm-info-post-buffer nm-info))))
+	  (t (editor-error "Not in a netnews message or message buffer.")))
+    (unless dbuf
+      (editor-error "Message buffer not associated with any draft or post ~
+                     buffer."))
+    (let* ((region (copy-region (current-region)))
+	   (dbuf-point (buffer-point dbuf))
+	   (dbuf-mark (copy-mark dbuf-point)))
+      (cond ((and (eq kind :mail)
+		  (hemlock-bound-p 'split-window-draft :buffer dbuf)
+		  (> (length (the list *window-list*)) 2)
+		  (buffer-windows dbuf))
+	     (setf (current-buffer) dbuf
+		   (current-window) (car (buffer-windows dbuf))))
+	    ((and (eq kind :netnews)
+		  (and (member (post-info-message-window post-info)
+			       *window-list*)
+		       (member (post-info-reply-window post-info)
+			       *window-list*)))
+	     (setf (current-buffer) dbuf
+		   (current-window) (post-info-reply-window post-info)))
+	    (t (change-to-buffer dbuf)))
+      (push-buffer-mark dbuf-mark)
+      (ninsert-region dbuf-point region)
+      (unless p
+	(fill-region-by-paragraphs (region dbuf-mark dbuf-point)
+				   (value message-insertion-prefix)
+				   (value message-insertion-column)))))
   (setf (last-command-type) :ephemerally-active))
 
 
@@ -1342,21 +1369,24 @@
   :value "    ")
 
 (defcommand "Insert Message Buffer" (p)
-  "Insert entire (associated) message buffer into (associated) draft buffer.
-   When in a draft buffer with an associated message buffer, or when in a
-   message buffer that has an associated draft buffer, the message buffer is
-   inserted into the draft buffer.  Each inserted line is modified by prefixing
-   it with \"Message Buffer Insertion Prefix\".  If an argument is supplied the
-   prefixing is inhibited."
-  "When in a draft buffer with an associated message buffer, or when in a
-   message buffer that has an associated draft buffer, the message buffer
-   is inserted into the draft buffer.  Each inserted line is modified by
-   prefixing it with \"Message Buffer Insertion Prefix\".  If an argument
-   is supplied the prefixing is inhibited."
+  "Insert entire (associated) message buffer into (associated) draft or
+   post buffer.  When in a draft or post buffer with an associated message
+   buffer, or when in a message buffer that has an associated draft or post
+   buffer, the message buffer is inserted into the draft buffer.  When
+   there are both an associated draft and post buffer, the text is inserted
+   into the draft buffer.  Each inserted line is modified by prefixing it
+   with \"Message Buffer Insertion Prefix\".  If an argument is supplied
+   the prefixing is inhibited."
+  "When in a draft or post buffer with an associated message buffer, or
+   when in a message buffer that has an associated draft or post buffer, the
+   message buffer is inserted into the draft buffer.  Each inserted line is
+   modified by prefixing it with \"Message Buffer Insertion Prefix\".  If an
+   argument is supplied the prefixing is inhibited."
   (let ((minfo (value message-information))
 	(dinfo (value draft-information))
-	mbuf dbuf)
+	mbuf dbuf message-kind)
     (cond (minfo
+	   (setf message-kind :mail)
 	   (setf dbuf (message-info-draft-buf minfo))
 	   (unless dbuf
 	     (editor-error
@@ -1364,12 +1394,32 @@
 	   (setf mbuf (current-buffer))
 	   (change-to-buffer dbuf))
 	  (dinfo
+	   (setf message-kind :mail)
 	   (setf mbuf (value message-buffer))
 	   (unless mbuf
 	     (editor-error
 	      "Draft buffer not associated with any message buffer."))
 	   (setf dbuf (current-buffer)))
-	  (t (editor-error "Not in a draft or message buffer.")))
+	  ((hemlock-bound-p 'netnews-message-info)
+	   (setf message-kind :netnews)
+	   (setf mbuf (current-buffer))
+	   (let ((nm-info (value netnews-message-info)))
+	     (setf dbuf (or (nm-info-draft-buffer nm-info)
+			    (nm-info-post-buffer nm-info)))
+	     (unless dbuf
+	       (editor-error "Message buffer not associated with any draft ~
+	       		      or post buffer.")))
+	   (change-to-buffer dbuf))
+	  ((hemlock-bound-p 'post-info)
+	   (setf message-kind :netnews)
+	   (let ((post-info (value post-info)))
+	     (setf mbuf (post-info-message-buffer post-info))
+	     (unless mbuf
+	       (editor-error "Post buffer not associated with any message ~
+	                      buffer.")))
+	   (setf dbuf (current-buffer)))
+	  (t (editor-error "Not in a draft, message, news-message, or post ~
+	                    buffer.")))	  
     (let* ((dbuf-point (buffer-point dbuf))
 	   (dbuf-mark (copy-mark dbuf-point)))
       (push-buffer-mark dbuf-mark)
@@ -1381,7 +1431,11 @@
 	      (when (mark>= temp dbuf-point) (return))
 	      (insert-string temp prefix)
 	      (unless (line-offset temp 1 0) (return)))))))
-    (insert-message-buffer-cleanup-split-draft dbuf mbuf))
+    (ecase message-kind
+      (:mail
+       (insert-message-buffer-cleanup-split-draft dbuf mbuf))
+      (:netnews 
+       (nn-reply-cleanup-split-windows dbuf))))
   (setf (last-command-type) :ephemerally-active))
 
 ;;; INSERT-MESSAGE-BUFFER-CLEANUP-SPLIT-DRAFT tries to delete an extra window
@@ -1614,41 +1668,6 @@
   (change-to-buffer *new-mail-buffer*))
 
 
-(defhvar "Store Password"
-  "When this is set, the user is only prompted once for his password."
-  :value nil)
-
-(defvar *stored-password* nil)
-
-(defun get-password ()
-  (if (value store-password)
-      (or *stored-password*
-	  (setf *stored-password* (prompt-for-password)))
-      (prompt-for-password)))
-
-
-(defhvar "Authenticate Incorporation"
-  "When this is set (the default), incorporating new mail prompts for a
-   password to access a remote mail drop."
-  :value t)
-(defhvar "Authentication User Name"
-  "When incorporating new mail accesses a remote mail drop, this is the user
-   name supplied for authentication on the remote machine.  If this is nil
-   it is looked up on the local machine."
-  :value nil)
-#|
-(defhvar "Authentication Group Name"
-  "When incorporating new mail accesses a remote mail drop, this is the group
-   name supplied for authentication on the remote machine.  If this is nil
-   it is looked up on the local machine."
-  :value nil)
-(defhvar "Authentication Account Name"
-  "When incorporating new mail accesses a remote mail drop, this is the account
-   name supplied for authentication on the remote machine.  If this is nil
-   it is looked up on the local machine."
-  :value nil)
-|#
-
 (defhvar "Incorporate New Mail Hook"
   "Functions on this hook are invoked immediately after new mail is
    incorporated."
@@ -1660,27 +1679,10 @@
   (unless (new-mail-p) (editor-error "No new mail."))
   (let ((args `(,(coerce-folder-name (value new-mail-folder))
 		,@(if stream nil '("-silent"))
-		"-form" ,(namestring (value mh-scan-line-form))
+		"-form" ,(namestring (truename (value mh-scan-line-form)))
 		"-width" ,(number-string (value fill-column)))))
-    (cond ((value authenticate-incorporation)
-	   (let ((password (get-password)))
-	     ;; Since we know there is mail due to above check, look for a
-	     ;; possible password failure since MH or the rfs stuff is stupid.
-	     (multiple-value-bind
-		 (winp error-string)
-		 (let ((*standard-output* (or stream *standard-output*)))
-		   (message "Incorporating new mail ...")
-		   (mh "inc" args :errorp nil :password password
-		       :username (value authentication-user-name)))
-	       (declare (simple-string error-string))
-	       (unless winp
-		 (when (string= error-string "inc: unable to read" :end1 19)
-		   (setf *stored-password* nil)
-		   (editor-error
-		    "Couldn't read maildrop, possible mistyped password."))
-		 (editor-error "MH Error -- ~A" error-string)))))
-	  (t (message "Incorporating new mail ...")
-	     (mh "inc" args))))
+    (message "Incorporating new mail ...")
+    (mh "inc" args))
   (when (value incorporate-new-mail-hook)
     (message "Invoking new mail hooks ..."))
   (invoke-hook incorporate-new-mail-hook))
@@ -2699,32 +2701,24 @@
 
 (defvar *mh-error-output* (make-string-output-stream))
 
-(defun mh (utility args &key (errorp *signal-mh-errors*)
-		             password username environment)
+(defun mh (utility args &key (errorp *signal-mh-errors*) environment)
   "Runs the MH utility with the list of args (suitable for EXT:RUN-PROGRAM),
-   outputting to *standard-output*.  If password is supplied, then the MH
-   utility is run with RFS authentication.  If username is nil, this looks it
-   up on the editor's machine.  Environment is a list of strings appended with
-   ext:*environment-list*.  This returns t, unless there is an error.
-   When errorp, this reports any MH errors in the echo area as an editor error,
-   and this does not return; otherwise, nil and the error output from the MH
-   utility are returned."
+   outputting to *standard-output*.  Environment is a list of strings
+   appended with ext:*environment-list*.  This returns t, unless there is
+   an error.  When errorp, this reports any MH errors in the echo area as
+   an editor error, and this does not return; otherwise, nil and the error
+   output from the MH utility are returned."
   (fresh-line)
-  (let* ((utility (namestring (truename
-			       (merge-pathnames utility
-						(value mh-utility-pathname)))))
+  (let* ((utility
+	  (namestring
+	   (or (probe-file (merge-pathnames utility
+					    (value mh-utility-pathname)))
+	       utility)))
 	 (proc (ext:run-program
 		utility args
 		:output *standard-output*
 		:error *mh-error-output*
-		:env (append environment ext:*environment-list*)
-		:before-execve
-		(if password
-		    #'(lambda ()
-			(mach:rfs-authenticate
-			 (or username
-			     (lisp::lookup-login-name (mach:unix-getuid)))
-			 nil nil password))))))
+		:env (append environment ext:*environment-list*))))
     (fresh-line)
     (ext:process-close proc)
     (cond ((zerop (ext:process-exit-code proc))
@@ -2803,7 +2797,8 @@
       (let ((path (mh-profile-component "path")))
 	(unless path (error "MH profile does not contain a Path component."))
 	(setf *mh-directory-pathname*
-	      (merge-relative-pathnames path (user-homedir-pathname))))))
+	      (truename (merge-relative-pathnames path
+						  (user-homedir-pathname)))))))
 
 ;;; Profile components.
 ;;; 
@@ -2845,12 +2840,14 @@
       (setf *mh-profile-pathname*
 	    (merge-pathnames (or (cdr (assoc :mh ext:*environment-list*))
 				 ".mh_profile")
-			     (user-homedir-pathname)))))
+			     (truename (user-homedir-pathname))))))
 
 
 
 ;;;; Sequence handling.
 
+(declaim (optimize (speed 2))); byte compile off
+
 (defun mark-one-message (folder msg sequence add-or-delete)
   "Msg is added or deleted to the sequence named sequence in the folder's
    \".mh_sequence\" file.  Add-or-delete is either :add or :delete."
@@ -3084,7 +3081,7 @@
 	    (push (format nil "~D-~D" low high) result))))
     (nreverse result)))
 
-
+(declaim (optimize (speed 0))); byte compile again.
 
 ;;;; CMU Common Lisp support.
 
@@ -3096,10 +3093,10 @@
 (defun hacking-rename-file (old new)
   (let ((ses-name1 (namestring old))
 	(ses-name2 (namestring new)))
-    (multiple-value-bind (res err) (mach:unix-rename ses-name1 ses-name2)
+    (multiple-value-bind (res err) (unix:unix-rename ses-name1 ses-name2)
       (unless res
 	(error "Failed to rename ~A to ~A: ~A."
-	       ses-name1 ses-name2 (mach:get-unix-error-msg err))))))
+	       ses-name1 ses-name2 (unix:get-unix-error-msg err))))))
 
 
 ;;; Folder existence and creation.
@@ -3111,10 +3108,10 @@
   (declare (simple-string folder))
   (let* ((folder (strip-folder-name folder))
 	 (pathname (merge-relative-pathnames folder (mh-directory-pathname)))
-	 (ses-name (namestring pathname)))
-    (multiple-value-bind (winp type)
-			 (mach:unix-subtestname ses-name)
-      (and winp (eq type :entry_directory)))))
+	 (pf (probe-file pathname)))
+    (and pf
+	 (null (pathname-name pf))
+	 (null (pathname-type pf)))))
 
 (defun create-folder (folder)
   "Creates folder directory with default protection #o711 but considers the
@@ -3134,11 +3131,11 @@
       (setf protection
 	    (parse-integer protection :radix 8 :junk-allowed t)))
     (multiple-value-bind (winp err)
-			 (mach:unix-mkdir name (or protection #o711))
+			 (unix:unix-mkdir name (or protection #o711))
       (unless winp
 	(error "Couldn't make directory ~S: ~A"
 	       name
-	       (mach:get-unix-error-msg err)))
+	       (unix:get-unix-error-msg err)))
       (check-folder-name-table)
       (setf (getstring folder *folder-name-table*) t))))
 
@@ -3153,17 +3150,17 @@
    (setf *mailbox*
 	 (probe-file (or (cdr (assoc :mail ext:*environment-list*))
 			 (cdr (assoc :maildrop ext:*environment-list*))
-			 (mh-profile-component "mail-drop")
+			 (mh-profile-component "MailDrop")
 			 (merge-pathnames
 			  (cdr (assoc :user ext:*environment-list*))
 			  "/usr/spool/mail/")))))
   (when *mailbox*
     (multiple-value-bind (success dev ino mode nlink uid gid rdev size
 			  atime)
-			 (mach:unix-stat (namestring *mailbox*))
+			 (unix:unix-stat (namestring *mailbox*))
       (declare (ignore dev ino nlink uid gid rdev atime))
       (and success
-	   (plusp (logand mach::s_ifreg mode))
+	   (plusp (logand unix:s-ifreg mode))
 	   (not (zerop size))))))
 
 
diff --git a/hemlock/morecoms.lisp b/hemlock/morecoms.lisp
index a07e07a23..23a13c0f1 100644
--- a/hemlock/morecoms.lisp
+++ b/hemlock/morecoms.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/morecoms.lisp,v 1.3 1994/02/11 21:53:36 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Written by Bill Chiles and Rob MacLachlan.
@@ -136,7 +139,9 @@
 		     (insert-character mark #\space))
 		   (mark-before mark)))
 		((mark-before mark))
-		(t (return)))))
+		(t
+		 (setq errorp t)
+		 (return)))))
       (kill-characters point (- n))
       (when errorp
 	(editor-error "There were not ~D characters before point." n)))))
@@ -273,7 +278,7 @@
   "Display stats on allocated storage."
   "Run Room into a With-Random-Typeout window."
   (declare (ignore p))
-  (with-pop-up-display (*standard-output* :height 19)
+  (with-pop-up-display (*standard-output*)
     (room)))
 
 
@@ -618,7 +623,6 @@
    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))
diff --git a/hemlock/pop-up-stream.lisp b/hemlock/pop-up-stream.lisp
index 3e8467470..4c17e462f 100644
--- a/hemlock/pop-up-stream.lisp
+++ b/hemlock/pop-up-stream.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/pop-up-stream.lisp,v 1.1.1.2 1991/02/08 16:36:58 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/pop-up-stream.lisp,v 1.2 1994/02/11 21:53:37 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/register.lisp b/hemlock/register.lisp
index 89dda633c..42b2a3d0b 100644
--- a/hemlock/register.lisp
+++ b/hemlock/register.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/register.lisp,v 1.3 1994/02/11 21:53:39 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Registers for holding text and positions.
@@ -13,7 +16,7 @@
 ;;; Written by Dave Touretzky.
 ;;; Modified by Bill Chiles for Hemlock consistency.
 ;;;
-(in-package 'hemlock)
+(in-package "HEMLOCK")
 
 
 
@@ -71,7 +74,6 @@
 ;;; 
 (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)))
diff --git a/hemlock/ring.lisp b/hemlock/ring.lisp
index 5176e2b1e..466b3498c 100644
--- a/hemlock/ring.lisp
+++ b/hemlock/ring.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/ring.lisp,v 1.1.1.4 1993/08/25 02:23:57 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/ring.lisp,v 1.2 1994/02/11 21:53:39 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/rompsite.lisp b/hemlock/rompsite.lisp
index d4b66d775..3a645a20f 100644
--- a/hemlock/rompsite.lisp
+++ b/hemlock/rompsite.lisp
@@ -1,22 +1,35 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC).
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/rompsite.lisp,v 1.4 1994/02/11 21:53:41 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; "Site dependent" stuff for the editor while on the IBM RT PC machine.
 ;;;
 
+;;; Stuff to set up the packages Hemlock uses.
+;;;
+(in-package "HEMLOCK-INTERNALS"
+	    :nicknames '("HI")
+	    :use '("LISP" "EXTENSIONS" "SYSTEM"))
+;;;
+(in-package "HEMLOCK"
+	    :nicknames '("ED")
+	    :use '("LISP" "HEMLOCK-INTERNALS" "EXTENSIONS" "SYSTEM"))
+;;;
 (in-package "SYSTEM")
-
-(export '(without-hemlock))
-
-
-(in-package "HEMLOCK-INTERNALS" :nicknames '("HI"))
+(export '(without-hemlock %sp-byte-blt %sp-find-character
+			  %sp-find-character-with-attribute 
+			  %sp-reverse-find-character-with-attribute))
+;;;
+(in-package "HI")
 
 (export '(show-mark editor-sleep *input-transcript* fun-defined-from-pathname
 	  editor-describe-function pause-hemlock store-cut-string
@@ -99,7 +112,7 @@
   (defhvar "Cursor Bitmap File"
     "File to read to setup cursors for Hemlock windows.  The mask is found by
      merging this name with \".mask\"."
-    :value "/usr/misc/.lisp/lib/hemlock11.cursor")
+    :value "library:hemlock11.cursor")
   (defhvar "Enter Window Hook"
     "When the mouse enters an editor window, this hook is invoked.  These
      functions take the Hemlock Window as an argument."
@@ -133,37 +146,26 @@
 
 ;;; MERGE-RELATIVE-PATHNAMES takes a pathname that is either absolute or
 ;;; relative to default-dir, merging it as appropriate and returning a definite
-;;; directory pathname.  If the component comes back with a trailing slash, we
-;;; have to remove it to get the MERGE-PATHNAMES to work correctly.  The result
-;;; must have a trailing slash.
+;;; directory pathname.
+;;;
+;;; This function isn't really needed anymore now that merge-pathnames does
+;;; this, but the semantics are slightly different.  So it's easier to just
+;;; keep this around instead of changing all the uses of it.
 ;;; 
 (defun merge-relative-pathnames (pathname default-directory)
   "Merges pathname with default-directory.  If pathname is not absolute, it
    is assumed to be relative to default-directory.  The result is always a
    directory."
-  (setf pathname (pathname pathname))
-  (flet ((return-with-slash (pathname)
-	   (let ((ns (namestring pathname)))
-	     (declare (simple-string ns))
-	     (if (char= #\/ (schar ns (1- (length ns))))
-		 pathname
-		 (pathname (concatenate 'simple-string ns "/"))))))
-    (let ((dir (pathname-directory pathname)))
-      (if dir
-	  (let ((dev (pathname-device pathname)))
-	    (if (eq dev :absolute)
-		(return-with-slash pathname)
-		(return-with-slash
-		    (make-pathname :device (pathname-device default-directory)
-				   :directory
-				   (concatenate
-				    'simple-vector
-				    (pathname-directory default-directory)
-				    dir)
-				   :defaults pathname))))
-	  (return-with-slash (merge-pathnames pathname default-directory))))))
+  (let ((pathname (merge-pathnames pathname default-directory)))
+    (if (directoryp pathname)
+	pathname
+	(pathname (concatenate 'simple-string
+			       (namestring pathname)
+			       "/")))))
 
 (defun directoryp (pathname)
+  "Returns whether pathname names a directory, that is whether it has no
+   name and no type components."
   (not (or (pathname-name pathname) (pathname-type pathname))))
 
 
@@ -181,33 +183,42 @@
 ;;; 
 (defvar *editor-windowed-input* nil)
 
-
 ;;; These are used for selecting X events.
-;;; 
-(defconstant group-interesting-xevents
-  '(:structure-notify))
+#+clx
+(eval-when (compile load eval)
+  (defconstant group-interesting-xevents
+    '(:structure-notify)))
+#+clx
 (defconstant group-interesting-xevents-mask
   (apply #'xlib:make-event-mask group-interesting-xevents))
 
-(defconstant child-interesting-xevents
-  '(:key-press :button-press :button-release :structure-notify :exposure
-    :enter-window :leave-window))
+#+clx
+(eval-when (compile load eval)
+  (defconstant child-interesting-xevents
+    '(:key-press :button-press :button-release :structure-notify :exposure
+		 :enter-window :leave-window)))
+#+clx
 (defconstant child-interesting-xevents-mask
   (apply #'xlib:make-event-mask child-interesting-xevents))
 
-(defconstant random-typeout-xevents
-  '(:key-press :button-press :button-release :enter-window :leave-window
-    :exposure))
+#+clx
+(eval-when (compile load eval)
+  (defconstant random-typeout-xevents
+    '(:key-press :button-press :button-release :enter-window :leave-window
+		 :exposure)))
+#+clx
 (defconstant random-typeout-xevents-mask
   (apply #'xlib:make-event-mask random-typeout-xevents))
 
+
+#+clx
 (proclaim '(special ed::*open-paren-highlight-font*
 		    ed::*active-region-highlight-font*))
 
-(defparameter lisp-fonts-pathnames
-  '("/usr/misc/.lisp/lib/fonts/"
-    "/afs/cs.cmu.edu/unix/rt_mach/omega/usr/misc/.lisp/lib/fonts/"))
+#+clx
+(defparameter lisp-fonts-pathnames '("library:fonts/"))
 
+(proclaim '(special *editor-input* *real-editor-input*))
 
 (proclaim '(special *editor-input* *real-editor-input*))
 
@@ -217,12 +228,12 @@
 ;;; lisp.  It sets up process specific data structures.
 ;;;
 (defun init-raw-io (display)
+  #-clx (declare (ignore display))
   (setf *editor-windowed-input* nil)
-  (cond (display
+  (cond #+clx
+	(display
 	 (setf *editor-windowed-input* (ext:open-clx-display display))
 	 (setf *editor-input* (make-windowed-editor-input))
-	 (ext:carefully-add-font-paths *editor-windowed-input*
-				       lisp-fonts-pathnames)
 	 (setup-font-family *editor-windowed-input*
 			    (variable-value 'ed::default-font)
 			    "8x13u" "8x13bold"))
@@ -245,6 +256,7 @@
 ;;; font-map-size should be defined in font.lisp, but SETUP-FONT-FAMILY would
 ;;; assume it to be special, issuing a nasty warning.
 ;;;
+#+clx
 (defconstant font-map-size 16
   "The number of possible fonts in a font-map.")
 
@@ -255,6 +267,7 @@
 ;;; in lieu of "Active Region Highlighting Font" and "Open Paren Highlighting
 ;;; Font" when these are defined.
 ;;;
+#+clx
 (defun setup-font-family (display default-font default-highlight-font
 				  default-open-paren-font)
   (let* ((font-family (make-font-family :map (make-array font-map-size
@@ -293,6 +306,7 @@
 ;;; level, we want to deal with this error here returning nil if the font
 ;;; couldn't be opened.
 ;;;
+#+clx
 (defun setup-one-font (display font-name font-family-map index)
   (handler-case (let ((font (xlib:open-font display (namestring font-name))))
 		  (xlib:display-finish-output display)
@@ -301,7 +315,6 @@
      (warn "Cannot open font -- ~S" font-name)
      nil)))
 
-
 
 ;;;; HEMLOCK-BEEP.
 
@@ -313,36 +326,40 @@
 (defun tty-beep (&optional device stream)
   (declare (ignore device stream))
   (when (variable-value 'ed::bell-style)
-    (mach:unix-write 1 *editor-bell* 0 1)))
+    (unix:unix-write 1 *editor-bell* 0 1)))
 
 (proclaim '(special *current-window*))
 
 ;;; BITMAP-BEEP is used in Hemlock for beeping when running under windowed
 ;;; input.
 ;;;
-(defun bitmap-beep (display stream)
+#+clx
+(defun bitmap-beep (device stream)
   (declare (ignore stream))
-  (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.
-     )))
-
+  (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.
+       ))))
+
+#+clx
 (proclaim '(special *foreground-background-xor*))
 
+#+clx
 (defun flash-window-border (window)
   (let* ((hunk (window-hunk window))
 	 (xwin (bitmap-hunk-xwindow hunk))
@@ -358,17 +375,20 @@
 	 (bottom-y (- h top-border)))
     (xlib:with-gcontext (gcontext :function xlib::boole-xor
 				  :foreground *foreground-background-xor*)
-      (dotimes (i 8)
-	(xlib:draw-rectangle xwin gcontext 0 0 side-border h t)
-	(xlib:display-force-output display)
-	(xlib:draw-rectangle xwin gcontext side-border bottom-y
-			     top-width top-border t)
-	(xlib:display-force-output display)
-	(xlib:draw-rectangle xwin gcontext right-x 0 side-border h t)
+      (flet ((zot ()
+	       (xlib:draw-rectangle xwin gcontext 0 0 side-border h t)
+	       (xlib:draw-rectangle xwin gcontext side-border bottom-y
+				    top-width top-border t)
+	       (xlib:draw-rectangle xwin gcontext right-x 0 side-border h t)
+	       (xlib:draw-rectangle xwin gcontext side-border 0
+				    top-width top-border t)))
+	(zot)
 	(xlib:display-force-output display)
-	(xlib:draw-rectangle xwin gcontext side-border 0 top-width top-border t)
+	(sleep 0.1)
+	(zot)
 	(xlib:display-force-output display)))))
 
+#+clx
 (defun flash-window (window)
   (let* ((hunk (window-hunk window))
 	 (xwin (bitmap-hunk-xwindow hunk))
@@ -381,15 +401,14 @@
 				  :foreground *foreground-background-xor*)
       (xlib:draw-rectangle xwin gcontext 0 0 width height t)
       (xlib:display-force-output display)
+      (sleep 0.1)
       (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) (bitmap-device-display device) stream)))
+    (funcall (device-beep device) device stream)))
 
 
 
@@ -452,6 +471,7 @@
 	 (cond ((not *editor-windowed-input*)
 		,@body)
 	       (t
+		#+clx
 		(ext:with-clx-event-handling
 		    (*editor-windowed-input* #'ext:object-set-event-handler)
 		  ,@body)))))
@@ -469,6 +489,7 @@
 ;;; Maybe bury/unbury hemlock window when we go to and from Lisp.
 ;;; This should do something more sophisticated when we know what that is.
 ;;; 
+#+clx
 (defun default-hemlock-window-mngt (display on)
   (let ((xparent (window-group-xparent
 		  (bitmap-hunk-window-group (window-hunk *current-window*))))
@@ -482,7 +503,7 @@
 	     (setf (xlib:window-priority xparent) :below))))
   (xlib:display-force-output display))
 
-(defvar *hemlock-window-mngt* #'default-hemlock-window-mngt
+(defvar *hemlock-window-mngt* nil;#'default-hemlock-window-mngt
   "This function is called by HEMLOCK-WINDOW, passing its arguments.  This may
    be nil.")
 
@@ -503,7 +524,7 @@
 
 ;;;; Current terminal character translation.
 
-(defconstant termcap-file "/etc/termcap")
+(defvar termcap-file "/etc/termcap")
 
 
 
@@ -666,6 +687,7 @@
 	   t)
 	(t nil)))
 
+#+clx
 (defun bitmap-show-mark (window x y time)
   (cond ((listen-editor-input *editor-input*))
 	(x (let* ((hunk (window-hunk window))
@@ -679,7 +701,6 @@
 	     t))
 	(t nil)))
 
-
 
 ;;;; Function description and defined-from.
 
@@ -688,23 +709,26 @@
 ;;; not defined in some file, then nil is returned.
 ;;; 
 (defun fun-defined-from-pathname (function)
-  "Takes a symbol or function and returns the pathname for the file the function
-   was defined in.  If it was not defined in some file, nil is returned."
-  (typecase function
-    (symbol (fun-defined-from-pathname (careful-symbol-function function)))
-    (compiled-function
-     (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)))
+  "Takes a symbol or function and returns the pathname for the file the
+   function was defined in.  If it was not defined in some file, nil is
+   returned."
+  (flet ((frob (code)
+	   (let ((info (kernel:%code-debug-info code)))
+	     (when info
+	       (let ((sources (c::debug-info-source info)))
+		 (when sources
+		   (let ((source (car sources)))
+		     (when (eq (c::debug-source-from source) :file)
+		       (c::debug-source-name source)))))))))
+    (typecase function
+      (symbol (fun-defined-from-pathname (fdefinition function)))
+      (kernel:byte-closure
+       (fun-defined-from-pathname (kernel:byte-closure-function function)))
+      (kernel:byte-function
+       (frob (c::byte-function-component function)))
+      (function
+       (frob (kernel:function-code-header (kernel:%function-self function))))
+      (t nil))))
 
 
 (defvar *editor-describe-stream*
@@ -729,7 +753,8 @@
    *standard-output*."
   (describe fun)
   (when (and (compiled-function-p fun)
-	     (not (eq (%primitive header-ref fun %function-name-slot) sym)))
+	     (not (eq (kernel:%function-name (kernel:%closure-function fun))
+		      sym)))
     (let ((doc (documentation sym 'function)))
       (when doc
 	(format t "~&Function documentation for ~S:" sym)
@@ -743,31 +768,38 @@
 
 
 ;;;; X Stuff.
-
 ;;; Setting window cursors ...
 ;;; 
 
+#+clx
 (proclaim '(special *default-foreground-pixel* *default-background-pixel*))
 
+#+clx
 (defvar *hemlock-cursor* nil "Holds cursor for Hemlock windows.")
 
 ;;; DEFINE-WINDOW-CURSOR in shoved on the "Make Window Hook".
 ;;; 
+#+clx
 (defun define-window-cursor (window)
   (setf (xlib:window-cursor (bitmap-hunk-xwindow (window-hunk window)))
 	*hemlock-cursor*))
 
 ;;; These are set in INIT-BITMAP-SCREEN-MANAGER and REVERSE-VIDEO-HOOK-FUN.
 ;;;
+#+clx
 (defvar *cursor-foreground-color* nil)
+#+clx
 (defvar *cursor-background-color* nil)
+#+clx
 (defun make-white-color () (xlib:make-color :red 1.0 :green 1.0 :blue 1.0))
+#+clx
 (defun make-black-color () (xlib:make-color :red 0.0 :green 0.0 :blue 0.0))
 
 
 ;;; GET-HEMLOCK-CURSOR is used in INIT-BITMAP-SCREEN-MANAGER to load the
 ;;; hemlock cursor for DEFINE-WINDOW-CURSOR.
 ;;;
+#+clx
 (defun get-hemlock-cursor (display)
   (when *hemlock-cursor* (xlib:free-cursor *hemlock-cursor*))
   (let* ((cursor-file (truename (variable-value 'ed::cursor-bitmap-file)))
@@ -785,6 +817,7 @@
       (xlib:free-pixmap cursor-pixmap)
       (when mask-pixmap (xlib:free-pixmap mask-pixmap)))))
 
+#+clx
 (defun get-cursor-pixmap (root pathname)
   (let* ((image (xlib:read-bitmap-file pathname))
 	 (pixmap (xlib:create-pixmap :width 16 :height 16
@@ -801,9 +834,11 @@
 ;;; Setting up grey borders ...
 ;;; 
 
+#+clx
 (defparameter hemlock-grey-bitmap-data
   '(#*10 #*01))
 
+#+clx
 (defun get-hemlock-grey-pixmap (display)
   (let* ((screen (xlib:display-default-screen display))
 	 (depth (xlib:screen-root-depth screen))
@@ -826,26 +861,29 @@
 ;;; Cut Buffer manipulation ...
 ;;;
 
+#+clx
 (defun store-cut-string (display string)
   (check-type string simple-string)
   (setf (xlib:cut-buffer display) string))
 
+#+clx
 (defun fetch-cut-string (display)
   (xlib:cut-buffer display))
 
 
 ;;; Window naming ...
 ;;;
+#+clx
 (defun set-window-name-for-buffer-name (buffer new-name)
   (dolist (ele (buffer-windows buffer))
     (xlib:set-standard-properties (bitmap-hunk-xwindow (window-hunk ele))
 				  :icon-name new-name)))
   
+#+clx
 (defun set-window-name-for-window-buffer (window new-buffer)
   (xlib:set-standard-properties (bitmap-hunk-xwindow (window-hunk window))
 				:icon-name (buffer-name new-buffer)))
 
-
 
 ;;;; Some hacks for supporting Hemlock under Mach.
 
@@ -864,44 +902,28 @@
   (cdr (assoc :termcap *environment-list* :test #'eq)))
 
 
-
-(defvar *editor-buffer* (make-string 256))
-
 ;;; GET-EDITOR-TTY-INPUT reads from stream's Unix file descriptor queuing events
 ;;; in the stream's queue.
 ;;;
 (defun get-editor-tty-input (fd)
-  (let* ((buf *editor-buffer*)
-	 (len (mach:unix-read fd buf 256))
-	 (i 0))
-    (declare (simple-string buf) (fixnum len i))
-    (loop
-      (when (>= i len) (return t))
-      (q-event *real-editor-input*
-	       (ext:char-key-event (schar buf i)))
-      (incf i))))
-
-;;; This is used to get listening during smart redisplay to pick up input
-;;; in between displaying each line by listening longer (or slowing down
-;;; line output depending on your model).  10-20 seems to be good for 9600
-;;; baud, and 250 seems to do it with 1200 baud.
-;;; 
-(defparameter listen-iterations-hack 1) ; 10-20 seems to really pick up input.
+  (alien:with-alien ((buf (alien:array c-call:unsigned-char 256)))
+    (multiple-value-bind
+	(len errno)
+	(unix:unix-read fd (alien:alien-sap buf) 256)
+      (declare (type (or null fixnum) len))
+      (unless len
+	(error "Problem with tty input: ~S"
+	       (unix:get-unix-error-msg errno)))
+      (dotimes (i len t)
+	(q-event *real-editor-input*
+		 (ext:char-key-event (code-char (alien:deref buf i))))))))
 
 (defun editor-tty-listen (stream)
-  (mach::with-trap-arg-block mach::int1 nc
-    (dotimes (i listen-iterations-hack nil)
-      (multiple-value-bind (val err) 
-			   (mach::Unix-ioctl (tty-editor-input-fd stream)
-					     mach::FIONREAD
-					     (lisp::alien-value-sap
-					      mach::int1))
-	(declare (ignore err))
-	(when (and val
-		   (> (alien-access (mach::int1-int (alien-value nc))) 0))
-	  (return t))))))
-
-
+  (alien:with-alien ((nc c-call:int))
+    (and (unix:unix-ioctl (tty-editor-input-fd stream)
+			  unix::FIONREAD
+			  (alien:alien-sap (alien:addr nc)))
+	 (> nc 0))))
 
 (defvar old-flags)
 
@@ -909,157 +931,233 @@
 
 (defvar old-ltchars)
 
+#+hpux
+(progn
+  (defvar old-c-iflag)
+  (defvar old-c-oflag)
+  (defvar old-c-cflag)
+  (defvar old-c-lflag)
+  (defvar old-c-cc))
+
 (defun setup-input ()
   (let ((fd *editor-file-descriptor*))
-    (when (mach:unix-isatty 0)
-      (mach:with-trap-arg-block mach:sgtty sg
+    (when (unix:unix-isatty 0)
+      #+hpux
+      (alien:with-alien ((tios (alien:struct unix:termios)))
 	(multiple-value-bind
 	    (val err)
-	    (mach:unix-ioctl fd mach:TIOCGETP
-			     (lisp::alien-value-sap mach:sgtty))
-	  (if (null val)
-	      (error "Could not get tty information, unix error ~S."
-		     (mach:get-unix-error-msg err)))
-	  (let ((flags (alien-access (mach::sgtty-flags (alien-value sg)))))
-	    (setq old-flags flags)
-	    (setf (alien-access (mach::sgtty-flags (alien-value sg)))
-		  (logand (logior flags mach::tty-cbreak)
-			  (lognot mach::tty-echo)
-			  (lognot mach::tty-crmod)))
-	    (multiple-value-bind
-		(val err)
-		(mach:unix-ioctl fd mach:TIOCSETP
-				 (lisp::alien-value-sap mach:sgtty))
-	      (if (null val)
-		  (error "Could not set tty information, unix error ~S."
-			 (mach:get-unix-error-msg err)))))))
-      (mach:with-trap-arg-block mach:tchars tc
+	    (unix:unix-tcgetattr fd (alien:alien-sap tios))
+	  (when (null val)
+	    (error "Could not tcgetattr, unix error ~S."
+		   (unix:get-unix-error-msg err))))
+	(setf old-c-iflag (alien:slot tios 'unix:c-iflag))
+	(setf old-c-oflag (alien:slot tios 'unix:c-oflag))
+	(setf old-c-cflag (alien:slot tios 'unix:c-cflag))
+	(setf old-c-lflag (alien:slot tios 'unix:c-lflag))
+	(setf old-c-cc
+	      (vector (alien:deref (alien:slot tios 'unix:c-cc) unix:vdsusp)
+		      (alien:deref (alien:slot tios 'unix:c-cc) unix:veof)
+		      (alien:deref (alien:slot tios 'unix:c-cc) unix:vintr)
+		      (alien:deref (alien:slot tios 'unix:c-cc) unix:vquit)
+		      (alien:deref (alien:slot tios 'unix:c-cc) unix:vstart)
+		      (alien:deref (alien:slot tios 'unix:c-cc) unix:vstop)
+		      (alien:deref (alien:slot tios 'unix:c-cc) unix:vsusp)
+		      (alien:deref (alien:slot tios 'unix:c-cc) unix:vmin)
+		      (alien:deref (alien:slot tios 'unix:c-cc) unix:vtime)))
+	(setf (alien:slot tios 'unix:c-lflag)
+	      (logand (alien:slot tios 'unix:c-lflag)
+		      (lognot (logior unix:tty-echo unix:tty-icanon))))
+	(setf (alien:slot tios 'unix:c-iflag)
+	      (logand (alien:slot tios 'unix:c-iflag)
+		      (lognot (logior unix:tty-icrnl unix:tty-ixon))))
+	(setf (alien:slot tios 'unix:c-oflag)
+	      (logand (alien:slot tios 'unix:c-oflag) (lognot unix:tty-ocrnl)))
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vdsusp) #xff)
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:veof) #xff)
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vintr)
+	      (if *editor-windowed-input* #xff 28))
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vquit) #xff)
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vstart) #xff)
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vstop) #xff)
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vsusp) #xff)
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vmin) 1)
+	(setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vtime) 0)
+	(multiple-value-bind
+	    (val err)
+	    (unix:unix-tcsetattr fd unix:tcsaflush (alien:alien-sap tios))
+	  (when (null val)
+	    (error "Could not tcsetattr, unix error ~S."
+		   (unix:get-unix-error-msg err)))))
+      #-hpux
+      (alien:with-alien ((sg (alien:struct unix:sgttyb)))
 	(multiple-value-bind
 	    (val err)
-	    (mach:unix-ioctl fd mach:TIOCGETC
-			     (lisp::alien-value-sap mach:tchars))
-	  (if (null val)
-	      (error "Could not get tty tchars information, unix error ~S."
-		     (mach:get-unix-error-msg err)))
-	  (setq old-tchars
-		(vector (alien-access (mach::tchars-intrc (alien-value tc)))
-			(alien-access (mach::tchars-quitc (alien-value tc)))
-			(alien-access (mach::tchars-startc (alien-value tc)))
-			(alien-access (mach::tchars-stopc (alien-value tc)))
-			(alien-access (mach::tchars-eofc (alien-value tc)))
-			(alien-access (mach::tchars-brkc (alien-value tc))))))
-	(setf (alien-access (mach::tchars-intrc (alien-value tc)))
+	    (unix:unix-ioctl fd unix:TIOCGETP (alien:alien-sap sg))
+	  (unless val
+	    (error "Could not get tty information, unix error ~S."
+		   (unix:get-unix-error-msg err))))
+	(let ((flags (alien:slot sg 'unix:sg-flags)))
+	  (setq old-flags flags)
+	  (setf (alien:slot sg 'unix:sg-flags)
+		(logand #-hpux (logior flags unix:tty-cbreak)
+			(lognot unix:tty-echo)
+			(lognot unix:tty-crmod)))
+	  (multiple-value-bind
+	      (val err)
+	      (unix:unix-ioctl fd unix:TIOCSETP (alien:alien-sap sg))
+	    (if (null val)
+		(error "Could not set tty information, unix error ~S."
+		       (unix:get-unix-error-msg err))))))
+      #-hpux
+      (alien:with-alien ((tc (alien:struct unix:tchars)))
+	(multiple-value-bind
+	    (val err)
+	    (unix:unix-ioctl fd unix:TIOCGETC (alien:alien-sap tc))
+	  (unless val
+	    (error "Could not get tty tchars information, unix error ~S."
+		   (unix:get-unix-error-msg err))))
+	(setq old-tchars
+	      (vector (alien:slot tc 'unix:t-intrc)
+		      (alien:slot tc 'unix:t-quitc)
+		      (alien:slot tc 'unix:t-startc)
+		      (alien:slot tc 'unix:t-stopc)
+		      (alien:slot tc 'unix:t-eofc)
+		      (alien:slot tc 'unix:t-brkc)))
+	(setf (alien:slot tc 'unix:t-intrc)
 	      (if *editor-windowed-input* -1 28))
-	(setf (alien-access (mach::tchars-quitc (alien-value tc))) -1)
-	(setf (alien-access (mach::tchars-startc (alien-value tc))) -1)
-	(setf (alien-access (mach::tchars-stopc (alien-value tc))) -1)
-	(setf (alien-access (mach::tchars-eofc (alien-value tc))) -1)
-	(setf (alien-access (mach::tchars-brkc (alien-value tc))) -1)
+	(setf (alien:slot tc 'unix:t-quitc) -1)
+	(setf (alien:slot tc 'unix:t-startc) -1)
+	(setf (alien:slot tc 'unix:t-stopc) -1)
+	(setf (alien:slot tc 'unix:t-eofc) -1)
+	(setf (alien:slot tc 'unix:t-brkc) -1)
 	(multiple-value-bind
 	    (val err)
-	    (mach:unix-ioctl fd mach:TIOCSETC
-			     (lisp::alien-value-sap mach:tchars))
-	  (if (null val) (error "Failed to set tchars, unix error ~S."
-				(mach:get-unix-error-msg err)))))
-      (mach:with-trap-arg-block mach:ltchars tc
+	    (unix:unix-ioctl fd unix:TIOCSETC (alien:alien-sap tc))
+	  (unless val
+	    (error "Failed to set tchars, unix error ~S."
+		   (unix:get-unix-error-msg err)))))
+
+      ;; Needed even under HpUx to suppress dsuspc.
+      (alien:with-alien ((tc (alien:struct unix:ltchars)))
 	(multiple-value-bind
 	    (val err)
-	    (mach:unix-ioctl fd mach:TIOCGLTC
-			     (lisp::alien-value-sap mach:ltchars))
-	  (if (null val)
-	      (error "Could not get tty ltchars information, unix error ~S."
-		     (mach:get-unix-error-msg err)))
-	  (setq old-ltchars
-		(vector (alien-access (mach::ltchars-suspc (alien-value tc)))
-			(alien-access (mach::ltchars-dsuspc (alien-value tc)))
-			(alien-access (mach::ltchars-rprntc (alien-value tc)))
-			(alien-access (mach::ltchars-flushc (alien-value tc)))
-			(alien-access (mach::ltchars-werasc (alien-value tc)))
-			(alien-access (mach::ltchars-lnextc (alien-value tc))))))
-	(setf (alien-access (mach::ltchars-suspc (alien-value tc))) -1)
-	(setf (alien-access (mach::ltchars-dsuspc (alien-value tc))) -1)
-	(setf (alien-access (mach::ltchars-rprntc (alien-value tc))) -1)
-	(setf (alien-access (mach::ltchars-flushc (alien-value tc))) -1)
-	(setf (alien-access (mach::ltchars-werasc (alien-value tc))) -1)
-	(setf (alien-access (mach::ltchars-lnextc (alien-value tc))) -1)
+	    (unix:unix-ioctl fd unix:TIOCGLTC (alien:alien-sap tc))
+	  (unless val
+	    (error "Could not get tty ltchars information, unix error ~S."
+		   (unix:get-unix-error-msg err))))
+	(setq old-ltchars
+	      (vector (alien:slot tc 'unix:t-suspc)
+		      (alien:slot tc 'unix:t-dsuspc)
+		      (alien:slot tc 'unix:t-rprntc)
+		      (alien:slot tc 'unix:t-flushc)
+		      (alien:slot tc 'unix:t-werasc)
+		      (alien:slot tc 'unix:t-lnextc)))
+	(setf (alien:slot tc 'unix:t-suspc) -1)
+	(setf (alien:slot tc 'unix:t-dsuspc) -1)
+	(setf (alien:slot tc 'unix:t-rprntc) -1)
+	(setf (alien:slot tc 'unix:t-flushc) -1)
+	(setf (alien:slot tc 'unix:t-werasc) -1)
+	(setf (alien:slot tc 'unix:t-lnextc) -1)
 	(multiple-value-bind
 	    (val err)
-	    (mach:unix-ioctl fd mach:TIOCSLTC
-			     (lisp::alien-value-sap mach:ltchars))
-	  (if (null val) (error "Failed to set ltchars, unix error ~S."
-				(mach:get-unix-error-msg err))))))))
+	    (unix:unix-ioctl fd unix:TIOCSLTC (alien:alien-sap tc))
+	  (unless val
+	    (error "Failed to set ltchars, unix error ~S."
+		   (unix:get-unix-error-msg err))))))))
 
-	
 (defun reset-input ()
-  (when (mach:unix-isatty 0)
-    (if (boundp 'old-flags)
-	(let ((fd *editor-file-descriptor*))
-	  (mach:with-trap-arg-block mach:sgtty sg
+  (when (unix:unix-isatty 0)
+    (let ((fd *editor-file-descriptor*))
+      #+hpux
+      (when (boundp 'old-c-lflag)
+	(alien:with-alien ((tios (alien:struct unix:termios)))
+	  (multiple-value-bind
+	      (val err)
+	      (unix:unix-tcgetattr fd (alien:alien-sap tios))
+	    (when (null val)
+	      (error "Could not tcgetattr, unix error ~S."
+		     (unix:get-unix-error-msg err))))
+	  (setf (alien:slot tios 'unix:c-iflag) old-c-iflag)
+	  (setf (alien:slot tios 'unix:c-oflag) old-c-oflag)
+	  (setf (alien:slot tios 'unix:c-cflag) old-c-cflag)
+	  (setf (alien:slot tios 'unix:c-lflag) old-c-lflag)
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vdsusp)
+		(svref old-c-cc 0))
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:veof)
+		(svref old-c-cc 1))
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vintr)
+		(svref old-c-cc 2))
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vquit)
+		(svref old-c-cc 3))
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vstart)
+		(svref old-c-cc 4))
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vstop)
+		(svref old-c-cc 5))
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vsusp)
+		(svref old-c-cc 6))
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vmin)
+		(svref old-c-cc 7))
+	  (setf (alien:deref (alien:slot tios 'unix:c-cc) unix:vtime)
+		(svref old-c-cc 8))
+	  (multiple-value-bind
+	      (val err)
+	      (unix:unix-tcsetattr fd unix:tcsaflush (alien:alien-sap tios))
+	    (when (null val)
+	      (error "Could not tcsetattr, unix error ~S."
+		     (unix:get-unix-error-msg err))))))
+      #-hpux
+      (when (boundp 'old-flags)
+	(alien:with-alien ((sg (alien:struct unix:sgttyb)))
+	  (multiple-value-bind
+	      (val err)
+	      (unix:unix-ioctl fd unix:TIOCGETP (alien:alien-sap sg))
+	    (unless val
+	      (error "Could not get tty information, unix error ~S."
+		     (unix:get-unix-error-msg err)))
+	    (setf (alien:slot sg 'unix:sg-flags) old-flags)
 	    (multiple-value-bind
 		(val err)
-		(mach:unix-ioctl fd mach:TIOCGETP
-				 (lisp::alien-value-sap mach:sgtty))
-	      (if (null val)
-		  (error "Could not get tty information, unix error ~S."
-			 (mach:get-unix-error-msg err)))
-	      (setf (alien-access (mach::sgtty-flags (alien-value sg)))
-		    old-flags)
-	      (multiple-value-bind
-		  (val err)
-		  (mach:unix-ioctl fd mach:TIOCSETP
-				   (lisp::alien-value-sap mach:sgtty))
-		(if (null val)
-		    (error "Could not set tty information, unix error ~S."
-			   (mach:get-unix-error-msg err))))))
-	  (cond ((and (boundp 'old-tchars)
-		      (simple-vector-p old-tchars)
-		      (eq (length old-tchars) 6))
-		 (mach:with-trap-arg-block mach:tchars tc
-		   (setf (alien-access (mach::tchars-intrc (alien-value tc)))
-			 (svref old-tchars 0))
-		   (setf (alien-access (mach::tchars-quitc (alien-value tc)))
-			 (svref old-tchars 1))
-		   (setf (alien-access (mach::tchars-startc (alien-value tc)))
-			 (svref old-tchars 2))
-		   (setf (alien-access (mach::tchars-stopc (alien-value tc)))
-			 (svref old-tchars 3))
-		   (setf (alien-access (mach::tchars-eofc (alien-value tc)))
-			 (svref old-tchars 4))
-		   (setf (alien-access (mach::tchars-brkc (alien-value tc)))
-			 (svref old-tchars 5))
-		   (multiple-value-bind
-		       (val err)
-		       (mach:unix-ioctl fd mach:TIOCSETC
-					(lisp::alien-value-sap mach:tchars))
-		     (if (null val)
-			 (error "Failed to set tchars, unix error ~S."
-				(mach:get-unix-error-msg err)))))))
-	  (cond ((and (boundp 'old-ltchars)
-		      (simple-vector-p old-ltchars)
-		      (eq (length old-ltchars) 6))
-		 (mach:with-trap-arg-block mach:ltchars tc
-		   (setf (alien-access (mach::ltchars-suspc (alien-value tc)))
-			 (svref old-ltchars 0))
-		   (setf (alien-access (mach::ltchars-dsuspc (alien-value tc)))
-			 (svref old-ltchars 1))
-		   (setf (alien-access (mach::ltchars-rprntc (alien-value tc)))
-			 (svref old-ltchars 2))
-		   (setf (alien-access (mach::ltchars-flushc (alien-value tc)))
-			 (svref old-ltchars 3))
-		   (setf (alien-access (mach::ltchars-werasc (alien-value tc)))
-			 (svref old-ltchars 4))
-		   (setf (alien-access (mach::ltchars-lnextc (alien-value tc)))
-			 (svref old-ltchars 5))
-		   (multiple-value-bind
-		       (val err)
-		       (mach:unix-ioctl fd mach:TIOCSLTC
-					(lisp::alien-value-sap mach:ltchars))
-		     (if (null val)
-			 (error "Failed to set ltchars, unix error ~S."
-				(mach:get-unix-error-msg err)))))))))))
-
+		(unix:unix-ioctl fd unix:TIOCSETP (alien:alien-sap sg))
+	      (unless val
+		(error "Could not set tty information, unix error ~S."
+		       (unix:get-unix-error-msg err)))))))
+      #-hpux
+      (when (and (boundp 'old-tchars)
+		 (simple-vector-p old-tchars)
+		 (eq (length old-tchars) 6))
+	(alien:with-alien ((tc (alien:struct unix:tchars)))
+	  (setf (alien:slot tc 'unix:t-intrc) (svref old-tchars 0))
+	  (setf (alien:slot tc 'unix:t-quitc) (svref old-tchars 1))
+	  (setf (alien:slot tc 'unix:t-startc) (svref old-tchars 2))
+	  (setf (alien:slot tc 'unix:t-stopc) (svref old-tchars 3))
+	  (setf (alien:slot tc 'unix:t-eofc) (svref old-tchars 4))
+	  (setf (alien:slot tc 'unix:t-brkc) (svref old-tchars 5))
+	  (multiple-value-bind
+	      (val err)
+	      (unix:unix-ioctl fd unix:TIOCSETC (alien:alien-sap tc))
+	    (unless val
+	      (error "Failed to set tchars, unix error ~S."
+		     (unix:get-unix-error-msg err))))))
+
+      (when (and (boundp 'old-ltchars)
+		 (simple-vector-p old-ltchars)
+		 (eq (length old-ltchars) 6))
+	(alien:with-alien ((tc (alien:struct unix:ltchars)))
+	  (setf (alien:slot tc 'unix:t-suspc) (svref old-ltchars 0))
+	  (setf (alien:slot tc 'unix:t-dsuspc) (svref old-ltchars 1))
+	  (setf (alien:slot tc 'unix:t-rprntc) (svref old-ltchars 2))
+	  (setf (alien:slot tc 'unix:t-flushc) (svref old-ltchars 3))
+	  (setf (alien:slot tc 'unix:t-werasc) (svref old-ltchars 4))
+	  (setf (alien:slot tc 'unix:t-lnextc) (svref old-ltchars 5))
+	  (multiple-value-bind
+	      (val err)
+	      (unix:unix-ioctl fd unix:TIOCSLTC (alien:alien-sap tc))
+	    (unless val
+	      (error "Failed to set ltchars, unix error ~S."
+		     (unix:get-unix-error-msg err)))))))))
 
 (defun pause-hemlock ()
   "Pause hemlock and pop out to the Unix Shell."
-  (mach:unix-kill (mach:unix-getpid) mach:sigtstp)
+  (system:without-hemlock
+   (unix:unix-kill (unix:unix-getpid) :sigstop))
   T)
diff --git a/hemlock/screen.lisp b/hemlock/screen.lisp
index e9251a7d9..65f98d135 100644
--- a/hemlock/screen.lisp
+++ b/hemlock/screen.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/screen.lisp,v 1.3 1994/02/11 21:53:44 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;;    Written by Bill Chiles.
@@ -42,17 +45,20 @@
 
 ;;;; Window operations.
 
-(defun make-window (start &key
-			  (modelinep t)
-			  (device nil)
-			  window
+(defun make-window (start &key (modelinep t) (device nil) window
+			  (proportion .5)			  
 			  (font-family *default-font-family*)
-			  (ask-user nil)
-			  x y
+			  (ask-user nil) x y
 			  (width (value ed::default-window-width))
 			  (height (value ed::default-window-height)))
-  "Make a window that displays text starting at the mark Start.  The default
-   action is to split the current window to make room for the new window.
+  "Make a window that displays text starting at the mark start.  The default
+   action is to make the new window a proportion of the current window's height
+   to make room for the new window.
+
+   Proportion determines what proportion of the current window's height
+   the new window will use.  The current window retains whatever space left
+   after accommodating the new one.  The default is to split the current window
+   in half.
 
    Modelinep specifies whether the window should display buffer modelines.
 
@@ -74,7 +80,7 @@
   (let* ((device (or device (device-hunk-device (window-hunk (current-window)))))
 	 (window (funcall (device-make-window device)
 			  device start modelinep window font-family
-			  ask-user x y width height)))
+			  ask-user x y width height proportion)))
     (unless window (editor-error "Could not make a window."))
     (invoke-hook ed::make-window-hook window)
     window))
@@ -188,7 +194,7 @@
   (list (make-modeline-field
 	 :name :more-prompt
 	 :function #'(lambda (buffer window)
-		       (declare (ignore buffer window))
+		       (declare (ignore window))
 		       (ecase *more-prompt-action*
 			 (:more "--More--")
 			 (:flush "--Flush--")
diff --git a/hemlock/search1.lisp b/hemlock/search1.lisp
index 8a85603a9..a172ea45b 100644
--- a/hemlock/search1.lisp
+++ b/hemlock/search1.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/search1.lisp,v 1.1.1.4 1992/01/06 16:24:15 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/search1.lisp,v 1.2 1994/02/11 21:53:45 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/shell.lisp b/hemlock/shell.lisp
index 1ca0e0405..791f47ee4 100644
--- a/hemlock/shell.lisp
+++ b/hemlock/shell.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/shell.lisp,v 1.3 1994/02/11 21:53:46 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Hemlock command level support for processes.
@@ -25,7 +28,7 @@
     (defhvar "Process Output Stream"
       "The process structure for this buffer."
       :buffer buffer
-      :value (make-hemlock-output-stream mark))
+      :value (make-hemlock-output-stream mark :full))
     (defhvar "Interactive History"
       "A ring of the regions input to an interactive mode (Eval or Typescript)."
       :buffer buffer
@@ -45,6 +48,122 @@
 
 (defmode "Process" :major-p nil :setup-function #'setup-process-buffer)
 
+
+
+;;;; Shell-filter streams.
+
+;;; We use shell-filter-streams to capture text going from the shell process to
+;;; a Hemlock output stream.  They pass character and misc operations through
+;;; to the attached hemlock-output-stream.  The string output function scans
+;;; the string for ^A_____^B, denoting a change of directory.
+;;;
+;;; The following aliases in a .cshrc file are required for using filename
+;;; completion:
+;;;    alias cd 'cd \!* ; echo ""`pwd`"/"'
+;;;    alias popd 'popd \!* ; echo ""`pwd`"/"'
+;;;    alias pushd 'pushd \!* ; echo ""`pwd`"/"'
+;;;
+
+(defstruct (shell-filter-stream
+	    (:include stream
+		      (:out #'shell-filter-out)
+		      (:sout #'shell-filter-string-out)
+		      (:misc #'shell-filter-output-misc))
+	    (:print-function print-shell-filter-stream)
+	    (:constructor 
+	     make-shell-filter-stream (buffer hemlock-stream)))
+  ;; The buffer where output will be going
+  buffer
+  ;; The Hemlock stream to which output will be directed
+  hemlock-stream)
+
+
+;;; PRINT-SHELL-FILTER-STREAM  -- Internal
+;;;
+;;; Function for printing a shell-filter-stream.
+;;;
+(defun print-shell-filter-stream (s stream d)
+  (declare (ignore d s))
+  (write-string "#<Shell filter stream>" stream))
+
+
+;;; SHELL-FILTER-OUT -- Internal
+;;;
+;;; This is the character-out handler for the shell-filter-stream.
+;;; It writes the character it is given to the underlying
+;;; hemlock-output-stream.
+;;;
+(defun shell-filter-out (stream character)
+  (write-char character (shell-filter-stream-hemlock-stream stream)))
+
+
+;;; SHELL-FILTER-OUTPUT-MISC -- Internal
+;;;
+;;; This will also simply pass the output request on the the
+;;; attached hemlock-output-stream.
+;;;
+(defun shell-filter-output-misc (stream operation &optional arg1 arg2)
+  (let ((hemlock-stream (shell-filter-stream-hemlock-stream stream)))
+    (funcall (hi::hemlock-output-stream-misc hemlock-stream)
+	     hemlock-stream operation arg1 arg2)))
+
+
+;;; CATCH-CD-STRING -- Internal
+;;;
+;;; Scans String for the sequence ^A...^B.  Returns as multiple values
+;;; the breaks in the string.  If the second start/end pair is nil, there
+;;; was no cd sequence.
+;;;
+(defun catch-cd-string (string start end)
+  (declare (simple-string string))
+  (let ((cd-start (position (code-char 1) string :start start :end end)))
+    (if cd-start
+	(let ((cd-end (position (code-char 2) string :start cd-start :end end)))
+	  (if cd-end
+	      (values start cd-start cd-end end)
+	      (values start end nil nil)))
+	(values start end nil nil))))
+
+;;; SHELL-FILTER-STRING-OUT -- Internal
+;;;
+;;; The string output function for shell-filter-stream's.
+;;; Any string containing a ^A...^B is caught and assumed to be
+;;; the path-name of the new current working directory.  This is
+;;; removed from the orginal string and the result is passed along
+;;; to the Hemlock stream.
+;;;
+(defun shell-filter-string-out (stream string start end)
+  (declare (simple-string string))
+  (let ((hemlock-stream (shell-filter-stream-hemlock-stream stream))
+	(buffer (shell-filter-stream-buffer stream)))
+
+    (multiple-value-bind (start1 end1 start2 end2)
+			 (catch-cd-string string start end)
+      (write-string string hemlock-stream :start start1 :end end1)
+      (when start2
+	(write-string string hemlock-stream :start (+ 2 start2) :end end2)
+	(let ((cd-string (subseq string (1+ end1) start2)))
+	  (setf (variable-value 'current-working-directory :buffer buffer)
+		(pathname cd-string)))))))
+
+
+;;; FILTER-TILDES -- Internal
+;;;
+;;; Since COMPLETE-FILE does not seem to deal with ~'s in the filename
+;;; this function expands them to a full path name.
+;;;
+(defun filter-tildes (name)
+  (declare (simple-string name))
+  (if (char= (schar name 0) #\~)
+      (concatenate 'simple-string
+		   (if (or (= (length name) 1)
+			   (char= (schar name 1) #\/))
+		       (cdr (assoc :home *environment-list*))
+		       "/usr/")
+		 (subseq name 1))
+      name))
+
+
 
 ;;;; Support for handling input before the prompt in process buffers.
 
@@ -65,6 +184,7 @@
   :value "Interrupt and throw to end of buffer?"
   :mode "Process")
 
+
 
 ;;;; Some Global Variables.
 
@@ -114,7 +234,7 @@
 (defun set-current-shell ()
   (let ((old-buffer (value current-shell))
 	(first-old-shell (do-strings (var val *shell-names* nil)
-			   (declare (ignore var val))
+			   (declare (ignore val))
 			   (return var))))
     (when (and (not old-buffer) (not first-old-shell))
       (editor-error "Nothing to set current shell to."))
@@ -183,7 +303,7 @@
 				     ,command)
 			   :help "Where output from this process will appear.")
 			  (new-shell-name)))
-	 (buffer (make-buffer
+	 (temp (make-buffer
 		  buffer-name
 		  :modes '("Fundamental" "Process")
 		  :delete-hook
@@ -192,23 +312,32 @@
 			      (setf (value current-shell) nil))
 			    (delete-string (buffer-name buffer) *shell-names*)
 			    (kill-process (variable-value 'process
-							  :buffer buffer)))))))
-    (unless buffer
-      (setf buffer (getstring buffer-name *buffer-names*))
-      (buffer-end (buffer-point buffer)))
+							  :buffer buffer))))))
+	 (buffer (or temp (getstring buffer-name *buffer-names*)))
+	 (stream (variable-value 'process-output-stream :buffer buffer))
+	 (output-stream
+	  ;; If we re-used an old shell buffer, this isn't necessary.
+	  (if (hemlock-output-stream-p stream)
+	      (setf (variable-value 'process-output-stream :buffer buffer)
+		    (make-shell-filter-stream buffer stream))
+	      stream)))
+    (buffer-end (buffer-point buffer))
     (defhvar "Process"
       "The process for Shell and Process buffers."
       :buffer buffer
       :value (ext::run-program "/bin/sh" (list "-c" command)
 			       :wait nil
-			       :pty (variable-value 'process-output-stream
-						    :buffer buffer)
+			       :pty output-stream
 			       :env (frob-environment-list
 				     (car (buffer-windows buffer)))
 			       :status-hook #'(lambda (process)
 						(declare (ignore process))
 						(update-process-buffer buffer))
 			       :input t :output t))
+    (defhvar "Current Working Directory"
+      "The pathname of the current working directory for this buffer."
+      :buffer buffer
+      :value (default-directory))
     (setf (getstring buffer-name *shell-names*) buffer)
     (update-process-buffer buffer)
     (when (and (not (value current-shell)) set-current-shell-p)
@@ -267,7 +396,7 @@
       (ecase (ext:process-status process)
 	(:running "running")
 	(:stopped "stopped")
-	(:signaled "killed by signal ~D" (mach:unix-signal-name
+	(:signaled "killed by signal ~D" (unix:unix-signal-name
 					  (ext:process-exit-code process)))
 	(:exited (format nil "exited with status ~D"
 			 (ext:process-exit-code process)))))))
@@ -308,6 +437,37 @@
       ;; Move "Buffer Input Mark" to end of buffer.
       (move-mark (region-start input-region) (region-end input-region)))))
 
+(defcommand "Shell Complete Filename" (p)
+  "Attempts to complete the filename immediately preceding the point.
+   It will beep if the result of completion is not unique."
+  "Attempts to complete the filename immediately preceding the point.
+   It will beep if the result of completion is not unique."
+  (declare (ignore p))
+  (unless (hemlock-bound-p 'current-working-directory)
+    (editor-error "Shell filename completion only works in shells."))
+  (let ((point (current-point)))
+    (with-mark ((start point))
+      (pre-command-parse-check start)
+      (unless (form-offset start -1) (editor-error "Can't grab filename."))
+      (when (member (next-character start) '(#\" #\' #\< #\>))
+	(mark-after start))
+      (let* ((name-region (region start point))
+	     (fragment (filter-tildes (region-to-string name-region)))
+	     (dir (default-directory))
+	     (shell-dir (value current-working-directory)))
+	(multiple-value-bind (filename unique)
+			     (unwind-protect
+				 (progn
+				   (setf (default-directory) shell-dir)
+				   (complete-file fragment :defaults shell-dir))
+			       (setf (default-directory) dir))
+	  (cond (filename
+		 (delete-region name-region)
+		 (insert-string point (namestring filename))
+		 (when (not unique)
+		   (editor-error)))
+		(t (editor-error "No such file exists."))))))))
+
 (defcommand "Kill Main Process" (p)
   "Kills the process in the current buffer."
   "Kills the process in the current buffer."
@@ -353,7 +513,7 @@
   (unless (hemlock-bound-p 'process :buffer (current-buffer))
     (editor-error "Not in a process buffer."))
   (let ((stream (ext:process-pty (value process))))
-    (write-char (int-char 4) stream)
+    (write-char (code-char 4) stream)
     (force-output stream)))
 
 (defcommand "Interrupt Buffer Subprocess" (p)
@@ -385,7 +545,6 @@
 (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/spell-aug.lisp b/hemlock/spell-aug.lisp
index 9e0c9abaa..2bdbe9db5 100644
--- a/hemlock/spell-aug.lisp
+++ b/hemlock/spell-aug.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-aug.lisp,v 1.1.1.4 1993/08/25 02:34:08 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-aug.lisp,v 1.2 1994/02/11 21:53:48 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/spell-build.lisp b/hemlock/spell-build.lisp
index 92ccc55bd..62fda7977 100644
--- a/hemlock/spell-build.lisp
+++ b/hemlock/spell-build.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-build.lisp,v 1.1.1.7 1993/08/25 02:41:08 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-build.lisp,v 1.2 1994/02/11 21:53:49 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/spell-corr.lisp b/hemlock/spell-corr.lisp
index a2bb420a2..0aba55154 100644
--- a/hemlock/spell-corr.lisp
+++ b/hemlock/spell-corr.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-corr.lisp,v 1.1.1.9 1993/08/25 02:40:00 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-corr.lisp,v 1.2 1994/02/11 21:53:51 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/spell-rt.lisp b/hemlock/spell-rt.lisp
index dd5bb7609..59d10f524 100644
--- a/hemlock/spell-rt.lisp
+++ b/hemlock/spell-rt.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-rt.lisp,v 1.1.1.7 1993/08/25 02:40:34 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-rt.lisp,v 1.2 1994/02/11 21:53:53 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/spellcoms.lisp b/hemlock/spellcoms.lisp
index 8b8d35840..e2f2cf4f6 100644
--- a/hemlock/spellcoms.lisp
+++ b/hemlock/spellcoms.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spellcoms.lisp,v 1.3 1994/02/11 21:53:54 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;;    Written by Bill Chiles and Rob Maclachlan.
@@ -14,7 +17,7 @@
 ;;; checking/correcting stuff in Spell-Corr.Lisp and the dictionary
 ;;; augmenting stuff in Spell-Augment.Lisp.
 
-(in-package 'hemlock)
+(in-package "HEMLOCK")
 
 
 
@@ -25,7 +28,9 @@
 
 (defun print-spell-info (obj str n)
   (declare (ignore n))
-  (format str "#<Spell Info ~S>" (namestring (spell-info-pathname obj))))
+  (let ((pn (spell-info-pathname obj)))
+    (format str "#<Spell Info~@[ ~S~]>"
+	    (and pn (namestring pn)))))
 
 
 (defattribute "Spell Word Character"
@@ -641,7 +646,7 @@
 				      (name (spell-info-pathname info)))
   (when (spell-info-insertions info)
     (with-open-file (stream name
-			    :direction :output :element-type 'string-char
+			    :direction :output :element-type 'base-char
 			    :if-exists :append :if-does-not-exist :create)
       (dolist (w (spell-info-insertions info))
 	(write-line w stream)))
diff --git a/hemlock/streams.lisp b/hemlock/streams.lisp
index 0cfea3093..2893680dc 100644
--- a/hemlock/streams.lisp
+++ b/hemlock/streams.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/streams.lisp,v 1.3 1994/02/11 21:53:56 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;;    This file contains definitions of various types of streams used
@@ -124,13 +127,12 @@
     ((:finish-output :force-output)
      (redisplay-windows-from-mark (hemlock-output-stream-mark stream)))
     (:close (setf (hemlock-output-stream-mark stream) nil))
-    (:element-type 'string-char)))
+    (:element-type 'base-char)))
 
 (defstruct (hemlock-region-stream
 	    (:include stream
 		      (:in #'region-in)
-		      (:misc #'region-misc)
-		      (:in-buffer (make-string lisp::in-buffer-length)))
+		      (:misc #'region-misc))
 	    (:print-function %print-region-stream)
 	    (:constructor internal-make-hemlock-region-stream (region mark)))
   ;;
@@ -151,8 +153,7 @@
    region (copy-mark (region-start region) :right-inserting)))
 
 (defun modify-hemlock-region-stream (stream region)
-  (setf (hemlock-region-stream-region stream) region
-	(lisp::stream-in-index stream) lisp::in-buffer-length)
+  (setf (hemlock-region-stream-region stream) region)
   (let* ((mark (hemlock-region-stream-mark stream))
 	 (start (region-start region))
 	 (start-line (mark-line start)))
@@ -162,102 +163,42 @@
     (push mark (line-marks start-line)))
   stream)
 
-(defun region-readline (stream eof-errorp eof-value)
-  (close-line)
-  (let ((mark (hemlock-region-stream-mark stream))
-	(end (region-end (hemlock-region-stream-region stream))))
-    (cond ((mark>= mark end)
-	   (if eof-errorp
-	       (error "~A hit end of file." stream)
-	       (values eof-value nil)))
-	  ((eq (mark-line mark) (mark-line end))
-	   (let* ((limit (mark-charpos end))
-		  (charpos (mark-charpos mark))
-		  (dst-end (- limit charpos))
-		  (result (make-string dst-end)))
-	     (declare (simple-string result))
-	     (%sp-byte-blt (line-chars (mark-line mark)) charpos
-			   result 0 dst-end)
-	     (setf (mark-charpos mark) limit)
-	     (values result t)))
-	  ((= (mark-charpos mark) 0)
-	   (let* ((line (mark-line mark))
-		  (next (line-next line)))
-	     (always-change-line mark next)
-	     (values (line-chars line) nil)))
-	  (t
-	   (let* ((line (mark-line mark))
-		  (chars (line-chars line))
-		  (next (line-next line))
-		  (charpos (mark-charpos mark))
-		  (dst-end (- (length chars) charpos))
-		  (result (make-string dst-end)))
-	     (declare (simple-string chars result))
-	     (%sp-byte-blt chars charpos result 0 dst-end)
-	     (setf (mark-charpos mark) 0)
-	     (always-change-line mark next)
-	     (values result nil))))))
-
 (defun region-in (stream eof-errorp eof-value)
-  (close-line)
-  (let* ((mark (hemlock-region-stream-mark stream))
-	 (charpos (mark-charpos mark))
-	 (line (mark-line mark))
-	 (chars (line-chars line))
-	 (length (length chars))
-	 (last (region-end (hemlock-region-stream-region stream)))
-	 (last-line (mark-line last))
-	 (buffer (lisp::stream-in-buffer stream)) start len)
-    (declare (fixnum length charpos last-charpos start len)
-	     (simple-string chars))
-    (cond 
-     ((eq line last-line)
-      (let ((last-charpos (mark-charpos last)))
-	(setq len (- last-charpos charpos))
-	(cond
-	 ((>= charpos last-charpos)
-	  (if eof-errorp
-	      (error "~A hit end of file." stream) 
-	      (return-from region-in eof-value)))
-	 ((> len lisp::in-buffer-length)       
-	  (%sp-byte-blt chars charpos buffer 0 lisp::in-buffer-length)
-	  (setq start 0  len lisp::in-buffer-length))
-	 (t
-	  (setq start (- lisp::in-buffer-length len))
-	  (%sp-byte-blt chars charpos buffer start lisp::in-buffer-length)))))
-     ((line> line last-line)
-      (if eof-errorp
-	  (error "~a hit end of file." stream) 
-	  (return-from region-in eof-value)))
-     (t
-      (setq len (- length charpos))
-      (cond
-       ((< len lisp::in-buffer-length)
-	(let ((end (1- lisp::in-buffer-length)))
-	  (setq start (- lisp::in-buffer-length len 1))
-	  (%sp-byte-blt chars charpos buffer start end)
-	  (setf (schar buffer end) #\newline))
-	(incf len))
-       (t
-	(%sp-byte-blt chars charpos buffer 0 lisp::in-buffer-length)
-	(setq start 0  len lisp::in-buffer-length)))))
-    (setf (lisp::stream-in-index stream) (1+ start))
-    (character-offset mark len)
-    (schar buffer start)))
+  (let ((mark (hemlock-region-stream-mark stream)))
+    (cond ((mark< mark
+		  (region-end (hemlock-region-stream-region stream)))
+	   (prog1 (next-character mark) (mark-after mark)))
+	  (eof-errorp (error "~A hit end of file." stream)) 
+	  (t eof-value))))
 
 (defun region-misc (stream operation &optional arg1 arg2)
-  (declare (ignore arg1 arg2))
+  (declare (ignore arg2))
   (case operation
     (:listen (mark< (hemlock-region-stream-mark stream)
 		    (region-end (hemlock-region-stream-region stream))))
-    (:read-line (region-readline stream arg1 arg2))
     (:clear-input (move-mark
                    (hemlock-region-stream-mark stream)
                    (region-end (hemlock-region-stream-region stream))))
+    (:unread
+     (let ((mark (hemlock-region-stream-mark stream)))
+       (unless (mark> mark
+		      (region-start (hemlock-region-stream-region stream)))
+	 (error "Nothing to unread."))
+       (unless (char= arg1 (previous-character mark))
+	 (error "Unreading something not read: ~S" arg1))
+       (mark-before mark)))
+    (:file-position
+     (let ((start (region-start (hemlock-region-stream-region stream)))
+	   (mark (hemlock-region-stream-mark stream)))
+       (cond (arg1
+	      (move-mark mark start)
+	      (character-offset mark arg1))
+	     (t
+	      (count-characters (region start mark))))))
     (:close
      (delete-mark (hemlock-region-stream-mark stream))
      (setf (hemlock-region-stream-region stream) nil))
-    (:element-type 'string-char)))
+    (:element-type 'base-char)))
 
 ;;;; Stuff to support keyboard macros.
 
diff --git a/hemlock/struct.lisp b/hemlock/struct.lisp
index 6152c4a8a..c506ee540 100644
--- a/hemlock/struct.lisp
+++ b/hemlock/struct.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/struct.lisp,v 1.4 1994/02/11 21:53:57 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;; Structures and assorted macros for Hemlock.
@@ -18,8 +21,8 @@
 	  buffer-delete-hook buffer-windows buffer-variables buffer-write-date
 	  region regionp region-start region-end window windowp window-height
 	  window-width window-display-start window-display-end window-point
-	  commandp command command-function command-documentation
-	  modeline-field modeline-field-p))
+	  window-display-recentering commandp command command-function
+	  command-documentation modeline-field modeline-field-p))
 
 
 ;;;; Marks.
@@ -57,8 +60,7 @@
   font)
 
 (defmacro fast-font-mark-p (s)
-  `(eq (svref ,s 0) 'font-mark))
-
+  `(typep ,s 'font-mark))
 
 
 ;;;; Regions, buffers, modeline fields.
@@ -219,7 +221,9 @@
   point				; Where the cursor is in this window.  
   modeline-dis-line		; Dis-line for modeline display.
   modeline-buffer		; Complete string of all modeline data.
-  modeline-buffer-len)		; Valid chars in modeline-buffer.
+  modeline-buffer-len		; Valid chars in modeline-buffer.
+  display-recentering)		; Tells whether redisplay recenters window
+				;    regardless of whether it is current.
 
 (setf (documentation 'windowp 'function)
   "Returns true if its argument is a Hemlock window object, Nil otherwise.")
@@ -229,16 +233,19 @@
   "Return the width of a Hemlock window in character positions.")
 (setf (documentation 'window-display-start 'function)
   "Return the mark which points before the first character displayed in
-  the supplied window.")
+   the supplied window.")
 (setf (documentation 'window-display-end 'function)
   "Return the mark which points after the last character displayed in
-  the supplied window.")
+   the supplied window.")
 (setf (documentation 'window-point 'function)
-  "Return the mark that points to where the cursor is displayed in this
-  window.  When the window is made current, the Buffer-Point of this
-  window's buffer is moved to this position.  While the window is
-  current, redisplay makes this mark point to the same position as the
-  Buffer-Point of its buffer.")
+ "Return the mark that points to where the cursor is displayed in this
+  window.  When the window is made current, the Buffer-Point of this window's
+  buffer is moved to this position.  While the window is current, redisplay
+  makes this mark point to the same position as the Buffer-Point of its
+  buffer.")
+(setf (documentation 'window-display-recentering 'function)
+ "This determines whether redisplay recenters window regardless of whether it
+  is current.  This is SETF'able.")
 
 (defstruct (dis-line (:copier nil)
 		     (:constructor nil))
@@ -457,9 +464,11 @@
 			; 0 sends digit-chars.
   (cm-y-pad nil)	; nil, 0, 2, or 3 for places to pad.
 			; 0 sends digit-chars.
-  screen-image)		; vector device-lines long of strings
+  screen-image		; vector device-lines long of strings
 			; device-columns long.
-
+  ;;
+  ;; This terminal's baud rate, or NIL for infinite.
+  (speed nil :type (or (unsigned-byte 16) null)))
 
 
 ;;;; Device screen hunks and window-group.
diff --git a/hemlock/syntax.lisp b/hemlock/syntax.lisp
index fe69e9aad..cdfa7bb47 100644
--- a/hemlock/syntax.lisp
+++ b/hemlock/syntax.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/syntax.lisp,v 1.1.1.4 1991/02/08 16:38:20 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/syntax.lisp,v 1.2 1994/02/11 21:53:59 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/table.lisp b/hemlock/table.lisp
index a9643e796..2244f3660 100644
--- a/hemlock/table.lisp
+++ b/hemlock/table.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/table.lisp,v 1.1.1.6 1993/08/25 02:10:57 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/table.lisp,v 1.2 1994/02/11 21:54:00 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/text.lisp b/hemlock/text.lisp
index 83776da85..b8e1dba39 100644
--- a/hemlock/text.lisp
+++ b/hemlock/text.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/text.lisp,v 1.1.1.3 1991/10/03 15:16:27 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/text.lisp,v 1.2 1994/02/11 21:54:02 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/ts-stream.lisp b/hemlock/ts-stream.lisp
index d1e6644e1..f76498d72 100644
--- a/hemlock/ts-stream.lisp
+++ b/hemlock/ts-stream.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/ts-stream.lisp,v 1.1.1.12 1993/08/30 21:48:47 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/ts-stream.lisp,v 1.2 1994/02/11 21:54:06 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/tty-disp-rt.lisp b/hemlock/tty-disp-rt.lisp
index a2bc71402..8bb00b5bc 100644
--- a/hemlock/tty-disp-rt.lisp
+++ b/hemlock/tty-disp-rt.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-disp-rt.lisp,v 1.1.1.6 1992/02/15 01:06:24 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-disp-rt.lisp,v 1.2 1994/02/11 21:54:07 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
diff --git a/hemlock/tty-display.lisp b/hemlock/tty-display.lisp
index f555e2d16..d288d0b73 100644
--- a/hemlock/tty-display.lisp
+++ b/hemlock/tty-display.lisp
@@ -1,11 +1,14 @@
 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
 ;;;
 ;;; **********************************************************************
-;;; This code was written as part of the Spice Lisp project at
-;;; Carnegie-Mellon University, and has been placed in the public domain.
-;;; Spice Lisp is currently incomplete and under active development.
-;;; If you want to use this code or any part of Spice Lisp, please contact
-;;; Scott Fahlman (FAHLMAN@CMUC). 
+;;; This code was written as part of the CMU Common Lisp project at
+;;; Carnegie Mellon University, and has been placed in the public domain.
+;;; If you want to use this code or any part of CMU Common Lisp, please contact
+;;; Scott Fahlman or slisp-group@cs.cmu.edu.
+;;;
+(ext:file-comment
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-display.lisp,v 1.3 1994/02/11 21:54:09 ram Exp $")
+;;;
 ;;; **********************************************************************
 ;;;
 ;;;    Written by Bill Chiles.
@@ -13,7 +16,7 @@
 
 (in-package "HEMLOCK-INTERNALS")
 
-(export '(redisplay redisplay-all))
+(export '(redisplay redisplay-all define-tty-font))
 
 
 
@@ -48,8 +51,9 @@
 ;;; 
 (defstruct (si-line (:print-function print-screen-image-line)
 		    (:constructor %make-si-line (chars)))
-  chars
-  (length 0))
+  (chars nil :type simple-string)
+  (length 0)
+  (fonts nil :type list))
 
 (defun make-si-line (n)
   (%make-si-line (make-string n)))
@@ -61,22 +65,159 @@
   (write-string "\">" str))
 
 
+(defun find-identical-prefix (dis-line dis-line-fonts si-line)
+  (declare (type dis-line dis-line)
+	   (type list dis-line-fonts)
+	   (type si-line si-line))
+  (let* ((dl-chars (dis-line-chars dis-line))
+	 (dl-len (dis-line-length dis-line))
+	 (si-chars (si-line-chars si-line))
+	 (si-len (si-line-length si-line))
+	 (okay-until 0))
+    (declare (type simple-string dl-chars si-chars)
+	     (type (and unsigned-byte fixnum) dl-len si-len)
+	     (type (and unsigned-byte fixnum) okay-until))
+    (do ((dl-fonts dis-line-fonts (cdr dis-line-fonts))
+	 (si-fonts (si-line-fonts si-line) (cdr si-fonts)))
+	((or (null dl-fonts) (null si-fonts))
+	 (let ((next-font (car (or dl-fonts si-fonts))))
+	   (if next-font
+	       (let ((end (min dl-len si-len (cadr next-font))))
+		 (or (string/= dl-chars si-chars
+			       :start1 okay-until :start2 okay-until
+			       :end1 end :end2 end)
+		     end))
+	       (let ((end (min dl-len si-len)))
+		 (or (string/= dl-chars si-chars
+			       :start1 okay-until :start2 okay-until
+			       :end1 end :end2 end)
+		     (if (= dl-len si-len) nil end))))))
+      (let ((dl-font (caar dl-fonts))
+	    (dl-start (cadar dl-fonts))
+	    (dl-stop (cddar dl-fonts))
+	    (si-font (caar si-fonts))
+	    (si-start (cadar si-fonts))
+	    (si-stop (cddar si-fonts)))
+	(unless (and (= dl-font si-font)
+		     (= dl-start si-start))
+	  (let ((font-lossage (min dl-start si-start)))
+	    (return (or (string/= dl-chars si-chars
+				  :start1 okay-until :start2 okay-until
+				  :end1 font-lossage :end2 font-lossage)
+			font-lossage))))
+	(unless (= dl-stop si-stop)
+	  (let ((font-lossage (min dl-stop si-stop)))
+	    (return (or (string/= dl-chars si-chars
+				  :start1 okay-until :start2 okay-until
+				  :end1 font-lossage :end2 font-lossage)
+			font-lossage))))
+	(let ((mismatch (string/= dl-chars si-chars
+				  :start1 okay-until :start2 okay-until
+				  :end1 dl-stop :end2 si-stop)))
+	  (if mismatch
+	      (return mismatch)
+	      (setf okay-until dl-stop)))))))
+
+
+(defun find-identical-suffix (dis-line dis-line-fonts si-line)
+  (declare (type dis-line dis-line)
+	   (type list dis-line-fonts)
+	   (type si-line si-line))
+  (let* ((dl-chars (dis-line-chars dis-line))
+	 (dl-len (dis-line-length dis-line))
+	 (si-chars (si-line-chars si-line))
+	 (si-len (si-line-length si-line))
+	 (count (dotimes (i (min dl-len si-len) i)
+		  (when (char/= (schar dl-chars (- dl-len i 1))
+				(schar si-chars (- si-len i 1)))
+		    (return i)))))
+    (declare (type simple-string dl-chars si-chars)
+	     (type (and unsigned-byte fixnum) dl-len si-len))
+    (do ((dl-fonts (reverse dis-line-fonts) (cdr dis-line-fonts))
+	 (si-fonts (reverse (si-line-fonts si-line)) (cdr si-fonts)))
+	((or (null dl-fonts) (null si-fonts))
+	 (cond (dl-fonts
+		(min (- dl-len (cddar dl-fonts)) count))
+	       (si-fonts
+		(min (- si-len (cddar si-fonts)) count))
+	       (t
+		count)))
+      (let ((dl-font (caar dl-fonts))
+	    (dl-start (- dl-len (cadar dl-fonts)))
+	    (dl-stop (- dl-len (cddar dl-fonts)))
+	    (si-font (caar si-fonts))
+	    (si-start (- si-len (cadar si-fonts)))
+	    (si-stop (- si-len (cddar si-fonts))))
+	(unless (and (= dl-font si-font)
+		     (= dl-stop si-stop))
+	  (return (min dl-stop si-stop count)))
+	(unless (= dl-start si-start)
+	  (return (min dl-start si-start count)))
+	(when (<= count dl-start)
+	  (return count))))))
+
+
 (defmacro si-line (screen-image n)
   `(svref ,screen-image ,n))
 
 
+
+;;; Font support.
+
+(defvar *tty-font-strings* (make-array font-map-size :initial-element nil)
+  "Array of (start-string . end-string) for fonts, or NIL if no such font.")
+
+(defun define-tty-font (font-id &rest stuff)
+  (unless (<= 0 font-id (1- font-map-size))
+    (error "Bogus font-id: ~S" font-id))
+  (cond ((every #'keywordp stuff)
+	 (error "Can't extract font strings from the termcap entry yet."))
+	((and (= (length stuff) 2)
+	      (stringp (car stuff))
+	      (stringp (cadr stuff)))
+	 (setf (aref *tty-font-strings* font-id)
+	       (cons (car stuff) (cadr stuff))))
+	(t
+	 (error "Bogus font spec: ~S~%Must be either a list of keywords or ~
+		 a list of the start string and end string."))))
+
+
+(defun compute-font-usages (dis-line)
+  (do ((results nil)
+       (change (dis-line-font-changes dis-line) (font-change-next change))
+       (prev nil change))
+      ((null change)
+       (when prev
+	 (let ((font (font-change-font prev)))
+	   (when (and (not (zerop font))
+		      (aref *tty-font-strings* font))
+	     (push (list* (font-change-font prev)
+			  (font-change-x prev)
+			  (dis-line-length dis-line))
+		   results))))
+       (nreverse results))
+    (when prev
+      (let ((font (font-change-font prev)))
+	(when (and (not (zerop font))
+		   (aref *tty-font-strings* font))
+	  (push (list* (font-change-font prev)
+		       (font-change-x prev)
+		       (font-change-x change))
+		results))))))
+
 
 ;;;; Dumb window redisplay.
 
 (defmacro tty-dumb-line-redisplay (device hunk dis-line &optional y)
-  (let ((dl (gensym)) (dl-chars (gensym)) (dl-len (gensym))
+  (let ((dl (gensym)) (dl-chars (gensym)) (dl-fonts (gensym)) (dl-len (gensym))
 	(dl-pos (gensym)) (screen-image-line (gensym)))
     `(let* ((,dl ,dis-line)
 	    (,dl-chars (dis-line-chars ,dl))
+	    (,dl-fonts (compute-font-usages ,dis-line))
 	    (,dl-len (dis-line-length ,dl))
 	    (,dl-pos ,(or y `(dis-line-position ,dl))))
        (funcall (tty-device-display-string ,device)
-		,hunk 0 ,dl-pos ,dl-chars 0 ,dl-len)
+		,hunk 0 ,dl-pos ,dl-chars ,dl-fonts 0 ,dl-len)
        (setf (dis-line-flags ,dl) unaltered-bits)
        (setf (dis-line-delta ,dl) 0)
        (select-hunk ,hunk)
@@ -84,7 +225,8 @@
 					  (+ *hunk-top-line* ,dl-pos))))
 	 (replace-si-line (si-line-chars ,screen-image-line) ,dl-chars
 			  0 0 ,dl-len)
-	 (setf (si-line-length ,screen-image-line) ,dl-len)))))
+	 (setf (si-line-length ,screen-image-line) ,dl-len)
+	 (setf (si-line-fonts ,screen-image-line) ,dl-fonts)))))
 
 (defun tty-dumb-window-redisplay (window)
   (let* ((first (window-first-line window))
@@ -101,17 +243,21 @@
 	      (i (+ *hunk-top-line* i) (1+ i)))
 	     ((> i last))
 	   (declare (fixnum i last))
-	   (setf (si-line-length (si-line screen-image i)) 0)))
+	   (let ((si-line (si-line screen-image i)))
+	     (setf (si-line-length si-line) 0)
+	     (setf (si-line-fonts si-line) nil))))
       (tty-dumb-line-redisplay device hunk (car dl) i))
     (setf (window-first-changed window) the-sentinel
 	  (window-last-changed window) first)
     (when (window-modeline-buffer window)
       (let ((dl (window-modeline-dis-line window))
 	    (y (tty-hunk-modeline-pos hunk)))
-	(funcall (tty-device-standout-init device) hunk)
-	(funcall (tty-device-clear-to-eol device) hunk 0 y)
-	(tty-dumb-line-redisplay device hunk dl y)
-	(funcall (tty-device-standout-end device) hunk)
+	(unwind-protect
+	    (progn
+	      (funcall (tty-device-standout-init device) hunk)
+	      (funcall (tty-device-clear-to-eol device) hunk 0 y)
+	      (tty-dumb-line-redisplay device hunk dl y))
+	  (funcall (tty-device-standout-end device) hunk))
 	(setf (dis-line-flags dl) unaltered-bits)))))
 
 
@@ -155,7 +301,7 @@
     ;;
     ;; Clear any extra lines at the end of the window.
     (let ((pos (dis-line-position (car (window-last-line window)))))
-      (when (< pos (window-old-lines window))
+      (when (< pos (1- (window-height window)))
 	(tty-smart-clear-to-eow hunk (1+ pos)))
       (setf (window-old-lines window) pos))
     ;;
@@ -163,10 +309,11 @@
     (when (window-modeline-buffer window)
       (let ((dl (window-modeline-dis-line window)))
 	(when (/= (dis-line-flags dl) unaltered-bits)
-	  (funcall (tty-device-standout-init device) hunk)
 	  (unwind-protect
-	      (tty-smart-line-redisplay device hunk dl
-					(tty-hunk-modeline-pos hunk))
+	      (progn
+		(funcall (tty-device-standout-init device) hunk)
+		(tty-smart-line-redisplay device hunk dl
+					  (tty-hunk-modeline-pos hunk)))
 	    (funcall (tty-device-standout-end device) hunk)))))))
 
 ;;; NEXT-DIS-LINE is used in DO-SEMI-DUMB-LINE-WRITES and
@@ -193,7 +340,6 @@
   (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
@@ -217,7 +363,8 @@
 				     &optional (dl-pos (dis-line-position dl)))
   (declare (fixnum dl-pos))
   (let* ((dl-chars (dis-line-chars dl))
-	 (dl-len (dis-line-length dl)))
+	 (dl-len (dis-line-length dl))
+	 (dl-fonts (compute-font-usages dl)))
     (declare (fixnum dl-len) (simple-string dl-chars))
     (when (listen-editor-input *editor-input*)
       (throw 'redisplay-catcher :editor-input))
@@ -226,9 +373,8 @@
 				       (+ *hunk-top-line* dl-pos)))
 	   (si-line-chars (si-line-chars screen-image-line))
 	   (si-line-length (si-line-length screen-image-line))
-	   (findex (string/= dl-chars si-line-chars
-			     :end1 dl-len :end2 si-line-length)))
-      (declare (fixnum findex) (simple-string si-line-chars))
+	   (findex (find-identical-prefix dl dl-fonts screen-image-line)))
+      (declare (type (or fixnum null) findex) (simple-string si-line-chars))
       ;;
       ;; When the dis-line and screen chars are not string=.
       (when findex
@@ -236,18 +382,19 @@
 	 ;; See if the screen shows an initial substring of the dis-line.
 	 ((= findex si-line-length)
 	  (funcall (tty-device-display-string device)
-		   hunk findex dl-pos dl-chars findex dl-len)
+		   hunk findex dl-pos dl-chars dl-fonts findex dl-len)
 	  (replace-si-line si-line-chars dl-chars findex findex dl-len))
 	 ;; When the dis-line is an initial substring of what's on the screen.
 	 ((= findex dl-len)
 	  (funcall (tty-device-clear-to-eol device) hunk dl-len dl-pos))
 	 ;; Otherwise, blast dl-chars and clear to eol as necessary.
 	 (t (funcall (tty-device-display-string device)
-		     hunk findex dl-pos dl-chars findex dl-len)
+		     hunk findex dl-pos dl-chars dl-fonts findex dl-len)
 	    (when (< dl-len si-line-length)
 	      (funcall (tty-device-clear-to-eol device) hunk dl-len dl-pos))
 	    (replace-si-line si-line-chars dl-chars findex findex dl-len)))
-	(setf (si-line-length screen-image-line) dl-len)))
+	(setf (si-line-length screen-image-line) dl-len)
+	(setf (si-line-fonts screen-image-line) dl-fonts)))
     (setf (dis-line-flags dl) unaltered-bits)
     (setf (dis-line-delta dl) 0)))
 
@@ -268,6 +415,8 @@
 
 (defvar *tty-line-writes* (make-array tty-hunk-height-limit))
 
+(defvar *tty-line-moves* (make-array tty-hunk-height-limit))
+
 (eval-when (compile eval)
 
 (defmacro queue (value queue ptr)
@@ -368,6 +517,7 @@
 	      (declare (fixnum ,insert-index ,free-lines-index ,n))
 	      (let ((,temp (si-line *screen-image-temp* ,free-lines-index)))
 		(setf (si-line-length ,temp) 0)
+		(setf (si-line-fonts ,temp) nil)
 		(setf (si-line ,do-screen-image ,insert-index) ,temp)))
 	    (decf ,fsil ,num))
 	 (declare (fixnum ,target-terminus ,source-index ,target-index))
@@ -399,7 +549,7 @@
 	    ;; One line-changed.
 	    (tty-smart-line-redisplay device hunk (car first-changed))
 	    ;; More lines changed.
-	    (multiple-value-bind (ins outs writes)
+	    (multiple-value-bind (ins outs writes moves)
 				 (compute-tty-changes
 				  first-changed last-changed
 				  (tty-hunk-modeline-pos hunk))
@@ -413,6 +563,7 @@
 		      (t
 		       (do-line-insertions hunk ins
 					   (do-line-deletions hunk outs))
+		       (note-line-moves moves)
 		       (do-line-writes hunk writes))))))
 	;; Set the bounds so we know we displayed...
 	(setf (window-first-changed window) the-sentinel
@@ -420,7 +571,7 @@
     ;;
     ;; Clear any extra lines at the end of the window.
     (let ((pos (dis-line-position (car (window-last-line window)))))
-      (when (< pos (window-old-lines window))
+      (when (< pos (1- (window-height window)))
 	(tty-smart-clear-to-eow hunk (1+ pos)))
       (setf (window-old-lines window) pos))
     ;;
@@ -428,10 +579,11 @@
     (when (window-modeline-buffer window)
       (let ((dl (window-modeline-dis-line window)))
 	(when (/= (dis-line-flags dl) unaltered-bits)
-	  (funcall (tty-device-standout-init device) hunk)
 	  (unwind-protect
-	      (tty-smart-line-redisplay device hunk dl
-					(tty-hunk-modeline-pos hunk))
+	      (progn
+		(funcall (tty-device-standout-init device) hunk)
+		(tty-smart-line-redisplay device hunk dl
+					  (tty-hunk-modeline-pos hunk)))
 	    (funcall (tty-device-standout-end device) hunk)))))))
 
 
@@ -533,10 +685,11 @@
 ;;; done to the screen, we save the changed bit on, so the line will be
 ;;; queued to be written after redisplay is re-entered.
 ;;; 
-;;; If the line is changed or new, then queue it to be written.  Note
-;;; before that we checked the flags for equality with the new bits, and
-;;; it is possible that updating the window image will yield lines that
-;;; are both new and changed.
+;;; If the line is changed or new, then queue it to be written.  Since we can
+;;; abort out of the actual dislpay at any time (due to pending input), we
+;;; don't clear the flags or delta here.  A dis-line may be groveled many times
+;;; by this function before it actually makes it to the screen, so we may have
+;;; odd combinations of bits such as both new and changed.
 ;;; 
 ;;; Otherwise, get the next display line, loop, and see if it's
 ;;; interesting.
@@ -545,68 +698,63 @@
   (declare (fixnum modeline-pos))
   (let* ((dl first-changed)
 	 (flags (dis-line-flags (car dl)))
-	 (ins 0) (outs 0) (writes 0)
+	 (ins 0) (outs 0) (writes 0) (moves 0)
 	 (prev-delta 0) (cum-deletes 0) (net-delta 0) (cum-inserts 0)
 	 prev)
-    (declare (fixnum flags ins outs writes prev-delta cum-deletes net-delta
-		     cum-inserts))
+    (declare (fixnum flags ins outs writes moves prev-delta cum-deletes
+		     net-delta cum-inserts))
     (loop
-     (cond
-      ((= flags new-bit)
-       (queue (car dl) *tty-line-writes* writes)
-       (next-dis-line))
-      ((not (zerop (the fixnum (logand flags moved-bit))))
-       (let* ((start-dl (car dl))
-	      (start-pos (dis-line-position start-dl))
-	      (curr-delta (dis-line-delta start-dl))
-	      (delta-delta (- prev-delta curr-delta))
-	      (car-dl start-dl))
-	 (declare (fixnum start-pos curr-delta delta-delta))
-	 (cond ((plusp delta-delta)
-		(queue (the fixnum (- start-pos cum-inserts))
-		       *tty-line-deletions* outs)
-		(queue delta-delta *tty-line-deletions* outs)
-		(incf cum-deletes delta-delta)
-		(decf net-delta delta-delta))
-	       ((minusp delta-delta)
-		(let ((eff-pos (the fixnum (+ start-pos delta-delta)))
-		      (num (the fixnum (- delta-delta))))
-		  (queue eff-pos *tty-line-insertions* ins)
-		  (queue num *tty-line-insertions* ins)
-		  (incf net-delta num)
-		  (incf cum-inserts num)))
-	       (t (error "Internal error -- unexpected zero transition delta ~
-			 in redisplay.")))
-	 (loop
-	  (cond ((and (zerop (the fixnum (logand flags changed-bit)))
-		      (zerop (the fixnum (logand flags new-bit))))
-		 (setf (dis-line-flags car-dl) unaltered-bits))
-		(t (queue car-dl *tty-line-writes* writes)
-		   ;; keep just the changed-bit on.
-		   (setf (dis-line-flags car-dl) changed-bit)))
-	  (setf (dis-line-delta car-dl) 0)
-	  (next-dis-line)
-	  (setf car-dl (car dl))
-	  (when (/= (the fixnum (dis-line-delta car-dl)) curr-delta)
-	    (setf prev-delta curr-delta)
-	    (return)))))
-      ((not (and (zerop (logand (the fixnum flags) changed-bit))
-		 (zerop (logand (the fixnum flags) new-bit))))
-       (queue (car dl) *tty-line-writes* writes)
-       (next-dis-line))
-      (t (next-dis-line)))
-     (when (eq prev last-changed)
-       (unless (zerop net-delta)
-	 (cond ((plusp net-delta)
-		(queue (the fixnum (- modeline-pos cum-deletes net-delta))
-		       *tty-line-deletions* outs)
-		(queue net-delta *tty-line-deletions* outs))
-	       (t (queue (the fixnum (+ modeline-pos net-delta))
-			 *tty-line-insertions* ins)
-		  (queue (the fixnum (- net-delta))
-			 *tty-line-insertions* ins))))
-       (return (values ins outs writes))))))
-
+      (cond
+       ((logtest flags new-bit)
+	(queue (car dl) *tty-line-writes* writes)
+	(next-dis-line))
+       ((logtest flags moved-bit)
+	(let* ((start-dl (car dl))
+	       (start-pos (dis-line-position start-dl))
+	       (curr-delta (dis-line-delta start-dl))
+	       (delta-delta (- prev-delta curr-delta))
+	       (car-dl start-dl))
+	  (declare (fixnum start-pos curr-delta delta-delta))
+	  (cond ((plusp delta-delta)
+		 (queue (the fixnum (- start-pos cum-inserts))
+			*tty-line-deletions* outs)
+		 (queue delta-delta *tty-line-deletions* outs)
+		 (incf cum-deletes delta-delta)
+		 (decf net-delta delta-delta))
+		((minusp delta-delta)
+		 (let ((eff-pos (the fixnum (+ start-pos delta-delta)))
+		       (num (the fixnum (- delta-delta))))
+		   (queue eff-pos *tty-line-insertions* ins)
+		   (queue num *tty-line-insertions* ins)
+		   (incf net-delta num)
+		   (incf cum-inserts num))))
+	  (loop
+	    (if (logtest flags (logior changed-bit new-bit))
+		(queue car-dl *tty-line-writes* writes)
+		(queue car-dl *tty-line-moves* moves))
+	    (next-dis-line)
+	    (setf car-dl (car dl))
+	    (when (or (eq prev last-changed)
+		      (/= (the fixnum (dis-line-delta car-dl)) curr-delta))
+	      (setf prev-delta curr-delta)
+	      (return)))))
+       ((logtest flags (logior changed-bit new-bit))
+	(queue (car dl) *tty-line-writes* writes)
+	(next-dis-line))
+       (t
+	(next-dis-line)))
+
+      (when (eq prev last-changed)
+	(unless (zerop net-delta)
+	  (cond ((plusp net-delta)
+		 (queue (the fixnum (- modeline-pos cum-deletes net-delta))
+			*tty-line-deletions* outs)
+		 (queue net-delta *tty-line-deletions* outs))
+		(t (queue (the fixnum (+ modeline-pos net-delta))
+			  *tty-line-insertions* ins)
+		   (queue (the fixnum (- net-delta))
+			  *tty-line-insertions* ins))))
+	(return (values ins outs writes moves))))))
 
 
 ;;;; Smart window redisplay -- operation methods.
@@ -628,7 +776,20 @@
       (let ((si-line (si-line screen-image si-idx)))
 	(unless (zerop (si-line-length si-line))
 	  (funcall clear-to-eol hunk 0 y)
-	  (setf (si-line-length si-line) 0))))))
+	  (setf (si-line-length si-line) 0)
+	  (setf (si-line-fonts si-line) nil))))))
+
+;;; NOTE-LINE-MOVES  --  Internal
+;;;
+;;;    Clear out the flags and delta of lines that have been moved.
+;;;
+(defun note-line-moves (moves)
+  (let ((i 0))
+    (loop
+      (when (= i moves) (return))
+      (let ((dl (dequeue *tty-line-moves* i)))
+	(setf (dis-line-flags dl) unaltered-bits)
+	(setf (dis-line-delta dl) 0)))))
 
 ;;; DO-LINE-DELETIONS pops elements off the *tty-lines-deletions* queue,
 ;;; deleting lines from hunk's area of the screen.  The internal screen
@@ -711,7 +872,8 @@
 				 &optional (dl-pos (dis-line-position dl)))
   (declare (fixnum dl-pos))
   (let* ((dl-chars (dis-line-chars dl))
-	 (dl-len (dis-line-length dl)))
+	 (dl-len (dis-line-length dl))
+	 (dl-fonts (compute-font-usages dl)))
     (declare (fixnum dl-len) (simple-string dl-chars))
     (when (listen-editor-input *editor-input*)
       (throw 'redisplay-catcher :editor-input))
@@ -720,9 +882,8 @@
 				       (+ *hunk-top-line* dl-pos)))
 	   (si-line-chars (si-line-chars screen-image-line))
 	   (si-line-length (si-line-length screen-image-line))
-	   (findex (string/= dl-chars si-line-chars
-			      :end1 dl-len :end2 si-line-length)))
-      (declare (fixnum findex) (simple-string si-line-chars))
+	   (findex (find-identical-prefix dl dl-fonts screen-image-line)))
+      (declare (type (or fixnum null) findex) (simple-string si-line-chars))
       ;;
       ;; When the dis-line and screen chars are not string=.
       (when findex
@@ -731,7 +892,7 @@
 	  ;; See if the screen shows an initial substring of the dis-line.
 	  (when (= findex si-line-length)
 	    (funcall (tty-device-display-string device)
-		     hunk findex dl-pos dl-chars findex dl-len)
+		     hunk findex dl-pos dl-chars dl-fonts findex dl-len)
 	    (replace-si-line si-line-chars dl-chars findex findex dl-len)
 	    (return-from tslr-main-body t))
 	  ;;
@@ -741,20 +902,18 @@
 	    (return-from tslr-main-body t))
 	  ;;
 	  ;; Find trailing substrings that are the same.
-	  (multiple-value-bind (sindex dindex)
-			       (do ((sindex (1- si-line-length) (1- sindex))
-				    (dindex (1- dl-len) (1- dindex)))
-				   ((or (= sindex -1)
-					(= dindex -1)
-					(char/= (schar dl-chars dindex)
-						(schar si-line-chars sindex)))
-				    (values (1+ sindex) (1+ dindex))))
+	  (multiple-value-bind
+	      (sindex dindex)
+	      (let ((count (find-identical-suffix dl dl-fonts
+						  screen-image-line)))
+		(values (- si-line-length count)
+			(- dl-len count)))
 	    (declare (fixnum sindex dindex))
 	    ;;
 	    ;; No trailing substrings -- blast and clear to eol.
 	    (when (= dindex dl-len)
 	      (funcall (tty-device-display-string device)
-		       hunk findex dl-pos dl-chars findex dl-len)
+		       hunk findex dl-pos dl-chars dl-fonts findex dl-len)
 	      (when (< dindex sindex)
 		(funcall (tty-device-clear-to-eol device)
 			 hunk dl-len dl-pos))
@@ -766,7 +925,8 @@
 		     (setf lindex findex))
 		    (t
 		     (funcall (tty-device-display-string device)
-			      hunk findex dl-pos dl-chars findex lindex)
+			      hunk findex dl-pos dl-chars dl-fonts
+			      findex lindex)
 		     (replace-si-line si-line-chars dl-chars
 				      findex findex lindex)))
 	      (cond
@@ -780,19 +940,23 @@
 				  hunk dindex dl-pos delete-char-num))
 			(t 
 			 (funcall (tty-device-display-string device)
-				  hunk dindex dl-pos dl-chars dindex dl-len)
+				  hunk dindex dl-pos dl-chars dl-fonts
+				  dindex dl-len)
 			 (funcall (tty-device-clear-to-eol device)
 				  hunk dl-len dl-pos)))))
 	       (t
 		(if (and (tty-device-insert-string device)
-			 (worth-using-insert-mode device (- dindex sindex)))
+			 (worth-using-insert-mode device (- dindex sindex)
+						  (- dl-len sindex)))
 		    (funcall (tty-device-insert-string device)
 			     hunk sindex dl-pos dl-chars sindex dindex)
 		    (funcall (tty-device-display-string device)
-			     hunk sindex dl-pos dl-chars sindex dl-len))))
+			     hunk sindex dl-pos dl-chars dl-fonts
+			     sindex dl-len))))
 	      (replace-si-line si-line-chars dl-chars
 			       lindex lindex dl-len))))
-	(setf (si-line-length screen-image-line) dl-len)))
+	(setf (si-line-length screen-image-line) dl-len)
+	(setf (si-line-fonts screen-image-line) dl-fonts)))
     (setf (dis-line-flags dl) unaltered-bits)
     (setf (dis-line-delta dl) 0)))
 
@@ -908,11 +1072,36 @@
 
 ;;; DISPLAY-STRING is used to put a string at (x,y) on the device.
 ;;; 
-(defun display-string (hunk x y string
+(defun display-string (hunk x y string font-info
 			    &optional (start 0) (end (strlen string)))
   (declare (fixnum x y start end))
   (update-cursor hunk x y)
-  (device-write-string string start end)
+  ;; Ignore font info for chars before the start of the string.
+  (loop
+    (if (or (null font-info)
+	    (< start (cddar font-info)))
+	(return)
+	(pop font-info)))
+  (let ((posn start))
+    (dolist (next-font font-info)
+      (let ((font (car next-font))
+	    (start (cadr next-font))
+	    (stop (cddr next-font)))
+	(when (<= end start)
+	  (return))
+	(when (< posn start)
+	  (device-write-string string posn start)
+	  (setf posn start))
+	(let ((new-posn (min stop end))
+	      (font-strings (aref *tty-font-strings* font)))
+	  (unwind-protect
+	      (progn
+		(device-write-string (car font-strings))
+		(device-write-string string posn new-posn))
+	    (device-write-string (cdr font-strings)))
+	  (setf posn new-posn))))
+    (when (< posn end)
+      (device-write-string string posn end)))
   (setf (tty-device-cursor-x (device-hunk-device hunk))
 	(the fixnum (+ x (the fixnum (- end start))))))
 
@@ -922,16 +1111,17 @@
 ;;; what the sequence is), whether the terminal has insert-mode, or whether
 ;;; the terminal has delete-mode.
 ;;; 
-(defun display-string-checking-underlines (hunk x y string
+(defun display-string-checking-underlines (hunk x y string font-info
 						&optional (start 0)
 						          (end (strlen string)))
+  (declare (ignore font-info))
   (declare (fixnum x y start end) (simple-string string))
   (update-cursor hunk x y)
   (let ((upos (position #\_ string :test #'char= :start start :end end))
 	(device (device-hunk-device hunk)))
     (if upos
 	(let ((previous start)
-	      after-pos)
+	      (after-pos 0))
 	  (declare (fixnum previous after-pos))
 	  (loop (device-write-string string previous upos)
 		(setf after-pos (do ((i (1+ upos) (1+ i)))
@@ -1026,25 +1216,25 @@
   (let* ((device (device-hunk-device hunk))
 	 (init-string (tty-device-insert-init-string device))
 	 (char-init-string (tty-device-insert-char-init-string device))
-	 (cis-len (if char-init-string (length char-init-string)))
 	 (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 (simple-string char-init-string char-end-string))
+    (declare (type (or simple-string null) char-init-string char-end-string))
     (when init-string (device-write-string init-string))
     (if char-init-string
-	(do ((i start (1+ i)))
-	    ((= i end))
-	  (device-write-string char-init-string 0 cis-len)
-	  (tty-write-char (schar string i))
-	  (when char-end-string
-	    (device-write-string char-end-string 0 ces-len)))
+	(let ((cis-len (length char-init-string))
+	      (ces-len (length char-end-string)))
+	  (do ((i start (1+ i)))
+	      ((= i end))
+	    (device-write-string char-init-string 0 cis-len)
+	    (tty-write-char (schar string i))
+	    (when char-end-string
+	      (device-write-string char-end-string 0 ces-len))))
 	(device-write-string string start end))
     (when end-string (device-write-string end-string))
     (setf (tty-device-cursor-x device)
 	  (the fixnum (+ x (the fixnum (- end start)))))))
 
-(defun worth-using-insert-mode (device insert-char-num)
+(defun worth-using-insert-mode (device insert-char-num chars-saved)
   (let* ((init-string (tty-device-insert-init-string device))
 	 (char-init-string (tty-device-insert-char-init-string device))
 	 (char-end-string (tty-device-insert-char-end-string device))
@@ -1059,9 +1249,9 @@
 							char-end-string))
 					   0)))))
     (when end-string (incf cost (length (the simple-string end-string))))
-    (< cost insert-char-num)))
+    (< cost chars-saved)))
 
-(defun delete-char (hunk x y &optional n)
+(defun delete-char (hunk x y &optional (n 1))
   (declare (fixnum x y n))
   (update-cursor hunk x y)
   (let* ((device (device-hunk-device hunk))
@@ -1074,13 +1264,14 @@
     (when end-string (device-write-string end-string))))
 
 (defun worth-using-delete-mode (device delete-char-num clear-char-num)
-  (declare (fixnum num))
+  (declare (fixnum delete-char-num clear-char-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 (simple-string init-string end-string delete-char-string)
+    (declare (type (or simple-string null) 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/hemlock/tty-stream.lisp b/hemlock/tty-stream.lisp
index c4433ffcb..0feebdf19 100644
--- a/hemlock/tty-stream.lisp
+++ b/hemlock/tty-stream.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-stream.lisp,v 1.1.1.5 1993/08/25 02:24:03 ram Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/tty-stream.lisp,v 1.2 1994/02/11 21:54:11 ram Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
-- 
GitLab