From ba904cfefa2d31549e7800a60ec847bd1368ee25 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 9 Aug 1989 13:18:18 +0000
Subject: [PATCH] * Major overhaul of evaluation commands.  Now the transcript
 buffer is used more uniformly, and by default it is turned on.  The name and
 mode of the transcript buffer can be set by variables, which are initially
 set to use "*scratch*" in scheme-interaction mode. Appropriate hooks have
 been added to allow scheme-interaction to share virtually all of the
 evaluation and transcript code with the rest of the evaluation commands.  The
 end result of all of these changes is that the evaluation commands work much
 more like the Emacs/Scheme interface.

New command `select-transcript-buffer' is bound to C-c C-s.

* Implement `mode-line-format'; see that variable's documentation for
details.  Change "Info" to use it.  Also implement associated
variables:
	global-mode-string
	mode-line-buffer-identification
	mode-line-modified
	mode-line-procedure
	mode-line-process

* Rewrite the image code to allow the starting index and column to be
specified.  This will be used later when horizontal scrolling is
implemented.  Change name of `make-image' to `string->image'.
Implement new operations:
	(string-head->image string start start-column)
	(string-representation string start-column)
	(substring-representation string start end start-column)

* Change `prompt-for-expression' and `prompt-for-expression-value' so
that #F is a valid default value.  The default value argument is now
optional, and the only way to have no default is to call the
procedures without that argument.

* Implement `fresh-line' operations for output-ports to marks and to
the current point.  Add new procedures to support them:
	(fresh-line #!optional port)
	(fresh-lines n #!optional port)
	(mark->output-port mark #!optional buffer)

* Change `prompt-for-yes-or-no?' to erase the input if it is neither
"yes" or "no".  This is now consistent with Emacs.

* Change command-history display to use new feature in runtime system
that unparses objects such that they can be read back in.

* Implement new procedures:
	(scode-eval-with-history scode environment)
	(string->temporary-buffer string name)
	(current-buffer? buffer)
	(->command object)
	(->variable object)
	(->mode object)
---
 v7/src/edwin/artdebug.scm |   5 +-
 v7/src/edwin/autold.scm   |   5 +-
 v7/src/edwin/bufcom.scm   |  10 +-
 v7/src/edwin/buffer.scm   | 128 +++++++--------
 v7/src/edwin/bufout.scm   |  71 +++++++--
 v7/src/edwin/comman.scm   |  15 +-
 v7/src/edwin/comred.scm   |   7 +-
 v7/src/edwin/curren.scm   |  12 +-
 v7/src/edwin/decls.scm    |   1 +
 v7/src/edwin/edwin.ldr    |   3 +-
 v7/src/edwin/edwin.pkg    |  20 ++-
 v7/src/edwin/evlcom.scm   | 320 ++++++++++++++++++++------------------
 v7/src/edwin/image.scm    | 258 +++++++++++++++++-------------
 v7/src/edwin/info.scm     |  35 ++---
 v7/src/edwin/intmod.scm   | 143 +++++++----------
 v7/src/edwin/iserch.scm   |   5 +-
 v7/src/edwin/make.scm     |   4 +-
 v7/src/edwin/modefs.scm   |  19 +--
 v7/src/edwin/modes.scm    |  10 +-
 v7/src/edwin/modwin.scm   | 105 ++++---------
 v7/src/edwin/prompt.scm   |  29 ++--
 v7/src/edwin/schmod.scm   |  27 ++--
 v7/src/edwin/unix.scm     |  36 ++++-
 v7/src/edwin/utils.scm    |  14 +-
 v7/src/edwin/winout.scm   |  21 ++-
 25 files changed, 702 insertions(+), 601 deletions(-)

diff --git a/v7/src/edwin/artdebug.scm b/v7/src/edwin/artdebug.scm
index 7c27f1b9d..7e8bd49a3 100644
--- a/v7/src/edwin/artdebug.scm
+++ b/v7/src/edwin/artdebug.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/artdebug.scm,v 1.1 1989/08/08 22:00:00 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/artdebug.scm,v 1.2 1989/08/09 13:17:06 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -110,7 +110,8 @@ The error that started the debugger is:
 	      (hook/prompt-for-expression
 	       (lambda (cmdl prompt)
 		 cmdl			;ignore
-		 (prompt-for-expression prompt false)))	      (hook/debugger-failure
+		 (prompt-for-expression prompt)))
+	      (hook/debugger-failure
 	       (lambda (string)
 		 (message string)
 		 (editor-beep)))
diff --git a/v7/src/edwin/autold.scm b/v7/src/edwin/autold.scm
index 92a1676df..417711dc0 100644
--- a/v7/src/edwin/autold.scm
+++ b/v7/src/edwin/autold.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/autold.scm,v 1.44 1989/08/03 23:33:05 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/autold.scm,v 1.45 1989/08/09 13:16:41 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -198,7 +198,8 @@
     (temporary-message "Loading file \"" (pathname->string pathname) "\"")
     (let ((scode (fasload pathname true)))
       (if (or (default-object? purify?) purify?) (purify scode))
-      (scode-eval scode (->environment package))))  (append-message " -- done"))
+      (scode-eval-with-history scode (->environment package))))
+  (append-message " -- done"))
 
 (define-command load-file
   "Load an Edwin binary file.
diff --git a/v7/src/edwin/bufcom.scm b/v7/src/edwin/bufcom.scm
index 6efb01a25..7ba1a416e 100644
--- a/v7/src/edwin/bufcom.scm
+++ b/v7/src/edwin/bufcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufcom.scm,v 1.82 1989/04/28 22:47:10 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufcom.scm,v 1.83 1989/08/09 13:16:45 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -191,6 +191,14 @@ Just like what happens when the file is first visited."
 		   (if buffer
 		       (search-loop 2)
 		       name))))
+
+(define (string->temporary-buffer string name)
+  (let ((buffer (temporary-buffer name)))
+    (insert-string string (buffer-point buffer))
+    (set-buffer-point! buffer (buffer-start buffer))
+    (buffer-not-modified! buffer)
+    (pop-up-buffer buffer false)))
+
 (define (with-output-to-temporary-buffer name thunk)
   (let ((buffer (temporary-buffer name)))
     (with-output-to-mark (buffer-point buffer) thunk)
diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 3fe830430..033e838c8 100644
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.131 1989/08/08 10:05:22 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.132 1989/08/09 13:16:48 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -290,32 +290,25 @@ The buffer is guaranteed to be deselected at that time."
 		  thunk
 		  (lambda ()
 		    (if read-only? (set-group-read-only! group))))))
-
-;;;; Buffer Display Name
-
-(define (buffer-display-name buffer)
-  (let ((name (buffer-name buffer))
-	(pathname (or (buffer-truename buffer) (buffer-pathname buffer))))
-    (let ((display-string
-	   (lambda (name)
-	     (if (pathname-version pathname)
-		 (let ((version
-			(pathname-version
-			 (or (buffer-truename buffer) pathname))))
-		   (if (integer? version)
-		       (string-append name " (" (number->string version) ")")
-		       name))
-		 name))))
-      (if (not pathname)
-	  name
-	  (let ((name* (pathname->buffer-name pathname)))
-	    (if (or (string-ci=? name name*)
-		    (let ((i (string-match-forward-ci name name*)))
-		      (and i
-			   (= i (string-length name*))
-			   (char=? (string-ref name i) #\<))))
-		(display-string name)
-		(string-append name " [" (display-string name*) "]")))))))
+
+(define (add-buffer-initialization! buffer thunk)
+  (without-interrupts (lambda () (%add-buffer-initialization! buffer thunk))))
+
+(define (%add-buffer-initialization! buffer thunk)
+  (if (current-buffer? buffer)
+      (thunk)
+      (vector-set! buffer
+		   buffer-index:initializations
+		   (append! (buffer-initializations buffer) (list thunk)))))
+
+(define (perform-buffer-initializations! buffer)
+  ;; Assumes that interrupts are disabled and BUFFER is selected.
+  (let loop ((thunks (buffer-initializations buffer)))
+    (if (not (null? thunks))
+	(begin
+	  ((car thunks))
+	  (loop))))  (vector-set! buffer buffer-index:initializations '())
+  unspecific)
 
 ;;;; Local Bindings
 
@@ -350,17 +343,14 @@ The buffer is guaranteed to be deselected at that time."
      unspecific)))
 
 (define (undo-local-bindings!)
-  (without-interrupts
-   (lambda ()
-     (let ((buffer (current-buffer)))
-       (for-each (lambda (binding)
-		   (let ((variable (car binding)))
-		     (%set-variable-value! variable (cdr binding))
-		     (invoke-variable-assignment-daemons! variable)))
-		 (buffer-local-bindings buffer))
-       (vector-set! buffer buffer-index:local-bindings '()))
-     unspecific)))
-
+  (let ((buffer (current-buffer)))
+    (for-each (lambda (binding)
+		(let ((variable (car binding)))
+		  (%set-variable-value! variable (cdr binding))
+		  (invoke-variable-assignment-daemons! variable)))
+	      (buffer-local-bindings buffer))
+    (vector-set! buffer buffer-index:local-bindings '()))
+  unspecific)
 (define (change-local-bindings! old-buffer new-buffer select-buffer!)
   ;; Assumes that interrupts are disabled and that OLD-BUFFER is selected.
   (let ((variables '()))
@@ -391,18 +381,19 @@ The buffer is guaranteed to be deselected at that time."
 	(for-each invoke-variable-assignment-daemons! variables))))
 
 (define (variable-local-value buffer variable)
-  (let ((buffer* (current-buffer))
-	(in-cell
+  (let ((in-cell
 	 (lambda ()
 	   (variable-value variable))))
-    (if (eq? buffer buffer*)
+    (if (current-buffer? buffer)
 	(in-cell)
 	(let ((binding (assq variable (buffer-local-bindings buffer))))
 	  (cond (binding
 		 (cdr binding))
-		((variable-buffer-local? variable)
+		((and (variable-buffer-local? variable)
+		      (within-editor?))
 		 (let ((binding
-			(assq variable (buffer-local-bindings buffer*))))
+			(assq variable
+			      (buffer-local-bindings (current-buffer)))))
 		   (if binding
 		       (cdr binding)
 		       (in-cell))))
@@ -410,7 +401,7 @@ The buffer is guaranteed to be deselected at that time."
 		 (in-cell)))))))
 
 (define (set-variable-local-value! buffer variable value)
-  (if (eq? buffer (current-buffer))
+  (if (current-buffer? buffer)
       (set-variable-value! variable value)
       (let ((binding (assq variable (buffer-local-bindings buffer))))
 	(if binding
@@ -419,6 +410,20 @@ The buffer is guaranteed to be deselected at that time."
 	      unspecific)
 	    (set-variable-value! variable value)))))
 
+(define (define-variable-local-value! buffer variable value)
+  (if (current-buffer? buffer)
+      (make-local-binding! variable value)
+      (without-interrupts
+       (lambda ()
+	 (let ((bindings (buffer-local-bindings buffer)))
+	   (let ((binding (assq variable bindings)))
+	     (if binding
+		 (set-cdr! binding value)
+		 (vector-set! buffer
+			      buffer-index:local-bindings
+			      (cons (cons variable value) bindings)))
+	     unspecific))))))
+
 (define (variable-local-value? buffer variable)
   (assq variable (buffer-local-bindings buffer)))
 
@@ -453,14 +458,17 @@ The buffer is guaranteed to be deselected at that time."
        (set-cdr! modes '()))
      (set-buffer-comtabs! buffer (mode-comtabs mode))
      (vector-set! buffer buffer-index:alist '())
-     (buffer-modeline-event! buffer 'BUFFER-MODES)
      (vector-set! buffer buffer-index:initializations '())
-     (add-buffer-initialization! buffer undo-local-bindings!)
-     (add-buffer-initialization! buffer (mode-initialization mode)))))
+     (buffer-modeline-event! buffer 'BUFFER-MODES)
+     (%add-buffer-initialization! buffer undo-local-bindings!)
+     (%add-buffer-initialization! buffer (mode-initialization mode)))))
+
+(define-integrable (buffer-minor-modes buffer)
+  (cdr (buffer-modes buffer)))
 
 (define (buffer-minor-mode? buffer mode)
   (if (mode-major? mode) (error "Not a minor mode" mode))
-  (memq mode (buffer-modes buffer)))
+  (memq mode (buffer-minor-modes buffer)))
 
 (define (enable-buffer-minor-mode! buffer mode)
   (if (mode-major? mode) (error "Not a minor mode" mode))
@@ -473,9 +481,8 @@ The buffer is guaranteed to be deselected at that time."
 	     (set-buffer-comtabs! buffer
 				  (cons (mode-comtab mode)
 					(buffer-comtabs buffer)))
-	     (buffer-modeline-event! buffer 'BUFFER-MODES)
-	     (add-buffer-initialization! buffer
-					 (mode-initialization mode))))))))
+	     (%add-buffer-initialization! buffer (mode-initialization mode))
+	     (buffer-modeline-event! buffer 'BUFFER-MODES)))))))
 
 (define (disable-buffer-minor-mode! buffer mode)
   (if (mode-major? mode) (error "Not a minor mode" mode))
@@ -488,21 +495,4 @@ The buffer is guaranteed to be deselected at that time."
 	     (set-buffer-comtabs! buffer
 				  (delq! (mode-comtab mode)
 					 (buffer-comtabs buffer)))
-	     (buffer-modeline-event! buffer 'BUFFER-MODES)))))))
-
-(define (add-buffer-initialization! buffer thunk)
-  (if (eq? buffer (current-buffer))
-      (thunk)
-      (vector-set! buffer
-		   buffer-index:initializations
-		   (append! (buffer-initializations buffer) (list thunk)))))
-
-(define (perform-buffer-initializations! buffer)
-  ;; Assumes that BUFFER is selected.
-  (let loop ()
-    (let ((thunks (buffer-initializations buffer)))
-      (if (not (null? thunks))
-	  (begin
-	    (vector-set! buffer buffer-index:initializations (cdr thunks))
-	    ((car thunks))
-	    (loop))))))
\ No newline at end of file
+	     (buffer-modeline-event! buffer 'BUFFER-MODES)))))))
\ No newline at end of file
diff --git a/v7/src/edwin/bufout.scm b/v7/src/edwin/bufout.scm
index 21b05bf94..14f7ec4fb 100644
--- a/v7/src/edwin/bufout.scm
+++ b/v7/src/edwin/bufout.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufout.scm,v 1.2 1989/04/28 22:47:40 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufout.scm,v 1.3 1989/08/09 13:16:53 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -43,6 +43,7 @@
 ;;;
 
 ;;;; Buffer Output Ports
+;;; Package: (edwin buffer-output-port)
 
 (declare (usual-integrations))
 
@@ -50,20 +51,72 @@
   (with-output-to-port (mark->output-port mark)
     thunk))
 
-(define (mark->output-port mark)
-  (output-port/copy mark-output-port-template (mark-left-inserting mark)))
+(define (mark->output-port mark #!optional buffer)
+  (output-port/copy mark-output-port-template
+		    (cons (mark-left-inserting mark)
+			  (if (default-object? buffer)
+			      false
+			      buffer))))
 
-(define (operation/write-char port char)
-  (region-insert-char! (output-port/state port) char))
+(define (fresh-line #!optional port)
+  (let ((port (if (default-object? port) (current-output-port) port)))
+    (let ((operation (output-port/custom-operation port 'fresh-line)))
+      (if operation
+	  (operation port)
+	  (output-port/write-char port #\newline))
+      (output-port/flush-output port))))
 
-(define (operation/write-string port string)
-  (region-insert-string! (output-port/state port) string))
+(define (fresh-lines n #!optional port)
+  (let ((port (if (default-object? port) (current-output-port) port)))
+    (let ((operation (output-port/custom-operation port 'fresh-lines)))
+      (if operation
+	  (operation port n)
+	  (let loop ((n n))
+	    (if (positive? n)
+		(begin
+		  (output-port/write-char port #\newline)
+		  (loop (-1+ n))))))
+      (output-port/flush-output port))))
+
+(define-integrable (output-port/mark port)
+  (car (output-port/state port)))
+
+(define-integrable (output-port/buffer port)
+  (cdr (output-port/state port)))
+
+(define (operation/flush-output port)
+  (let ((mark (output-port/mark port))
+	(buffer (output-port/buffer port)))
+    (if buffer
+	(for-each (if (mark= mark (buffer-point buffer))
+		      (lambda (window)
+			(set-window-point! window mark)
+			(window-direct-update! window false))
+		      (lambda (window)
+			(window-direct-update! window false)))
+		  (buffer-windows buffer)))))
+
+(define (operation/fresh-line port)
+  (guarantee-newline (output-port/mark port)))
+
+(define (operation/fresh-lines port n)
+  (guarantee-newlines n (output-port/mark port)))
 
 (define (operation/print-self state port)
   (unparse-string state "to buffer at ")
-  (unparse-object state (output-port/state port)))
+  (unparse-object state (output-port/mark port)))
+
+(define (operation/write-char port char)
+  (region-insert-char! (output-port/mark port) char))
+
+(define (operation/write-string port string)
+  (region-insert-string! (output-port/mark port) string))
 
 (define mark-output-port-template
-  (make-output-port `((PRINT-SELF ,operation/print-self)		      (WRITE-CHAR ,operation/write-char)
+  (make-output-port `((FLUSH-OUTPUT ,operation/flush-output)
+		      (FRESH-LINE ,operation/fresh-line)
+		      (FRESH-LINES ,operation/fresh-lines)
+		      (PRINT-SELF ,operation/print-self)
+		      (WRITE-CHAR ,operation/write-char)
 		      (WRITE-STRING ,operation/write-string))
 		    false))
\ No newline at end of file
diff --git a/v7/src/edwin/comman.scm b/v7/src/edwin/comman.scm
index 4fa6103a5..7fcd956d0 100644
--- a/v7/src/edwin/comman.scm
+++ b/v7/src/edwin/comman.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comman.scm,v 1.59 1989/08/08 10:05:43 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comman.scm,v 1.60 1989/08/09 13:16:56 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -74,8 +74,7 @@
     (vector-set! command command-index:procedure procedure)
     command))
 
-(define editor-commands
-  (make-string-table 500))
+(define editor-commands (make-string-table 500))
 
 (define (name->command name)
   (let ((name (canonicalize-name name)))
@@ -89,6 +88,9 @@
 		     (editor-error "Undefined command: "
 				   (command-name-string command))))))
 	  command))))
+
+(define (->command object)
+  (if (command? object) object (name->command object)))
 
 (define-named-structure "Variable"
   name
@@ -130,13 +132,16 @@
   (for-each (lambda (daemon) (daemon variable))
 	    (variable-assignment-daemons variable)))
 
-(define editor-variables
-  (make-string-table 50))
+(define editor-variables (make-string-table 50))
 
 (define (name->variable name)
   (let ((name (canonicalize-name name)))
     (or (string-table-get editor-variables (symbol->string name))
 	(make-variable name "" false))))
+
+(define (->variable object)
+  (if (variable? object) object (name->variable object)))
+
 (define (set-variable-value! variable value)
   (if (variable-buffer-local? variable)
       (make-local-binding! variable value)
diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index b224aeab9..a5cb408e6 100644
--- a/v7/src/edwin/comred.scm
+++ b/v7/src/edwin/comred.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.77 1989/08/08 10:05:47 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.78 1989/08/09 13:16:59 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -353,9 +353,10 @@
       ((#\v)
        (prompting (variable-name (prompt-for-variable prompt))))
       ((#\x)
-       (prompting (prompt-for-expression prompt false)))
+       (prompting (prompt-for-expression prompt)))
       ((#\X)
-       (prompting (prompt-for-expression-value prompt false)))      (else
+       (prompting (prompt-for-expression-value prompt)))
+      (else
        (editor-error "Invalid control letter "
 		     char
 		     " in interactive calling string")))))
diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index 0d097c637..2b951f436 100644
--- a/v7/src/edwin/curren.scm
+++ b/v7/src/edwin/curren.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.84 1989/08/08 10:05:50 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.85 1989/08/09 13:17:02 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -134,6 +134,9 @@
 (define-integrable (buffer-names)
   (bufferset-names (current-bufferset)))
 
+(define-integrable (current-buffer? buffer)
+  (eq? buffer (current-buffer)))
+
 (define-integrable (current-buffer)
   (window-buffer (current-window)))
 
@@ -311,11 +314,12 @@
 
 ;;;; Modes and Comtabs
 
-(define-integrable (current-modes)
-  (buffer-modes (current-buffer)))
-
 (define-integrable (current-major-mode)
   (buffer-major-mode (current-buffer)))
+
+(define-integrable (current-minor-modes)
+  (buffer-minor-modes (current-buffer)))
+
 (define-integrable (current-comtabs)
   (buffer-comtabs (current-buffer)))
 
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index 3989cd6ea..2ecd1bf70 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -71,6 +71,7 @@
      "midas"
      "modefs"
      "modes"
+     "modlin"
      "motcom"
      "pasmod"
      "prompt"
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index 26769942e..c57873870 100644
--- a/v7/src/edwin/edwin.ldr
+++ b/v7/src/edwin/edwin.ldr
@@ -1,5 +1,5 @@
 ;;; -*-Scheme-*-
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.ldr,v 1.5 1989/08/07 08:44:42 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.ldr,v 1.6 1989/08/09 13:17:13 cph Exp $
 ;;; program to load package contents
 ;;; **** This program (unlike most .ldr files) is not generated by a program.
 
@@ -60,6 +60,7 @@
     (load "simple" environment)
     (load "debuge" environment)
     (load "calias" environment)
+    (load "modlin" (->environment '(EDWIN MODELINE-STRING)))
     (load "input" (->environment '(EDWIN KEYBOARD)))
     (load "prompt" (->environment '(EDWIN PROMPT)))
     (load "comred" (->environment '(EDWIN COMMAND-READER)))
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index d06de3459..822c5c7a4 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.8 1989/08/08 10:06:04 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.9 1989/08/09 13:17:16 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -273,9 +273,6 @@ MIT in each case. |#
 	  initialize-buttons!
 	  make-display
 	  make-editor-frame
-	  modeline-mode-string
-	  modeline-modified-string
-	  modeline-percentage-string
 	  set-window-point!
 	  set-window-start-mark!
 	  update-screen!
@@ -344,6 +341,18 @@ MIT in each case. |#
 	  combination-leaf-window
 	  window0))
 
+(define-package (edwin modeline-string)
+  (files "modlin")
+  (parent (edwin))
+  (export (edwin)
+	  edwin-variable$global-mode-string
+	  edwin-variable$mode-line-buffer-identification
+	  edwin-variable$mode-line-format
+	  edwin-variable$mode-line-modified
+	  edwin-variable$mode-line-procedure
+	  edwin-variable$mode-line-process
+	  modeline-string))
+
 (define-package (edwin command-reader)
   (files "comred")
   (parent (edwin))
@@ -425,6 +434,9 @@ MIT in each case. |#
   (files "bufout")
   (parent (edwin))
   (export (edwin)
+	  fresh-line
+	  fresh-lines
+	  mark->output-port
 	  with-output-to-mark))
 
 (define-package (edwin buffer-output-port-truncating)
diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index ec3795378..f6f611c58 100644
--- a/v7/src/edwin/evlcom.scm
+++ b/v7/src/edwin/evlcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.15 1989/08/07 08:44:48 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.16 1989/08/09 13:17:23 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -43,21 +43,20 @@
 ;;;
 
 ;;;; Evaluation Commands
+;;; Package: (edwin)
 
 (declare (usual-integrations))
 
+;;;; Variables
+
 (define-variable scheme-environment
   "The environment used by the evaluation commands, or 'DEFAULT.
 If 'DEFAULT, use the default (REP loop) environment."
   'DEFAULT)
 
 (define-variable scheme-syntax-table
-  "The syntax table used by the evaluation commands, or false.
-If false, use the default (REP loop) syntax-table."
-  false)
-
-(define-variable previous-evaluation-expression
-  "The last expression evaluated in the typein window."
+  "The syntax table used by the evaluation commands, or #F
+If #F, use the default (REP loop) syntax-table."
   false)
 
 (define-variable debug-on-evaluation-error
@@ -65,67 +64,75 @@ If false, use the default (REP loop) syntax-table."
 This does not affect editor errors."
   true)
 
+(define-variable enable-transcript-buffer
+  "If true, output from evaluation commands is recorded in transcript buffer."
+  true)
+
+(define-variable transcript-buffer-name
+  "Name of evaluation transcript buffer.
+This can also be a buffer object."
+  "*scratch*")
+
+(define-variable transcript-buffer-mode
+  "Mode of evaluation transcript buffer.
+This can be either a mode object or the name of one."
+  'scheme-interaction)
+
+(define-variable transcript-input-recorder
+  "A procedure which receives each input region before evaluation.
+If #F, disables input recording."
+  false)
+
+(define-variable transcript-output-wrapper
+  "A procedure which is called to setup transcript output.
+It is passed a thunk as its only argument.
+If #F, normal transcript output is done."
+  false)
+
+(define-variable transcript-value-truncate
+  "True means evaluation results are printed with depth and breadth limits."
+  true)
+
+;;;; Commands
+
 (define-command eval-definition
   "Evaluate the definition at point.
 Prints the result in the typein window.
-With an argument, prompts for the evaluation environment.
-Output goes to the transcript buffer."
+With an argument, prompts for the evaluation environment."
   "P"
   (lambda (argument)
-    (evaluate-from-mark (current-definition-start)
-			(evaluation-environment argument))))
+    (evaluate-from-mark (current-definition-start) argument)))
 
 (define-command eval-next-sexp
   "Evaluate the expression following point.
 Prints the result in the typein window.
-With an argument, prompts for the evaluation environment.
-Output goes to the transcript buffer."
+With an argument, prompts for the evaluation environment."
   "P"
   (lambda (argument)
-    (evaluate-from-mark (current-point)
-			(evaluation-environment argument))))
+    (evaluate-from-mark (current-point) argument)))
 
 (define-command eval-previous-sexp
   "Evaluate the expression preceding point.
 Prints the result in the typein window.
-With an argument, prompts for the evaluation environment.
-Output goes to the transcript buffer."
+With an argument, prompts for the evaluation environment."
   "P"
   (lambda (argument)
-    (evaluate-from-mark (backward-one-sexp (current-point))
-			(evaluation-environment argument))))
+    (evaluate-from-mark (backward-sexp (current-point) 1 'ERROR) argument)))
 
 (define-command eval-region
   "Evaluate the region, printing the results in the typein window.
-With an argument, prompts for the evaluation environment.
-Output goes to the transcript buffer."
+With an argument, prompts for the evaluation environment."
   "r\nP"
   (lambda (region argument)
-    (evaluate-region region (evaluation-environment argument))))
+    (evaluate-region region argument)))
 
-(define-command eval-current-buffer
+(define-command eval-buffer
   "Evaluate the buffer.
 The values are printed in the typein window.
-With an argument, prompts for the evaluation environment.
-Output goes to the transcript buffer."
-  "P"
-  (lambda (argument)
-    (evaluate-region (buffer-region (current-buffer))
-		     (evaluation-environment argument))))
-
-(define-command eval-previous-sexp-into-buffer
-  "Evaluate the expression preceding point.
-With an argument, prompts for the evaluation environment.
-Output is inserted into the buffer at point."
+With an argument, prompts for the evaluation environment."
   "P"
   (lambda (argument)
-    (let ((start (backward-sexp (current-point) 1 false)))
-      (if (not start) (editor-error "No previous expression"))
-      (let ((environment (evaluation-environment argument)))
-	(with-output-to-current-point
-	 (lambda ()
-	   (write-line
-	    (eval-with-history (read-from-mark start) environment))))))))
+    (evaluate-region (buffer-region (current-buffer)) argument)))
 
 (define-command eval-expression
   "Read an evaluate an expression in the typein window.
@@ -140,30 +147,79 @@ With an argument, prompts for the evaluation environment."
   (lambda (environment)
     (set-repl/environment! (nearest-repl) (->environment environment))))
 
-(define (evaluation-environment argument)
-  (cond (argument
-	 (->environment
-	  (prompt-for-expression-value "Evaluate in environment" false)))
-	((eq? 'DEFAULT (ref-variable scheme-environment))
-	 (nearest-repl/environment))
-	(else
-	 (->environment (ref-variable scheme-environment)))))
-
 (define-command set-syntactic-environment
   "Sets the current syntactic environment."
   "XSet syntactic environment"
   (lambda (syntactic-environment)
     (set-repl/syntax-table! (nearest-repl) syntactic-environment)))
 
+(define-command select-transcript-buffer
+  "Select the transcript buffer."
+  ()
+  (lambda ()
+    (select-buffer (transcript-buffer))))
+
+;;;; Expression Prompts
+
+(define (prompt-for-expression-value prompt #!optional default)
+  (eval-with-history (if (default-object? default)
+			 (prompt-for-expression prompt)
+			 (prompt-for-expression prompt default))
+		     (evaluation-environment false)))
+
+(define (prompt-for-expression prompt #!optional default-object default-type)
+  (read-from-string
+   (prompt-for-string prompt
+		      (and (not (default-object? default-object))
+			   (write-to-string default-object))
+		      (if (default-object? default-type)
+			  'VISIBLE-DEFAULT
+			  default-type)
+		      (ref-mode-object prompt-for-expression))))
+(define-major-mode prompt-for-expression scheme #f
+  "Major mode for editing solicited input expressions.
+Depending on what is being solicited, either defaulting or completion
+may be available.  The following commands are special to this mode:
+
+\\[exit-minibuffer] terminates the input.
+\\[minibuffer-yank-default] yanks the default string, if there is one.")
+
+(define-key 'prompt-for-expression #\return 'exit-minibuffer)
+(define-key 'prompt-for-expression #\c-m-y 'minibuffer-yank-default)
+
+;;;; Evaluation
+
+(define (evaluate-from-mark input-mark argument)
+  (evaluate-region (make-region input-mark (forward-sexp input-mark 1 'ERROR))
+		   argument))
+
+(define (evaluate-region region argument)
+  (let ((transcript-input-recorder (ref-variable transcript-input-recorder)))
+    (if transcript-input-recorder
+	(transcript-input-recorder region)))
+  (let ((environment (evaluation-environment argument)))
+    (with-input-from-region region
+      (lambda ()
+	(let loop ((sexp (read)))
+	  (if (not (eof-object? sexp))
+	      (begin
+		(editor-eval sexp environment)
+		(loop (read)))))))))
+
+(define (evaluation-environment argument)
+  (if argument
+      (if (environment? argument)
+	  argument
+	  (->environment
+	   (prompt-for-expression-value "Evaluate in environment")))
+      (let ((environment (ref-variable scheme-environment)))
+	(if (eq? 'DEFAULT environment)
+	    (nearest-repl/environment)
+	    (->environment environment)))))
+
 (define (evaluation-syntax-table)
   (or (ref-variable scheme-syntax-table)
       (nearest-repl/syntax-table)))
-
-(define (evaluate-from-mark input-mark environment)
-  (editor-eval (read-from-mark input-mark) environment))
-
-(define (read-from-mark input-mark)
-  (with-input-from-mark input-mark read))
 
 (define (editor-eval sexp environment)
   (with-output-to-transcript-buffer
@@ -172,23 +228,16 @@ With an argument, prompts for the evaluation environment."
        (transcript-write value)
        value))))
 
-(define (evaluate-region region environment)
-  (with-output-to-transcript-buffer
-    (lambda ()
-      (with-input-from-region region
-	(lambda ()
-	  (let loop ((object (read)))
-	    (if (not (eof-object? object))
-		(begin
-		  (transcript-write (eval-with-history object environment))
-		  (loop (read))))))))))
-
 (define (eval-with-history expression environment)
-  (let ((scode (syntax expression (evaluation-syntax-table))))
-    (bind-condition-handler '()
-	(lambda (condition)
-	  (and (not (condition/internal? condition))
-	       (error? condition)
+  (scode-eval-with-history (syntax expression (evaluation-syntax-table))
+			   environment))
+
+(define (scode-eval-with-history scode environment)
+  (bind-condition-handler '()
+      (lambda (condition)
+	(and (not (condition/internal? condition))
+	     (error? condition)
+	     (begin
 	       (if (ref-variable debug-on-evaluation-error)
 		   (debug-scheme-error condition)
 		   (let ((string
@@ -201,89 +250,58 @@ With an argument, prompts for the evaluation environment."
 			      (< (string-column-length string 18) 80))
 			 (message "Evaluation error: " string)
 			 (begin
-			   (with-output-to-temporary-buffer "*error*" string)
+			   (string->temporary-buffer string "*Error*")
 			   (message "Evaluation error")))))
-	       (%editor-error)))
-      (lambda ()
-	(with-new-history
-	 (lambda () (extended-scode-eval scode environment)))))))
-
-(define (prompt-for-expression-value prompt default)
-  (eval-with-history (prompt-for-expression prompt default)
-		     (evaluation-environment false)))
-
-(define (prompt-for-expression prompt default-object #!optional default-type)
-  (read-from-string
-   (prompt-for-string prompt
-		      (and default-object
-			   (write-to-string default-object))
-		      (if (default-object? default-type)
-			  'VISIBLE-DEFAULT
-			  default-type)
-		      (ref-mode-object prompt-for-expression))))
-
-(define-major-mode prompt-for-expression scheme #f
-  "Major mode for editing solicited input expressions.
-Depending on what is being solicited, either defaulting or completion
-may be available.  The following commands are special to this mode:
-
-\\[exit-minibuffer] terminates the input.
-\\[minibuffer-yank-default] yanks the default string, if there is one.")
-
-(define-key 'prompt-for-expression #\return 'exit-minibuffer)
-(define-key 'prompt-for-expression #\c-m-y 'minibuffer-yank-default)
+	       (%editor-error))))
+    (lambda ()
+      (with-new-history
+       (lambda ()
+	 (extended-scode-eval scode environment))))))
 
 ;;;; Transcript Buffer
 
-(define-variable transcript-buffer-name
-  "Name of buffer to which evaluation commands record their output."
-  "*Transcript*")
-
-(define-variable enable-transcript-buffer
-  "If true, I/O from evaluation commands is recorded in transcript buffer.
-Recording is done only for commands that write their output to the
-message area, not commands that write to a specific buffer."
-  false)
-
-(define (transcript-buffer)
-  (find-or-create-buffer (ref-variable transcript-buffer-name)))
+(define (with-output-to-transcript-buffer thunk)
+  (if (ref-variable enable-transcript-buffer)
+      (let ((output-wrapper (ref-variable transcript-output-wrapper)))
+	(if output-wrapper
+	    (output-wrapper thunk)
+	    (with-output-to-port
+	     (let ((buffer (transcript-buffer)))
+	       (mark->output-port (buffer-end buffer) buffer))
+	     (lambda ()
+	       (fresh-lines 1)
+	       (thunk)))))
+      (let ((value))
+	(let ((output
+	       (with-output-to-string
+		 (lambda ()
+		   (set! value (thunk))
+		   unspecific))))
+	  (if (not (string-null? output))
+	      (string->temporary-buffer output "*Unsolicited-Output*")))
+	value)))
 
 (define (transcript-write value)
-  (if (ref-variable enable-transcript-buffer)
-      (write-line value))
-  (if (or (not (ref-variable enable-transcript-buffer))
-	  (null? (buffer-windows (transcript-buffer))))
-      (message (write-to-string value))))
+  (let ((value-string
+	 (with-output-to-string
+	   (lambda ()
+	     (write-value value (ref-variable transcript-value-truncate))))))
+    (let ((value-message (lambda () (message value-string))))
+      (if (ref-variable enable-transcript-buffer)
+	  (begin
+	    (fresh-lines 1)	    (write-string value-string)
+	    (fresh-lines 2)
+	    (if (null? (buffer-windows (transcript-buffer)))
+		(value-message)))
+	  (value-message)))))
 
-(define (with-output-to-transcript-buffer thunk)
-  (if (ref-variable enable-transcript-buffer)
-      (with-interactive-output-port (transcript-output-port) thunk)
-      (thunk)))
-
-(define (transcript-output-port)
-  (output-port/copy transcript-output-port-template (transcript-buffer)))
-
-(define (operation/write-char port char)
-  (region-insert-char! (buffer-end (output-port/state port)) char))
-
-(define (operation/write-string port string)
-  (region-insert-string! (buffer-end (output-port/state port)) string))
-
-(define (operation/flush-output port)
-  (let ((buffer (output-port/state port)))
-    (let ((end (buffer-end buffer)))
-      (for-each (lambda (window)
-		  (set-window-point! window end)
-		  (window-direct-update! window false))
-		(buffer-windows buffer)))))
-
-(define (operation/print-self state port)
-  (unparse-string state "to transcript buffer ")
-  (unparse-object state (output-port/state port)))
-
-(define transcript-output-port-template
-  (make-output-port `((FLUSH-OUTPUT ,operation/flush-output)
-		      (PRINT-SELF ,operation/print-self)
-		      (WRITE-CHAR ,operation/write-char)
-		      (WRITE-STRING ,operation/write-string))
-		    false))
\ No newline at end of file
+(define (transcript-buffer)
+  (let ((name (ref-variable transcript-buffer-name)))
+    (if (buffer? name)
+	name
+	(or (find-buffer name)
+	    (let ((buffer (create-buffer name)))
+	      (set-buffer-major-mode!
+	       buffer
+	       (->mode (ref-variable transcript-buffer-mode)))
+	      buffer)))))
\ No newline at end of file
diff --git a/v7/src/edwin/image.scm b/v7/src/edwin/image.scm
index 52742e25d..2145a89a4 100644
--- a/v7/src/edwin/image.scm
+++ b/v7/src/edwin/image.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/image.scm,v 1.123 1989/04/28 22:50:11 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/image.scm,v 1.124 1989/08/09 13:17:27 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -56,7 +56,7 @@
 
 ;;; *** One important note: the image abstraction will not "correctly"
 ;;; display strings that contain newlines.  Currently, a newline in
-;;; such a string will be represented by the string "^N" (or perhaps
+;;; such a string will be represented by the string "^J" (or perhaps
 ;;; "^M").  This is so because images are intended to be used on a
 ;;; per-line basis; that is, the string should be for a single line.
 
@@ -89,38 +89,45 @@
 
 (define-structure (image (type vector) (constructor false))
   (string false read-only true)
+  (start-index false read-only true)
+  (start-column false read-only true)
   (parse false read-only true)
   (column-size false read-only true))
 
 (define (make-null-image)
-  (vector "" '() 0))
+  (vector "" 0 0 '() 0))
 
-(define (make-image string)
-  (parse-string-for-image string
+(define-integrable (string->image string start-column)
+  (string-head->image string 0 start-column))
+
+(define (string-head->image string start start-column)
+  (parse-substring-for-image string start (string-length string) start-column
     (lambda (parse column-size)
-      (vector string parse column-size))))
+      (vector string start start-column parse column-size))))
 
-(define-integrable (image-index-size image)
-  (string-length (image-string image)))
+(define (image-index-size image)
+  (- (string-length (image-string image)) (image-start-index image)))
 
 (define (image-direct-output-insert-char! image char)
   (vector-set! image 0 (string-append-char (vector-ref image 0) char))
-  (vector-set! image 2 (1+ (vector-ref image 2)))
+  (vector-set! image 4 (1+ (vector-ref image 4)))
   unspecific)
 
 (define (image-direct-output-insert-substring! image string start end)
   (vector-set! image 0
 	       (string-append-substring (vector-ref image 0)
 					string start end))
-  (vector-set! image 2 (+ (vector-ref image 2) (- end start)))
+  (vector-set! image 4 (+ (vector-ref image 4) (- end start)))
   unspecific)
 
 (define (image-representation image)
   (let ((string (image-string image))
-	(result-end (image-column-size image)))
-    (let ((string-end (string-length string))
-	  (result (string-allocate result-end)))
-      (let loop ((parse (image-parse image)) (string-start 0) (result-start 0))
+	(result (string-allocate (image-column-size image))))
+    (let ((string-end (string-length string)))
+      (let loop
+	  ((parse (image-parse image))
+	   (string-start (image-start-index image))
+	   (result-start 0))
 	(cond ((null? parse)
 	       (substring-move-right! string string-start string-end
 				      result result-start))
@@ -139,7 +146,10 @@
       result)))
 
 (define (image-index->column image index)
-  (let loop ((parse (image-parse image)) (start 0) (column 0))
+  (let loop
+      ((parse (image-parse image))
+       (start (image-start-index image))
+       (column (image-start-column image)))
     (cond ((null? parse)
 	   (+ column (- index start)))
 	  ((string? (car parse))
@@ -158,7 +168,10 @@
 	   (error "Bad parse element" (car parse))))))
 
 (define (image-column->index image column)
-  (let loop ((parse (image-parse image)) (start 0) (c 0))
+  (let loop
+      ((parse (image-parse image))
+       (start (image-start-index image))
+       (c (image-start-column image)))
     (cond ((null? parse)
 	   (+ start (- column c)))
 	  ((string? (car parse))
@@ -174,10 +187,36 @@
 	  (else
 	   (error "Bad parse element" (car parse))))))
 
-;;;; Parsing
+;;;; String Operations
 
-(define (parse-string-for-image string receiver)
-  (parse-substring-for-image string 0 (string-length string) receiver))
+(define (string-representation string start-column)
+  (substring-representation string 0 (string-length string) start-column))
+
+(define (substring-representation string start end start-column)
+  (let ((result
+	 (string-allocate
+	  (- (substring-column-length string start end start-column)
+	     start-column))))
+    (let loop ((start start) (column start-column) (rindex 0))
+      (let* ((index
+	      (substring-find-next-char-in-set string start end
+					       char-set:not-graphic))
+	     (copy-representation!
+	      (lambda (column rindex)
+		(let* ((representation
+			(char-representation (string-ref string index) column))
+		       (size (string-length representation)))
+		  (substring-move-right! representation 0 size result rindex)
+		  (loop (1+ index) (+ column size) (+ rindex size))))))
+	(cond ((not index)
+	       (substring-move-right! string start end result rindex)
+	       result)
+	      ((= start index)
+	       (copy-representation! column rindex))
+	      (else
+	       (substring-move-right! string start index result rindex)
+	       (let ((size (- index start)))
+		 (copy-representation! (+ column size) (+ rindex size)))))))))
 
 (define (string-column-length string start-column)
   (substring-column-length string 0 (string-length string) start-column))
@@ -185,109 +224,106 @@
 (define (string-index->column string start-column index)
   (+ start-column (substring-column-length string 0 index start-column)))
 
+(define (substring-column-length string start end start-column)
+  (let loop ((i start) (c start-column))
+    (let ((index
+	   (substring-find-next-char-in-set string i end
+					    char-set:not-graphic)))
+      (if (not index)
+	  (+ c (- end i))
+	  (loop (1+ index)
+		(let ((c (+ c (- index i))))
+		  (+ c (char-column-length (string-ref string index) c))))))))
+
 (define (string-column->index string start-column column if-lose)
   (substring-column->index string 0 (string-length string) start-column
 			   column if-lose))
 
-(define (char-column-length char start-column)
-  (string-length (char-representation char start-column)))
-
-(define parse-substring-for-image)
-(define substring-column-length)
-(define substring-column->index)
-(define char-representation)
-(let ()
+(define (substring-column->index string start end start-column column
+				 #!optional if-lose)
+  (if (zero? column)
+      start
+      (let loop ((i start) (c start-column) (left (- column start-column)))
+	(let ((index
+	       (substring-find-next-char-in-set string i end
+						char-set:not-graphic)))
+	  (if (not index)
+	      (let ((n (- end i)))
+		(cond ((<= left n) (+ i left))
+		      ((default-object? if-lose) end)
+		      (else (if-lose (+ c n)))))
+	      (let ((n (- index i)))
+		(if (<= left n)
+		    (+ i left)
+		    (let ((c (+ c n))
+			  (left (- left n)))
+		      (let ((n
+			     (char-column-length (string-ref string index) c)))
+			(cond ((< left n) index)
+			      ((= left n) (1+ index))
+			      (else
+			       (loop (1+ index) (+ c n) (- left n)))))))))))))
+
+;;;; Parsing
 
-(set! parse-substring-for-image
-(named-lambda (parse-substring-for-image string start end receiver)
-  (define (loop start column receiver)
-    (let ((index (substring-find-next-char-in-set string start end
-						  char-set:not-graphic)))
+(define (parse-substring-for-image string start end start-column receiver)
+  (let loop ((start start) (column start-column) (receiver receiver))
+    (let ((index
+	   (substring-find-next-char-in-set string start end
+					    char-set:not-graphic)))
       (if (not index)
 	  (receiver '() (+ column (- end start)))
 	  (let ((column (+ column (- index start))))
-	    (let ((representation (char-rep string index column)))
+	    (let ((representation
+		   (char-representation (string-ref string index) column)))
 	      (loop (1+ index)
 		    (+ column (string-length representation))
 		    (lambda (parse column-size)
 		      (receiver (if (= index start)				    (cons representation parse)
 				    (cons index (cons representation parse)))
-				column-size))))))))
-  (loop start 0 receiver)))
+				column-size)))))))))
 
-(set! substring-column-length
-(named-lambda (substring-column-length string start end start-column)
-  (define (loop i c)
-    (let ((index (substring-find-next-char-in-set string i end
-						  char-set:not-graphic)))
-      (if (not index)
-	  (+ c (- end i))
-	  (let ((c (+ c (- index i))))
-	    (loop (1+ index)
-		  (+ c (string-length (char-rep string index c))))))))
-  (loop start start-column)))
-
-(set! substring-column->index
-(named-lambda (substring-column->index string start end start-column
-				       column #!optional if-lose)
-  (define (loop i c left)
-    (let ((index (substring-find-next-char-in-set string i end
-						  char-set:not-graphic)))
-      (if (not index)
-	  (let ((n (- end i)))
-	    (cond ((<= left n) (+ i left))
-		  ((default-object? if-lose) end)
-		  (else (if-lose (+ c n)))))
-	  (let ((n (- index i)))
-	    (if (<= left n)
-		(+ i left)
-		(let ((c (+ c n)) (left (- left n)))
-		  (let ((n (string-length (char-rep string index c))))
-		    (cond ((< left n) index)
-			  ((= left n) (1+ index))
-			  (else (loop (1+ index) (+ c n) (- left n)))))))))))
-  (if (zero? column)
-      start
-      (loop start start-column (- column start-column)))))
-
-(define-integrable (char-rep string index column)
-  (char-representation (string-ref string index) column))
-
-(set! char-representation
-(named-lambda (char-representation char column)
-  (if (char=? char #\Tab)
-      (vector-ref tab-display-images (remainder column 8))
-      (vector-ref display-images (char->ascii char)))))
-
-(define tab-display-images
-  #("        " "       " "      " "     " "    " "   " "  " " "))
-
-(define display-images
-  #("^@" "^A" "^B" "^C" "^D" "^E" "^F" "^G"
-    "^H" "^I" "^J" "^K" "^L" "^M" "^N" "^O"
-    "^P" "^Q" "^R" "^S" "^T" "^U" "^V" "^W"
-    "^X" "^Y" "^Z" "^[" "^\\" "^]" "^^" "^_"
-    " " "!" "\"" "#" "$" "%" "&" "'" "(" ")" "*" "+" "," "-" "." "/"
-    "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ":" ";" "<" "=" ">" "?"
-    "@" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O"
-    "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "[" "\\" "]" "^" "_"
-    "`" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"
-    "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "{" "|" "}" "~" "^?"
-    "\200" "\201" "\202" "\203" "\204" "\205" "\206" "\207"
-    "\210" "\211" "\212" "\213" "\214" "\215" "\216" "\217"
-    "\220" "\221" "\222" "\223" "\224" "\225" "\226" "\227"
-    "\230" "\231" "\232" "\233" "\234" "\235" "\236" "\237"
-    "\240" "\241" "\242" "\243" "\244" "\245" "\246" "\247"
-    "\250" "\251" "\252" "\253" "\254" "\255" "\256" "\257"
-    "\260" "\261" "\262" "\263" "\264" "\265" "\266" "\267"
-    "\270" "\271" "\272" "\273" "\274" "\275" "\276" "\277"
-    "\300" "\301" "\302" "\303" "\304" "\305" "\306" "\307"
-    "\310" "\311" "\312" "\313" "\314" "\315" "\316" "\317"
-    "\320" "\321" "\322" "\323" "\324" "\325" "\326" "\327"
-    "\330" "\331" "\332" "\333" "\334" "\335" "\336" "\337"
-    "\340" "\341" "\342" "\343" "\344" "\345" "\346" "\347"
-    "\350" "\351" "\352" "\353" "\354" "\355" "\356" "\357"
-    "\360" "\361" "\362" "\363" "\364" "\365" "\366" "\367"
-    "\370" "\371" "\372" "\373" "\374" "\375" "\376" "\377"))
-
-)
\ No newline at end of file
+(define char-column-length)
+(define char-representation)
+(let ((tab-display-images
+       #("        " "       " "      " "     " "    " "   " "  " " "))
+      (display-images
+       #("^@" "^A" "^B" "^C" "^D" "^E" "^F" "^G"
+	 "^H" "^I" "^J" "^K" "^L" "^M" "^N" "^O"
+	 "^P" "^Q" "^R" "^S" "^T" "^U" "^V" "^W"
+	 "^X" "^Y" "^Z" "^[" "^\\" "^]" "^^" "^_"
+	 " " "!" "\"" "#" "$" "%" "&" "'" "(" ")" "*" "+" "," "-" "." "/"
+	 "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" ":" ";" "<" "=" ">" "?"
+	 "@" "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M" "N" "O"
+	 "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z" "[" "\\" "]" "^" "_"
+	 "`" "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"
+	 "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z" "{" "|" "}" "~" "^?"
+	 "\200" "\201" "\202" "\203" "\204" "\205" "\206" "\207"
+	 "\210" "\211" "\212" "\213" "\214" "\215" "\216" "\217"
+	 "\220" "\221" "\222" "\223" "\224" "\225" "\226" "\227"
+	 "\230" "\231" "\232" "\233" "\234" "\235" "\236" "\237"
+	 "\240" "\241" "\242" "\243" "\244" "\245" "\246" "\247"
+	 "\250" "\251" "\252" "\253" "\254" "\255" "\256" "\257"
+	 "\260" "\261" "\262" "\263" "\264" "\265" "\266" "\267"
+	 "\270" "\271" "\272" "\273" "\274" "\275" "\276" "\277"
+	 "\300" "\301" "\302" "\303" "\304" "\305" "\306" "\307"
+	 "\310" "\311" "\312" "\313" "\314" "\315" "\316" "\317"
+	 "\320" "\321" "\322" "\323" "\324" "\325" "\326" "\327"
+	 "\330" "\331" "\332" "\333" "\334" "\335" "\336" "\337"
+	 "\340" "\341" "\342" "\343" "\344" "\345" "\346" "\347"
+	 "\350" "\351" "\352" "\353" "\354" "\355" "\356" "\357"
+	 "\360" "\361" "\362" "\363" "\364" "\365" "\366" "\367"
+	 "\370" "\371" "\372" "\373" "\374" "\375" "\376" "\377")))
+  (set! char-representation
+	(lambda (char column)
+	  (if (char=? char #\Tab)
+	      (vector-ref tab-display-images (remainder column 8))
+	      (vector-ref display-images (char->ascii char)))))
+  (let ((tab-display-lengths (vector-map tab-display-images string-length))
+	(display-lengths (vector-map display-images string-length)))
+    (set! char-column-length
+	  (lambda (char column)
+	    (if (char=? char #\Tab)
+		(vector-ref tab-display-lengths (remainder column 8))
+		(vector-ref display-lengths (char->ascii char)))))
+    unspecific))
\ No newline at end of file
diff --git a/v7/src/edwin/info.scm b/v7/src/edwin/info.scm
index e1226d3fc..4598274b3 100644
--- a/v7/src/edwin/info.scm
+++ b/v7/src/edwin/info.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.92 1989/08/03 23:32:45 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/info.scm,v 1.93 1989/08/09 13:17:32 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -115,22 +115,18 @@ s	Search through this Info file for specified regexp,
   (local-set-variable! info-current-node false)
   (local-set-variable! info-tag-table-start false)
   (local-set-variable! info-tag-table-end false)
-  (buffer-put! (current-buffer) 'MODELINE-STRING info-modeline-string))
+  (info-set-mode-line!))
 
-(define (info-modeline-string window)
-  (string-append "--"
-		 (modeline-modified-string window)
-		 "-Info:  ("
-		 (let ((pathname (ref-variable info-current-file)))
-		   (if pathname
-		       (pathname-name-string pathname)
-		       ""))
-		 ")"
-		 (or (ref-variable info-current-node) "")
-		 "      "
-		 (modeline-mode-string window)
-		 "--"
-		 (modeline-percentage-string window)))
+(define (info-set-mode-line!)
+  (local-set-variable! mode-line-buffer-identification
+		       (string-append
+			"Info:  ("
+			(let ((pathname (ref-variable info-current-file)))
+			  (if pathname
+			      (pathname-name-string pathname)
+			      ""))
+			")"
+			(or (ref-variable info-current-node) ""))))
 
 (define-key 'info #\space 'scroll-up)
 (define-key 'info #\. 'beginning-of-buffer)
@@ -634,7 +630,8 @@ The name may be an abbreviation of the reference name."
       (if (string=? nodename "*")
 	  (begin
 	    (set-variable! info-current-subfile false)
-	    (set-variable! info-current-node nodename))
+	    (set-variable! info-current-node nodename)
+	    (info-set-mode-line!))
 	  (select-node
 	   (let ((end (buffer-end buffer)))
 	     (let loop ((start (node-search-start nodename)))
@@ -662,7 +659,9 @@ The name may be an abbreviation of the reference name."
 
 (define (select-node point)
   (let ((node (node-start point (group-start point))))
-    (set-variable! info-current-node (extract-node-name node))    ;; **** need to add active node hacking here ****
+    (set-variable! info-current-node (extract-node-name node))
+    (info-set-mode-line!)
+    ;; **** need to add active node hacking here ****
     (region-clip! (node-region node))
     (set-current-point! point)))
 
diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm
index 60adc90ca..327f40d2e 100644
--- a/v7/src/edwin/intmod.scm
+++ b/v7/src/edwin/intmod.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.35 1989/04/28 22:50:26 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.36 1989/08/09 13:17:37 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -43,6 +43,7 @@
 ;;;
 
 ;;;; Interaction Mode
+;;; Package: (edwin)
 
 (declare (usual-integrations))
 
@@ -56,110 +57,70 @@
   "Major mode for evaluating Scheme expressions interactively.
 Same as Scheme mode, except for
 
-\\[scheme-interaction-eval-previous-sexp] evaluates the current expression.
-\\[scheme-interaction-eval-definition] evaluates the current definition.
-\\[scheme-interaction-eval-region] evaluates the region.
 \\[scheme-interaction-yank] yanks the most recently evaluated expression.
 \\[scheme-interaction-yank-pop] yanks an earlier expression, replacing a yank."
-  (local-set-variable! scheme-interaction-kill-ring (make-ring 32))
-  (local-set-variable! scheme-environment (ref-variable scheme-environment))
-  (local-set-variable! scheme-syntax-table (ref-variable scheme-syntax-table)))
+  (local-set-variable! enable-transcript-buffer true)
+  (local-set-variable! transcript-buffer-name (current-buffer))
+  (local-set-variable! transcript-input-recorder
+		       scheme-interaction-input-recorder)
+  (local-set-variable! transcript-output-wrapper
+		       scheme-interaction-output-wrapper)
+  (local-set-variable! scheme-interaction-kill-ring (make-ring 32)))
+
+(define (scheme-interaction-input-recorder region)
+  (ring-push! (ref-variable scheme-interaction-kill-ring)
+	      (region->string region)))
+
+(define (scheme-interaction-output-wrapper thunk)
+  (set-current-point! (buffer-end (current-buffer)))
+  (with-output-to-current-point
+   (lambda ()
+     (intercept-^G-interrupts
+      (lambda ()
+	(fresh-line)
+	(write-string ";Abort!")
+	(fresh-lines 2)
+	(^G-signal))
+      thunk))))
 
-(define-prefix-key 'scheme-interaction #\C-x 'prefix-char)
 (define-prefix-key 'scheme-interaction #\C-c 'prefix-char)
-(define-key 'scheme-interaction '(#\C-x #\C-e)
-  'scheme-interaction-eval-previous-sexp)
-(define-key 'scheme-interaction #\M-return
-  'scheme-interaction-eval-previous-sexp)
-(define-key 'scheme-interaction #\M-z 'scheme-interaction-eval-definition)
-(define-key 'scheme-interaction #\C-M-z 'scheme-interaction-eval-region)
 (define-key 'scheme-interaction '(#\C-c #\C-y) 'scheme-interaction-yank)
 (define-key 'scheme-interaction '(#\C-c #\C-r) 'scheme-interaction-yank-pop)
-
+
 (define-variable scheme-interaction-kill-ring
   "Kill ring used by Interaction mode evaluation commands.")
 
-(define (scheme-interaction-eval-region region argument)
-  (set-current-point! (region-end region))
-  (let ((string (region->string region)))
-    (ring-push! (ref-variable scheme-interaction-kill-ring) string)
-    (let ((expression (with-input-from-string string read)))
-      (let ((value
-	     (with-output-to-current-point
-	      (lambda ()
-		(intercept-^G-interrupts
-		 (lambda ()
-		   (guarantee-newline)
-		   (insert-string "Abort!")
-		   (insert-newlines 2)
-		   (^G-signal))
-		 (lambda ()
-		   (eval-with-history expression
-				      (evaluation-environment argument))))))))
-	(guarantee-newline)
-	(if (undefined-value? value)
-	    (insert-string ";No value")
-	    (begin
-	      (insert-string ";Value: ")
-	      (insert-string (scheme-interaction-object->string value))))
-	(guarantee-newlines 2)))))
-
-(define (scheme-interaction-object->string object)
-  (fluid-let ((*unparser-list-depth-limit* 5)
-	      (*unparser-list-breadth-limit* 10))
-    (write-to-string object)))
-
-(define-command scheme-interaction-eval-previous-sexp
-  "Evaluate the expression to the left of point."
-  "P"
-  (lambda (argument)
-    (let ((point (current-point)))
-      (scheme-interaction-eval-region
-       (make-region (backward-one-sexp point) point)
-       argument))))
-
-(define-command scheme-interaction-eval-definition
-  "Evaluate the definition at point.
-Moves point to the definition's end.
-Output and the result are written at that point.
-With an argument, prompts for the evaluation environment."
-  "P"
-  (lambda (argument)
-    (scheme-interaction-eval-region
-     (let ((start (current-definition-start)))
-       (make-region start (forward-one-definition-end start)))
-     argument)))
-
-(define-command scheme-interaction-eval-region
-  "Evaluate the definition at point.
-Moves point to the definition's end.
-Output and the result are written at that point.
-With an argument, prompts for the evaluation environment."
-  "r\nP"
-  scheme-interaction-eval-region)
-
-(define scheme-interaction-mode:yank-command-message
-  "Yank")
+(define scheme-interaction-mode:yank-command-message "Yank")
 
 (define-command scheme-interaction-yank
-  "Yank the last input expression."
+  "Re-insert the last input expression.
+Puts point after it and the mark before it."
   ()
   (lambda ()
-    (push-current-mark! (mark-right-inserting (current-point)))
-    (insert-string (ring-ref (ref-variable scheme-interaction-kill-ring) 0))
-    (set-command-message! scheme-interaction-mode:yank-command-message)))
+    (let ((kill-ring (ref-variable scheme-interaction-kill-ring)))
+      (if (ring-empty? kill-ring)
+	  (editor-error "Nothing to yank"))
+      (push-current-mark! (mark-right-inserting (current-point)))
+      (insert-string (ring-ref kill-ring 0))
+      (set-command-message! scheme-interaction-mode:yank-command-message))))
 
 (define-command scheme-interaction-yank-pop
-  "Yank the last input expression."
+  "Correct after \\[scheme-interaction-yank] to use an earlier expression.
+Requires that the region contain the most recent expression,
+as it does immediately after using \\[scheme-interaction-yank].
+It is deleted and replaced with the previous expression,
+which is rotated to the front of the expression ring."
   ()
   (lambda ()
-    (command-message-receive scheme-interaction-mode:yank-command-message
-      (lambda ()
-	(delete-string (pop-current-mark!) (current-point))
-	(push-current-mark! (mark-right-inserting (current-point)))
-	(ring-pop! (ref-variable scheme-interaction-kill-ring))
-	(insert-string
-	 (ring-ref (ref-variable scheme-interaction-kill-ring) 0))
-	(set-command-message! scheme-interaction-mode:yank-command-message))
-      (lambda ()
-	(editor-error "No previous yank to replace")))))
\ No newline at end of file
+    (let ((kill-ring (ref-variable scheme-interaction-kill-ring)))
+      (if (ring-empty? kill-ring)
+	  (editor-error "Nothing to yank"))
+      (command-message-receive scheme-interaction-mode:yank-command-message
+	(lambda ()
+	  (delete-string (pop-current-mark!) (current-point))
+	  (push-current-mark! (mark-right-inserting (current-point)))
+	  (ring-pop! kill-ring)
+	  (insert-string (ring-ref kill-ring 0))
+	  (set-command-message! scheme-interaction-mode:yank-command-message))
+	(lambda ()
+	  (editor-error "No previous yank to replace"))))))
\ No newline at end of file
diff --git a/v7/src/edwin/iserch.scm b/v7/src/edwin/iserch.scm
index 7bdf45175..189f66d61 100644
--- a/v7/src/edwin/iserch.scm
+++ b/v7/src/edwin/iserch.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/iserch.scm,v 1.6 1989/04/28 22:50:31 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/iserch.scm,v 1.7 1989/08/09 13:17:41 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -167,7 +167,8 @@
 	    "I-search"
 	    (if (search-state-forward? state) "" " backward")
 	    ": "
-	    (image-representation (make-image (search-state-text state)))	    (if invalid-regexp (string-append " [" invalid-regexp "]") ""))))
+	    (string-representation (search-state-text state) 0)
+	    (if invalid-regexp (string-append " [" invalid-regexp "]") ""))))
       (string-set! m 0 (char-upcase (string-ref m 0)))
       m)))
 
diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index b1ca734cc..72a435092 100644
--- a/v7/src/edwin/make.scm
+++ b/v7/src/edwin/make.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.13 1989/08/08 10:06:22 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.14 1989/08/09 13:17:47 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -37,4 +37,4 @@ MIT in each case. |#
 (declare (usual-integrations))
 
 (package/system-loader "edwin" '() 'QUERY)
-(add-system! (make-system "Edwin" 3 13 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 14 '()))
\ No newline at end of file
diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index 3effbdacc..e18df53d6 100644
--- a/v7/src/edwin/modefs.scm
+++ b/v7/src/edwin/modefs.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.119 1989/08/08 10:06:25 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.120 1989/08/09 13:17:51 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989 Massachusetts Institute of Technology
 ;;;
@@ -68,22 +68,16 @@ Most other major modes are defined by comparison to this one."
   (ref-mode-object fundamental))
 
 (define initial-buffer-name
-  "*scratch*")
+  (ref-variable transcript-buffer-name))
 
 (define initial-buffer-mode
-  (ref-mode-object scheme-interaction))
+  (->mode (ref-variable transcript-buffer-mode)))
 
 (define-variable file-type-to-major-mode
   "Specifies the major mode for new buffers based on file type.
 This is an alist, the cars of which are pathname types,
 and the cdrs of which are major modes."
-  `(("ASM" . midas)
-    ("C" . c)
-    ("PAS" . pascal)
-    ("S" . scheme)
-    ("SCM" . scheme)
-    ("TXI" . texinfo)
-    ("TXT" . text)))
+  (os/file-type-to-major-mode))
 
 (define-default-key 'fundamental '^r-bad-command)
 
@@ -231,7 +225,10 @@ and the cdrs of which are major modes."
 (define-key 'fundamental #\c-m-v 'scroll-other-window)
 (define-key 'fundamental #\c-m-w 'append-next-kill)
 (define-key 'fundamental #\c-m-rubout 'backward-kill-sexp)
-(define-key 'fundamental '(#\c-h #\a) 'command-apropos)(define-key 'fundamental '(#\c-h #\c) 'describe-key-briefly)
+
+(define-key 'fundamental '(#\c-c #\c-s) 'select-transcript-buffer)
+
+(define-key 'fundamental '(#\c-h #\a) 'command-apropos)(define-key 'fundamental '(#\c-h #\c) 'describe-key-briefly)
 (define-key 'fundamental '(#\c-h #\d) 'describe-command)(define-key 'fundamental '(#\c-h #\i) 'info)
 (define-key 'fundamental '(#\c-h #\k) 'describe-key)
 (define-key 'fundamental '(#\c-h #\l) 'view-lossage)
diff --git a/v7/src/edwin/modes.scm b/v7/src/edwin/modes.scm
index 1a746c9d7..140f4035e 100644
--- a/v7/src/edwin/modes.scm
+++ b/v7/src/edwin/modes.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modes.scm,v 1.23 1989/04/28 22:51:33 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modes.scm,v 1.24 1989/08/09 13:17:56 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -75,8 +75,7 @@
 (define-integrable (mode-comtab mode)
   (car (mode-comtabs mode)))
 
-(define editor-modes
-  (make-string-table))
+(define editor-modes (make-string-table))
 
 (define (name->mode name)
   (let ((name (canonicalize-name name)))
@@ -86,4 +85,7 @@
 		   (symbol->string name)
 		   '()
 		   ""
-		   (lambda () (error "Undefined mode" name))))))
\ No newline at end of file
+		   (lambda () (error "Undefined mode" name))))))
+
+(define (->mode object)
+  (if (mode? object) object (name->mode object)))
\ No newline at end of file
diff --git a/v7/src/edwin/modwin.scm b/v7/src/edwin/modwin.scm
index ce78e401a..44c60c32a 100644
--- a/v7/src/edwin/modwin.scm
+++ b/v7/src/edwin/modwin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modwin.scm,v 1.29 1989/04/28 22:51:38 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modwin.scm,v 1.30 1989/08/09 13:17:59 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -59,27 +59,31 @@
 						 xl xu yl yu display-style)
   display-style				;ignore
   (if (< yl yu)
-      (with-inverse-video! screen (ref-variable mode-line-inverse-video)
-	(lambda ()
-	  (screen-write-substring!
-	   screen x-start y-start
-	   (string-pad-right (modeline-string superior) x-size #\-)
-	   xl xu))))
-  true)
+      (let ((thunk
+	     (lambda ()
+	       (screen-write-substring!
+		screen x-start y-start
+		(string-pad-right (modeline-string superior) x-size #\-)
+		xl xu))))
+	(if (and (variable-local-value
+		  (window-buffer superior)
+		  (ref-variable-object mode-line-inverse-video))
+		 (let ((x-size (screen-x-size screen)))
+		   (or (= x-size (window-x-size superior))
+		       (= x-size (window-x-size (window-superior superior))))))	    (with-inverse-video! screen thunk)
+	    (thunk))))  true)
 
-(define (with-inverse-video! screen flag? thunk)
-  (if flag?
-      (let ((old-inverse? (screen-inverse-video! screen false))
-	    (new-inverse? true))
-	(screen-inverse-video! screen old-inverse?)
-	(dynamic-wind (lambda ()
-			(set! old-inverse?
-			      (screen-inverse-video! screen new-inverse?)))
-		      thunk
-		      (lambda ()
-			(set! new-inverse?
-			      (screen-inverse-video! screen old-inverse?)))))
-      (thunk)))
+(define (with-inverse-video! screen thunk)
+  (let ((old-inverse? (screen-inverse-video! screen false))
+	(new-inverse? true))
+    (screen-inverse-video! screen old-inverse?)
+    (dynamic-wind (lambda ()
+		    (set! old-inverse?
+			  (screen-inverse-video! screen new-inverse?)))
+		  thunk
+		  (lambda ()
+		    (set! new-inverse?
+			  (screen-inverse-video! screen old-inverse?))))))
 
 (define-method modeline-window (:event! window type)
   (case type
@@ -95,61 +99,4 @@
       unspecific)
      (else 
       (setup-redisplay-flags! redisplay-flags)))
-  unspecific)
-
-(define (modeline-string window)
-  ((or (buffer-get (window-buffer window) 'MODELINE-STRING)
-       standard-modeline-string)
-   window))
-
-(define (standard-modeline-string window)
-  (string-append "--"
-		 (modeline-modified-string window)
-		 "-Edwin: "
-		 (string-pad-right (buffer-display-name (window-buffer window))
-				   30)
-		 " "
-		 (modeline-mode-string window)
-		 "--"
-		 (modeline-percentage-string window)))
-
-(define (modeline-modified-string window)
-  (let ((buffer (window-buffer window)))
-    (cond ((not (buffer-writeable? buffer)) "%%")
-	  ((buffer-modified? buffer) "**")
-	  (else "--"))))
-
-(define (modeline-mode-string window)
-  (let ((buffer (window-buffer window)))
-    (string-append
-     (make-string recursive-edit-level #\[)
-     "("
-     (let loop ((modes (buffer-modes buffer)))
-       (if (null? (cdr modes))
-	   (string-append (mode-display-name (car modes))
-			  (if *defining-keyboard-macro?* " Def" "")
-			  (if (group-clipped? (buffer-group buffer))
-			      " Narrow" ""))
-	   (string-append (mode-display-name (car modes))
-			  " "
-			  (loop (cdr modes)))))
-     ")"
-     (make-string recursive-edit-level #\]))))
-
-(define (modeline-percentage-string window)
-  (let ((buffer (window-buffer window)))
-    (if (window-mark-visible? window (buffer-start buffer))
-	(if (window-mark-visible? window (buffer-end buffer))
-	    "All" "Top")
-	(if (window-mark-visible? window (buffer-end buffer))
-	    "Bot"
-	    (string-append
-	     (string-pad-left
-	      (number->string
-	       (round
-		(* 100
-		   (let ((start-index (mark-index (buffer-start buffer))))
-		     (/ (- (mark-index (window-start-mark window)) start-index)
-			(- (mark-index (buffer-end buffer)) start-index))))))
-	      2)
-	     "%")))))
\ No newline at end of file
+  unspecific)
\ No newline at end of file
diff --git a/v7/src/edwin/prompt.scm b/v7/src/edwin/prompt.scm
index 74c2eba89..11b92e31b 100644
--- a/v7/src/edwin/prompt.scm
+++ b/v7/src/edwin/prompt.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.134 1989/04/28 22:52:09 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/prompt.scm,v 1.135 1989/08/09 13:18:02 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -43,6 +43,7 @@
 ;;;
 
 ;;;; User Prompting
+;;; Package: (edwin prompt)
 
 (declare (usual-integrations))
 
@@ -559,7 +560,7 @@ a repetition of this command will exit."
      (prompt-for-typein (string-append prompt ": ") false
        (lambda ()
 	 (let ((char (keyboard-read-char)))
-	   (set-typein-string! (char-name char))
+	   (set-typein-string! (char-name char) true)
 	   char))))))
 
 (define (prompt-for-key prompt #!optional comtab)
@@ -571,7 +572,7 @@ a repetition of this command will exit."
 	   (let outer-loop ((prefix '()))
 	     (let inner-loop ((char (keyboard-read-char)))
 	       (let ((chars (append! prefix (list char))))
-		 (set-typein-string! (xchar->name chars))
+		 (set-typein-string! (xchar->name chars) true)
 		 (if (prefix-char-list? comtab chars)
 		     (outer-loop chars)
 		     (let ((command (comtab-entry comtab chars)))
@@ -590,11 +591,11 @@ a repetition of this command will exit."
 	(let ((char (char-upcase (keyboard-read-char))))
 	  (cond ((or (char=? char #\Y)
 		     (char=? char #\Space))
-		 (set-typein-string! "Yes")
+		 (set-typein-string! "yes" true)
 		 true)
 		((or (char=? char #\N)
 		     (char=? char #\Rubout))
-		 (set-typein-string! "No")
+		 (set-typein-string! "no" true)
 		 false)
 		(else
 		 (editor-failure)
@@ -607,19 +608,21 @@ a repetition of this command will exit."
      (typein-editor-thunk (ref-mode-object minibuffer-local-yes-or-no)))))
 
 (define-major-mode minibuffer-local-yes-or-no fundamental #f
-  "Enter either \"Yes\" or \"No\".")
+  "Enter either \"yes\" or \"no\".")
 
 (define-key 'minibuffer-local-yes-or-no #\return 'exit-minibuffer-yes-or-no)
 
 (define-command exit-minibuffer-yes-or-no
-  "Like \\[exit-minibuffer], but insists on \"Yes\" or \"No\" as an answer."
+  "Like \\[exit-minibuffer], but insists on \"yes\" or \"no\" as an answer."
   ()
   (lambda ()
     (let ((string (typein-string)))
       (if (or (string-ci=? "yes" string)
 	      (string-ci=? "no" string))
 	  (exit-typein-edit)
-	  (editor-error "Please enter \"Yes\" or \"No\"")))))
+	  (begin
+	    (set-typein-string! "" false)
+	    (editor-error "Please enter \"yes\" or \"no\""))))))
 
 ;;;; Command History Prompt
 
@@ -642,7 +645,7 @@ Whilst editing the command, the following commands are available:
       (execute-command-history-entry
        (read-from-string
 	(prompt-for-string "Redo"
-			   (write-to-string
+			   (command-history-entry->string
 			    (list-ref *command-history* (-1+ argument)))
 			   'INSERTED-DEFAULT
 			   (ref-mode-object repeat-complex-command)))))))
@@ -650,6 +653,10 @@ Whilst editing the command, the following commands are available:
 (define *command-history*)
 (define *command-history-index*)
 
+(define (command-history-entry->string command)
+  (fluid-let ((*unparse-with-maximum-readability?* true))
+    (write-to-string command)))
+
 (define-major-mode repeat-complex-command minibuffer-local #f
   "Major mode for editing command history.")
 
@@ -670,7 +677,9 @@ Whilst editing the command, the following commands are available:
 			    "No preceeding item in command history")))
       (set! *command-history-index* index)
       (set-typein-string!
-       (write-to-string (list-ref *command-history* (-1+ index))))      (set-current-point! (buffer-start (current-buffer))))))
+       (command-history-entry->string (list-ref *command-history* (-1+ index)))
+       true)
+      (set-current-point! (buffer-start (current-buffer))))))
 
 (define-command previous-complex-command
   "Inserts the next element of `command-history' into the minibuffer."
diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm
index 8528d77dd..855d3194a 100644
--- a/v7/src/edwin/schmod.scm
+++ b/v7/src/edwin/schmod.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.12 1989/08/07 08:45:12 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.13 1989/08/09 13:18:07 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -57,17 +57,13 @@
 \\[lisp-indent-line] indents the current line for Scheme.
 \\[indent-sexp] indents the next s-expression.
 
-\\[eval-previous-sexp-into-buffer] evaluates the expression preceding point.
-    All output is inserted into the buffer at point.
-\\[eval-expression] reads and evaluates an expression in the typein window.
-
-The following evaluation commands keep a transcript of all output in
-the buffer *Transcript*:
+The following commands evaluate Scheme expressions;
+normally they record the associated output in a transcript buffer:
 
+\\[eval-expression] reads and evaluates an expression in minibuffer.
+\\[eval-previous-sexp] evaluates the expression preceding point.
 \\[eval-definition] evaluates the current definition.
 \\[eval-buffer] evaluates the buffer.
-\\[eval-next-sexp] evaluates the expression following point.
-\\[eval-previous-sexp] evaluates the expression preceding point.
 \\[eval-region] evaluates the current region."
 
   (local-set-variable! syntax-table scheme-mode:syntax-table)
@@ -93,23 +89,22 @@ the buffer *Transcript*:
 (define-key 'scheme #\) 'lisp-insert-paren)
 (define-key 'scheme #\m-o 'eval-buffer)
 (define-key 'scheme #\m-z 'eval-definition)
-(define-key 'scheme #\c-m-= 'eval-previous-sexp-into-buffer)
 (define-key 'scheme #\c-m-q 'indent-sexp)
-(define-key 'scheme #\c-m-x 'eval-expression)
 (define-key 'scheme #\c-m-z 'eval-region)
 
 ;;;; Read Syntax
 
 (define scheme-mode:syntax-table (make-syntax-table))
 
-(modify-syntax-entries! scheme-mode:syntax-table #\NUL #\/ "_")
+(modify-syntax-entries! scheme-mode:syntax-table #\nul #\/ "_")
 (modify-syntax-entries! scheme-mode:syntax-table #\: #\@ "_")
 (modify-syntax-entries! scheme-mode:syntax-table #\[ #\` "_")
-(modify-syntax-entries! scheme-mode:syntax-table #\{ #\Rubout "_")
+(modify-syntax-entries! scheme-mode:syntax-table #\{ #\rubout "_")
 
-(modify-syntax-entry! scheme-mode:syntax-table #\Space " ")
-(modify-syntax-entry! scheme-mode:syntax-table #\Tab " ")
-(modify-syntax-entry! scheme-mode:syntax-table #\Page " ")(modify-syntax-entry! scheme-mode:syntax-table #\[ " ")
+(modify-syntax-entry! scheme-mode:syntax-table #\space " ")
+(modify-syntax-entry! scheme-mode:syntax-table #\tab " ")
+(modify-syntax-entry! scheme-mode:syntax-table #\page " ")
+(modify-syntax-entry! scheme-mode:syntax-table #\[ " ")
 (modify-syntax-entry! scheme-mode:syntax-table #\] " ")
 (modify-syntax-entry! scheme-mode:syntax-table #\{ " ")
 (modify-syntax-entry! scheme-mode:syntax-table #\} " ")
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index e0ad858fd..e7689aa6e 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.8 1989/08/07 08:45:16 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/unix.scm,v 1.9 1989/08/09 13:18:11 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -271,4 +271,36 @@ Includes the new backup.  Must be > 0"
   (list-copy
    '(".o" ".elc" "~" ".bin" ".lbin" ".fasl"
      ".dvi" ".toc" ".log" ".aux"
-     ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot")))
\ No newline at end of file
+     ".lof" ".blg" ".bbl" ".glo" ".idx" ".lot")))
+
+(define (os/file-type-to-major-mode)
+  (alist-copy
+   `(("article" . text)
+     ("asm" . midas)
+     ("bib" . text)
+     ("c" . c)
+     ("cc" . c)
+     ("h" . c)
+     ("pas" . pascal)
+     ("s" . scheme)
+     ("scm" . scheme)
+     ("text" . text)
+     ("txi" . texinfo)
+     ("txt" . text)
+     ("y" . c))))
+
+(define (os/truncate-filename-for-modeline filename width)
+  (let ((length (string-length filename)))
+    (if (< 0 width length)
+	(let ((result
+	       (substring
+		filename
+		(let ((index (- length width)))
+		  (or (and (not (char=? #\/ (string-ref filename index)))
+			   (substring-find-next-char filename index length
+						     #\/))
+		      (1+ index)))
+		length)))
+	  (string-set! result 0 #\$)
+	  result)
+	filename)))
\ No newline at end of file
diff --git a/v7/src/edwin/utils.scm b/v7/src/edwin/utils.scm
index 3d3277ceb..6da9dbebc 100644
--- a/v7/src/edwin/utils.scm
+++ b/v7/src/edwin/utils.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utils.scm,v 1.15 1989/04/28 22:54:22 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utils.scm,v 1.16 1989/08/09 13:18:15 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -171,4 +171,14 @@
 	 (lambda (condition)
 	   condition
 	   (continuation (if-error)))
-       thunk))))
\ No newline at end of file
+       thunk))))
+
+(define (write-value value truncate?)
+  (if (undefined-value? value)
+      (write-string ";No value")
+      (begin
+	(write-string ";Value: ")	(if truncate?
+	    (fluid-let ((*unparser-list-depth-limit* 5)
+			(*unparser-list-breadth-limit* 10))
+	      (write value))
+	    (write value)))))
\ No newline at end of file
diff --git a/v7/src/edwin/winout.scm b/v7/src/edwin/winout.scm
index 4bf53e431..413956d63 100644
--- a/v7/src/edwin/winout.scm
+++ b/v7/src/edwin/winout.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/winout.scm,v 1.3 1989/04/28 22:54:48 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/winout.scm,v 1.4 1989/08/09 13:18:18 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -43,6 +43,7 @@
 ;;;
 
 ;;;; Buffer I/O Ports
+;;; package: (edwin window-output-port)
 
 (declare (usual-integrations))
 
@@ -60,6 +61,19 @@
 (define (window-output-port window)
   (output-port/copy window-output-port-template window))
 
+(define (operation/fresh-line port)
+  (if (not (line-start? (window-point (output-port/state port))))
+      (operation/write-char port #\newline)))
+
+(define (operation/fresh-lines port n)
+  (let loop
+      ((n
+	(if (line-start? (window-point (output-port/state port))) (-1+ n) n)))
+    (if (positive? n)
+	(begin
+	  (operation/write-char port #\newline)
+	  (loop (-1+ n))))))
+
 (define (operation/write-char port char)
   (let ((window (output-port/state port)))
     (let ((buffer (window-buffer window))
@@ -112,7 +126,10 @@
   (unparse-object state (output-port/state port)))
 
 (define window-output-port-template
-  (make-output-port `((FLUSH-OUTPUT ,operation/flush-output)		      (PRINT-SELF ,operation/print-self)
+  (make-output-port `((FLUSH-OUTPUT ,operation/flush-output)
+		      (FRESH-LINE ,operation/fresh-line)
+		      (FRESH-LINES ,operation/fresh-lines)
+		      (PRINT-SELF ,operation/print-self)
 		      (WRITE-CHAR ,operation/write-char)
 		      (WRITE-STRING ,operation/write-string))
 		    false))
\ No newline at end of file
-- 
2.25.1