Fix continuation-browser bugs introduced by repl mode.

diff --git a/v7/src/edwin/artdebug.scm b/v7/src/edwin/artdebug.scm
index 3e6575d743bd6a5f3197bfdb2375d1b63bb71c4a..81c12e91281e343db29604dc630cca6ad0d11fca 100644 (file)
--- a/v7/src/edwin/artdebug.scm
+++ b/v7/src/edwin/artdebug.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/artdebug.scm,v 1.15 1991/12/05 16:18:51 markf Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/artdebug.scm,v 1.16 1992/01/09 17:55:24 cph Exp $
 ;;;
-;;;    Copyright (c) 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -388,26 +388,24 @@ Miscellany
     subproblem with its value.
 
 Use \\[kill-buffer] to quit the debugger."
-  (local-set-variable! enable-transcript-buffer true)
-  (local-set-variable! transcript-buffer-name (current-buffer))
   (local-set-variable! comint-input-ring
                       (make-ring (ref-variable comint-input-ring-size)))
   (local-set-variable! evaluation-input-recorder
                       continuation-browser-input-recorder)
-  (local-set-variable! transcript-output-wrapper
-                      continuation-browser-output-wrapper))
+  (local-set-variable! evaluation-output-receiver
+                      continuation-browser-output-receiver))
 
 (define (continuation-browser-input-recorder region)
   (ring-push! (ref-variable comint-input-ring) (region->string region)))
 
-(define (continuation-browser-output-wrapper thunk)
-  (with-output-to-mark (current-point)
-    (lambda ()
-      (intercept-^G-interrupts (lambda ()
-                                (fresh-line)
-                                (write-string ";Abort!\n\n")
-                                (^G-signal))
-                              thunk))))
+(define (continuation-browser-output-receiver value output)
+  (let ((point (mark-left-inserting-copy (current-point))))
+    (insert-string output point)
+    (guarantee-newlines 1 point)
+    (insert-string (transcript-value-prefix-string value true) point)
+    (insert-string (transcript-value-string value) point)
+    (insert-newlines 2 point)
+    (mark-temporary! point)))
 \f
 ;;; Disable EVAL-CURRENT-BUFFER in Debugger Mode.  It is inherited
 ;;; from Scheme mode but does not make sense here:

diff --git a/v7/src/edwin/evlcom.scm b/v7/src/edwin/evlcom.scm
index b28516e105559f261c1aae26f2b97d0484cf2254..f5aa5e47b2633498180d8caec2273525929ee9ef 100644 (file)
--- a/v7/src/edwin/evlcom.scm
+++ b/v7/src/edwin/evlcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.32 1991/12/05 16:20:16 markf Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/evlcom.scm,v 1.33 1992/01/09 17:55:35 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -71,10 +71,10 @@ If #F, disables input recording."
   false)
 
 (define-variable evaluation-output-receiver
-  "A procedure that is called with the value and the output (as a string)
-resulting from evaluation.
-If #F, the output will be thrown in the bit bucket, unless 
-ENABLE-TRANSCRIPT-BUFFER is true."
+  "Procedure to call with the value and output from evaluation.
+The value is an object, and the output is a string.
+If #F, the value is printed in the typein window,
+and the output, if non-null, is shown in a pop-up buffer."
   false)
 
 (define-variable enable-transcript-buffer
@@ -99,14 +99,12 @@ If #F, normal transcript output is done."
   false)
 
 (define-variable transcript-list-depth-limit
-  "List depth to which evaluation results are printed in the transcript
-buffer.  #F means no limit."
+  "List depth to which evaluation results are printed.  #F means no limit."
   false
   (lambda (object) (or (not object) (exact-nonnegative-integer? object))))
 
 (define-variable transcript-list-breadth-limit
-  "List breadth to which evaluation results are printed in the transcript
-buffer.  #F means no limit."
+  "List breadth to which evaluation results are printed.  #F means no limit."
   false
   (lambda (object) (or (not object) (exact-nonnegative-integer? object))))
 \f
@@ -348,17 +346,15 @@ kludge the mode line."
                   (let ((evaluation-output-receiver
                          (ref-variable evaluation-output-receiver)))
                     (if evaluation-output-receiver
-                        (evaluation-output-receiver
-                         value
-                         output-string)))
-                  (with-output-to-transcript-buffer
-                   (lambda ()
-                     (write-string output-string)
-                     (transcript-write
-                      value
-                      (and (ref-variable enable-transcript-buffer)
-                           (transcript-buffer)))
-                     value)))))))))
+                        (evaluation-output-receiver value output-string)
+                        (with-output-to-transcript-buffer
+                         (lambda ()
+                           (write-string output-string)
+                           (transcript-write
+                            value
+                            (and (ref-variable enable-transcript-buffer)
+                                 (transcript-buffer))))))))
+                value))))))
     (if (ref-variable enable-run-light?)
        (dynamic-wind
         (lambda ()
@@ -460,12 +456,8 @@ FIT           Error messages appear in typein window if they fit;
 (define (transcript-write value buffer)
   (let ((value-string
         (string-append
-         (transcript-value-string value false)
-         (fluid-let ((*unparser-list-depth-limit*
-                      (ref-variable transcript-list-depth-limit))
-                     (*unparser-list-breadth-limit*
-                      (ref-variable transcript-list-breadth-limit)))
-           (write-to-string value)))))
+         (transcript-value-prefix-string value false)
+         (transcript-value-string value))))
     (if buffer
        (let ((point (mark-left-inserting-copy (buffer-end buffer))))
          (guarantee-newlines 1 point)
@@ -475,7 +467,7 @@ FIT           Error messages appear in typein window if they fit;
     (if (or (not buffer) (null? (buffer-windows buffer)))
        (message value-string))))
 
-(define (transcript-value-string value hash-number?)
+(define (transcript-value-prefix-string value hash-number?)
   (if (undefined-value? value)
       ";No value"
       (string-append
@@ -490,6 +482,15 @@ FIT           Error messages appear in typein window if they fit;
           "")
        ": ")))
 
+(define (transcript-value-string value)
+  (if (undefined-value? value)
+      ""
+      (fluid-let ((*unparser-list-depth-limit*
+                  (ref-variable transcript-list-depth-limit))
+                 (*unparser-list-breadth-limit*
+                  (ref-variable transcript-list-breadth-limit)))
+       (write-to-string value))))
+
 (define (transcript-buffer)
   (let ((name (ref-variable transcript-buffer-name)))
     (if (buffer? name)