Fix problem in declaration parser.
authorChris Hanson <org/chris-hanson/cph>
Tue, 16 Oct 2001 20:13:03 +0000 (20:13 +0000)
committerChris Hanson <org/chris-hanson/cph>
Tue, 16 Oct 2001 20:13:03 +0000 (20:13 +0000)
v7/src/xml/xml-parser.scm

index 2e778a53d5a0e20500f7779bb01109d4841775d8..d4ed011f96d78296a6c0c21b800170f333ffa801 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: xml-parser.scm,v 1.10 2001/07/16 20:39:33 cph Exp $
+;;; $Id: xml-parser.scm,v 1.11 2001/10/16 20:13:03 cph Exp $
 ;;;
 ;;; Copyright (c) 2001 Massachusetts Institute of Technology
 ;;;
 ;;;; Top level
 
 (define (parse-xml-document buffer)    ;[1,22]
-  (fluid-let ((*general-entities* (predefined-entities))
-             (*standalone?*)
-             (*internal-dtd?* #t))
-    (let ((declaration (parse-declaration buffer))
-         (one-value (lambda (v) (and v (vector-ref v 0)))))
-      (set! *standalone?*
-           (and declaration
-                (equal? (xml-declaration-standalone declaration)
-                        "yes")))
-      (let* ((misc-1 (one-value (parse-misc buffer)))
-            (dtd (one-value (parse-dtd buffer)))
-            (misc-2 (if dtd (one-value (parse-misc buffer)) '()))
-            (element
-             (or (one-value (parse-element buffer))
-                 (perror buffer "Missing root element")))
-            (misc-3 (one-value (parse-misc buffer))))
-       (if (peek-parser-buffer-char buffer)
-           (perror buffer "Unparsed content in input"))
-       (make-xml-document declaration
-                          misc-1
-                          dtd
-                          misc-2
-                          element
-                          misc-3)))))
+  (let ((one-value (lambda (v) (and v (vector-ref v 0)))))
+    (fluid-let ((*general-entities* (predefined-entities))
+               (*standalone?*)
+               (*internal-dtd?* #t))
+      (let ((declaration (one-value (parse-declaration buffer))))
+       (set! *standalone?*
+             (and declaration
+                  (equal? (xml-declaration-standalone declaration)
+                          "yes")))
+       (let* ((misc-1 (one-value (parse-misc buffer)))
+              (dtd (one-value (parse-dtd buffer)))
+              (misc-2 (if dtd (one-value (parse-misc buffer)) '()))
+              (element
+               (or (one-value (parse-element buffer))
+                   (perror buffer "Missing root element")))
+              (misc-3 (one-value (parse-misc buffer))))
+         (if (peek-parser-buffer-char buffer)
+             (perror buffer "Unparsed content in input"))
+         (make-xml-document declaration
+                            misc-1
+                            dtd
+                            misc-2
+                            element
+                            misc-3))))))
 
 (define *standalone?*)
 (define *internal-dtd?*)
   (*parser
    (top-level
     (with-pointer p
-      (transform
+      (encapsulate
          (lambda (v)
            (transform-declaration (vector-ref v 0) allow-standalone? p))
        (sbracket description "<?xml" "?>"