Update of /project/s-xml/cvsroot/s-xml/test In directory common-lisp.net:/tmp/cvs-serv8028/test
Modified Files: counter.lisp tracer.lisp Added Files: remove-markup.lisp Log Message: further cleanup of examples and hook documentation
Date: Fri Jun 11 04:14:43 2004 Author: scaekenberghe
Index: s-xml/test/counter.lisp diff -u s-xml/test/counter.lisp:1.1.1.1 s-xml/test/counter.lisp:1.2 --- s-xml/test/counter.lisp:1.1.1.1 Mon Jun 7 11:49:59 2004 +++ s-xml/test/counter.lisp Fri Jun 11 04:14:43 2004 @@ -1,8 +1,8 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: counter.lisp,v 1.1.1.1 2004/06/07 18:49:59 scaekenberghe Exp $ +;;;; $Id: counter.lisp,v 1.2 2004/06/11 11:14:43 scaekenberghe Exp $ ;;;; -;;;; A simple SAX counter example that can be used as a performance test +;;;; A simple SSAX counter example that can be used as a performance test ;;;; ;;;; Copyright (C) 2004 Sven Van Caekenberghe, Beta Nine BVBA. ;;;; @@ -41,7 +41,7 @@ (let ((result (count-xml in))) (with-slots (elements attributes characters) result (format t - "~a countains ~d XML elements, ~d attributes and ~d characters.~%" + "~a contains ~d XML elements, ~d attributes and ~d characters.~%" pathname elements attributes characters)))))
;;;; eof
Index: s-xml/test/tracer.lisp diff -u s-xml/test/tracer.lisp:1.1 s-xml/test/tracer.lisp:1.2 --- s-xml/test/tracer.lisp:1.1 Fri Jun 11 01:20:58 2004 +++ s-xml/test/tracer.lisp Fri Jun 11 04:14:43 2004 @@ -1,8 +1,8 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: tracer.lisp,v 1.1 2004/06/11 08:20:58 scaekenberghe Exp $ +;;;; $Id: tracer.lisp,v 1.2 2004/06/11 11:14:43 scaekenberghe Exp $ ;;;; -;;;; A simple SAX tracer example that can be used to understand how the hooks are called +;;;; 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. ;;;; @@ -18,28 +18,33 @@ (terpri *standard-output*))
(defun trace-xml-new-element-hook (name attributes seed) - (trace-xml-log (car seed) - "(new-element :name ~s :attributes ~:[()~;~:*s~] :seed ~s)" - name attributes seed) - (cons (1+ (car seed)) (1+ (cdr 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) - (trace-xml-log (car parent-seed) - "(finish-element :name ~s :attributes ~:[()~;~:*s~] :parent-seed ~s :seed ~s)" - name attributes parent-seed seed) - (cons (1- (car seed)) (1+ (cdr 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) - (trace-xml-log (car seed) - "(text :string ~s :seed ~s)" - string seed) - 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 (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)))