From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 27 Jun 2004 06:26:33 +0000 (+0000)
Subject: Fix valid-content tests on output of processing instructions to
X-Git-Tag: 20090517-FFI~1635
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=780811931563a680076caaec95e925b2e460410e;p=mit-scheme.git

Fix valid-content tests on output of processing instructions to
correspond to those in xml-struct.
---

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index d30332e24..f56a8df83 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.60 2004/05/26 15:26:29 cph Exp $
+$Id: xml-parser.scm,v 1.61 2004/06/27 06:26:26 cph Exp $
 
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
@@ -637,7 +637,7 @@ USA.
 		 (let ((entry (assq name *pi-handlers*)))
 		   (if entry
 		       (let ((content ((cadr entry) text)))
-			 (if (not (list-of-type? content valid-content?))
+			 (if (not (valid-content? content))
 			     (perror p
 				     "Illegal output from XML processor"
 				     name))
@@ -650,29 +650,22 @@ USA.
 		  (values "")))))))))
 
 (define parse-pi:misc
-  (pi-parser
-   (lambda (object)
-     (or (string? object)
-	 (xml-comment? object)
-	 (xml-processing-instructions? object)))))
+  (pi-parser xml-misc-content?))
 
 (define parse-pi:element
-  (pi-parser
-   (lambda (object)
-     (or (string? object)
-	 (xml-element? object)
-	 (xml-comment? object)
-	 (xml-processing-instructions? object)))))
+  (pi-parser xml-content?))
 
 (define parse-pi:internal-markup-decl
   (pi-parser
    (lambda (object)
-     (or (xml-!element? object)
-	 (xml-!attlist? object)
-	 (xml-!entity? object)
-	 (xml-!notation? object)
-	 (xml-comment? object)
-	 (xml-processing-instructions? object)))))
+     (list-of-type? object
+       (lambda (object)
+	 (or (xml-!element? object)
+	     (xml-!attlist? object)
+	     (xml-!entity? object)
+	     (xml-!notation? object)
+	     (xml-comment? object)
+	     (xml-processing-instructions? object)))))))
 
 ;;;; References
 
diff --git a/v7/src/xml/xml-struct.scm b/v7/src/xml/xml-struct.scm
index 440c00625..bf460b0f6 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.40 2003/11/03 21:32:31 cph Exp $
+$Id: xml-struct.scm,v 1.41 2004/06/27 06:26:33 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -104,13 +104,13 @@ USA.
 
 (define-xml-type document
   (declaration (lambda (object) (or (not object) (xml-declaration? object))))
-  (misc-1 misc-arg?)
+  (misc-1 xml-misc-content?)
   (dtd (lambda (object) (or (not object) (xml-dtd? object))))
-  (misc-2 misc-arg?)
+  (misc-2 xml-misc-content?)
   (root xml-element?)
-  (misc-3 misc-arg?))
+  (misc-3 xml-misc-content?))
 
-(define (misc-arg? object)
+(define (xml-misc-content? object)
   (list-of-type? object
     (lambda (object)
       (or (xml-comment? object)
diff --git a/v7/src/xml/xml.pkg b/v7/src/xml/xml.pkg
index a5098eddb..b905c0dab 100644
--- a/v7/src/xml/xml.pkg
+++ b/v7/src/xml/xml.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml.pkg,v 1.39 2004/02/25 21:00:45 cph Exp $
+$Id: xml.pkg,v 1.40 2004/06/27 06:26:13 cph Exp $
 
 Copyright 2001,2002,2003,2004 Massachusetts Institute of Technology
 
@@ -235,6 +235,7 @@ USA.
 	  xml-external-id-id
 	  xml-external-id-iri
 	  xml-external-id?
+	  xml-misc-content?
 	  xml-parameter-!entity-name
 	  xml-parameter-!entity-value
 	  xml-parameter-!entity?