Generate BOM on output for those encodings that require it.

diff --git a/v7/src/xml/xml-output.scm b/v7/src/xml/xml-output.scm
index 8009307ce7531d3ac7c692ffbc53f925015f94b3..c5d442b5ed4d1ec484d78fa902de6e782a5bb94a 100644 (file)
--- a/v7/src/xml/xml-output.scm
+++ b/v7/src/xml/xml-output.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml-output.scm,v 1.31 2004/02/24 20:48:32 cph Exp $
+$Id: xml-output.scm,v 1.32 2004/02/25 21:00:49 cph Exp $
 
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
@@ -38,12 +38,15 @@ USA.
       (write-xml-1 xml port options))))
 
 (define (set-coding xml port)
-  (port/set-coding port
-                  (or (normalize-coding port
-                                        (and (xml-document? xml)
-                                             (xml-document-declaration xml)))
-                      'UTF-8))
-  (port/set-line-ending port 'TEXT))
+  (let ((coding
+        (or (normalize-coding port
+                              (and (xml-document? xml)
+                                   (xml-document-declaration xml)))
+            'UTF-8)))
+    (port/set-coding port coding)
+    (port/set-line-ending port 'TEXT)
+    (if (coding-requires-bom? coding)
+       (write-char #\U+FEFF port))))
 
 (define (xml->wide-string xml . options)
   (call-with-wide-output-string

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index e7216817dfe5260b5e4308c6ea69d966818f1b51..b52fc9f4122a7a1d1a7ec29285add64c550b53c7 100644 (file)
--- a/v7/src/xml/xml-parser.scm
+++ b/v7/src/xml/xml-parser.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml-parser.scm,v 1.57 2004/02/24 20:36:42 cph Exp $
+$Id: xml-parser.scm,v 1.58 2004/02/25 21:00:52 cph Exp $
 
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
@@ -170,7 +170,7 @@ USA.
                            0)))
               (lose c0 c1 c2 c3))))
        ((#\U+3C)
-        (values #f '8-BIT #\<))
+        (values #f 'NO-BOM #\<))
        (else
         (values 'UTF-8 'UTF-8 c0))))))
 \f
@@ -188,9 +188,8 @@ USA.
            ((UTF-32)
             (if (not (eq? declared coding))
                 (lose)))
-           ((8-BIT)
-            (if (memq declared
-                      '(UTF-16 UTF-16BE UTF-16LE UTF-32 UTF-32BE UTF-32LE))
+           ((NO-BOM)
+            (if (coding-requires-bom? declared)
                 (lose))
             (port/set-coding port (or declared 'UTF-8)))
            ((ANY) unspecific)
@@ -205,6 +204,9 @@ USA.
     (if (and coding (not (port/known-coding? port coding)))
        (error:bad-range-argument coding #f))
     coding))
+
+(define (coding-requires-bom? coding)
+  (memq coding '(UTF-16 UTF-16BE UTF-16LE UTF-32 UTF-32BE UTF-32LE)))
 \f
 ;;;; Top level
 

diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index aaaa67b0a1cd26040a2ac19a0ef789d4209fb9a5..a5098eddbaefeef3103b3e0700c28d9c57211c81 100644 (file)
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.38 2004/02/24 20:36:23 cph Exp $
+$Id: xml.pkg,v 1.39 2004/02/25 21:00:45 cph Exp $
 
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
@@ -278,6 +278,7 @@ USA.
   (export (runtime xml)
          alphabet:name-initial
          alphabet:name-subsequent
+         coding-requires-bom?
          normalize-coding))
 
 (define-package (runtime xml output)