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

escape % in internal entities

Browse Source 
new function unparsed-internal-subset
use " to escape IDs containing '
This commit is contained in:
dlichteblau
2007-07-01 17:25:39 +00:00
parent d4658bc57f
commit dd08cc3711
1 changed files with 65 additions and 34 deletions
Download Patch File Download Diff File Expand all files Collapse all files

99
xml/unparse.lisp
View File

@ -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 "&lt;") ystream))
((rune= c #/>) (write-rod '#.(string-rod "&gt;") ystream))
((rune= c #/\") (write-rod '#.(string-rod "&quot;") ystream))
((rune= c #/U+0009) (write-rod '#.(string-rod "&#9;") ystream))
((rune= c #/U+000A) (write-rod '#.(string-rod "&#10;") ystream))
((rune= c #/U+000D) (write-rod '#.(string-rod "&#13;") ystream))
(t
(write-rune c ystream))))
(defun %write-rune (c sink)
(write-rune c (sink-ystream sink)))