Fix echoing of input when standard input is redirected to a file.

Eliminate separate implementation of DISCARD-CHAR; the top-level
procedures are now aliases for READ-CHAR.

diff --git a/v7/src/runtime/input.scm b/v7/src/runtime/input.scm
index 99d2a46ca0f8701c0bbe61f8b8630cbfed1951df..618e83087b1f641f79da757145a01d501f12238e 100644 (file)
--- a/v7/src/runtime/input.scm
+++ b/v7/src/runtime/input.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: input.scm,v 14.33 2007/01/05 21:19:28 cph Exp $
+$Id: input.scm,v 14.34 2007/01/09 06:16:45 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -44,9 +44,6 @@ USA.
 (define (input-port/peek-char port)
   ((port/operation/peek-char port) port))
 
-(define (input-port/discard-char port)
-  ((port/operation/discard-char port) port))
-
 (define (input-port/read-string! port string)
   (input-port/read-substring! port string 0 (string-length string)))
 
@@ -173,9 +170,6 @@ USA.
     (let loop ()
       (or (input-port/peek-char port)
          (loop)))))
-
-(define (discard-char #!optional port)
-  (input-port/discard-char (optional-input-port port 'DISCARD-CHAR)))
 \f
 (define (read-char-no-hang #!optional port)
   (let ((port (optional-input-port port 'READ-CHAR-NO-HANG)))

diff --git a/v7/src/runtime/parse.scm b/v7/src/runtime/parse.scm
index 8c813edacdfebcc23b75d4feb0bdfa16cc32e2c1..04de22fafe90995ff42d91ad934240da898a1595 100644 (file)
--- a/v7/src/runtime/parse.scm
+++ b/v7/src/runtime/parse.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: parse.scm,v 14.65 2007/01/05 21:19:28 cph Exp $
+$Id: parse.scm,v 14.66 2007/01/09 06:16:49 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -270,7 +270,7 @@ USA.
               (begin
                 (set! prefix (cdr prefix))
                 unspecific)
-              (discard-char port)))))
+              (read-char port)))))
     (let read-unquoted ((quoted? #f))
       (let ((char (%peek)))
        (if (or (eof-object? char)
@@ -420,7 +420,7 @@ USA.
   ctx char
   (if (char=? (peek-char/no-eof port) #\@)
       (begin
-       (discard-char port)
+       (read-char port)
        (list 'UNQUOTE-SPLICING (read-object port db)))
       (list 'UNQUOTE (read-object port db))))
 
@@ -574,9 +574,14 @@ USA.
   (list 'NON-SHARED-OBJECT))
 \f
 (define (read-char port)
-  (let loop ()
-    (or (input-port/read-char port)
-       (loop))))
+  (let ((char
+        (let loop ()
+          (or (input-port/read-char port)
+              (loop))))
+       (op (port/operation port 'DISCRETIONARY-WRITE-CHAR)))
+    (if op
+       (op char port))
+    char))
 
 (define (read-char/no-eof port)
   (let ((char (read-char port)))
@@ -584,11 +589,6 @@ USA.
        (error:premature-eof port))
     char))
 
-(define (discard-char port)
-  (let loop ()
-    (if (not (input-port/discard-char port))
-       (loop))))
-
 (define (peek-char port)
   (let loop ()
     (or (input-port/peek-char port)

diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index 1a497594bc7294a776cd090e965491c1da4e6eff..5a6ee663ff46cc68237ef80efaf578ef41c39f7d 100644 (file)
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.49 2007/01/07 09:11:11 cph Exp $
+$Id: port.scm,v 1.50 2007/01/09 06:16:53 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -42,7 +42,6 @@ USA.
   (read-char #f read-only #t)
   (unread-char #f read-only #t)
   (peek-char #f read-only #t)
-  (discard-char #f read-only #t)
   (read-substring #f read-only #t)
   (read-wide-substring #f read-only #t)
   (read-external-substring #f read-only #t)
@@ -154,7 +153,6 @@ USA.
                       (op 'READ-CHAR)
                       (op 'UNREAD-CHAR)
                       (op 'PEEK-CHAR)
-                      (op 'DISCARD-CHAR)
                       (op 'READ-SUBSTRING)
                       (op 'READ-WIDE-SUBSTRING)
                       (op 'READ-EXTERNAL-SUBSTRING)
@@ -368,13 +366,6 @@ USA.
                         (set-port/unread! port char)
                         (transcribe-char char port)))
                   char)))))
-       (discard-char
-        (let ((defer (op 'READ-CHAR)))
-           (lambda (port)
-             (if (port/unread port)
-                 (set-port/unread! port #f)
-                 (defer port))
-             unspecific)))
        (read-substring
         (let ((defer (op 'READ-SUBSTRING)))
           (lambda (port string start end)
@@ -422,7 +413,6 @@ USA.
        ((READ-CHAR) read-char)
        ((UNREAD-CHAR) unread-char)
        ((PEEK-CHAR) peek-char)
-       ((DISCARD-CHAR) discard-char)
        ((READ-SUBSTRING) read-substring)
        ((READ-WIDE-SUBSTRING) read-wide-substring)
        ((READ-EXTERNAL-SUBSTRING) read-external-substring)
@@ -566,7 +556,6 @@ USA.
   (define-port-operation read-char)
   (define-port-operation unread-char)
   (define-port-operation peek-char)
-  (define-port-operation discard-char)
   (define-port-operation read-substring)
   (define-port-operation read-wide-substring)
   (define-port-operation read-external-substring)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 00fab67a78281399331401864f20d81757f45449..cf20cca21a77b8c16f48b17061221f2294914d01 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.609 2007/01/07 09:11:18 cph Exp $
+$Id: runtime.pkg,v 14.610 2007/01/09 06:16:59 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -1933,7 +1933,6 @@ USA.
          output-port?
          port-position
          port-type/char-ready?
-         port-type/discard-char
          port-type/discretionary-flush-output
          port-type/flush-output
          port-type/fresh-line
@@ -2007,7 +2006,6 @@ USA.
          port/unread)
   (export (runtime input-port)
          port/operation/char-ready?
-         port/operation/discard-char
          port/operation/peek-char
          port/operation/read-char
          port/operation/read-external-substring
@@ -2041,18 +2039,18 @@ USA.
   (files "input")
   (parent (runtime))
   (export ()
+         (discard-char read-char)
+         (input-port/discard-char input-port/read-char)
          char-ready?
-         discard-char
          eof-object?
          input-port/char-ready?
-         input-port/discard-char
          input-port/discard-chars
          input-port/peek-char
          input-port/read-char
-         input-port/read-line
-         input-port/read-string
          input-port/read-external-string!
          input-port/read-external-substring!
+         input-port/read-line
+         input-port/read-string
          input-port/read-string!
          input-port/read-substring!
          input-port/read-wide-string!

diff --git a/v7/src/runtime/ttyio.scm b/v7/src/runtime/ttyio.scm
index 63562b290782a2216b659785609bce6a52306526..44c928b9597283752ac2dfa02403df50c5b5b9f5 100644 (file)
--- a/v7/src/runtime/ttyio.scm
+++ b/v7/src/runtime/ttyio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ttyio.scm,v 1.25 2007/01/05 21:19:28 cph Exp $
+$Id: ttyio.scm,v 1.26 2007/01/09 06:17:04 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -39,6 +39,7 @@ USA.
            `((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)
              (READ-CHAR ,operation/read-char)
              (READ-FINISH ,operation/read-finish)
@@ -52,10 +53,7 @@ USA.
        (set! the-console-port port)
        (set-console-i/o-port! port)
        (set-current-input-port! port)
-       (set-current-output-port! port)))
-    (set! *char-ready? (port-type/char-ready? gtype))
-    (set! *read-char (port-type/read-char gtype))
-    (set! *unread-char (port-type/unread-char gtype)))
+       (set-current-output-port! port))))
   (add-event-receiver! event:before-exit save-console-input)
   (add-event-receiver! event:after-restore reset-console))
 
@@ -102,9 +100,6 @@ USA.
 (define console-i/o-port)
 (define console-input-port)
 (define console-output-port)
-(define *char-ready?)
-(define *read-char)
-(define *unread-char)
 \f
 (define (operation/read-char port)
   (let ((char (generic-io/read-char port)))
@@ -115,24 +110,20 @@ USA.
                (fresh-line port)
                (write-string "End of input stream reached." port)))
          (%exit)))
-    (maybe-echo-input port char)
     char))
 
 (define (operation/read-finish port)
   (let loop ()
-    (if (*char-ready? port)
-       (let ((char (*read-char port)))
+    (if (char-ready? port)
+       (let ((char (read-char port)))
          (if (not (eof-object? char))
-             (begin
-               (maybe-echo-input port char)
-               (if (char-whitespace? char)
-                   (loop)
-                   (*unread-char port char)))))))
+             (if (char-whitespace? char)
+                 (loop)
+                 (unread-char char port))))))
   (output-port/discretionary-flush port))
 
-(define (maybe-echo-input port char)
-  (if (and char
-          (cstate-echo-input? (port/state port))
+(define (operation/discretionary-write-char char port)
+  (if (and (cstate-echo-input? (port/state port))
           (not (nearest-cmdl/batch-mode?)))
       (output-port/write-char port char)))