1 ;;;; -*- mode: lisp -*-
 2 ;;;;
 3 ;;;; $Id: echo.lisp,v 1.1 2005/08/17 13:44:30 scaekenberghe Exp $
 4 ;;;;
 5 ;;;; A simple example as well as a useful tool: parse, echo and pretty print XML
 6 ;;;;
 7 ;;;; Copyright (C) 2002, 2004 Sven Van Caekenberghe, Beta Nine BVBA.
 8 ;;;;
 9 ;;;; You are granted the rights to distribute and use this software
10 ;;;; as governed by the terms of the Lisp Lesser General Public License
11 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
12 
13 (in-package :s-xml)
14 
15 (defun indent (stream count)
16   (loop :repeat (* count 2) :do (write-char #\space stream)))
17 
18 (defclass echo-xml-seed ()
19   ((stream :initarg :stream)
20    (level :initarg :level :initform 0)))
21 
22 #+NIL
23 (defmethod print-object ((seed echo-xml-seed) stream)
24   (with-slots (stream level) seed
25     (print-unreadable-object (seed stream :type t)
26       (format stream "level=~d" level))))
27 
28 (defun echo-xml-new-element-hook (name attributes seed)
29   (with-slots (stream level) seed
30     (indent stream level)
31     (format stream "<~a" name)
32     (dolist (attribute (reverse attributes)) 
33       (format stream " ~a=\'" (car attribute))
34       (print-string-xml (cdr attribute) stream)
35       (write-char #\' stream))
36     (format stream ">~%")
37     (incf level)
38     seed))
39 
40 (defun echo-xml-finish-element-hook (name attributes parent-seed seed)
41   (declare (ignore attributes parent-seed))
42   (with-slots (stream level) seed 
43     (decf level)
44     (indent stream level)
45     (format stream "</~a>~%" name)
46     seed))
47 
48 (defun echo-xml-text-hook (string seed)
49   (with-slots (stream level) seed
50     (indent stream level)
51     (print-string-xml string stream)
52     (terpri stream)
53     seed))
54   
55 (defun echo-xml (in out)
56   "Parse a toplevel XML element from stream in, echoing and pretty printing the result to stream out"
57   (start-parse-xml in
58 		   (make-instance 'xml-parser-state
59 				  :seed (make-instance 'echo-xml-seed :stream out)
60 				  :new-element-hook #'echo-xml-new-element-hook
61 				  :finish-element-hook #'echo-xml-finish-element-hook
62 				  :text-hook #'echo-xml-text-hook)))
63 
64 ;;;; eof