Update of /project/s-xml/cvsroot/s-xml/examples In directory clnet:/tmp/cvs-serv15874/examples

Added Files: counter.lisp echo.lisp remove-markup.lisp tracer.lisp Log Message: patch contributed by Gismo / Luca Capello: - splitted source code files from test in test and examples directory - added s-xml.test asdf to compile/load the tests - added s-xml.examples to compile/load the examples - modified path references in the test code to use the asdf location

--- /project/s-xml/cvsroot/s-xml/examples/counter.lisp 2008/02/15 13:54:57 NONE +++ /project/s-xml/cvsroot/s-xml/examples/counter.lisp 2008/02/15 13:54:57 1.1 ;;;; -*- mode: lisp -*- ;;;; ;;;; $Id: counter.lisp,v 1.1 2008/02/15 13:54:57 scaekenberghe Exp $ ;;;; ;;;; A simple SSAX counter example that can be used as a performance test ;;;; ;;;; Copyright (C) 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)

(defclass count-xml-seed () ((elements :initform 0) (attributes :initform 0) (characters :initform 0)))

(defun count-xml-new-element-hook (name attributes seed) (declare (ignore name)) (incf (slot-value seed 'elements)) (incf (slot-value seed 'attributes) (length attributes)) seed)

(defun count-xml-text-hook (string seed) (incf (slot-value seed 'characters) (length string)) seed)

(defun count-xml (in) "Parse a toplevel XML element from stream in, counting elements, attributes and characters" (start-parse-xml in (make-instance 'xml-parser-state :seed (make-instance 'count-xml-seed) :new-element-hook #'count-xml-new-element-hook :text-hook #'count-xml-text-hook)))

(defun count-xml-file (pathname) "Parse XMl from the file at pathname, counting elements, attributes and characters" (with-open-file (in pathname) (let ((result (count-xml in))) (with-slots (elements attributes characters) result (format t "~a contains ~d XML elements, ~d attributes and ~d characters.~%" pathname elements attributes characters)))))

;;;; eof --- /project/s-xml/cvsroot/s-xml/examples/echo.lisp 2008/02/15 13:54:57 NONE +++ /project/s-xml/cvsroot/s-xml/examples/echo.lisp 2008/02/15 13:54:57 1.1 ;;;; -*- 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 --- /project/s-xml/cvsroot/s-xml/examples/remove-markup.lisp 2008/02/15 13:54:57 NONE +++ /project/s-xml/cvsroot/s-xml/examples/remove-markup.lisp 2008/02/15 13:54:57 1.1 ;;;; -*- mode: lisp -*- ;;;; ;;;; $Id: remove-markup.lisp,v 1.1 2008/02/15 13:54:57 scaekenberghe Exp $ ;;;; ;;;; Remove markup from an XML document using the SSAX interface ;;;; ;;;; Copyright (C) 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 remove-xml-markup (in) (let* ((state (make-instance 'xml-parser-state :text-hook #'(lambda (string seed) (cons string seed)))) (result (start-parse-xml in state))) (apply #'concatenate 'string (nreverse result))))

;;;; eof--- /project/s-xml/cvsroot/s-xml/examples/tracer.lisp 2008/02/15 13:54:57 NONE +++ /project/s-xml/cvsroot/s-xml/examples/tracer.lisp 2008/02/15 13:54:57 1.1 ;;;; -*- mode: lisp -*- ;;;; ;;;; $Id: tracer.lisp,v 1.1 2008/02/15 13:54:57 scaekenberghe Exp $ ;;;; ;;;; A simple SSAX tracer example that can be used to understand how the hooks are called ;;;; ;;;; Copyright (C) 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 trace-xml-log (level msg &rest args) (indent *standard-output* level) (apply #'format *standard-output* msg args) (terpri *standard-output*))

(defun trace-xml-new-element-hook (name attributes seed) (let ((new-seed (cons (1+ (car seed)) (1+ (cdr seed))))) (trace-xml-log (car seed) "(new-element :name ~s :attributes ~:[()~;~:*~s~] :seed ~s) => ~s" name attributes seed new-seed) new-seed))

(defun trace-xml-finish-element-hook (name attributes parent-seed seed) (let ((new-seed (cons (1- (car seed)) (1+ (cdr seed))))) (trace-xml-log (car parent-seed) "(finish-element :name ~s :attributes ~:[()~;~:*~s~] :parent-seed ~s :seed ~s) => ~s" name attributes parent-seed seed new-seed) new-seed))

(defun trace-xml-text-hook (string seed) (let ((new-seed (cons (car seed) (1+ (cdr seed))))) (trace-xml-log (car seed) "(text :string ~s :seed ~s) => ~s" string seed new-seed) new-seed))

(defun trace-xml (in) "Parse and trace a toplevel XML element from stream in" (start-parse-xml in (make-instance 'xml-parser-state :seed (cons 0 0) ;; seed car is xml element nesting level ;; seed cdr is ever increasing from element to element :new-element-hook #'trace-xml-new-element-hook :finish-element-hook #'trace-xml-finish-element-hook :text-hook #'trace-xml-text-hook)))

(defun trace-xml-file (pathname) "Parse and trace XMl from the file at pathname" (with-open-file (in pathname) (trace-xml in)))

;;;; eof