From c1daa593eb6dfab9524c323a7ec51e9c95334937 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 8 Apr 1992 17:57:48 +0000
Subject: [PATCH] Support to permit evaluation commands to work more like those
 in the Emacs interface.

* Add new variable EVALUATE-IN-INFERIOR-REPL.  If true (default is
  false), the evaluation commands operate by transmitting expressions
  to an inferior REPL.  The REPL used is the least-recently-started
  inferior REPL (usually the one started when the editor is first
  entered).  When this variable is true, the RUN-LIGHT in Scheme
  buffers is that of the inferior REPL.

* Evaluation commands no longer recognize the prefix argument to have
  special meaning.

* The default value of MODE-LINE-PROCESS no longer displays RUN-LIGHT.
  This is bound in Scheme mode now.

* The commands M-x set-environment and M-x set-syntax-table now bind
  the associated variables locally in the current buffer.
  Additionally, they may locally bind the variable
  EVALUATE-IN-INFERIOR-REPL to false if the buffer has local
  definitions of environment or syntax-table.

* When EVALUATE-IN-INFERIOR-REPL is true, C-c C-c will signal a ^G
  interrupt to the inferior REPL when typed in any Scheme mode buffer.

* Add kill-buffer hooks to allow arbitrary actions to be executed when
  a buffer is killed.  Change inferior REPL support to use this
  mechanism to kill the inferior REPL thread when its buffer is
  killed.
---
 v7/src/edwin/comred.scm |   4 +-
 v7/src/edwin/curren.scm |  10 +-
 v7/src/edwin/edwin.pkg  |   5 +-
 v7/src/edwin/evlcom.scm | 294 +++++++++++++++++++++++-----------------
 v7/src/edwin/filcom.scm |   6 +-
 v7/src/edwin/intmod.scm | 157 ++++++++++++++-------
 v7/src/edwin/modlin.scm |   7 +-
 v7/src/edwin/schmod.scm |  25 ++--
 8 files changed, 313 insertions(+), 195 deletions(-)

diff --git a/v7/src/edwin/comred.scm b/v7/src/edwin/comred.scm
index 106715326..0726907b9 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.92 1992/02/17 22:08:30 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comred.scm,v 1.93 1992/04/08 17:57:38 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -391,7 +391,7 @@
   (apply (command-procedure (name->command (car entry)))
 	 (map (let ((environment (->environment '(EDWIN))))
 		(lambda (expression)
-		  (eval-with-history expression environment)))
+		  (eval-with-history (current-buffer) expression environment)))
 	      (cdr entry))))
 
 (define (interactive-argument key prompt)
diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index 2d46db3cb..90e183041 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.101 1992/04/05 02:33:05 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/curren.scm,v 1.102 1992/04/08 17:57:39 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -366,8 +366,14 @@
 	      (hangup-process process true)
 	      (set-process-buffer! process false))
 	    (buffer-processes buffer))
-  (kill-buffer-inferior-repl buffer)
+  (for-each (lambda (hook) (hook buffer))
+	    (buffer-get buffer 'KILL-BUFFER-HOOKS))
   (bufferset-kill-buffer! (current-bufferset) buffer))
+
+(define (add-kill-buffer-hook buffer hook)
+  (let ((hooks (or (buffer-get buffer 'KILL-BUFFER-HOOKS) '())))
+    (if (not (memq hook hooks))
+	(buffer-put! buffer 'KILL-BUFFER-HOOKS (cons hook hooks)))))
 
 (define (select-buffer buffer)
   (set-window-buffer! (current-window) buffer true))
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index ca009da67..18bf14d9e 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.84 1992/04/06 20:13:54 bal Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.85 1992/04/08 17:57:40 cph Exp $
 
 Copyright (c) 1989-92 Massachusetts Institute of Technology
 
@@ -974,6 +974,7 @@ MIT in each case. |#
   (files "intmod")
   (parent (edwin))
   (export (edwin)
+	  current-repl-buffer
 	  edwin-command$inferior-cmdl-abort-nearest
 	  edwin-command$inferior-cmdl-abort-previous
 	  edwin-command$inferior-cmdl-abort-top-level
@@ -987,6 +988,8 @@ MIT in each case. |#
 	  edwin-mode$inferior-repl
 	  edwin-variable$repl-enable-transcript-buffer
 	  edwin-variable$repl-error-decision
+	  inferior-repl-eval-expression
+	  inferior-repl-eval-region
 	  initialize-inferior-repls!
 	  kill-buffer-inferior-repl
 	  start-inferior-repl!))
diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index 50694537c..5bcbbb573 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.35 1992/02/18 16:00:30 markf Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.36 1992/04/08 17:57:42 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -55,7 +55,7 @@ If 'DEFAULT, use the default (REP loop) environment."
   'DEFAULT)
 
 (define-variable scheme-syntax-table
-  "The syntax table used by the evaluation commands, or #F
+  "The syntax table used by the evaluation commands, or #F.
 If #F, use the default (REP loop) syntax-table."
   false)
 
@@ -107,81 +107,124 @@ If #F, normal transcript output is done."
   "List breadth to which evaluation results are printed.  #F means no limit."
   false
   (lambda (object) (or (not object) (exact-nonnegative-integer? object))))
+
+(define-variable evaluate-in-inferior-repl
+  "If true, evaluation commands evaluate expressions in an inferior REPL.
+Also, the inferior REPL's run light appears in all Scheme mode buffers.
+Otherwise, expressions are evaluated directly by the commands."
+  false
+  boolean?)
 
 ;;;; Commands
 
 (define-command eval-defun
   "Evaluate defun that point is in or before.
-Print value in minibuffer.
-With argument, prompts for the evaluation environment."
-  "P"
-  (lambda (argument)
-    (evaluate-from-mark (current-definition-start) argument)))
+Print value in minibuffer."
+  ()
+  (lambda () (evaluate-from-mark (current-definition-start))))
 
 (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."
-  "P"
-  (lambda (argument)
-    (evaluate-from-mark (current-point) argument)))
+Prints the result in the typein window."
+  ()
+  (lambda () (evaluate-from-mark (current-point))))
 
 (define-command eval-last-sexp
   "Evaluate the expression preceding point.
-Prints the result in the typein window.
-With an argument, prompts for the evaluation environment."
-  "P"
-  (lambda (argument)
-    (evaluate-from-mark (backward-sexp (current-point) 1 'ERROR) argument)))
+Prints the result in the typein window."
+  ()
+  (lambda () (evaluate-from-mark (backward-sexp (current-point) 1 'ERROR))))
+
+(define (evaluate-from-mark input-mark)
+  ((ref-command eval-region)
+   (make-region input-mark
+		(forward-sexp input-mark 1 'ERROR))))
 
 (define-command eval-region
   "Evaluate the region, printing the results in the typein window.
 With an argument, prompts for the evaluation environment."
-  "r\nP"
-  (lambda (region argument)
-    (evaluate-region region argument)))
+  "r"
+  (lambda (region)
+    (let ((buffer (mark-buffer (region-start region))))
+      (if (ref-variable evaluate-in-inferior-repl buffer)
+	  (inferior-repl-eval-region (current-repl-buffer) region)
+	  (evaluate-region region (evaluation-environment buffer))))))
 
 (define-command eval-current-buffer
   "Evaluate the current buffer.
-The values are printed in the typein window.
-With an argument, prompts for the evaluation environment."
-  "P"
-  (lambda (argument)
-    (evaluate-region (buffer-region (current-buffer)) argument)))
+The values are printed in the typein window."
+  ()
+  (lambda () ((ref-command eval-region) (buffer-region (current-buffer)))))
 
 (define-command eval-expression
-  "Read and evaluate an expression in the typein window.
-With an argument, prompts for the evaluation environment."
-  "xEvaluate expression\nP"
-  (lambda (expression argument)
-    (let ((enable-transcript-buffer (ref-variable enable-transcript-buffer)))
-      (if enable-transcript-buffer
-	  (insert-string
-	   (fluid-let ((*unparse-with-maximum-readability?* true))
-	     (write-to-string expression))
-	   (buffer-end (transcript-buffer)))))
-    (editor-eval expression (evaluation-environment argument))))
+  "Read and evaluate an expression in the typein window."
+  "xEvaluate expression"
+  (lambda (expression)
+    (let ((buffer (current-buffer)))
+      (if (ref-variable evaluate-in-inferior-repl buffer)
+	  (inferior-repl-eval-expression (current-repl-buffer) expression)
+	  (begin
+	    (if (ref-variable enable-transcript-buffer buffer)
+		(insert-string
+		 (fluid-let ((*unparse-with-maximum-readability?* true))
+		   (write-to-string expression))
+		 (buffer-end (transcript-buffer))))
+	    (editor-eval buffer
+			 expression
+			 (evaluation-environment buffer)))))))
+
+(define-command eval-abort-top-level
+  "Force the evaluation REPL up to top level.
+Has no effect if evaluate-in-inferior-repl is false."
+  ()
+  (lambda ()
+    (let ((buffer (current-buffer)))
+      (if (ref-variable evaluate-in-inferior-repl buffer)
+	  ((ref-command inferior-cmdl-abort-top-level))
+	  (editor-error "Nothing to abort.")))))
 
 (define-command set-environment
   "Make ENVIRONMENT the current evaluation environment."
   "XSet environment"
   (lambda (environment)
-    (set-variable! scheme-environment
-		   (or (and (eq? environment 'DEFAULT) 'DEFAULT)
-		       (->environment environment)))))
+    (let ((buffer (current-buffer)))
+      (define-variable-local-value! buffer
+	(ref-variable-object scheme-environment)
+	(if (eq? environment 'DEFAULT)
+	    'DEFAULT
+	    (->environment environment)))
+      (normal-buffer-evaluation-mode buffer))))
 
 (define-command set-syntax-table
   "Make SYNTAX-TABLE the current syntax table."
   "XSet syntax table"
   (lambda (syntax-table)
-    (set-variable! scheme-syntax-table syntax-table)))
+    (let ((buffer (current-buffer)))
+      (define-variable-local-value! buffer
+				    (ref-variable-object scheme-syntax-table)
+				    syntax-table)
+      (normal-buffer-evaluation-mode buffer))))
+
+(define (normal-buffer-evaluation-mode buffer)
+  (let ((evaluate-in-inferior-repl
+	 (ref-variable-object evaluate-in-inferior-repl))
+	(run-light (ref-variable-object run-light)))
+    (if (and (eq? (ref-variable scheme-environment buffer) 'DEFAULT)
+	     (memq (ref-variable scheme-syntax-table buffer) '(#F DEFAULT)))
+	(begin
+	  (undefine-variable-local-value! buffer evaluate-in-inferior-repl)
+	  (undefine-variable-local-value! buffer run-light))
+	(begin
+	  (define-variable-local-value! buffer evaluate-in-inferior-repl false)
+	  (define-variable-local-value! buffer run-light false)))))
 
 (define-command set-default-environment
   "Make ENVIRONMENT the default evaluation environment."
   "XSet default environment"
   (lambda (environment)
     (set-variable-default-value! (ref-variable-object scheme-environment)
-				 (or (and (eq? environment 'DEFAULT) 'DEFAULT)
+				 (if (eq? environment 'DEFAULT)
+				     'DEFAULT
 				     (->environment environment)))))
 
 (define-command set-default-syntax-table
@@ -212,16 +255,18 @@ With an argument, prompts for the evaluation environment."
 ;;;; 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
-			      (if (or (symbol? default)
-				      (pair? default)
-				      (vector? default))
-				  `',default
-				  default)))
-   (evaluation-environment false)))
+  (let ((buffer (current-buffer)))
+    (eval-with-history
+     buffer
+     (if (default-object? default)
+	 (prompt-for-expression prompt)
+	 (prompt-for-expression prompt
+				(if (or (symbol? default)
+					(pair? default)
+					(vector? default))
+				    `',default
+				    default)))
+     (evaluation-environment buffer))))
 
 (define (prompt-for-expression prompt #!optional default-object default-type)
   (let ((default-string
@@ -260,55 +305,52 @@ may be available.  The following commands are special to this mode:
 
 ;;;; 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 ((evaluation-input-recorder (ref-variable evaluation-input-recorder)))
-    (if evaluation-input-recorder
-	(evaluation-input-recorder region)))
-  (let ((enable-transcript-buffer (ref-variable enable-transcript-buffer)))
-    (if enable-transcript-buffer
-	(insert-region (region-start region)
-		       (region-end region)
-		       (buffer-end (transcript-buffer)))))
-  (let ((environment (evaluation-environment argument)))
-    (with-input-from-region region
+(define (evaluate-region region environment)
+  (let ((buffer (mark-buffer (region-start region))))
+    (let ((evaluation-input-recorder
+	   (ref-variable evaluation-input-recorder buffer)))
+      (if evaluation-input-recorder
+	  (evaluation-input-recorder region)))
+    (let ((enable-transcript-buffer
+	   (ref-variable enable-transcript-buffer buffer)))
+      (if enable-transcript-buffer
+	  (insert-region (region-start region)
+			 (region-end region)
+			 (buffer-end (transcript-buffer)))))
+    (bind-condition-handler (list condition-type:error)
+	evaluation-error-handler
       (lambda ()
+	(let loop
+	    ((expressions (read-expressions-from-region region))
+	     (result unspecific))
+	  (if (null? expressions)
+	      result
+	      (loop (cdr expressions)
+		    (editor-eval buffer (car expressions) environment))))))))
+
+(define (read-expressions-from-region region)
+  (with-input-from-region region
+    (lambda ()
+      (let loop ()
+	(let ((expression (read)))
+	  (if (eof-object? expression)
+	      '()
+	      (cons expression (loop))))))))
+
+(define (evaluation-environment buffer)
+  (let ((environment
+	 (ref-variable scheme-environment (or buffer (current-buffer)))))
+    (if (eq? 'DEFAULT environment)
+	(nearest-repl/environment)
 	(bind-condition-handler (list condition-type:error)
-	    evaluation-error-handler
-	  (letrec
-	      ((loop
-		(lambda (result)
-		  (let ((sexp (read)))
-		    (if (eof-object? sexp)
-			result
-			(loop (editor-eval sexp environment)))))))
-	    (lambda ()
-	      (loop unspecific))))))))
-
-(define (evaluation-environment argument)
-  (let ((->environment
-	 (lambda (object)
-	   (bind-condition-handler (list condition-type:error)
-	       (lambda (condition)
-		 condition
-		 (editor-error "Illegal environment: " object))
-	     (lambda ()
-	       (->environment object))))))
-    (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 environment)
-  (let ((syntax-table (ref-variable scheme-syntax-table)))
+	    (lambda (condition)
+	      condition
+	      (editor-error "Illegal environment: " environment))
+	  (lambda ()
+	    (->environment environment))))))
+
+(define (evaluation-syntax-table buffer environment)
+  (let ((syntax-table (ref-variable scheme-syntax-table buffer)))
     (cond ((or (not syntax-table) (eq? 'DEFAULT syntax-table))
 	   (nearest-repl/syntax-table))
 	  ((scheme-syntax-table? syntax-table)
@@ -326,16 +368,17 @@ may be available.  The following commands are special to this mode:
   (access syntax-table? system-global-environment))
 
 (define-variable run-light
-  "Scheme run light.  Not intended to be modified by users, but needed to
-kludge the mode line."
-  false)
+  "Scheme run light.  Not intended to be modified by users.
+Set by Scheme evaluation code to update the mode line."
+  false
+  (lambda (object) (or (not object) (string? object))))
 
 (define-variable enable-run-light?
-  "Whether to display the Scheme run light."
+  "If true, Scheme evaluation commands display a run light in the mode line."
   true
   boolean?)
 
-(define (editor-eval sexp environment)
+(define (editor-eval buffer sexp environment)
   (let ((core
 	 (lambda ()
 	   (with-input-from-string ""
@@ -345,9 +388,10 @@ kludge the mode line."
 			(with-output-to-string
 			  (lambda ()
 			    (set! value
-				  (eval-with-history sexp environment))))))
+				  (eval-with-history buffer sexp environment))
+			    unspecific))))
 		   (let ((evaluation-output-receiver
-			  (ref-variable evaluation-output-receiver)))
+			  (ref-variable evaluation-output-receiver buffer)))
 		     (if evaluation-output-receiver
 			 (evaluation-output-receiver value output-string)
 			 (with-output-to-transcript-buffer
@@ -355,28 +399,32 @@ kludge the mode line."
 			    (write-string output-string)
 			    (transcript-write
 			     value
-			     (and (ref-variable enable-transcript-buffer)
+			     (and (ref-variable enable-transcript-buffer
+						buffer)
 				  (transcript-buffer))))))))
 		 value))))))
-    (if (ref-variable enable-run-light?)
-	(unwind-protect
-	 (lambda ()
-	   (set-variable! run-light "eval")
-	   (for-each (lambda (window)
-		       (window-modeline-event! window 'RUN-LIGHT))
-		     (window-list))
-	   (update-screens! false))
-	 core
-	 (lambda ()
-	   (set-variable! run-light false)
-	   (for-each (lambda (window)
-		       (window-modeline-event! window 'RUN-LIGHT))
-		     (window-list))
-	   (update-screens! false)))
+    (if (ref-variable enable-run-light? buffer)
+	(let ((run-light (ref-variable-object run-light))
+	      (outside)
+	      (inside "eval"))
+	  (dynamic-wind
+	   (lambda ()
+	     (set! outside (variable-local-value buffer run-light))
+	     (set-variable-local-value! buffer run-light inside)
+	     (set! inside)
+	     (global-window-modeline-event!)
+	     (update-screens! false))
+	   core
+	   (lambda ()
+	     (set! inside (variable-local-value buffer run-light))
+	     (set-variable-local-value! buffer run-light outside)
+	     (set! outside)
+	     (global-window-modeline-event!)
+	     (update-screens! false))))
 	(core))))
 
-(define (eval-with-history expression environment)
-  (let ((syntax-table (evaluation-syntax-table environment)))
+(define (eval-with-history buffer expression environment)
+  (let ((syntax-table (evaluation-syntax-table buffer environment)))
     (bind-condition-handler (list condition-type:error)
 	evaluation-error-handler
       (lambda ()
diff --git a/v7/src/edwin/filcom.scm b/v7/src/edwin/filcom.scm
index 59527f440..ca97f00bf 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.165 1992/02/13 18:25:54 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/filcom.scm,v 1.166 1992/04/08 17:57:43 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -286,7 +286,9 @@ invocation."
       (if entry
 	  (begin
 	    (local-set-variable! scheme-environment (cadr entry))
-	    (local-set-variable! scheme-syntax-table (caddr entry)))))))
+	    (local-set-variable! scheme-syntax-table (caddr entry))
+	    (local-set-variable! evaluate-in-inferior-repl false)
+	    (local-set-variable! run-light false))))))
 
 (define-command save-buffer
   "Save current buffer in visited file if modified.  Versions described below.
diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm
index 80d303284..d8bbbadd0 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.45 1992/03/13 10:48:18 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.46 1992/04/08 17:57:45 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -53,6 +53,11 @@ This flag has effect only when ENABLE-TRANSCRIPT-BUFFER is also true."
   true
   boolean?)
 
+(define (transcript-output-mark buffer)
+  (and (ref-variable repl-enable-transcript-buffer buffer)
+       (ref-variable enable-transcript-buffer buffer)
+       (buffer-end (transcript-buffer))))
+
 (define-variable repl-error-decision
   "If true, errors in REPL evaluation force the user to choose an option.
 Otherwise, they start a nested error REPL."
@@ -62,19 +67,20 @@ Otherwise, they start a nested error REPL."
 (define-command repl
   "Run an inferior read-eval-print loop (REPL), with I/O through buffer *scheme*.
 If buffer exists, just select it; otherwise create it and start REPL.
-REPL uses current evaluation environment,
-but prefix argument means prompt for different environment."
-  "P"
-  (lambda (argument)
+REPL uses current evaluation environment."
+  ()
+  (lambda ()
     (select-buffer
      (or (find-buffer initial-buffer-name)
-	 (let ((environment (evaluation-environment argument)))
-	   (let ((buffer (create-buffer initial-buffer-name)))
-	     (start-inferior-repl! buffer
-				   environment
-				   (evaluation-syntax-table environment)
-				   false)
-	     buffer))))))
+	 (let ((current-buffer (current-buffer)))
+	   (let ((environment (evaluation-environment current-buffer)))
+	     (let ((buffer (create-buffer initial-buffer-name)))
+	       (start-inferior-repl! buffer
+				     environment
+				     (evaluation-syntax-table current-buffer
+							      environment)
+				     false)
+	       buffer)))))))
 
 (define (start-inferior-repl! buffer environment syntax-table message)
   (set-buffer-major-mode! buffer (ref-mode-object inferior-repl))
@@ -103,7 +109,19 @@ but prefix argument means prompt for different environment."
 					   user-initial-prompt)
 				message))))))))))))
 
+(define (current-repl-buffer)
+  (let ((buffer (current-buffer)))
+    (if (buffer-interface-port buffer)
+	buffer
+	(let ((buffers repl-buffers))
+	  (if (null? buffers)
+	      (error "No REPL to evaluate in."))
+	  (car buffers)))))
+
+(define repl-buffers)
+
 (define (initialize-inferior-repls!)
+  (set! repl-buffers '())
   unspecific)
 
 (define (wait-for-input port level mode)
@@ -153,18 +171,29 @@ but prefix argument means prompt for different environment."
 	      (begin
 		(set-buffer-major-mode! buffer mode)
 		(attach-buffer-interface-port! buffer port)))))))
-
+
 (define (attach-buffer-interface-port! buffer port)
+  (if (not (memq buffer repl-buffers))
+      (set! repl-buffers (append! repl-buffers (list buffer))))
   (buffer-put! buffer 'INTERFACE-PORT port)
+  (add-kill-buffer-hook buffer kill-buffer-inferior-repl)
   (define-variable-local-value! buffer
     (ref-variable-object comint-input-ring)
     (port/input-ring port))
   (set-run-light! buffer false))
 
 (define (set-run-light! buffer run?)
-  (define-variable-local-value! buffer (ref-variable-object run-light)
-    (if run? "run" "listen"))
-  (buffer-modeline-event! buffer 'RUN-LIGHT))
+  (let ((variable (ref-variable-object run-light))
+	(value (if run? "eval" "listen")))
+    (if (and (ref-variable evaluate-in-inferior-repl buffer)
+	     (eq? buffer (current-repl-buffer)))
+	(begin
+	  (undefine-variable-local-value! buffer variable)
+	  (set-variable-default-value! variable value)
+	  (global-window-modeline-event!))
+	(begin
+	  (define-variable-local-value! buffer variable value)
+	  (buffer-modeline-event! buffer 'RUN-LIGHT)))))
 
 (define-integrable (buffer-interface-port buffer)
   (buffer-get buffer 'INTERFACE-PORT))
@@ -176,7 +205,22 @@ but prefix argument means prompt for different environment."
 	  (signal-thread-event (port/thread port)
 	    (lambda ()
 	      (exit-current-thread unspecific)))
-	  (buffer-remove! buffer 'INTERFACE-PORT)))))
+	  (buffer-remove! buffer 'INTERFACE-PORT)
+	  (let ((run-light (ref-variable-object run-light)))
+	    (if (and (ref-variable evaluate-in-inferior-repl buffer)
+		     (eq? buffer (current-repl-buffer)))
+		(begin
+		  (set-variable-default-value! run-light false)
+		  (global-window-modeline-event!)))
+	    (set! repl-buffers (delq! buffer repl-buffers))
+	    (let ((buffer
+		   (and (ref-variable evaluate-in-inferior-repl buffer)
+			(current-repl-buffer))))
+	      (if buffer
+		  (let ((value (variable-local-value buffer run-light)))
+		    (undefine-variable-local-value! buffer run-light)
+		    (set-variable-default-value! run-light value)
+		    (global-window-modeline-event!)))))))))
 
 (define (error-decision repl condition)
   (if (ref-variable repl-error-decision)
@@ -287,7 +331,8 @@ Additionally, these commands abort the command loop:
 
 (define (interrupt-command interrupt)
   (lambda ()
-    (signal-thread-event (port/thread (buffer-interface-port (current-buffer)))
+    (signal-thread-event
+	(port/thread (buffer-interface-port (current-repl-buffer)))
       interrupt)))
 
 (define-command inferior-cmdl-breakpoint
@@ -322,11 +367,18 @@ Additionally, these commands abort the command loop:
   (lambda ()
     (inferior-repl-eval-from-mark (backward-sexp (current-point) 1 'ERROR))))
 
+(define (inferior-repl-eval-from-mark mark)
+  ((ref-command inferior-repl-eval-region)
+   (make-region mark (forward-sexp mark 1 'ERROR))))
+
 (define-command inferior-repl-eval-region
   "Evaluate the region."
   "r"
   (lambda (region)
-    (inferior-repl-eval-region (region-start region) (region-end region))))
+    (let ((buffer (mark-buffer (region-start region))))
+      (ring-push! (port/input-ring (buffer-interface-port buffer))
+		  (region->string region))
+      (inferior-repl-eval-region buffer region))))
 
 (define-command inferior-repl-debug
   "Select a debugger buffer to examine the current REPL state.
@@ -377,33 +429,43 @@ If this is an error, the debugger examines the error condition."
     (let ((port (buffer-interface-port (current-buffer))))
       (set-port/command-char! port (last-command-key))
       (end-input-wait port))))
-
-(define (inferior-repl-eval-from-mark mark)
-  (inferior-repl-eval-region mark (forward-sexp mark 1 'ERROR)))
-
-(define (inferior-repl-eval-region start end)
-  (let ((buffer (mark-buffer start)))
-    (let ((port (buffer-interface-port buffer)))
+
+(define (inferior-repl-eval-region buffer region)
+  (let ((mark (transcript-output-mark buffer)))
+    (if mark
+	(insert-region (region-start region)
+		       (region-end region)
+		       mark)))
+  (let ((port (buffer-interface-port buffer)))
+    (let ((end
+	   (let ((end (buffer-end buffer))
+		 (end* (region-end region)))
+	     (if (mark~ end end*)
+		 end*
+		 end))))
       (set-buffer-point! buffer end)
-      (move-mark-to! (port/mark port) end)
-      (let ((string (extract-string start end)))
-	(ring-push! (port/input-ring port) string)
-	(if (and (ref-variable repl-enable-transcript-buffer)
-		 (ref-variable enable-transcript-buffer))
-	    (insert-string string (buffer-end (transcript-buffer)))))
-      (let ((queue (port/expression-queue port)))
-	(let ((input-port (make-buffer-input-port start end)))
-	  (bind-condition-handler (list condition-type:error)
-	      evaluation-error-handler
-	    (lambda ()
-	      (let loop ()
-		(let ((sexp (read input-port)))
-		  (if (not (eof-object? sexp))
-		      (begin
-			(enqueue! queue sexp)
-			(loop))))))))
-	(if (not (queue-empty? queue))
-	    (end-input-wait port))))))
+      (move-mark-to! (port/mark port) end))
+    (let ((queue (port/expression-queue port)))
+      (bind-condition-handler (list condition-type:error)
+	  evaluation-error-handler
+	(lambda ()
+	  (for-each (lambda (expression) (enqueue! queue expression))
+		    (read-expressions-from-region region))))
+      (if (not (queue-empty? queue))
+	  (end-input-wait port)))))
+
+(define (inferior-repl-eval-expression buffer expression)
+  (let ((mark (transcript-output-mark buffer)))
+    (if mark
+	(insert-string (fluid-let ((*unparse-with-maximum-readability?* true))
+			 (write-to-string expression))
+		       mark)))
+  (let ((port (buffer-interface-port buffer)))
+    (let ((end (buffer-end buffer)))
+      (set-buffer-point! buffer end)
+      (move-mark-to! (port/mark port) end))
+    (enqueue! (port/expression-queue port) expression)
+    (end-input-wait port)))
 
 ;;;; Queue
 
@@ -559,10 +621,7 @@ If this is an error, the debugger examines the error condition."
 (define (process-output-queue port)
   (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok))
 	(mark (port/mark port))
-	(transcript-mark
-	 (and (ref-variable repl-enable-transcript-buffer)
-	      (ref-variable enable-transcript-buffer)
-	      (buffer-end (transcript-buffer)))))
+	(transcript-mark (transcript-output-mark (port/buffer port))))
     (let loop ()
       (let ((operation (dequeue!/unsafe (port/output-queue port) false)))
 	(if operation
diff --git a/v7/src/edwin/modlin.scm b/v7/src/edwin/modlin.scm
index 9123bd700..dd1e59c45 100644
--- a/v7/src/edwin/modlin.scm
+++ b/v7/src/edwin/modlin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modlin.scm,v 1.13 1992/02/14 22:30:53 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modlin.scm,v 1.14 1992/04/08 17:57:46 cph Exp $
 ;;;
 ;;;	Copyright (c) 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -99,9 +99,8 @@ other than ordinary files may change this (e.g. Info, Dired,...)"
   false)
 
 (define-variable-per-buffer mode-line-process
-  "Mode-line control for displaying info on process status.
-Normally displays the Scheme run light, if ENABLE-RUN-LIGHT? is true."
-  '(run-light (": " run-light) ""))
+  "Mode-line control for displaying info on process status."
+  false)
 
 (define-variable-per-buffer mode-line-procedure
   "Procedure used to generate the mode-line.
diff --git a/v7/src/edwin/schmod.scm b/v7/src/edwin/schmod.scm
index 14a63465a..c60cd41eb 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.25 1992/04/06 05:35:03 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/schmod.scm,v 1.26 1992/04/08 17:57:48 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -57,15 +57,13 @@
 \\[lisp-indent-line] indents the current line for Scheme.
 \\[indent-sexp] indents the next s-expression.
 
-The following commands evaluate Scheme expressions;
-normally they record the associated output in a transcript buffer:
+The following commands evaluate Scheme expressions:
 
 \\[eval-expression] reads and evaluates an expression in minibuffer.
 \\[eval-last-sexp] evaluates the expression preceding point.
 \\[eval-defun] evaluates the current definition.
 \\[eval-current-buffer] evaluates the buffer.
 \\[eval-region] evaluates the current region."
-
   (local-set-variable! syntax-table scheme-mode:syntax-table)
   (local-set-variable! syntax-ignore-comments-backwards false)
   (local-set-variable! lisp-indent-hook standard-lisp-indent-hook)
@@ -80,6 +78,7 @@ normally they record the associated output in a transcript buffer:
     (local-set-variable! paragraph-separate separate))
   (local-set-variable! paragraph-ignore-fill-prefix true)
   (local-set-variable! indent-line-procedure (ref-command lisp-indent-line))
+  (local-set-variable! mode-line-process '(RUN-LIGHT (": " RUN-LIGHT) ""))
   (event-distributor/invoke! (ref-variable scheme-mode-hook)))
 
 (define-variable scheme-mode-hook
@@ -96,6 +95,7 @@ normally they record the associated output in a transcript buffer:
 (define-key 'scheme #\c-m-q 'indent-sexp)
 (define-key 'scheme #\c-m-z 'eval-region)
 (define-key 'scheme #\m-tab 'scheme-complete-variable)
+(define-key 'scheme '(#\c-c #\c-c) 'eval-abort-top-level)
 
 ;;;; Read Syntax
 
@@ -133,14 +133,15 @@ normally they record the associated output in a transcript buffer:
 
 (define (scheme-mode:indent-let-method state indent-point normal-indent)
   (lisp-indent-special-form
-   (let ((m (parse-state-containing-sexp state)))
-     (let ((start (forward-to-sexp-start (forward-one-sexp (mark1+ m)
-							   indent-point)
-					 indent-point)))
-       (if (and start
-		(not (re-match-forward "\\s(" start)))
-	   2
-	   1)))
+   (if (let ((start
+	      (forward-to-sexp-start
+	       (forward-one-sexp (mark1+ (parse-state-containing-sexp state))
+				 indent-point)
+	       indent-point)))
+	 (and start
+	      (not (re-match-forward "\\s(" start))))
+       2
+       1)
    state indent-point normal-indent))
 
 (define scheme-mode:indent-methods (make-string-table))
-- 
2.25.1