From 90ec641999ad69271beedaa2aa6d073eca25ec0d Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 21 Oct 1993 04:58:12 +0000
Subject: [PATCH] Instantiate the editor CMDL with a dummy I/O port that
 signals an error if it is read from or written to.  Define the CHILD-PORT
 operation on that CMDL so that spawning a another CMDL under the editor CMDL
 (e.g. by DEBUG-INTERNAL-ERRORS? being true) will cause the child to use the
 port that was in effect when the editor was started.

---
 v7/src/edwin/editor.scm | 28 ++++++++++++++++++++++++----
 1 file changed, 24 insertions(+), 4 deletions(-)

diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index e621779a6..e05267dc5 100644
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: editor.scm,v 1.229 1993/08/02 23:54:22 cph Exp $
+;;;	$Id: editor.scm,v 1.230 1993/10/21 04:58:12 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-1993 Massachusetts Institute of Technology
 ;;;
@@ -76,7 +76,9 @@
 	 (lambda (with-editor-ungrabbed operations)
 	   (let ((message (cmdl-message/null)))
 	     (cmdl/start
-	      (push-cmdl
+	      (make-cmdl
+	       (nearest-cmdl)
+	       dummy-i/o-port
 	       (lambda (cmdl)
 		 cmdl		;ignore
 		 (bind-condition-handler (list condition-type:error)
@@ -95,8 +97,8 @@
 			(top-level-command-reader edwin-initialization)))))
 		 message)
 	       false
-	       `((START-CHILD
-		  ,(editor-start-child-cmdl with-editor-ungrabbed))
+	       `((START-CHILD ,(editor-start-child-cmdl with-editor-ungrabbed))
+		 (CHILD-PORT ,(editor-child-cmdl-port (nearest-cmdl/port)))
 		 ,@operations))
 	      message))))))))
 
@@ -445,10 +447,28 @@ This does not affect editor errors or evaluation errors."
 			      operations))
 			  exit)))))))
 
+(define dummy-i/o-port
+  (make-i/o-port
+   (map (lambda (name)
+	  (list name
+		(lambda (port . ignore)
+		  ignore
+		  (error "Attempt to perform a"
+			 name
+			 (error-irritant/noise " operation on dummy I/O port:")
+			 port))))
+	'(CHAR-READY? READ-CHAR PEEK-CHAR WRITE-CHAR))
+   #f))
+
 (define (editor-start-child-cmdl with-editor-ungrabbed)
   (lambda (cmdl thunk)
     cmdl
     (with-editor-ungrabbed thunk)))
+
+(define (editor-child-cmdl-port port)
+  (lambda (cmdl)
+    cmdl
+    port))
 
 (define inferior-thread-changes?)
 (define inferior-threads)
-- 
2.25.1