From 38c2c7c492c5864c4fc9a2c839a856628c05e847 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 16 Feb 1999 05:39:38 +0000 Subject: [PATCH] Implement FRESH-LINE operation for generic, file, and console ports. --- v7/src/runtime/fileio.scm | 31 ++++++++++++++++--------------- v7/src/runtime/genio.scm | 7 ++++++- v7/src/runtime/io.scm | 18 ++++++++++++------ v7/src/runtime/runtime.pkg | 5 ++++- v7/src/runtime/ttyio.scm | 7 ++++++- 5 files changed, 44 insertions(+), 24 deletions(-) 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))) -- 2.25.1