From 37948e173d34dcb4991f3310b3f8d6c55647ba02 Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Mon, 6 May 2002 15:54:38 +0000
Subject: [PATCH] Preserve ports in forked child. The use of NARROW had borked
 this.

---
 scsh/scsh.scm | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/scsh/scsh.scm b/scsh/scsh.scm
index 2639a4a..33c2c87 100644
--- a/scsh/scsh.scm
+++ b/scsh/scsh.scm
@@ -927,6 +927,21 @@
 		 (not dont-narrow?)
 		 maybe-thunk)))
 
+(define (preserve-ports thunk)
+  (let ((current-input (current-input-port))
+	(current-output (current-output-port))
+	(current-error (current-error-port)))
+    (lambda ()
+      (with-current-input-port*
+       current-input
+       (lambda ()
+	 (with-current-output-port*
+	  current-output
+	  (lambda ()
+	    (with-current-error-port*
+	     current-error
+	     thunk))))))))
+
 (define (really-fork clear-interactive? narrow? maybe-thunk)
   (with-env-aligned*			; not neccessary here but doing it on exec
 					; genereates no cache in the parent
@@ -935,7 +950,8 @@
 	   (maybe-narrow
 	    (if narrow?
 		(lambda (thunk)
-		  (narrow (preserve-thread-fluids thunk)
+		  ;; narrow loses the thread fluids and the dynamic environment
+		  (narrow (preserve-ports (preserve-thread-fluids thunk))
 			  'forking))
 		(lambda (thunk) (thunk)))))
        (maybe-narrow