July 2007 - cxml-cvs@common-lisp.net - mailman3.common-lisp.net

[cxml-cvs] CVS cxml/doc
by dlichteblau 05 Jul '07

05 Jul '07

Update of /project/cxml/cvsroot/cxml/doc In directory clnet:/tmp/cvs-serv5595/doc Modified Files: index.xml Log Message: Fixed build on non-Unicode lisps. Fixed parsing on non-Unicode lisps. Fixed Unicode detection on OpenMCL. --- /project/cxml/cvsroot/cxml/doc/index.xml 2007/06/16 11:27:19 1.11 +++ /project/cxml/cvsroot/cxml/doc/index.xml 2007/07/05 20:58:15 1.12 @@ -59,6 +59,10 @@ <h3>Recent Changes</h3> <p class="nomargin"><tt>rel-2007-mm-dd</tt></p> <ul class="nomargin"> + <li> + Fixed build on non-Unicode lisps. Fixed parsing on + non-Unicode lisps. Fixed Unicode detection on OpenMCL. + </li> <li>Serialization no longer defaults to canonical form.</li> <li>Fixed octet array argument to make-source.</li> <li> @@ -74,6 +78,8 @@ where normal streams are used instead of xstreams and ystreams (albeit both SCL-specific at this point). </li> + <li>new convenience serialization function cxml:doctype. Various + DTD serialization fixes.</li> </ul> <p class="nomargin"><tt>rel-2007-05-26</tt></p> <ul class="nomargin">

1 0

[cxml-cvs] CVS cxml
by dlichteblau 05 Jul '07

05 Jul '07

Update of /project/cxml/cvsroot/cxml In directory clnet:/tmp/cvs-serv5595 Modified Files: GNUmakefile cxml.asd runes.asd Log Message: Fixed build on non-Unicode lisps. Fixed parsing on non-Unicode lisps. Fixed Unicode detection on OpenMCL. --- /project/cxml/cvsroot/cxml/GNUmakefile 2005/03/13 18:02:50 1.1.1.1 +++ /project/cxml/cvsroot/cxml/GNUmakefile 2007/07/05 20:58:15 1.2 @@ -4,5 +4,4 @@ .PHONY: clean clean: - touch dummy.fasl - find . \( -name \*.fasl -o -name \*.x86f \) -print0 | xargs -0 rm + find . \( -name \*.fasl -o -name \*.x86f -o -name \*.lx64fsl \) -print0 | xargs -0 rm -f --- /project/cxml/cvsroot/cxml/cxml.asd 2007/06/16 11:27:18 1.19 +++ /project/cxml/cvsroot/cxml/cxml.asd 2007/07/05 20:58:15 1.20 @@ -2,6 +2,9 @@ (:use :asdf :cl)) (in-package :cxml-system) +;; force loading of runes.asd, which installs *features* this file depends on +(find-system :runes) + (defclass closure-source-file (cl-source-file) ()) #+scl --- /project/cxml/cvsroot/cxml/runes.asd 2007/06/30 21:24:34 1.3 +++ /project/cxml/cvsroot/cxml/runes.asd 2007/07/05 20:58:15 1.4 @@ -26,7 +26,9 @@ (progn (format t " ok, characters have at least 16 bits.~%") :rune-is-character)) - (unless (and (< x char-code-limit) (code-char x)) + (unless (or (<= #xD800 x #xDFFF) + (and (< x char-code-limit) (code-char x))) + (print (code-char x)) (format t " no, reverting to octet strings.~%") (return :rune-is-integer))) *features*))

1 0

[cxml-cvs] CVS cxml/doc
by dlichteblau 01 Jul '07

01 Jul '07

Update of /project/cxml/cvsroot/cxml/doc In directory clnet:/tmp/cvs-serv14500 Modified Files: sax.xml Log Message: new function cxml:doctype --- /project/cxml/cvsroot/cxml/doc/sax.xml 2007/05/01 20:07:00 1.4 +++ /project/cxml/cvsroot/cxml/doc/sax.xml 2007/07/01 18:56:09 1.5 @@ -299,6 +299,7 @@ <div class="def">Function CXML:ATTRIBUTE* (prefix lname value) => value</div> <div class="def">Function CXML:TEXT (data) => data</div> <div class="def">Function CXML:CDATA (data) => data</div> + <div class="def">Function CXML:doctype (name public-id system-id &optional internal-subset)</div> Convenience syntax for event-based serialization. </p> <p>

1 0

[cxml-cvs] CVS cxml/xml
by dlichteblau 01 Jul '07

01 Jul '07

Update of /project/cxml/cvsroot/cxml/xml In directory clnet:/tmp/cvs-serv13842 Modified Files: package.lisp Log Message: new function cxml:doctype --- /project/cxml/cvsroot/cxml/xml/package.lisp 2007/06/16 11:27:19 1.17 +++ /project/cxml/cvsroot/cxml/xml/package.lisp 2007/07/01 18:52:33 1.18 @@ -58,6 +58,7 @@ #:unparse-attribute #:cdata #:text + #:doctype #:xml-parse-error #:well-formedness-violation

1 0

[cxml-cvs] CVS cxml/xml
by dlichteblau 01 Jul '07

01 Jul '07

Update of /project/cxml/cvsroot/cxml/xml In directory clnet:/tmp/cvs-serv13765 Modified Files: unparse.lisp Log Message: new function cxml:doctype --- /project/cxml/cvsroot/cxml/xml/unparse.lisp 2007/07/01 17:25:39 1.17 +++ /project/cxml/cvsroot/cxml/xml/unparse.lisp 2007/07/01 18:52:26 1.18 @@ -564,6 +564,12 @@ (defmacro with-namespace ((prefix uri) &body body) `(invoke-with-namespace (lambda () ,@body) ,prefix ,uri)) +(defun doctype (name public-id system-id &optional internal-subset) + (sax:start-dtd *sink* name public-id system-id) + (when internal-subset + (sax:unparsed-internal-subset *sink* internal-subset)) + (sax:end-dtd *sink*)) + (defun maybe-emit-start-tag () (when *current-element* ;; starting child node, need to emit opening tag of parent first:

1 0

[cxml-cvs] CVS cxml/test
by dlichteblau 01 Jul '07

01 Jul '07

Update of /project/cxml/cvsroot/cxml/test In directory clnet:/tmp/cvs-serv27018 Modified Files: xmlconf.lisp Log Message: hacks for stp tests --- /project/cxml/cvsroot/cxml/test/xmlconf.lisp 2007/06/16 10:03:11 1.15 +++ /project/cxml/cvsroot/cxml/test/xmlconf.lisp 2007/07/01 17:26:12 1.16 @@ -53,7 +53,7 @@ (when (plusp (length output)) (merge-pathnames output sub-directory))))) -(defun serialize-document (document) +(defmethod serialize-document ((document t)) (dom:map-document (cxml:make-octet-vector-sink :canonical 2) document :include-doctype :canonical-notations @@ -195,6 +195,10 @@ :validate nil) (error "well-formedness violation not detected") nil) + #+fixme-stp-test + (error () + (format t " unexpected-error") + t) (cxml:well-formedness-violation () (format t " not-wf") t)) @@ -207,6 +211,10 @@ :validate t) (error "well-formedness violation not detected") nil) + #+fixme-stp-test + (error () + (format t " unexpected-error") + t) (cxml:well-formedness-violation () (format t " not-wf") t)

1 0

[cxml-cvs] CVS cxml/xml
by dlichteblau 01 Jul '07

01 Jul '07

Update of /project/cxml/cvsroot/cxml/xml In directory clnet:/tmp/cvs-serv26914 Modified Files: xmls-compat.lisp Log Message: removed out-of-date comment --- /project/cxml/cvsroot/cxml/xml/xmls-compat.lisp 2007/06/16 11:07:58 1.4 +++ /project/cxml/cvsroot/cxml/xml/xmls-compat.lisp 2007/07/01 17:26:04 1.5 @@ -6,9 +6,6 @@ ;;;; Developed 2004 for headcraft - http://headcraft.de/ ;;;; Copyright: David Lichteblau -;;;; XXX Der namespace-Support in xmls kommt mir zweifelhaft vor. -;;;; Wir imitieren das soweit es gebraucht wurde bisher. - (defpackage cxml-xmls (:use :cl :runes) (:export #:make-node #:node-name #:node-ns #:node-attrs #:node-children

1 0

[cxml-cvs] CVS cxml/xml
by dlichteblau 01 Jul '07

01 Jul '07

Update of /project/cxml/cvsroot/cxml/xml In directory clnet:/tmp/cvs-serv26838 Modified Files: sax-handler.lisp Log Message: new function unparsed-internal-subset --- /project/cxml/cvsroot/cxml/xml/sax-handler.lisp 2007/03/04 21:04:13 1.7 +++ /project/cxml/cvsroot/cxml/xml/sax-handler.lisp 2007/07/01 17:25:45 1.8 @@ -73,6 +73,7 @@ #:start-dtd #:end-dtd #:start-internal-subset + #:unparsed-internal-subset #:end-internal-subset #:unparsed-entity-declaration #:external-entity-declaration @@ -337,6 +338,11 @@ finished, if present.") (:method ((handler t)) nil)) +(defgeneric unparsed-internal-subset (handler str) + (:documentation "Reports that an internal subset is present, but has not +been parsed and is available as a string.") + (:method ((handler t) str) nil)) + (defgeneric unparsed-entity-declaration (handler name public-id system-id notation-name) (:documentation

1 0

[cxml-cvs] CVS cxml/xml
by dlichteblau 01 Jul '07

01 Jul '07

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

1 0