diff options
author | Andy Wingo <wingo@pobox.com> | 2016-06-01 12:01:16 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-06-01 12:07:30 +0200 |
commit | 9454068a54a4e9e84db61dc42d9a5d7a544a7ece (patch) | |
tree | 1817e3fe92cba9b7a6f5f6cc092c60bdbd081589 | |
parent | 5bec3261b469a4fb735e096025e8953ea8c72c8c (diff) | |
download | guile-9454068a54a4e9e84db61dc42d9a5d7a544a7ece.tar.gz |
put-string in Scheme
* module/ice-9/ports.scm: Export port-encode-chars and
port-clear-stream-start-for-bom-write via the internals module.
* module/ice-9/sports.scm (put-string): New function.
-rw-r--r-- | module/ice-9/ports.scm | 4 | ||||
-rw-r--r-- | module/ice-9/sports.scm | 22 |
2 files changed, 26 insertions, 0 deletions
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm index 3fc2f6465..68afed1d4 100644 --- a/module/ice-9/ports.scm +++ b/module/ice-9/ports.scm @@ -182,10 +182,12 @@ interpret its input and output." port-read port-write port-clear-stream-start-for-bom-read + port-clear-stream-start-for-bom-write %port-encoding specialize-port-encoding! port-random-access? port-decode-char + port-encode-chars port-read-buffering port-poll port-read-wait-fd @@ -227,9 +229,11 @@ interpret its input and output." port-read port-write port-clear-stream-start-for-bom-read + port-clear-stream-start-for-bom-write %port-encoding specialize-port-encoding! port-decode-char + port-encode-chars port-random-access? port-read-buffering port-poll diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm index 86d9a5b06..d145d071a 100644 --- a/module/ice-9/sports.scm +++ b/module/ice-9/sports.scm @@ -64,6 +64,7 @@ get-bytevector-n put-u8 put-bytevector + put-string %read-line read-line @@ -653,6 +654,27 @@ (define* (%read-line port) (read-line port 'split)) +(define* (put-string port str #:optional (start 0) + (count (- (string-length str) start))) + (let* ((aux (port-auxiliary-write-buffer port)) + (pos (port-buffer-position aux)) + (line (port-position-line pos))) + (set-port-buffer-cur! aux 0) + (port-clear-stream-start-for-bom-write port aux) + (let lp ((encoded 0)) + (when (< encoded count) + (let ((encoded (+ encoded + (port-encode-chars port aux str + (+ start encoded) + (- count encoded))))) + (let ((end (port-buffer-end aux))) + (set-port-buffer-end! aux 0) + (put-bytevector port (port-buffer-bytevector aux) 0 end) + (lp encoded))))) + (when (and (not (eqv? line (port-position-line pos))) + (port-line-buffered? port)) + (flush-output port)))) + (define saved-port-bindings #f) (define port-bindings '(((guile) read-char peek-char force-output close-port) |