From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 15 Aug 1994 19:14:42 +0000 (+0000)
Subject: Add additional kludge so that Emacs port is properly copied to all of
X-Git-Tag: 20090517-FFI~7135
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=b2ff7e10a84f85dd3e346839943aa00ff75cbc58;p=mit-scheme.git

Add additional kludge so that Emacs port is properly copied to all of
the standard places.
---

diff --git a/v7/src/runtime/emacs.scm b/v7/src/runtime/emacs.scm
index bea09594a..670ec02b3 100644
--- a/v7/src/runtime/emacs.scm
+++ b/v7/src/runtime/emacs.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: emacs.scm,v 14.20 1993/11/19 22:17:07 cph Exp $
+$Id: emacs.scm,v 14.21 1994/08/15 19:14:42 cph Exp $
 
-Copyright (c) 1988-93 Massachusetts Institute of Technology
+Copyright (c) 1988-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -259,6 +259,12 @@ MIT in each case. |#
 	  (or (eq? port the-console-port)
 	      (eq? port emacs-console-port)))
 	(set-console-i/o-port! new-port))
+    (do ((pairs standard-port-accessors (cdr pairs)))
+	((null? pairs))
+      (if (let ((port ((caar pairs))))
+	    (or (eq? port the-console-port)
+		(eq? port emacs-console-port)))
+	  ((cdar pairs) new-port)))
     (do ((cmdl (nearest-cmdl) (cmdl/parent cmdl)))
 	((not cmdl))
       (if (let ((port (cmdl/port cmdl)))
diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index 8810036de..c1c3dd510 100644
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.7 1993/10/21 14:52:40 cph Exp $
+$Id: port.scm,v 1.8 1994/08/15 19:14:15 cph Exp $
 
-Copyright (c) 1991-93 Massachusetts Institute of Technology
+Copyright (c) 1991-94 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -552,4 +552,11 @@ MIT in each case. |#
 
 (define (with-interaction-i/o-port port thunk)
   (fluid-let ((*interaction-i/o-port* (guarantee-i/o-port port)))
-    (thunk)))
\ No newline at end of file
+    (thunk)))
+
+(define standard-port-accessors
+  (list (cons current-input-port set-current-input-port!)
+	(cons current-output-port set-current-output-port!)
+	(cons notification-output-port set-notification-output-port!)
+	(cons trace-output-port set-trace-output-port!)
+	(cons interaction-i/o-port set-interaction-i/o-port!)))
\ No newline at end of file
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 449042bf9..37c8e99d4 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.230 1994/08/04 15:23:45 adams Exp $
+$Id: runtime.pkg,v 14.231 1994/08/15 19:14:28 cph Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -1033,7 +1033,8 @@ MIT in each case. |#
 	  *notification-output-port*
 	  *trace-output-port*)
   (export (runtime emacs-interface)
-	  set-port/thread-mutex!))
+	  set-port/thread-mutex!
+	  standard-port-accessors))
 
 (define-package (runtime input-port)
   (files "input")
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 449042bf9..37c8e99d4 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.230 1994/08/04 15:23:45 adams Exp $
+$Id: runtime.pkg,v 14.231 1994/08/15 19:14:28 cph Exp $
 
 Copyright (c) 1988-1994 Massachusetts Institute of Technology
 
@@ -1033,7 +1033,8 @@ MIT in each case. |#
 	  *notification-output-port*
 	  *trace-output-port*)
   (export (runtime emacs-interface)
-	  set-port/thread-mutex!))
+	  set-port/thread-mutex!
+	  standard-port-accessors))
 
 (define-package (runtime input-port)
   (files "input")