From a6a823c6f9c47ea600d2f23268ec80d17c02ea41 Mon Sep 17 00:00:00 2001
From: Arthur Gleckler <edu/mit/csail/zurich/arthur>
Date: Wed, 28 Aug 1991 21:07:07 +0000
Subject: [PATCH] Fix various bugs with evaluation commands:

Grab the transcript buffer (and whether it's enabled) BEFORE
beginning an evaluation, because, for example, the output from the
debugger Z command would go into a completely random place (window
and buffer).

Make sure that buffers for which the transcript buffer is not enabled
do not output values to the transcript buffer.
---
 v7/src/edwin/evlcom.scm | 36 +++++++++++++++++++++---------------
 v7/src/edwin/intmod.scm | 24 +++++++++++++-----------
 2 files changed, 34 insertions(+), 26 deletions(-)

diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index 7bf0bf2da..e88023797 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.26 1991/07/19 00:38:54 arthur Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.27 1991/08/28 21:07:07 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -305,11 +305,15 @@ may be available.  The following commands are special to this mode:
   (access syntax-table? system-global-environment))
 
 (define (editor-eval sexp environment)
-  (with-output-to-transcript-buffer
-   (lambda ()
-     (let ((value (eval-with-history sexp environment)))
-       (transcript-write value)
-       value))))
+  (let ((to-transcript? (ref-variable enable-transcript-buffer)))
+    (with-output-to-transcript-buffer
+     (lambda ()
+       (let* ((buffer (transcript-buffer))
+	      (value (eval-with-history sexp environment)))
+	 (transcript-write value
+			   buffer
+			   to-transcript?)
+	 value)))))
 
 (define (eval-with-history expression environment)
   (let ((syntax-table (evaluation-syntax-table environment)))
@@ -400,7 +404,7 @@ TYPEIN or False => Error messages always appear in Typein window."
 	(lambda ()
 	  (thunk))))))
 
-(define (transcript-write value)
+(define (transcript-write value buffer to-transcript?)
   (let ((value-string
 	 (if (undefined-value? value)
 	     "No value"
@@ -412,14 +416,16 @@ TYPEIN or False => Error messages always appear in Typein window."
 			   (ref-variable transcript-list-breadth-limit)))
 		(write-to-string value))))))
     (let ((value-message (lambda () (message value-string))))
-      (if (ref-variable enable-transcript-buffer)
-	  (begin
-	    (fresh-lines 1)
-	    (write-char #\;)
-	    (write-string value-string)
-	    (fresh-lines 2)
-	    (if (null? (buffer-windows (transcript-buffer)))
-		(value-message)))
+      (if to-transcript?
+	  (with-output-to-mark
+	   (buffer-point buffer)
+	   (lambda ()
+	     (fresh-lines 1)
+	     (write-char #\;)
+	     (write-string value-string)
+	     (fresh-lines 2)
+	     (if (null? (buffer-windows buffer))
+		 (value-message))))
 	  (value-message)))))
 
 (define (transcript-buffer)
diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm
index 95e2e89b6..8d5235c61 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.38 1991/05/06 01:04:35 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/intmod.scm,v 1.39 1991/08/28 21:06:47 arthur Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
 ;;;
@@ -76,16 +76,18 @@ The history may be accessed with the following commands:
 	      (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))))
+  (let ((point (buffer-end (current-buffer))))
+    (set-current-point! point)
+    (with-output-to-mark
+     point
+     (lambda ()
+       (intercept-^G-interrupts
+	(lambda ()
+	  (fresh-line)
+	  (write-string ";Abort!")
+	  (fresh-lines 2)
+	  (^G-signal))
+	thunk)))))
 
 (define-key 'scheme-interaction #\M-p 'comint-previous-input)
 (define-key 'scheme-interaction #\M-n 'comint-next-input)
-- 
2.25.1