[s-xml-cvs] CVS update: s-xml/src/xml.lisp

[Sven Van Caekenberghe]

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 "<" stream))
 	     (#\> (write-string ">" stream))
 	     (#\" (write-string """ stream))
-	     #+nil (#\' (write-string "'" 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