Change DTD structures to use symbol names that are more closely

related to the tokens appearing in the XML document.

diff --git a/v7/src/xml/xml-output.scm b/v7/src/xml/xml-output.scm
index 14ff4123785461f8f66904a571ba60437e2e8a5b..fd4adb8a26f727ec346c847e6c4426af3bc41db7 100644 (file)
--- a/v7/src/xml/xml-output.scm
+++ b/v7/src/xml/xml-output.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: xml-output.scm,v 1.22 2003/07/30 19:43:59 cph Exp $
+$Id: xml-output.scm,v 1.23 2003/08/01 19:31:02 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -172,7 +172,7 @@ USA.
   (let ((type (xml-!element-content-type decl)))
     (cond ((symbol? type)
           (emit-string (string-upcase (symbol-name type)) ctx))
-         ((and (pair? type) (eq? (car type) 'MIX))
+         ((and (pair? type) (eq? (car type) '|#PCDATA|))
           (emit-string "(#PCDATA" ctx)
           (if (pair? (cdr type))
               (begin
@@ -194,7 +194,7 @@ USA.
                       (emit-string "(" ctx)
                       (write-cp (cadr type))
                       (for-each
-                       (let ((sep (if (eq? (car type) 'ALT) "|" ",")))
+                       (let ((sep (if (eq? (car type) 'alt) "|" ",")))
                          (lambda (type)
                            (emit-string sep ctx)
                            (write-cp type)))
@@ -234,7 +234,7 @@ USA.
           (let ((type (cadr definition)))
             (cond ((symbol? type)
                    (emit-string (string-upcase (symbol-name type)) ctx))
-                  ((and (pair? type) (eq? (car type) 'NOTATION))
+                  ((and (pair? type) (eq? (car type) '|NOTATION|))
                    (emit-string "NOTATION (" ctx)
                    (if (pair? (cdr type))
                        (begin
@@ -244,7 +244,7 @@ USA.
                                      (write-xml-name name ctx))
                                    (cddr type))))
                    (emit-string ")" ctx))
-                  ((and (pair? type) (eq? (car type) 'ENUMERATED))
+                  ((and (pair? type) (eq? (car type) 'enumerated))
                    (emit-string "(" ctx)
                    (if (pair? (cdr type))
                        (begin
@@ -258,15 +258,14 @@ USA.
                    (error "Malformed !ATTLIST type:" type))))
           (emit-string " " ctx)
           (let ((default (caddr definition)))
-            (cond ((eq? default 'REQUIRED)
-                   (emit-string "#REQUIRED" ctx))
-                  ((eq? default 'IMPLIED)
-                   (emit-string "#IMPLIED" ctx))
-                  ((and (pair? default) (eq? (car default) 'FIXED))
-                   (emit-string "#FIXED" ctx)
+            (cond ((or (eq? default '|#REQUIRED|)
+                       (eq? default '|#IMPLIED|))
+                   (emit-string (symbol-name default) ctx))
+                  ((and (pair? default) (eq? (car default) '|#FIXED|))
+                   (emit-string (symbol-name (car default)) ctx)
                    (emit-string " " ctx)
                    (write-xml-attribute-value (cdr default) ctx))
-                  ((and (pair? default) (eq? (car default) 'DEFAULT))
+                  ((and (pair? default) (eq? (car default) 'default))
                    (write-xml-attribute-value (cdr default) ctx))
                   (else
                    (error "Malformed !ATTLIST default:" default)))))))

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index 0fae4bcd4c2cb3173269d4b2517ca11d42ee3352..0ba4af7028de6af16c889fdc040b1d0786972221 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.30 2003/08/01 03:50:16 cph Exp $
+$Id: xml-parser.scm,v 1.31 2003/08/01 19:30:55 cph Exp $
 
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
 
@@ -974,10 +974,10 @@ USA.
         (encapsulate encapsulate-suffix
           (seq (sbracket "!ELEMENT type" "(" ")"
                  S?
-                 (alt (encapsulate (lambda (v) (cons 'ALT (vector->list v)))
+                 (alt (encapsulate (lambda (v) (cons 'alt (vector->list v)))
                         (seq parse-cp
                              (+ (seq S? "|" S? parse-cp))))
-                      (encapsulate (lambda (v) (cons 'SEQ (vector->list v)))
+                      (encapsulate (lambda (v) (cons 'seq (vector->list v)))
                         (seq parse-cp
                              (* (seq S? "," S? parse-cp)))))
                  S?)
@@ -1005,14 +1005,14 @@ USA.
         parse-required-element-name
         S
         ;;[46]
-        (alt (map intern (match (string "EMPTY")))
-             (map intern (match (string "ANY")))
+        (alt (map xml-intern (match "EMPTY"))
+             (map xml-intern (match "ANY"))
              ;;[51]
-             (encapsulate (lambda (v) (cons 'MIX (vector->list v)))
+             (encapsulate vector->list
                (with-pointer p
                  (seq "("
                       S?
-                      "#PCDATA"
+                      (map string->symbol (match "#PCDATA"))
                       (alt (seq S? ")")
                            (seq (* (seq S? "|" S?
                                         parse-required-element-name))
@@ -1042,7 +1042,7 @@ USA.
                        (type (vector-ref v 1))
                        (default (vector-ref v 2)))
                    (list name type
-                         (if (and (not (eq? type 'CDATA))
+                         (if (and (not (eq? type '|CDATA|))
                                   (pair? default))
                              (list (car default)
                                    (trim-attribute-whitespace (cadr default)))
@@ -1057,27 +1057,23 @@ USA.
 
 (define parse-!attlist-type            ;[54,57]
   (*parser
-   (alt (map intern
+   (alt (map xml-intern
             ;;[55,56]
-            (alt (match (string "CDATA"))
-                 (match (string "IDREFS"))
-                 (match (string "IDREF"))
-                 (match (string "ID"))
-                 (match (string "ENTITY"))
-                 (match (string "ENTITIES"))
-                 (match (string "NMTOKENS"))
-                 (match (string "NMTOKEN"))))
+            (match (alt "CDATA" "IDREFS" "IDREF" "ID"
+                        "ENTITY" "ENTITIES" "NMTOKENS" "NMTOKEN")))
        ;;[58]
-       (encapsulate (lambda (v) (cons 'NOTATION (vector->list v)))
+       (encapsulate vector->list
          (bracket "notation type"
-             (noise (seq (string "NOTATION") S (string "(")))
+             (seq (map xml-intern (match "NOTATION"))
+                  S
+                  "(")
              ")"
            S?
            parse-notation-name
            (* (seq S? "|" S? parse-notation-name))
            S?))
        ;;[59]
-       (encapsulate (lambda (v) (cons 'ENUMERATED (vector->list v)))
+       (encapsulate (lambda (v) (cons 'enumerated (vector->list v)))
          (sbracket "enumerated type" "(" ")"
            S?
            parse-required-name-token
@@ -1086,16 +1082,12 @@ USA.
 
 (define parse-!attlist-default         ;[60]
   (*parser
-   (alt (seq "#"
-            (map intern
-                 (alt (match (string "REQUIRED"))
-                      (match (string "IMPLIED")))))
+   (alt (map string->symbol (match (alt "#REQUIRED" "#IMPLIED")))
        (encapsulate (lambda (v) (cons (vector-ref v 0) (vector-ref v 1)))
-         (seq "#"
-              (map intern (match (string "FIXED")))
+         (seq (map string->symbol (match "#FIXED"))
               S
               parse-attribute-value))
-       (encapsulate (lambda (v) (cons 'DEFAULT (vector-ref v 0)))
+       (encapsulate (lambda (v) (cons 'default (vector-ref v 0)))
          parse-attribute-value))))
 \f
 (define parse-!entity                  ;[70,71,72,73,74,76]
@@ -1203,7 +1195,7 @@ USA.
                             (seq (char #\") (* (alphabet a2)) (char #\"))
                             (seq (char #\') (* (alphabet a3)) (char #\'))))
                       parse-parameter-entity-reference))
-              (match (string ">")))))))))))
+              (match ">"))))))))))
 
 (define (reparse-text v parser description ptr)
   (let ((v (coalesce-elements v)))
@@ -1297,7 +1289,7 @@ USA.
                S?
                parse-parameter-entity-reference
                S?
-               (match (string "[")))
+               (match "["))
           (match (string conditional-end))
         (match (* match-!ignore-contents)))))))