[cxml-cvs] CVS update: cxml/xml/sax-handler.lisp cxml/xml/unparse.lisp cxml/xml/xml-parse.lisp
David Lichteblau
dlichteblau at common-lisp.net
Sun Dec 4 18:44:16 UTC 2005
Update of /project/cxml/cvsroot/cxml/xml
In directory common-lisp.net:/tmp/cvs-serv22921/xml
Modified Files:
sax-handler.lisp unparse.lisp xml-parse.lisp
Log Message:
DOM 2 Core. Ungetestet, aber die 1er tests laufen wieder, daher rein damit.
Date: Sun Dec 4 19:44:14 2005
Author: dlichteblau
Index: cxml/xml/sax-handler.lisp
diff -u cxml/xml/sax-handler.lisp:1.1.1.13 cxml/xml/sax-handler.lisp:1.2
--- cxml/xml/sax-handler.lisp:1.1.1.13 Sun Mar 13 19:02:51 2005
+++ cxml/xml/sax-handler.lisp Sun Dec 4 19:44:05 2005
@@ -72,6 +72,8 @@
#:end-cdata
#:start-dtd
#:end-dtd
+ #:start-internal-subset
+ #:end-internal-subset
#:unparsed-entity-declaration
#:external-entity-declaration
#:internal-entity-declaration
@@ -252,6 +254,16 @@
(defgeneric end-dtd (handler)
(:documentation "Called at the end of parsing a DTD.")
+ (:method ((handler t)) nil))
+
+(defgeneric start-internal-subset (handler)
+ (:documentation "Reports that an internal subset is present. Called before
+any definition from the internal subset is reported.")
+ (:method ((handler t)) nil))
+
+(defgeneric end-internal-subset (handler)
+ (:documentation "Called after processing of the internal subset has
+finished, if present.")
(:method ((handler t)) nil))
(defgeneric unparsed-entity-declaration
Index: cxml/xml/unparse.lisp
diff -u cxml/xml/unparse.lisp:1.3 cxml/xml/unparse.lisp:1.4
--- cxml/xml/unparse.lisp:1.3 Mon Nov 28 23:33:47 2005
+++ cxml/xml/unparse.lisp Sun Dec 4 19:44:06 2005
@@ -7,9 +7,9 @@
;;; Author: David Lichteblau <david at lichteblau.com>
;;; License: Lisp-LGPL (See file COPYING for details).
;;; ---------------------------------------------------------------------------
-;;; © copyright 1999 by Gilbert Baumann
-;;; © copyright 2004 by knowledgeTools Int. GmbH
-;;; © copyright 2004 by David Lichteblau (for headcraft.de)
+;;; © copyright 1999 by Gilbert Baumann
+;;; © copyright 2004 by knowledgeTools Int. GmbH
+;;; © copyright 2004 by David Lichteblau (for headcraft.de)
;;; This library is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Library General Public
@@ -184,42 +184,185 @@
(unparse-string public-id sink)
(write-rod #"\"" sink)))))
+(defmethod sax:start-internal-subset ((sink sink))
+ (ensure-doctype sink)
+ (write-rod #" [" sink)
+ (write-rune #/U+000A sink))
+
+(defmethod sax:end-internal-subset ((sink sink))
+ (ensure-doctype sink)
+ (write-rod #"]" sink))
+
(defmethod sax:notation-declaration ((sink sink) name public-id system-id)
- (when (and (canonical sink) (>= (canonical sink) 2))
- (let ((prev (previous-notation sink)))
- (cond
- (prev
- (unless (rod< prev name)
- (error "misordered notations; cannot unparse canonically")))
- (t
- (ensure-doctype sink)
- (write-rod #" [" sink)
- (write-rune #/U+000A sink)))
- (setf (previous-notation sink) name))
- (write-rod #"<!NOTATION " sink)
+ (let ((prev (previous-notation sink)))
+ (when (and (and (canonical sink) (>= (canonical sink) 2))
+ prev
+ (not (rod< prev name)))
+ (error "misordered notations; cannot unparse canonically"))
+ (setf (previous-notation sink) name))
+ (write-rod #"<!NOTATION " sink)
+ (write-rod name sink)
+ (cond
+ ((zerop (length public-id))
+ (write-rod #" SYSTEM '" sink)
+ (write-rod system-id sink)
+ (write-rune #/' sink))
+ ((zerop (length system-id))
+ (write-rod #" PUBLIC '" sink)
+ (write-rod public-id sink)
+ (write-rune #/' sink))
+ (t
+ (write-rod #" PUBLIC '" sink)
+ (write-rod public-id sink)
+ (write-rod #"' '" sink)
+ (write-rod system-id sink)
+ (write-rune #/' sink)))
+ (write-rune #/> sink)
+ (write-rune #/U+000A sink))
+
+(defmethod sax:unparsed-entity-declaration
+ ((sink sink) name public-id system-id notation-name)
+ (unless (and (canonical sink) (< (canonical sink) 3))
+ (write-rod #"<!ENTITY " sink)
(write-rod name sink)
(cond
((zerop (length public-id))
- (write-rod #" SYSTEM '" sink)
- (write-rod system-id sink)
- (write-rune #/' sink))
+ (write-rod #" SYSTEM '" sink)
+ (write-rod system-id sink)
+ (write-rune #/' sink))
((zerop (length system-id))
- (write-rod #" PUBLIC '" sink)
- (write-rod public-id sink)
- (write-rune #/' sink))
+ (write-rod #" PUBLIC '" sink)
+ (write-rod public-id sink)
+ (write-rune #/' sink))
(t
- (write-rod #" PUBLIC '" sink)
- (write-rod public-id sink)
- (write-rod #"' '" sink)
- (write-rod system-id sink)
- (write-rune #/' sink)))
+ (write-rod #" PUBLIC '" sink)
+ (write-rod public-id sink)
+ (write-rod #"' '" sink)
+ (write-rod system-id sink)
+ (write-rune #/' sink)))
+ (write-rod #" NDATA " sink)
+ (write-rod notation-name sink)
(write-rune #/> sink)
(write-rune #/U+000A sink)))
+(defmethod sax:external-entity-declaration
+ ((sink sink) kind name public-id system-id)
+ (when (canonical sink)
+ (error "cannot serialize parsed entities in canonical mode"))
+ (write-rod #"<!ENTITY " sink)
+ (when (eq kind :parameter)
+ (write-rod #" % " sink))
+ (write-rod name sink)
+ (cond
+ ((zerop (length public-id))
+ (write-rod #" SYSTEM '" sink)
+ (write-rod system-id sink)
+ (write-rune #/' sink))
+ ((zerop (length system-id))
+ (write-rod #" PUBLIC '" sink)
+ (write-rod public-id sink)
+ (write-rune #/' sink))
+ (t
+ (write-rod #" PUBLIC '" sink)
+ (write-rod public-id sink)
+ (write-rod #"' '" sink)
+ (write-rod system-id sink)
+ (write-rune #/' sink)))
+ (write-rune #/> sink)
+ (write-rune #/U+000A sink))
+
+(defmethod sax:internal-entity-declaration ((sink sink) kind name value)
+ (when (canonical sink)
+ (error "cannot serialize parsed entities in canonical mode"))
+ (write-rod #"<!ENTITY " sink)
+ (when (eq kind :parameter)
+ (write-rod #" % " sink))
+ (write-rod name sink)
+ (write-rune #/U+0020 sink)
+ (write-rune #/\" sink)
+ (unparse-string value sink)
+ (write-rune #/\" sink)
+ (write-rune #/> sink)
+ (write-rune #/U+000A sink))
+
+(defmethod sax:element-declaration ((sink sink) name model)
+ (when (canonical sink)
+ (error "cannot serialize element type declarations in canonical mode"))
+ (write-rod #"<!ELEMENT " sink)
+ (write-rod name sink)
+ (write-rune #/U+0020 sink)
+ (labels ((walk (m)
+ (cond
+ ((eq m :EMPTY)
+ (write-rod "EMPTY" sink))
+ ((eq m :PCDATA)
+ (write-rod "#PCDATA" sink))
+ ((atom m)
+ (unparse-string m sink))
+ (t
+ (ecase (car m)
+ (and
+ (write-rune #/\( sink)
+ (loop for (n . rest) on (cdr m) do
+ (walk n)
+ (when rest
+ (write-rune #\, sink)))
+ (write-rune #/\) sink))
+ (or
+ (write-rune #/\( sink)
+ (loop for (n . rest) on (cdr m) do
+ (walk n)
+ (when rest
+ (write-rune #\| sink)))
+ (write-rune #/\) sink))
+ (*
+ (walk (second m))
+ (write-rod #/* sink))
+ (+
+ (walk (second m))
+ (write-rod #/+ sink))
+ (?
+ (walk (second m))
+ (write-rod #/? sink)))))))
+ (walk model))
+ (write-rune #/> sink)
+ (write-rune #/U+000A sink))
+
+(defmethod sax:attribute-declaration ((sink sink) ename aname type default)
+ (when (canonical sink)
+ (error "cannot serialize attribute type declarations in canonical mode"))
+ (write-rod #"<!ATTLIST " sink)
+ (write-rod ename sink)
+ (write-rune #/U+0020 sink)
+ (write-rod aname sink)
+ (write-rune #/U+0020 sink)
+ (cond
+ ((atom type)
+ (write-rod (rod (string-upcase (symbol-name type))) sink))
+ (t
+ (when (eq :NOTATION (car type))
+ (write-rod #"NOTATION " sink))
+ (write-rune #/\( sink)
+ (loop for (n . rest) on (cdr type) do
+ (write-rod n sink)
+ (when rest
+ (write-rune #\| sink)))
+ (write-rune #/\) sink)))
+ (cond
+ ((atom default)
+ (write-rune #/# sink)
+ (write-rod (rod (string-upcase (symbol-name default))) sink))
+ (t
+ (when (eq :FIXED (car default))
+ (write-rod #"#FIXED " sink))
+ (write-rune #/\" sink)
+ (unparse-string (second default) sink)
+ (write-rune #/\" sink)))
+ (write-rune #/> sink)
+ (write-rune #/U+000A sink))
+
(defmethod sax:end-dtd ((sink sink))
(when (have-doctype sink)
- (when (previous-notation sink)
- (write-rod #"]" sink))
(write-rod #">" sink)
(write-rune #/U+000A sink)))
Index: cxml/xml/xml-parse.lisp
diff -u cxml/xml/xml-parse.lisp:1.49 cxml/xml/xml-parse.lisp:1.50
--- cxml/xml/xml-parse.lisp:1.49 Sat Dec 3 22:54:44 2005
+++ cxml/xml/xml-parse.lisp Sun Dec 4 19:44:06 2005
@@ -1517,7 +1517,6 @@
delim))))))
(defun read-character-reference (input)
- ;; xxx eof handling
;; The #/& is already read
(let ((res
(let ((c (read-rune input)))
@@ -2080,9 +2079,9 @@
;;; to indicate whether the end tag is valid.
;;;
;;; Function B will be called with the character data rod as its argument, it
-;;; returns a boolean indicating whether this text element is allowed.
+;;; returns a boolean indicating whether this text node is allowed.
;;;
-;;; That is, if one of the functions ever returns NIL, the element is
+;;; That is, if one of the functions ever returns NIL, the node is
;;; rejected as invalid.
(defun cmodel-done (actual-value)
@@ -2471,6 +2470,7 @@
(wf-error input "document includes an internal subset"))
(ensure-dtd)
(consume-token input)
+ (sax:start-internal-subset (handler *ctx*))
(while (progn (p/S? input)
(not (eq (peek-token input) :\] )))
(if (eq (peek-token input) :PE-REFERENCE)
@@ -2487,6 +2487,7 @@
(let ((*expand-pe-p* t))
(p/markup-decl input))))
(consume-token input)
+ (sax:end-internal-subset (handler *ctx*))
(p/S? input))
(expect input :>)
(when extid
More information about the Cxml-cvs
mailing list