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
