@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
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
@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
@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.
#| -*-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
\f
(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
(%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)
(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/"))
\f
(define (make-xml-nmtoken object)
(if (string? object)
(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
expanded-name?
(uri expanded-name-uri)
(local expanded-name-local)
- (combos expanded-name-combos))
-\f
-;;;; 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
#| -*-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.
(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)))))))
\f
(define (write-indent col ctx)
(if col
#| -*-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
(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)))
(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)))
#| -*-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
(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))
(->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))))))
\f
;;;; Convenience procedures
projects / mit-scheme.git / commitdiff