Implement FRESH-LINE operation for generic, file, and console ports.

diff --git a/v7/src/runtime/fileio.scm b/v7/src/runtime/fileio.scm
index 4437a9683015e24d0e001d1b0dfb6578ca2d0890..c8080952b74121044b3dac21b364a9f2a8d801be 100644 (file)
--- a/v7/src/runtime/fileio.scm
+++ b/v7/src/runtime/fileio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: fileio.scm,v 1.14 1999/02/16 00:49:52 cph Exp $
+$Id: fileio.scm,v 1.15 1999/02/16 05:39:07 cph Exp $
 
 Copyright (c) 1991-1999 Massachusetts Institute of Technology
 
@@ -51,6 +51,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         `((BUFFERED-OUTPUT-CHARS ,operation/buffered-output-chars)
           (CLOSE-OUTPUT ,operation/close-output)
           (FLUSH-OUTPUT ,operation/flush-output)
+          (FRESH-LINE ,operation/fresh-line)
           (OUTPUT-BLOCKING-MODE ,operation/output-blocking-mode)
           (OUTPUT-BUFFER-SIZE ,operation/output-buffer-size)
           (OUTPUT-CHANNEL ,operation/output-channel)
@@ -69,16 +70,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     (set! input-file-template
          (make-input-port (append input-operations
                                   other-operations)
-                          false))
+                          #f))
     (set! output-file-template
          (make-output-port (append output-operations
                                    other-operations)
-                           false))
+                           #f))
     (set! i/o-file-template
          (make-i/o-port (append input-operations
                                 output-operations
                                 other-operations)
-                        false)))
+                        #f)))
   unspecific)
 
 (define input-file-template)
@@ -98,7 +99,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
            (make-input-buffer channel
                               input-buffer-size
                               (pathname-newline-translation pathname))
-           false
+           #f
            pathname))))
     (set-channel-port! channel port)
     port))
@@ -114,7 +115,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          (port/copy
           output-file-template
           (make-file-state
-           false
+           #f
            (make-output-buffer channel
                                output-buffer-size
                                (pathname-newline-translation pathname))
@@ -148,8 +149,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          (port/copy input-file-template
                     (make-file-state (make-input-buffer channel
                                                         input-buffer-size
-                                                        false)
-                                     false
+                                                        #f)
+                                     #f
                                      pathname))))
     (set-channel-port! channel port)
     port))
@@ -163,10 +164,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                (file-open-output-channel filename))))
         (port
          (port/copy output-file-template
-                    (make-file-state false
+                    (make-file-state #f
                                      (make-output-buffer channel
                                                          output-buffer-size
-                                                         false)
+                                                         #f)
                                      pathname))))
     (set-channel-port! channel port)
     port))
@@ -178,10 +179,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          (port/copy i/o-file-template
                     (make-file-state (make-input-buffer channel
                                                         input-buffer-size
-                                                        false)
+                                                        #f)
                                      (make-output-buffer channel
                                                          output-buffer-size
-                                                         false)
+                                                         #f)
                                      pathname))))
     (set-channel-port! channel port)
     port))
@@ -230,9 +231,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                              (conc-name file-state/))
   ;; First two elements of this vector are required by the generic
   ;; I/O port operations.
-  (input-buffer false read-only true)
-  (output-buffer false read-only true)
-  (pathname false read-only true))
+  (input-buffer #f read-only #t)
+  (output-buffer #f read-only #t)
+  (pathname #f read-only #t))
 
 (define (operation/length port)
   (channel-file-length (operation/input-channel port)))

diff --git a/v7/src/runtime/genio.scm b/v7/src/runtime/genio.scm
index 536adfe056f53e587bcf6be496f167cd2e57af6b..4ab4b0818dd28b1f63cd8aa9e09b1b9760696bc9 100644 (file)
--- a/v7/src/runtime/genio.scm
+++ b/v7/src/runtime/genio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: genio.scm,v 1.12 1999/02/16 05:14:46 cph Exp $
+$Id: genio.scm,v 1.13 1999/02/16 05:38:34 cph Exp $
 
 Copyright (c) 1991-1999 Massachusetts Institute of Technology
 
@@ -49,6 +49,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         `((BUFFERED-OUTPUT-CHARS ,operation/buffered-output-chars)
           (CLOSE-OUTPUT ,operation/close-output)
           (FLUSH-OUTPUT ,operation/flush-output)
+          (FRESH-LINE ,operation/fresh-line)
           (OUTPUT-BLOCKING-MODE ,operation/output-blocking-mode)
           (OUTPUT-BUFFER-SIZE ,operation/output-buffer-size)
           (OUTPUT-CHANNEL ,operation/output-channel)
@@ -227,6 +228,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (output-buffer/write-substring-block (port/output-buffer port)
                                       string start end))
 
+(define (operation/fresh-line port)
+  (if (not (output-buffer/line-start? (port/output-buffer port)))
+      (operation/write-char port #\newline)))
+
 (define (operation/output-buffer-size port)
   (output-buffer/size (port/output-buffer port)))
 

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index acd4f2bae5b029a4876272dc184dda673fc356fc..594cc23a4e074c9ff5e3278715ea45a27c5eb2a3 100644 (file)
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.57 1999/02/16 05:25:17 cph Exp $
+$Id: io.scm,v 14.58 1999/02/16 05:38:22 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -576,7 +576,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   position
   line-translation                     ; string that newline maps to
   logical-size
-  closed?)
+  closed?
+  line-start?)
 
 (define (output-buffer-sizes translation buffer-size)
   (let ((logical-size
@@ -609,7 +610,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                             0
                             translation
                             logical-size
-                            #f)))))
+                            #f
+                            #t)))))
 
 (define (output-buffer/close buffer associated-buffer)
   (output-buffer/drain-block buffer)
@@ -691,9 +693,13 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                            (output-buffer/string buffer) posn)
       (set-output-buffer/position! buffer (fix:+ posn (fix:- end start)))))
 
-  (cond ((output-buffer/closed? buffer)
-        (error:bad-range-argument buffer 'OUTPUT-BUFFER/WRITE-SUBSTRING))
-       ((not (output-buffer/string buffer))
+  (if (output-buffer/closed? buffer)
+      (error:bad-range-argument buffer 'OUTPUT-BUFFER/WRITE-SUBSTRING))
+  (if (fix:< start end)
+      (set-output-buffer/line-start?!
+       buffer
+       (char=? #\newline (string-ref string (fix:- end 1)))))
+  (cond ((not (output-buffer/string buffer))
         (if (fix:= start end)
             0
             (or (channel-write (output-buffer/channel buffer)

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index b1c7ef6f9ea26caed08079b5c6a8450ec96e1d4f..25b596ddefe7b74534a9228c20f4f6085015cf1c 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.309 1999/02/16 05:22:58 cph Exp $
+$Id: runtime.pkg,v 14.310 1999/02/16 05:39:38 cph Exp $
 
 Copyright (c) 1988-1999 Massachusetts Institute of Technology
 
@@ -940,6 +940,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          operation/discard-chars
          operation/eof?
          operation/flush-output
+         operation/fresh-line
          operation/input-blocking-mode
          operation/input-buffer-size
          operation/input-channel
@@ -1860,6 +1861,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          output-buffer/channel
          output-buffer/close
          output-buffer/drain-block
+         output-buffer/line-start?
          output-buffer/open?
          output-buffer/set-size
          output-buffer/size
@@ -1889,6 +1891,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
          output-buffer/buffered-chars
          output-buffer/channel
          output-buffer/drain-block
+         output-buffer/line-start?
          output-buffer/set-size
          output-buffer/size
          output-buffer/write-char-block

diff --git a/v7/src/runtime/ttyio.scm b/v7/src/runtime/ttyio.scm
index a04b02059bf53b74101058e6c7d8cb7352ef5bac..4c890c69be0aa163e8349cb77a256562276b06ff 100644 (file)
--- a/v7/src/runtime/ttyio.scm
+++ b/v7/src/runtime/ttyio.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ttyio.scm,v 1.6 1999/01/02 06:19:10 cph Exp $
+$Id: ttyio.scm,v 1.7 1999/02/16 05:39:29 cph Exp $
 
 Copyright (c) 1991-1999 Massachusetts Institute of Technology
 
@@ -42,6 +42,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
             (DISCARD-CHAR ,operation/read-char)
             (DISCRETIONARY-FLUSH-OUTPUT ,operation/discretionary-flush-output)
             (FLUSH-OUTPUT ,operation/flush-output)
+            (FRESH-LINE ,operation/fresh-line)
             (INPUT-BLOCKING-MODE ,operation/input-blocking-mode)
             (INPUT-BUFFER-SIZE ,operation/input-buffer-size)
             (INPUT-CHANNEL ,operation/input-channel)
@@ -180,6 +181,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (if transcript-port
       (output-port/write-substring transcript-port string start end)))
 
+(define (operation/fresh-line port)
+  (if (not (output-buffer/line-start? (port/output-buffer port)))
+      (operation/write-char port #\newline)))
+
 (define (operation/flush-output port)
   (output-buffer/drain-block (port/output-buffer port))
   (if transcript-port (output-port/flush-output transcript-port)))