Export XML-IRI and XMLNS-IRI. Change MAKE-XML-NAME to signal an error

if the xml: or xmlns: prefixes are used with the wrong IRI.

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index b39deaafed2333b9b85c668fddf26d23ef734a48..e5a13f19958970df1c40ff030c6d1af9a79b4465 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.43 2003/09/25 16:51:18 cph Exp $
+$Id: xml-parser.scm,v 1.44 2003/09/26 00:35:49 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -537,9 +537,6 @@ USA.
                                (string-tail->symbol s (fix:+ c 1))
                                simple))
            simple)))))
-
-(define xml-iri "http://www.w3.org/XML/1998/namespace")
-(define xmlns-iri "http://www.w3.org/2000/xmlns/")
 \f
 ;;;; Processing instructions
 

diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm
index fb38b80ebc37bdfe6df361f56198076bfe248d6d..1d6d52f66b76e380642880ef35b61cc4c2c36ff3 100644 (file)
--- a/v7/src/xml/xml-struct.scm
+++ b/v7/src/xml/xml-struct.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml-struct.scm,v 1.32 2003/09/25 16:51:20 cph Exp $
+$Id: xml-struct.scm,v 1.33 2003/09/26 00:35:52 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -100,24 +100,36 @@ USA.
                     iri)))
 
 (define (make-xml-name simple iri)
-  (let ((lose
+  (let ((bad-name
         (lambda ()
-          (error:wrong-type-argument simple "an XML name" 'MAKE-XML-NAME))))
+          (error:wrong-type-argument simple "an XML name" 'MAKE-XML-NAME)))
+       (bad-iri
+        (lambda ()
+          (error:wrong-type-argument iri "IRI" 'MAKE-XML-NAME))))
     (receive (string symbol)
        (cond ((symbol? simple) (values (symbol-name simple) simple))
              ((string? simple) (values simple (string->symbol simple)))
-             (else (lose)))
+             (else (bad-name)))
       (let ((type (string-is-xml-nmtoken? string)))
        (cond ((and type (default-xml-namespace-iri? iri))
               symbol)
              ((eq? type 'NAME)
-              (%make-xml-name symbol
-                              (make-xml-namespace-iri iri)
-                              (let ((c (string-find-next-char string #\:)))
-                                (if c
-                                    (string-tail->symbol string (fix:+ c 1))
-                                    symbol))))
-             (else (lose)))))))
+              (let ((iri (make-xml-namespace-iri iri)))
+                (%make-xml-name
+                 symbol
+                 iri
+                 (let ((c (string-find-next-char string #\:)))
+                   (if c
+                       (let ((prefix (string-head->symbol string c))
+                             (local (string-tail->symbol string (fix:+ c 1))))
+                         (if (or (and (eq? prefix 'xml)
+                                      (not (eq? iri xml-iri)))
+                                 (and (eq? prefix 'xmlns)
+                                      (not (eq? iri xmlns-iri))))
+                             (bad-iri))
+                         local)
+                       symbol)))))
+             (else (bad-name)))))))
 
 (define (%make-xml-name simple iri local)
   (let ((uname
@@ -135,6 +147,12 @@ USA.
 
 (define universal-names
   (make-eq-hash-table))
+
+(define xml-iri
+  (make-xml-namespace-iri "http://www.w3.org/XML/1998/namespace"))
+
+(define xmlns-iri
+  (make-xml-namespace-iri "http://www.w3.org/2000/xmlns/"))
 \f
 (define (xml-name-simple name)
   (cond ((xml-nmtoken? name) name)

diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index b7f7e210344131d5c9986854cf46a961bb9e52bd..eb909bb6444f6bc0adceaa6eaa656cf51e31bd87 100644 (file)
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.30 2003/09/25 16:51:12 cph Exp $
+$Id: xml.pkg,v 1.31 2003/09/26 00:35:45 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -195,6 +195,7 @@ USA.
          (xml-external-id-uri xml-external-id-iri)
          xml-external-id?
          xml-intern
+         xml-iri
          xml-name-hash
          xml-name-local
          xml-name-local=?
@@ -222,7 +223,8 @@ USA.
          xml-unparsed-!entity-name
          xml-unparsed-!entity-notation
          xml-unparsed-!entity?
-         xml-whitespace-string?)
+         xml-whitespace-string?
+         xmlns-iri)
   (export (runtime xml parser)
          %make-xml-name))