Update of /project/s-xml/cvsroot/s-xml/src In directory common-lisp.net:/tmp/cvs-serv17887/src
Modified Files: xml.lisp Log Message: added CDATA support (patch contributed by Peter Van Eynde pvaneynd@mailworks.org)
Date: Sun Nov 6 13:44:48 2005 Author: scaekenberghe
Index: s-xml/src/xml.lisp diff -u s-xml/src/xml.lisp:1.12 s-xml/src/xml.lisp:1.13 --- s-xml/src/xml.lisp:1.12 Thu Sep 8 17:39:29 2005 +++ s-xml/src/xml.lisp Sun Nov 6 13:44:48 2005 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xml.lisp,v 1.12 2005/09/08 15:39:29 scaekenberghe Exp $ +;;;; $Id: xml.lisp,v 1.13 2005/11/06 12:44:48 scaekenberghe Exp $ ;;;; ;;;; This is a Common Lisp implementation of a basic but usable XML parser. ;;;; The parser is non-validating and not complete (no CDATA). @@ -446,7 +446,32 @@ (if (char/= (read-char stream nil nil) #>) (error (parser-error "expected > ending comment" nil stream))))
-(defun skip-special-tag (stream) +(defun read-cdata (stream state &optional (string (make-extendable-string))) + "Reads in the CDATA and calls the callback for CDATA if it exists" + ;; we already read the <![CDATA[ stuff + ;; continue to read until we hit ]]> + (let ((char #\space) + (last-3-characters (list #[ #\A #\T)) + (pattern (list #> #] #]))) + (loop + (setf char (read-char stream nil nil)) + (when (null char) (error (parser-error "encountered unexpected eof in text"))) + (push char last-3-characters) + (setf (cdddr last-3-characters) nil) + (cond + ((equal last-3-characters + pattern) + (setf (fill-pointer string) + (- (fill-pointer string) 2)) + (setf (get-seed state) + (funcall (get-text-hook state) + (copy-seq string) + (get-seed state))) + (return-from read-cdata)) + (t + (vector-push-extend char string)))))) + +(defun skip-special-tag (stream state) "Skip an XML special tag (comments and processing instructions) in stream, positioned after the opening '<', unexpected eof is an error" ;; opening < has been read, consume ? or ! @@ -458,6 +483,15 @@ (when (char= char #-) (skip-comment stream) (return-from skip-special-tag))) + ;; maybe we are dealing with CDATA? + (when (and (char= char #[) + (loop :for pattern :across "CDATA[" + :for char = (read-char stream nil nil) + :when (null char) :do + (error (parser-error "encountered unexpected eof in cdata")) + :always (char= char pattern))) + (read-cdata stream state (get-buffer state)) + (return-from skip-special-tag)) ;; loop over chars, dealing with strings (skipping their content) ;; and counting opening and closing < and > chars (let ((taglevel 1) @@ -510,7 +544,7 @@ (declare (special *namespaces*)) ;; opening < has been read (when (char= (peek-char nil stream nil nil) #!) - (skip-special-tag stream) + (skip-special-tag stream state) (return-from parse-xml-element)) (let (char buffer open-tag parent-seed has-children) (setf parent-seed (get-seed state)) @@ -589,7 +623,7 @@ (setf char (peek-char nil stream nil nil)) (if (or (char= char #!) (char= char #?)) ;; deal with special tags - (skip-special-tag stream) + (skip-special-tag stream state) (progn ;; read the main element (parse-xml-element stream state)