Commit | Line | Data |
---|---|---|
f05bb849 AW |
1 | ;;; Encoding and decoding byte representations of strings |
2 | ||
3 | ;; Copyright (C) 2013 Free Software Foundation, Inc. | |
4 | ||
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | ;;; Code: | |
20 | ||
21 | (define-module (ice-9 iconv) | |
22 | #:use-module (rnrs bytevectors) | |
23 | #:use-module (ice-9 binary-ports) | |
24 | #:use-module ((ice-9 rdelim) #:select (read-delimited)) | |
25 | #:export (string->bytevector | |
26 | bytevector->string | |
27 | call-with-encoded-output-string)) | |
28 | ||
29 | ;; Like call-with-output-string, but actually closes the port. | |
30 | (define (call-with-output-string* proc) | |
31 | (let ((port (open-output-string))) | |
32 | (proc port) | |
33 | (let ((str (get-output-string port))) | |
34 | (close-port port) | |
35 | str))) | |
36 | ||
37 | (define (call-with-output-bytevector* proc) | |
38 | (call-with-values (lambda () (open-bytevector-output-port)) | |
39 | (lambda (port get-bytevector) | |
40 | (proc port) | |
41 | (let ((bv (get-bytevector))) | |
42 | (close-port port) | |
43 | bv)))) | |
44 | ||
45 | (define* (call-with-encoded-output-string encoding proc | |
5ed4ea90 AW |
46 | #:optional |
47 | (conversion-strategy 'error)) | |
18c5bffe AW |
48 | "Call PROC on a fresh port. Encode the resulting string as a |
49 | bytevector according to ENCODING, and return the bytevector." | |
f05bb849 AW |
50 | (if (string-ci=? encoding "utf-8") |
51 | ;; I don't know why, but this appears to be faster; at least for | |
52 | ;; serving examples/debug-sxml.scm (1464 reqs/s versus 850 | |
53 | ;; reqs/s). | |
54 | (string->utf8 (call-with-output-string* proc)) | |
55 | (call-with-output-bytevector* | |
56 | (lambda (port) | |
57 | (set-port-encoding! port encoding) | |
58 | (if conversion-strategy | |
59 | (set-port-conversion-strategy! port conversion-strategy)) | |
60 | (proc port))))) | |
61 | ||
62 | ;; TODO: Provide C implementations that call scm_from_stringn and | |
63 | ;; friends? | |
64 | ||
5ed4ea90 AW |
65 | (define* (string->bytevector str encoding |
66 | #:optional (conversion-strategy 'error)) | |
18c5bffe AW |
67 | "Encode STRING according to ENCODING, which should be a string naming |
68 | a character encoding, like \"utf-8\"." | |
f05bb849 AW |
69 | (if (string-ci=? encoding "utf-8") |
70 | (string->utf8 str) | |
71 | (call-with-encoded-output-string | |
72 | encoding | |
73 | (lambda (port) | |
74 | (display str port)) | |
5ed4ea90 | 75 | conversion-strategy))) |
f05bb849 | 76 | |
5ed4ea90 AW |
77 | (define* (bytevector->string bv encoding |
78 | #:optional (conversion-strategy 'error)) | |
18c5bffe AW |
79 | "Decode the string represented by BV. The bytes in the bytevector |
80 | will be interpreted according to ENCODING, which should be a string | |
81 | naming a character encoding, like \"utf-8\"." | |
f05bb849 AW |
82 | (if (string-ci=? encoding "utf-8") |
83 | (utf8->string bv) | |
84 | (let ((p (open-bytevector-input-port bv))) | |
85 | (set-port-encoding! p encoding) | |
86 | (if conversion-strategy | |
87 | (set-port-conversion-strategy! p conversion-strategy)) | |
88 | (let ((res (read-delimited "" p))) | |
89 | (close-port p) | |
90 | (if (eof-object? res) | |
91 | "" | |
92 | res))))) |