From 7721d91af5d5b6d9c2cf8ef72619026e6d1ffab8 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 26 Sep 2003 01:00:14 +0000 Subject: [PATCH] Change terminology to be more in accord with W3C documents: universal-name => expanded-name simple => qname default-xml-namespace-iri => null-xml-namespace-iri --- v7/src/xml/xml-parser.scm | 49 ++++++++++---------- v7/src/xml/xml-struct.scm | 96 +++++++++++++++++++-------------------- v7/src/xml/xml.pkg | 10 ++-- 3 files changed, 78 insertions(+), 77 deletions(-) diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm index e5a13f199..9377c6402 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.44 2003/09/26 00:35:49 cph Exp $ +$Id: xml-parser.scm,v 1.45 2003/09/26 01:00:11 cph Exp $ Copyright 2001,2002,2003 Massachusetts Institute of Technology @@ -491,7 +491,7 @@ USA. (if (string=? "xmlns:xmlns" s) (perror pn "Illegal namespace prefix" s)) (let ((iri (iri))) - (if (default-xml-namespace-iri? iri) + (if (null-xml-namespace-iri? iri) ;; legal in XML 1.1 (forbidden-iri "")) (if (string=? "xmlns:xml" s) @@ -510,33 +510,34 @@ USA. (define (intern-name n element-name?) (let ((s (car n)) (p (cdr n))) - (let ((simple (string->symbol s)) + (let ((qname (string->symbol s)) (c (string-find-next-char s #\:))) (let ((iri - (and (not *in-dtd?*) - (or element-name? c) - (let ((prefix - (if c - (string-head->symbol s c) - (null-xml-name-prefix)))) - (case prefix - ((xmlns) xmlns-iri) - ((xml) xml-iri) - (else - (let ((entry (assq prefix *prefix-bindings*))) - (if entry - (cdr entry) - (begin - (if (not (null-xml-name-prefix? prefix)) - (perror p "Unknown XML prefix" prefix)) - (default-xml-namespace-iri)))))))))) - (if iri - (%make-xml-name simple + (if (and (not *in-dtd?*) + (or element-name? c)) + (let ((prefix + (if c + (string-head->symbol s c) + (null-xml-name-prefix)))) + (case prefix + ((xmlns) xmlns-iri) + ((xml) xml-iri) + (else + (let ((entry (assq prefix *prefix-bindings*))) + (if entry + (cdr entry) + (begin + (if (not (null-xml-name-prefix? prefix)) + (perror p "Unknown XML prefix" prefix)) + (null-xml-namespace-iri))))))) + (null-xml-namespace-iri? iri)))) + (if (null-xml-namespace-iri? iri) + qname + (%make-xml-name qname iri (if c (string-tail->symbol s (fix:+ c 1)) - simple)) - simple))))) + qname))))))) ;;;; Processing instructions diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm index 1d6d52f66..0d50f334b 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.33 2003/09/26 00:35:52 cph Exp $ +$Id: xml-struct.scm,v 1.34 2003/09/26 01:00:14 cph Exp $ Copyright 2001,2002,2003 Massachusetts Institute of Technology @@ -28,23 +28,23 @@ USA. (declare (usual-integrations)) (define-record-type - (make-combo-name simple universal) + (make-combo-name qname expanded) combo-name? - (simple combo-name-simple) - (universal combo-name-universal)) + (qname combo-name-qname) + (expanded combo-name-expanded)) (set-record-type-unparser-method! (standard-unparser-method 'XML-NAME (lambda (name port) (write-char #\space port) - (write (combo-name-simple name) port)))) + (write (combo-name-qname name) port)))) -(define-record-type - (make-universal-name iri local combos) - universal-name? - (iri universal-name-iri) - (local universal-name-local) - (combos universal-name-combos)) +(define-record-type + (make-expanded-name iri local combos) + expanded-name? + (iri expanded-name-iri) + (local expanded-name-local) + (combos expanded-name-combos)) (define (xml-name? object) (or (and (interned-symbol? object) @@ -76,10 +76,10 @@ USA. ;; See RFC 1630 for correct syntax. (utf8-string-valid? object)) -(define (default-xml-namespace-iri? object) +(define (null-xml-namespace-iri? object) (eq? object '||)) -(define (default-xml-namespace-iri) +(define (null-xml-namespace-iri) '||) (define (guarantee-xml-namespace-iri object caller) @@ -93,25 +93,25 @@ USA. (guarantee-xml-namespace-iri iri 'XML-NAMESPACE-IRI->STRING) (symbol->string iri)) -(define (xml-intern simple #!optional iri) - (make-xml-name simple +(define (xml-intern qname #!optional iri) + (make-xml-name qname (if (default-object? iri) - (default-xml-namespace-iri) + (null-xml-namespace-iri) iri))) -(define (make-xml-name simple iri) +(define (make-xml-name qname iri) (let ((bad-name (lambda () - (error:wrong-type-argument simple "an XML name" 'MAKE-XML-NAME))) + (error:wrong-type-argument qname "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))) + (cond ((symbol? qname) (values (symbol-name qname) qname)) + ((string? qname) (values qname (string->symbol qname))) (else (bad-name))) (let ((type (string-is-xml-nmtoken? string))) - (cond ((and type (default-xml-namespace-iri? iri)) + (cond ((and type (null-xml-namespace-iri? iri)) symbol) ((eq? type 'NAME) (let ((iri (make-xml-namespace-iri iri))) @@ -131,21 +131,21 @@ USA. symbol))))) (else (bad-name))))))) -(define (%make-xml-name simple iri local) +(define (%make-xml-name qname iri local) (let ((uname - (hash-table/intern! (hash-table/intern! universal-names + (hash-table/intern! (hash-table/intern! expanded-names iri make-eq-hash-table) local (lambda () - (make-universal-name iri - local - (make-eq-hash-table)))))) - (hash-table/intern! (universal-name-combos uname) - simple - (lambda () (make-combo-name simple uname))))) - -(define universal-names + (make-expanded-name iri + local + (make-eq-hash-table)))))) + (hash-table/intern! (expanded-name-combos uname) + qname + (lambda () (make-combo-name qname uname))))) + +(define expanded-names (make-eq-hash-table)) (define xml-iri @@ -154,20 +154,20 @@ USA. (define xmlns-iri (make-xml-namespace-iri "http://www.w3.org/2000/xmlns/")) -(define (xml-name-simple name) +(define (xml-name-qname name) (cond ((xml-nmtoken? name) name) - ((combo-name? name) (combo-name-simple name)) - (else (error:not-xml-name name 'XML-NAME-simple)))) + ((combo-name? name) (combo-name-qname name)) + (else (error:not-xml-name name 'XML-NAME-QNAME)))) -(define (xml-name-simple=? name simple) - (eq? (xml-name-simple name) simple)) +(define (xml-name-qname=? name qname) + (eq? (xml-name-qname name) qname)) (define (xml-name-string name) - (symbol-name (xml-name-simple name))) + (symbol-name (xml-name-qname name))) (define (xml-name-iri name) - (cond ((xml-nmtoken? name) (default-xml-namespace-iri)) - ((combo-name? name) (universal-name-iri (combo-name-universal name))) + (cond ((xml-nmtoken? name) (null-xml-namespace-iri)) + ((combo-name? name) (expanded-name-iri (combo-name-expanded name))) (else (error:not-xml-name name 'XML-NAME-IRI)))) (define (xml-name-iri=? name iri) @@ -177,7 +177,7 @@ USA. (let ((s (symbol-name (cond ((xml-nmtoken? name) name) - ((combo-name? name) (combo-name-simple name)) + ((combo-name? name) (combo-name-qname name)) (else (error:not-xml-name name 'XML-NAME-PREFIX)))))) (let ((c (string-find-next-char s #\:))) (if c @@ -185,10 +185,10 @@ USA. (null-xml-name-prefix))))) (define (null-xml-name-prefix? object) - (eq? object ':NULL)) + (eq? object '||)) (define (null-xml-name-prefix) - ':NULL) + '||) (define (xml-name-prefix=? name prefix) (eq? (xml-name-prefix name) prefix)) @@ -200,7 +200,7 @@ USA. (if c (string-tail->symbol s (fix:+ c 1)) name)))) - ((combo-name? name) (universal-name-local (combo-name-universal name))) + ((combo-name? name) (expanded-name-local (combo-name-expanded name))) (else (error:not-xml-name name 'XML-NAME-LOCAL)))) (define (xml-name-local=? name local) @@ -210,14 +210,14 @@ USA. (let ((lose (lambda (n) (error:not-xml-name n 'XML-NAME=?)))) (cond ((xml-nmtoken? n1) (cond ((xml-nmtoken? n2) (eq? n1 n2)) - ((combo-name? n2) (eq? n1 (combo-name-simple n2))) + ((combo-name? n2) (eq? n1 (combo-name-qname n2))) (else (lose n2)))) ((combo-name? n1) (cond ((xml-nmtoken? n2) - (eq? (combo-name-simple n1) n2)) + (eq? (combo-name-qname n1) n2)) ((combo-name? n2) - (eq? (combo-name-universal n1) - (combo-name-universal n2))) + (eq? (combo-name-expanded n1) + (combo-name-expanded n2))) (else (lose n2)))) (else (lose n1))))) @@ -661,7 +661,7 @@ USA. (define-xml-printer element (lambda (elt) - (xml-name-simple (xml-element-name elt)))) + (xml-name-qname (xml-element-name elt)))) (define-xml-printer external-id (lambda (dtd) diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg index eb909bb64..414ec0f2e 100644 --- a/v7/src/xml/xml.pkg +++ b/v7/src/xml/xml.pkg @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: xml.pkg,v 1.31 2003/09/26 00:35:45 cph Exp $ +$Id: xml.pkg,v 1.32 2003/09/26 01:00:07 cph Exp $ Copyright 2001,2002,2003 Massachusetts Institute of Technology @@ -51,8 +51,6 @@ USA. - default-xml-namespace-iri - default-xml-namespace-iri? error:not-xml-attribute-value error:not-xml-!attlist error:not-xml-!element @@ -109,6 +107,8 @@ USA. make-xml-unparsed-!entity null-xml-name-prefix null-xml-name-prefix? + null-xml-namespace-iri + null-xml-namespace-iri? set-xml-!attlist-definitions! set-xml-!attlist-name! set-xml-!element-content-type! @@ -201,8 +201,8 @@ USA. xml-name-local=? xml-name-prefix xml-name-prefix=? - xml-name-simple - xml-name-simple=? + xml-name-qname + xml-name-qname=? xml-name-string xml-name-iri xml-name-iri=? -- 2.25.1