[Guile-commits] 16/23: eports: add put-utf8-char, put-utf8-string

[Andy Wingo]

wingo pushed a commit to branch wip-ethreads
in repository guile.

commit f00836531282b66a30dfe9ae9ec6dca6b860d733
Author: Andy Wingo <address@hidden>
Date:   Tue Mar 27 16:15:36 2012 +0200

    eports: add put-utf8-char, put-utf8-string
    
    * module/ice-9/eports.scm (put-latin1-string): Fix a bug.
      (put-utf8-char, put-utf8-string): New functions.
---
 module/ice-9/eports.scm |   15 +++++++++++++--
 1 files changed, 13 insertions(+), 2 deletions(-)

diff --git a/module/ice-9/eports.scm b/module/ice-9/eports.scm
index 2ca8656..c6300d3 100644
--- a/module/ice-9/eports.scm
+++ b/module/ice-9/eports.scm
@@ -55,7 +55,10 @@
             get-latin1-string-n!
             get-latin1-string-delimited
             put-latin1-char
-            put-latin1-string))
+            put-latin1-string
+
+            put-utf8-char
+            put-utf8-string))
 
 (define-record-type <eport>
   (make-eport fd readbuf writebuf file-port)
@@ -546,10 +549,18 @@
 
 (define (put-latin1-string eport str)
   (if (string-every (lambda (c) (< (char->integer c) 128)) str)
-      (put-bytevector eport (string->utf8 eport))
+      (put-bytevector eport (string->utf8 str))
       ;; Need a string->latin1.
       (let ((len (string-length str)))
         (let lp ((n 0))
           (when (< n len)
             (put-u8 eport (char->integer (string-ref str n)))
             (lp (1+ n)))))))
+
+(define (put-utf8-char eport c)
+  (if (< (char->integer c) 128)
+      (put-u8 eport (char->integer c))
+      (put-utf8-string eport (string c))))
+
+(define (put-utf8-string eport str)
+  (put-bytevector eport (string->utf8 str)))