Implement console-error-port and initialize current-error-port to it.

diff --git a/src/runtime/console-io.scm b/src/runtime/console-io.scm
index ac56b24cce9b25344faa285b2bc8a8e0efe8f47d..587209934a06207a8ac9f83c573d1cbce890ba79 100644 (file)
--- a/src/runtime/console-io.scm
+++ b/src/runtime/console-io.scm
@@ -29,69 +29,86 @@ USA.
 
 (declare (usual-integrations))
 \f
-(define (initialize-package!)
-  (let ((input-channel (tty-input-channel))
-       (output-channel (tty-output-channel))
-       (gtype (generic-i/o-port-type 'channel 'channel)))
-    (let ((type
-          (make-textual-port-type
-           `((beep ,operation/beep)
-             (char-ready? ,generic-io/char-ready?)
-             (clear ,operation/clear)
-             (discretionary-write-char ,operation/discretionary-write-char)
-             (discretionary-flush-output ,generic-io/flush-output)
-             (peek-char ,generic-io/peek-char)
-             (read-char ,operation/read-char)
-             (read-finish ,operation/read-finish)
-             (unread-char ,generic-io/unread-char)
-             (write-self ,operation/write-self)
-             (x-size ,operation/x-size)
-             (y-size ,operation/y-size))
-           gtype)))
-      (let ((port
-            (make-textual-port type
-                               (make-cstate input-channel output-channel))))
-       (set-channel-port! input-channel port)
-       (set-channel-port! output-channel port)
-       (set! the-console-port port)
-       (current-input-port port)
-       (current-output-port port))))
-  (set! port/echo-input? (generic-i/o-port-accessor 0))
-  (add-event-receiver! event:before-exit save-console-input)
-  (add-event-receiver! event:after-restore reset-console))
-
-(define port/echo-input?)
-
-(define (save-console-input)
-  ((ucode-primitive reload-save-string 1)
-   (generic-io/buffer-contents the-console-port)))
-
-(define (reset-console)
-  (let ((input-channel (tty-input-channel))
-       (output-channel (tty-output-channel)))
-    (set-textual-port-state! the-console-port
-                            (make-cstate input-channel output-channel))
-    (let ((contents ((ucode-primitive reload-retrieve-string 0))))
-      (if contents
-         (generic-io/set-buffer-contents the-console-port contents)))
-    (set-channel-port! input-channel the-console-port)
-    (set-channel-port! output-channel the-console-port)))
-
-(define (make-cstate input-channel output-channel)
-  (make-gstate (make-binary-port (make-channel-input-source input-channel)
-                                (make-channel-output-sink output-channel))
-              'text
-              'text
-              (default-object)
-              (channel-type=file? input-channel)))
-
+(define (make-binary-console-port)
+  (make-binary-port (make-channel-input-source (tty-input-channel))
+                   (make-channel-output-sink (tty-output-channel))))
+
+(define-deferred the-console-port
+  (let ((binary-port (make-binary-console-port)))
+    (make-generic-i/o-port
+     binary-port
+     (make-textual-port-type `((beep ,operation/beep)
+                              (char-ready? ,generic-io/char-ready?)
+                              (clear ,operation/clear)
+                              (discretionary-write-char
+                               ,operation/discretionary-write-char)
+                              (discretionary-flush-output
+                               ,generic-io/flush-output)
+                              (peek-char ,generic-io/peek-char)
+                              (read-char ,operation/read-char)
+                              (read-finish ,operation/read-finish)
+                              (unread-char ,generic-io/unread-char)
+                              (write-self ,operation/write-self)
+                              (x-size ,operation/x-size)
+                              (y-size ,operation/y-size))
+                            (generic-i/o-port-type 'channel 'channel))
+     (default-object)
+     (should-echo-input? binary-port))))
+
+(define (should-echo-input? binary-port)
+  (channel-type=file? (binary-port-input-channel binary-port)))
+
+(define-deferred echo-input?
+  (generic-i/o-port-accessor 0))
+
+(define-deferred set-echo-input!
+  (generic-i/o-port-modifier 0))
+
+(define (make-binary-error-port)
+  (make-binary-port #f
+                   (make-channel-output-sink (tty-error-channel))))
+
+(define-deferred the-error-port
+  (make-generic-i/o-port
+   (make-binary-error-port)
+   (make-textual-port-type `((beep ,operation/beep)
+                            (clear ,operation/clear)
+                            (discretionary-flush-output
+                             ,generic-io/flush-output)
+                            (write-self ,operation/write-self)
+                            (x-size ,operation/x-size)
+                            (y-size ,operation/y-size))
+                          (generic-i/o-port-type #f 'channel))))
+\f
 (define (console-i/o-port)
   the-console-port)
 
 (define (console-i/o-port? port)
   (eqv? port the-console-port))
 
-(define the-console-port)
+(define (console-error-port)
+  the-error-port)
+
+(add-boot-init!
+ (lambda ()
+   (current-input-port the-console-port)
+   (current-output-port the-console-port)
+   (current-error-port the-error-port)
+   (add-event-receiver! event:before-exit save-console-input)
+   (add-event-receiver! event:after-restore reset-console)))
+
+(define (save-console-input)
+  ((ucode-primitive reload-save-string 1)
+   (generic-io/buffer-contents the-console-port)))
+
+(define (reset-console)
+  (let ((binary-port (make-binary-console-port)))
+    (replace-binary-port! the-console-port binary-port)
+    (set-echo-input! the-console-port (should-echo-input? binary-port)))
+  (let ((contents ((ucode-primitive reload-retrieve-string 0))))
+    (if contents
+       (generic-io/set-buffer-contents the-console-port contents)))
+  (replace-binary-port! the-error-port (make-binary-error-port)))
 \f
 (define (operation/read-char port)
   (let ((char (generic-io/read-char port)))
@@ -120,7 +137,7 @@ USA.
   (output-port/discretionary-flush port))
 
 (define (operation/discretionary-write-char port char)
-  (if (and (port/echo-input? port)
+  (if (and (echo-input? port)
           (not (nearest-cmdl/batch-mode?)))
       (output-port/write-char port char)))
 

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 1a068da876272a3d74cd1201162f76260057549c..3d975952717b077956b7649d2b2527d52d5abf9b 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1549,7 +1549,8 @@ USA.
   (parent (runtime))
   (export ()
          console-i/o-port
-         console-i/o-port?)
+         console-i/o-port?
+         console-error-port)
   (export (runtime emacs-interface)
          the-console-port)
   (initialization (initialize-package!)))
@@ -2323,6 +2324,7 @@ USA.
          primary-output-port-codings)
   (export (runtime console-i/o-port)
          generic-i/o-port-accessor
+         generic-i/o-port-modifier
          generic-i/o-port-type
          generic-io/buffer-contents
          generic-io/char-ready?