diff options
| author | Vincent Ambo <mail@tazj.in> | 2021-12-15T21·51+0300 |
|---|---|---|
| committer | tazjin <mail@tazj.in> | 2021-12-15T22·09+0000 |
| commit | db742c2035f9cfcf496b4a9b1640d1cf623a2c0f (patch) | |
| tree | a9bcaf6632d910ae68185319cc5bcd408667a8d9 /third_party/lisp/s-xml | |
| parent | 75ca24c60a57ab894da4d404755b8b4094284ad8 (diff) | |
chore(3p/lisp): use nixpkgs sources for s-xml r/3258
this one was a little more difficult because it needs a patch, there's something wonky with the definition order fwiw, the upstream cvs repository ... server errors. Change-Id: I2d99359edec36b578389f1be1fcf077743c29c4e Reviewed-on: https://cl.tvl.fyi/c/depot/+/4342 Tested-by: BuildkiteCI Reviewed-by: grfn <grfn@gws.fyi>
Diffstat (limited to 'third_party/lisp/s-xml')
24 files changed, 43 insertions, 2383 deletions
diff --git a/third_party/lisp/s-xml/.gitignore b/third_party/lisp/s-xml/.gitignore deleted file mode 100644 index 40caffa8e257..000000000000 --- a/third_party/lisp/s-xml/.gitignore +++ /dev/null @@ -1,28 +0,0 @@ -# CVS default ignores begin -tags -TAGS -.make.state -.nse_depinfo -*~ -#* -.#* -,* -_$* -*$ -*.old -*.bak -*.BAK -*.orig -*.rej -.del-* -*.a -*.olb -*.o -*.obj -*.so -*.exe -*.Z -*.elc -*.ln -core -# CVS default ignores end diff --git a/third_party/lisp/s-xml/0001-fix-definition-order-in-xml.lisp.patch b/third_party/lisp/s-xml/0001-fix-definition-order-in-xml.lisp.patch new file mode 100644 index 000000000000..9e5838c3c545 --- /dev/null +++ b/third_party/lisp/s-xml/0001-fix-definition-order-in-xml.lisp.patch @@ -0,0 +1,26 @@ +From 789dc38399f4039b114de28384c149721d66b030 Mon Sep 17 00:00:00 2001 +From: Vincent Ambo <mail@tazj.in> +Date: Thu, 16 Dec 2021 00:48:04 +0300 +Subject: [PATCH] fix definition order in xml.lisp + +--- + src/xml.lisp | 3 +++ + 1 file changed, 3 insertions(+) + +diff --git a/src/xml.lisp b/src/xml.lisp +index 39c9b63..3232491 100644 +--- a/src/xml.lisp ++++ b/src/xml.lisp +@@ -19,6 +19,9 @@ + + ;;; error reporting + ++(defvar *ignore-namespaces* nil ++ "When t, namespaces are ignored like in the old version of S-XML") ++ + (define-condition xml-parser-error (error) + ((message :initarg :message :reader xml-parser-error-message) + (args :initarg :args :reader xml-parser-error-args) +-- +2.34.0 + diff --git a/third_party/lisp/s-xml/ChangeLog b/third_party/lisp/s-xml/ChangeLog deleted file mode 100644 index ac196619c0aa..000000000000 --- a/third_party/lisp/s-xml/ChangeLog +++ /dev/null @@ -1,66 +0,0 @@ -2006-01-19 Sven Van Caekenberghe <svc@mac.com> - - * added a set of patches contributed by David Tolpin dvd@davidashen.net : we're now using char of type - Character and #\Null instead of null, read/unread instead of peek/read and some more declarations for - more efficiency - added hooks for customizing parsing attribute names and values - -2005-11-20 Sven Van Caekenberghe <svc@mac.com> - - * added xml prefix namespace as per REC-xml-names-19990114 (by Rudi Schlatte) - -2005-11-06 Sven Van Caekenberghe <svc@mac.com> - - * removed Debian packaging directory (on Luca's request) - * added CDATA support (patch contributed by Peter Van Eynde pvaneynd@mailworks.org) - -2005-08-30 Sven Van Caekenberghe <svc@mac.com> - - * added Debian packaging directory (contributed by Luca Capello luca@pca.it) - * added experimental XML namespace support - -2005-02-03 Sven Van Caekenberghe <svc@mac.com> - - * release 5 (cvs tag RELEASE_5) - * added :start and :end keywords to print-string-xml - * fixed a bug: in a tag containing whitespace, like <foo> </foo> the parser collapsed - and ingnored all whitespace and considered the tag to be empty! - this is now fixed and a unit test has been added - * cleaned up xml character escaping a bit: single quotes and all normal whitespace - (newline, return and tab) is preserved a unit test for this has been added - * IE doesn't understand the ' XML entity, so I've commented that out for now. - Also, using actual newlines for newlines is probably better than using #xA, - which won't get any end of line conversion by the server or user agent. - -June 2004 Sven Van Caekenberghe <svc@mac.com> - - * release 4 - * project moved to common-lisp.net, renamed to s-xml, - * added examples counter, tracer and remove-markup, improved documentation - -13 Jan 2004 Sven Van Caekenberghe <svc@mac.com> - - * release 3 - * added ASDF systems - * optimized print-string-xml - -10 Jun 2003 Sven Van Caekenberghe <svc@mac.com> - - * release 2 - * added echo-xml function: we are no longer taking the car when - the last seed is returned from start-parse-xml - -25 May 2003 Sven Van Caekenberghe <svc@mac.com> - - * release 1 - * first public release of working code - * tested on OpenMCL - * rewritten to be event-based, to improve efficiency and - to optionally use different DOM representations - * more documentation - -end of 2002 Sven Van Caekenberghe <svc@mac.com> - - * release 0 - * as part of an XML-RPC implementation - -$Id: ChangeLog,v 1.5 2005/11/20 14:24:33 scaekenberghe Exp $ diff --git a/third_party/lisp/s-xml/Makefile b/third_party/lisp/s-xml/Makefile deleted file mode 100644 index 0c7292ea9fb5..000000000000 --- a/third_party/lisp/s-xml/Makefile +++ /dev/null @@ -1,35 +0,0 @@ -# $Id: Makefile,v 1.2 2004/06/11 13:46:48 scaekenberghe Exp $ - -default: - @echo Possible targets: - @echo clean-openmcl --- remove all '*.dfsl' recursively - @echo clean-lw --- remove all '*.nfasl' recursively - @echo clean-emacs --- remove all '*~' recursively - @echo clean --- all of the above - -clean-openmcl: - find . -name "*.dfsl" | xargs rm - -clean-lw: - find . -name "*.nfasl" | xargs rm - -clean-emacs: - find . -name "*~" | xargs rm - -clean: clean-openmcl clean-lw clean-emacs - -# -# This can obviously only be done by a specific person in a very specific context ;-) -# - -PRJ=s-xml -ACCOUNT=scaekenberghe -CVSRT=:ext:$(ACCOUNT)@common-lisp.net:/project/$(PRJ)/cvsroot - -release: - rm -rf /tmp/$(PRJ) /tmp/public_html /tmp/$(PRJ).tgz /tmp/$(PRJ).tgz.asc - cd /tmp; cvs -d$(CVSRT) export -r HEAD $(PRJ); cvs -d$(CVSRT) export -r HEAD public_html - mv /tmp/public_html /tmp/$(PRJ)/doc - cd /tmp; gnutar cvfz $(PRJ).tgz $(PRJ); gpg -a -b $(PRJ).tgz - scp /tmp/$(PRJ).tgz $(ACCOUNT)@common-lisp.net:/project/$(PRJ)/public_html - scp /tmp/$(PRJ).tgz.asc $(ACCOUNT)@common-lisp.net:/project/$(PRJ)/public_html diff --git a/third_party/lisp/s-xml/default.nix b/third_party/lisp/s-xml/default.nix index 82b6317f372c..3cd13ffb6b67 100644 --- a/third_party/lisp/s-xml/default.nix +++ b/third_party/lisp/s-xml/default.nix @@ -1,17 +1,23 @@ # XML serialiser for Common Lisp. -# -# This system was imported from a Quicklisp tarball at 's-xml-20150608'. -{ depot, ... }: +{ depot, pkgs, ... }: -depot.nix.buildLisp.library { +let src = pkgs.applyPatches { + name = "s-xml-source"; + src = pkgs.lispPackages.s-xml.src; + + patches = [ + ./0001-fix-definition-order-in-xml.lisp.patch + ]; +}; +in depot.nix.buildLisp.library { name = "s-xml"; - srcs = [ - ./src/package.lisp - ./src/xml.lisp - ./src/dom.lisp - ./src/lxml-dom.lisp - ./src/sxml-dom.lisp - ./src/xml-struct-dom.lisp + srcs = map (f: src + ("/src/" + f)) [ + "package.lisp" + "xml.lisp" + "dom.lisp" + "lxml-dom.lisp" + "sxml-dom.lisp" + "xml-struct-dom.lisp" ]; } diff --git a/third_party/lisp/s-xml/examples/counter.lisp b/third_party/lisp/s-xml/examples/counter.lisp deleted file mode 100644 index b26453e6ea66..000000000000 --- a/third_party/lisp/s-xml/examples/counter.lisp +++ /dev/null @@ -1,47 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: counter.lisp,v 1.2 2004/06/11 11:14:43 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 diff --git a/third_party/lisp/s-xml/examples/echo.lisp b/third_party/lisp/s-xml/examples/echo.lisp deleted file mode 100644 index a0befe2cbbbb..000000000000 --- a/third_party/lisp/s-xml/examples/echo.lisp +++ /dev/null @@ -1,64 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: echo.lisp,v 1.1 2005/08/17 13:44:30 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 diff --git a/third_party/lisp/s-xml/examples/remove-markup.lisp b/third_party/lisp/s-xml/examples/remove-markup.lisp deleted file mode 100644 index 41d858b4a8c5..000000000000 --- a/third_party/lisp/s-xml/examples/remove-markup.lisp +++ /dev/null @@ -1,21 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: remove-markup.lisp,v 1.1 2004/06/11 11:14:43 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 \ No newline at end of file diff --git a/third_party/lisp/s-xml/examples/tracer.lisp b/third_party/lisp/s-xml/examples/tracer.lisp deleted file mode 100644 index c8a3eaec1f2b..000000000000 --- a/third_party/lisp/s-xml/examples/tracer.lisp +++ /dev/null @@ -1,57 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: tracer.lisp,v 1.2 2004/06/11 11:14:43 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 diff --git a/third_party/lisp/s-xml/s-xml.asd b/third_party/lisp/s-xml/s-xml.asd deleted file mode 100644 index 651f5e5844c2..000000000000 --- a/third_party/lisp/s-xml/s-xml.asd +++ /dev/null @@ -1,49 +0,0 @@ -;;;; -*- Mode: LISP -*- -;;;; -;;;; $Id: s-xml.asd,v 1.2 2005/12/14 21:49:04 scaekenberghe Exp $ -;;;; -;;;; The S-XML ASDF system definition -;;;; -;;;; 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 :asdf) - -(defsystem :s-xml - :name "S-XML" - :author "Sven Van Caekenberghe <svc@mac.com>" - :version "3" - :maintainer "Sven Van Caekenberghe <svc@mac.com>, Brian Mastenbrook <>, Rudi Schlatte <>" - :licence "Lisp Lesser General Public License (LLGPL)" - :description "Simple Common Lisp XML Parser" - :long-description "S-XML is a Common Lisp implementation of a simple XML parser, with a SAX-like and DOM interface" - - :components - ((:module - :src - :components ((:file "package") - (:file "xml" :depends-on ("package")) - (:file "dom" :depends-on ("package" "xml")) - (:file "lxml-dom" :depends-on ("dom")) - (: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 diff --git a/third_party/lisp/s-xml/src/dom.lisp b/third_party/lisp/s-xml/src/dom.lisp deleted file mode 100644 index 74d1c371db22..000000000000 --- a/third_party/lisp/s-xml/src/dom.lisp +++ /dev/null @@ -1,75 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: dom.lisp,v 1.1.1.1 2004/06/07 18:49:56 scaekenberghe Exp $ -;;;; -;;;; This is the generic simple DOM parser and printer interface. -;;;; -;;;; 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) - -;;; top level DOM parser interface - -(defgeneric parse-xml-dom (stream output-type) - (:documentation "Parse a character stream as XML and generate a DOM of output-type")) - -(defun parse-xml (stream &key (output-type :lxml)) - "Parse a character stream as XML and generate a DOM of output-type, defaulting to :lxml" - (parse-xml-dom stream output-type)) - -(defun parse-xml-string (string &key (output-type :lxml)) - "Parse a string as XML and generate a DOM of output-type, defaulting to :lxml" - (with-input-from-string (stream string) - (parse-xml-dom stream output-type))) - -(defun parse-xml-file (filename &key (output-type :lxml)) - "Parse a character file as XML and generate a DOM of output-type, defaulting to :lxml" - (with-open-file (in filename :direction :input) - (parse-xml-dom in output-type))) - -;;; top level DOM printer interface - -(defgeneric print-xml-dom (dom input-type stream pretty level) - (:documentation "Generate XML output on a character stream from a DOM of input-type, optionally pretty printing using level")) - -(defun print-xml (dom &key (stream t) (pretty nil) (input-type :lxml) (header)) - "Generate XML output on a character stream (t by default) from a DOM of input-type (:lxml by default), optionally pretty printing (off by default), or adding a header (none by default)" - (when header (format stream header)) - (when pretty (terpri stream)) - (print-xml-dom dom input-type stream pretty 1)) - -(defun print-xml-string (dom &key (pretty nil) (input-type :lxml)) - "Generate XML output to a string from a DOM of input-type (:lxml by default), optionally pretty printing (off by default)" - (with-output-to-string (stream) - (print-xml dom :stream stream :pretty pretty :input-type input-type))) - -;;; shared/common support functions - -(defun print-spaces (n stream &optional (preceding-newline t)) - (when preceding-newline - (terpri stream)) - (loop :repeat n - :do (write-char #\Space stream))) - -(defun print-solitary-tag (tag stream) - (write-char #\< stream) - (print-identifier tag stream) - (write-string "/>" stream)) - -(defun print-closing-tag (tag stream) - (write-string "</" stream) - (print-identifier tag stream) - (write-char #\> stream)) - -(defun print-attribute (name value stream) - (write-char #\space stream) - (print-identifier name stream t) - (write-string "=\"" stream) - (print-string-xml value stream) - (write-char #\" stream)) - -;;;; eof diff --git a/third_party/lisp/s-xml/src/lxml-dom.lisp b/third_party/lisp/s-xml/src/lxml-dom.lisp deleted file mode 100644 index d43df6cf8171..000000000000 --- a/third_party/lisp/s-xml/src/lxml-dom.lisp +++ /dev/null @@ -1,83 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: lxml-dom.lisp,v 1.5 2005/09/20 09:57:44 scaekenberghe Exp $ -;;;; -;;;; LXML implementation of the generic DOM parser and printer. -;;;; -;;;; 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) - -;;; the lxml hooks to generate lxml - -(defun lxml-new-element-hook (name attributes seed) - (declare (ignore name attributes seed)) - '()) - -(defun lxml-finish-element-hook (name attributes parent-seed seed) - (let ((xml-element - (cond ((and (null seed) (null attributes)) - name) - (attributes - `((,name ,@(let (list) - (dolist (attribute attributes list) - (push (cdr attribute) list) - (push (car attribute) list)))) - ,@(nreverse seed))) - (t - `(,name ,@(nreverse seed)))))) - (cons xml-element parent-seed))) - -(defun lxml-text-hook (string seed) - (cons string seed)) - -;;; standard DOM interfaces - -(defmethod parse-xml-dom (stream (output-type (eql :lxml))) - (car (start-parse-xml stream - (make-instance 'xml-parser-state - :new-element-hook #'lxml-new-element-hook - :finish-element-hook #'lxml-finish-element-hook - :text-hook #'lxml-text-hook)))) - -(defun plist->alist (plist) - (when plist - (cons (cons (first plist) (second plist)) - (plist->alist (rest (rest plist)))))) - -(defmethod print-xml-dom (dom (input-type (eql :lxml)) stream pretty level) - (declare (special *namespaces*)) - (cond ((symbolp dom) (print-solitary-tag dom stream)) - ((stringp dom) (print-string-xml dom stream)) - ((consp dom) - (let (tag attributes) - (cond ((symbolp (first dom)) (setf tag (first dom))) - ((consp (first dom)) (setf tag (first (first dom)) - attributes (plist->alist (rest (first dom))))) - (t (error "Input not recognized as LXML ~s" dom))) - (let ((*namespaces* (extend-namespaces attributes *namespaces*))) - (write-char #\< stream) - (print-identifier tag stream) - (loop :for (name . value) :in attributes - :do (print-attribute name value stream)) - (if (rest dom) - (let ((children (rest dom))) - (write-char #\> stream) - (if (and (= (length children) 1) (stringp (first children))) - (print-string-xml (first children) stream) - (progn - (dolist (child children) - (when pretty (print-spaces (* 2 level) stream)) - (if (stringp child) - (print-string-xml child stream) - (print-xml-dom child input-type stream pretty (1+ level)))) - (when pretty (print-spaces (* 2 (1- level)) stream)))) - (print-closing-tag tag stream)) - (write-string "/>" stream))))) - (t (error "Input not recognized as LXML ~s" dom)))) - -;;;; eof \ No newline at end of file diff --git a/third_party/lisp/s-xml/src/package.lisp b/third_party/lisp/s-xml/src/package.lisp deleted file mode 100644 index f90f0f49a166..000000000000 --- a/third_party/lisp/s-xml/src/package.lisp +++ /dev/null @@ -1,46 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: package.lisp,v 1.7 2006/01/19 20:00:06 scaekenberghe Exp $ -;;;; -;;;; This is a Common Lisp implementation of a very basic XML parser. -;;;; The parser is non-validating. -;;;; The API into the parser is pure functional parser hook model that comes from SSAX, -;;;; see also http://pobox.com/~oleg/ftp/Scheme/xml.html or http://ssax.sourceforge.net -;;;; Different DOM models are provided, an XSML, an LXML and a xml-element struct based one. -;;;; -;;;; Copyright (C) 2002, 2003, 2004, 2005, 2006 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. - -(defpackage s-xml - (:use common-lisp) - (:export - ;; main parser interface - #:start-parse-xml - #:print-string-xml - #:xml-parser-error #:xml-parser-error-message #:xml-parser-error-args #:xml-parser-error-stream - #:xml-parser-state #:get-entities #:get-seed - #:get-new-element-hook #:get-finish-element-hook #:get-text-hook - ;; callbacks - #:*attribute-name-parser* - #:*attribute-value-parser* - #:parse-attribute-name - #:parse-attribute-value - ;; dom parser and printer - #:parse-xml-dom #:parse-xml #:parse-xml-string #:parse-xml-file - #:print-xml-dom #:print-xml #:print-xml-string - ;; xml-element structure - #:make-xml-element #:xml-element-children #:xml-element-name - #:xml-element-attribute #:xml-element-attributes - #:xml-element-p #:new-xml-element #:first-xml-element-child - ;; namespaces - #:*ignore-namespaces* #:*local-namespace* #:*namespaces* - #:*require-existing-symbols* #:*auto-export-symbols* #:*auto-create-namespace-packages* - #:find-namespace #:register-namespace #:get-prefix #:get-uri #:get-package - #:resolve-identifier #:extend-namespaces #:print-identifier #:split-identifier) - (:documentation - "A simple XML parser with an efficient, purely functional, event-based interface as well as a DOM interface")) - -;;;; eof diff --git a/third_party/lisp/s-xml/src/sxml-dom.lisp b/third_party/lisp/s-xml/src/sxml-dom.lisp deleted file mode 100644 index c9e0f9e0db4e..000000000000 --- a/third_party/lisp/s-xml/src/sxml-dom.lisp +++ /dev/null @@ -1,76 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: sxml-dom.lisp,v 1.4 2005/09/20 09:57:48 scaekenberghe Exp $ -;;;; -;;;; LXML implementation of the generic DOM parser and printer. -;;;; -;;;; Copyright (C) 2003, 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) - -;;; the sxml hooks to generate sxml - -(defun sxml-new-element-hook (name attributes seed) - (declare (ignore name attributes seed)) - '()) - -(defun sxml-finish-element-hook (name attributes parent-seed seed) - (let ((xml-element (append (list name) - (when attributes - (list (let (list) - (dolist (attribute attributes (cons :@ list)) - (push (list (car attribute) (cdr attribute)) list))))) - (nreverse seed)))) - (cons xml-element parent-seed))) - -(defun sxml-text-hook (string seed) - (cons string seed)) - -;;; the standard DOM interfaces - -(defmethod parse-xml-dom (stream (output-type (eql :sxml))) - (car (start-parse-xml stream - (make-instance 'xml-parser-state - :new-element-hook #'sxml-new-element-hook - :finish-element-hook #'sxml-finish-element-hook - :text-hook #'sxml-text-hook)))) - -(defmethod print-xml-dom (dom (input-type (eql :sxml)) stream pretty level) - (declare (special *namespaces*)) - (cond ((stringp dom) (print-string-xml dom stream)) - ((consp dom) - (let ((tag (first dom)) - attributes - children) - (if (and (consp (second dom)) (eq (first (second dom)) :@)) - (setf attributes (rest (second dom)) - children (rest (rest dom))) - (setf children (rest dom))) - (let ((*namespaces* (extend-namespaces (loop :for (name value) :in attributes - :collect (cons name value)) - *namespaces*))) - (write-char #\< stream) - (print-identifier tag stream) - (loop :for (name value) :in attributes - :do (print-attribute name value stream)) - (if children - (progn - (write-char #\> stream) - (if (and (= (length children) 1) (stringp (first children))) - (print-string-xml (first children) stream) - (progn - (dolist (child children) - (when pretty (print-spaces (* 2 level) stream)) - (if (stringp child) - (print-string-xml child stream) - (print-xml-dom child input-type stream pretty (1+ level)))) - (when pretty (print-spaces (* 2 (1- level)) stream)))) - (print-closing-tag tag stream)) - (write-string "/>" stream))))) - (t (error "Input not recognized as SXML ~s" dom)))) - -;;;; eof diff --git a/third_party/lisp/s-xml/src/xml-struct-dom.lisp b/third_party/lisp/s-xml/src/xml-struct-dom.lisp deleted file mode 100644 index 70373889152f..000000000000 --- a/third_party/lisp/s-xml/src/xml-struct-dom.lisp +++ /dev/null @@ -1,125 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: xml-struct-dom.lisp,v 1.2 2005/08/29 15:01:47 scaekenberghe Exp $ -;;;; -;;;; XML-STRUCT implementation of the generic DOM parser and printer. -;;;; -;;;; 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) - -;;; xml-element struct datastructure and API - -(defstruct xml-element - name ; :tag-name - attributes ; a assoc list of (:attribute-name . "attribute-value") - children ; a list of children/content either text strings or xml-elements - ) - -(setf (documentation 'xml-element-p 'function) - "Return T when the argument is an xml-element struct" - (documentation 'xml-element-attributes 'function) - "Return the alist of attribute names and values dotted pairs from an xml-element struct" - (documentation 'xml-element-children 'function) - "Return the list of children from an xml-element struct" - (documentation 'xml-element-name 'function) - "Return the name from an xml-element struct" - (documentation 'make-xml-element 'function) - "Make and return a new xml-element struct") - -(defun xml-element-attribute (xml-element key) - "Return the string value of the attribute with name the keyword :key - of xml-element if any, return null if not found" - (let ((pair (assoc key (xml-element-attributes xml-element) :test #'eq))) - (when pair (cdr pair)))) - -(defun (setf xml-element-attribute) (value xml-element key) - "Set the string value of the attribute with name the keyword :key of - xml-element, creating a new attribute if necessary or overwriting an - existing one, returning the value" - (let ((attributes (xml-element-attributes xml-element))) - (if (null attributes) - (push (cons key value) (xml-element-attributes xml-element)) - (let ((pair (assoc key attributes :test #'eq))) - (if pair - (setf (cdr pair) value) - (push (cons key value) (xml-element-attributes xml-element))))) - value)) - -(defun new-xml-element (name &rest children) - "Make a new xml-element with name and children" - (make-xml-element :name name :children children)) - -(defun first-xml-element-child (xml-element) - "Get the first child of an xml-element" - (first (xml-element-children xml-element))) - -(defun xml-equal (xml-1 xml-2) - (and (xml-element-p xml-1) - (xml-element-p xml-2) - (eq (xml-element-name xml-1) - (xml-element-name xml-2)) - (equal (xml-element-attributes xml-1) - (xml-element-attributes xml-2)) - (reduce #'(lambda (&optional (x t) (y t)) (and x y)) - (mapcar #'(lambda (x y) - (or (and (stringp x) (stringp y) (string= x y)) - (xml-equal x y))) - (xml-element-children xml-1) - (xml-element-children xml-2))))) - -;;; printing xml structures - -(defmethod print-xml-dom (xml-element (input-type (eql :xml-struct)) stream pretty level) - (declare (special *namespaces*)) - (let ((*namespaces* (extend-namespaces (xml-element-attributes xml-element) - *namespaces*))) - (write-char #\< stream) - (print-identifier (xml-element-name xml-element) stream) - (loop :for (name . value) :in (xml-element-attributes xml-element) - :do (print-attribute name value stream)) - (let ((children (xml-element-children xml-element))) - (if children - (progn - (write-char #\> stream) - (if (and (= (length children) 1) (stringp (first children))) - (print-string-xml (first children) stream) - (progn - (dolist (child children) - (when pretty (print-spaces (* 2 level) stream)) - (if (stringp child) - (print-string-xml child stream) - (print-xml-dom child input-type stream pretty (1+ level)))) - (when pretty (print-spaces (* 2 (1- level)) stream)))) - (print-closing-tag (xml-element-name xml-element) stream)) - (write-string "/>" stream))))) - -;;; the standard hooks to generate xml-element structs - -(defun standard-new-element-hook (name attributes seed) - (declare (ignore name attributes seed)) - '()) - -(defun standard-finish-element-hook (name attributes parent-seed seed) - (let ((xml-element (make-xml-element :name name - :attributes attributes - :children (nreverse seed)))) - (cons xml-element parent-seed))) - -(defun standard-text-hook (string seed) - (cons string seed)) - -;;; top level standard parser interfaces - -(defmethod parse-xml-dom (stream (output-type (eql :xml-struct))) - (car (start-parse-xml stream - (make-instance 'xml-parser-state - :new-element-hook #'standard-new-element-hook - :finish-element-hook #'standard-finish-element-hook - :text-hook #'standard-text-hook)))) - -;;;; eof diff --git a/third_party/lisp/s-xml/src/xml.lisp b/third_party/lisp/s-xml/src/xml.lisp deleted file mode 100644 index 8a2076985a49..000000000000 --- a/third_party/lisp/s-xml/src/xml.lisp +++ /dev/null @@ -1,702 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: xml.lisp,v 1.15 2006/01/19 20:00:06 scaekenberghe Exp $ -;;;; -;;;; This is a Common Lisp implementation of a basic but usable XML parser. -;;;; The parser is non-validating and not complete (no PI). -;;;; Namespace and entities are handled. -;;;; The API into the parser is a pure functional parser hook model that comes from SSAX, -;;;; see also http://pobox.com/~oleg/ftp/Scheme/xml.html or http://ssax.sourceforge.net -;;;; Different DOM models are provided, an XSML, an LXML and a xml-element struct based one. -;;;; -;;;; Copyright (C) 2002, 2003, 2004, 2005, 2006 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) - -;;; (tazjin): moved up here because something was wonky with the -;;; definition order -(defvar *ignore-namespaces* nil - "When t, namespaces are ignored like in the old version of S-XML") - -;;; error reporting - -(define-condition xml-parser-error (error) - ((message :initarg :message :reader xml-parser-error-message) - (args :initarg :args :reader xml-parser-error-args) - (stream :initarg :stream :reader xml-parser-error-stream :initform nil)) - (:report (lambda (condition stream) - (format stream - "XML parser ~?~@[ near stream position ~d~]." - (xml-parser-error-message condition) - (xml-parser-error-args condition) - (and (xml-parser-error-stream condition) - (file-position (xml-parser-error-stream condition)))))) - (:documentation "Thrown by the XML parser to indicate errorneous input")) - -(setf (documentation 'xml-parser-error-message 'function) - "Get the message from an XML parser error" - (documentation 'xml-parser-error-args 'function) - "Get the error arguments from an XML parser error" - (documentation 'xml-parser-error-stream 'function) - "Get the stream from an XML parser error") - -(defun parser-error (message &optional args stream) - (make-condition 'xml-parser-error - :message message - :args args - :stream stream)) - -;; attribute parsing hooks -;; this is a bit complicated, refer to the mailing lists for a more detailed explanation - -(defun parse-attribute-name (string) - "Default parser for the attribute name" - (declare (special *namespaces*)) - (resolve-identifier string *namespaces* t)) - -(defun parse-attribute-value (name string) - "Default parser for the attribute value" - (declare (ignore name) - (special *ignore-namespace*)) - (if *ignore-namespaces* - (copy-seq string) - string)) - -(defparameter *attribute-name-parser* #'parse-attribute-name - "Called to compute interned attribute name from a buffer that will be reused") - -(defparameter *attribute-value-parser* #'parse-attribute-value - "Called to compute an element of an attribute list from a buffer that will be reused") - -;;; utilities - -(defun whitespace-char-p (char) - "Is char an XML whitespace character ?" - (declare (type character char)) - (or (char= char #\space) - (char= char #\tab) - (char= char #\return) - (char= char #\linefeed))) - -(defun identifier-char-p (char) - "Is char an XML identifier character ?" - (declare (type character char)) - (or (and (char<= #\A char) (char<= char #\Z)) - (and (char<= #\a char) (char<= char #\z)) - (and (char<= #\0 char) (char<= char #\9)) - (char= char #\-) - (char= char #\_) - (char= char #\.) - (char= char #\:))) - -(defun skip-whitespace (stream) - "Skip over XML whitespace in stream, return first non-whitespace - character which was peeked but not read, return nil on eof" - (loop - (let ((char (peek-char nil stream nil #\Null))) - (declare (type character char)) - (if (whitespace-char-p char) - (read-char stream) - (return char))))) - -(defun make-extendable-string (&optional (size 10)) - "Make an extendable string which is a one-dimensional character - array which is adjustable and has a fill pointer" - (make-array size - :element-type 'character - :adjustable t - :fill-pointer 0)) - -(defun print-string-xml (string stream &key (start 0) end) - "Write the characters of string to stream using basic XML conventions" - (loop for offset upfrom start below (or end (length string)) - for char = (char string offset) - do (case char - (#\& (write-string "&" stream)) - (#\< (write-string "<" stream)) - (#\> (write-string ">" stream)) - (#\" (write-string """ stream)) - ((#\newline #\return #\tab) (write-char char stream)) - (t (if (and (<= 32 (char-code char)) - (<= (char-code char) 126)) - (write-char char stream) - (progn - (write-string "&#x" stream) - (write (char-code char) :stream stream :base 16) - (write-char #\; stream))))))) - -(defun make-standard-entities () - "A hashtable mapping XML entity names to their replacement strings, - filled with the standard set" - (let ((entities (make-hash-table :test #'equal))) - (setf (gethash "amp" entities) (string #\&) - (gethash "quot" entities) (string #\") - (gethash "apos" entities) (string #\') - (gethash "lt" entities) (string #\<) - (gethash "gt" entities) (string #\>) - (gethash "nbsp" entities) (string #\space)) - entities)) - -(defun resolve-entity (stream extendable-string entities entity) - "Read and resolve an XML entity from stream, positioned after the '&' entity marker, - accepting &name; &#DEC; and &#xHEX; formats, - destructively modifying string, which is also returned, - destructively modifying entity, incorrect entity formats result in errors" - (declare (type (vector character) entity)) - (loop - (let ((char (read-char stream nil #\Null))) - (declare (type character char)) - (cond ((char= char #\Null) (error (parser-error "encountered eof before end of entity"))) - ((char= #\; char) (return)) - (t (vector-push-extend char entity))))) - (if (char= (char entity 0) #\#) - (let ((code (if (char= (char entity 1) #\x) - (parse-integer entity :start 2 :radix 16 :junk-allowed t) - (parse-integer entity :start 1 :radix 10 :junk-allowed t)))) - (when (null code) - (error (parser-error "encountered incorrect entity &~s;" (list entity) stream))) - (vector-push-extend (code-char code) extendable-string)) - (let ((value (gethash entity entities))) - (if value - (loop :for char :across value - :do (vector-push-extend char extendable-string)) - (error (parser-error "encountered unknown entity &~s;" (list entity) stream))))) - extendable-string) - -;;; namespace support - -(defclass xml-namespace () - ((uri :documentation "The URI used to identify this namespace" - :accessor get-uri - :initarg :uri) - (prefix :documentation "The preferred prefix assigned to this namespace" - :accessor get-prefix - :initarg :prefix - :initform nil) - (package :documentation "The Common Lisp package where this namespace's symbols are interned" - :accessor get-package - :initarg :package - :initform nil)) - (:documentation "Describes an XML namespace and how it is handled")) - -(setf (documentation 'get-uri 'function) - "The URI used to identify this namespace" - (documentation 'get-prefix 'function) - "The preferred prefix assigned to this namespace" - (documentation 'get-package 'function) - "The Common Lisp package where this namespace's symbols are interned") - -(defmethod print-object ((object xml-namespace) stream) - (print-unreadable-object (object stream :type t :identity t) - (format stream "~A - ~A" (get-prefix object) (get-uri object)))) - -(defvar *local-namespace* (make-instance 'xml-namespace - :uri "local" - :prefix "" - :package (find-package :keyword)) - "The local (global default) XML namespace") - -(defvar *xml-namespace* (make-instance 'xml-namespace - :uri "http://www.w3.org/XML/1998/namespace" - :prefix "xml" - :package (or (find-package :xml) - (make-package :xml :nicknames '("XML")))) - "REC-xml-names-19990114 says the prefix xml is bound to the namespace http://www.w3.org/XML/1998/namespace.") - -(defvar *known-namespaces* (list *local-namespace* *xml-namespace*) - "The list of known/defined namespaces") - -(defvar *namespaces* `(("xml" . ,*xml-namespace*) ("" . ,*local-namespace*)) - "Ordered list of (prefix . XML-namespace) bindings currently in effect - special variable") - -(defun find-namespace (uri) - "Find a registered XML namespace identified by uri" - (find uri *known-namespaces* :key #'get-uri :test #'string-equal)) - -(defun register-namespace (uri prefix package) - "Register a new or redefine an existing XML namespace defined by uri with prefix and package" - (let ((namespace (find-namespace uri))) - (if namespace - (setf (get-prefix namespace) prefix - (get-package namespace) (find-package package)) - (push (setf namespace (make-instance 'xml-namespace - :uri uri - :prefix prefix - :package (find-package package))) - *known-namespaces*)) - namespace)) - -(defun find-namespace-binding (prefix namespaces) - "Find the XML namespace currently bound to prefix in the namespaces bindings" - (cdr (assoc prefix namespaces :test #'string-equal))) - -(defun split-identifier (identifier) - "Split an identifier 'prefix:name' and return (values prefix name)" - (when (symbolp identifier) - (setf identifier (symbol-name identifier))) - (let ((colon-position (position #\: identifier :test #'char=))) - (if colon-position - (values (subseq identifier 0 colon-position) - (subseq identifier (1+ colon-position))) - (values nil identifier)))) - -(defvar *require-existing-symbols* nil - "If t, each XML identifier must exist as symbol already") - -(defvar *auto-export-symbols* t - "If t, export newly interned symbols form their packages") - -(defun resolve-identifier (identifier namespaces &optional as-attribute) - "Resolve the string identifier in the list of namespace bindings" - (if *ignore-namespaces* - (intern identifier :keyword) - (flet ((intern-symbol (string package) ; intern string as a symbol in package - (if *require-existing-symbols* - (let ((symbol (find-symbol string package))) - (or symbol - (error "Symbol ~s does not exist in ~s" string package))) - (let ((symbol (intern string package))) - (when (and *auto-export-symbols* - (not (eql package (find-package :keyword)))) - (export symbol package)) - symbol)))) - (multiple-value-bind (prefix name) - (split-identifier identifier) - (if (or (null prefix) (string= prefix "xmlns")) - (if as-attribute - (intern (if (string= prefix "xmlns") identifier name) (get-package *local-namespace*)) - (let ((default-namespace (find-namespace-binding "" namespaces))) - (intern-symbol name (get-package default-namespace)))) - (let ((namespace (find-namespace-binding prefix namespaces))) - (if namespace - (intern-symbol name (get-package namespace)) - (error "namespace not found for prefix ~s" prefix)))))))) - -(defvar *auto-create-namespace-packages* t - "If t, new packages will be created for namespaces, if needed, named by the prefix") - -(defun new-namespace (uri &optional prefix) - "Register a new namespace for uri and prefix, creating a package if necessary" - (if prefix - (register-namespace uri - prefix - (or (find-package prefix) - (if *auto-create-namespace-packages* - (make-package prefix :nicknames `(,(string-upcase prefix))) - (error "Cannot find or create package ~s" prefix)))) - (let ((unique-name (loop :for i :upfrom 0 - :do (let ((name (format nil "ns-~d" i))) - (when (not (find-package name)) - (return name)))))) - (register-namespace uri - unique-name - (if *auto-create-namespace-packages* - (make-package (string-upcase unique-name) :nicknames `(,unique-name)) - (error "Cannot create package ~s" unique-name)))))) - -(defun extend-namespaces (attributes namespaces) - "Given possible 'xmlns[:prefix]' attributes, extend the namespaces bindings" - (unless *ignore-namespaces* - (let (default-namespace-uri) - (loop :for (key . value) :in attributes - :do (if (string= key "xmlns") - (setf default-namespace-uri value) - (multiple-value-bind (prefix name) - (split-identifier key) - (when (string= prefix "xmlns") - (let* ((uri value) - (prefix name) - (namespace (find-namespace uri))) - (unless namespace - (setf namespace (new-namespace uri prefix))) - (push `(,prefix . ,namespace) namespaces)))))) - (when default-namespace-uri - (let ((namespace (find-namespace default-namespace-uri))) - (unless namespace - (setf namespace (new-namespace default-namespace-uri))) - (push `("" . ,namespace) namespaces))))) - namespaces) - -(defun print-identifier (identifier stream &optional as-attribute) - "Print identifier on stream using namespace conventions" - (declare (ignore as-attribute) (special *namespaces*)) - (if *ignore-namespaces* - (princ identifier stream) - (if (symbolp identifier) - (let ((package (symbol-package identifier)) - (name (symbol-name identifier))) - (let* ((namespace (find package *known-namespaces* :key #'get-package)) - (prefix (or (car (find namespace *namespaces* :key #'cdr)) - (get-prefix namespace)))) - (if (string= prefix "") - (princ name stream) - (format stream "~a:~a" prefix name)))) - (princ identifier stream)))) - -;;; the parser state - -(defclass xml-parser-state () - ((entities :documentation "A hashtable mapping XML entity names to their replacement stings" - :accessor get-entities - :initarg :entities - :initform (make-standard-entities)) - (seed :documentation "The user seed object" - :accessor get-seed - :initarg :seed - :initform nil) - (buffer :documentation "The main reusable character buffer" - :accessor get-buffer - :initform (make-extendable-string)) - (mini-buffer :documentation "The secondary, smaller reusable character buffer" - :accessor get-mini-buffer - :initform (make-extendable-string)) - (new-element-hook :documentation "Called when new element starts" - ;; Handle the start of a new xml element with name and attributes, - ;; receiving seed from previous element (sibling or parent) - ;; return seed to be used for first child (content) - ;; or directly to finish-element-hook - :accessor get-new-element-hook - :initarg :new-element-hook - :initform #'(lambda (name attributes seed) - (declare (ignore name attributes)) - seed)) - (finish-element-hook :documentation "Called when element ends" - ;; Handle the end of an xml element with name and attributes, - ;; receiving parent-seed, the seed passed to us when this element started, - ;; i.e. passed to our corresponding new-element-hook - ;; and receiving seed from last child (content) - ;; or directly from new-element-hook - ;; return final seed for this element to next element (sibling or parent) - :accessor get-finish-element-hook - :initarg :finish-element-hook - :initform #'(lambda (name attributes parent-seed seed) - (declare (ignore name attributes parent-seed)) - seed)) - (text-hook :documentation "Called when text is found" - ;; Handle text in string, found as contents, - ;; receiving seed from previous element (sibling or parent), - ;; return final seed for this element to next element (sibling or parent) - :accessor get-text-hook - :initarg :text-hook - :initform #'(lambda (string seed) - (declare (ignore string)) - seed))) - (:documentation "The XML parser state passed along all code making up the parser")) - -(setf (documentation 'get-seed 'function) - "Get the initial user seed of an XML parser state" - (documentation 'get-entities 'function) - "Get the entities hashtable of an XML parser state" - (documentation 'get-new-element-hook 'function) - "Get the new element hook of an XML parser state" - (documentation 'get-finish-element-hook 'function) - "Get the finish element hook of an XML parser state" - (documentation 'get-text-hook 'function) - "Get the text hook of an XML parser state") - -#-allegro -(setf (documentation '(setf get-seed) 'function) - "Set the initial user seed of an XML parser state" - (documentation '(setf get-entities) 'function) - "Set the entities hashtable of an XML parser state" - (documentation '(setf get-new-element-hook) 'function) - "Set the new element hook of an XML parser state" - (documentation '(setf get-finish-element-hook) 'function) - "Set the finish element hook of an XML parser state" - (documentation '(setf get-text-hook) 'function) - "Set the text hook of an XML parser state") - -(defmethod get-mini-buffer :after ((state xml-parser-state)) - "Reset and return the reusable mini buffer" - (with-slots (mini-buffer) state - (setf (fill-pointer mini-buffer) 0))) - -(defmethod get-buffer :after ((state xml-parser-state)) - "Reset and return the main reusable buffer" - (with-slots (buffer) state - (setf (fill-pointer buffer) 0))) - -;;; parser support - -(defun parse-whitespace (stream extendable-string) - "Read and collect XML whitespace from stream in string which is - destructively modified, return first non-whitespace character which - was peeked but not read, return #\Null on eof" - (declare (type (vector character) extendable-string)) - (loop - (let ((char (peek-char nil stream nil #\Null))) - (declare (type character char)) - (if (whitespace-char-p char) - (vector-push-extend (read-char stream) extendable-string) - (return char))))) - -(defun parse-string (stream state string) - "Read and return an XML string from stream, delimited by either - single or double quotes, the stream is expected to be on the opening - delimiter, at the end the closing delimiter is also read, entities - are resolved, eof before end of string is an error" - (declare (type (vector character) string)) - (let ((delimiter (read-char stream nil #\Null)) - (char #\Null)) - (declare (type character delimiter char)) - (unless (or (char= delimiter #\') (char= delimiter #\")) - (error (parser-error "expected string delimiter" nil stream))) - (loop - (setf char (read-char stream nil #\Null)) - (cond ((char= char #\Null) (error (parser-error "encountered eof before end of string"))) - ((char= char delimiter) (return)) - ((char= char #\&) (resolve-entity stream string (get-entities state) (get-mini-buffer state))) - (t (vector-push-extend char string)))) - string)) - -(defun parse-text (stream state extendable-string) - "Read and collect XML text from stream in string which is - destructively modified, the text ends with a '<', which is peeked and - returned, entities are resolved, eof is considered an error" - (declare (type (vector character) extendable-string)) - (let ((char #\Null)) - (declare (type character char)) - (loop - (setf char (peek-char nil stream nil #\Null)) - (when (char= char #\Null) (error (parser-error "encountered unexpected eof in text"))) - (when (char= char #\<) (return)) - (read-char stream) - (if (char= char #\&) - (resolve-entity stream extendable-string (get-entities state) (get-mini-buffer state)) - (vector-push-extend char extendable-string))) - char)) - -(defun parse-identifier (stream identifier) - "Read and returns an XML identifier from stream, positioned at the - start of the identifier, ending with the first non-identifier - character, which is peeked, the identifier is written destructively - into identifier which is also returned" - (declare (type (vector character) identifier)) - (loop - (let ((char (read-char stream nil #\Null))) - (declare (type character char)) - (cond ((identifier-char-p char) - (vector-push-extend char identifier)) - (t - (when (char/= char #\Null) (unread-char char stream)) - (return identifier)))))) - -(defun skip-comment (stream) - "Skip an XML comment in stream, positioned after the opening '<!--', - consumes the closing '-->' sequence, unexpected eof or a malformed - closing sequence result in a error" - (let ((dashes-to-read 2)) - (loop - (if (zerop dashes-to-read) (return)) - (let ((char (read-char stream nil #\Null))) - (declare (type character char)) - (if (char= char #\Null) - (error (parser-error "encountered unexpected eof for comment"))) - (if (char= char #\-) - (decf dashes-to-read) - (setf dashes-to-read 2))))) - (if (char/= (read-char stream nil #\Null) #\>) - (error (parser-error "expected > ending comment" nil stream)))) - -(defun read-cdata (stream state string) - "Reads in the CDATA and calls the callback for CDATA if it exists" - ;; we already read the <![CDATA[ stuff - ;; continue to read until we hit ]]> - (let ((char #\space) - (last-3-characters (list #\[ #\A #\T)) - (pattern (list #\> #\] #\]))) - (declare (type character char)) - (loop - (setf char (read-char stream nil #\Null)) - (when (char= char #\Null) (error (parser-error "encountered unexpected eof in text"))) - (push char last-3-characters) - (setf (cdddr last-3-characters) nil) - (cond - ((equal last-3-characters - pattern) - (setf (fill-pointer string) - (- (fill-pointer string) 2)) - (setf (get-seed state) - (funcall (get-text-hook state) - (copy-seq string) - (get-seed state))) - (return-from read-cdata)) - (t - (vector-push-extend char string)))))) - -(defun skip-special-tag (stream state) - "Skip an XML special tag (comments and processing instructions) in - stream, positioned after the opening '<', unexpected eof is an error" - ;; opening < has been read, consume ? or ! - (read-char stream) - (let ((char (read-char stream nil #\Null))) - (declare (type character char)) - ;; see if we are dealing with a comment - (when (char= char #\-) - (setf char (read-char stream nil #\Null)) - (when (char= char #\-) - (skip-comment stream) - (return-from skip-special-tag))) - ;; maybe we are dealing with CDATA? - (when (and (char= char #\[) - (loop :for pattern :across "CDATA[" - :for char = (read-char stream nil #\Null) - :when (char= char #\Null) :do - (error (parser-error "encountered unexpected eof in cdata")) - :always (char= char pattern))) - (read-cdata stream state (get-buffer state)) - (return-from skip-special-tag)) - ;; loop over chars, dealing with strings (skipping their content) - ;; and counting opening and closing < and > chars - (let ((taglevel 1) - (string-delimiter #\Null)) - (declare (type character string-delimiter)) - (loop - (when (zerop taglevel) (return)) - (setf char (read-char stream nil #\Null)) - (when (char= char #\Null) - (error (parser-error "encountered unexpected eof for special (! or ?) tag" nil stream))) - (if (char/= string-delimiter #\Null) - ;; inside a string we only look for a closing string delimiter - (when (char= char string-delimiter) - (setf string-delimiter #\Null)) - ;; outside a string we count < and > and watch out for strings - (cond ((or (char= char #\') (char= char #\")) (setf string-delimiter char)) - ((char= char #\<) (incf taglevel)) - ((char= char #\>) (decf taglevel)))))))) - -;;; the XML parser proper - -(defun parse-xml-element-attributes (stream state) - "Parse XML element attributes from stream positioned after the tag - identifier, returning the attributes as an assoc list, ending at - either a '>' or a '/' which is peeked and also returned" - (declare (special *namespaces*)) - (let ((char #\Null) attributes) - (declare (type character char)) - (loop - ;; skip whitespace separating items - (setf char (skip-whitespace stream)) - ;; start tag attributes ends with > or /> - (when (or (char= char #\>) (char= char #\/)) (return)) - ;; read the attribute key - (let ((key (let ((string (parse-identifier stream (get-mini-buffer state)))) - (if *ignore-namespaces* - (funcall *attribute-name-parser* string) - (copy-seq string))))) - ;; skip separating whitespace - (setf char (skip-whitespace stream)) - ;; require = sign (and consume it if present) - (if (char= char #\=) - (read-char stream) - (error (parser-error "expected =" nil stream))) - ;; skip separating whitespace - (skip-whitespace stream) - ;; read the attribute value as a string - (push (cons key (let ((string (parse-string stream state (get-buffer state)))) - (if *ignore-namespaces* - (funcall *attribute-value-parser* key string) - (copy-seq string)))) - attributes))) - ;; return attributes peek char ending loop - (values attributes char))) - -(defun parse-xml-element (stream state) - "Parse and return an XML element from stream, positioned after the opening '<'" - (declare (special *namespaces*)) - ;; opening < has been read - (when (char= (peek-char nil stream nil #\Null) #\!) - (skip-special-tag stream state) - (return-from parse-xml-element)) - (let ((char #\Null) buffer open-tag parent-seed has-children) - (declare (type character char)) - (setf parent-seed (get-seed state)) - ;; read tag name (no whitespace between < and name ?) - (setf open-tag (copy-seq (parse-identifier stream (get-mini-buffer state)))) - ;; tag has been read, read attributes if any - (multiple-value-bind (attributes peeked-char) - (parse-xml-element-attributes stream state) - (let ((*namespaces* (extend-namespaces attributes *namespaces*))) - (setf open-tag (resolve-identifier open-tag *namespaces*)) - (unless *ignore-namespaces* - (dolist (attribute attributes) - (setf (car attribute) (funcall *attribute-name-parser* (car attribute)) - (cdr attribute) (funcall *attribute-value-parser* (car attribute) (cdr attribute))))) - (setf (get-seed state) (funcall (get-new-element-hook state) - open-tag attributes (get-seed state))) - (setf char peeked-char) - (when (char= char #\/) - ;; handle solitary tag of the form <tag .. /> - (read-char stream) - (setf char (read-char stream nil #\Null)) - (if (char= #\> char) - (progn - (setf (get-seed state) (funcall (get-finish-element-hook state) - open-tag attributes parent-seed (get-seed state))) - (return-from parse-xml-element)) - (error (parser-error "expected >" nil stream)))) - ;; consume > - (read-char stream) - (loop - (setf buffer (get-buffer state)) - ;; read whitespace into buffer - (setf char (parse-whitespace stream buffer)) - ;; see what ended the whitespace scan - (cond ((char= char #\Null) (error (parser-error "encountered unexpected eof handling ~a" - (list open-tag)))) - ((char= char #\<) - ;; consume the < - (read-char stream) - (if (char= (peek-char nil stream nil #\Null) #\/) - (progn - ;; handle the matching closing tag </tag> and done - ;; if we read whitespace as this (leaf) element's contents, it is significant - (when (and (not has-children) (plusp (length buffer))) - (setf (get-seed state) (funcall (get-text-hook state) - (copy-seq buffer) (get-seed state)))) - (read-char stream) - (let ((close-tag (resolve-identifier (parse-identifier stream (get-mini-buffer state)) - *namespaces*))) - (unless (eq open-tag close-tag) - (error (parser-error "found <~a> not matched by </~a> but by <~a>" - (list open-tag open-tag close-tag) stream))) - (unless (char= (read-char stream nil #\Null) #\>) - (error (parser-error "expected >" nil stream))) - (setf (get-seed state) (funcall (get-finish-element-hook state) - open-tag attributes parent-seed (get-seed state)))) - (return)) - ;; handle child tag and loop, no hooks to call here - ;; whitespace between child elements is skipped - (progn - (setf has-children t) - (parse-xml-element stream state)))) - (t - ;; no child tag, concatenate text to whitespace in buffer - ;; handle text content and loop - (setf char (parse-text stream state buffer)) - (setf (get-seed state) (funcall (get-text-hook state) - (copy-seq buffer) (get-seed state)))))))))) - -(defun start-parse-xml (stream &optional (state (make-instance 'xml-parser-state))) - "Parse and return a toplevel XML element from stream, using parser state" - (loop - (let ((char (skip-whitespace stream))) - (when (char= char #\Null) (return-from start-parse-xml)) - ;; skip whitespace until start tag - (unless (char= char #\<) - (error (parser-error "expected <" nil stream))) - (read-char stream) ; consume peeked char - (setf char (peek-char nil stream nil #\Null)) - (if (or (char= char #\!) (char= char #\?)) - ;; deal with special tags - (skip-special-tag stream state) - (progn - ;; read the main element - (parse-xml-element stream state) - (return-from start-parse-xml (get-seed state))))))) - -;;;; eof diff --git a/third_party/lisp/s-xml/test/ant-build-file.xml b/third_party/lisp/s-xml/test/ant-build-file.xml deleted file mode 100644 index 91d78707b8a1..000000000000 --- a/third_party/lisp/s-xml/test/ant-build-file.xml +++ /dev/null @@ -1,252 +0,0 @@ -<!-- $Id: ant-build-file.xml,v 1.1 2003/03/18 08:22:09 sven Exp $ --> -<!-- Ant 1.2 build file --> - -<project name="Libretto" default="compile" basedir="."> - - <!-- set global properties for this build --> - <property name="src" value="${basedir}/src" /> - <property name="rsrc" value="${basedir}/rsrc" /> - <property name="build" value="${basedir}/bin" /> - <property name="api" value="${basedir}/api" /> - <property name="lib" value="${basedir}/lib" /> - <property name="junit" value="${basedir}/junit" /> - <property name="rsrc" value="${basedir}/rsrc" /> - - <target name="prepare"> - <!-- Create the time stamp --> - <tstamp/> - <!-- Create the build directory structure used by compile --> - <mkdir dir="${build}" /> - <mkdir dir="${api}" /> - <mkdir dir="${junit}" /> - <copy file="${rsrc}/build/build.version" tofile="${build}/build.properties"/> - <replace file="${build}/build.properties" token="@@@BUILD_ID@@@" value="${DSTAMP}-${TSTAMP}"/> - </target> - - <target name="compile" depends="copy-rsrc"> - <!-- Compile the java code from ${src} into ${build} --> - <javac srcdir="${src}" destdir="${build}" debug="on"> - <classpath> - <fileset dir="${lib}"> - <include name="log4j-core.jar" /> - <include name="jaxp.jar" /> - <include name="crimson.jar" /> - <include name="jdom.jar" /> - <include name="beanshell.jar" /> - </fileset> - </classpath> - </javac> - </target> - - <target name="compile-junit" depends="copy-rsrc"> - <!-- Compile the java code from ${src} into ${build} --> - <javac srcdir="${junit}" destdir="${build}" debug="on"> - <classpath> - <fileset dir="${lib}"> - <include name="*.jar" /> - </fileset> - </classpath> - </javac> - </target> - - <target name="copy-rsrc" depends="prepare"> - <!-- Copy various resource files into ${build} --> - <copy todir="${build}"> - <fileset - dir="${basedir}" - includes="images/*.gif, images/*.jpg" /> - </copy> - <copy todir="${build}"> - <fileset - dir="${src}" - includes="be/beta9/libretto/data/*.txt" /> - </copy> - <copy todir="${build}"> - <fileset - dir="${rsrc}/log4j" - includes="log4j.properties" /> - </copy> - </target> - - <target name="c-header" depends="compile"> - <javah destdir="${rsrc}/VC_source" class="be.beta9.libretto.io.ParallelPort"> - <classpath> - <pathelement location="${build}" /> - </classpath> - </javah> - </target> - - <target name="test-parport" depends="compile"> - <java - classname="be.beta9.libretto.io.ParallelPortWriter" - fork="yes"> - <classpath> - <pathelement location="${build}" /> - <fileset dir="${lib}"> - <include name="*.jar" /> - </fileset> - </classpath> - </java> - </target> - - <target name="jar-simple" depends="compile"> - <!-- Put everything in ${build} into the a jar file --> - <jar - jarfile="${basedir}/libretto.jar" - basedir="${build}" - manifest="${rsrc}/manifest/libretto.mf"/> - </target> - - <target name="jar" depends="compile"> - <!-- Put everything in ${build} into the a jar file including all dependecies --> - <unjar src="${lib}/jaxp.jar" dest="${build}" /> - <unjar src="${lib}/crimson.jar" dest="${build}" /> - <unjar src="${lib}/jdom.jar" dest="${build}" /> - <unjar src="${lib}/log4j-core.jar" dest="${build}" /> - <jar - jarfile="${basedir}/libretto.jar" - basedir="${build}" - manifest="${rsrc}/manifest/libretto.mf"/> - </target> - - <target name="client-jar" depends="background-jar"> - <!-- Put everything in ${build} into the a jar file including all dependecies --> - <unjar src="${lib}/log4j-core.jar" dest="${build}" /> - <jar jarfile="${basedir}/libretto-client.jar" manifest="${rsrc}/manifest/libretto-client.mf"> - <fileset dir="${build}"> - <include name="build.properties"/> - <include name="log4j.properties"/> - <include name="be/beta9/libretto/io/*.class"/> - <include name="be/beta9/libretto/application/Build.class"/> - <include name="be/beta9/libretto/net/LibrettoTextClient*.class"/> - <include name="be/beta9/libretto/net/TestClientMessage.class"/> - <include name="be/beta9/libretto/net/ClientStatusMessageResult.class"/> - <include name="be/beta9/libretto/net/Client*.class"/> - <include name="be/beta9/libretto/net/Constants.class"/> - <include name="be/beta9/libretto/net/TextMessage.class"/> - <include name="be/beta9/libretto/net/MessageResult.class"/> - <include name="be/beta9/libretto/net/MessageException.class"/> - <include name="be/beta9/libretto/net/SingleTextMessage.class"/> - <include name="be/beta9/libretto/net/Message.class"/> - <include name="be/beta9/libretto/net/Util.class"/> - <include name="be/beta9/libretto/gui/ShowSingleTextFrame*.class"/> - <include name="be/beta9/libretto/gui/AWTTextView*.class"/> - <include name="be/beta9/libretto/model/AttributedString*.class"/> - <include name="be/beta9/libretto/model/AWTTextStyle.class"/> - <include name="be/beta9/libretto/model/LTextStyle.class"/> - <include name="be/beta9/libretto/model/AWTCharacterAttributes.class"/> - <include name="be/beta9/libretto/model/Java2DTextStyle.class"/> - <include name="be/beta9/libretto/model/LCharacterAttributes.class"/> - <include name="be/beta9/libretto/model/Java2DCharacterAttributes.class"/> - <include name="be/beta9/libretto/util/TextStyleManager.class"/> - <include name="be/beta9/libretto/util/Bean.class"/> - <include name="be/beta9/libretto/util/LibrettoSaxReader.class"/> - <include name="be/beta9/libretto/util/Preferences.class"/> - <include name="be/beta9/libretto/util/Utilities.class"/> - <include name="org/apache/log4j/**"/> - </fileset> - </jar> - </target> - - <target name="background-jar" depends="compile"> - <!-- Put everything in ${build} into the a jar file including all dependecies --> - <jar jarfile="${basedir}/background.jar" manifest="${rsrc}/manifest/background-black-window.mf"> - <fileset dir="${build}"> - <include name="be/beta9/libretto/gui/BackgroundBlackWindow.class"/> - </fileset> - </jar> - </target> - - <target name="run" depends="compile"> - <!-- Execute the main application --> - <java - classname="be.beta9.libretto.application.Libretto" - fork="yes"> - <classpath> - <pathelement location="${build}" /> - <fileset dir="${lib}"> - <include name="log4j-core.jar" /> - <include name="jaxp.jar" /> - <include name="crimson.jar" /> - <include name="jdom.jar" /> - </fileset> - </classpath> - </java> - </target> - - <target name="debug" depends="compile"> - <!-- Execute the main application in debug mode --> - <java - classname="be.beta9.libretto.application.LibrettoDebug" - fork="yes"> - <classpath> - <pathelement location="${build}" /> - <fileset dir="${lib}"> - <include name="*.jar" /> - </fileset> - </classpath> - </java> - </target> - - <target name="junit" depends="compile-junit"> - <!-- Execute all junit tests --> - <java - classname="be.beta9.libretto.AllTests" - fork="yes"> - <classpath> - <pathelement location="${build}" /> - <fileset dir="${lib}"> - <include name="*.jar" /> - </fileset> - </classpath> - </java> - </target> - - <target name="clean"> - <!-- Delete the ${build} directory trees --> - <delete dir="${build}" /> - <delete dir="${api}" /> - </target> - - <target name="api" depends="prepare"> - <!-- Generate javadoc --> - <javadoc - packagenames="be.beta9.libretto.*" - sourcepath="${src}" - destdir="${api}" - windowtitle="Libretto" - author="true" - version="true" - use="true"/> - </target> - - <target name="zip-all" depends="jar, client-jar"> - <zip zipfile="libretto.zip"> - <fileset dir="${basedir}"> - <include name="libretto.jar"/> - <include name="libretto-client.jar"/> - </fileset> - </zip> - </target> - - <target name="upload" depends="clean, zip-all"> - <ftp - server="users.pandora.be" - userid="a002458" - password="bast0s" - remotedir="libretto" - verbose="true" - passive="true"> - <fileset dir="${basedir}"> - <include name="libretto.jar" /> - <include name="libretto-client.jar" /> - <include name="libretto.zip" /> - </fileset> - </ftp> - </target> - -</project> - - - - diff --git a/third_party/lisp/s-xml/test/plist.xml b/third_party/lisp/s-xml/test/plist.xml deleted file mode 100644 index 910e6326ea63..000000000000 --- a/third_party/lisp/s-xml/test/plist.xml +++ /dev/null @@ -1,38 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd"> -<plist version="1.0"> -<dict> - <key>AppleDockIconEnabled</key> - <true/> - <key>AppleNavServices:GetFile:0:Path</key> - <string>file://localhost/Users/sven/Pictures/</string> - <key>AppleNavServices:GetFile:0:Position</key> - <data> - AOUBXw== - </data> - <key>AppleNavServices:GetFile:0:Size</key> - <data> - AAAAAAFeAcI= - </data> - <key>AppleNavServices:PutFile:0:Disclosure</key> - <data> - AQ== - </data> - <key>AppleNavServices:PutFile:0:Path</key> - <string>file://localhost/Users/sven/Desktop/</string> - <key>AppleNavServices:PutFile:0:Position</key> - <data> - AUIBVQ== - </data> - <key>AppleNavServices:PutFile:0:Size</key> - <data> - AAAAAACkAdY= - </data> - <key>AppleSavePanelExpanded</key> - <string>YES</string> - <key>NSDefaultOpenDirectory</key> - <string>~/Desktop</string> - <key>NSNoBigString</key> - <true/> -</dict> -</plist> diff --git a/third_party/lisp/s-xml/test/simple.xml b/third_party/lisp/s-xml/test/simple.xml deleted file mode 100644 index 08ad9424e3ae..000000000000 --- a/third_party/lisp/s-xml/test/simple.xml +++ /dev/null @@ -1,5 +0,0 @@ -<?xml version="1.0"?> -<!-- This is a very simple XML document --> -<root id="123"> - <text>Hello World!</text> -</root> diff --git a/third_party/lisp/s-xml/test/test-lxml-dom.lisp b/third_party/lisp/s-xml/test/test-lxml-dom.lisp deleted file mode 100644 index 248e1e4b907f..000000000000 --- a/third_party/lisp/s-xml/test/test-lxml-dom.lisp +++ /dev/null @@ -1,86 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: test-lxml-dom.lisp,v 1.2 2005/11/06 12:44:48 scaekenberghe Exp $ -;;;; -;;;; Unit and functional tests for lxml-dom.lisp -;;;; -;;;; 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) - -(assert - (equal (with-input-from-string (stream " <foo/>") - (parse-xml stream :output-type :lxml)) - :|foo|)) - -(assert - (equal (parse-xml-string "<tag1><tag2 att1='one'/>this is some text</tag1>" - :output-type :lxml) - '(:|tag1| - ((:|tag2| :|att1| "one")) - "this is some text"))) - -(assert - (equal (parse-xml-string "<TAG><foo></TAG>" - :output-type :lxml) - '(:TAG "<foo>"))) - -(assert - (equal (parse-xml-string - "<P><INDEX ITEM='one'/> This is some <B>bold</B> text, with a leading & trailing space </P>" - :output-type :lxml) - '(:p - ((:index :item "one")) - " This is some " - (:b "bold") - " text, with a leading & trailing space "))) - -(assert - (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 "test/ant-build-file.xml" - (asdf:component-pathname - (asdf:find-system :s-xml.test))) - :output-type :lxml))) - -(assert - (consp (parse-xml-file (merge-pathnames "test/plist.xml" - (asdf:component-pathname - (asdf:find-system :s-xml.test))) - :output-type :lxml))) - -(assert - (string-equal (print-xml-string :|foo| :input-type :lxml) - "<foo/>")) - -(assert - (string-equal (print-xml-string '((:|foo| :|bar| "1")) :input-type :lxml) - "<foo bar=\"1\"/>")) - -(assert - (string-equal (print-xml-string '(:foo "some text") :input-type :lxml) - "<FOO>some text</FOO>")) - -(assert - (string-equal (print-xml-string '(:|foo| :|bar|) :input-type :lxml) - "<foo><bar/></foo>")) - -(assert (string-equal (second - (with-input-from-string (stream "<foo><![CDATA[<greeting>Hello, world!</greeting>]]></foo>") - (parse-xml stream :output-type :lxml))) - "<greeting>Hello, world!</greeting>")) - -(assert (string-equal (second - (with-input-from-string (stream "<foo><![CDATA[<greeting>Hello, < world!</greeting>]]></foo>") - (parse-xml stream :output-type :lxml))) - "<greeting>Hello, < world!</greeting>")) - -;;;; eof diff --git a/third_party/lisp/s-xml/test/test-sxml-dom.lisp b/third_party/lisp/s-xml/test/test-sxml-dom.lisp deleted file mode 100644 index 7164d5ef0d66..000000000000 --- a/third_party/lisp/s-xml/test/test-sxml-dom.lisp +++ /dev/null @@ -1,76 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: test-sxml-dom.lisp,v 1.1.1.1 2004/06/07 18:49:59 scaekenberghe Exp $ -;;;; -;;;; Unit and functional tests for sxml-dom.lisp -;;;; -;;;; 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) - -(assert - (equal (with-input-from-string (stream " <foo/>") - (parse-xml stream :output-type :sxml)) - '(:|foo|))) - -(assert - (equal (parse-xml-string "<tag1><tag2 att1='one'/>this is some text</tag1>" - :output-type :sxml) - '(:|tag1| - (:|tag2| (:@ (:|att1| "one"))) - "this is some text"))) - -(assert - (equal (parse-xml-string "<TAG><foo></TAG>" - :output-type :sxml) - '(:TAG "<foo>"))) - -(assert - (equal (parse-xml-string - "<P><INDEX ITEM='one'/> This is some <B>bold</B> text, with a leading & trailing space </P>" - :output-type :sxml) - '(:p - (:index (:@ (:item "one"))) - " This is some " - (:b "bold") - " text, with a leading & trailing space "))) - -(assert - (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 "test/ant-build-file.xml" - (asdf:component-pathname - (asdf:find-system :s-xml.test))) - :output-type :sxml))) - -(assert - (consp (parse-xml-file (merge-pathnames "test/plist.xml" - (asdf:component-pathname - (asdf:find-system :s-xml.test))) - :output-type :sxml))) - -(assert - (string-equal (print-xml-string '(:|foo|) :input-type :sxml) - "<foo/>")) - -(assert - (string-equal (print-xml-string '(:|foo| (:@ (:|bar| "1"))) :input-type :sxml) - "<foo bar=\"1\"/>")) - -(assert - (string-equal (print-xml-string '(:foo "some text") :input-type :sxml) - "<FOO>some text</FOO>")) - -(assert - (string-equal (print-xml-string '(:|foo| (:|bar|)) :input-type :sxml) - "<foo><bar/></foo>")) - -;;;; eof \ No newline at end of file diff --git a/third_party/lisp/s-xml/test/test-xml-struct-dom.lisp b/third_party/lisp/s-xml/test/test-xml-struct-dom.lisp deleted file mode 100644 index f5ee1cc92583..000000000000 --- a/third_party/lisp/s-xml/test/test-xml-struct-dom.lisp +++ /dev/null @@ -1,84 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: test-xml-struct-dom.lisp,v 1.2 2005/08/29 15:01:49 scaekenberghe Exp $ -;;;; -;;;; Unit and functional tests for xml-struct-dom.lisp -;;;; -;;;; 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) - -(assert - (xml-equal (with-input-from-string (stream " <foo/>") - (parse-xml stream :output-type :xml-struct)) - (make-xml-element :name :|foo|))) - -(assert - (xml-equal (parse-xml-string "<tag1><tag2 att1='one'/>this is some text</tag1>" - :output-type :xml-struct) - (make-xml-element :name :|tag1| - :children (list (make-xml-element :name :|tag2| - :attributes '((:|att1| . "one"))) - "this is some text")))) - -(assert - (xml-equal (parse-xml-string "<tag><foo></tag>" - :output-type :xml-struct) - (make-xml-element :name :|tag| - :children (list "<foo>")))) - -(assert - (xml-equal (parse-xml-string - "<P><INDEX ITEM='one'/> This is some <B>bold</B> text, with a leading & trailing space </P>" - :output-type :xml-struct) - (make-xml-element :name :p - :children (list (make-xml-element :name :index - :attributes '((:item . "one"))) - " This is some " - (make-xml-element :name :b - :children (list "bold")) - " text, with a leading & trailing space ")))) - -(assert - (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 "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 "test/plist.xml" - (asdf:component-pathname - (asdf:find-system :s-xml.test))) - :output-type :xml-struct))) - -(assert - (string-equal (print-xml-string (make-xml-element :name "foo") - :input-type :xml-struct) - "<foo/>")) - -(assert - (string-equal (print-xml-string (make-xml-element :name "foo" :attributes '((:|bar| . "1"))) - :input-type :xml-struct) - "<foo bar=\"1\"/>")) - -(assert - (string-equal (print-xml-string (make-xml-element :name "foo" :children (list "some text")) - :input-type :xml-struct) - "<foo>some text</foo>")) - -(assert - (string-equal (print-xml-string (make-xml-element :name "foo" :children (list (make-xml-element :name "bar"))) - :input-type :xml-struct) - "<foo><bar/></foo>")) - -;;;; eof \ No newline at end of file diff --git a/third_party/lisp/s-xml/test/test-xml.lisp b/third_party/lisp/s-xml/test/test-xml.lisp deleted file mode 100644 index daef58ea4639..000000000000 --- a/third_party/lisp/s-xml/test/test-xml.lisp +++ /dev/null @@ -1,86 +0,0 @@ -;;;; -*- mode: lisp -*- -;;;; -;;;; $Id: test-xml.lisp,v 1.3 2005/11/06 12:44:48 scaekenberghe Exp $ -;;;; -;;;; Unit and functional tests for xml.lisp -;;;; -;;;; 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) - -(assert - (whitespace-char-p (character " "))) - -(assert - (whitespace-char-p (character " "))) - -(assert - (whitespace-char-p (code-char 10))) - -(assert - (whitespace-char-p (code-char 13))) - -(assert - (not (whitespace-char-p #\A))) - -(assert - (char= (with-input-from-string (stream " ABC") - (skip-whitespace stream)) - #\A)) - -(assert - (char= (with-input-from-string (stream "ABC") - (skip-whitespace stream)) - #\A)) - -(assert - (string-equal (with-output-to-string (stream) (print-string-xml "<foo>" stream)) - "<foo>")) - -(assert - (string-equal (with-output-to-string (stream) (print-string-xml "' '" stream)) - "' '")) - -(assert - (let ((string (map 'string #'identity '(#\return #\tab #\newline)))) - (string-equal (with-output-to-string (stream) (print-string-xml string stream)) - string))) - -(defun simple-echo-xml (in out) - (start-parse-xml - in - (make-instance 'xml-parser-state - :new-element-hook #'(lambda (name attributes seed) - (declare (ignore seed)) - (format out "<~a~:{ ~a='~a'~}>" - name - (mapcar #'(lambda (p) (list (car p) (cdr p))) - (reverse attributes)))) - :finish-element-hook #'(lambda (name attributes parent-seed seed) - (declare (ignore attributes parent-seed seed)) - (format out "</~a>" name)) - :text-hook #'(lambda (string seed) - (declare (ignore seed)) - (princ string out))))) - -(defun simple-echo-xml-string (string) - (with-input-from-string (in string) - (with-output-to-string (out) - (simple-echo-xml in out)))) - -(dolist (*ignore-namespaces* '(nil t)) - (assert - (let ((xml "<FOO ATT1='1' ATT2='2'><B>Text</B><EMPTY></EMPTY>More text!<SUB><SUB></SUB></SUB></FOO>")) - (equal (simple-echo-xml-string xml) - xml)))) - -(assert - (let ((xml "<p> </p>")) - (equal (simple-echo-xml-string xml) - xml))) - -;;;; eof \ No newline at end of file diff --git a/third_party/lisp/s-xml/test/xhtml-page.xml b/third_party/lisp/s-xml/test/xhtml-page.xml deleted file mode 100644 index 79f3ae3bade6..000000000000 --- a/third_party/lisp/s-xml/test/xhtml-page.xml +++ /dev/null @@ -1,271 +0,0 @@ -<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> - -<html> -<head> - -<title>XHTML Tutorial</title> -<meta http-equiv="Content-Type" content="text/html; charset=windows-1252" /> -<meta name="Keywords" content="XML,tutorial,HTML,DHTML,CSS,XSL,XHTML,JavaScript,ASP,ADO,VBScript,DOM,authoring,programming,learning,beginner's guide,primer,lessons,school,howto,reference,examples,samples,source code,demos,tips,links,FAQ,tag list,forms,frames,color table,W3C,Cascading Style Sheets,Active Server Pages,Dynamic HTML,Internet database development,Webbuilder,Sitebuilder,Webmaster,HTMLGuide,SiteExpert" /> -<meta name="Description" content="HTML,CSS,JavaScript,DHTML,XML,XHTML,ASP,ADO and VBScript tutorial from W3Schools." /> -<meta http-equiv="pragma" content="no-cache" /> -<meta http-equiv="cache-control" content="no-cache" /> - -<link rel="stylesheet" type="text/css" href="../stdtheme.css" /> - -</head> -<body> - -<table border="0" cellpadding="0" cellspacing="0" width="775"> -<tr> -<td width="140" class="content" valign="top"> -<br /> -<a class="left" href="../default.asp" target="_top"><b>HOME</b></a><br /> -<br /> -<b>XHTML Tutorial</b><br /> -<a class="left" target="_top" href="default.asp" style='font-weight:bold;color:#000000;background-color:transparent;'>XHTML HOME</a><br /> -<a class="left" target="_top" href="xhtml_intro.asp" >XHTML Introduction</a><br /> -<a class="left" target="_top" href="xhtml_why.asp" >XHTML Why</a><br /> -<a class="left" target="_top" href="xhtml_html.asp" >XHTML v HTML</a><br /> -<a class="left" target="_top" href="xhtml_syntax.asp" >XHTML Syntax</a><br /> -<a class="left" target="_top" href="xhtml_dtd.asp" >XHTML DTD</a><br /> -<a class="left" target="_top" href="xhtml_howto.asp" >XHTML HowTo</a><br /> -<a class="left" target="_top" href="xhtml_validate.asp" >XHTML Validation</a><br /> -<br /> -<b>Quiz</b> -<br /> -<a class="left" target="_top" href="xhtml_quiz.asp" >XHTML Quiz</a><br /> -<br /> -<b>References</b> -<br /> -<a class="left" target="_top" href="xhtml_reference.asp" >XHTML Tag List</a><br /> -<a class="left" target="_top" href="xhtml_standardattributes.asp" >XHTML Attributes</a><br /> -<a class="left" target="_top" href="xhtml_eventattributes.asp" >XHTML Events</a><br /> -</td> -<td width="490" valign="top"> -<table width="100%" bgcolor="#FFFFFF" border="1" cellpadding="7" cellspacing="0"> -<tr> -<td> -<center> -<a href="http://ad.doubleclick.net/jump/N1951.w3schools/B1097963;sz=468x60;ord=[timestamp]?" target="_new"> -<img src="http://ad.doubleclick.net/ad/N1951.w3schools/B1097963;sz=468x60;ord=[timestamp]?" -border="0" width="468" height="60" alt="Corel XMetal 3" /></a> - - -<br />Please Visit Our Sponsors ! -</center> -<h1>XHTML Tutorial</h1> -<a href="../default.asp"><img border="0" src="../images/btn_previous.gif" alt="Previous" /></a> -<a href="xhtml_intro.asp"><img border="0" src="../images/btn_next.gif" width="100" height="20" alt="Next" /></a> - -<hr /> - -<h2>XHTML Tutorial</h2> -<p>XHTML is the next generation of HTML! In our XHTML tutorial you will learn the difference between HTML and XHTML, and how to use XHTML in your future -applications. You will also see how we converted this Web site into XHTML. <a href="xhtml_intro.asp">Start Learning -XHTML!</a></p> - -<h2>XHTML Quiz Test</h2> -<p>Test your XHTML skills at W3Schools! <a href="xhtml_quiz.asp">Start XHTML -Quiz!</a> </p> - -<h2>XHTML References</h2> -<p>At W3Schools you will find complete XHTML references about tags, attributes -and events. <a href="xhtml_reference.asp">XHTML 1.0 References</a>.</p> -<hr /> -<h2>Table of Contents</h2> -<p><a href="xhtml_intro.asp">Introduction to XHTML</a><br /> -This chapter gives a brief introduction to XHTML and explains what XHTML is.</p> -<p><a href="xhtml_why.asp">XHTML - Why?</a><br /> -This chapter explains why we needed a new language like XHTML.</p> -<p><a href="xhtml_html.asp">Differences between XHTML and HTML</a><br /> -This chapter explains the main differences in syntax between XHTML and HTML.</p> -<p><a href="xhtml_syntax.asp">XHTML Syntax</a> <br /> -This chapter explains the basic syntax of XHTML.</p> -<p><a href="xhtml_dtd.asp">XHTML DTD</a> <br /> -This chapter explains the three different XHTML Document Type Definitions.</p> -<p><a href="xhtml_howto.asp">XHTML HowTo</a><br /> -This chapter explains how this web site was converted from HTML to XHTML.</p> -<p><a href="xhtml_validate.asp">XHTML Validation</a><br /> -This chapter explains how to validate XHTML documents.</p> -<hr /> -<h2>XHTML References</h2> -<p><a href="xhtml_reference.asp">XHTML 1.0 Reference<br /> -</a>Our complete XHTML 1.0 reference is an alphabetical list of all XHTML tags -with lots of examples and tips.</p> -<p><a href="xhtml_standardattributes.asp">XHTML 1.0 Standard Attributes<br /> -</a>All the tags have attributes. The attributes for each tag are listed in the -examples in the "XHTML 1.0 Reference" page. The attributes listed here -are the core and language attributes all the tags has as standard (with -few exceptions). This reference describes the attributes, and shows possible -values for each.</p> -<p><a href="xhtml_eventattributes.asp">XHTML 1.0 Event Attributes<br /> -</a>All the standard event attributes of the tags. This reference describes the attributes, and shows possible -values for each.</p> -<hr /> -<a href="../default.asp"><img border="0" src="../images/btn_previous.gif" width="100" height="20" alt="Previous" /></a> -<a href="xhtml_intro.asp"><img border="0" src="../images/btn_next.gif" width="100" height="20" alt="Next" /></a> - - -<hr /> -<p> -Jump to: <a href="#top" target="_top"><b>Top of Page</b></a> -or <a href="/" target="_top"><b>HOME</b></a> or -<a href='/xhtml/default.asp?output=print' target="_blank"> -<img src="../images/print.gif" alt="Printer Friendly" border="0" /> -<b>Printer friendly page</b></a> -</p> -<hr /> - -<h2>Search W3Schools:</h2> -<form method="get" name="searchform" action="http://www.google.com/search" target="_blank"> -<input type="hidden" name="as_sitesearch" value="www.w3schools.com" /> -<input type="text" size="30" name="as_q" /> -<input type="submit" value=" Go! " /> -</form> - -<hr /> -<h2>What Others Say About Us</h2> -<p>Does the world know about us? Check out these places:</p> -<p> -<a href="http://search.dogpile.com/texis/search?q=W3schools" target="_blank">Dogpile</a> -<a href="http://www.altavista.com/cgi-bin/query?q=W3Schools" target="_blank">Alta Vista</a> -<a href="http://search.msn.com/results.asp?q=W3Schools" target="_blank">MSN</a> -<a href="http://www.google.com/search?q=W3Schools" target="_blank">Google</a> -<a href="http://search.excite.com/search.gw?search=W3Schools" target="_blank">Excite</a> -<a href="http://search.lycos.com/main/?query=W3Schools" target="_blank">Lycos</a> -<a href="http://search.yahoo.com/search?p=w3schools" target="_blank">Yahoo</a> -<a href="http://www.ask.com/main/askJeeves.asp?ask=W3Schools" target="_blank">Ask Jeeves</a> -</p> -<hr /> -<h2>We Help You For Free. You Can Help Us!</h2> -<ul> -<li><a href="../tellyourgroup.htm" target="blank">Tell your newsgroup or mailing list</a></li> -<li><a href="../about/about_linking.asp">Link to us from your pages</a></li> -<li><a href="../about/about_helpers.asp">Help us correct errors and broken links</a></li> -<li><a href="../about/about_helpers.asp">Help us with spelling and grammar</a></li> -<li><a href="http://validator.w3.org/check/referer" target="_blank">Validate the XHTML code of this page</a></li> -</ul> - -<hr /> -<p> -W3Schools is for training only. We do not warrant its correctness or its fitness for use. -The risk of using it remains entirely with the user. While using this site, you agree to have read and accepted our -<a href="../about/about_copyright.asp">terms of use</a> and -<a href="../about/about_privacy.asp">privacy policy</a>.</p> -<p> -<a href="../about/about_copyright.asp">Copyright 1999-2002</a> by Refsnes Data. All Rights Reserved</p> -<hr /> -<table border="0" width="100%" cellspacing="0" cellpadding="0"><tr> -<td width="25%" align="left"> -<a href="http://validator.w3.org/check/referer" target="_blank"> -<img src="../images/vxhtml.gif" alt="Validate" width="88" height="31" border="0" /></a> -</td> -<td width="50%" align="center"> -<a href="../xhtml/" target="_top">How we converted to XHTML</a> -</td> -<td width="25%" align="right"> -<a href="http://jigsaw.w3.org/css-validator/check/referer" target="_blank"> -<img src="../images/vcss.gif" alt="Validate" width="88" height="31" border="0" /></a> -</td> -</tr></table> -</td> -</tr> -</table> -</td> - - - -<td width="144" align="center" valign="top"> - -<table border="1" width="100%" bgcolor="#ffffff" cellpadding="0" cellspacing="0"><tr> -<td align="center" class="right"><br /> - -<a href="http://www.dotnetcharting.com" target="_blank"><img src="../images/dnc-icon.gif" alt="Web charting" border="0" /></a> -<br /> -<a class="right" href="http://www.dotnetcharting.com" target="_blank">Web based charting<br />for ASP.NET</a> - -<br /><br /> -</td></tr></table> - -<table border="1" width="100%" bgcolor="#ffffff" cellpadding="0" cellspacing="0"><tr> -<td align="center" class="right"> -<br /> -<a href="../hosting/default.asp"> -Your own Web Site?<br /> -<br />Read W3Schools -<br />Hosting Tutorial</a> -<br /> -<br /> -</td></tr></table> - -<table border="1" width="100%" bgcolor="#ffffff" cellpadding="0" cellspacing="0"><tr> -<td align="center" class="right"> -<br /> -<a class="red" href="http://www.dotdnr.com" target="_blank">$15 Domain Name<br />Registration<br />Save $20 / year!</a> -<br /> -<br /> -</td></tr></table> - - - -<table border="1" width="100%" bgcolor="#ffffff" cellpadding="0" cellspacing="0"> -<tr><td align="center" class="right"> -<br /> -<b>SELECTED LINKS</b> -<br /><br /> -<a class="right" href="http://opogee.com/clk/dangtingcentiaonie" target="_blank">University Online<br /> -Master Degree<br />Bachelor Degree</a> -<br /><br /> -<a class="right" href="../software/default.asp" target="_top">Web Software</a> -<br /><br /> -<a class="right" href="../appml/default.asp" target="_top">The Future of<br />Web Development</a> -<br /><br /> -<a class="right" href="../careers/default.asp" target="_top">Jobs and Careers</a> -<br /><br /> -<a class="right" href="../site/site_security.asp" target="_top">Web Security</a> -<br /> -<a class="right" href="../browsers/browsers_stats.asp" target="_top">Web Statistics</a> -<br /> -<a class="right" href="../w3c" target="_top">Web Standards</a> -<br /><br /> -</td></tr></table> - - -<table border="1" width="100%" bgcolor="#ffffff" cellpadding="0" cellspacing="0"><tr> -<td align="center" class="right"> -<br /> - -<b>Recommended<br /> -Reading:</b><br /><br /> - -<a class="right" target="_blank" -href="http://www.amazon.com/exec/obidos/ASIN/059600026X/w3schools03"> -<img src="../images/book_amazon_xhtml.jpg" border="0" alt="HTML XHTML" /></a> - - -<br /><br /></td> -</tr></table> - -<table border="1" width="100%" bgcolor="#ffffff" cellpadding="0" cellspacing="0"><tr> -<td align="center" class="right"> -<br /> -<b>PARTNERS</b><br /> -<br /> -<a class="right" href="http://www.W3Schools.com" target="_blank">W3Schools</a><br /> -<a class="right" href="http://www.topxml.com" target="_blank">TopXML</a><br /> -<a class="right" href="http://www.visualbuilder.com" target="_blank">VisualBuilder</a><br /> -<a class="right" href="http://www.xmlpitstop.com" target="_blank">XMLPitstop</a><br /> -<a class="right" href="http://www.developersdex.com" target="_blank">DevelopersDex</a><br /> -<a class="right" href="http://www.devguru.com" target="_blank">DevGuru</a><br /> -<a class="right" href="http://www.programmersheaven.com/" target="_blank">Programmers Heaven</a><br /> -<a class="right" href="http://www.codeproject.com" target="_blank">The Code Project</a><br /> -<a class="right" href="http://www.tek-tips.com" target="_blank">Tek Tips Forum</a><br /> -<a class="right" href="http://www.zvon.ORG/" target="_blank">ZVON.ORG</a><br /> -<a class="right" href="http://www.topxml.com/search.asp" target="_blank">TopXML Search</a><br /> -<br /> -</td> -</tr></table> -</td></tr></table> - -</body> -</html> |