[cxml-cvs] CVS update: cxml/xml/xml-parse.lisp

[David Lichteblau]

Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv24800/xml

Modified Files:
	xml-parse.lisp 
Log Message:
-sun/not-wf/sgml03.xml [not-wf?] FAILED:
-  well-formedness violation not detected
-[
-    Comments may not contain "--"]

Date: Sun Nov 27 01:07:30 2005
Author: dlichteblau

Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.12 cxml/xml/xml-parse.lisp:1.13
--- cxml/xml/xml-parse.lisp:1.12	Sun Nov 27 00:57:10 2005
+++ cxml/xml/xml-parse.lisp	Sun Nov 27 01:07:29 2005
@@ -132,11 +132,7 @@
 ;;
 ;; o max depth together with circle detection
 ;;   (or proof, that our circle detection is enough).
-;;
-;; o element definitions (with att definitions in the elements)
-;;   [das haben wir doch, oder?]
-;;
-;; o store entities in the DTD
+;;   [was fuer circle detection?--david]
 ;;
 ;; o better extensibility wrt character representation, one may want to
 ;;   have
@@ -151,38 +147,12 @@
 ;;   [ausgelagert sind sie; dokumentiert "so la la"; die Reintegration
 ;;   in Closure ist ein ganz anderes Thema]
 ;;
-;; o merge node representation with SGML module
-;;   [???]
-;;
-;; o line/column number recording
-;;
-;; o better error messages
-;;
 ;; o recording of source locations for nodes.
 ;;
-;; o make the *scratch-pad* hack safe
-;;
 ;; o based on the DTD and xml:space attribute implement HTML white
 ;;   space rules.
 ;;
 ;; o on a parser option, do not expand external entities.
-;;
-;; o does the user need the distinction between "" and " " ?
-;;   That is literal and 'quoted' white space.
-;;   [verstehe ich nicht --david]
-;;
-;; o on an option merge CDATA section;
-;;
-;; o data in parse tree? extra nodes like in SGML?!
-;;
-;; o what to store in the node-gi field? Some name object or the
-;;   string used?
-;;
-
-;; Test that fail:
-;;
-;; not-wf/sa/128        is false a alarm
-;;
 
 ;;;; Validity constraints:
 ;;;; (00) Root Element Type                     like (03), c.f. MAKE-ROOT-MODEL
@@ -1586,40 +1556,37 @@
         (go state-1)))))
 
 (defun read-comment-content (input &aux d)
-  (let ((warnedp nil))
-    (with-rune-collector (collect)
-      (block nil
-        (tagbody
-         state-1
-          (setf d (read-rune input))
-          (unless (data-rune-p d)
-            (error "Illegal char: ~S." d))
-          (when (rune= d #/-) (go state-2))
-          (collect d)
-          (go state-1)
-         state-2 ;; #/- seen
-          (setf d (read-rune input))
-          (unless (data-rune-p d)
-            (error "Illegal char: ~S." d))
-          (when (rune= d #/-) (go state-3))
-          (collect #/-)
-          (collect d)
-          (go state-1)
-         state-3 ;; #/- #/- seen
-          (setf d (read-rune input))
-          (unless (data-rune-p d)
-            (error "Illegal char: ~S." d))
-          (when (rune= d #/>) (return))
-          (unless warnedp
-            (warn "WFC: no '--' in comments please.")
-            (setf warnedp t))
-          (when (rune= d #/-)
-            (collect #/-)
-            (go state-3))
-          (collect #/-)
-          (collect #/-)
-          (collect d)
-          (go state-1))))))
+  (with-rune-collector (collect)
+    (block nil
+      (tagbody
+       state-1
+	(setf d (read-rune input))
+	(unless (data-rune-p d)
+	  (wf-error "Illegal char: ~S." d))
+	(when (rune= d #/-) (go state-2))
+	(collect d)
+	(go state-1)
+       state-2 ;; #/- seen
+	(setf d (read-rune input))
+	(unless (data-rune-p d)
+	  (wf-error "Illegal char: ~S." d))
+	(when (rune= d #/-) (go state-3))
+	(collect #/-)
+	(collect d)
+	(go state-1)
+       state-3 ;; #/- #/- seen
+	(setf d (read-rune input))
+	(unless (data-rune-p d)
+	  (wf-error "Illegal char: ~S." d))
+	(when (rune= d #/>) (return))
+	(wf-error "'--' not allowed in a comment")
+	(when (rune= d #/-)
+	  (collect #/-)
+	  (go state-3))
+	(collect #/-)
+	(collect #/-)
+	(collect d)
+	(go state-1)))))
 
 (defun read-cdata-sect (input &aux d)
   ;; <![CDATA[ is already read