From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 16 Feb 1999 05:39:38 +0000 (+0000)
Subject: Implement FRESH-LINE operation for generic, file, and console ports.
X-Git-Tag: 20090517-FFI~4628
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=38c2c7c492c5864c4fc9a2c839a856628c05e847;p=mit-scheme.git

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 4437a9683..c8080952b 100644
--- 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 536adfe05..4ab4b0818 100644
--- 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 acd4f2bae..594cc23a4 100644
--- 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 b1c7ef6f9..25b596dde 100644
--- 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 a04b02059..4c890c69b 100644
--- 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)))