From d96cd8d4d87de3c915ed9ad799f7e9fdb1450fa8 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 22 Apr 1994 05:05:41 +0000
Subject: [PATCH] Change handling of inferior REPL output so that it does not
affect the 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 | 3 ++-
v7/src/edwin/intmod.scm | 59 +++++++++++++++++++++++------------------
2 files changed, 35 insertions(+), 27 deletions(-)
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index d3e197825..365473869 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -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
diff --git a/v7/src/edwin/intmod.scm b/v7/src/edwin/intmod.scm
index daadd3e8a..7f45e745d 100644
--- a/v7/src/edwin/intmod.scm
+++ b/v7/src/edwin/intmod.scm
@@ -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
@@ -50,18 +50,25 @@
(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?)
(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))))
(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))
@@ -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
--
2.25.1