Update of /project/cxml/cvsroot/cxml/xml In directory clnet:/tmp/cvs-serv26802
Modified Files: unparse.lisp Log Message: escape % in internal entities new function unparsed-internal-subset use " to escape IDs containing '
--- /project/cxml/cvsroot/cxml/xml/unparse.lisp 2007/06/16 11:27:19 1.16 +++ /project/cxml/cvsroot/cxml/xml/unparse.lisp 2007/07/01 17:25:39 1.17 @@ -79,6 +79,7 @@ (name-for-dtd :accessor name-for-dtd) (previous-notation :initform nil :accessor previous-notation) (have-doctype :initform nil :accessor have-doctype) + (have-internal-subset :initform nil :accessor have-internal-subset) (stack :initform nil :accessor stack)))
(defmethod initialize-instance :after ((instance sink) &key) @@ -156,6 +157,9 @@ (%write-rod #""" sink)))))
(defmethod sax:start-internal-subset ((sink sink)) + (when (have-internal-subset sink) + (error "duplicate internal subset")) + (setf (have-internal-subset sink) t) (ensure-doctype sink) (%write-rod #" [" sink) (%write-rune #/U+000A sink)) @@ -164,6 +168,25 @@ (ensure-doctype sink) (%write-rod #"]" sink))
+(defmethod sax:unparsed-internal-subset ((sink sink) str) + (when (have-internal-subset sink) + (error "duplicate internal subset")) + (setf (have-internal-subset sink) t) + (ensure-doctype sink) + (%write-rod #" [" sink) + (%write-rune #/U+000A sink) + (unparse-string str sink) + (%write-rod #"]" sink)) + +;; for the benefit of the XML test suite, prefer ' over " +(defun write-quoted-rod (x sink) + (let ((q (if (find #/' x) #/" #/' + ;; '" (thanks you Emacs indentation, the if ends here) + ))) + (%write-rune q sink) + (%write-rod x sink) + (%write-rune q sink))) + (defmethod sax:notation-declaration ((sink sink) name public-id system-id) (let ((prev (previous-notation sink))) (when (and (and (canonical sink) (>= (canonical sink) 2)) @@ -175,19 +198,16 @@ (%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-quoted-rod system-id sink)) ((zerop (length system-id)) - (%write-rod #" PUBLIC '" sink) - (%write-rod public-id sink) - (%write-rune #/' sink)) + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id 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-quoted-rod public-id sink) + (%write-rod #" " sink) + (write-quoted-rod system-id sink))) (%write-rune #/> sink) (%write-rune #/U+000A sink))
@@ -198,19 +218,16 @@ (%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-quoted-rod system-id sink)) ((zerop (length system-id)) - (%write-rod #" PUBLIC '" sink) - (%write-rod public-id sink) - (%write-rune #/' sink)) + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id 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-quoted-rod public-id sink) + (%write-rod #" " sink) + (write-quoted-rod system-id sink))) (%write-rod #" NDATA " sink) (%write-rod notation-name sink) (%write-rune #/> sink) @@ -226,19 +243,16 @@ (%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-quoted-rod system-id sink)) ((zerop (length system-id)) - (%write-rod #" PUBLIC '" sink) - (%write-rod public-id sink) - (%write-rune #/' sink)) + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id 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-quoted-rod public-id sink) + (%write-rod #" " sink) + (write-quoted-rod system-id sink))) (%write-rune #/> sink) (%write-rune #/U+000A sink))
@@ -251,7 +265,7 @@ (%write-rod name sink) (%write-rune #/U+0020 sink) (%write-rune #/" sink) - (unparse-string value sink) + (unparse-dtd-string value sink) (%write-rune #/" sink) (%write-rune #/> sink) (%write-rune #/U+000A sink)) @@ -319,6 +333,7 @@ (when rest (%write-rune #| sink))) (%write-rune #/) sink))) + (%write-rune #/U+0020 sink) (cond ((atom default) (%write-rune #/# sink) @@ -498,6 +513,22 @@ (t (write-rune c ystream))))
+(defun unparse-dtd-string (str sink) + (let ((y (sink-ystream sink))) + (loop for rune across str do (unparse-dtd-char rune y)))) + +(defun unparse-dtd-char (c ystream) + (cond ((rune= c #/%) (write-rod '#.(string-rod "%") ystream)) + ((rune= c #/&) (write-rod '#.(string-rod "&") ystream)) + ((rune= c #/<) (write-rod '#.(string-rod "<") ystream)) + ((rune= c #/>) (write-rod '#.(string-rod ">") ystream)) + ((rune= c #/") (write-rod '#.(string-rod """) ystream)) + ((rune= c #/U+0009) (write-rod '#.(string-rod "	") ystream)) + ((rune= c #/U+000A) (write-rod '#.(string-rod " ") ystream)) + ((rune= c #/U+000D) (write-rod '#.(string-rod " ") ystream)) + (t + (write-rune c ystream)))) + (defun %write-rune (c sink) (write-rune c (sink-ystream sink)))
-
dlichteblau