summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-06-01 12:01:16 +0200
committerAndy Wingo <wingo@pobox.com>2016-06-01 12:07:30 +0200
commit9454068a54a4e9e84db61dc42d9a5d7a544a7ece (patch)
tree1817e3fe92cba9b7a6f5f6cc092c60bdbd081589
parent5bec3261b469a4fb735e096025e8953ea8c72c8c (diff)
downloadguile-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.scm4
-rw-r--r--module/ice-9/sports.scm22
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)