From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 13 Jul 2003 03:41:29 +0000 (+0000)
Subject: Export predicates for some key data structures.  Allow use of wide
X-Git-Tag: 20090517-FFI~1874
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=119ee293674481e120a55827fb93cb94e428a5d2;p=mit-scheme.git

Export predicates for some key data structures.  Allow use of wide
strings wherever they make sense.
---

diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm
index 9f0ae8806..9730d0ff3 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.13 2003/07/12 04:34:43 cph Exp $
+$Id: xml-struct.scm,v 1.14 2003/07/13 03:41:29 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -156,43 +156,50 @@ USA.
 (define char-set:xml-encoding
   (char-set-union char-set:alphanumeric
 		  (string->char-set "_.-")))
-
+
 (define-xml-type element
   (name xml-name?)
-  (attributes
-   (lambda (object)
-     (list-of-type? object
-       (lambda (object)
-	 (and (pair? object)
-	      (xml-name? (car object))
-	      (attribute-value? (cdr object)))))))
-  (contents
-   (lambda (object)
-     (list-of-type? object
-       (lambda (object)
-	 (or (string? object)
-	     (wide-string? object)
-	     (xml-comment? object)
-	     (xml-element? object)
-	     (xml-processing-instructions? object)
-	     (xml-entity-ref? object)))))))
-
-(define (attribute-value? object)
+  (attributes xml-attribute-list?)
+  (contents xml-content?))
+
+(define (xml-attribute-list? object)
+  (list-of-type? object xml-attribute?))
+
+(define (xml-attribute? object)
+  (and (pair? object)
+       (xml-name? (car object))
+       (xml-attribute-value? (cdr object))))
+
+(define (xml-attribute-value? object)
   (and (pair? object)
        (list-of-type? object
 	 (lambda (object)
-	   (or (string? object)
+	   (or (xml-char-data? object)
 	       (xml-entity-ref? object))))))
 
+(define (xml-content? object)
+  (list-of-type? object xml-content-item?))
+
+(define (xml-content-item? object)
+  (or (xml-char-data? object)
+      (xml-comment? object)
+      (xml-element? object)
+      (xml-processing-instructions? object)
+      (xml-entity-ref? object)))
+
+(define (xml-char-data? object)
+  (or (string? object)
+      (wide-string? object)))
+
 (define-xml-type comment
-  (text string?))
+  (text xml-char-data?))
 
 (define-xml-type processing-instructions
   (name
    (lambda (object)
      (and (xml-name? object)
 	  (not (string-ci=? "xml" (symbol-name object))))))
-  (text string?))
+  (text xml-char-data?))
 
 (define-xml-type dtd
   (root xml-name?)
@@ -221,7 +228,7 @@ USA.
   (uri
    (lambda (object)
      (or (not object)
-	 (string? object)))))
+	 (xml-char-data? object)))))
 
 (define (public-id? object)
   (string-composed-of? object char-set:xml-public-id))
@@ -299,10 +306,10 @@ USA.
       (eq? object 'IMPLIED)
       (and (pair? object)
 	   (eq? 'FIXED (car object))
-	   (attribute-value? (cdr object)))
+	   (xml-attribute-value? (cdr object)))
       (and (pair? object)
 	   (eq? 'DEFAULT (car object))
-	   (attribute-value? (cdr object)))))
+	   (xml-attribute-value? (cdr object)))))
 
 (define-xml-type !entity
   (name xml-name?)
@@ -321,7 +328,7 @@ USA.
   (or (and (pair? object)
 	   (list-of-type? object
 	     (lambda (object)
-	       (or (string? object)
+	       (or (xml-char-data? object)
 		   (xml-entity-ref? object)
 		   (xml-parameter-entity-ref? object)))))
       (xml-external-id? object)))
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index a6fcb2eae..0864ec89a 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.19 2003/03/08 02:14:11 cph Exp $
+$Id: xml.pkg,v 1.20 2003/07/13 03:41:25 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -113,8 +113,14 @@ USA.
 	  xml-!notation-id
 	  xml-!notation-name
 	  xml-!notation?
+	  xml-attribute-list?
+	  xml-attribute-value?
+	  xml-attribute?
+	  xml-char-data?
 	  xml-comment-text
 	  xml-comment?
+	  xml-content-item?
+	  xml-content?
 	  xml-declaration-encoding
 	  xml-declaration-standalone
 	  xml-declaration-version