Implement new procedures (and use where appropriate):

    SIMPLE-XML-ATTRIBUTE-VALUE?
    XML-NAME-LOCAL=?
    XML-NAME-PREFIX=?
    XML-NAME-SIMPLE=?
    XML-NAME-URI=?

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index 277548c21ec5d95c63881f378e1c5d07531909cf..440fb87b8af6949c5bba518f48d3495cb0a364e7 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.40 2003/09/16 04:32:59 cph Exp $
+$Id: xml-parser.scm,v 1.41 2003/09/24 03:26:19 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -73,11 +73,6 @@ USA.
      (alt (sbracket description "\"" "\"" (match (* (alphabet a1))))
          (sbracket description "'" "'" (match (* (alphabet a2))))))))
 
-(define (simple-attribute-value? v)
-  (and (pair? v)
-       (string? (car v))
-       (null? (cdr v))))
-
 (define (read-xml-file pathname #!optional pi-handlers)
   (call-with-input-file pathname
     (lambda (port)
@@ -183,7 +178,7 @@ USA.
 (define (transform-declaration attributes text-decl? p)
   (if (not (for-all? attributes
             (lambda (attribute)
-              (simple-attribute-value? (cdr attribute)))))
+              (simple-xml-attribute-value? (cdr attribute)))))
       (perror p "XML declaration can't contain entity refs" attributes))
   (let ((finish
         (lambda (version encoding standalone)
@@ -355,7 +350,7 @@ USA.
                        "Incorrect attribute value"
                        (string->symbol name)))
            (if (and (not (eq? type '|CDATA|))
-                    (simple-attribute-value? av))
+                    (simple-xml-attribute-value? av))
                (set-car! av (trim-attribute-whitespace (car av))))
            attributes)
          (begin
@@ -479,7 +474,7 @@ USA.
                      (pn (cdr name)))
                  (let ((uri
                         (lambda ()
-                          (if (not (simple-attribute-value? value))
+                          (if (not (simple-xml-attribute-value? value))
                               (perror pn "Illegal namespace URI" value))
                           (if (string-null? (car value))
                               #f       ;xmlns=""
@@ -892,7 +887,7 @@ USA.
              (let ((entity (find-parameter-entity name)))
                (and entity
                     (xml-parameter-!entity-value entity))))))
-    (if (simple-attribute-value? value)
+    (if (simple-xml-attribute-value? value)
        (car value)
        (begin
          (set! *parameter-entities* 'STOP)
@@ -922,7 +917,7 @@ USA.
                (let ((value (xml-!entity-value entity)))
                  (cond ((xml-external-id? value) #f)
                        (in-attribute? value)
-                       ((simple-attribute-value? value)
+                       ((simple-xml-attribute-value? value)
                         (reparse-entity-value-string name (car value) p))
                        (else
                         (if (or *standalone?* *internal-dtd?*)
@@ -1113,7 +1108,7 @@ USA.
                    (list name type
                          (if (and (not (eq? type '|CDATA|))
                                   (pair? default)
-                                  (simple-attribute-value? (cdr default)))
+                                  (simple-xml-attribute-value? (cdr default)))
                              (list (car default)
                                    (trim-attribute-whitespace (cadr default)))
                              default))))

diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm
index 5716cb5f205f231131cf5187595ed00432c61a1f..85c7988b92c907bdfb12af747b6a2b179f814f03 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.24 2003/09/17 03:20:45 cph Exp $
+$Id: xml-struct.scm,v 1.25 2003/09/24 03:26:23 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -119,6 +119,9 @@ USA.
        ((combo-name? name) (combo-name-simple name))
        (else (error:not-xml-name name 'XML-NAME-simple))))
 
+(define (xml-name-simple=? name simple)
+  (eq? (xml-name-simple name) simple))
+
 (define (xml-name-string name)
   (symbol-name (xml-name-simple name)))
 
@@ -127,6 +130,9 @@ USA.
        ((combo-name? name) (universal-name-uri (combo-name-universal name)))
        (else (error:not-xml-name name 'XML-NAME-URI))))
 
+(define (xml-name-uri=? name uri)
+  (eq? (xml-name-uri name) uri))
+
 (define (xml-name-prefix name)
   (let ((simple
         (lambda (name)
@@ -139,6 +145,9 @@ USA.
          ((combo-name? name) (simple (combo-name-simple name)))
          (else (error:not-xml-name name 'XML-NAME-PREFIX)))))
 
+(define (xml-name-prefix=? name prefix)
+  (eq? (xml-name-prefix name) prefix))
+
 (define (xml-name-local name)
   (cond ((xml-nmtoken? name)
         (let ((s (symbol-name name)))
@@ -149,6 +158,9 @@ USA.
        ((combo-name? name) (universal-name-local (combo-name-universal name)))
        (else (error:not-xml-name name 'XML-NAME-LOCAL))))
 
+(define (xml-name-local=? name local)
+  (eq? (xml-name-local name) local))
+
 (define (xml-name=? n1 n2)
   (let ((lose (lambda (n) (error:not-xml-name n 'XML-NAME=?))))
     (cond ((xml-nmtoken? n1)
@@ -341,6 +353,11 @@ USA.
   (and (pair? object)
        (list-of-type? object xml-attribute-value-item?)))
 
+(define (simple-xml-attribute-value? object)
+  (and (pair? object)
+       (xml-char-data? (car object))
+       (null? (cdr object))))
+
 (define (xml-attribute-value-item? object)
   (or (xml-char-data? object)
       (xml-entity-ref? object)))

diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index 07151ef70042795e32d7f111c475cdbe0ba6aae2..748d9a50ff5f35f5e7b10f21e4dee20b180318b9 100644 (file)
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.25 2003/09/17 03:20:41 cph Exp $
+$Id: xml.pkg,v 1.26 2003/09/24 03:26:16 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -103,6 +103,7 @@ USA.
          set-xml-unparsed-!entity-id!
          set-xml-unparsed-!entity-name!
          set-xml-unparsed-!entity-notation!
+         simple-xml-attribute-value?
          xml-!attlist-definitions
          xml-!attlist-name
          xml-!attlist?
@@ -151,10 +152,14 @@ USA.
          xml-intern
          xml-name-hash
          xml-name-local
+         xml-name-local=?
          xml-name-prefix
+         xml-name-prefix=?
          xml-name-simple
+         xml-name-simple=?
          xml-name-string
          xml-name-uri
+         xml-name-uri=?
          xml-name=?
          xml-name?
          xml-nmtoken?
@@ -184,7 +189,7 @@ USA.
          read-xml-file
          string->xml
          substring->xml)
-  (export (runtime xml structure)
+  (export (runtime xml)
          alphabet:name-initial
          alphabet:name-subsequent))