summaryrefslogtreecommitdiff
path: root/module/rnrs/io/ports.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/rnrs/io/ports.scm')
-rw-r--r--module/rnrs/io/ports.scm68
1 files changed, 52 insertions, 16 deletions
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index a5815c85f..04d167a2c 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -32,13 +32,14 @@
;; auxiliary types
file-options buffer-mode buffer-mode?
eol-style native-eol-style error-handling-mode
- make-transcoder transcoder-codec native-transcoder
+ make-transcoder transcoder-codec transcoder-eol-style
+ transcoder-error-handling-mode native-transcoder
latin-1-codec utf-8-codec utf-16-codec
;; input & output ports
port? input-port? output-port?
port-eof?
- port-transcoder binary-port? transcoded-port
+ port-transcoder binary-port? textual-port? transcoded-port
port-position set-port-position!
port-has-port-position? port-has-set-port-position!?
call-with-port close-port
@@ -68,13 +69,15 @@
put-u8 put-bytevector
;; textual input
- get-char get-datum get-line get-string-all lookahead-char
-
+ get-char get-datum get-line get-string-all get-string-n get-string-n!
+ lookahead-char
+
;; textual output
put-char put-datum put-string
;; standard ports
standard-input-port standard-output-port standard-error-port
+ current-input-port current-output-port current-error-port
;; condition types
&i/o i/o-error? make-i/o-error
@@ -98,7 +101,8 @@
make-i/o-decoding-error
&i/o-encoding-error i/o-encoding-error?
make-i/o-encoding-error i/o-encoding-error-char)
- (import (only (rnrs base) assertion-violation)
+ (import (ice-9 binary-ports)
+ (only (rnrs base) assertion-violation)
(rnrs enums)
(rnrs records syntactic)
(rnrs exceptions)
@@ -108,9 +112,6 @@
(ice-9 rdelim)
(except (guile) raise))
-(load-extension (string-append "libguile-" (effective-version))
- "scm_init_r6rs_ports")
-
;;;
@@ -129,11 +130,11 @@
(enum-set-member? symbol (enum-set-universe (buffer-modes))))
(define-enumeration eol-style
- (lf cr crlf nel crnel ls)
+ (lf cr crlf nel crnel ls none)
eol-styles)
(define (native-eol-style)
- (eol-style lf))
+ (eol-style none))
(define-enumeration error-handling-mode
(ignore raise replace)
@@ -190,10 +191,30 @@
;;;
(define (port-transcoder port)
- (error "port transcoders are not supported" port))
+ "Return the transcoder object associated with @var{port}, or @code{#f}
+if the port has no transcoder."
+ (cond ((port-encoding port)
+ => (lambda (encoding)
+ (make-transcoder
+ encoding
+ (native-eol-style)
+ (case (port-conversion-strategy port)
+ ((error) 'raise)
+ ((substitute) 'replace)
+ (else
+ (assertion-violation 'port-transcoder
+ "unsupported error handling mode"))))))
+ (else
+ #f)))
(define (binary-port? port)
- ;; So far, we don't support transcoders other than the binary transcoder.
+ "Returns @code{#t} if @var{port} does not have an associated encoding,
+@code{#f} otherwise."
+ (not (port-encoding port)))
+
+(define (textual-port? port)
+ "Always returns @var{#t}, as all ports can be used for textual I/O in
+Guile."
#t)
(define (port-eof? port)
@@ -205,7 +226,8 @@
"Return a new textual port based on @var{port}, using
@var{transcoder} to encode and decode data written to or
read from its underlying binary port @var{port}."
- (let ((result (%make-transcoded-port port)))
+ ;; Hackily get at %make-transcoded-port.
+ (let ((result ((@@ (ice-9 binary-ports) %make-transcoded-port) port)))
(set-port-encoding! result (transcoder-codec transcoder))
(case (transcoder-error-handling-mode transcoder)
((raise)
@@ -387,6 +409,17 @@ return the characters accumulated in that port."
(define (get-string-all port)
(with-i/o-decoding-error (read-delimited "" port 'concat)))
+(define (get-string-n port count)
+ "Read up to @var{count} characters from @var{port}.
+If no characters could be read before encountering the end of file,
+return the end-of-file object, otherwise return a string containing
+the characters read."
+ (let* ((s (make-string count))
+ (rv (get-string-n! port s 0 count)))
+ (cond ((eof-object? rv) rv)
+ ((= rv count) s)
+ (else (substring/shared s 0 rv)))))
+
(define (lookahead-char port)
(with-i/o-decoding-error (peek-char port)))
@@ -396,13 +429,16 @@ return the characters accumulated in that port."
;;;
(define (standard-input-port)
- (dup->inport 0))
+ (with-fluids ((%default-port-encoding #f))
+ (dup->inport 0)))
(define (standard-output-port)
- (dup->outport 1))
+ (with-fluids ((%default-port-encoding #f))
+ (dup->outport 1)))
(define (standard-error-port)
- (dup->outport 2))
+ (with-fluids ((%default-port-encoding #f))
+ (dup->outport 2)))
)