OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

DTD serialization fixes

Browse Source
This commit is contained in:
dlichteblau
2007-07-22 19:44:01 +00:00
parent 5142cfe2b8
commit b0ca8a12da
1 changed files with 25 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
xml/unparse.lisp
View File

@ -145,15 +145,15 @@
(%write-rod #"<!DOCTYPE " sink) (%write-rod #"<!DOCTYPE " sink)
(%write-rod (name-for-dtd sink) sink) (%write-rod (name-for-dtd sink) sink)
(cond (cond
(public-id ((not (zerop (length public-id)))
(%write-rod #" PUBLIC \"" sink) (%write-rod #" PUBLIC \"" sink)
(unparse-string public-id sink) (unparse-string public-id sink)
(%write-rod #"\" \"" sink) (%write-rod #"\" \"" sink)
(unparse-string system-id sink) (unparse-string system-id sink)
(%write-rod #"\"" sink)) (%write-rod #"\"" sink))
(system-id ((not (zerop (length system-id)))
(%write-rod #" SYSTEM \"" sink) (%write-rod #" SYSTEM \"" sink)
(unparse-string public-id sink) (unparse-string system-id sink)
(%write-rod #"\"" sink))))) (%write-rod #"\"" sink)))))
(defmethod sax:start-internal-subset ((sink sink)) (defmethod sax:start-internal-subset ((sink sink))
@ -175,7 +175,7 @@
(ensure-doctype sink) (ensure-doctype sink)
(%write-rod #" [" sink) (%write-rod #" [" sink)
(%write-rune #/U+000A sink) (%write-rune #/U+000A sink)
(unparse-string str sink) (%write-rod str sink)
(%write-rod #"]" sink)) (%write-rod #"]" sink))
;; for the benefit of the XML test suite, prefer ' over " ;; for the benefit of the XML test suite, prefer ' over "
@ -383,14 +383,17 @@
(start-indentation-block sink)) (start-indentation-block sink))
(%write-rune #/< sink) (%write-rune #/< sink)
(%write-rod qname sink) (%write-rod qname sink)
(let ((atts (sort (copy-list attributes) #'rod< :key #'sax:attribute-qname))) (dolist (a (if (canonical sink)
(dolist (a atts) (sort (copy-list attributes)
(%write-rune #/space sink) #'rod<
(%write-rod (sax:attribute-qname a) sink) :key #'sax:attribute-qname)
(%write-rune #/= sink) attributes))
(%write-rune #/\" sink) (%write-rune #/space sink)
(unparse-string (sax:attribute-value a) sink) (%write-rod (sax:attribute-qname a) sink)
(%write-rune #/\" sink))) (%write-rune #/= sink)
(%write-rune #/\" sink)
(unparse-string (sax:attribute-value a) sink)
(%write-rune #/\" sink))
(when (canonical sink) (when (canonical sink)
(maybe-close-tag sink))) (maybe-close-tag sink)))
@ -420,7 +423,7 @@
(unless (rod-equal target '#.(string-rod "xml")) (unless (rod-equal target '#.(string-rod "xml"))
(%write-rod '#.(string-rod "<?") sink) (%write-rod '#.(string-rod "<?") sink)
(%write-rod target sink) (%write-rod target sink)
(when data (unless (zerop (length data))
(%write-rune #/space sink) (%write-rune #/space sink)
(%write-rod data sink)) (%write-rod data sink))
(%write-rod '#.(string-rod "?>") sink))) (%write-rod '#.(string-rod "?>") sink)))
@ -449,6 +452,14 @@
(loop for c across data do (unparse-datachar c y)) (loop for c across data do (unparse-datachar c y))
(loop for c across data do (unparse-datachar-readable c y)))))))) (loop for c across data do (unparse-datachar-readable c y))))))))
(defmethod sax:comment ((sink sink) data)
(maybe-close-tag sink)
(unless (canonical sink)
;; XXX signal error if body is unprintable?
(%write-rod #"<!--" sink)
(map nil (lambda (c) (%write-rune c sink)) data)
(%write-rod #"-->" sink)))
(defmethod sax:end-cdata ((sink sink)) (defmethod sax:end-cdata ((sink sink))
(unless (eq (pop (stack sink)) :cdata) (unless (eq (pop (stack sink)) :cdata)
(error "output does not nest: not in a cdata section"))) (error "output does not nest: not in a cdata section")))
@ -510,6 +521,7 @@
((rune= c #/<) (write-rod '#.(string-rod "&lt;") ystream)) ((rune= c #/<) (write-rod '#.(string-rod "&lt;") ystream))
((rune= c #/>) (write-rod '#.(string-rod "&gt;") ystream)) ((rune= c #/>) (write-rod '#.(string-rod "&gt;") ystream))
((rune= c #/\") (write-rod '#.(string-rod "&quot;") ystream)) ((rune= c #/\") (write-rod '#.(string-rod "&quot;") ystream))
((rune= c #/U+000D) (write-rod '#.(string-rod "&#13;") ystream))
(t (t
(write-rune c ystream)))) (write-rune c ystream))))