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@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