Change handling of inferior REPL output so that it does not affect the
authorChris Hanson <org/chris-hanson/cph>
Fri, 22 Apr 1994 05:05:41 +0000 (05:05 +0000)
committerChris Hanson <org/chris-hanson/cph>
Fri, 22 Apr 1994 05:05:41 +0000 (05:05 +0000)
point of the inferior REPL buffer, and so that insertions to the right
of the output mark remain to its right when output occurs.
Additionally, implement new editor variable to control whether output
from evaluation commands in other buffers cause the evaluation results
to be written to the REPL buffer.

v7/src/edwin/edwin.pkg
v7/src/edwin/intmod.scm

index d3e19782564bc5c2a63bcdcd0e08358496c925a5..365473869495a129eb15eeb069f2df8dfb3869d3 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: edwin.pkg,v 1.146 1994/03/16 23:26:50 cph Exp $
+$Id: edwin.pkg,v 1.147 1994/04/22 05:05:41 cph Exp $
 
 Copyright (c) 1989-1994 Massachusetts Institute of Technology
 
@@ -665,6 +665,7 @@ MIT in each case. |#
          edwin-command$repl
          edwin-mode$inferior-cmdl
          edwin-mode$inferior-repl
+         edwin-variable$inferior-repl-write-results
          edwin-variable$repl-enable-transcript-buffer
          edwin-variable$repl-error-decision
          inferior-repl-eval-expression
index daadd3e8a85578b2603535268565aeec61691a55..7f45e745d9d5ee9af370af2504049d950e6a8612 100644 (file)
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Id: intmod.scm,v 1.77 1993/11/02 22:19:34 cph Exp $
+;;;    $Id: intmod.scm,v 1.78 1994/04/22 05:05:34 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-93 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-94 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
 (define-variable repl-enable-transcript-buffer
   "If true, record input and output from inferior REPLs in transcript buffer.
 This flag has effect only when ENABLE-TRANSCRIPT-BUFFER is also true."
-  true
+  #t
   boolean?)
 
 (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."
-  false
+  #f
   boolean?)
 
 (define-variable repl-mode-locked
   "If true, user cannot change the mode of REPL and CMDL buffers."
-  true
+  #t
+  boolean?)
+
+(define-variable inferior-repl-write-results
+  "If true, results of evaluation commands are written in the REPL buffer.
+This includes evaluation of expressions in other buffers.
+Otherwise, only evaluation of expressions in the REPL buffer itself do this."
+  #t
   boolean?)
 \f
 (define (call-with-transcript-output-mark buffer procedure)
@@ -527,14 +534,14 @@ If this is an error, the debugger examines the error condition."
                         (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))
+    (move-mark-to! (port/mark port)
+                  (let ((end (buffer-end buffer))
+                        (end* (region-end region)))
+                    (if (mark~ end end*)
+                        (begin
+                          (set-buffer-point! buffer end*)
+                          end*)
+                        end)))
     (let ((queue (port/expression-queue port)))
       (bind-condition-handler (list condition-type:error)
          evaluation-error-handler
@@ -560,9 +567,7 @@ If this is an error, the debugger examines the error condition."
             (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))
+    ;;(move-mark-to! (port/mark port) (buffer-end buffer))
     (enqueue! (port/expression-queue port) (cons expression 'EXPRESSION))
     (end-input-wait port)))
 
@@ -621,7 +626,7 @@ If this is an error, the debugger examines the error condition."
        (port/copy interface-port-template
                   (make-interface-port-state
                    thread
-                   (mark-left-inserting-copy (buffer-end buffer))
+                   (mark-right-inserting-copy (buffer-end buffer))
                    (make-ring (ref-variable comint-input-ring-size))
                    (make-queue)
                    false
@@ -714,13 +719,13 @@ If this is an error, the debugger examines the error condition."
 
 (define (operation/write-result port expression value hash-number)
   (let ((buffer (port/buffer port)))
-    (case (operation/current-expression-context port expression)
-      ((EXPRESSION OTHER-BUFFER)
-       (transcript-write value
-                        (and (ref-variable enable-transcript-buffer buffer)
-                             (transcript-buffer))))
-      (else
-       (default/write-result port expression value hash-number)))))
+    (if (and (not (ref-variable inferior-repl-write-results buffer))
+            (memq (operation/current-expression-context port expression)
+                  '(EXPRESSION OTHER-BUFFER)))
+       (transcript-write value
+                         (and (ref-variable enable-transcript-buffer buffer)
+                              (transcript-buffer)))
+       (default/write-result port expression value hash-number))))
 \f
 (define (enqueue-output-string! port string)
   (let ((interrupt-mask (set-interrupt-enables! interrupt-mask/gc-ok)))
@@ -749,7 +754,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))
+       (mark (mark-left-inserting-copy (port/mark port)))
        (result #t))
     (call-with-transcript-output-mark (port/buffer port)
       (lambda (transcript-mark)
@@ -777,6 +782,8 @@ If this is an error, the debugger examines the error condition."
                  (if transcript-mark
                      (region-insert-string! transcript-mark
                                             (car strings)))))))))
+    (move-mark-to! (port/mark port) mark)
+    (mark-temporary! mark)
     (set-interrupt-enables! interrupt-mask)
     result))
 \f
@@ -981,4 +988,4 @@ If this is an error, the debugger examines the error condition."
      (READ ,operation/read)
      (CURRENT-EXPRESSION-CONTEXT ,operation/current-expression-context)
      (WRITE-RESULT ,operation/write-result))
-   false))
\ No newline at end of file
+   #f))
\ No newline at end of file