s-xml-cvs February 2008

s-xml-cvs@common-lisp.net

1 participants
4 discussions

[s-xml-cvs] CVS s-xml/test
by scaekenberghe 15 Feb '08

15 Feb '08

Update of /project/s-xml/cvsroot/s-xml/test In directory clnet:/tmp/cvs-serv15874/test Modified Files: test-lxml-dom.lisp test-sxml-dom.lisp test-xml-struct-dom.lisp Removed Files: all-tests.lisp 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/test/test-lxml-dom.lisp 2005/11/06 12:44:48 1.2 +++ /project/s-xml/cvsroot/s-xml/test/test-lxml-dom.lisp 2008/02/15 13:54:57 1.3 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-lxml-dom.lisp,v 1.2 2005/11/06 12:44:48 scaekenberghe Exp $ +;;;; $Id: test-lxml-dom.lisp,v 1.3 2008/02/15 13:54:57 scaekenberghe Exp $ ;;;; ;;;; Unit and functional tests for lxml-dom.lisp ;;;; @@ -40,15 +40,21 @@ " text, with a leading & trailing space "))) (assert - (consp (parse-xml-file (merge-pathnames "xhtml-page.xml" *load-pathname*) + (consp (parse-xml-file (merge-pathnames "test/xhtml-page.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :lxml))) (assert - (consp (parse-xml-file (merge-pathnames "ant-build-file.xml" *load-pathname*) + (consp (parse-xml-file (merge-pathnames "test/ant-build-file.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :lxml))) (assert - (consp (parse-xml-file (merge-pathnames "plist.xml" *load-pathname*) + (consp (parse-xml-file (merge-pathnames "test/plist.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :lxml))) (assert @@ -77,4 +83,4 @@ (parse-xml stream :output-type :lxml))) "<greeting>Hello, < world!</greeting>")) -;;;; eof \ No newline at end of file +;;;; eof --- /project/s-xml/cvsroot/s-xml/test/test-sxml-dom.lisp 2004/06/07 18:49:59 1.1.1.1 +++ /project/s-xml/cvsroot/s-xml/test/test-sxml-dom.lisp 2008/02/15 13:54:57 1.2 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-sxml-dom.lisp,v 1.1.1.1 2004/06/07 18:49:59 scaekenberghe Exp $ +;;;; $Id: test-sxml-dom.lisp,v 1.2 2008/02/15 13:54:57 scaekenberghe Exp $ ;;;; ;;;; Unit and functional tests for sxml-dom.lisp ;;;; @@ -40,15 +40,21 @@ " text, with a leading & trailing space "))) (assert - (consp (parse-xml-file (merge-pathnames "xhtml-page.xml" *load-pathname*) + (consp (parse-xml-file (merge-pathnames "test/xhtml-page.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :sxml))) (assert - (consp (parse-xml-file (merge-pathnames "ant-build-file.xml" *load-pathname*) + (consp (parse-xml-file (merge-pathnames "test/ant-build-file.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :sxml))) (assert - (consp (parse-xml-file (merge-pathnames "plist.xml" *load-pathname*) + (consp (parse-xml-file (merge-pathnames "test/plist.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :sxml))) (assert --- /project/s-xml/cvsroot/s-xml/test/test-xml-struct-dom.lisp 2005/08/29 15:01:49 1.2 +++ /project/s-xml/cvsroot/s-xml/test/test-xml-struct-dom.lisp 2008/02/15 13:54:57 1.3 @@ -1,6 +1,6 @@ ;;;; -*- mode: lisp -*- ;;;; -;;;; $Id: test-xml-struct-dom.lisp,v 1.2 2005/08/29 15:01:49 scaekenberghe Exp $ +;;;; $Id: test-xml-struct-dom.lisp,v 1.3 2008/02/15 13:54:57 scaekenberghe Exp $ ;;;; ;;;; Unit and functional tests for xml-struct-dom.lisp ;;;; @@ -44,15 +44,21 @@ " text, with a leading & trailing space ")))) (assert - (xml-element-p (parse-xml-file (merge-pathnames "xhtml-page.xml" *load-pathname*) + (xml-element-p (parse-xml-file (merge-pathnames "test/xhtml-page.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :xml-struct))) (assert - (xml-element-p (parse-xml-file (merge-pathnames "ant-build-file.xml" *load-pathname*) + (xml-element-p (parse-xml-file (merge-pathnames "test/ant-build-file.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :xml-struct))) (assert - (xml-element-p (parse-xml-file (merge-pathnames "plist.xml" *load-pathname*) + (xml-element-p (parse-xml-file (merge-pathnames "test/plist.xml" + (asdf:component-pathname + (asdf:find-system :s-xml.test))) :output-type :xml-struct))) (assert

1 0

[s-xml-cvs] CVS s-xml
by scaekenberghe 15 Feb '08

15 Feb '08

Update of /project/s-xml/cvsroot/s-xml In directory clnet:/tmp/cvs-serv15874 Modified Files: s-xml.asd 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/s-xml.asd 2005/12/14 21:49:04 1.2 +++ /project/s-xml/cvsroot/s-xml/s-xml.asd 2008/02/15 13:54:57 1.3 @@ -1,6 +1,6 @@ ;;;; -*- Mode: LISP -*- ;;;; -;;;; $Id: s-xml.asd,v 1.2 2005/12/14 21:49:04 scaekenberghe Exp $ +;;;; $Id: s-xml.asd,v 1.3 2008/02/15 13:54:57 scaekenberghe Exp $ ;;;; ;;;; The S-XML ASDF system definition ;;;; @@ -31,4 +31,19 @@ (:file "sxml-dom" :depends-on ("dom")) (:file "xml-struct-dom" :depends-on ("dom")))))) +(defsystem :s-xml.test + :depends-on (:s-xml) + :components ((:module :test + :components ((:file "test-xml") + (:file "test-xml-struct-dom") + (:file "test-lxml-dom") + (:file "test-sxml-dom"))))) + +(defsystem :s-xml.examples + :depends-on (:s-xml) + :components ((:module :examples + :components ((:file "counter") + (:file "echo") + (:file "remove-markup") + (:file "tracer"))))) ;;;; eof

1 0

[s-xml-cvs] CVS s-xml/examples
by scaekenberghe 15 Feb '08

15 Feb '08

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

1 0

[s-xml-cvs] CVS s-xml/examples
by scaekenberghe 15 Feb '08

15 Feb '08

Update of /project/s-xml/cvsroot/s-xml/examples In directory clnet:/tmp/cvs-serv14978/examples Log Message: Directory /project/s-xml/cvsroot/s-xml/examples added to the repository

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

s-xml-cvs February 2008