Update of /project/s-xml/cvsroot/s-xml/src In directory common-lisp.net:/tmp/cvs-serv28410/src

Modified Files: xml.lisp Log Message: fixed a bug: in a tag containing whitespace, like <foo> </foo> the parser collapsed and ingnored all whitespace and considered the tag to be empty! this is now fixed and a unit test has been added cleaned up xml character escaping a bit: single quotes and all normal whitespace (newline, return and tab) is preserved a unit test for this has been added

Date: Fri Oct 22 12:36:58 2004 Author: scaekenberghe

Index: s-xml/src/xml.lisp diff -u s-xml/src/xml.lisp:1.4 s-xml/src/xml.lisp:1.5 --- s-xml/src/xml.lisp:1.4 Thu Aug 19 16:55:20 2004 +++ s-xml/src/xml.lisp Fri Oct 22 12:36:58 2004 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: xml.lisp,v 1.4 2004/08/19 14:55:20 bmastenbrook Exp $ +;;;; $Id: xml.lisp,v 1.5 2004/10/22 10:36:58 scaekenberghe Exp $ ;;;; ;;;; This is a Common Lisp implementation of a very basic XML parser. ;;;; The parser is non-validating and not at all complete (no CDATA). @@ -88,9 +88,7 @@ (#< (write-string "&lt;" stream)) (#> (write-string "&gt;" stream)) (#" (write-string "&quot;" stream)) - #+nil (#' (write-string "&apos;" stream)) - (#' (write-string "'" stream)) - (#\Newline (write-string (string #\newline) stream)) + ((#\newline #\return #\tab) (write-char char stream)) (t (if (and (<= 32 (char-code char)) (<= (char-code char) 126)) (write-char char stream) @@ -355,7 +353,7 @@ (when (char= (peek-char nil stream nil nil) #!) (skip-special-tag stream) (return-from parse-xml-element)) - (let (char buffer open-tag parent-seed) + (let (char buffer open-tag parent-seed has-children) (setf parent-seed (get-seed state)) ;; read tag name (no whitespace between < and name ?) (setf open-tag (intern (parse-identifier stream (get-mini-buffer state)) :keyword)) @@ -389,6 +387,10 @@ (if (char= (peek-char nil stream nil nil) #/) (progn ;; handle the matching closing tag </tag> and done + ;; if we read whitespace as this (leaf) element's contents, it is significant + (when (and (not has-children) (plusp (length buffer))) + (setf (get-seed state) (funcall (get-text-hook state) + (copy-seq buffer) (get-seed state)))) (read-char stream) (let ((close-tag (intern (parse-identifier stream (get-mini-buffer state)) :keyword))) (unless (eq open-tag close-tag) @@ -400,7 +402,10 @@ open-tag attributes parent-seed (get-seed state)))) (return)) ;; handle child tag and loop, no hooks to call here - (parse-xml-element stream state))) + ;; whitespace between child elements is skipped + (progn + (setf has-children t) + (parse-xml-element stream state)))) (t ;; no child tag, concatenate text to whitespace in buffer ;; handle text content and loop