Implement bytevector I/O for XML.

diff --git a/src/xml/xml-output.scm b/src/xml/xml-output.scm
index d4c5e8c4a0c087921099d14337aa1ef6212bfcdf..ba04ab349db9678aade4c7556ff0622b9bb56f75 100644 (file)
--- a/src/xml/xml-output.scm
+++ b/src/xml/xml-output.scm
@@ -29,20 +29,26 @@ USA.
 (declare (usual-integrations))
 \f
 (define (write-xml xml port . options)
-  (set-coding xml port)
-  (write-xml-1 xml port options))
+  (write-xml* xml port options))
 
 (define (write-xml-file xml pathname . options)
   (call-with-output-file pathname
     (lambda (port)
-      (set-coding xml port)
-      (write-xml-1 xml port options))))
-
-(define (xml->octets xml . options)
-  (call-with-output-octets
-   (lambda (port)
-     (set-coding xml port)
-     (write-xml-1 xml port options))))
+      (write-xml* xml port options))))
+
+(define (xml->string xml . options)
+  (call-with-output-string
+    (lambda (port)
+      (write-xml* xml port options))))
+
+(define (xml->bytevector xml . options)
+  (call-with-output-bytevector
+   (lambda (binary-port)
+     (write-xml* xml (binary->textual-port binary-port) options))))
+
+(define (write-xml* xml port options)
+  (set-coding xml port)
+  (write-xml-1 xml port options))
 
 (define (set-coding xml port)
   (if (port/supports-coding? port)

diff --git a/src/xml/xml-parser.scm b/src/xml/xml-parser.scm
index 2b4025984e524c2058d5ba120f8f6a74f409788e..e6d90c06bc681a2b78a30700fd0c1e38be34a6b7 100644 (file)
--- a/src/xml/xml-parser.scm
+++ b/src/xml/xml-parser.scm
@@ -83,14 +83,18 @@ USA.
 
 (define (read-xml port #!optional pi-handlers)
   (receive (coding prefix) (determine-coding port)
-    (parse-xml (input-port->parser-buffer port prefix)
+    (parse-xml (textual-input-port->parser-buffer port prefix)
               coding
-              (guarantee-pi-handlers pi-handlers 'READ-XML))))
+              (guarantee-pi-handlers pi-handlers 'read-xml))))
+
+(define (bytevector->xml bv #!optional start end pi-handlers)
+  (read-xml (binary->textual-port (open-input-bytevector bv start end))
+           pi-handlers))
 
 (define (string->xml string #!optional start end pi-handlers)
   (parse-xml (string->parser-buffer string start end)
-            'ANY
-            (guarantee-pi-handlers pi-handlers 'STRING->XML)))
+            'any
+            (guarantee-pi-handlers pi-handlers 'string->xml)))
 
 (define (guarantee-pi-handlers object caller)
   (if (default-object? object)

diff --git a/src/xml/xml-rpc.scm b/src/xml/xml-rpc.scm
index 485e57c8caf8cac3f7331b3b3ffd909325653dc0..82b17c0ad72e7b3e0e47899e369b383c5f00de47 100644 (file)
--- a/src/xml/xml-rpc.scm
+++ b/src/xml/xml-rpc.scm
@@ -33,7 +33,7 @@ USA.
         (http-post uri
                    `(,@(if (default-object? headers) '() headers)
                      ,(make-http-header 'CONTENT-TYPE "text/xml"))
-                   (xml->octets (->request request 'XML-RPC)))))
+                   (xml->bytevector (->request request 'XML-RPC)))))
     (if (not (= 200 (http-response-status response)))
        (error "HTTP error:" (http-response-reason response)))
     (xml-rpc:parse-response (read-xml (http-message-body-port response)))))

diff --git a/src/xml/xml.pkg b/src/xml/xml.pkg
index b2c97ed3097e0a5562cff8e369b4a11c8f2e76a4..eb66cec78abe07e20553716fe0d236f1ebebdc58 100644 (file)
--- a/src/xml/xml.pkg
+++ b/src/xml/xml.pkg
@@ -258,6 +258,7 @@ USA.
   (files "xml-parser")
   (parent (runtime xml))
   (export ()
+         bytevector->xml
          read-xml
          read-xml-file
          string->xml
@@ -270,10 +271,10 @@ USA.
   (files "xml-output")
   (parent (runtime xml))
   (export ()
-         (xml->string xml->octets)
          write-xml
          write-xml-file
-         xml->octets))
+         xml->bytevector
+         xml->string))
 
 (define-package (runtime xml html)
   (files "xhtml" "xhtml-entities")