[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-serv32224/src

Modified Files:
	xml.lisp 
Log Message:
moved echo code into its own file in test/

Date: Wed Aug 17 15:44:29 2005
Author: scaekenberghe

Index: s-xml/src/xml.lisp
diff -u s-xml/src/xml.lisp:1.6 s-xml/src/xml.lisp:1.7
--- s-xml/src/xml.lisp:1.6	Mon Jan 24 11:03:09 2005
+++ s-xml/src/xml.lisp	Wed Aug 17 15:44:29 2005
@@ -1,6 +1,6 @@
 ;;;; -*- mode: lisp -*-
 ;;;;
-;;;; $Id: xml.lisp,v 1.6 2005/01/24 10:03:09 scaekenberghe Exp $
+;;;; $Id: xml.lisp,v 1.7 2005/08/17 13:44:29 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).
@@ -111,11 +111,10 @@
     entities))
 
 (defun resolve-entity (stream extendable-string entities &optional (entity (make-extendable-string)))
-  "Read and resolve an XML entity from stream, positioned on the '&'
-  entity marker, accepting &name; , &DEC; and &#HEX; formats,
+  "Read and resolve an XML entity from stream, positioned after the '&' entity marker, 
+  accepting &name; &#DEC; and &#xHEX; formats,
   destructively modifying string, which is also returned,
-  destructively modifying entity, incorrect entity formats result in
-  errors"
+  destructively modifying entity, incorrect entity formats result in errors"
   (loop
    (let ((char (read-char stream nil nil)))
      (cond ((null char) (error (parser-error "encountered eof before end of entity")))
@@ -123,14 +122,15 @@
 	   (t (vector-push-extend char entity)))))
   (if (char= (char entity 0) #\#)
       (let ((code (if (char= (char entity 1) #\x)
-		      (parse-integer entity :start 2 :radix 16)
-		    (parse-integer entity :start 1 :radix 10))))
-	(if (null code) (error (parser-error "encountered incorrect entity &~s;" (list entity) stream)))
+		      (parse-integer entity :start 2 :radix 16 :junk-allowed t)
+		    (parse-integer entity :start 1 :radix 10 :junk-allowed t))))
+	(when (null code) 
+          (error (parser-error "encountered incorrect entity &~s;" (list entity) stream)))
 	(vector-push-extend (code-char code) extendable-string))
     (let ((value (gethash entity entities)))
       (if value
-	  (dotimes (i (length value))
-	    (vector-push-extend (char value i) extendable-string))
+	  (loop :for char :across value 
+                :do (vector-push-extend char extendable-string))
 	(error (parser-error "encountered unknown entity &~s;" (list entity) stream)))))
   extendable-string)
 
@@ -431,56 +431,5 @@
 	 ;; read the main element
 	 (parse-xml-element stream state)
 	 (return-from start-parse-xml (get-seed state)))))))
-
-;;; A simple example as well as a useful tool: parse, echo and pretty print XML
-
-(defun indent (stream count)
-  (loop :repeat (* count 2) :do (write-char #\space stream)))
-
-(defclass echo-xml-seed ()
-  ((stream :initarg :stream)
-   (level :initarg :level :initform 0)))
-
-#+NIL
-(defmethod print-object ((seed echo-xml-seed) stream)
-  (with-slots (stream level) seed
-    (print-unreadable-object (seed stream :type t)
-      (format stream "level=~d" level))))
-
-(defun echo-xml-new-element-hook (name attributes seed)
-  (with-slots (stream level) seed
-    (indent stream level)
-    (format stream "<~a" name)
-    (dolist (attribute (reverse attributes)) 
-      (format stream " ~a=\'" (car attribute))
-      (print-string-xml (cdr attribute) stream)
-      (write-char #\' stream))
-    (format stream ">~%")
-    (incf level)
-    seed))
-
-(defun echo-xml-finish-element-hook (name attributes parent-seed seed)
-  (declare (ignore attributes parent-seed))
-  (with-slots (stream level) seed 
-    (decf level)
-    (indent stream level)
-    (format stream "</~a>~%" name)
-    seed))
-
-(defun echo-xml-text-hook (string seed)
-  (with-slots (stream level) seed
-    (indent stream level)
-    (print-string-xml string stream)
-    (terpri stream)
-    seed))
-  
-(defun echo-xml (in out)
-  "Parse a toplevel XML element from stream in, echoing and pretty printing the result to stream out"
-  (start-parse-xml in
-		   (make-instance 'xml-parser-state
-				  :seed (make-instance 'echo-xml-seed :stream out)
-				  :new-element-hook #'echo-xml-new-element-hook
-				  :finish-element-hook #'echo-xml-finish-element-hook
-				  :text-hook #'echo-xml-text-hook)))
 
 ;;;; eof