Change several error messages to be clearer or more accurate.

diff --git a/v7/src/xml/parser-macro.scm b/v7/src/xml/parser-macro.scm
index 3930a20ad5340541adf5569799613fdb6525d99e..8cbc963c177815cab7cb26c7fe0f4529e5c653ce 100644 (file)
--- a/v7/src/xml/parser-macro.scm
+++ b/v7/src/xml/parser-macro.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: parser-macro.scm,v 1.8 2003/02/14 18:28:38 cph Exp $
+$Id: parser-macro.scm,v 1.9 2006/02/15 06:08:07 cph Exp $
 
-Copyright 2001 Massachusetts Institute of Technology
+Copyright 2001,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -45,9 +45,8 @@ USA.
                    (PERROR
                     ,v
                     ,(if (string? description)
-                         (string-append "Unterminated " description)
-                         `(STRING-APPEND "Unterminated "
-                                         ,description))))))))))
+                         (string-append "Malformed " description)
+                         `(STRING-APPEND "Malformed " ,description))))))))))
 
 (define-*parser-macro (sbracket description open close . body)
   `(BRACKET ,description (NOISE (STRING ,open)) (NOISE (STRING ,close))

diff --git a/v7/src/xml/xml-parser.scm b/v7/src/xml/xml-parser.scm
index 8a3816701002bd6df0ba6de6715fb66ca7c57345..b2a5d727588e016886f112b359ee593bc0cf3429 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.69 2006/02/12 02:48:53 cph Exp $
+$Id: xml-parser.scm,v 1.70 2006/02/15 06:08:12 cph Exp $
 
 Copyright 2001,2002,2003,2004,2005,2006 Massachusetts Institute of Technology
 
@@ -293,9 +293,8 @@ USA.
         (lambda (version encoding standalone)
           (if (and (not text-decl?) (not version))
               (perror p "Missing XML version"))
-          (if (not (if version
-                       (match-xml-version (string->parser-buffer version))
-                       #t))
+          (if (and version
+                   (not (match-xml-version (string->parser-buffer version))))
               (perror p "Malformed XML version" version))
           (if (and version (not (string=? version "1.0")))
               (perror p "Unsupported XML version" version))
@@ -330,7 +329,8 @@ USA.
                    (finish (caddr results) (cadr results) (car results)))))
          (begin
            (if (pair? attributes)
-               (perror p "Extra attributes in XML declaration" attributes))
+               (perror p "Extra attributes in XML declaration"
+                       (map xml-attribute-name attributes)))
            (if text-decl?
                (finish (cadr results) (car results) #f)
                (finish (caddr results) (cadr results) (car results))))))))
@@ -746,7 +746,7 @@ USA.
 \f
 ;;;; Attributes
 
-(define (attribute-list-parser parse-name name=?)
+(define (attribute-list-parser parse-name ->name)
   (let ((parse-attribute (attribute-parser parse-name)))
     (*parser
      (with-pointer p
@@ -755,10 +755,11 @@ USA.
             (let ((attrs (vector->list v)))
               (do ((attrs attrs (cdr attrs)))
                   ((not (pair? attrs)))
-                (let ((name (xml-attribute-name (car attrs))))
+                (let ((name (->name (xml-attribute-name (car attrs)))))
                   (if (there-exists? (cdr attrs)
                         (lambda (attr)
-                          (name=? (xml-attribute-name attr) name)))
+                          (xml-name=? (->name (xml-attribute-name attr))
+                                      name)))
                       (perror p "Attributes with same name" name))))
               attrs))
         (seq (* parse-attribute)
@@ -778,11 +779,11 @@ USA.
 
 (define parse-attribute-list
   (attribute-list-parser parse-unexpanded-name
-                        (lambda (a b) (xml-name=? (car a) (car b)))))
+                        (lambda (a) (car a))))
 
 (define parse-declaration-attributes
   (attribute-list-parser (*parser (map make-xml-qname (match match-name)))
-                        xml-name=?))
+                        (lambda (a) a)))
 \f
 (define (attribute-value-parser alphabet parse-reference)
   (let ((a1 (alphabet- alphabet (string->alphabet "\"")))
@@ -979,7 +980,7 @@ USA.
       (perror p "Circular entity reference" name))
   (let ((entity (find-entity name)))
     (if (not entity)
-       (perror p "Reference to undefined entity" name))
+       (perror p "Reference to undeclared entity" name))
     (if (xml-unparsed-!entity? entity)
        (perror p "Reference to unparsed entity" name))
     (let ((value (xml-!entity-value entity)))
@@ -988,7 +989,7 @@ USA.
       (if (not (and (pair? value)
                    (string? (car value))
                    (null? (cdr value))))
-         (perror p "Reference to partially-defined entity" name))
+         (perror p "Reference to partially-declared entity" name))
       (if in-attribute?
          (car value)
          (reparse-entity-value-string name (car value) p)))))
@@ -1148,15 +1149,14 @@ USA.
                       S?
                       (map string->symbol (match "#PCDATA"))
                       (alt (seq S? ")")
-                           (seq (* (seq S? "|" S?
-                                        parse-required-element-name))
+                           (seq (* (seq S? "|" S? parse-element-name))
                                 S?
                                 ")*")
 
                            (sexp
                             (lambda (buffer)
                               buffer
-                              (perror p "Unterminated !ELEMENT type")))))))
+                              (perror p "Ill-formed declaration value")))))))
              parse-children))))))
 \f
 (define parse-!attlist                 ;[52,53]