From 06275ddfbabd0c5685d625f9012c9894d497b810 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 7 Aug 1989 08:45:16 +0000
Subject: [PATCH] * Implemented new editor-based debugger, which uses the
 standard debugger to generate its presentations (by means of new hooks in the
 runtime system).  The debugger can be invoked manually by the command
 `browse-continuation', or automatically by setting one of the following
 variables true:

debug-on-evaluation-error	error during evaluation
debug-on-editor-error		editor error (user error)
debug-on-internal-error		editor bug

Normally `debug-on-evaluation-error' is true and the others are false.

* Controlification redone so that controlification of all ASCII
control characters is uniform.  Previously characters such as newline
and page were handled specially.  The net result of this is that
controlification of an ASCII control character has no effect.

* C-x C-c is now bound to a command which exits Scheme and returns to
the unix shell.

* All messages are cleared immediately after reading the first
character of a command key sequence.  This is similar to the action of
GNU Emacs, and prevents non-temporary messages from sticking around
for a long time.

* Dired now handles symbolic links specially, showing the file linked
to in the usual way.

* Bug fix in `clear-message': this procedure now preserves the
command-prompt; previously it was clearing both the message and the
command-prompt.

* Bug fix in "cterm": the `move-cursor!' operation must move the
cursor immediately if an update is not in effect.

* Bug fix in `revert-buffer': can't assume that the buffer being
reverted is current.

* Bug fix: `with-output-to-string' had incorrect indentation method.

* Bug fix: typo in dired sorting routine.
---
 v7/src/edwin/basic.scm  |  38 ++++++++++--
 v7/src/edwin/calias.scm |  16 ++---
 v7/src/edwin/comred.scm |   6 +-
 v7/src/edwin/decls.scm  |   3 +-
 v7/src/edwin/dired.scm  |   4 +-
 v7/src/edwin/editor.scm | 134 +++++++++++++++++++---------------------
 v7/src/edwin/edwin.ldr  |   3 +
 v7/src/edwin/edwin.pkg  |  38 ++++++++++--
 v7/src/edwin/evlcom.scm |  33 +++++++---
 v7/src/edwin/filcom.scm |  10 +--
 v7/src/edwin/input.scm  |  42 ++++++-------
 v7/src/edwin/make.scm   |   4 +-
 v7/src/edwin/modefs.scm | 110 ++++++++-------------------------
 v7/src/edwin/schmod.scm |   5 +-
 v7/src/edwin/unix.scm   |  15 ++++-
 15 files changed, 241 insertions(+), 220 deletions(-)

diff --git a/v7/src/edwin/basic.scm b/v7/src/edwin/basic.scm
index d34e23a09..fa0461fec 100644
--- a/v7/src/edwin/basic.scm
+++ b/v7/src/edwin/basic.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.100 1989/08/04 03:30:48 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/basic.scm,v 1.101 1989/08/07 08:44:14 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -109,16 +109,32 @@ procedure when it fails to find a command."
   (editor-error "Trying to modify read only text."))
 
 (define-variable debug-on-editor-error
-  "If not false, signal Scheme error when an editor error occurs."
+  "True means signal Scheme error when an editor error occurs."
   false)
 
+(define condition-type:editor-error
+  (make-error-type '()
+    (lambda (condition port)
+      (write-string "Editor error: " port)
+      (write-string (message-args->string (condition/irritants condition))
+		    port))))
+
 (define (editor-error . strings)
   (if (ref-variable debug-on-editor-error)
-      (error "editor error" (message-args->string strings))
+      (call-with-current-continuation
+       (lambda (continuation)
+	 (debug-scheme-error
+	  (make-condition condition-type:editor-error
+			  strings
+			  continuation))
+	 (%editor-error)))
       (begin
 	(if (not (null? strings)) (apply temporary-message strings))
-	(editor-beep)
-	(abort-current-command))))
+	(%editor-error))))
+
+(define (%editor-error)
+  (editor-beep)
+  (abort-current-command))
 
 (define (editor-failure . strings)
   (cond ((not (null? strings)) (apply temporary-message strings))
@@ -223,6 +239,18 @@ With argument, saves visited file first."
   ()
   (lambda ()
     (editor-abort *the-non-printing-object*)))
+
+(define-command save-buffers-kill-scheme
+  "Offer to save each buffer, then kill Scheme.
+With prefix arg, silently save all file-visiting buffers, then kill."
+  "P"
+  (lambda (no-confirmation?)
+    (save-some-buffers no-confirmation?)
+    (set! edwin-finalization
+	  (lambda ()
+	    (set! edwin-finalization false)
+	    (%exit)))    ((ref-command suspend-edwin))))
+
 (define-command exit-recursive-edit
   "Exit normally from a subsystem of a level of editing."
   ()
diff --git a/v7/src/edwin/calias.scm b/v7/src/edwin/calias.scm
index 1447615cb..b9ccf6668 100644
--- a/v7/src/edwin/calias.scm
+++ b/v7/src/edwin/calias.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/calias.scm,v 1.5 1989/04/28 22:48:15 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/calias.scm,v 1.6 1989/08/07 08:44:17 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -74,7 +74,7 @@
 	  (else char))))
 
 (define (unmap-alias-char char)
-  (if (ascii-controlified? char)
+  (if (and (ascii-controlified? char)	   (even? (quotient (char-bits char) 2)))
       (unmap-alias-char
        (make-char (let ((code (char-code char)))
 		    (+ code (if (<= #x01 code #x1A) #x60 #x40)))
@@ -87,14 +87,8 @@
 	    (unmap-alias-char (car entry))
 	    char))))
 
-(define (ascii-controlified? char)
-  (and (even? (quotient (char-bits char) 2))
-       (let ((code (char-code char)))
-	 (or (< code #x09)
-	     (= code #x0B)
-	     (if (< code #x1B)
-		 (< #x0D code)
-		 (and (< code #x20)
-		      (< #x1B code)))))))
+(define-integrable (ascii-controlified? char)
+  (< (char-code char) #x20))
+
 (define-integrable (char-name char)
   (char->name (unmap-alias-char char)))
\ No newline at end of file
diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index f6a863e7e..788dabb65 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.75 1989/08/03 01:31:16 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.76 1989/08/07 08:44:21 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -98,6 +98,7 @@
     (reset-command-state!)
     (let ((char (with-editor-interrupts-disabled keyboard-read-char)))
       (set! *command-char* char)
+      (clear-message)
       (set-command-prompt! (char-name char))
       (let ((window (current-window)))
 	(%dispatch-on-command window
@@ -132,7 +133,8 @@
   (reset-command-state!)
   (%dispatch-on-command (current-window) command false))
 
-(define-integrable (read-and-dispatch-on-char)  (dispatch-on-char (current-comtabs)
+(define (read-and-dispatch-on-char)
+  (dispatch-on-char (current-comtabs)
 		    (with-editor-interrupts-disabled keyboard-read-char)))
 
 (define (dispatch-on-char comtab char)
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index 268f7b85a..3989cd6ea 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -48,7 +48,8 @@
      "comman"
      "comred"
      "curren"
-     ;; "debug"     "debuge"
+     "debug"
+     "debuge"
      "dired"     "editor"
      "edtstr"
      "evlcom"
diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index 4582d0ed0..0543c1fef 100644
--- a/v7/src/edwin/dired.scm
+++ b/v7/src/edwin/dired.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.103 1989/08/04 03:17:42 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/dired.scm,v 1.104 1989/08/07 08:44:35 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -331,4 +331,4 @@ C-] -- abort Dired; this is like \\[kill-buffer] on this buffer."
 		  (map pathname-name-string pathnames)))))))))
 
 (define (read&sort-directory pathname)
-  (or/dired-sort-pathnames (directory-read pathname false)))
\ No newline at end of file
+  (os/dired-sort-pathnames (directory-read pathname false)))
\ No newline at end of file
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 19dc593b9..0fae32e51 100644
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.187 1989/04/28 22:49:21 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.188 1989/08/07 08:44:38 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -46,63 +46,42 @@
 
 (declare (usual-integrations))
 
-(define edwin-reset-args
-  '())
-
 (define (edwin)
   (if (not edwin-editor)
       (apply edwin-reset edwin-reset-args))
   (call-with-current-continuation
    (lambda (continuation)
-     (bind-condition-handler
-	 '()
-	 (lambda (condition)
-	   (and (not (condition/internal? condition))
-		(error? condition)
-		(if (ref-variable debug-on-error)
-		    (begin
-		     (with-output-to-temporary-buffer "*Error*"
-		       (lambda ()
-			 (format-error-message (condition/message condition)
-					       (condition/irritants condition)
-					       (current-output-port))))
-		     (editor-error "Scheme error"))
-		    (within-continuation continuation
-		      (lambda ()
-			(signal-error condition))))))
-       (lambda ()
-	 (using-screen edwin-screen
-	  (lambda ()
-	    (with-editor-input-port edwin-input-port
+     (fluid-let ((editor-abort continuation)
+		 (*auto-save-keystroke-count* 0))
+       (within-editor edwin-editor
+	 (lambda ()
+	   (using-screen edwin-screen
 	     (lambda ()
-	       (with-editor-interrupts
-		(lambda ()
-		  (within-editor edwin-editor
-		   (lambda ()
-		     (perform-buffer-initializations! (current-buffer))
-		     (dynamic-wind
-		      (lambda ()
-			(update-screens! true))
-		      (lambda ()
-			;; Should this be in a dynamic wind? -- Jinx
-			(if edwin-initialization (edwin-initialization))
-			(let ((message (cmdl-message/null)))
-			  (push-cmdl (lambda (cmdl)
-				       cmdl	;ignore
-				       (top-level-command-reader)
-				       message)
-				     false
-				     message)))
-		      (lambda ()
-			unspecific))))))))))
-	 ;; Should this be here or in a dynamic wind? -- Jinx
-	 (if edwin-finalization (edwin-finalization))))))
+	       (with-editor-input-port edwin-input-port
+		 (lambda ()
+		   (with-editor-interrupts
+		     (lambda ()
+		       (bind-condition-handler '() internal-error-handler
+			 (lambda ()
+			   (perform-buffer-initializations! (current-buffer))
+			   (dynamic-wind
+			    (lambda () (update-screens! true))
+			    (lambda ()
+			      ;; Should this be in a dynamic wind? -- Jinx
+			      (if edwin-initialization (edwin-initialization))
+			      (let ((message (cmdl-message/null)))
+				(push-cmdl (lambda (cmdl)
+					     cmdl ;ignore
+					     (top-level-command-reader)
+					     message)
+					   false
+					   message)))
+			    (lambda () unspecific)))))))))))))))  ;; Should this be here or in a dynamic wind? -- Jinx
+  (if edwin-finalization (edwin-finalization))
   unspecific)
 
-(define-variable debug-on-error
-  "*True means enter debugger if an error is signalled.
-Does not apply to editor errors."
-  false)
+(define edwin-reset-args '())
+(define editor-abort)
 
 ;; Set this before entering the editor to get something done after the
 ;; editor's dynamic environment is initialized, but before the command
@@ -113,21 +92,13 @@ Does not apply to editor errors."
 ;; reset and then reenter the editor.
 (define edwin-finalization false)
 
-(define (within-editor editor thunk)
-  (call-with-current-continuation
-   (lambda (continuation)
-     (fluid-let ((editor-continuation continuation)
-		 (recursive-edit-continuation false)
-		 (recursive-edit-level 0)
-		 (current-editor editor)
-		 (*auto-save-keystroke-count* 0))
-       (thunk)))))
-
-(define editor-continuation)
-(define recursive-edit-continuation)
-(define recursive-edit-level)
-(define current-editor)
+;;;; Recursive Edit Levels
 
+(define (within-editor editor thunk)
+  (fluid-let ((current-editor editor)
+	      (recursive-edit-continuation false)
+	      (recursive-edit-level 0))
+    (thunk)))
 (define (enter-recursive-edit)
   (let ((value
 	 (call-with-current-continuation
@@ -154,11 +125,33 @@ Does not apply to editor errors."
       (recursive-edit-continuation value)
       (editor-error "No recursive edit is in progress")))
 
-(define (editor-abort value)
-  (editor-continuation value))
+(define recursive-edit-continuation)
+(define recursive-edit-level)
+(define current-editor)
+
+;;;; Internal Errors
 
-(define *^G-interrupt-continuations*
-  '())
+(define (internal-error-handler condition)
+  (and (not (condition/internal? condition))
+       (error? condition)
+       (if (ref-variable debug-on-internal-error)
+	   (begin
+	     (debug-scheme-error condition)
+	     (message "Scheme error")
+	     (%editor-error))
+	   (exit-editor-and-signal-error condition))))
+
+(define-variable debug-on-internal-error
+  "True means enter debugger if error is signalled while the editor is running.
+This does not affect editor errors or evaluation errors."
+  false)
+
+(define (exit-editor-and-signal-error condition)
+  (within-continuation editor-abort
+    (lambda ()
+      (signal-error condition))))
+
+;;;; C-g Interrupts
 
 (define (^G-signal)
   (let ((continuations *^G-interrupt-continuations*))
@@ -177,4 +170,7 @@ Does not apply to editor errors."
 		 (thunk))))))
       (if (eq? value signal-tag)
 	  (interceptor)
-	  value))))
\ No newline at end of file
+	  value))))
+
+(define *^G-interrupt-continuations*
+  '())
\ No newline at end of file
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index d316ea367..26769942e 100644
--- a/v7/src/edwin/edwin.ldr
+++ b/v7/src/edwin/edwin.ldr
@@ -1,5 +1,7 @@
 ;;; -*-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 $
 ;;; program to load package contents
+;;; **** This program (unlike most .ldr files) is not generated by a program.
 
 (declare (usual-integrations))
 
@@ -79,6 +81,7 @@
     (load "basic" environment)
     (load "bufcom" environment)
     (load "bufmnu" (->environment '(EDWIN BUFFER-MENU)))
+    (load "debug" (->environment '(EDWIN DEBUGGER)))
     (load "evlcom" environment)
     (load "filcom" environment)
     (load "fill" environment)
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 92d62542a..bddd74bdc 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.6 1989/08/03 01:34:32 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.7 1989/08/07 08:44:45 cph Exp $
 
 Copyright (c) 1989 Massachusetts Institute of Technology
 
@@ -534,11 +534,41 @@ MIT in each case. |#
 (define-package (edwin command-summary)
   (files "keymap")
   (parent (edwin)))
-#|
+
 (define-package (edwin debugger)
   (files "debug")
-  (parent (edwin)))
-|#(define-package (edwin dired)
+  (parent (edwin))
+  (export (edwin)
+	  debug-scheme-error)
+  (import (runtime debugger)
+	  command/earlier-reduction
+	  command/earlier-subproblem
+	  command/frame
+	  command/goto
+	  command/later-reduction
+	  command/later-subproblem
+	  command/move-to-child-environment
+	  command/move-to-parent-environment
+	  command/print-environment-procedure
+	  command/print-expression
+	  command/print-reduction
+	  command/print-reductions
+	  command/return
+	  command/show-all-frames
+	  command/show-current-frame
+	  command/summarize-history
+	  dstate/environment-list
+	  make-initial-dstate
+	  show-error-info)
+  (import (runtime debugger-utilities)
+	  hook/debugger-failure
+	  hook/debugger-message
+	  hook/presentation)
+  (import (runtime rep)
+	  hook/prompt-for-confirmation
+	  hook/prompt-for-expression))
+
+(define-package (edwin dired)
   (files "dired")
   (parent (edwin))
   (export (edwin)
diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index 1ab019a12..ec3795378 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.14 1989/04/28 22:49:39 cph Rel $
+;;;	$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 $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -60,6 +60,11 @@ If false, use the default (REP loop) syntax-table."
   "The last expression evaluated in the typein window."
   false)
 
+(define-variable debug-on-evaluation-error
+  "True means enter debugger if error is signalled while evaluating.
+This does not affect editor errors."
+  true)
+
 (define-command eval-definition
   "Evaluate the definition at point.
 Prints the result in the typein window.
@@ -184,15 +189,25 @@ With an argument, prompts for the evaluation environment."
 	(lambda (condition)
 	  (and (not (condition/internal? condition))
 	       (error? condition)
-	       (begin
-		(with-output-to-temporary-buffer "*Error*"
-		  (lambda ()
-		    (format-error-message (condition/message condition)
-					  (condition/irritants condition)
-					  (current-output-port))))
-		(editor-error "Error while evaluating expression"))))
+	       (if (ref-variable debug-on-evaluation-error)
+		   (debug-scheme-error condition)
+		   (let ((string
+			  (with-output-to-string
+			    (lambda ()
+			      ((condition/reporter condition)
+			       condition
+			       (current-output-port))))))
+		     (if (and (not (string-find-next-char string #\newline))
+			      (< (string-column-length string 18) 80))
+			 (message "Evaluation error: " string)
+			 (begin
+			   (with-output-to-temporary-buffer "*error*" string)
+			   (message "Evaluation error")))))
+	       (%editor-error)))
       (lambda ()
-	(with-new-history (lambda () (scode-eval scode environment)))))))
+	(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)))
diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index dfe43511b..15709e6c5 100644
--- a/v7/src/edwin/filcom.scm
+++ b/v7/src/edwin/filcom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.136 1989/04/28 22:49:44 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.137 1989/08/07 08:44:52 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -333,9 +333,11 @@ Argument means don't offer to use auto-save file."
 				     (pathname->string pathname))))
 		 (let ((where (mark-index (buffer-point buffer))))
 		   (read-buffer buffer pathname)
-		   (set-current-point!
-		    (mark+ (buffer-start buffer) where 'LIMIT))
-		   (after-find-file buffer false))))))))
+		   (set-buffer-point!
+		    buffer
+		    (mark+ (buffer-start buffer) where 'LIMIT)))
+		 (after-find-file buffer false)))))))
+
 (define-command copy-file
   "Copy a file; the old and new names are read in the typein window.
 If a file with the new name already exists, confirmation is requested first."
diff --git a/v7/src/edwin/input.scm b/v7/src/edwin/input.scm
index 8349541a1..9589de43b 100644
--- a/v7/src/edwin/input.scm
+++ b/v7/src/edwin/input.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/input.scm,v 1.79 1989/04/28 22:50:22 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/input.scm,v 1.80 1989/08/07 08:44:56 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -56,7 +56,7 @@ State variables:
 a : there is a command prompt
 b : the command prompt is displayed
 c : there is a message
-d : the message should be erased
+d : the message should be erased (also implies it is displayed)
 
 Constraints:
 
@@ -91,8 +91,8 @@ given starting state and transition operation.
 
   012345
 0 082300
-8 08230C
-C *C230C	* is special -- see the code.
+8 08238C
+C *C23CC	* is special -- see the code.
 2 2A2302
 3 3B2300
 A 2AAB8C
@@ -165,11 +165,12 @@ B 3BAB8C
     (set-message! string)))
 
 (define (clear-message)
-  (set! command-prompt-string false)
-  (set! command-prompt-displayed? false)
-  (set! message-string false)
-  (set! message-should-be-erased? false)
-  (clear-message!))
+  (if message-string
+      (begin
+	(set! message-string false)
+	(set! message-should-be-erased? false)
+	(if (not command-prompt-displayed?)
+	    (clear-message!)))))
 
 (define editor-input-port)
 
@@ -185,26 +186,23 @@ B 3BAB8C
 (define (keyboard-peek-char)
   (if *executing-keyboard-macro?*
       (keyboard-macro-peek-char)
-      (begin
-	(read-char-preface)
-	(remap-alias-char (peek-char editor-input-port)))))
+      (keyboard-read-char-1 peek-char)))
 
 (define (keyboard-read-char)
   (set! keyboard-chars-read (1+ keyboard-chars-read))
   (if *executing-keyboard-macro?*
       (keyboard-macro-read-char)
-      (begin
-	(read-char-preface)
-	(let ((char (remap-alias-char (read-char editor-input-port))))
-	  (set! *auto-save-keystroke-count* (1+ *auto-save-keystroke-count*))
-	  (ring-push! (current-char-history) char)
-	  (if *defining-keyboard-macro?* (keyboard-macro-write-char char))
-	  char))))
+      (let ((char (keyboard-read-char-1 read-char)))
+	(set! *auto-save-keystroke-count* (1+ *auto-save-keystroke-count*))
+	(ring-push! (current-char-history) char)
+	(if *defining-keyboard-macro?* (keyboard-macro-write-char char))
+	char)))
 
 (define read-char-timeout/fast 500)
 (define read-char-timeout/slow 2000)
 
-(define-integrable (read-char-preface)
+(define (keyboard-read-char-1 read-char)
+  ;; Perform redisplay if needed.
   (if (not (keyboard-active? 0))
       (begin
 	(update-screens! false)
@@ -216,6 +214,7 @@ B 3BAB8C
 	    (begin
 	      (do-auto-save)
 	      (set! *auto-save-keystroke-count* 0)))))
+  ;; Perform the appropriate juggling of the minibuffer message.
   (cond ((within-typein-edit?)
 	 (if message-string
 	     (begin
@@ -233,4 +232,5 @@ B 3BAB8C
 	     (begin
 	       (set! command-prompt-displayed? true)
 	       (set-message! command-prompt-string))
-	     (clear-message!)))))
\ No newline at end of file
+	     (clear-message!))))
+  (remap-alias-char (read-char editor-input-port)))
\ No newline at end of file
diff --git a/v7/src/edwin/make.scm b/v7/src/edwin/make.scm
index 0fa7a9e14..6ab88b152 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.11 1989/08/03 01:34:55 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/make.scm,v 3.12 1989/08/07 08:44:59 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 11 '()))
\ No newline at end of file
+(add-system! (make-system "Edwin" 3 12 '()))
\ No newline at end of file
diff --git a/v7/src/edwin/modefs.scm b/v7/src/edwin/modefs.scm
index be1a04d90..f15628406 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.117 1989/04/28 22:51:27 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modefs.scm,v 1.118 1989/08/07 08:45:08 cph Exp $
 ;;;
 ;;;	Copyright (c) 1985, 1989 Massachusetts Institute of Technology
 ;;;
@@ -91,31 +91,11 @@ and the cdrs of which are major modes."
 (define-key 'fundamental char-set:numeric 'auto-digit-argument)
 (define-key 'fundamental #\- 'auto-negative-argument)
 
-(define-key 'fundamental #\tab 'indent-for-tab-command)
-(define-key 'fundamental #\linefeed 'newline-and-indent)
-(define-key 'fundamental #\page 'recenter)
-(define-key 'fundamental #\return 'newline)
-(define-key 'fundamental #\altmode 'meta-prefix)
 (define-key 'fundamental #\rubout 'backward-delete-char)
-
-(define-prefix-key 'fundamental #\backspace 'help-prefix)
-(define-key 'fundamental '(#\backspace #\a) 'command-apropos)
-(define-key 'fundamental '(#\backspace #\c) 'describe-key-briefly)
-(define-key 'fundamental '(#\backspace #\d) 'describe-command)
-(define-key 'fundamental '(#\backspace #\i) 'info)
-(define-key 'fundamental '(#\backspace #\k) 'describe-key)
-(define-key 'fundamental '(#\backspace #\l) 'view-lossage)
-(define-key 'fundamental '(#\backspace #\m) 'describe-mode)
-(define-key 'fundamental '(#\backspace #\t) 'help-with-tutorial)
-(define-key 'fundamental '(#\backspace #\v) 'describe-variable)
-(define-key 'fundamental '(#\backspace #\w) 'where-is)
 
 (define-key 'fundamental #\c-space 'set-mark-command)
-;!"#$
 (define-key 'fundamental #\c-% 'replace-string)
-;'()*+,
 (define-key 'fundamental #\c-- 'negative-argument)
-;./
 (define-key 'fundamental #\c-0 'digit-argument)
 (define-key 'fundamental #\c-1 'digit-argument)
 (define-key 'fundamental #\c-2 'digit-argument)
@@ -126,12 +106,10 @@ and the cdrs of which are major modes."
 (define-key 'fundamental #\c-7 'digit-argument)
 (define-key 'fundamental #\c-8 'digit-argument)
 (define-key 'fundamental #\c-9 'digit-argument)
-;:
 (define-key 'fundamental #\c-\; 'indent-for-comment)
 (define-key 'fundamental #\c-< 'mark-beginning-of-buffer)
 (define-key 'fundamental #\c-= 'what-cursor-position)
 (define-key 'fundamental #\c-> 'mark-end-of-buffer)
-;?
 (define-key 'fundamental #\c-@ 'set-mark-command)
 (define-key 'fundamental #\c-a 'beginning-of-line)
 (define-key 'fundamental #\c-b 'backward-char)
@@ -140,12 +118,12 @@ and the cdrs of which are major modes."
 (define-key 'fundamental #\c-e 'end-of-line)
 (define-key 'fundamental #\c-f 'forward-char)
 (define-key 'fundamental #\c-g 'keyboard-quit)
-;(define-prefix-key 'fundamental #\c-h 'help-prefix)
-;(define-key 'fundamental #\c-i 'indent-for-tab-command)
-;(define-key 'fundamental #\c-j 'newline-and-indent)
+(define-prefix-key 'fundamental #\c-h 'help-prefix)
+(define-key 'fundamental #\c-i 'indent-for-tab-command)
+(define-key 'fundamental #\c-j 'newline-and-indent)
 (define-key 'fundamental #\c-k 'kill-line)
-;(define-key 'fundamental #\c-l 'recenter)
-;(define-key 'fundamental #\c-m 'newline)
+(define-key 'fundamental #\c-l 'recenter)
+(define-key 'fundamental #\c-m 'newline)
 (define-key 'fundamental #\c-n 'next-line)
 (define-key 'fundamental #\c-o 'open-line)
 (define-key 'fundamental #\c-p 'previous-line)
@@ -159,28 +137,17 @@ and the cdrs of which are major modes."
 (define-prefix-key 'fundamental #\c-x 'prefix-char)
 (define-key 'fundamental #\c-y 'yank)
 (define-key 'fundamental #\c-z 'control-meta-prefix)
-;(define-key 'fundamental #\c-\[ 'meta-prefix)
-;\
+(define-key 'fundamental #\c-\[ 'meta-prefix)
 (define-key 'fundamental #\c-\] 'abort-recursive-edit)
 (define-key 'fundamental #\c-^ 'control-prefix)
 (define-key 'fundamental #\c-_ 'undo)
-;`{|}~
 (define-key 'fundamental #\c-rubout 'backward-delete-char-untabify)
 
-(define-key 'fundamental #\m-backspace 'mark-definition)
-;(define-key 'fundamental #\m-tab 'insert-tab)
-(define-key 'fundamental #\m-linefeed 'indent-new-comment-line)
-(define-key 'fundamental #\m-page 'twiddle-buffers)
-;(define-key 'fundamental #\m-return 'back-to-indentation)
-(define-key 'fundamental #\m-altmode 'eval-expression)
 (define-key 'fundamental #\m-space 'just-one-space)
-;!"#$
 (define-key 'fundamental #\m-% 'query-replace)
-;'()*+
 (define-key 'fundamental #\m-, 'tags-loop-continue)
 (define-key 'fundamental #\m-- 'auto-argument)
 (define-key 'fundamental #\m-. 'find-tag)
-;(define-key 'fundamental #\m-/ 'describe-command)
 (define-key 'fundamental #\m-0 'auto-argument)
 (define-key 'fundamental #\m-1 'auto-argument)
 (define-key 'fundamental #\m-2 'auto-argument)
@@ -191,18 +158,15 @@ and the cdrs of which are major modes."
 (define-key 'fundamental #\m-7 'auto-argument)
 (define-key 'fundamental #\m-8 'auto-argument)
 (define-key 'fundamental #\m-9 'auto-argument)
-;:
 (define-key 'fundamental #\m-\; 'indent-for-comment)
 (define-key 'fundamental #\m-< 'beginning-of-buffer)
 (define-key 'fundamental #\m-= 'count-lines-region)
 (define-key 'fundamental #\m-> 'end-of-buffer)
-;?
 (define-key 'fundamental #\m-@ 'mark-word)
 (define-key 'fundamental #\m-\[ 'backward-paragraph)
 (define-key 'fundamental #\m-\\ 'delete-horizontal-space)
 (define-key 'fundamental #\m-\] 'forward-paragraph)
 (define-key 'fundamental #\m-^ 'delete-indentation)
-;_`
 (define-key 'fundamental #\m-a 'backward-sentence)
 (define-key 'fundamental #\m-b 'backward-word)
 (define-key 'fundamental #\m-c 'capitalize-word)
@@ -216,10 +180,8 @@ and the cdrs of which are major modes."
 (define-key 'fundamental #\m-k 'kill-sentence)
 (define-key 'fundamental #\m-l 'downcase-word)
 (define-key 'fundamental #\m-m 'back-to-indentation)
-;nop
 (define-key 'fundamental #\m-q 'fill-paragraph)
 (define-key 'fundamental #\m-r 'move-to-window-line)
-;s
 (define-key 'fundamental #\m-t 'transpose-words)
 (define-key 'fundamental #\m-u 'upcase-word)
 (define-key 'fundamental #\m-v 'scroll-down)
@@ -227,7 +189,6 @@ and the cdrs of which are major modes."
 (define-key 'fundamental #\m-x 'execute-extended-command)
 (define-key 'fundamental #\m-y 'yank-pop)
 (define-key 'fundamental #\m-z 'zap-to-char)
-;{|}
 (define-key 'fundamental #\m-~ 'not-modified)
 (define-key 'fundamental #\m-rubout 'backward-kill-word)
 
@@ -243,61 +204,54 @@ and the cdrs of which are major modes."
 (define-key 'fundamental #\c-m-8 'digit-argument)
 (define-key 'fundamental #\c-m-9 'digit-argument)
 (define-key 'fundamental #\c-m-- 'negative-argument)
-
 (define-key 'fundamental #\c-m-\\ 'indent-region)
 (define-key 'fundamental #\c-m-^ 'delete-indentation)
 (define-key 'fundamental #\c-m-\( 'backward-up-list)
 (define-key 'fundamental #\c-m-\) 'up-list)
 (define-key 'fundamental #\c-m-@ 'mark-sexp)
 (define-key 'fundamental #\c-m-\; 'kill-comment)
-
+(define-key 'fundamental #\c-m-\[ 'eval-expression)
 (define-key 'fundamental #\c-m-a 'beginning-of-definition)
 (define-key 'fundamental #\c-m-b 'backward-sexp)
 (define-key 'fundamental #\c-m-c 'exit-recursive-edit)
 (define-key 'fundamental #\c-m-d 'down-list)
 (define-key 'fundamental #\c-m-e 'end-of-definition)
 (define-key 'fundamental #\c-m-f 'forward-sexp)
-;G
 (define-key 'fundamental #\c-m-h 'mark-definition)
-;I
-;(define-key 'fundamental #\c-m-j 'indent-new-comment-line)
+(define-key 'fundamental #\c-m-j 'indent-new-comment-line)
 (define-key 'fundamental #\c-m-k 'kill-sexp)
-;(define-key 'fundamental #\c-m-l 'twiddle-buffers)
-;M
+(define-key 'fundamental #\c-m-l 'twiddle-buffers)
 (define-key 'fundamental #\c-m-n 'forward-list)
 (define-key 'fundamental #\c-m-o 'split-line)
 (define-key 'fundamental #\c-m-p 'backward-list)
-;Q
 (define-key 'fundamental #\c-m-r 'align-definition)
 (define-key 'fundamental #\c-m-s 'isearch-forward-regexp)
 (define-key 'fundamental #\c-m-t 'transpose-sexps)
 (define-key 'fundamental #\c-m-u 'backward-up-list)
 (define-key 'fundamental #\c-m-v 'scroll-other-window)
 (define-key 'fundamental #\c-m-w 'append-next-kill)
-;XYZ
 (define-key 'fundamental #\c-m-rubout 'backward-kill-sexp)
-;backspace
-(define-key 'fundamental '(#\c-x #\tab) 'indent-rigidly)
-;linefeed
-(define-key 'fundamental '(#\c-x #\page) 'downcase-region)
-;return
-(define-key 'fundamental '(#\c-x #\altmode) 'repeat-complex-command)
-;A
+(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)
+(define-key 'fundamental '(#\c-h #\m) 'describe-mode)
+(define-key 'fundamental '(#\c-h #\t) 'help-with-tutorial)
+(define-key 'fundamental '(#\c-h #\v) 'describe-variable)
+(define-key 'fundamental '(#\c-h #\w) 'where-is)
+
+(define-key 'fundamental '(#\c-x #\c-\[) 'repeat-complex-command)
 (define-key 'fundamental '(#\c-x #\c-b) 'list-buffers)
-;C
+(define-key 'fundamental '(#\c-x #\c-c) 'save-buffers-kill-scheme)
 (define-key 'fundamental '(#\c-x #\c-d) 'list-directory)
 (define-key 'fundamental '(#\c-x #\c-e) 'eval-previous-sexp)
 (define-key 'fundamental '(#\c-x #\c-f) 'find-file)
-;GH
-;(define-key 'fundamental '(#\c-x #\c-i) 'indent-rigidly)
-;JK
-;(define-key 'fundamental '(#\c-x #\c-l) 'downcase-region)
-;M
+(define-key 'fundamental '(#\c-x #\c-i) 'indent-rigidly)
+(define-key 'fundamental '(#\c-x #\c-l) 'downcase-region)
 (define-key 'fundamental '(#\c-x #\c-n) 'set-goal-column)
 (define-key 'fundamental '(#\c-x #\c-o) 'delete-blank-lines)
 (define-key 'fundamental '(#\c-x #\c-p) 'mark-page)
 (define-key 'fundamental '(#\c-x #\c-q) 'toggle-read-only)
-;R
 (define-key 'fundamental '(#\c-x #\c-s) 'save-buffer)
 (define-key 'fundamental '(#\c-x #\c-t) 'transpose-lines)
 (define-key 'fundamental '(#\c-x #\c-u) 'upcase-region)
@@ -305,16 +259,13 @@ and the cdrs of which are major modes."
 (define-key 'fundamental '(#\c-x #\c-w) 'write-file)
 (define-key 'fundamental '(#\c-x #\c-x) 'exchange-point-and-mark)
 (define-key 'fundamental '(#\c-x #\c-z) 'suspend-scheme)
-;!"#$%&'
 (define-key 'fundamental '(#\c-x #\() 'start-kbd-macro)
 (define-key 'fundamental '(#\c-x #\)) 'end-kbd-macro)
-;*+,-
 (define-key 'fundamental '(#\c-x #\.) 'set-fill-prefix)
 (define-key 'fundamental '(#\c-x #\/) 'point-to-register)
 (define-key 'fundamental '(#\c-x #\0) 'delete-window)
 (define-key 'fundamental '(#\c-x #\1) 'delete-other-windows)
 (define-key 'fundamental '(#\c-x #\2) 'split-window-vertically)
-;(define-key 'fundamental '(#\c-x #\3) 'kill-pop-up-buffer)
 (define-prefix-key 'fundamental '(#\c-x #\4) 'prefix-char)
 (define-key 'fundamental '(#\c-x #\4 #\c-f) 'find-file-other-window)
 (define-key 'fundamental '(#\c-x #\4 #\.) 'find-tag-other-window)
@@ -322,19 +273,12 @@ and the cdrs of which are major modes."
 (define-key 'fundamental '(#\c-x #\4 #\d) 'dired-other-window)
 (define-key 'fundamental '(#\c-x #\4 #\f) 'find-file-other-window)
 (define-key 'fundamental '(#\c-x #\5) 'split-window-horizontally)
-;:
 (define-key 'fundamental '(#\c-x #\;) 'set-comment-column)
-;<
 (define-key 'fundamental '(#\c-x #\=) 'what-cursor-position)
-;>?
 (define-key 'fundamental '(#\c-x #\[) 'backward-page)
-;\
 (define-key 'fundamental '(#\c-x #\]) 'forward-page)
 (define-key 'fundamental '(#\c-x #\^) 'enlarge-window)
-;_`
-;a
-(define-key 'fundamental '(#\c-x #\b) 'switch-to-buffer);c
-(define-key 'fundamental '(#\c-x #\d) 'dired)
+(define-key 'fundamental '(#\c-x #\b) 'switch-to-buffer)(define-key 'fundamental '(#\c-x #\d) 'dired)
 (define-key 'fundamental '(#\c-x #\e) 'call-last-kbd-macro)
 (define-key 'fundamental '(#\c-x #\f) 'set-fill-column)
 (define-key 'fundamental '(#\c-x #\g) 'insert-register)
@@ -343,7 +287,6 @@ and the cdrs of which are major modes."
 (define-key 'fundamental '(#\c-x #\j) 'register-to-point)
 (define-key 'fundamental '(#\c-x #\k) 'kill-buffer)
 (define-key 'fundamental '(#\c-x #\l) 'count-lines-page)
-;m
 (define-key 'fundamental '(#\c-x #\n) 'narrow-to-region)
 (define-key 'fundamental '(#\c-x #\o) 'other-window)
 (define-key 'fundamental '(#\c-x #\p) 'narrow-to-page)
@@ -352,12 +295,9 @@ and the cdrs of which are major modes."
 (define-key 'fundamental '(#\c-x #\s) 'save-some-buffers)
 ;(define-key 'fundamental '(#\c-x #\t) 'transpose-regions)
 (define-key 'fundamental '(#\c-x #\u) 'undo)
-;v
 (define-key 'fundamental '(#\c-x #\w) 'widen)
 (define-key 'fundamental '(#\c-x #\x) 'copy-to-register)
-;y
 (define-key 'fundamental '(#\c-x #\z) 'suspend-edwin)
 (define-key 'fundamental '(#\c-x #\{) 'shrink-window-horizontally)
-;|
 (define-key 'fundamental '(#\c-x #\}) 'enlarge-window-horizontally)
-;~(define-key 'fundamental '(#\c-x #\rubout) 'backward-kill-sentence)
\ No newline at end of file
+(define-key 'fundamental '(#\c-x #\rubout) 'backward-kill-sentence)
\ No newline at end of file
diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm
index 4ce3df031..8528d77dd 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.11 1989/05/16 18:52:49 cph Rel $
+;;;	$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 $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -178,7 +178,8 @@ the buffer *Transcript*:
 	    (WITH-INPUT-FROM-PORT . 1)
 	    (WITH-INPUT-FROM-STRING . 1)
 	    (WITH-OUTPUT-TO-PORT . 1)
-	    (WITH-OUTPUT-TO-STRING . 1)	    (WITH-VALUES . 1)
+	    (WITH-OUTPUT-TO-STRING . 0)
+	    (WITH-VALUES . 1)
 
 	    (BIND-CONDITION-HANDLER . 2)
 	    (LIST-TRANSFORM-POSITIVE . 1)
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 1babfd304..e0ad858fd 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.7 1989/08/04 03:17:28 cph Exp $
+;;;	$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 $
 ;;;
 ;;;	Copyright (c) 1989 Massachusetts Institute of Technology
 ;;;
@@ -209,11 +209,20 @@ Includes the new backup.  Must be > 0"
 		     4
 		     16)
 	  " "
-	  (pathname-name-string pathname)))))
+	  (pathname-name-string pathname)
+	  (let ((type (file-attributes/type attributes)))
+	    (if (string? type)
+		(string-append " -> " type)
+		""))))))
 
 (define (os/dired-filename-region lstart)
   (let ((lend (line-end lstart 0)))
-    (char-search-backward #\Space lend lstart 'LIMIT)    (make-region (re-match-end 0) lend)))
+    (if (not (re-search-forward
+	      "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\) +[0-9]+ +[0-9:]+ "
+	      lstart
+	      lend))
+	(editor-error "No filename on this line"))
+    (make-region (re-match-end 0) lend)))
 
 (define (os/dired-sort-pathnames pathnames)
   (sort pathnames
-- 
2.25.1