diff options
author | Matthias Benkard <code@mail.matthias.benkard.de> | 2009-10-30 20:52:07 +0100 |
---|---|---|
committer | Matthias Benkard <code@mail.matthias.benkard.de> | 2009-10-30 20:52:07 +0100 |
commit | ddb83b1fb2d305e0c06fc067d82d6bab5458b0fd (patch) | |
tree | 8f9003926f0b5295c7a04b2ca257c0a2155ce841 /third-party/s-xml/examples/echo.lisp | |
parent | 15937a1a4f1cf40bc55aa34eb71c67b88466ff57 (diff) |
Add third-party XML processing libraries.
Ignore-this: 5ca28497555bf944858ca2f58bc8a62b
darcs-hash:a0b0f9baa7c9b1259e755435db1fb17123630a6c
Diffstat (limited to 'third-party/s-xml/examples/echo.lisp')
-rw-r--r-- | third-party/s-xml/examples/echo.lisp | 64 |
1 files changed, 64 insertions, 0 deletions
diff --git a/third-party/s-xml/examples/echo.lisp b/third-party/s-xml/examples/echo.lisp new file mode 100644 index 0000000..84e7ea1 --- /dev/null +++ b/third-party/s-xml/examples/echo.lisp @@ -0,0 +1,64 @@ +;;;; -*- mode: lisp -*- +;;;; +;;;; $Id: echo.lisp,v 1.1 2008-02-15 13:54:57 scaekenberghe Exp $ +;;;; +;;;; A simple example as well as a useful tool: parse, echo and pretty print XML +;;;; +;;;; Copyright (C) 2002, 2004 Sven Van Caekenberghe, Beta Nine BVBA. +;;;; +;;;; You are granted the rights to distribute and use this software +;;;; as governed by the terms of the Lisp Lesser General Public License +;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. + +(in-package :s-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 |