diff options
author | Andy Wingo <wingo@pobox.com> | 2016-06-21 11:06:25 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-06-21 11:06:25 +0200 |
commit | 5d9516637b68ddce3c5246a9a883e73cdcbc9097 (patch) | |
tree | 71b7f6a52c2a8e223bd02106e2ecfd5208e35d9a /module | |
parent | d545e4551dbc1c41babf5b9fd972fdeff62378a3 (diff) | |
download | guile-5d9516637b68ddce3c5246a9a883e73cdcbc9097.tar.gz |
Implement R6RS output-port-buffer-mode
* module/rnrs/io/ports.scm (r6rs-open): Set buffer-mode on new port.
(output-port-buffer-mode): Implement and export.
* module/rnrs.scm (rnrs): Export output-port-buffer-mode
* test-suite/tests/r6rs-ports.test (test-output-file-opener): Add
tests.
Diffstat (limited to 'module')
-rw-r--r-- | module/rnrs.scm | 2 | ||||
-rw-r--r-- | module/rnrs/io/ports.scm | 19 |
2 files changed, 18 insertions, 3 deletions
diff --git a/module/rnrs.scm b/module/rnrs.scm index a132c5364..e4a06faf5 100644 --- a/module/rnrs.scm +++ b/module/rnrs.scm @@ -183,7 +183,7 @@ open-file-input-port open-file-output-port open-file-input/output-port make-custom-textual-output-port call-with-string-output-port - flush-output-port put-string + output-port-buffer-mode flush-output-port put-string get-char get-datum get-line get-string-all get-string-n get-string-n! lookahead-char put-char put-datum put-string diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index 2968dbd9f..0cceb0672 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -63,6 +63,7 @@ call-with-bytevector-output-port call-with-string-output-port make-custom-textual-output-port + output-port-buffer-mode flush-output-port ;; input/output ports @@ -106,6 +107,9 @@ make-i/o-encoding-error i/o-encoding-error-char) (import (ice-9 binary-ports) (only (rnrs base) assertion-violation) + (only (ice-9 ports internal) + port-write-buffer port-buffer-bytevector port-line-buffered?) + (only (rnrs bytevectors) bytevector-length) (rnrs enums) (rnrs records syntactic) (rnrs exceptions) @@ -310,8 +314,9 @@ read from/written to in @var{port}." (lambda () (with-fluids ((%default-port-encoding #f)) (open filename mode)))))) - (cond (transcoder - (set-port-encoding! port (transcoder-codec transcoder)))) + (setvbuf port buffer-mode) + (when transcoder + (set-port-encoding! port (transcoder-codec transcoder))) port)) (define (file-options->mode file-options base-mode) @@ -382,6 +387,16 @@ return the characters accumulated in that port." close) "w")) +(define (output-port-buffer-mode port) + "Return @code{none} if @var{port} is unbuffered, @code{line} if it is +line buffered, or @code{block} otherwise." + (let ((buffering (bytevector-length + (port-buffer-bytevector (port-write-buffer port))))) + (cond + ((= buffering 1) 'none) + ((port-line-buffered? port) 'line) + (else 'block)))) + (define (flush-output-port port) (force-output port)) |