From 6fbc5acab6294baa02d893c549192cce2827ea18 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 31 Jan 2006 06:15:55 +0000 Subject: [PATCH] Use URI records for for namespace URIs. --- v7/doc/ref-manual/io.texi | 44 ++++++++++++++--------------- v7/src/xml/xml-names.scm | 58 ++++++++++++++++++--------------------- v7/src/xml/xml-output.scm | 8 +++--- v7/src/xml/xml-parser.scm | 13 +++++---- v7/src/xml/xml-struct.scm | 25 ++++++++--------- 5 files changed, 71 insertions(+), 77 deletions(-) diff --git a/v7/doc/ref-manual/io.texi b/v7/doc/ref-manual/io.texi index 7f6d3edb6..34a52adad 100644 --- a/v7/doc/ref-manual/io.texi +++ b/v7/doc/ref-manual/io.texi @@ -1,5 +1,5 @@ @c This file is part of the MIT/GNU Scheme Reference Manual. -@c $Id: io.texi,v 1.13 2006/01/30 21:05:54 cph Exp $ +@c $Id: io.texi,v 1.14 2006/01/31 06:15:55 cph Exp $ @c Copyright 1991,1992,1993,1994,1995 Massachusetts Institute of Technology @c Copyright 1996,1997,1999,2000,2001 Massachusetts Institute of Technology @@ -3041,31 +3041,32 @@ they appear in the @acronym{DTD} of a document, even if the body of the document uses them. Consequently, it must be possible to compare non-associated names with associated names. -@cindex Internationalized Resource Identifier +@cindex Uniform Resource Identifier @cindex URI, of XML name @cindex qname, of XML name An @acronym{XML} name consists of two parts: the @dfn{qname}, which is a symbol, possibly including a namespace prefix; and the -@dfn{Internationalized Resource Identifier} (@acronym{URI}), which +@dfn{Uniform Resource Identifier} (@acronym{URI}), which identifies an optional namespace. @deffn procedure make-xml-name qname uri Creates and returns an @acronym{XML} name. @var{Qname} must be a symbol -whose name satisfies @code{string-is-xml-name?}. @var{Uri} must be an -absolute @acronym{URI} record. The returned value is an @acronym{XML} -name that satisfies @code{xml-name?}. +whose name satisfies @code{string-is-xml-name?}. @var{Uri} must satisfy +either @code{absolute-uri?} or @code{null-xml-namespace-uri?}. The +returned value is an @acronym{XML} name that satisfies @code{xml-name?}. If @var{uri} is the @dfn{null} namespace (satisfies -@code{null-xml-name-prefix?}), the returned value is a symbol equivalent -to @var{qname}. This means that an ordinary symbol can be used as an -@acronym{XML} name when there is no namespace associated with the name. +@code{null-xml-namespace-uri?}), the returned value is a symbol +equivalent to @var{qname}. This means that an ordinary symbol can be +used as an @acronym{XML} name when there is no namespace associated with +the name. For convenience, @var{qname} may be a string, in which case it is converted to a symbol using @code{make-xml-qname}. -For convenience, @var{uri} may be a string, in which case it is -converted to an absolute @acronym{URI} record using -@code{->absolute-uri}. +For convenience, @var{uri} may be any object that @code{->uri} is able +to convert to a @acronym{URI} record, provided the resulting +@acronym{URI} meets the above restrictions. @end deffn @deffn procedure xml-name? object @@ -3078,8 +3079,8 @@ Returns the @dfn{qname} of @var{xml-name} as a symbol. @end deffn @deffn procedure xml-name-uri xml-name -Returns the @dfn{URI} of @var{xml-name} as an absolute @acronym{URI} -record. +Returns the @dfn{URI} of @var{xml-name}. The result always satisfies +@code{absolute-uri?} or @code{null-xml-namespace-uri?}. @end deffn @deffn procedure xml-name-string xml-name @@ -3164,19 +3165,18 @@ Returns @code{#t} if @var{object} is the null prefix, otherwise returns @code{#f}. @end deffn -These next procedures define the data abstraction for namespace -@acronym{URI}s. Conceptually, an @acronym{URI} is a string with a -particular syntax, but this implementation uses an abstract -representation that speeds up type and equality testing. Two -@acronym{URI}s are tested for equality using @code{eq?}. +The namespace @acronym{URI} of an @acronym{XML} name may be null, +meaning that there is no namespace associated with the name. This +namespace is represented by a relative @acronym{URI} record whose string +representation is the null string. @deffn procedure null-xml-namespace-uri -Returns the null @acronym{URI} record. +Returns the null namespace @acronym{URI} record. @end deffn @deffn procedure null-xml-namespace-uri? object -Returns @code{#t} if @var{object} is the null @acronym{URI} record, -otherwise returns @code{#f}. +Returns @code{#t} if @var{object} is the null namespace @acronym{URI} +record, otherwise returns @code{#f}. @end deffn The following values are two distinguished @acronym{URI} records. diff --git a/v7/src/xml/xml-names.scm b/v7/src/xml/xml-names.scm index 0749f90fc..686100461 100644 --- a/v7/src/xml/xml-names.scm +++ b/v7/src/xml/xml-names.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: xml-names.scm,v 1.11 2006/01/30 21:05:31 cph Exp $ +$Id: xml-names.scm,v 1.12 2006/01/31 06:14:16 cph Exp $ Copyright 2003,2004,2005,2006 Massachusetts Institute of Technology @@ -29,7 +29,7 @@ USA. (define (make-xml-name qname uri) (let ((qname (make-xml-qname qname)) - (uri (->absolute-uri uri))) + (uri (->uri uri))) (if (null-xml-namespace-uri? uri) qname (begin @@ -37,17 +37,17 @@ USA. (%make-xml-name qname uri))))) (define (check-prefix+uri qname uri) - (if (let ((s (symbol-name qname))) - (let ((c (find-prefix-separator s))) - (case c - ((#f) #f) - ((ILLEGAL) uri) - (else - (let ((prefix (utf8-string->symbol (string-head s c)))) - (or (and (eq? prefix 'xml) - (not (eq? uri xml-uri))) - (and (eq? prefix 'xmlns) - (not (eq? uri xmlns-uri))))))))) + (if (not (and (uri-absolute? uri) + (let ((s (symbol-name qname))) + (let ((c (find-prefix-separator s))) + (case c + ((#f) #t) + ((ILLEGAL) #f) + (else + (case (utf8-string->symbol (string-head s c)) + ((xml) (uri=? uri xml-uri)) + ((xmlns) (uri=? uri xmlns-uri)) + (else #t)))))))) (error:bad-range-argument uri 'MAKE-XML-NAME))) (define (%make-xml-name qname uri) @@ -78,6 +78,17 @@ USA. (define (error:not-xml-name object caller) (error:wrong-type-argument object "an XML Name" caller)) + +(define (null-xml-namespace-uri? object) + (and (uri? object) + (uri=? object null-namespace-uri))) + +(define (null-xml-namespace-uri) + null-namespace-uri) + +(define null-namespace-uri (->relative-uri "")) +(define xml-uri (->absolute-uri "http://www.w3.org/XML/1998/namespace")) +(define xmlns-uri (->absolute-uri "http://www.w3.org/2000/xmlns/")) (define (make-xml-nmtoken object) (if (string? object) @@ -152,7 +163,7 @@ USA. (else (error:not-xml-name name 'XML-NAME-URI)))) (define (xml-name-uri=? name uri) - (eq? (xml-name-uri name) uri)) + (uri=? (xml-name-uri name) uri)) (define (xml-name-prefix name) (xml-qname-prefix @@ -270,21 +281,4 @@ USA. expanded-name? (uri expanded-name-uri) (local expanded-name-local) - (combos expanded-name-combos)) - -;;;; Namespace URI - -(define (null-xml-namespace-uri? object) - (eq? object null-namespace-uri)) - -(define (null-xml-namespace-uri) - null-namespace-uri) - -(define null-namespace-uri - (->relative-uri "")) - -(define xml-uri - (->absolute-uri "http://www.w3.org/XML/1998/namespace")) - -(define xmlns-uri - (->absolute-uri "http://www.w3.org/2000/xmlns/")) \ No newline at end of file + (combos expanded-name-combos)) \ No newline at end of file diff --git a/v7/src/xml/xml-output.scm b/v7/src/xml/xml-output.scm index ed6f2c7e9..f2b39ef31 100644 --- a/v7/src/xml/xml-output.scm +++ b/v7/src/xml/xml-output.scm @@ -1,8 +1,8 @@ #| -*-Scheme-*- -$Id: xml-output.scm,v 1.39 2006/01/30 20:20:43 cph Exp $ +$Id: xml-output.scm,v 1.40 2006/01/31 06:14:20 cph Exp $ -Copyright 2001,2002,2003,2004,2005 Massachusetts Institute of Technology +Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology This file is part of MIT/GNU Scheme. @@ -464,12 +464,12 @@ USA. (if (xml-external-id-uri id) (begin (write-indent col ctx) - (quoted-string (xml-external-id-uri id))))) + (quoted-string (uri->string (xml-external-id-uri id)))))) (begin (write-indent col ctx) (emit-string "SYSTEM" ctx) (emit-string " " ctx) - (quoted-string (xml-external-id-uri id)))))) + (quoted-string (uri->string (xml-external-id-uri id))))))) (define (write-indent col ctx) (if col diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm index 31e5afd3c..40a78c1d5 100644 --- 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.67 2006/01/30 21:05:32 cph Exp $ +$Id: xml-parser.scm,v 1.68 2006/01/31 06:14:25 cph Exp $ Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology @@ -570,14 +570,15 @@ USA. (lambda () (if (string-null? value) (null-xml-namespace-uri) - (->absolute-uri value)))) + (string->absolute-uri value)))) (forbidden-uri (lambda (uri) - (perror p "Forbidden namespace URI" uri)))) + (perror p "Forbidden namespace URI" + (uri->string uri))))) (let ((guarantee-legal-uri (lambda (uri) - (if (or (eq? uri xml-uri) - (eq? uri xmlns-uri)) + (if (or (uri=? uri xml-uri) + (uri=? uri xmlns-uri)) (forbidden-uri uri))))) (cond ((xml-name=? qname 'xmlns) (let ((uri (get-uri))) @@ -588,7 +589,7 @@ USA. (perror p "Illegal namespace prefix" qname)) (let ((uri (get-uri))) (if (xml-name=? qname 'xmlns:xml) - (if (not (eq? uri xml-uri)) + (if (not (uri=? uri xml-uri)) (forbidden-uri uri)) (guarantee-legal-uri uri)) (cons (cons (xml-name-local qname) uri) tail))) diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm index cc0013d87..662698a65 100644 --- 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.52 2006/01/30 21:05:33 cph Exp $ +$Id: xml-struct.scm,v 1.53 2006/01/31 06:14:29 cph Exp $ Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology @@ -262,7 +262,7 @@ USA. (uri canonicalize (lambda (object) (and object - (canonicalize-char-data object))))) + (->uri (canonicalize-char-data object)))))) (define (public-id? object) (string-composed-of? object char-set:xml-public-id)) @@ -442,17 +442,16 @@ USA. (->absolute-uri value))))) (define (xml-element-namespace-prefix elt uri) - (let ((uri (uri->string uri))) - (let ((attr - (find-matching-item (xml-element-attributes elt) - (lambda (attr) - (and (xml-attribute-namespace-decl? attr) - (string=? (xml-attribute-value attr) uri)))))) - (and attr - (let ((name (xml-attribute-name attr))) - (if (xml-name=? name 'xmlns) - (null-xml-name-prefix) - (xml-name-local name))))))) + (let ((attr + (find-matching-item (xml-element-attributes elt) + (lambda (attr) + (and (xml-attribute-namespace-decl? attr) + (uri=? (->uri (xml-attribute-value attr)) uri)))))) + (and attr + (let ((name (xml-attribute-name attr))) + (if (xml-name=? name 'xmlns) + (null-xml-name-prefix) + (xml-name-local name)))))) ;;;; Convenience procedures -- 2.25.1