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.

diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index 7bf0bf2dad57abeaafe3fa3b832674e6c8cfeca3..e88023797faa6a534434b446f86b2a035a3cefc7 100644 (file)
--- 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))
 \f
 (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 95e2e89b612dbbd41f13804f103a163d88499c79..8d5235c6150fc85781cbb9a60cb37eeb551470e6 100644 (file)
--- 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)