Author: ksprotte Date: Sun Feb 17 09:26:33 2008 New Revision: 2520 Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/characters.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/closure-common.asd branches/trunk-reorg/thirdparty/closure-common-2007-10-21/definline.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings-data.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/hax.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/package.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/runes.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/stream-scl.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/syntax.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/utf8.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/xstream.lisp branches/trunk-reorg/thirdparty/closure-common-2007-10-21/ystream.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/ branches/trunk-reorg/thirdparty/cxml-2007-10-21/COPYING branches/trunk-reorg/thirdparty/cxml-2007-10-21/DOMTEST branches/trunk-reorg/thirdparty/cxml-2007-10-21/GNUmakefile branches/trunk-reorg/thirdparty/cxml-2007-10-21/OLDNEWS branches/trunk-reorg/thirdparty/cxml-2007-10-21/README branches/trunk-reorg/thirdparty/cxml-2007-10-21/TIMES branches/trunk-reorg/thirdparty/cxml-2007-10-21/XMLCONF branches/trunk-reorg/thirdparty/cxml-2007-10-21/XMLS-SYMBOLS.diff branches/trunk-reorg/thirdparty/cxml-2007-10-21/catalog.dtd branches/trunk-reorg/thirdparty/cxml-2007-10-21/contrib/ branches/trunk-reorg/thirdparty/cxml-2007-10-21/contrib/xhtmlgen.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/cxml.asd branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/GNUmakefile branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/bg.png (contents, props changed) branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/cxml.css branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/dom.html branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/dom.xml branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/html.xsl branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/index.html branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/index.xml branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/installation.html branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/installation.xml branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/klacks.html branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/klacks.xml branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/quickstart.html branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/quickstart.xml branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/sax.html branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/sax.xml branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/xmls-compat.html branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/xmls-compat.xml branches/trunk-reorg/thirdparty/cxml-2007-10-21/documentation.css branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/ branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-builder.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-impl.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-sax.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/package.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/ branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/klacks-impl.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/klacks.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/package.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/tap-source.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/mlisp-patch.diff branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/ branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/domtest.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/misc.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/utf8domtest.diff branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/xmlconf-base.diff branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/xmlconf.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/catalog.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/package.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/recoder.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-handler.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-proxy.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/event-collecting-handler.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/package.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/tests.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/space-normalizer.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/split-sequence.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/unparse.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/util.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xml-name-rune-p.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xml-parse.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xmlns-normalizer.lisp branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xmls-compat.lisp Removed: branches/trunk-reorg/thirdparty/cxml-2007-08-05/ Log: pulled cxml-2007-10-21, latest cxml release Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/characters.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/characters.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,148 @@ +;;; copyright (c) 2004 knowledgeTools Int. GmbH +;;; Author of this version: David Lichteblau <david@knowledgetools.de> +;;; +;;; derived from runes.lisp, (c) copyright 1998,1999 by Gilbert Baumann +;;; +;;; License: Lisp-LGPL (See file COPYING for details). +;;; +;;; This code is free software; you can redistribute it and/or modify it +;;; under the terms of the version 2.1 of the GNU Lesser General Public +;;; License as published by the Free Software Foundation, as clarified +;;; by the "Preamble to the Gnu Lesser General Public License" found in +;;; the file COPYING. +;;; +;;; This code is distributed in the hope that it will be useful, +;;; but without any warranty; without even the implied warranty of +;;; merchantability or fitness for a particular purpose. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; Version 2.1 of the GNU Lesser General Public License is in the file +;;; COPYING that was distributed with this file. If it is not present, +;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until +;;; superseded by a newer version) or write to the Free Software +;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +(in-package :runes) + +(deftype rune () #-lispworks 'character #+lispworks 'lw:simple-char) +(deftype rod () '(vector rune)) +(deftype simple-rod () '(simple-array rune)) + +(definline rune (rod index) + (char rod index)) + +(defun (setf rune) (new rod index) + (setf (char rod index) new)) + +(definline %rune (rod index) + (aref (the simple-string rod) (the fixnum index))) + +(definline (setf %rune) (new rod index) + (setf (aref (the simple-string rod) (the fixnum index)) new)) + +(defun rod-capitalize (rod) + (string-upcase rod)) + +(definline code-rune (x) (code-char x)) +(definline rune-code (x) (char-code x)) + +(definline rune= (x y) + (char= x y)) + +(defun rune-downcase (rune) + (char-downcase rune)) + +(definline rune-upcase (rune) + (char-upcase rune)) + +(defun rune-upper-case-letter-p (rune) + (upper-case-p rune)) + +(defun rune-lower-case-letter-p (rune) + (lower-case-p rune)) + +(defun rune-equal (x y) + (char-equal x y)) + +(defun rod-downcase (rod) + (string-downcase rod)) + +(defun rod-upcase (rod) + (string-upcase rod)) + +(definline white-space-rune-p (char) + (or (char= char #\tab) + (char= char #.(code-char 10)) ;Linefeed + (char= char #.(code-char 13)) ;Carriage Return + (char= char #\space))) + +(definline digit-rune-p (char &optional (radix 10)) + (digit-char-p char radix)) + +(defun rod (x) + (cond + ((stringp x) x) + ((symbolp x) (string x)) + ((characterp x) (string x)) + ((vectorp x) (coerce x 'string)) + ((integerp x) (string (code-char x))) + (t (error "Cannot convert ~S to a ~S" x 'rod)))) + +(defun runep (x) + (characterp x)) + +(defun sloopy-rod-p (x) + (stringp x)) + +(defun rod= (x y) + (if (zerop (length x)) + (zerop (length y)) + (and (plusp (length y)) (string= x y)))) + +(defun rod-equal (x y) + (string-equal x y)) + +(definline make-rod (size) + (make-string size :element-type 'rune)) + +(defun char-rune (char) + char) + +(defun rune-char (rune &optional default) + (declare (ignore default)) + rune) + +(defun rod-string (rod &optional (default-char #\?)) + (declare (ignore default-char)) + rod) + +(defun string-rod (string) + string) + +;;;; + +(defun rune<= (rune &rest more-runes) + (loop + for (a b) on (cons rune more-runes) + while b + always (char<= a b))) + +(defun rune>= (rune &rest more-runes) + (loop + for (a b) on (cons rune more-runes) + while b + always (char>= a b))) + +(defun rodp (object) + (stringp object)) + +(defun rod-subseq (source start &optional (end (length source))) + (unless (stringp source) + (error "~S is not of type ~S." source 'rod)) + (subseq source start end)) + +(defun rod-subseq* (source start &optional (end (length source))) + (rod-subseq source start end)) + +(defun rod< (rod1 rod2) + (string< rod1 rod2)) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/closure-common.asd ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/closure-common.asd Sun Feb 17 09:26:33 2008 @@ -0,0 +1,56 @@ +(defpackage :closure-common-system + (:use :asdf :cl) + (:export #:*utf8-runes-readtable*)) + +(in-package :closure-common-system) + +(defvar *utf8-runes-readtable*) + +(defclass closure-source-file (cl-source-file) ()) + +#+sbcl +(defmethod perform :around ((o compile-op) (s closure-source-file)) + ;; shut up already. Correctness first. + (handler-bind ((sb-ext:compiler-note #'muffle-warning)) + (let (#+sbcl (*compile-print* nil)) + (call-next-method)))) + +#-(or rune-is-character rune-is-integer) +(progn + (format t "~&;;; Checking for wide character support...") + (force-output) + (pushnew (dotimes (x 65536 + (progn + (format t " ok, characters have at least 16 bits.~%") + :rune-is-character)) + (unless (or (<= #xD800 x #xDFFF) + (and (< x char-code-limit) (code-char x))) + (format t " no, reverting to octet strings.~%") + (return :rune-is-integer))) + *features*)) + +#-rune-is-character +(format t "~&;;; Building Closure with (UNSIGNED-BYTE 16) RUNES~%") + +#+rune-is-character +(format t "~&;;; Building Closure with CHARACTER RUNES~%") + +(defsystem :closure-common + :default-component-class closure-source-file + :serial t + :components + ((:file "package") + (:file "definline") + (:file runes + :pathname + #-rune-is-character "runes" + #+rune-is-character "characters") + #+rune-is-integer (:file "utf8") + (:file "syntax") + #-x&y-streams-are-stream (:file "encodings") + #-x&y-streams-are-stream (:file "encodings-data") + #-x&y-streams-are-stream (:file "xstream") + #-x&y-streams-are-stream (:file "ystream") + #+x&y-streams-are-stream (:file #+scl "stream-scl") + (:file "hax")) + :depends-on (#-scl :trivial-gray-streams)) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/definline.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/definline.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,63 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*- +;;; --------------------------------------------------------------------------- +;;; Title: definline +;;; Created: 1999-05-25 22:32 +;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1999 by Gilbert Baumann + +;;; This code is free software; you can redistribute it and/or modify it +;;; under the terms of the version 2.1 of the GNU Lesser General Public +;;; License as published by the Free Software Foundation, as clarified +;;; by the "Preamble to the Gnu Lesser General Public License" found in +;;; the file COPYING. +;;; +;;; This code is distributed in the hope that it will be useful, +;;; but without any warranty; without even the implied warranty of +;;; merchantability or fitness for a particular purpose. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; Version 2.1 of the GNU Lesser General Public License is in the file +;;; COPYING that was distributed with this file. If it is not present, +;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until +;;; superseded by a newer version) or write to the Free Software +;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +(in-package :runes) + +#-(or allegro openmcl) +(defmacro definline (name args &body body) + `(progn + (declaim (inline ,name)) + (defun ,name ,args .,body))) + +#+openmcl +(defmacro runes::definline (fun args &body body) + (if (consp fun) + `(defun ,fun ,args + ,@body) + `(progn + (defun ,fun ,args .,body) + (define-compiler-macro ,fun (&rest .args.) + (cons '(lambda ,args .,body) + .args.))))) + +#+allegro +(defmacro definline (fun args &body body) + (if (and (consp fun) (eq (car fun) 'setf)) + (let ((fnam (intern (concatenate 'string "(SETF " (symbol-name (cadr fun)) ")") + (symbol-package (cadr fun))))) + `(progn + (defsetf ,(cadr fun) (&rest ap) (new-value) (list* ',fnam new-value ap)) + (definline ,fnam ,args .,body))) + (labels ((declp (x) + (and (consp x) (eq (car x) 'declare)))) + `(progn + (defun ,fun ,args .,body) + (define-compiler-macro ,fun (&rest .args.) + (cons '(lambda ,args + ,@(remove-if-not #'declp body) + (block ,fun + ,@(remove-if #'declp body))) + .args.)))))) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings-data.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings-data.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,568 @@ +(in-package :runes-encoding) + +(progn + (add-name :us-ascii "ANSI_X3.4-1968") + (add-name :us-ascii "iso-ir-6") + (add-name :us-ascii "ANSI_X3.4-1986") + (add-name :us-ascii "ISO_646.irv:1991") + (add-name :us-ascii "ASCII") + (add-name :us-ascii "ISO646-US") + (add-name :us-ascii "US-ASCII") + (add-name :us-ascii "us") + (add-name :us-ascii "IBM367") + (add-name :us-ascii "cp367") + (add-name :us-ascii "csASCII") + + (add-name :iso-8859-1 "ISO_8859-1:1987") + (add-name :iso-8859-1 "iso-ir-100") + (add-name :iso-8859-1 "ISO_8859-1") + (add-name :iso-8859-1 "ISO-8859-1") + (add-name :iso-8859-1 "latin1") + (add-name :iso-8859-1 "l1") + (add-name :iso-8859-1 "IBM819") + (add-name :iso-8859-1 "CP819") + (add-name :iso-8859-1 "csISOLatin1") + + (add-name :iso-8859-2 "ISO_8859-2:1987") + (add-name :iso-8859-2 "iso-ir-101") + (add-name :iso-8859-2 "ISO_8859-2") + (add-name :iso-8859-2 "ISO-8859-2") + (add-name :iso-8859-2 "latin2") + (add-name :iso-8859-2 "l2") + (add-name :iso-8859-2 "csISOLatin2") + + (add-name :iso-8859-3 "ISO_8859-3:1988") + (add-name :iso-8859-3 "iso-ir-109") + (add-name :iso-8859-3 "ISO_8859-3") + (add-name :iso-8859-3 "ISO-8859-3") + (add-name :iso-8859-3 "latin3") + (add-name :iso-8859-3 "l3") + (add-name :iso-8859-3 "csISOLatin3") + + (add-name :iso-8859-4 "ISO_8859-4:1988") + (add-name :iso-8859-4 "iso-ir-110") + (add-name :iso-8859-4 "ISO_8859-4") + (add-name :iso-8859-4 "ISO-8859-4") + (add-name :iso-8859-4 "latin4") + (add-name :iso-8859-4 "l4") + (add-name :iso-8859-4 "csISOLatin4") + + (add-name :iso-8859-6 "ISO_8859-6:1987") + (add-name :iso-8859-6 "iso-ir-127") + (add-name :iso-8859-6 "ISO_8859-6") + (add-name :iso-8859-6 "ISO-8859-6") + (add-name :iso-8859-6 "ECMA-114") + (add-name :iso-8859-6 "ASMO-708") + (add-name :iso-8859-6 "arabic") + (add-name :iso-8859-6 "csISOLatinArabic") + + (add-name :iso-8859-7 "ISO_8859-7:1987") + (add-name :iso-8859-7 "iso-ir-126") + (add-name :iso-8859-7 "ISO_8859-7") + (add-name :iso-8859-7 "ISO-8859-7") + (add-name :iso-8859-7 "ELOT_928") + (add-name :iso-8859-7 "ECMA-118") + (add-name :iso-8859-7 "greek") + (add-name :iso-8859-7 "greek8") + (add-name :iso-8859-7 "csISOLatinGreek") + + (add-name :iso-8859-8 "ISO_8859-8:1988") + (add-name :iso-8859-8 "iso-ir-138") + (add-name :iso-8859-8 "ISO_8859-8") + (add-name :iso-8859-8 "ISO-8859-8") + (add-name :iso-8859-8 "hebrew") + (add-name :iso-8859-8 "csISOLatinHebrew") + + (add-name :iso-8859-5 "ISO_8859-5:1988") + (add-name :iso-8859-5 "iso-ir-144") + (add-name :iso-8859-5 "ISO_8859-5") + (add-name :iso-8859-5 "ISO-8859-5") + (add-name :iso-8859-5 "cyrillic") + (add-name :iso-8859-5 "csISOLatinCyrillic") + + (add-name :iso-8859-9 "ISO_8859-9:1989") + (add-name :iso-8859-9 "iso-ir-148") + (add-name :iso-8859-9 "ISO_8859-9") + (add-name :iso-8859-9 "ISO-8859-9") + (add-name :iso-8859-9 "latin5") + (add-name :iso-8859-9 "l5") + (add-name :iso-8859-9 "csISOLatin5") + + (add-name :iso-8859-15 "ISO_8859-15") + (add-name :iso-8859-15 "ISO-8859-15") + + (add-name :iso-8859-14 "ISO_8859-14") + (add-name :iso-8859-14 "ISO-8859-14") + + (add-name :koi8-r "KOI8-R") + (add-name :koi8-r "csKOI8R") + + (add-name :utf-8 "UTF-8") + + (add-name :utf-16 "UTF-16") + + (add-name :ucs-4 "ISO-10646-UCS-4") + (add-name :ucs-4 "UCS-4") + + (add-name :ucs-2 "ISO-10646-UCS-2") + (add-name :ucs-2 "UCS-2") ) + + +(progn + (define-encoding :iso-8859-1 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-1))) + + (define-encoding :iso-8859-2 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-2))) + + (define-encoding :iso-8859-3 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-3))) + + (define-encoding :iso-8859-4 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-4))) + + (define-encoding :iso-8859-5 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-5))) + + (define-encoding :iso-8859-6 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-6))) + + (define-encoding :iso-8859-7 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-7))) + + (define-encoding :iso-8859-8 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-8))) + + (define-encoding :iso-8859-14 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-14))) + + (define-encoding :iso-8859-15 + (make-simple-8-bit-encoding + :charset (find-charset :iso-8859-15))) + + (define-encoding :koi8-r + (make-simple-8-bit-encoding + :charset (find-charset :koi8-r))) + + (define-encoding :utf-8 :utf-8) + ) + +(progn + (define-8-bit-charset :iso-8859-1 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7 + #| #o25x |# #x00A8 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF + #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7 + #| #o27x |# #x00B8 #x00B9 #x00BA #x00BB #x00BC #x00BD #x00BE #x00BF + #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7 + #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF + #| #o32x |# #x00D0 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7 + #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x00DE #x00DF + #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7 + #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF + #| #o36x |# #x00F0 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7 + #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x00FE #x00FF) + + (define-8-bit-charset :iso-8859-2 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x0104 #x02D8 #x0141 #x00A4 #x013D #x015A #x00A7 + #| #o25x |# #x00A8 #x0160 #x015E #x0164 #x0179 #x00AD #x017D #x017B + #| #o26x |# #x00B0 #x0105 #x02DB #x0142 #x00B4 #x013E #x015B #x02C7 + #| #o27x |# #x00B8 #x0161 #x015F #x0165 #x017A #x02DD #x017E #x017C + #| #o30x |# #x0154 #x00C1 #x00C2 #x0102 #x00C4 #x0139 #x0106 #x00C7 + #| #o31x |# #x010C #x00C9 #x0118 #x00CB #x011A #x00CD #x00CE #x010E + #| #o32x |# #x0110 #x0143 #x0147 #x00D3 #x00D4 #x0150 #x00D6 #x00D7 + #| #o33x |# #x0158 #x016E #x00DA #x0170 #x00DC #x00DD #x0162 #x00DF + #| #o34x |# #x0155 #x00E1 #x00E2 #x0103 #x00E4 #x013A #x0107 #x00E7 + #| #o35x |# #x010D #x00E9 #x0119 #x00EB #x011B #x00ED #x00EE #x010F + #| #o36x |# #x0111 #x0144 #x0148 #x00F3 #x00F4 #x0151 #x00F6 #x00F7 + #| #o37x |# #x0159 #x016F #x00FA #x0171 #x00FC #x00FD #x0163 #x02D9) + + (define-8-bit-charset :iso-8859-3 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x0126 #x02D8 #x00A3 #x00A4 #xFFFF #x0124 #x00A7 + #| #o25x |# #x00A8 #x0130 #x015E #x011E #x0134 #x00AD #xFFFF #x017B + #| #o26x |# #x00B0 #x0127 #x00B2 #x00B3 #x00B4 #x00B5 #x0125 #x00B7 + #| #o27x |# #x00B8 #x0131 #x015F #x011F #x0135 #x00BD #xFFFF #x017C + #| #o30x |# #x00C0 #x00C1 #x00C2 #xFFFF #x00C4 #x010A #x0108 #x00C7 + #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF + #| #o32x |# #xFFFF #x00D1 #x00D2 #x00D3 #x00D4 #x0120 #x00D6 #x00D7 + #| #o33x |# #x011C #x00D9 #x00DA #x00DB #x00DC #x016C #x015C #x00DF + #| #o34x |# #x00E0 #x00E1 #x00E2 #xFFFF #x00E4 #x010B #x0109 #x00E7 + #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF + #| #o36x |# #xFFFF #x00F1 #x00F2 #x00F3 #x00F4 #x0121 #x00F6 #x00F7 + #| #o37x |# #x011D #x00F9 #x00FA #x00FB #x00FC #x016D #x015D #x02D9) + + (define-8-bit-charset :iso-8859-4 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x0104 #x0138 #x0156 #x00A4 #x0128 #x013B #x00A7 + #| #o25x |# #x00A8 #x0160 #x0112 #x0122 #x0166 #x00AD #x017D #x00AF + #| #o26x |# #x00B0 #x0105 #x02DB #x0157 #x00B4 #x0129 #x013C #x02C7 + #| #o27x |# #x00B8 #x0161 #x0113 #x0123 #x0167 #x014A #x017E #x014B + #| #o30x |# #x0100 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x012E + #| #o31x |# #x010C #x00C9 #x0118 #x00CB #x0116 #x00CD #x00CE #x012A + #| #o32x |# #x0110 #x0145 #x014C #x0136 #x00D4 #x00D5 #x00D6 #x00D7 + #| #o33x |# #x00D8 #x0172 #x00DA #x00DB #x00DC #x0168 #x016A #x00DF + #| #o34x |# #x0101 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x012F + #| #o35x |# #x010D #x00E9 #x0119 #x00EB #x0117 #x00ED #x00EE #x012B + #| #o36x |# #x0111 #x0146 #x014D #x0137 #x00F4 #x00F5 #x00F6 #x00F7 + #| #o37x |# #x00F8 #x0173 #x00FA #x00FB #x00FC #x0169 #x016B #x02D9) + + (define-8-bit-charset :iso-8859-5 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x0401 #x0402 #x0403 #x0404 #x0405 #x0406 #x0407 + #| #o25x |# #x0408 #x0409 #x040A #x040B #x040C #x00AD #x040E #x040F + #| #o26x |# #x0410 #x0411 #x0412 #x0413 #x0414 #x0415 #x0416 #x0417 + #| #o27x |# #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E #x041F + #| #o30x |# #x0420 #x0421 #x0422 #x0423 #x0424 #x0425 #x0426 #x0427 + #| #o31x |# #x0428 #x0429 #x042A #x042B #x042C #x042D #x042E #x042F + #| #o32x |# #x0430 #x0431 #x0432 #x0433 #x0434 #x0435 #x0436 #x0437 + #| #o33x |# #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E #x043F + #| #o34x |# #x0440 #x0441 #x0442 #x0443 #x0444 #x0445 #x0446 #x0447 + #| #o35x |# #x0448 #x0449 #x044A #x044B #x044C #x044D #x044E #x044F + #| #o36x |# #x2116 #x0451 #x0452 #x0453 #x0454 #x0455 #x0456 #x0457 + #| #o37x |# #x0458 #x0459 #x045A #x045B #x045C #x00A7 #x045E #x045F) + + (define-8-bit-charset :iso-8859-6 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0660 #x0661 #x0662 #x0663 #x0664 #x0665 #x0666 #x0667 + #| #o07x |# #x0668 #x0669 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #xFFFF #xFFFF #xFFFF #x00A4 #xFFFF #xFFFF #xFFFF + #| #o25x |# #xFFFF #xFFFF #xFFFF #xFFFF #x060C #x00AD #xFFFF #xFFFF + #| #o26x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o27x |# #xFFFF #xFFFF #xFFFF #x061B #xFFFF #xFFFF #xFFFF #x061F + #| #o30x |# #xFFFF #x0621 #x0622 #x0623 #x0624 #x0625 #x0626 #x0627 + #| #o31x |# #x0628 #x0629 #x062A #x062B #x062C #x062D #x062E #x062F + #| #o32x |# #x0630 #x0631 #x0632 #x0633 #x0634 #x0635 #x0636 #x0637 + #| #o33x |# #x0638 #x0639 #x063A #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o34x |# #x0640 #x0641 #x0642 #x0643 #x0644 #x0645 #x0646 #x0647 + #| #o35x |# #x0648 #x0649 #x064A #x064B #x064C #x064D #x064E #x064F + #| #o36x |# #x0650 #x0651 #x0652 #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o37x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF) + + (define-8-bit-charset :iso-8859-7 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x02BD #x02BC #x00A3 #xFFFF #xFFFF #x00A6 #x00A7 + #| #o25x |# #x00A8 #x00A9 #xFFFF #x00AB #x00AC #x00AD #xFFFF #x2015 + #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x0384 #x0385 #x0386 #x00B7 + #| #o27x |# #x0388 #x0389 #x038A #x00BB #x038C #x00BD #x038E #x038F + #| #o30x |# #x0390 #x0391 #x0392 #x0393 #x0394 #x0395 #x0396 #x0397 + #| #o31x |# #x0398 #x0399 #x039A #x039B #x039C #x039D #x039E #x039F + #| #o32x |# #x03A0 #x03A1 #xFFFF #x03A3 #x03A4 #x03A5 #x03A6 #x03A7 + #| #o33x |# #x03A8 #x03A9 #x03AA #x03AB #x03AC #x03AD #x03AE #x03AF + #| #o34x |# #x03B0 #x03B1 #x03B2 #x03B3 #x03B4 #x03B5 #x03B6 #x03B7 + #| #o35x |# #x03B8 #x03B9 #x03BA #x03BB #x03BC #x03BD #x03BE #x03BF + #| #o36x |# #x03C0 #x03C1 #x03C2 #x03C3 #x03C4 #x03C5 #x03C6 #x03C7 + #| #o37x |# #x03C8 #x03C9 #x03CA #x03CB #x03CC #x03CD #x03CE #xFFFF) + + (define-8-bit-charset :iso-8859-8 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #xFFFF #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7 + #| #o25x |# #x00A8 #x00A9 #x00D7 #x00AB #x00AC #x00AD #x00AE #x203E + #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7 + #| #o27x |# #x00B8 #x00B9 #x00F7 #x00BB #x00BC #x00BD #x00BE #xFFFF + #| #o30x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o31x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o32x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o33x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #x2017 + #| #o34x |# #x05D0 #x05D1 #x05D2 #x05D3 #x05D4 #x05D5 #x05D6 #x05D7 + #| #o35x |# #x05D8 #x05D9 #x05DA #x05DB #x05DC #x05DD #x05DE #x05DF + #| #o36x |# #x05E0 #x05E1 #x05E2 #x05E3 #x05E4 #x05E5 #x05E6 #x05E7 + #| #o37x |# #x05E8 #x05E9 #x05EA #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF) + + (define-8-bit-charset :iso-8859-9 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x00A4 #x00A5 #x00A6 #x00A7 + #| #o25x |# #x00A8 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF + #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x00B4 #x00B5 #x00B6 #x00B7 + #| #o27x |# #x00B8 #x00B9 #x00BA #x00BB #x00BC #x00BD #x00BE #x00BF + #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7 + #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF + #| #o32x |# #x011E #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7 + #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x0130 #x015E #x00DF + #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7 + #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF + #| #o36x |# #x011F #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7 + #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x0131 #x015F #x00FF) + + (define-8-bit-charset :iso-8859-14 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x1E02 #x1E03 #x00A3 #x010A #x010B #x1E0A #x00A7 + #| #o25x |# #x1E80 #x00A9 #x1E82 #x1E0B #x1EF2 #x00AD #x00AE #x0178 + #| #o26x |# #x1E1E #x1E1F #x0120 #x0121 #x1E40 #x1E41 #x00B6 #x1E56 + #| #o27x |# #x1E81 #x1E57 #x1E83 #x1E60 #x1EF3 #x1E84 #x1E85 #x1E61 + #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7 + #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF + #| #o32x |# #x0174 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x1E6A + #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x0176 #x00DF + #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7 + #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF + #| #o36x |# #x0175 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x1E6B + #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x0177 #x00FF) + + (define-8-bit-charset :iso-8859-15 + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o21x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o22x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o23x |# #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF #xFFFF + #| #o24x |# #x00A0 #x00A1 #x00A2 #x00A3 #x20AC #x00A5 #x0160 #x00A7 + #| #o25x |# #x0161 #x00A9 #x00AA #x00AB #x00AC #x00AD #x00AE #x00AF + #| #o26x |# #x00B0 #x00B1 #x00B2 #x00B3 #x017D #x00B5 #x00B6 #x00B7 + #| #o27x |# #x017E #x00B9 #x00BA #x00BB #x0152 #x0153 #x0178 #x00BF + #| #o30x |# #x00C0 #x00C1 #x00C2 #x00C3 #x00C4 #x00C5 #x00C6 #x00C7 + #| #o31x |# #x00C8 #x00C9 #x00CA #x00CB #x00CC #x00CD #x00CE #x00CF + #| #o32x |# #x00D0 #x00D1 #x00D2 #x00D3 #x00D4 #x00D5 #x00D6 #x00D7 + #| #o33x |# #x00D8 #x00D9 #x00DA #x00DB #x00DC #x00DD #x00DE #x00DF + #| #o34x |# #x00E0 #x00E1 #x00E2 #x00E3 #x00E4 #x00E5 #x00E6 #x00E7 + #| #o35x |# #x00E8 #x00E9 #x00EA #x00EB #x00EC #x00ED #x00EE #x00EF + #| #o36x |# #x00F0 #x00F1 #x00F2 #x00F3 #x00F4 #x00F5 #x00F6 #x00F7 + #| #o37x |# #x00F8 #x00F9 #x00FA #x00FB #x00FC #x00FD #x00FE #x00FF) + + (define-8-bit-charset :koi8-r + #| #o00x |# #x0000 #x0001 #x0002 #x0003 #x0004 #x0005 #x0006 #x0007 + #| #o01x |# #x0008 #x0009 #x000A #x000B #x000C #x000A #x000E #x000F + #| #o02x |# #x0010 #x0011 #x0012 #x0013 #x0014 #x0015 #x0016 #x0017 + #| #o03x |# #x0018 #x0019 #x001A #x001B #x001C #x001D #x001E #x001F + #| #o04x |# #x0020 #x0021 #x0022 #x0023 #x0024 #x0025 #x0026 #x0027 + #| #o05x |# #x0028 #x0029 #x002A #x002B #x002C #x002D #x002E #x002F + #| #o06x |# #x0030 #x0031 #x0032 #x0033 #x0034 #x0035 #x0036 #x0037 + #| #o07x |# #x0038 #x0039 #x003A #x003B #x003C #x003D #x003E #x003F + #| #o10x |# #x0040 #x0041 #x0042 #x0043 #x0044 #x0045 #x0046 #x0047 + #| #o11x |# #x0048 #x0049 #x004A #x004B #x004C #x004D #x004E #x004F + #| #o12x |# #x0050 #x0051 #x0052 #x0053 #x0054 #x0055 #x0056 #x0057 + #| #o13x |# #x0058 #x0059 #x005A #x005B #x005C #x005D #x005E #x005F + #| #o14x |# #x0060 #x0061 #x0062 #x0063 #x0064 #x0065 #x0066 #x0067 + #| #o15x |# #x0068 #x0069 #x006A #x006B #x006C #x006D #x006E #x006F + #| #o16x |# #x0070 #x0071 #x0072 #x0073 #x0074 #x0075 #x0076 #x0077 + #| #o17x |# #x0078 #x0079 #x007A #x007B #x007C #x007D #x007E #x007F + #| #o20x |# #x2500 #x2502 #x250C #x2510 #x2514 #x2518 #x251C #x2524 + #| #o21x |# #x252C #x2534 #x253C #x2580 #x2584 #x2588 #x258C #x2590 + #| #o22x |# #x2591 #x2592 #x2593 #x2320 #x25A0 #x2219 #x221A #x2248 + #| #o23x |# #x2264 #x2265 #x00A0 #x2321 #x00B0 #x00B2 #x00B7 #x00F7 + #| #o24x |# #x2550 #x2551 #x2552 #x0451 #x2553 #x2554 #x2555 #x2556 + #| #o25x |# #x2557 #x2558 #x2559 #x255A #x255B #x255C #x255D #x255E + #| #o26x |# #x255F #x2560 #x2561 #x0401 #x2562 #x2563 #x2564 #x2565 + #| #o27x |# #x2566 #x2567 #x2568 #x2569 #x256A #x256B #x256C #x00A9 + #| #o30x |# #x044E #x0430 #x0431 #x0446 #x0434 #x0435 #x0444 #x0433 + #| #o31x |# #x0445 #x0438 #x0439 #x043A #x043B #x043C #x043D #x043E + #| #o32x |# #x043F #x044F #x0440 #x0441 #x0442 #x0443 #x0436 #x0432 + #| #o33x |# #x044C #x044B #x0437 #x0448 #x044D #x0449 #x0447 #x044A + #| #o34x |# #x042E #x0410 #x0411 #x0426 #x0414 #x0415 #x0424 #x0413 + #| #o35x |# #x0425 #x0418 #x0419 #x041A #x041B #x041C #x041D #x041E + #| #o36x |# #x041F #x042F #x0420 #x0421 #x0422 #x0423 #x0416 #x0412 + #| #o37x |# #x042C #x042B #x0417 #x0428 #x042D #x0429 #x0427 #x042A) + ) + Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/encodings.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,396 @@ +(in-package :runes-encoding) + +(define-condition encoding-error (simple-error) ()) + +(defun xerror (fmt &rest args) + (error 'encoding-error :format-control fmt :format-arguments args)) + +;;;; --------------------------------------------------------------------------- +;;;; Encoding names +;;;; + +(defvar *names* (make-hash-table :test #'eq)) + +(defun canon-name (string) + (with-output-to-string (bag) + (map nil (lambda (ch) + (cond ((char= ch #\_) (write-char #\- bag)) + (t (write-char (char-upcase ch) bag)))) + string))) + +(defun canon-name-2 (string) + (with-output-to-string (bag) + (map nil (lambda (ch) + (cond ((char= ch #\_)) + ((char= ch #\-)) + (t (write-char (char-upcase ch) bag)))) + string))) + +(defmethod encoding-names ((encoding symbol)) + (gethash encoding *names*)) + +(defmethod (setf encoding-names) (new-value (encoding symbol)) + (setf (gethash encoding *names*) new-value)) + +(defun add-name (encoding name) + (pushnew (canon-name name) (encoding-names encoding) :test #'string=)) + +(defun resolve-name (string) + (cond ((symbolp string) + string) + (t + (setq string (canon-name string)) + (or + (block nil + (maphash (lambda (x y) + (when (member string y :test #'string=) + (return x))) + *names*) + nil) + (block nil + (maphash (lambda (x y) + (when (member string y + :test #'(lambda (x y) + (string= (canon-name-2 x) + (canon-name-2 y)))) + (return x))) + *names*) + nil))))) + +;;;; --------------------------------------------------------------------------- +;;;; Encodings +;;;; + +(defvar *encodings* (make-hash-table :test #'eq)) + +(defmacro define-encoding (name init-form) + `(progn + (setf (gethash ',name *encodings*) + (list nil (lambda () ,init-form))) + ',name)) + +(defun find-encoding (name) + (let ((x (gethash (resolve-name name) *encodings*))) + (and x + (or (first x) + (setf (first x) (funcall (second x))))))) + +(defclass encoding () ()) + +(defclass simple-8-bit-encoding (encoding) + ((table :initarg :table))) + +(defun make-simple-8-bit-encoding (&key charset) + (make-instance 'simple-8-bit-encoding + :table (coerce (to-unicode-table charset) '(simple-array (unsigned-byte 16) (256))))) + +;;;;;;; + +(defmacro fx-op (op &rest xs) + `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))) +(defmacro fx-pred (op &rest xs) + `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))) + +(defmacro %+ (&rest xs) `(fx-op + ,@xs)) +(defmacro %- (&rest xs) `(fx-op - ,@xs)) +(defmacro %* (&rest xs) `(fx-op * ,@xs)) +(defmacro %/ (&rest xs) `(fx-op floor ,@xs)) +(defmacro %and (&rest xs) `(fx-op logand ,@xs)) +(defmacro %ior (&rest xs) `(fx-op logior ,@xs)) +(defmacro %xor (&rest xs) `(fx-op logxor ,@xs)) +(defmacro %ash (&rest xs) `(fx-op ash ,@xs)) +(defmacro %mod (&rest xs) `(fx-op mod ,@xs)) + +(defmacro %= (&rest xs) `(fx-pred = ,@xs)) +(defmacro %<= (&rest xs) `(fx-pred <= ,@xs)) +(defmacro %>= (&rest xs) `(fx-pred >= ,@xs)) +(defmacro %< (&rest xs) `(fx-pred < ,@xs)) +(defmacro %> (&rest xs) `(fx-pred > ,@xs)) + +;;; Decoders + +;; The decoders share a common signature: +;; +;; DECODE input input-start input-end +;; output output-start output-end +;; eof-p +;; -> first-not-written ; first-not-read +;; +;; These decode functions should decode as much characters off `input' +;; into the `output' as possible and return the indexes to the first +;; not read and first not written element of `input' and `output' +;; respectively. If there are not enough bytes in `input' to decode a +;; full character, decoding shold be abandomed; the caller has to +;; ensure that the remaining bytes of `input' are passed to the +;; decoder again with more bytes appended. +;; +;; `eof-p' now in turn indicates, if the given input sequence, is all +;; the producer does have and might be used to produce error messages +;; in case of incomplete codes or decided what to do. +;; +;; Decoders are expected to handle the various CR/NL conventions and +;; canonicalize each end of line into a single NL rune (#xA) in good +;; old Lisp tradition. +;; + +;; TODO: change this to an encoding class, which then might carry +;; additional state. Stateless encodings could been represented by +;; keywords. e.g. +;; +;; defmethod DECODE-SEQUENCE ((encoding (eql :utf-8)) ...) +;; + +(defmethod decode-sequence ((encoding (eql :utf-16-big-endian)) + in in-start in-end out out-start out-end eof?) + ;; -> new wptr, new rptr + (let ((wptr out-start) + (rptr in-start)) + (loop + (when (%= wptr out-end) + (return)) + (when (>= (%+ rptr 1) in-end) + (return)) + (let ((hi (aref in rptr)) + (lo (aref in (%+ 1 rptr)))) + (setf rptr (%+ 2 rptr)) + ;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste + ;; Zeichen abwarten und nachgucken, dass nicht etwa die andere + ;; Haelfte fehlt! + (let ((x (logior (ash hi 8) lo))) + (when (or (eql x #xFFFE) (eql x #xFFFF)) + (xerror "not a valid code point: #x~X" x)) + (setf (aref out wptr) x)) + (setf wptr (%+ 1 wptr)))) + (values wptr rptr))) + +(defmethod decode-sequence ((encoding (eql :utf-16-little-endian)) + in in-start in-end out out-start out-end eof?) + ;; -> new wptr, new rptr + (let ((wptr out-start) + (rptr in-start)) + (loop + (when (%= wptr out-end) + (return)) + (when (>= (%+ rptr 1) in-end) + (return)) + (let ((lo (aref in (%+ 0 rptr))) + (hi (aref in (%+ 1 rptr)))) + (setf rptr (%+ 2 rptr)) + ;; FIXME: Wenn wir hier ein Surrogate sehen, muessen wir das naechste + ;; Zeichen abwarten und nachgucken, dass nicht etwa die andere + ;; Haelfte fehlt! + (let ((x (logior (ash hi 8) lo))) + (when (or (eql x #xFFFE) (eql x #xFFFF)) + (xerror "not a valid code point: #x~X" x)) + (setf (aref out wptr) x)) + (setf wptr (%+ 1 wptr)))) + (values wptr rptr))) + +(defmethod decode-sequence ((encoding (eql :utf-8)) + in in-start in-end out out-start out-end eof?) + (declare (optimize (speed 3) (safety 0)) + (type (simple-array (unsigned-byte 8) (*)) in) + (type (simple-array (unsigned-byte 16) (*)) out) + (type fixnum in-start in-end out-start out-end)) + (let ((wptr out-start) + (rptr in-start) + byte0) + (macrolet ((put (x) + `((lambda (x) + (when (or (<= #xD800 x #xDBFF) + (<= #xDC00 x #xDFFF)) + (xerror "surrogate encoded in UTF-8: #x~X." x)) + (cond ((or (%> x #x10FFFF) + (eql x #xFFFE) + (eql x #xFFFF)) + (xerror "not a valid code point: #x~X" x)) + ((%> x #xFFFF) + (setf (aref out (%+ 0 wptr)) (%+ #xD7C0 (ash x -10)) + (aref out (%+ 1 wptr)) (%ior #xDC00 (%and x #x3FF))) + (setf wptr (%+ wptr 2))) + (t + (setf (aref out wptr) x) + (setf wptr (%+ wptr 1))))) + ,x)) + (put1 (x) + `(progn + (setf (aref out wptr) ,x) + (setf wptr (%+ wptr 1))))) + (loop + (when (%= (+ wptr 1) out-end) (return)) + (when (%>= rptr in-end) (return)) + (setq byte0 (aref in rptr)) + (cond ((= byte0 #x0D) + ;; CR handling + ;; we need to know the following character + (cond ((>= (%+ rptr 1) in-end) + ;; no characters in buffer + (cond (eof? + ;; at EOF, pass it as NL + (put #x0A) + (setf rptr (%+ rptr 1))) + (t + ;; demand more characters + (return)))) + ((= (aref in (%+ rptr 1)) #x0A) + ;; we see CR NL, so forget this CR and the next NL will be + ;; inserted literally + (setf rptr (%+ rptr 1))) + (t + ;; singleton CR, pass it as NL + (put #x0A) + (setf rptr (%+ rptr 1))))) + + ((%<= #|#b00000000|# byte0 #b01111111) + (put1 byte0) + (setf rptr (%+ rptr 1))) + + ((%<= #|#b10000000|# byte0 #b10111111) + (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0) + (setf rptr (%+ rptr 1))) + + ((%<= #|#b11000000|# byte0 #b11011111) + (cond ((<= (%+ rptr 2) in-end) + (put + (dpb (ldb (byte 5 0) byte0) (byte 5 6) + (dpb (ldb (byte 6 0) (aref in (%+ rptr 1))) (byte 6 0) + 0))) + (setf rptr (%+ rptr 2))) + (t + (return)))) + + ((%<= #|#b11100000|# byte0 #b11101111) + (cond ((<= (%+ rptr 3) in-end) + (put + (dpb (ldb (byte 4 0) byte0) (byte 4 12) + (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 6) + (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 0) + 0)))) + (setf rptr (%+ rptr 3))) + (t + (return)))) + + ((%<= #|#b11110000|# byte0 #b11110111) + (cond ((<= (%+ rptr 4) in-end) + (put + (dpb (ldb (byte 3 0) byte0) (byte 3 18) + (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 12) + (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 6) + (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 0) + 0))))) + (setf rptr (%+ rptr 4))) + (t + (return)))) + + ((%<= #|#b11111000|# byte0 #b11111011) + (cond ((<= (%+ rptr 5) in-end) + (put + (dpb (ldb (byte 2 0) byte0) (byte 2 24) + (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 18) + (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 12) + (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 6) + (dpb (ldb (byte 6 0) (aref in (%+ 4 rptr))) (byte 6 0) + 0)))))) + (setf rptr (%+ rptr 5))) + (t + (return)))) + + ((%<= #|#b11111100|# byte0 #b11111101) + (cond ((<= (%+ rptr 6) in-end) + (put + (dpb (ldb (byte 1 0) byte0) (byte 1 30) + (dpb (ldb (byte 6 0) (aref in (%+ 1 rptr))) (byte 6 24) + (dpb (ldb (byte 6 0) (aref in (%+ 2 rptr))) (byte 6 18) + (dpb (ldb (byte 6 0) (aref in (%+ 3 rptr))) (byte 6 12) + (dpb (ldb (byte 6 0) (aref in (%+ 4 rptr))) (byte 6 6) + (dpb (ldb (byte 6 0) (aref in (%+ 5 rptr))) (byte 6 0) + 0))))))) + (setf rptr (%+ rptr 6))) + (t + (return)))) + + (t + (xerror "Corrupted UTF-8 input (initial byte was #b~8,'0B)" byte0)) ) )) + (values wptr rptr)) ) + +(defmethod encoding-p ((object (eql :utf-16-little-endian))) t) +(defmethod encoding-p ((object (eql :utf-16-big-endian))) t) +(defmethod encoding-p ((object (eql :utf-8))) t) + +(defmethod encoding-p ((object encoding)) t) + +(defmethod decode-sequence ((encoding simple-8-bit-encoding) + in in-start in-end + out out-start out-end + eof?) + (declare (optimize (speed 3) (safety 0)) + (type (simple-array (unsigned-byte 8) (*)) in) + (type (simple-array (unsigned-byte 16) (*)) out) + (type fixnum in-start in-end out-start out-end)) + (let ((wptr out-start) + (rptr in-start) + (byte 0) + (table (slot-value encoding 'table))) + (declare (type fixnum wptr rptr) + (type (unsigned-byte 8) byte) + (type (simple-array (unsigned-byte 16) (*)) table)) + (loop + (when (%= wptr out-end) (return)) + (when (%>= rptr in-end) (return)) + (setq byte (aref in rptr)) + (cond ((= byte #x0D) + ;; CR handling + ;; we need to know the following character + (cond ((>= (%+ rptr 1) in-end) + ;; no characters in buffer + (cond (eof? + ;; at EOF, pass it as NL + (setf (aref out wptr) #x0A) + (setf wptr (%+ wptr 1)) + (setf rptr (%+ rptr 1))) + (t + ;; demand more characters + (return)))) + ((= (aref in (%+ rptr 1)) #x0A) + ;; we see CR NL, so forget this CR and the next NL will be + ;; inserted literally + (setf rptr (%+ rptr 1))) + (t + ;; singleton CR, pass it as NL + (setf (aref out wptr) #x0A) + (setf wptr (%+ wptr 1)) + (setf rptr (%+ rptr 1))))) + + (t + (setf (aref out wptr) (aref table byte)) + (setf wptr (%+ wptr 1)) + (setf rptr (%+ rptr 1))) )) + (values wptr rptr))) + +;;;; --------------------------------------------------------------------------- +;;;; Character sets +;;;; + +(defvar *charsets* (make-hash-table :test #'eq)) + +(defclass 8-bit-charset () + ((name :initarg :name) + (to-unicode-table + :initarg :to-unicode-table + :reader to-unicode-table))) + +(defmacro define-8-bit-charset (name &rest codes) + (assert (= 256 (length codes))) + `(progn + (setf (gethash ',name *charsets*) + (make-instance '8-bit-charset + :name ',name + :to-unicode-table + ',(make-array 256 + :element-type '(unsigned-byte 16) + :initial-contents codes))) + ',name)) + +(defun find-charset (name) + (or (gethash name *charsets*) + (xerror "There is no character set named ~S." name))) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/hax.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/hax.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,404 @@ +;;; -*- show-trailing-whitespace: t; indent-tabs: nil -*- +;;; --------------------------------------------------------------------------- +;;; Title: An event API for the HTML parser, inspired by SAX +;;; Created: 2007-10-14 +;;; Author: David Lichteblau +;;; License: BSD +;;; --------------------------------------------------------------------------- +;;; (c) copyright 2005,2007 David Lichteblau + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions are +;;; met: +;;; +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution +;;; +;;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED +;;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +;;; IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, +;;; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +;;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +;;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING +;;; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +;;; POSSIBILITY OF SUCH DAMAGE. + +(defpackage :hax + (:use :common-lisp) + (:export #:abstract-handler + #:default-handler + + #:make-attribute + #:standard-attribute + #:find-attribute + #:attribute-name + #:attribute-value + #:attribute-specified-p + + #:start-document + #:start-element + #:characters + #:end-element + #:end-document + #:comment + + #+rune-is-integer + #:%want-strings-p)) + +(in-package :hax) + + +;;;; ATTRIBUTE + +(defgeneric attribute-name (attribute)) +(defgeneric attribute-value (attribute)) +(defgeneric attribute-specified-p (attribute)) + +(defclass standard-attribute () + ((name :initarg :name :accessor attribute-name) + (value :initarg :value :accessor attribute-value) + (specified-p :initarg :specified-p :accessor attribute-specified-p))) + +(defun make-attribute (name value &optional (specified-p t)) + (make-instance 'standard-attribute + :name name + :value value + :specified-p specified-p)) + +(defun %rod= (x y) + ;; allow rods *and* strings *and* null + (cond + ((zerop (length x)) (zerop (length y))) + ((zerop (length y)) nil) + ((stringp x) (string= x y)) + (t (runes:rod= x y)))) + +(defun find-attribute (name attrs) + (find name attrs :key #'attribute-name :test #'%rod=)) + + +;;;; ABSTRACT-HANDLER and DEFAULT-HANDLER + +(defclass abstract-handler () ()) +(defclass default-handler (abstract-handler) ()) + +#+rune-is-integer +(defgeneric %want-strings-p (handler) + (:method ((handler null)) nil) + (:method ((handler abstract-handler)) t)) + +(defgeneric start-document (handler name public-id system-id) + (:method ((handler null) name public-id system-id) + (declare (ignore name public-id system-id)) + nil) + (:method ((handler default-handler) name public-id system-id) + (declare (ignore name public-id system-id)) + nil)) + +(defgeneric start-element (handler name attributes) + (:method ((handler null) name attributes) + (declare (ignore name attributes)) + nil) + (:method ((handler default-handler) name attributes) + (declare (ignore name attributes)) + nil)) + +(defgeneric characters (handler data) + (:method ((handler null) data) + (declare (ignore data)) + nil) + (:method ((handler default-handler) data) + (declare (ignore data)) + nil)) + +(defgeneric end-element (handler name) + (:method ((handler null) name) + (declare (ignore name)) + nil) + (:method ((handler default-handler) name) + (declare (ignore name)) + nil)) + +(defgeneric end-document (handler) + (:method ((handler null)) nil) + (:method ((handler default-handler)) nil)) + +(defgeneric comment (handler data) + (:method ((handler null) data) + (declare (ignore data)) + nil) + (:method ((handler default-handler) data) + (declare (ignore data)) + nil)) + + +;;;; documentation + +(setf (documentation (find-package :hax) t) + "An event protocol for HTML serialization, this package is similar + to the SAX protocol defined by cxml for XML serialization. + + (Technically, this package should have been spelled SAH, but HAX + sounds better.) + + Note that Closure HTML is not a streaming parser yet. Documents + are always parsed in full before the first HAX event is emitted. + In spite of this restriction, the HAX API is useful for HTML + serialization and transformation purposes, and for integration + with SAX. + + @begin[HAX handlers]{section} + @aboutclass{abstract-handler} + @aboutclass{default-handler} + @end{section} + @begin[The attribute protocol]{section} + @aboutclass{standard-attribute} + @aboutfun{make-attribute} + @aboutfun{attribute-name} + @aboutfun{attribute-value} + @aboutfun{attribute-specified-p} + @end{section} + @begin[HAX events]{section} + @aboutfun{start-document} + @aboutfun{start-element} + @aboutfun{end-element} + @aboutfun{characters} + @aboutfun{comment} + @aboutfun{end-document} + @end{section}") + +(setf (documentation 'abstract-handler 'type) + "@short{The superclass of all HAX handlers.} + + Direct subclasses have to implement all event methods, since + no default methods are defined on this class. + + Note that it is permissible to use handlers that are not + instances of this class in some circumstances. + + In particular, + @code{nil} is a valid HAX handler and ignores all events. + + In addition, + @a[http://common-lisp.net/project/cxml/sax.html#sax]{SAX handlers} + are valid HAX handlers (and vice versa), even though + hax:abstract-handler and sax:abstract-handler do not + share a specific superclass. HAX events sent to SAX handlers are + automatically re-signalled as XHTML SAX events, and SAX events sent + to HAX handlers are re-signalled as namespace-less HAX events. + + However, user code should define subclasses of the documented + superclasses to enable the HAX/SAX bridging described above. + + @see{chtml:parse} + @see{chtml:serialize-lhtml} + @see{chtml:serialize-pt} + @see{start-document} + @see{end-document} + @see{start-element} + @see{end-element} + @see{characters} + @see{comment}") + +(setf (documentation 'default-handler 'type) + "@short{A no-op HAX handler.} + + This class defines methods for all HAX events that do nothing. + It is useful as a superclass when implementing a HAX handler that + is interested in only some events and not others. + + @see{chtml:parse} + @see{chtml:serialize-lhtml} + @see{chtml:serialize-pt} + @see{start-document} + @see{end-document} + @see{start-element} + @see{end-element} + @see{characters} + @see{comment}") + +(setf (documentation 'standard-attribute 'type) + "@short{An implementation of the HAX attribute protocol.} + + A standard class implementing the generic functions for HAX + attributes. Instances of this class can be passed to + @fun{hax:start-element} in the list of attributes. + + @see-slot{attribute-name} + @see-slot{attribute-value} + @see-slot{attribute-specified-p} + @see-constructor{make-instance}") + +(setf (documentation 'make-attribute 'function) + "@arg[name]{a string/rod} + @arg[value]{a string/rod} + @arg[specified-p]{a boolean, default is @code{t}} + @return{an instance of @class{standard-attribute}.} + @short{Creates a HAX attribute.} + + Creates an instance that can be used with the generic functions + for HAX attributes. The result can be passed to + @fun{hax:start-element} in the list of attributes. + + @see{attribute-name} + @see{attribute-value} + @see{attribute-specified-p}") + +(setf (documentation 'find-attribute 'function) + "@arg[name]{a string/rod} + @arg[attrs]{a list of attributes} + @return{an attribute, or nil} + @short{Searches for an attribute by name.} + + Returns the first attribute in @var{attrs} with the specified name, + or @code{nil} if no such attribute was found. + + @see{attribute-name}") + +(setf (documentation 'attribute-name 'function) + "@arg[instance]{any class implementing this function} + @return{a string/rod} + @short{Return an attribute's name.} + + Instances of this classes implementing this function can be passed to + @fun{hax:start-element} in the list of attributes. + + @see{attribute-value} + @see{attribute-specified-p}") + +(setf (documentation 'attribute-value 'function) + "@arg[instance]{any class implementing this function} + @return{a string/rod} + @short{Return an attribute's value.} + + Instances of this classes implementing this function can be passed to + @fun{hax:start-element} in the list of attributes. + + @see{attribute-name} + @see{attribute-specified-p}") + +(setf (documentation 'attribute-specified-p 'function) + "@arg[instance]{any class implementing this function} + @return{a string/rod} + @short{Return whether the attribute was contained the parsed document.} + + Attributes return @code{nil} here if they resulted from a default + value declaration in a DTD. + + Instances of this classes implementing this function can be passed to + @fun{hax:start-element} in the list of attributes. + + @see{attribute-name} + @see{attribute-value}") + +(setf (documentation 'start-document 'function) + "@arg[handler]{a HAX/SAX handler + (see @class{abstract-handler} for details)} + @arg[name]{root element name, a rod/string} + @arg[public-id]{nil or the Public ID, a rod/string} + @arg[system-id]{nil or the System ID/URI, a rod/string} + @return{unspecified} + @short{Signals the beginning of an HTML document.} + + This is the first event sent to any handler. + + If @var{system-id} is non-nil, the document includes a doctype + declaration. + + @see{start-element} + @see{end-element} + @see{characters} + @see{comment} + @see{end-document}") + +(setf (documentation 'start-element 'function) + "@arg[handler]{a HAX/SAX handler + (see @class{abstract-handler} for details)} + @arg[name]{root element name, a rod/string} + @arg[attributes]{a list of attributes} + @return{unspecified} + @short{Signals the beginning of an HTML element.} + + This event corresponds to the opening tag of an element. + + Elements of the attribute list can have any class, but must implement + the generic functions for attributes. See @class{standard-attribute} + for the built-in attribute implementation. + + @see{find-attribute} + @see{start-document} + @see{end-element} + @see{characters} + @see{comment} + @see{end-document}") + +(setf (documentation 'end-element 'function) + "@arg[handler]{a HAX/SAX handler + (see @class{abstract-handler} for details)} + @arg[name]{root element name, a rod/string} + @return{unspecified} + @short{Signals the end of an HTML element.} + + This event corresponds to the closing tag of an element. + + @see{start-document} + @see{start-element} + @see{characters} + @see{comment} + @see{end-document}") + +(setf (documentation 'characters 'function) + "@arg[handler]{a HAX/SAX handler + (see @class{abstract-handler} for details)} + @arg[data]{rod/string} + @return{unspecified} + @short{Signals character data.} + + This event represents character data in a document. + + @see{start-document} + @see{start-element} + @see{end-element} + @see{comment} + @see{end-document}") + +(setf (documentation 'comment 'function) + "@arg[handler]{a HAX/SAX handler + (see @class{abstract-handler} for details)} + @arg[data]{rod/string} + @return{unspecified} + @short{Signals a comment.} + + This event represents a comment. + + @see{start-document} + @see{start-element} + @see{end-element} + @see{characters} + @see{end-document}") + +(setf (documentation 'end-document 'function) + "@arg[handler]{a HAX/SAX handler + (see @class{abstract-handler} for details)} + @return{The return value of this function depends on the handler class.} + @short{Signals the end of an HTML document.} + + This is the last event sent to any handler, and signals the end of + serialization. + + The return value of this function is usually returned to user code + by higher-level serialization functions and can be considered the + result of serialization and \"return value\" of the handler. + + @see{start-document} + @see{start-element} + @see{end-element} + @see{characters} + @see{comment}") Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/package.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/package.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,99 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CL-USER; -*- +;;; --------------------------------------------------------------------------- +;;; Title: Generating a sane DEFPACKAGE for RUNES +;;; Created: 1999-05-25 +;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1999,2000 by Gilbert Baumann + +(in-package :cl-user) + +(defpackage :runes + (:use :cl #-scl :trivial-gray-streams) + (:export #:definline + + ;; runes.lisp + #:rune + #:rod + #:simple-rod + #:%rune + #:rod-capitalize + #:code-rune + #:rune-code + #:rune-downcase + #:rune-upcase + #:rod-downcase + #:rod-upcase + #:white-space-rune-p + #:digit-rune-p + #:rune= + #:rune<= + #:rune>= + #:rune-equal + #:runep + #:sloopy-rod-p + #:rod= + #:rod-equal + #:make-rod + #:char-rune + #:rune-char + #:rod-string + #:string-rod + #:rod-subseq + #:rod< + + ;; xstream.lisp + #:xstream + #:make-xstream + #:make-rod-xstream + #:close-xstream + #:xstream-p + #:read-rune + #:peek-rune + #:fread-rune + #:fpeek-rune + #:consume-rune + #:unread-rune + #:xstream-position + #:xstream-line-number + #:xstream-column-number + #:xstream-plist + #:xstream-encoding + #:set-to-full-speed + #:xstream-name + + ;; ystream.lisp + #:ystream + #:close-ystream + #:write-rune + #:write-rod + #:ystream-column + #:make-octet-vector-ystream + #:make-octet-stream-ystream + #:make-rod-ystream + #+rune-is-character #:make-character-stream-ystream + ;; These don't make too much sense on Unicode-enabled, + ;; implementations but for those applications using them anyway, + ;; I have commented out the reader conditionals now: + ;; #+rune-is-integer + #:make-string-ystream/utf8 + ;; #+rune-is-integer + #:make-character-stream-ystream/utf8 + #:runes-to-utf8/adjustable-string + + #:rod-to-utf8-string + #:utf8-string-to-rod + #:make-octet-input-stream)) + +(defpackage :utf8-runes + (:use :cl) + (:export *utf8-runes-readtable* + #:rune #:rod #:simple-rod #:rod-string #:rod= #:make-rod + #:string-rod)) + +(defpackage :runes-encoding + (:use :cl :runes) + (:export + #:encoding-error + #:find-encoding + #:decode-sequence)) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/runes.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/runes.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,230 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*- +;;; --------------------------------------------------------------------------- +;;; Title: Unicode strings (called RODs) +;;; Created: 1999-05-25 22:29 +;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1998,1999 by Gilbert Baumann + +;;; This code is free software; you can redistribute it and/or modify it +;;; under the terms of the version 2.1 of the GNU Lesser General Public +;;; License as published by the Free Software Foundation, as clarified +;;; by the "Preamble to the Gnu Lesser General Public License" found in +;;; the file COPYING. +;;; +;;; This code is distributed in the hope that it will be useful, +;;; but without any warranty; without even the implied warranty of +;;; merchantability or fitness for a particular purpose. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; Version 2.1 of the GNU Lesser General Public License is in the file +;;; COPYING that was distributed with this file. If it is not present, +;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until +;;; superseded by a newer version) or write to the Free Software +;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;; Changes +;; +;; When Who What +;; ---------------------------------------------------------------------------- +;; 1999-08-15 GB - ROD=, ROD-EQUAL +;; RUNE<=, RUNE>= +;; MAKE-ROD, ROD-SUBSEQ +;; CHAR-RUNE, RUNE-CHAR, ROD-STRING, STRING-ROD +;; new functions +;; - Added rune reader +;; + +(in-package :runes) + +(deftype rune () '(unsigned-byte 16)) +(deftype rod () '(array rune (*))) +(deftype simple-rod () '(simple-array rune (*))) + +(definline rune (rod index) + (aref rod index)) + +(defun (setf rune) (new rod index) + (setf (aref rod index) new)) + +(definline %rune (rod index) + (aref (the (simple-array (unsigned-byte 16) (*)) rod) (the fixnum index))) + +(definline (setf %rune) (new rod index) + (setf (aref (the (simple-array (unsigned-byte 16) (*)) rod) (the fixnum index)) new)) + +(defun rod-capitalize (rod) + (warn "~S is not implemented." 'rod-capitalize) + rod) + +(definline code-rune (x) x) +(definline rune-code (x) x) + +(definline rune= (x y) + (= x y)) + +(defun rune-downcase (rune) + (cond ((<= #x0041 rune #x005a) (+ rune #x20)) + ((= rune #x00d7) rune) + ((<= #x00c0 rune #x00de) (+ rune #x20)) + (t rune))) + +(definline rune-upcase (rune) + (cond ((<= #x0061 rune #x007a) (- rune #x20)) + ((= rune #x00f7) rune) + ((<= #x00e0 rune #x00fe) (- rune #x20)) + (t rune))) + +(defun rune-upper-case-letter-p (rune) + (or (<= #x0041 rune #x005a) (<= #x00c0 rune #x00de))) + +(defun rune-lower-case-letter-p (rune) + (or (<= #x0061 rune #x007a) (<= #x00e0 rune #x00fe) + (= rune #x00d7))) + + +(defun rune-equal (x y) + (rune= (rune-upcase x) (rune-upcase y))) + +(defun rod-downcase (rod) + ;; FIXME + (map '(simple-array (unsigned-byte 16) (*)) #'rune-downcase rod)) + +(defun rod-upcase (rod) + ;; FIXME + (map '(simple-array (unsigned-byte 16) (*)) #'rune-upcase rod)) + +(definline white-space-rune-p (char) + (or (= char 9) ;TAB + (= char 10) ;Linefeed + (= char 13) ;Carriage Return + (= char 32))) ;Space + +(definline digit-rune-p (char &optional (radix 10)) + (cond ((<= #.(char-code #\0) char #.(char-code #\9)) + (and (< (- char #.(char-code #\0)) radix) + (- char #.(char-code #\0)))) + ((<= #.(char-code #\A) char #.(char-code #\Z)) + (and (< (- char #.(char-code #\A) -10) radix) + (- char #.(char-code #\A) -10))) + ((<= #.(char-code #\a) char #.(char-code #\z)) + (and (< (- char #.(char-code #\a) -10) radix) + (- char #.(char-code #\a) -10))) )) + +(defun rod (x) + (cond ((stringp x) (map 'rod #'char-code x)) + ((symbolp x) (rod (string x))) + ((characterp x) (rod (string x))) + ((vectorp x) (coerce x 'rod)) + ((integerp x) (map 'rod #'identity (list x))) + (t (error "Cannot convert ~S to a ~S" x 'rod)))) + +(defun runep (x) + (and (integerp x) + (<= 0 x #xFFFF))) + +(defun sloopy-rod-p (x) + (and (not (stringp x)) + (vectorp x) + (every #'runep x))) + +(defun rod= (x y) + (and (= (length x) (length y)) + (dotimes (i (length x) t) + (unless (rune= (rune x i) (rune y i)) + (return nil))))) + +(defun rod-equal (x y) + (and (= (length x) (length y)) + (dotimes (i (length x) t) + (unless (rune-equal (rune x i) (rune y i)) + (return nil))))) + +(definline make-rod (size) + (make-array size :element-type 'rune)) + +(defun char-rune (char) + (code-rune (char-code char))) + +(defparameter *invalid-rune* nil ;;#\? + "Rune to use as a replacement in RUNE-CHAR and ROD-STRING for runes not + representable as characters. If NIL, an error is signalled instead.") + +(defun rune-char (rune &optional (default *invalid-rune*)) + (or (if (>= rune char-code-limit) + default + (or (code-char rune) default)) + (error "rune cannot be represented as a character: ~A" rune))) + +(defun rod-string (rod &optional (default-char *invalid-rune*)) + (map 'string (lambda (x) (rune-char x default-char)) rod)) + +(defun string-rod (string) + (let* ((n (length string)) + (res (make-rod n))) + (dotimes (i n) + (setf (%rune res i) (char-rune (char string i)))) + res)) + +;;;; + +(defun rune<= (rune &rest more-runes) + (apply #'<= rune more-runes)) + +(defun rune>= (rune &rest more-runes) + (apply #'>= rune more-runes)) + +(defun rodp (object) + (typep object 'rod)) + +(defun rod-subseq (source start &optional (end (length source))) + (unless (rodp source) + (error "~S is not of type ~S." source 'rod)) + (unless (and (typep start 'fixnum) (>= start 0)) + (error "~S is not a non-negative fixnum." start)) + (unless (and (typep end 'fixnum) (>= end start)) + (error "END argument, ~S, is not a fixnum no less than START, ~S." end start)) + (when (> start (length source)) + (error "START argument, ~S, should be no greater than length of rod." start)) + (when (> end (length source)) + (error "END argument, ~S, should be no greater than length of rod." end)) + (locally + (declare (type rod source) + (type fixnum start end)) + (let ((res (make-rod (- end start)))) + (declare (type rod res)) + (do ((i (- (- end start) 1) (the fixnum (- i 1)))) + ((< i 0) res) + (declare (type fixnum i)) + (setf (%rune res i) (%rune source (the fixnum (+ i start)))))))) + +(defun rod-subseq* (source start &optional (end (length source))) + (unless (and (typep start 'fixnum) (>= start 0)) + (error "~S is not a non-negative fixnum." start)) + (unless (and (typep end 'fixnum) (>= end start)) + (error "END argument, ~S, is not a fixnum no less than START, ~S." end start)) + (when (> start (length source)) + (error "START argument, ~S, should be no greater than length of rod." start)) + (when (> end (length source)) + (error "END argument, ~S, should be no greater than length of rod." end)) + (locally + (declare (type fixnum start end)) + (let ((res (make-rod (- end start)))) + (declare (type rod res)) + (do ((i (- (- end start) 1) (the fixnum (- i 1)))) + ((< i 0) res) + (declare (type fixnum i)) + (setf (%rune res i) (aref source (the fixnum (+ i start)))))))) + +(defun rod< (rod1 rod2) + (do ((i 0 (+ i 1))) + (nil) + (cond ((= i (length rod1)) + (return t)) + ((= i (length rod2)) + (return nil)) + ((< (aref rod1 i) (aref rod2 i)) + (return t)) + ((> (aref rod1 i) (aref rod2 i)) + (return nil))))) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/stream-scl.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/stream-scl.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,253 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*- +;;; --------------------------------------------------------------------------- +;;; Title: Fast streams +;;; Created: 1999-07-17 +;;; Author: Douglas Crosher +;;; License: Lisp-LGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 2007 by Douglas Crosher + +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Library General Public +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +(in-package :runes) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *fast* '(optimize (speed 3) (safety 3)))) + +(deftype runes-encoding:encoding-error () + 'ext:character-conversion-error) + + +;;; xstream + +(eval-when (:compile-toplevel :load-toplevel :execute) + +(defclass xstream (ext:character-stream) + ((name :initarg :name :initform nil + :accessor xstream-name) + (column :initarg :column :initform 0) + (line :initarg :line :initform 1) + (unread-column :initarg :unread-column :initform 0))) + +(defclass eol-conversion-xstream (lisp::eol-conversion-input-stream xstream) + ()) + +) ; eval-when + +(defun make-eol-conversion-xstream (source-stream) + "Returns a character stream that conversion CR-LF pairs and lone CR + characters into single linefeed character." + (declare (type stream source-stream)) + (let ((stream (ext:make-eol-conversion-stream source-stream + :input t + :close-stream-p t))) + (change-class stream 'eol-conversion-xstream))) + +(definline xstream-p (stream) + (typep stream 'xstream)) + +(defun close-xstream (input) + (close input)) + +(definline read-rune (input) + (declare (type stream input) + (inline read-char) + #.*fast*) + (let ((char (read-char input nil :eof))) + (cond ((member char '(#\UFFFE #\UFFFF)) + ;; These characters are illegal within XML documents. + (simple-error 'ext:character-conversion-error + "~@<Illegal XML document character: ~S~:@>" char)) + ((eql char #\linefeed) + (setf (slot-value input 'unread-column) (slot-value input 'column)) + (setf (slot-value input 'column) 0) + (incf (the kernel:index (slot-value input 'line)))) + (t + (incf (the kernel:index (slot-value input 'column))))) + char)) + +(definline peek-rune (input) + (declare (type stream input) + (inline peek-char) + #.*fast*) + (peek-char nil input nil :eof)) + +(definline consume-rune (input) + (declare (type stream input) + (inline read-rune) + #.*fast*) + (read-rune input) + nil) + +(definline unread-rune (rune input) + (declare (type stream input) + (inline unread-char) + #.*fast*) + (unread-char rune input) + (cond ((eql rune #\linefeed) + (setf (slot-value input 'column) (slot-value input 'unread-column)) + (setf (slot-value input 'unread-column) 0) + (decf (the kernel:index (slot-value input 'line)))) + (t + (decf (the kernel:index (slot-value input 'column))))) + nil) + +(defun fread-rune (input) + (read-rune input)) + +(defun fpeek-rune (input) + (peek-rune input)) + +(defun xstream-position (input) + (file-position input)) + +(defun runes-encoding:find-encoding (encoding) + encoding) + +(defun make-xstream (os-stream &key name + (speed 8192) + (initial-speed 1) + (initial-encoding :guess)) + (declare (ignore speed)) + (assert (eql initial-speed 1)) + (assert (eq initial-encoding :guess)) + (let* ((stream (ext:make-xml-character-conversion-stream os-stream + :input t + :close-stream-p t)) + (xstream (make-eol-conversion-xstream stream))) + (setf (xstream-name xstream) name) + xstream)) + + +(defclass xstream-string-input-stream (lisp::string-input-stream xstream) + ()) + +(defun make-rod-xstream (string &key name) + (declare (type string string)) + (let ((stream (make-string-input-stream string))) + (change-class stream 'xstream-string-input-stream :name name))) + +;;; already at 'full speed' so just return the buffer size. +(defun set-to-full-speed (stream) + (length (ext:stream-in-buffer stream))) + +(defun xstream-speed (stream) + (length (ext:stream-in-buffer stream))) + +(defun xstream-line-number (stream) + (slot-value stream 'line)) + +(defun xstream-column-number (stream) + (slot-value stream 'column)) + +(defun xstream-encoding (stream) + (stream-external-format stream)) + +;;; the encoding will have already been detected, but it is checked against the +;;; declared encoding here. +(defun (setf xstream-encoding) (declared-encoding stream) + (let* ((initial-encoding (xstream-encoding stream)) + (canonical-encoding + (cond ((and (eq initial-encoding :utf-16le) + (member declared-encoding '(:utf-16 :utf16 :utf-16le :utf16le) + :test 'string-equal)) + :utf-16le) + ((and (eq initial-encoding :utf-16be) + (member declared-encoding '(:utf-16 :utf16 :utf-16be :utf16be) + :test 'string-equal)) + :utf-16be) + ((and (eq initial-encoding :ucs-4be) + (member declared-encoding '(:ucs-4 :ucs4 :ucs-4be :ucs4be) + :test 'string-equal)) + :ucs4-be) + ((and (eq initial-encoding :ucs-4le) + (member declared-encoding '(:ucs-4 :ucs4 :ucs-4le :ucs4le) + :test 'string-equal)) + :ucs4-le) + (t + declared-encoding)))) + (unless (string-equal initial-encoding canonical-encoding) + (warn "Unable to change xstream encoding from ~S to ~S (~S)~%" + initial-encoding declared-encoding canonical-encoding)) + declared-encoding)) + + +;;; ystream - a run output stream. + +(deftype ystream () 'stream) + +(defun ystream-column (stream) + (ext:line-column stream)) + +(definline write-rune (rune stream) + (declare (inline write-char)) + (write-char rune stream)) + +(defun write-rod (rod stream) + (declare (type rod rod) + (type stream stream)) + (write-string rod stream)) + +(defun make-rod-ystream () + (make-string-output-stream)) + +(defun close-ystream (stream) + (etypecase stream + (ext:string-output-stream + (get-output-stream-string stream)) + (ext:character-conversion-output-stream + (let ((target (slot-value stream 'stream))) + (close stream) + (if (typep target 'ext:byte-output-stream) + (ext:get-output-stream-bytes target) + stream))))) + +;;;; CHARACTER-STREAM-YSTREAM + +(defun make-character-stream-ystream (target-stream) + target-stream) + + +;;;; OCTET-VECTOR-YSTREAM + +(defun make-octet-vector-ystream () + (let ((target (ext:make-byte-output-stream))) + (ext:make-character-conversion-stream target :output t + :external-format :utf-8 + :close-stream-p t))) + +;;;; OCTET-STREAM-YSTREAM + +(defun make-octet-stream-ystream (os-stream) + (ext:make-character-conversion-stream os-stream :output t + :external-format :utf-8 + :close-stream-p t)) + + +;;;; helper functions + +(defun rod-to-utf8-string (rod) + (ext:make-string-from-bytes (ext:make-bytes-from-string rod :utf8) + :iso-8859-1)) + +(defun utf8-string-to-rod (str) + (let ((bytes (map '(vector (unsigned-byte 8)) #'char-code str))) + (ext:make-string-from-bytes bytes :utf-8))) + +(defun make-octet-input-stream (octets) + (ext:make-byte-input-stream octets)) + + Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/syntax.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/syntax.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,181 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*- +;;; --------------------------------------------------------------------------- +;;; Title: Unicode strings (called RODs) +;;; Created: 1999-05-25 22:29 +;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1998,1999 by Gilbert Baumann + +;;; This code is free software; you can redistribute it and/or modify it +;;; under the terms of the version 2.1 of the GNU Lesser General Public +;;; License as published by the Free Software Foundation, as clarified +;;; by the "Preamble to the Gnu Lesser General Public License" found in +;;; the file COPYING. +;;; +;;; This code is distributed in the hope that it will be useful, +;;; but without any warranty; without even the implied warranty of +;;; merchantability or fitness for a particular purpose. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; Version 2.1 of the GNU Lesser General Public License is in the file +;;; COPYING that was distributed with this file. If it is not present, +;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until +;;; superseded by a newer version) or write to the Free Software +;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;; Changes +;; +;; When Who What +;; ---------------------------------------------------------------------------- +;; 1999-08-15 GB - ROD=, ROD-EQUAL +;; RUNE<=, RUNE>= +;; MAKE-ROD, ROD-SUBSEQ +;; CHAR-RUNE, RUNE-CHAR, ROD-STRING, STRING-ROD +;; new functions +;; - Added rune reader +;; + +(in-package :runes) + +;;;; +;;;; RUNE Reader +;;;; + +;; Portable implementation of WHITE-SPACE-P with regard to the current +;; read table -- this is bit tricky. + +(defun rt-white-space-p (char) + (let ((stream (make-string-input-stream (string char)))) + (eq :eof (peek-char t stream nil :eof)))) + +(defun read-rune-name (input) + ;; the first char is unconditionally read + (let ((char0 (read-char input t nil t))) + (when (char= char0 #\\) + (setf char0 (read-char input t nil t))) + (with-output-to-string (res) + (write-char char0 res) + (do ((ch (peek-char nil input nil :eof t) (peek-char nil input nil :eof t))) + ((or (eq ch :eof) + (rt-white-space-p ch) + (multiple-value-bind (function non-terminating-p) (get-macro-character ch) + (and function (not non-terminating-p))))) + (write-char ch res) + (read-char input))))) ;consume this character + +(defun iso-10646-char-code (char) + (char-code char)) + +(defvar *rune-names* (make-hash-table :test #'equal) + "Hashtable, which maps all known rune names to rune codes; + Names are stored in uppercase.") + +(defun define-rune-name (name code) + (setf (gethash (string-upcase name) *rune-names*) code) + name) + +(defun lookup-rune-name (name) + (gethash (string-upcase name) *rune-names*)) + +(define-rune-name "null" #x0000) +(define-rune-name "space" #x0020) +(define-rune-name "newline" #x000A) +(define-rune-name "return" #x000D) +(define-rune-name "tab" #x0009) +(define-rune-name "page" #x000C) + +;; and just for fun: +(define-rune-name "euro" #x20AC) + +;; ASCII control characters +(define-rune-name "nul" #x0000) ;null +(define-rune-name "soh" #x0001) ;start of header +(define-rune-name "stx" #x0002) ;start of text +(define-rune-name "etx" #x0003) ;end of text +(define-rune-name "eot" #x0004) ;end of transmission +(define-rune-name "enq" #x0005) ; +(define-rune-name "ack" #x0006) ;acknowledge +(define-rune-name "bel" #x0007) ;bell +(define-rune-name "bs" #x0008) ;backspace +(define-rune-name "ht" #x0009) ;horizontal tab +(define-rune-name "lf" #X000A) ;line feed, new line +(define-rune-name "vt" #X000B) ;vertical tab +(define-rune-name "ff" #x000C) ;form feed +(define-rune-name "cr" #x000D) ;carriage return +(define-rune-name "so" #x000E) ;shift out +(define-rune-name "si" #x000F) ;shift in +(define-rune-name "dle" #x0010) ;device latch enable ? +(define-rune-name "dc1" #x0011) ;device control 1 +(define-rune-name "dc2" #x0012) ;device control 2 +(define-rune-name "dc3" #x0013) ;device control 3 +(define-rune-name "dc4" #x0014) ;device control 4 +(define-rune-name "nak" #x0015) ;negative acknowledge +(define-rune-name "syn" #x0016) ; +(define-rune-name "etb" #x0017) ; +(define-rune-name "can" #x0018) ; +(define-rune-name "em" #x0019) ;end of message +(define-rune-name "sub" #x001A) ; +(define-rune-name "esc" #x001B) ;escape +(define-rune-name "fs" #x001C) ;field separator ? +(define-rune-name "gs" #x001D) ;group separator +(define-rune-name "rs" #x001E) ; +(define-rune-name "us" #x001F) ; + +(define-rune-name "del" #x007F) ;delete + +;; iso-latin +(define-rune-name "nbsp" #x00A0) ;non breakable space +(define-rune-name "shy" #x00AD) ;soft hyphen + +(defun rune-from-read-name (name) + (code-rune + (cond ((= (length name) 1) + (iso-10646-char-code (char name 0))) + ((and (= (length name) 2) + (char= (char name 0) #\\)) + (iso-10646-char-code (char name 1))) + ((and (>= (length name) 3) + (char-equal (char name 0) #\u) + (char-equal (char name 1) #\+) + (every (lambda (x) (digit-char-p x 16)) (subseq name 2))) + (parse-integer name :start 2 :radix 16)) + ((lookup-rune-name name)) + (t + (error "Meaningless rune name ~S." name))))) + +(defun rune-reader (stream subchar arg) + subchar arg + (values (rune-from-read-name (read-rune-name stream)))) + +(set-dispatch-macro-character #\# #\/ 'rune-reader) + +;;; ROD ext syntax + +(defun rod-reader (stream subchar arg) + (declare (ignore arg)) + (rod + (with-output-to-string (bag) + (do ((c (read-char stream t nil t) + (read-char stream t nil t))) + ((char= c subchar)) + (cond ((char= c #\\) + (setf c (read-char stream t nil t)))) + (princ c bag))))) + +#-rune-is-character +(defun rod-printer (stream rod) + (princ #\# stream) + (princ #\" stream) + (loop for x across rod do + (cond ((or (rune= x #.(char-rune #\\)) + (rune= x #.(char-rune #\"))) + (princ #\\ stream) + (princ (code-char x) stream)) + ((< x char-code-limit) + (princ (code-char x) stream)) + (t + (format stream "\\u~4,'0X" x)))) + (princ #\" stream)) + +(set-dispatch-macro-character #\# #\" 'rod-reader) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/utf8.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/utf8.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,36 @@ +;;; copyright (c) 2005 David Lichteblau <david@lichteblau.com> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; +;;; Rune emulation for the UTF-8-compatible DOM implementation. +;;; Used only with 8 bit characters on non-unicode Lisps. + +(in-package :utf8-runes) + +(deftype rune () 'character) +(deftype rod () '(vector rune)) +(deftype simple-rod () '(simple-array rune)) + +(defun rod= (r s) + (string= r s)) + +(defun rod-string (rod &optional default) + (declare (ignore default)) + rod) + +(defun string-rod (string) + string) + +(defun make-rod (size) + (make-string size :element-type 'rune)) + +(defun rune-reader (stream subchar arg) + (runes::rune-char (runes::rune-reader stream subchar arg))) + +(defun rod-reader (stream subchar arg) + (runes::rod-string (runes::rod-reader stream subchar arg))) + +(setf closure-common-system:*utf8-runes-readtable* + (let ((rt (copy-readtable))) + (set-dispatch-macro-character #\# #\/ 'rune-reader rt) + (set-dispatch-macro-character #\# #\" 'rod-reader rt) + rt)) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/xstream.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/xstream.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,411 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; readtable: runes; Encoding: utf-8; -*- +;;; --------------------------------------------------------------------------- +;;; Title: Fast streams +;;; Created: 1999-07-17 +;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1999 by Gilbert Baumann + +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Library General Public +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +(in-package :runes) + +;;; API +;; +;; MAKE-XSTREAM cl-stream &key name! speed initial-speed initial-encoding +;; [function] +;; MAKE-ROD-XSTREAM rod &key name [function] +;; CLOSE-XSTREAM xstream [function] +;; XSTREAM-P object [function] +;; +;; READ-RUNE xstream [macro] +;; PEEK-RUNE xstream [macro] +;; FREAD-RUNE xstream [function] +;; FPEEK-RUNE xstream [function] +;; CONSUME-RUNE xstream [macro] +;; UNREAD-RUNE rune xstream [function] +;; +;; XSTREAM-NAME xstream [accessor] +;; XSTREAM-POSITION xstream [function] +;; XSTREAM-LINE-NUMBER xstream [function] +;; XSTREAM-COLUMN-NUMBER xstream [function] +;; XSTREAM-PLIST xstream [accessor] +;; XSTREAM-ENCODING xstream [accessor] <-- be careful here. [*] +;; SET-TO-FULL-SPEED xstream [function] + +;; [*] switching the encoding on the fly is only possible when the +;; stream's buffer is empty; therefore to be able to switch the +;; encoding, while some runes are already read, set the stream's speed +;; to 1 initially (via the initial-speed argument for MAKE-XSTREAM) +;; and later set it to full speed. (The encoding of the runes +;; sequence, you fetch off with READ-RUNE is always UTF-16 though). +;; After switching the encoding, SET-TO-FULL-SPEED can be used to bump the +;; speed up to a full buffer length. + +;; An encoding is simply something, which provides the DECODE-SEQUENCE +;; method. + +;;; Controller protocol +;; +;; READ-OCTECTS sequence os-stream start end -> first-non-written +;; XSTREAM/CLOSE os-stream +;; + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *fast* '(optimize (speed 3) (safety 0)))) + +;; Let us first define fast fixnum arithmetric get rid of type +;; checks. (After all we know what we do here). + +(defmacro fx-op (op &rest xs) + `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))) +(defmacro fx-pred (op &rest xs) + `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))) + +(defmacro %+ (&rest xs) `(fx-op + ,@xs)) +(defmacro %= (&rest xs) `(fx-pred = ,@xs)) + +(deftype buffer-index () + `(unsigned-byte ,(integer-length array-total-size-limit))) + +(deftype buffer-byte () + `(unsigned-byte 16)) + +(deftype octet () + `(unsigned-byte 8)) + +;; The usage of a special marker for EOF is experimental and +;; considered unhygenic. + +(defconstant +end+ #xFFFF + "Special marker inserted into stream buffers to indicate end of buffered data.") + +(defvar +null-buffer+ (make-array 0 :element-type 'buffer-byte)) +(defvar +null-octet-buffer+ (make-array 0 :element-type 'octet)) + +(defstruct (xstream + (:constructor make-xstream/low) + (:copier nil) + (:print-function print-xstream)) + + ;;; Read buffer + + ;; the buffer itself + (buffer +null-buffer+ + :type (simple-array buffer-byte (*))) + ;; points to the next element of `buffer' containing the next rune + ;; about to be read. + (read-ptr 0 :type buffer-index) + ;; points to the first element of `buffer' not containing a rune to + ;; be read. + (fill-ptr 0 :type buffer-index) + + ;;; OS buffer + + ;; a scratch pad for READ-SEQUENCE + (os-buffer +null-octet-buffer+ + :type (simple-array octet (*))) + + ;; `os-left-start', `os-left-end' designate a region of os-buffer, + ;; which still contains some undecoded data. This is needed because + ;; of the DECODE-SEQUENCE protocol + (os-left-start 0 :type buffer-index) + (os-left-end 0 :type buffer-index) + + ;; How much to read each time + (speed 0 :type buffer-index) + (full-speed 0 :type buffer-index) + + ;; Some stream object obeying to a certain protcol + os-stream + + ;; The external format + ;; (some object offering the ENCODING protocol) + (encoding :utf-8) + + ;;A STREAM-NAME object + (name nil) + + ;; a plist a struct keeps the hack away + (plist nil) + + ;; Stream Position + (line-number 1 :type integer) ;current line number + (line-start 0 :type integer) ;stream position the current line starts at + (buffer-start 0 :type integer) ;stream position the current buffer starts at + + ;; There is no need to maintain a column counter for each character + ;; read, since we can easily compute it from `line-start' and + ;; `buffer-start'. + ) + +(defun print-xstream (self sink depth) + (declare (ignore depth)) + (format sink "#<~S ~S>" (type-of self) (xstream-name self))) + +(defmacro read-rune (input) + "Read a single rune off the xstream `input'. In case of end of file :EOF + is returned." + `((lambda (input) + (declare (type xstream input) + #.*fast*) + (let ((rp (xstream-read-ptr input))) + (declare (type buffer-index rp)) + (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input)) + rp))) + (declare (type buffer-byte ch)) + (setf (xstream-read-ptr input) (%+ rp 1)) + (cond ((%= ch +end+) + (the (or (member :eof) rune) + (xstream-underflow input))) + ((%= ch #x000A) ;line break + (account-for-line-break input) + (code-rune ch)) + (t + (code-rune ch)))))) + ,input)) + +(defmacro peek-rune (input) + "Peek a single rune off the xstream `input'. In case of end of file :EOF + is returned." + `((lambda (input) + (declare (type xstream input) + #.*fast*) + (let ((rp (xstream-read-ptr input))) + (declare (type buffer-index rp)) + (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input)) + rp))) + (declare (type buffer-byte ch)) + (cond ((%= ch +end+) + (prog1 + (the (or (member :eof) rune) (xstream-underflow input)) + (setf (xstream-read-ptr input) 0))) + (t + (code-rune ch)))))) + ,input)) + +(defmacro consume-rune (input) + "Like READ-RUNE, but does not actually return the read rune." + `((lambda (input) + (declare (type xstream input) + #.*fast*) + (let ((rp (xstream-read-ptr input))) + (declare (type buffer-index rp)) + (let ((ch (aref (the (simple-array buffer-byte (*)) (xstream-buffer input)) + rp))) + (declare (type buffer-byte ch)) + (setf (xstream-read-ptr input) (%+ rp 1)) + (when (%= ch +end+) + (xstream-underflow input)) + (when (%= ch #x000A) ;line break + (account-for-line-break input) ))) + nil) + ,input)) + +(definline unread-rune (rune input) + "Unread the last recently read rune; if there wasn't such a rune, you + deserve to lose." + (declare (ignore rune)) + (decf (xstream-read-ptr input)) + (when (rune= (peek-rune input) #/u+000A) ;was it a line break? + (unaccount-for-line-break input))) + +(defun fread-rune (input) + (read-rune input)) + +(defun fpeek-rune (input) + (peek-rune input)) + +;;; Line counting + +(defun account-for-line-break (input) + (declare (type xstream input)) + (incf (xstream-line-number input)) + (setf (xstream-line-start input) + (+ (xstream-buffer-start input) (xstream-read-ptr input)))) + +(defun unaccount-for-line-break (input) + ;; incomplete! + ;; We better use a traditional lookahead technique or forbid unread-rune. + (decf (xstream-line-number input))) + +;; User API: + +(defun xstream-position (input) + (+ (xstream-buffer-start input) (xstream-read-ptr input))) + +;; xstream-line-number is structure accessor + +(defun xstream-column-number (input) + (+ (- (xstream-position input) + (xstream-line-start input)) + 1)) + +;;; Underflow + +(defconstant +default-buffer-size+ 100) + +(defmethod xstream-underflow ((input xstream)) + (declare (type xstream input)) + ;; we are about to fill new data into the buffer, so we need to + ;; adjust buffer-start. + (incf (xstream-buffer-start input) + (- (xstream-fill-ptr input) 0)) + (let (n m) + ;; when there is something left in the os-buffer, we move it to + ;; the start of the buffer. + (setf m (- (xstream-os-left-end input) (xstream-os-left-start input))) + (unless (zerop m) + (replace (xstream-os-buffer input) (xstream-os-buffer input) + :start1 0 :end1 m + :start2 (xstream-os-left-start input) + :end2 (xstream-os-left-end input)) + ;; then we take care that the buffer is large enough to carry at + ;; least 100 bytes (a random number) + ;; + ;; David: My understanding is that any number of octets large enough + ;; to record the longest UTF-8 sequence or UTF-16 sequence is okay, + ;; so 100 is plenty for this purpose. + (unless (>= (length (xstream-os-buffer input)) + +default-buffer-size+) + (error "You lost"))) + (setf n + (read-octets (xstream-os-buffer input) (xstream-os-stream input) + m (min (1- (length (xstream-os-buffer input))) + (+ m (xstream-speed input))))) + (cond ((%= n 0) + (setf (xstream-read-ptr input) 0 + (xstream-fill-ptr input) n) + (setf (aref (xstream-buffer input) (xstream-fill-ptr input)) +end+) + :eof) + (t + (multiple-value-bind (fnw fnr) + (runes-encoding:decode-sequence + (xstream-encoding input) + (xstream-os-buffer input) 0 n + (xstream-buffer input) 0 (1- (length (xstream-buffer input))) + (= n m)) + (setf (xstream-os-left-start input) fnr + (xstream-os-left-end input) n + (xstream-read-ptr input) 0 + (xstream-fill-ptr input) fnw) + (setf (aref (xstream-buffer input) (xstream-fill-ptr input)) +end+) + (read-rune input)))))) + +;;; constructor + +(defun make-xstream (os-stream &key name + (speed 8192) + (initial-speed 1) + (initial-encoding :guess)) + ;; XXX if initial-speed isn't 1, encoding will me munged up + (assert (eql initial-speed 1)) + (multiple-value-bind (encoding preread) + (if (eq initial-encoding :guess) + (figure-encoding os-stream) + (values initial-encoding nil)) + (let* ((bufsize (max speed +default-buffer-size+)) + (osbuf (make-array bufsize :element-type '(unsigned-byte 8)))) + (replace osbuf preread) + (make-xstream/low + :buffer (let ((r (make-array bufsize :element-type 'buffer-byte))) + (setf (elt r 0) #xFFFF) + r) + :read-ptr 0 + :fill-ptr 0 + :os-buffer osbuf + :speed initial-speed + :full-speed speed + :os-stream os-stream + :os-left-start 0 + :os-left-end (length preread) + :encoding encoding + :name name)))) + +(defun make-rod-xstream (string &key name) + (unless (typep string 'simple-array) + (setf string (coerce string 'simple-string))) + ;; XXX encoding is mis-handled by this kind of stream + (let ((n (length string))) + (let ((buffer (make-array (1+ n) :element-type 'buffer-byte))) + (declare (type (simple-array buffer-byte (*)) buffer)) + ;; copy the rod + (do ((i (1- n) (- i 1))) + ((< i 0)) + (declare (type fixnum i)) + (setf (aref buffer i) (rune-code (%rune string i)))) + (setf (aref buffer n) +end+) + ;; + (make-xstream/low :buffer buffer + :read-ptr 0 + :fill-ptr n + ;; :os-buffer nil + :speed 1 + :os-stream nil + :name name)))) + +(defmethod figure-encoding ((stream null)) + (values :utf-8 nil)) + +(defmethod figure-encoding ((stream stream)) + (let ((c0 (read-byte stream nil :eof))) + (cond ((eq c0 :eof) + (values :utf-8 nil)) + (t + (let ((c1 (read-byte stream nil :eof))) + (cond ((eq c1 :eof) + (values :utf-8 (list c0))) + (t + (cond ((and (= c0 #xFE) (= c1 #xFF)) (values :utf-16-big-endian nil)) + ((and (= c0 #xFF) (= c1 #xFE)) (values :utf-16-little-endian nil)) + (t + (values :utf-8 (list c0 c1))))))))))) + +;;; misc + +(defun close-xstream (input) + (xstream/close (xstream-os-stream input))) + +(defun set-to-full-speed (xstream) + (setf (xstream-speed xstream) (xstream-full-speed xstream))) + +;;; controller implementations + +(defmethod read-octets (sequence (stream stream) start end) + (#+CLISP ext:read-byte-sequence + #-CLISP read-sequence + sequence stream :start start :end end)) + +#+cmu +(defmethod read-octets :around (sequence (stream stream) start end) + ;; CMUCL <= 19a on non-SunOS accidentally triggers EFAULT in read(2) + ;; if SEQUENCE has been write protected by GC. Workaround: Touch all pages + ;; in SEQUENCE and make sure no GC happens between that and the read(2). + (ext::without-gcing + (loop for i from start below end + do (setf (elt sequence i) (elt sequence i))) + (call-next-method))) + +(defmethod read-octets (sequence (stream null) start end) + (declare (ignore sequence start end)) + 0) + +(defmethod xstream/close ((stream stream)) + (close stream)) + +(defmethod xstream/close ((stream null)) + nil) Added: branches/trunk-reorg/thirdparty/closure-common-2007-10-21/ystream.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/closure-common-2007-10-21/ystream.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,297 @@ +;;; (c) 2005 David Lichteblau <david@lichteblau.com> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; +;;; ystream (for lack of a better name): a rune output "stream" + +(in-package :runes) + +(defconstant +ystream-bufsize+ 1024) + +(defun make-ub8-array (n) + (make-array n :element-type '(unsigned-byte 8))) + +(defun make-ub16-array (n) + (make-array n :element-type '(unsigned-byte 16))) + +(defun make-buffer (&key (element-type '(unsigned-byte 8))) + (make-array 1 + :element-type element-type + :adjustable t + :fill-pointer 0)) + +(defmacro while (test &body body) + `(until (not ,test) ,@body)) + +(defmacro until (test &body body) + `(do () (,test) ,@body)) + +;;; ystream +;;; +- utf8-ystream +;;; | +- octet-vector-ystream +;;; | \- %stream-ystream +;;; | +- octet-stream-ystream +;;; | \- character-stream-ystream/utf8 +;;; | \- string-ystream/utf8 +;;; +- rod-ystream +;;; \-- character-stream-ystream + +(defstruct ystream + (column 0 :type integer) + (in-ptr 0 :type fixnum) + (in-buffer (make-rod +ystream-bufsize+) :type simple-rod)) + +(defstruct (utf8-ystream + (:include ystream) + (:conc-name "YSTREAM-")) + (out-buffer (make-ub8-array (* 6 +ystream-bufsize+)) + :type (simple-array (unsigned-byte 8) (*)))) + +(defstruct (%stream-ystream (:include utf8-ystream) (:conc-name "YSTREAM-")) + (os-stream nil)) + +(definline write-rune (rune ystream) + (let ((in (ystream-in-buffer ystream))) + (when (eql (ystream-in-ptr ystream) (length in)) + (flush-ystream ystream) + (setf in (ystream-in-buffer ystream))) + (setf (elt in (ystream-in-ptr ystream)) rune) + (incf (ystream-in-ptr ystream)) + (setf (ystream-column ystream) + (if (eql rune #/U+0010) 0 (1+ (ystream-column ystream)))) + rune)) + +(defmethod close-ystream :before ((ystream ystream)) + (flush-ystream ystream)) + + +;;;; UTF8-YSTREAM (abstract) + +(defmethod close-ystream ((ystream %stream-ystream)) + (ystream-os-stream ystream)) + +(defgeneric ystream-device-write (ystream buf nbytes)) + +(defmethod flush-ystream ((ystream utf8-ystream)) + (let ((ptr (ystream-in-ptr ystream))) + (when (plusp ptr) + (let* ((in (ystream-in-buffer ystream)) + (out (ystream-out-buffer ystream)) + (surrogatep (<= #xD800 (rune-code (elt in (1- ptr))) #xDBFF)) + n) + (when surrogatep + (decf ptr)) + (when (plusp ptr) + (setf n (runes-to-utf8 out in ptr)) + (ystream-device-write ystream out n) + (cond + (surrogatep + (setf (elt in 0) (elt in (1- ptr))) + (setf (ystream-in-ptr ystream) 1)) + (t + (setf (ystream-in-ptr ystream) 0)))))))) + +(defun write-rod (rod sink) + (loop for rune across rod do (write-rune rune sink))) + +(defun fast-push (new-element vector) + (vector-push-extend new-element vector (max 1 (array-dimension vector 0)))) + +(macrolet ((define-utf8-writer (name (byte &rest aux) result &body body) + `(defun ,name (out in n) + (let ((high-surrogate nil) + ,@aux) + (labels + ((write0 (,byte) + ,@body) + (write1 (r) + (cond + ((<= #x00000000 r #x0000007F) + (write0 r)) + ((<= #x00000080 r #x000007FF) + (write0 (logior #b11000000 (ldb (byte 5 6) r))) + (write0 (logior #b10000000 (ldb (byte 6 0) r)))) + ((<= #x00000800 r #x0000FFFF) + (write0 (logior #b11100000 (ldb (byte 4 12) r))) + (write0 (logior #b10000000 (ldb (byte 6 6) r))) + (write0 (logior #b10000000 (ldb (byte 6 0) r)))) + ((<= #x00010000 r #x001FFFFF) + (write0 (logior #b11110000 (ldb (byte 3 18) r))) + (write0 (logior #b10000000 (ldb (byte 6 12) r))) + (write0 (logior #b10000000 (ldb (byte 6 6) r))) + (write0 (logior #b10000000 (ldb (byte 6 0) r)))) + ((<= #x00200000 r #x03FFFFFF) + (write0 (logior #b11111000 (ldb (byte 2 24) r))) + (write0 (logior #b10000000 (ldb (byte 6 18) r))) + (write0 (logior #b10000000 (ldb (byte 6 12) r))) + (write0 (logior #b10000000 (ldb (byte 6 6) r))) + (write0 (logior #b10000000 (ldb (byte 6 0) r)))) + ((<= #x04000000 r #x7FFFFFFF) + (write0 (logior #b11111100 (ldb (byte 1 30) r))) + (write0 (logior #b10000000 (ldb (byte 6 24) r))) + (write0 (logior #b10000000 (ldb (byte 6 18) r))) + (write0 (logior #b10000000 (ldb (byte 6 12) r))) + (write0 (logior #b10000000 (ldb (byte 6 6) r))) + (write0 (logior #b10000000 (ldb (byte 6 0) r)))))) + (write2 (r) + (cond + ((<= #xD800 r #xDBFF) + (setf high-surrogate r)) + ((<= #xDC00 r #xDFFF) + (let ((q (logior (ash (- high-surrogate #xD7C0) 10) + (- r #xDC00)))) + (write1 q)) + (setf high-surrogate nil)) + (t + (write1 r))))) + (dotimes (j n) + (write2 (rune-code (elt in j))))) + ,result)))) + (define-utf8-writer runes-to-utf8 (x (i 0)) + i + (setf (elt out i) x) + (incf i)) + (define-utf8-writer runes-to-utf8/adjustable-string (x) + nil + (fast-push (code-char x) out))) + + +;;;; ROD-YSTREAM + +(defstruct (rod-ystream (:include ystream))) + +(defmethod flush-ystream ((ystream rod-ystream)) + (let* ((old (ystream-in-buffer ystream)) + (new (make-rod (* 2 (length old))))) + (replace new old) + (setf (ystream-in-buffer ystream) new))) + +(defmethod close-ystream ((ystream rod-ystream)) + (subseq (ystream-in-buffer ystream) 0 (ystream-in-ptr ystream))) + + +;;;; CHARACTER-STREAM-YSTREAM + +#+rune-is-character +(progn + (defstruct (character-stream-ystream + (:constructor make-character-stream-ystream (target-stream)) + (:include ystream) + (:conc-name "YSTREAM-")) + (target-stream nil)) + + (defmethod flush-ystream ((ystream character-stream-ystream)) + (write-string (ystream-in-buffer ystream) + (ystream-target-stream ystream) + :end (ystream-in-ptr ystream)) + (setf (ystream-in-ptr ystream) 0)) + + (defmethod close-ystream ((ystream character-stream-ystream)) + (ystream-target-stream ystream))) + + +;;;; OCTET-VECTOR-YSTREAM + +(defstruct (octet-vector-ystream + (:include utf8-ystream) + (:conc-name "YSTREAM-")) + (result (make-buffer))) + +(defmethod ystream-device-write ((ystream octet-vector-ystream) buf nbytes) + (let* ((result (ystream-result ystream)) + (start (length result)) + (size (array-dimension result 0))) + (while (> (+ start nbytes) size) + (setf size (* 2 size))) + (adjust-array result size :fill-pointer (+ start nbytes)) + (replace result buf :start1 start :end2 nbytes))) + +(defmethod close-ystream ((ystream octet-vector-ystream)) + (ystream-result ystream)) + + +;;;; OCTET-STREAM-YSTREAM + +(defstruct (octet-stream-ystream + (:include %stream-ystream) + (:constructor make-octet-stream-ystream (os-stream)) + (:conc-name "YSTREAM-"))) + +(defmethod ystream-device-write ((ystream octet-stream-ystream) buf nbytes) + (write-sequence buf (ystream-os-stream ystream) :end nbytes)) + + +;;;; CHARACTER-STREAM-YSTREAM/UTF8 + +;; #+rune-is-integer +(progn + (defstruct (character-stream-ystream/utf8 + (:constructor make-character-stream-ystream/utf8 (os-stream)) + (:include %stream-ystream) + (:conc-name "YSTREAM-"))) + + (defmethod ystream-device-write + ((ystream character-stream-ystream/utf8) buf nbytes) + (declare (type (simple-array (unsigned-byte 8) (*)) buf)) + (let ((out (ystream-os-stream ystream))) + (dotimes (x nbytes) + (write-char (code-char (elt buf x)) out))))) + + +;;;; STRING-YSTREAM/UTF8 + +;; #+rune-is-integer +(progn + (defstruct (string-ystream/utf8 + (:include character-stream-ystream/utf8 + (os-stream (make-string-output-stream))) + (:conc-name "YSTREAM-"))) + + (defmethod close-ystream ((ystream string-ystream/utf8)) + (get-output-stream-string (ystream-os-stream ystream)))) + + +;;;; helper functions + +(defun rod-to-utf8-string (rod) + (let ((out (make-buffer :element-type 'character))) + (runes-to-utf8/adjustable-string out rod (length rod)) + out)) + +(defun utf8-string-to-rod (str) + (let* ((bytes (map '(vector (unsigned-byte 8)) #'char-code str)) + (buffer (make-array (length bytes) :element-type '(unsigned-byte 16))) + (n (runes-encoding:decode-sequence + :utf-8 bytes 0 (length bytes) buffer 0 0 nil)) + (result (make-array n :element-type 'rune))) + (map-into result #'code-rune buffer) + result)) + +(defclass octet-input-stream + (trivial-gray-stream-mixin fundamental-binary-input-stream) + ((octets :initarg :octets) + (pos :initform 0))) + +(defmethod close ((stream octet-input-stream) &key abort) + (declare (ignore abort)) + (open-stream-p stream)) + +(defmethod stream-read-byte ((stream octet-input-stream)) + (with-slots (octets pos) stream + (if (>= pos (length octets)) + :eof + (prog1 + (elt octets pos) + (incf pos))))) + +(defmethod stream-read-sequence + ((stream octet-input-stream) sequence start end &key &allow-other-keys) + (with-slots (octets pos) stream + (let* ((length (min (- end start) (- (length octets) pos))) + (end1 (+ start length)) + (end2 (+ pos length))) + (replace sequence octets :start1 start :end1 end1 :start2 pos :end2 end2) + (setf pos end2) + end1))) + +(defun make-octet-input-stream (octets) + (make-instance 'octet-input-stream :octets octets)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/COPYING ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/COPYING Sun Feb 17 09:26:33 2008 @@ -0,0 +1,526 @@ +Closure XML -- a Common Lisp XML parser + +Copyright (c) 1999 by Gilbert Baumann +Copyright (c) 2003 by Henrik Motakef +Copyright (c) 2004 knowledgeTools Int. GmbH +Copyright (c) 2004,2005 David Lichteblau + +Preamble to the Gnu Lesser General Public License + +The concept of the GNU Lesser General Public License version 2.1 +("LGPL") has been adopted to govern the use and distribution of +above-mentioned application. However, the LGPL uses terminology that is +more appropriate for a program written in C than one written in +Lisp. Nevertheless, the LGPL can still be applied to a Lisp program if +certain clarifications are made. This document details those +clarifications. Accordingly, the license for the open-source Lisp +applications consists of this document plus the LGPL. Wherever there is +a conflict between this document and the LGPL, this document takes +precedence over the LGPL. + +A "Library" in Lisp is a collection of Lisp functions, data and foreign +modules. The form of the Library can be Lisp source code (for processing +by an interpreter) or object code (usually the result of compilation of +source code or built with some other mechanisms). Foreign modules are +object code in a form that can be linked into a Lisp executable. When we +speak of functions we do so in the most general way to include, in +addition, methods and unnamed functions. Lisp "data" is also a general +term that includes the data structures resulting from defining Lisp +classes. A Lisp application may include the same set of Lisp objects as +does a Library, but this does not mean that the application is +necessarily a "work based on the Library" it contains. + +The Library consists of everything in the distribution file set before +any modifications are made to the files. If any of the functions or +classes in the Library are redefined in other files, then those +redefinitions ARE considered a work based on the Library. If additional +methods are added to generic functions in the Library, those additional +methods are NOT considered a work based on the Library. If Library +classes are subclassed, these subclasses are NOT considered a work based +on the Library. If the Library is modified to explicitly call other +functions that are neither part of Lisp itself nor an available add-on +module to Lisp, then the functions called by the modified Library ARE +considered a work based on the Library. The goal is to ensure that the +Library will compile and run without getting undefined function errors. + +It is permitted to add proprietary source code to the Library, but it +must be done in a way such that the Library will still run without that +proprietary code present. Section 5 of the LGPL distinguishes between +the case of a library being dynamically linked at runtime and one being +statically linked at build time. Section 5 of the LGPL states that the +former results in an executable that is a "work that uses the Library." +Section 5 of the LGPL states that the latter results in one that is a +"derivative of the Library", which is therefore covered by the +LGPL. Since Lisp only offers one choice, which is to link the Library +into an executable at build time, we declare that, for the purpose +applying the LGPL to the Library, an executable that results from +linking a "work that uses the Library" with the Library is considered a +"work that uses the Library" and is therefore NOT covered by the LGPL. + +Because of this declaration, section 6 of LGPL is not applicable to the +Library. However, in connection with each distribution of this +executable, you must also deliver, in accordance with the terms and +conditions of the LGPL, the source code of Library (or your derivative +thereof) that is incorporated into this executable. + +End of Document +------------------------------------------------------------------------ + GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +[This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.] + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser General Public License from time to time. +Such new versions will be similar in spirit to the present version, +but may differ in detail to address new problems or concerns. + +Each version is given a distinguishing version number. If the Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY +KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU +FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR +CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE +LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING +RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A +FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/DOMTEST ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/DOMTEST Sun Feb 17 09:26:33 2008 @@ -0,0 +1,840 @@ + +#P"/home/david/2001/DOM-Test-Suite/tests/level1/core/" +0/806 attrcreatedocumentfragment.xml +1/806 attrcreatetextnode.xml +2/806 attrcreatetextnode2.xml +3/806 attrdefaultvalue.xml +4/806 attreffectivevalue.xml +5/806 attrentityreplacement.xml +6/806 attrname.xml +7/806 attrnextsiblingnull.xml +8/806 attrnotspecifiedvalue.xml +9/806 attrparentnodenull.xml +10/806 attrprevioussiblingnull.xml +11/806 attrsetvaluenomodificationallowederr.xml +implementationAttribute expandEntityReferences not supported, skipping test +12/806 attrsetvaluenomodificationallowederrEE.xml +13/806 attrspecifiedvalue.xml +14/806 attrspecifiedvaluechanged.xml +15/806 attrspecifiedvalueremove.xml +16/806 cdatasectiongetdata.xml +implementationAttribute coalescing not supported, skipping test +17/806 cdatasectionnormalize.xml +18/806 characterdataappenddata.xml +19/806 characterdataappenddatagetdata.xml +20/806 characterdataappenddatanomodificationallowederr.xml +21/806 characterdataappenddatanomodificationallowederrEE.xml +22/806 characterdatadeletedatabegining.xml +23/806 characterdatadeletedataend.xml +24/806 characterdatadeletedataexceedslength.xml +25/806 characterdatadeletedatagetlengthanddata.xml +26/806 characterdatadeletedatamiddle.xml +27/806 characterdatadeletedatanomodificationallowederrEE.xml +28/806 characterdatagetdata.xml +29/806 characterdatagetlength.xml +30/806 characterdataindexsizeerrdeletedatacountnegative.xml +implementationAttribute signed not supported, skipping test +31/806 characterdataindexsizeerrdeletedataoffsetgreater.xml +32/806 characterdataindexsizeerrdeletedataoffsetnegative.xml +implementationAttribute signed not supported, skipping test +33/806 characterdataindexsizeerrinsertdataoffsetgreater.xml +34/806 characterdataindexsizeerrinsertdataoffsetnegative.xml +implementationAttribute signed not supported, skipping test +35/806 characterdataindexsizeerrreplacedatacountnegative.xml +implementationAttribute signed not supported, skipping test +36/806 characterdataindexsizeerrreplacedataoffsetgreater.xml +37/806 characterdataindexsizeerrreplacedataoffsetnegative.xml +implementationAttribute signed not supported, skipping test +38/806 characterdataindexsizeerrsubstringcountnegative.xml +implementationAttribute signed not supported, skipping test +39/806 characterdataindexsizeerrsubstringnegativeoffset.xml +implementationAttribute signed not supported, skipping test +40/806 characterdataindexsizeerrsubstringoffsetgreater.xml +41/806 characterdatainsertdatabeginning.xml +42/806 characterdatainsertdataend.xml +43/806 characterdatainsertdatamiddle.xml +44/806 characterdatainsertdatanomodificationallowederr.xml +45/806 characterdatainsertdatanomodificationallowederrEE.xml +46/806 characterdatareplacedatabegining.xml +47/806 characterdatareplacedataend.xml +48/806 characterdatareplacedataexceedslengthofarg.xml +49/806 characterdatareplacedataexceedslengthofdata.xml +50/806 characterdatareplacedatamiddle.xml +51/806 characterdatareplacedatanomodificationallowederr.xml +52/806 characterdatareplacedatanomodificationallowederrEE.xml +53/806 characterdatasetdatanomodificationallowederr.xml +54/806 characterdatasetdatanomodificationallowederrEE.xml +55/806 characterdatasetnodevalue.xml +56/806 characterdatasubstringexceedsvalue.xml +57/806 characterdatasubstringvalue.xml +58/806 commentgetcomment.xml +59/806 documentcreateattribute.xml +60/806 documentcreatecdatasection.xml +61/806 documentcreatecomment.xml +62/806 documentcreatedocumentfragment.xml +63/806 documentcreateelement.xml +64/806 documentcreateelementcasesensitive.xml +65/806 documentcreateelementdefaultattr.xml +66/806 documentcreateentityreference.xml +67/806 documentcreateentityreferenceknown.xml +68/806 documentcreateprocessinginstruction.xml +69/806 documentcreatetextnode.xml +70/806 documentgetdoctype.xml +71/806 documentgetdoctypenodtd.xml +72/806 documentgetelementsbytagnamelength.xml +73/806 documentgetelementsbytagnametotallength.xml +74/806 documentgetelementsbytagnamevalue.xml +75/806 documentgetimplementation.xml +76/806 documentgetrootnode.xml +77/806 documentinvalidcharacterexceptioncreateattribute.xml +78/806 documentinvalidcharacterexceptioncreateelement.xml +79/806 documentinvalidcharacterexceptioncreateentref.xml +80/806 documentinvalidcharacterexceptioncreateentref1.xml +81/806 documentinvalidcharacterexceptioncreatepi.xml +82/806 documentinvalidcharacterexceptioncreatepi1.xml +83/806 documenttypegetdoctype.xml +84/806 documenttypegetentities.xml +85/806 documenttypegetentitieslength.xml +86/806 documenttypegetentitiestype.xml +87/806 documenttypegetnotations.xml +88/806 documenttypegetnotationstype.xml +89/806 domimplementationfeaturenoversion.xml +90/806 domimplementationfeaturenull.xml +implementationAttribute hasNullString not supported, skipping test +91/806 domimplementationfeaturexml.xml +92/806 elementaddnewattribute.xml +93/806 elementassociatedattribute.xml +94/806 elementchangeattributevalue.xml +95/806 elementcreatenewattribute.xml +96/806 elementgetattributenode.xml +97/806 elementgetattributenodenull.xml +98/806 elementgetelementempty.xml +99/806 elementgetelementsbytagname.xml +100/806 elementgetelementsbytagnameaccessnodelist.xml +101/806 elementgetelementsbytagnamenomatch.xml +102/806 elementgetelementsbytagnamespecialvalue.xml +103/806 elementgettagname.xml +104/806 elementinuseattributeerr.xml +105/806 elementinvalidcharacterexception.xml +106/806 elementnormalize.xml +107/806 elementnotfounderr.xml +108/806 elementremoveattribute.xml +109/806 elementremoveattributeaftercreate.xml +110/806 elementremoveattributenode.xml +111/806 elementremoveattributenodenomodificationallowederr.xml +112/806 elementremoveattributenodenomodificationallowederrEE.xml +113/806 elementremoveattributenomodificationallowederr.xml +114/806 elementremoveattributenomodificationallowederrEE.xml +115/806 elementremoveattributerestoredefaultvalue.xml +116/806 elementreplaceattributewithself.xml +117/806 elementreplaceexistingattribute.xml +118/806 elementreplaceexistingattributegevalue.xml +119/806 elementretrieveallattributes.xml +120/806 elementretrieveattrvalue.xml +121/806 elementretrievetagname.xml +122/806 elementsetattributenodenomodificationallowederr.xml +123/806 elementsetattributenodenomodificationallowederrEE.xml +implementationAttribute expandEntityReferences not supported, skipping test +124/806 elementsetattributenodenull.xml +125/806 elementsetattributenomodificationallowederr.xml +implementationAttribute expandEntityReferences not supported, skipping test +126/806 elementsetattributenomodificationallowederrEE.xml +127/806 elementwrongdocumenterr.xml +128/806 entitygetentityname.xml +129/806 entitygetpublicid.xml +130/806 entitygetpublicidnull.xml +131/806 namednodemapchildnoderange.xml +132/806 namednodemapgetnameditem.xml +133/806 namednodemapinuseattributeerr.xml +134/806 namednodemapnotfounderr.xml +135/806 namednodemapnumberofnodes.xml +136/806 namednodemapremovenameditem.xml +137/806 namednodemapremovenameditemgetvalue.xml +138/806 namednodemapremovenameditemreturnnodevalue.xml +139/806 namednodemapreturnattrnode.xml +140/806 namednodemapreturnfirstitem.xml +141/806 namednodemapreturnlastitem.xml +142/806 namednodemapreturnnull.xml +143/806 namednodemapsetnameditem.xml +144/806 namednodemapsetnameditemreturnvalue.xml +145/806 namednodemapsetnameditemthatexists.xml +146/806 namednodemapsetnameditemwithnewvalue.xml +147/806 namednodemapwrongdocumenterr.xml +148/806 nodeappendchild.xml +149/806 nodeappendchildchildexists.xml +150/806 nodeappendchilddocfragment.xml +151/806 nodeappendchildgetnodename.xml +152/806 nodeappendchildinvalidnodetype.xml +153/806 nodeappendchildnewchilddiffdocument.xml +154/806 nodeappendchildnodeancestor.xml +155/806 nodeappendchildnomodificationallowederr.xml +156/806 nodeappendchildnomodificationallowederrEE.xml +157/806 nodeattributenodeattribute.xml +158/806 nodeattributenodename.xml +159/806 nodeattributenodetype.xml +160/806 nodeattributenodevalue.xml +161/806 nodecdatasectionnodeattribute.xml +162/806 nodecdatasectionnodename.xml +163/806 nodecdatasectionnodetype.xml +implementationAttribute coalescing not supported, skipping test +164/806 nodecdatasectionnodevalue.xml +implementationAttribute coalescing not supported, skipping test +165/806 nodechildnodes.xml +166/806 nodechildnodesappendchild.xml +167/806 nodechildnodesempty.xml +168/806 nodecloneattributescopied.xml +169/806 nodeclonefalsenocopytext.xml +170/806 nodeclonegetparentnull.xml +171/806 nodeclonenodefalse.xml +172/806 nodeclonenodetrue.xml +173/806 nodeclonetruecopytext.xml +174/806 nodecommentnodeattributes.xml +175/806 nodecommentnodename.xml +176/806 nodecommentnodetype.xml +177/806 nodecommentnodevalue.xml +178/806 nodedocumentfragmentnodename.xml +179/806 nodedocumentfragmentnodetype.xml +180/806 nodedocumentfragmentnodevalue.xml +181/806 nodedocumentnodeattribute.xml +182/806 nodedocumentnodename.xml +183/806 nodedocumentnodetype.xml +184/806 nodedocumentnodevalue.xml +185/806 nodedocumenttypenodename.xml +186/806 nodedocumenttypenodetype.xml +187/806 nodedocumenttypenodevalue.xml +188/806 nodeelementnodeattributes.xml +189/806 nodeelementnodename.xml +190/806 nodeelementnodetype.xml +191/806 nodeelementnodevalue.xml +192/806 nodeentitynodeattributes.xml +193/806 nodeentitynodename.xml +194/806 nodeentitynodetype.xml +195/806 nodeentitynodevalue.xml +196/806 nodeentitysetnodevalue.xml +197/806 nodeentityreferencenodeattributes.xml +198/806 nodeentityreferencenodename.xml +199/806 nodeentityreferencenodetype.xml +200/806 nodeentityreferencenodevalue.xml +201/806 nodegetfirstchild.xml +202/806 nodegetfirstchildnull.xml +203/806 nodegetlastchild.xml +204/806 nodegetlastchildnull.xml +205/806 nodegetnextsibling.xml +206/806 nodegetnextsiblingnull.xml +207/806 nodegetownerdocument.xml +208/806 nodegetownerdocumentnull.xml +209/806 nodegetprevioussibling.xml +210/806 nodegetprevioussiblingnull.xml +211/806 nodehaschildnodes.xml +212/806 nodehaschildnodesfalse.xml +213/806 nodeinsertbefore.xml +214/806 nodeinsertbeforedocfragment.xml +215/806 nodeinsertbeforeinvalidnodetype.xml +216/806 nodeinsertbeforenewchilddiffdocument.xml +217/806 nodeinsertbeforenewchildexists.xml +218/806 nodeinsertbeforenodeancestor.xml +219/806 nodeinsertbeforenodename.xml +220/806 nodeinsertbeforenomodificationallowederr.xml +221/806 nodeinsertbeforenomodificationallowederrEE.xml +222/806 nodeinsertbeforerefchildnonexistent.xml +223/806 nodeinsertbeforerefchildnull.xml +224/806 nodelistindexequalzero.xml +225/806 nodelistindexgetlength.xml +226/806 nodelistindexgetlengthofemptylist.xml +227/806 nodelistindexnotzero.xml +228/806 nodelistreturnfirstitem.xml +229/806 nodelistreturnlastitem.xml +230/806 nodelisttraverselist.xml +231/806 nodenotationnodeattributes.xml +232/806 nodenotationnodename.xml +233/806 nodenotationnodetype.xml +234/806 nodenotationnodevalue.xml +235/806 nodeparentnode.xml +236/806 nodeparentnodenull.xml +237/806 nodeprocessinginstructionnodeattributes.xml +238/806 nodeprocessinginstructionnodename.xml +239/806 nodeprocessinginstructionnodetype.xml +240/806 nodeprocessinginstructionnodevalue.xml +241/806 nodeprocessinginstructionsetnodevalue.xml +242/806 noderemovechild.xml +243/806 noderemovechildgetnodename.xml +244/806 noderemovechildnode.xml +245/806 noderemovechildnomodificationallowederr.xml +246/806 noderemovechildnomodificationallowederrEE.xml +247/806 noderemovechildoldchildnonexistent.xml +248/806 nodereplacechild.xml +249/806 nodereplacechildinvalidnodetype.xml +250/806 nodereplacechildnewchilddiffdocument.xml +251/806 nodereplacechildnewchildexists.xml +252/806 nodereplacechildnodeancestor.xml +253/806 nodereplacechildnodename.xml +254/806 nodereplacechildnomodificationallowederr.xml +255/806 nodereplacechildnomodificationallowederrEE.xml +256/806 nodereplacechildoldchildnonexistent.xml +257/806 nodesetnodevaluenomodificationallowederr.xml +258/806 nodesetnodevaluenomodificationallowederrEE.xml +259/806 nodetextnodeattribute.xml +260/806 nodetextnodename.xml +261/806 nodetextnodetype.xml +262/806 nodetextnodevalue.xml +263/806 notationgetnotationname.xml +264/806 notationgetpublicid.xml +265/806 notationgetpublicidnull.xml +266/806 notationgetsystemid.xml +267/806 notationgetsystemidnull.xml +268/806 processinginstructiongetdata.xml +269/806 processinginstructiongettarget.xml +270/806 processinginstructionsetdatanomodificationallowederr.xml +implementationAttribute expandEntityReferences not supported, skipping test +271/806 processinginstructionsetdatanomodificationallowederrEE.xml +272/806 textindexsizeerrnegativeoffset.xml +implementationAttribute signed not supported, skipping test +273/806 textindexsizeerroffsetoutofbounds.xml +274/806 textparseintolistofelements.xml +275/806 textsplittextfour.xml +276/806 textsplittextnomodificationallowederr.xml +277/806 textsplittextnomodificationallowederrEE.xml +278/806 textsplittextone.xml +279/806 textsplittextthree.xml +280/806 textsplittexttwo.xml +281/806 textwithnomarkup.xml +282/806 nodevalue01.xml +283/806 nodevalue02.xml +284/806 nodevalue03.xml +285/806 nodevalue04.xml +286/806 nodevalue05.xml +287/806 nodevalue06.xml +288/806 nodevalue07.xml +289/806 nodevalue08.xml +290/806 nodevalue09.xml +291/806 hc_attrcreatedocumentfragment.xml +292/806 hc_attrcreatetextnode.xml +293/806 hc_attrcreatetextnode2.xml +294/806 hc_attreffectivevalue.xml +295/806 hc_attrname.xml +296/806 hc_attrnextsiblingnull.xml +297/806 hc_attrparentnodenull.xml +298/806 hc_attrprevioussiblingnull.xml +299/806 hc_attrspecifiedvalue.xml +300/806 hc_attrspecifiedvaluechanged.xml +301/806 hc_characterdataappenddata.xml +302/806 hc_characterdataappenddatagetdata.xml +303/806 hc_characterdatadeletedatabegining.xml +304/806 hc_characterdatadeletedataend.xml +305/806 hc_characterdatadeletedataexceedslength.xml +306/806 hc_characterdatadeletedatagetlengthanddata.xml +307/806 hc_characterdatadeletedatamiddle.xml +308/806 hc_characterdatagetdata.xml +309/806 hc_characterdatagetlength.xml +310/806 hc_characterdataindexsizeerrdeletedatacountnegative.xml +implementationAttribute signed not supported, skipping test +311/806 hc_characterdataindexsizeerrdeletedataoffsetgreater.xml +312/806 hc_characterdataindexsizeerrdeletedataoffsetnegative.xml +implementationAttribute signed not supported, skipping test +313/806 hc_characterdataindexsizeerrinsertdataoffsetgreater.xml +314/806 hc_characterdataindexsizeerrinsertdataoffsetnegative.xml +implementationAttribute signed not supported, skipping test +315/806 hc_characterdataindexsizeerrreplacedatacountnegative.xml +implementationAttribute signed not supported, skipping test +316/806 hc_characterdataindexsizeerrreplacedataoffsetgreater.xml +317/806 hc_characterdataindexsizeerrreplacedataoffsetnegative.xml +implementationAttribute signed not supported, skipping test +318/806 hc_characterdataindexsizeerrsubstringcountnegative.xml +implementationAttribute signed not supported, skipping test +319/806 hc_characterdataindexsizeerrsubstringnegativeoffset.xml +implementationAttribute signed not supported, skipping test +320/806 hc_characterdataindexsizeerrsubstringoffsetgreater.xml +321/806 hc_characterdatainsertdatabeginning.xml +322/806 hc_characterdatainsertdataend.xml +323/806 hc_characterdatainsertdatamiddle.xml +324/806 hc_characterdatareplacedatabegining.xml +325/806 hc_characterdatareplacedataend.xml +326/806 hc_characterdatareplacedataexceedslengthofarg.xml +327/806 hc_characterdatareplacedataexceedslengthofdata.xml +328/806 hc_characterdatareplacedatamiddle.xml +329/806 hc_characterdatasetnodevalue.xml +330/806 hc_characterdatasubstringexceedsvalue.xml +331/806 hc_characterdatasubstringvalue.xml +332/806 hc_commentgetcomment.xml +333/806 hc_documentcreateattribute.xml +334/806 hc_documentcreatecomment.xml +335/806 hc_documentcreatedocumentfragment.xml +336/806 hc_documentcreateelement.xml +337/806 hc_documentcreateelementcasesensitive.xml +338/806 hc_documentcreatetextnode.xml +339/806 hc_documentgetdoctype.xml +340/806 hc_documentgetelementsbytagnamelength.xml +341/806 hc_documentgetelementsbytagnametotallength.xml +342/806 hc_documentgetelementsbytagnamevalue.xml +343/806 hc_documentgetimplementation.xml +344/806 hc_documentgetrootnode.xml +345/806 hc_documentinvalidcharacterexceptioncreateattribute.xml +346/806 hc_documentinvalidcharacterexceptioncreateattribute1.xml +347/806 hc_documentinvalidcharacterexceptioncreateelement.xml +348/806 hc_documentinvalidcharacterexceptioncreateelement1.xml +349/806 hc_domimplementationfeaturenoversion.xml +350/806 hc_domimplementationfeaturenull.xml +implementationAttribute hasNullString not supported, skipping test +351/806 hc_domimplementationfeaturexml.xml +352/806 hc_elementaddnewattribute.xml +353/806 hc_elementassociatedattribute.xml +354/806 hc_elementchangeattributevalue.xml +355/806 hc_elementcreatenewattribute.xml +356/806 hc_elementgetattributenode.xml +357/806 hc_elementgetattributenodenull.xml +358/806 hc_elementgetelementempty.xml +359/806 hc_elementgetelementsbytagname.xml +360/806 hc_elementgetelementsbytagnameaccessnodelist.xml +361/806 hc_elementgetelementsbytagnamenomatch.xml +362/806 hc_elementgetelementsbytagnamespecialvalue.xml +363/806 hc_elementgettagname.xml +364/806 hc_elementinuseattributeerr.xml +365/806 hc_elementinvalidcharacterexception.xml +366/806 hc_elementinvalidcharacterexception1.xml +367/806 hc_elementnormalize.xml +368/806 hc_elementnotfounderr.xml +369/806 hc_elementremoveattribute.xml +370/806 hc_elementremoveattributeaftercreate.xml +371/806 hc_elementremoveattributenode.xml +372/806 hc_elementreplaceattributewithself.xml +373/806 hc_elementreplaceexistingattribute.xml +374/806 hc_elementreplaceexistingattributegevalue.xml +375/806 hc_elementretrieveallattributes.xml +376/806 hc_elementretrieveattrvalue.xml +377/806 hc_elementretrievetagname.xml +378/806 hc_elementsetattributenodenull.xml +379/806 hc_elementwrongdocumenterr.xml +380/806 hc_entitiesremovenameditem1.xml +381/806 hc_entitiessetnameditem1.xml +382/806 hc_namednodemapchildnoderange.xml +383/806 hc_namednodemapgetnameditem.xml +384/806 hc_namednodemapinuseattributeerr.xml +385/806 hc_namednodemapnotfounderr.xml +386/806 hc_namednodemapnumberofnodes.xml +387/806 hc_namednodemapremovenameditem.xml +388/806 hc_namednodemapreturnattrnode.xml +389/806 hc_namednodemapreturnfirstitem.xml +390/806 hc_namednodemapreturnlastitem.xml +391/806 hc_namednodemapreturnnull.xml +392/806 hc_namednodemapsetnameditem.xml +393/806 hc_namednodemapsetnameditemreturnvalue.xml +394/806 hc_namednodemapsetnameditemthatexists.xml +395/806 hc_namednodemapsetnameditemwithnewvalue.xml +396/806 hc_namednodemapwrongdocumenterr.xml +397/806 hc_nodeappendchild.xml +398/806 hc_nodeappendchildchildexists.xml +399/806 hc_nodeappendchilddocfragment.xml +400/806 hc_nodeappendchildgetnodename.xml +401/806 hc_nodeappendchildinvalidnodetype.xml +402/806 hc_nodeappendchildnewchilddiffdocument.xml +403/806 hc_nodeappendchildnodeancestor.xml +404/806 hc_nodeattributenodeattribute.xml +405/806 hc_nodeattributenodename.xml +406/806 hc_nodeattributenodetype.xml +407/806 hc_nodeattributenodevalue.xml +408/806 hc_nodechildnodes.xml +409/806 hc_nodechildnodesappendchild.xml +410/806 hc_nodechildnodesempty.xml +411/806 hc_nodecloneattributescopied.xml +412/806 hc_nodeclonefalsenocopytext.xml +413/806 hc_nodeclonegetparentnull.xml +414/806 hc_nodeclonenodefalse.xml +415/806 hc_nodeclonenodetrue.xml +416/806 hc_nodeclonetruecopytext.xml +417/806 hc_nodecommentnodeattributes.xml +418/806 hc_nodecommentnodename.xml +419/806 hc_nodecommentnodetype.xml +420/806 hc_nodecommentnodevalue.xml +421/806 hc_nodedocumentfragmentnodename.xml +422/806 hc_nodedocumentfragmentnodetype.xml +423/806 hc_nodedocumentfragmentnodevalue.xml +424/806 hc_nodedocumentnodeattribute.xml +425/806 hc_nodedocumentnodename.xml +426/806 hc_nodedocumentnodetype.xml +427/806 hc_nodedocumentnodevalue.xml +428/806 hc_nodeelementnodeattributes.xml +429/806 hc_nodeelementnodename.xml +430/806 hc_nodeelementnodetype.xml +431/806 hc_nodeelementnodevalue.xml +432/806 hc_nodegetfirstchild.xml +433/806 hc_nodegetfirstchildnull.xml +434/806 hc_nodegetlastchild.xml +435/806 hc_nodegetlastchildnull.xml +436/806 hc_nodegetnextsibling.xml +437/806 hc_nodegetnextsiblingnull.xml +438/806 hc_nodegetownerdocument.xml +439/806 hc_nodegetownerdocumentnull.xml +440/806 hc_nodegetprevioussibling.xml +441/806 hc_nodegetprevioussiblingnull.xml +442/806 hc_nodehaschildnodes.xml +443/806 hc_nodehaschildnodesfalse.xml +444/806 hc_nodeinsertbefore.xml +445/806 hc_nodeinsertbeforedocfragment.xml +446/806 hc_nodeinsertbeforeinvalidnodetype.xml +447/806 hc_nodeinsertbeforenewchilddiffdocument.xml +448/806 hc_nodeinsertbeforenewchildexists.xml +449/806 hc_nodeinsertbeforenodeancestor.xml +450/806 hc_nodeinsertbeforenodename.xml +451/806 hc_nodeinsertbeforerefchildnonexistent.xml +452/806 hc_nodeinsertbeforerefchildnull.xml +453/806 hc_nodelistindexequalzero.xml +454/806 hc_nodelistindexgetlength.xml +455/806 hc_nodelistindexgetlengthofemptylist.xml +456/806 hc_nodelistindexnotzero.xml +457/806 hc_nodelistreturnfirstitem.xml +458/806 hc_nodelistreturnlastitem.xml +459/806 hc_nodelisttraverselist.xml +460/806 hc_nodeparentnode.xml +461/806 hc_nodeparentnodenull.xml +462/806 hc_noderemovechild.xml +463/806 hc_noderemovechildgetnodename.xml +464/806 hc_noderemovechildnode.xml +465/806 hc_noderemovechildoldchildnonexistent.xml +466/806 hc_nodereplacechild.xml +467/806 hc_nodereplacechildinvalidnodetype.xml +468/806 hc_nodereplacechildnewchilddiffdocument.xml +469/806 hc_nodereplacechildnodeancestor.xml +470/806 hc_nodereplacechildnodename.xml +471/806 hc_nodereplacechildoldchildnonexistent.xml +472/806 hc_nodetextnodeattribute.xml +473/806 hc_nodetextnodename.xml +474/806 hc_nodetextnodetype.xml +475/806 hc_nodetextnodevalue.xml +476/806 hc_nodevalue01.xml +477/806 hc_nodevalue02.xml +478/806 hc_nodevalue03.xml +479/806 hc_nodevalue04.xml +480/806 hc_nodevalue05.xml +481/806 hc_nodevalue06.xml +482/806 hc_nodevalue07.xml +483/806 hc_nodevalue08.xml +484/806 hc_notationsremovenameditem1.xml +485/806 hc_notationssetnameditem1.xml +486/806 hc_textindexsizeerrnegativeoffset.xml +implementationAttribute signed not supported, skipping test +487/806 hc_textindexsizeerroffsetoutofbounds.xml +488/806 hc_textparseintolistofelements.xml +489/806 hc_textsplittextfour.xml +490/806 hc_textsplittextone.xml +491/806 hc_textsplittextthree.xml +492/806 hc_textsplittexttwo.xml +493/806 hc_textwithnomarkup.xml +494/806 hc_attrappendchild1.xml +495/806 hc_attrappendchild2.xml +496/806 hc_attrappendchild3.xml +497/806 hc_attrappendchild4.xml +498/806 hc_attrappendchild5.xml +499/806 hc_attrappendchild6.xml +500/806 hc_attrchildnodes1.xml +501/806 hc_attrchildnodes2.xml +502/806 hc_attrclonenode1.xml +503/806 hc_attrfirstchild.xml +504/806 hc_attrgetvalue1.xml +505/806 hc_attrgetvalue2.xml +506/806 hc_attrhaschildnodes.xml +507/806 hc_attrinsertbefore1.xml +508/806 hc_attrinsertbefore2.xml +509/806 hc_attrinsertbefore3.xml +510/806 hc_attrinsertbefore4.xml +511/806 hc_attrinsertbefore5.xml +512/806 hc_attrinsertbefore6.xml +513/806 hc_attrinsertbefore7.xml +514/806 hc_attrlastchild.xml +515/806 hc_attrnormalize.xml +516/806 hc_attrremovechild1.xml +517/806 hc_attrremovechild2.xml +518/806 hc_attrreplacechild1.xml +519/806 hc_attrreplacechild2.xml +520/806 hc_attrsetvalue1.xml +521/806 hc_attrsetvalue2.xml +522/806 attrremovechild1.xml +523/806 attrreplacechild1.xml + +#P"/home/david/2001/DOM-Test-Suite/tests/level2/core/" +524/806 attrgetownerelement01.xml +525/806 attrgetownerelement02.xml +526/806 attrgetownerelement03.xml +527/806 attrgetownerelement04.xml +528/806 attrgetownerelement05.xml +529/806 createAttributeNS01.xml +530/806 createAttributeNS02.xml +531/806 createAttributeNS03.xml +532/806 createAttributeNS04.xml +533/806 createAttributeNS05.xml +534/806 createAttributeNS06.xml +535/806 createDocument01.xml +536/806 createDocument02.xml +537/806 createDocument03.xml +538/806 createDocument04.xml +539/806 createDocument05.xml +540/806 createDocument06.xml +541/806 createDocument07.xml +542/806 createDocument08.xml +543/806 createDocumentType01.xml +544/806 createDocumentType02.xml +545/806 createDocumentType03.xml +546/806 createDocumentType04.xml +547/806 createElementNS01.xml +548/806 createElementNS02.xml +549/806 createElementNS03.xml +550/806 createElementNS04.xml +551/806 createElementNS05.xml +552/806 documentcreateattributeNS01.xml +553/806 documentcreateattributeNS02.xml +554/806 documentcreateattributeNS03.xml +555/806 documentcreateattributeNS04.xml +556/806 documentcreateattributeNS05.xml +557/806 documentcreateattributeNS06.xml +558/806 documentcreateattributeNS07.xml +559/806 documentcreateelementNS01.xml +560/806 documentcreateelementNS02.xml +561/806 documentcreateelementNS05.xml +562/806 documentcreateelementNS06.xml +563/806 documentgetelementbyid01.xml +564/806 documentgetelementsbytagnameNS01.xml +565/806 documentgetelementsbytagnameNS02.xml +566/806 documentgetelementsbytagnameNS03.xml +567/806 documentgetelementsbytagnameNS04.xml +568/806 documentgetelementsbytagnameNS05.xml +569/806 documentimportnode01.xml +570/806 documentimportnode02.xml +571/806 documentimportnode03.xml +572/806 documentimportnode04.xml +573/806 documentimportnode05.xml +574/806 documentimportnode06.xml +575/806 documentimportnode07.xml +576/806 documentimportnode08.xml +577/806 documentimportnode09.xml +578/806 documentimportnode10.xml +579/806 documentimportnode11.xml +580/806 documentimportnode12.xml +581/806 documentimportnode13.xml +582/806 documentimportnode14.xml +583/806 documentimportnode15.xml +584/806 documentimportnode17.xml +585/806 documentimportnode18.xml +586/806 documentimportnode19.xml +587/806 documentimportnode20.xml +implementationAttribute expandEntityReferences not supported, skipping test +588/806 documentimportnode21.xml +implementationAttribute expandEntityReferences not supported, skipping test +589/806 documentimportnode22.xml +590/806 documenttypeinternalSubset01.xml +591/806 documenttypepublicid01.xml +592/806 documenttypesystemid01.xml +593/806 domimplementationcreatedocument03.xml +594/806 domimplementationcreatedocument04.xml +595/806 domimplementationcreatedocument05.xml +596/806 domimplementationcreatedocument07.xml +597/806 domimplementationcreatedocumenttype01.xml +598/806 domimplementationcreatedocumenttype02.xml +599/806 domimplementationcreatedocumenttype04.xml +600/806 domimplementationfeaturecore.xml +601/806 domimplementationfeaturexmlversion2.xml +602/806 domimplementationhasfeature01.xml +603/806 domimplementationhasfeature02.xml +604/806 elementgetattributenodens01.xml +605/806 elementgetattributenodens02.xml +606/806 elementgetattributenodens03.xml +607/806 elementgetattributens02.xml +608/806 elementgetelementsbytagnamens02.xml +609/806 elementgetelementsbytagnamens04.xml +610/806 elementgetelementsbytagnamens05.xml +611/806 elementhasattribute01.xml +612/806 elementhasattribute02.xml +613/806 elementhasattribute03.xml +614/806 elementhasattribute04.xml +615/806 elementhasattributens01.xml +616/806 elementhasattributens02.xml +617/806 elementhasattributens03.xml +618/806 elementremoveattributens01.xml +619/806 elementsetattributenodens01.xml +620/806 elementsetattributenodens02.xml +621/806 elementsetattributenodens03.xml +622/806 elementsetattributenodens04.xml +623/806 elementsetattributenodens05.xml +624/806 elementsetattributenodens06.xml +implementationAttribute expandEntityReferences not supported, skipping test +625/806 elementsetattributens01.xml +626/806 elementsetattributens02.xml +627/806 elementsetattributens03.xml +628/806 elementsetattributens04.xml +629/806 elementsetattributens05.xml +630/806 elementsetattributens08.xml +631/806 elementsetattributensurinull.xml +632/806 getAttributeNS01.xml +633/806 getAttributeNS02.xml +634/806 getAttributeNS03.xml +635/806 getAttributeNS04.xml +636/806 getAttributeNS05.xml +637/806 getAttributeNodeNS01.xml +638/806 getAttributeNodeNS02.xml +639/806 getElementById01.xml +640/806 getElementById02.xml +641/806 getElementsByTagNameNS01.xml +642/806 getElementsByTagNameNS02.xml +643/806 getElementsByTagNameNS03.xml +644/806 getElementsByTagNameNS04.xml +645/806 getElementsByTagNameNS05.xml +646/806 getElementsByTagNameNS06.xml +647/806 getElementsByTagNameNS07.xml +648/806 getElementsByTagNameNS08.xml +649/806 getElementsByTagNameNS09.xml +650/806 getElementsByTagNameNS10.xml +651/806 getElementsByTagNameNS11.xml +652/806 getElementsByTagNameNS12.xml +653/806 getElementsByTagNameNS13.xml +654/806 getElementsByTagNameNS14.xml +655/806 getNamedItemNS01.xml +656/806 getNamedItemNS02.xml +657/806 getNamedItemNS03.xml +658/806 getNamedItemNS04.xml +659/806 hasAttribute01.xml +660/806 hasAttribute02.xml +661/806 hasAttribute03.xml +662/806 hasAttribute04.xml +663/806 hasAttributeNS01.xml +664/806 hasAttributeNS02.xml +665/806 hasAttributeNS03.xml +666/806 hasAttributeNS04.xml +667/806 hasAttributeNS05.xml +668/806 hasAttributes01.xml +669/806 hasAttributes02.xml +670/806 hc_entitiesremovenameditemns1.xml +671/806 hc_entitiessetnameditemns1.xml +672/806 hc_namednodemapinvalidtype1.xml +673/806 hc_nodedocumentfragmentnormalize1.xml +674/806 hc_nodedocumentfragmentnormalize2.xml +675/806 hc_notationsremovenameditemns1.xml +676/806 hc_notationssetnameditemns1.xml +677/806 importNode01.xml +678/806 importNode02.xml +679/806 importNode03.xml +680/806 importNode04.xml +681/806 importNode05.xml +682/806 importNode06.xml +683/806 importNode07.xml +684/806 importNode08.xml +685/806 importNode09.xml +686/806 importNode10.xml +687/806 importNode11.xml +688/806 importNode12.xml +689/806 importNode13.xml +690/806 importNode14.xml +691/806 importNode15.xml +692/806 importNode16.xml +693/806 importNode17.xml +694/806 internalSubset01.xml +695/806 isSupported01.xml +696/806 isSupported02.xml +697/806 isSupported04.xml +698/806 isSupported05.xml +699/806 isSupported06.xml +700/806 isSupported07.xml +701/806 isSupported09.xml +702/806 isSupported10.xml +703/806 isSupported11.xml +704/806 isSupported12.xml +705/806 isSupported13.xml +706/806 isSupported14.xml +707/806 localName01.xml +708/806 localName02.xml +709/806 localName03.xml +710/806 localName04.xml +711/806 namednodemapgetnameditemns01.xml +712/806 namednodemapgetnameditemns02.xml +713/806 namednodemapgetnameditemns03.xml +714/806 namednodemapgetnameditemns04.xml +715/806 namednodemapgetnameditemns05.xml +716/806 namednodemapgetnameditemns06.xml +717/806 namednodemapremovenameditemns01.xml +718/806 namednodemapremovenameditemns02.xml +719/806 namednodemapremovenameditemns03.xml +720/806 namednodemapremovenameditemns04.xml +721/806 namednodemapremovenameditemns05.xml +722/806 namednodemapremovenameditemns06.xml +723/806 namednodemapremovenameditemns07.xml +724/806 namednodemapremovenameditemns08.xml +725/806 namednodemapremovenameditemns09.xml +726/806 namednodemapsetnameditemns01.xml +727/806 namednodemapsetnameditemns02.xml +728/806 namednodemapsetnameditemns03.xml +729/806 namednodemapsetnameditemns04.xml +730/806 namednodemapsetnameditemns05.xml +731/806 namednodemapsetnameditemns06.xml +732/806 namednodemapsetnameditemns07.xml +733/806 namednodemapsetnameditemns08.xml +734/806 namednodemapsetnameditemns09.xml +735/806 namednodemapsetnameditemns10.xml +736/806 namednodemapsetnameditemns11.xml +737/806 namespaceURI01.xml +738/806 namespaceURI02.xml +739/806 namespaceURI03.xml +740/806 namespaceURI04.xml +741/806 nodegetlocalname03.xml +742/806 nodegetnamespaceuri03.xml +743/806 nodegetownerdocument01.xml +744/806 nodegetownerdocument02.xml +745/806 nodegetprefix03.xml +746/806 nodehasattributes01.xml +747/806 nodehasattributes02.xml +748/806 nodehasattributes03.xml +749/806 nodehasattributes04.xml +750/806 nodeissupported01.xml +751/806 nodeissupported02.xml +752/806 nodeissupported03.xml +753/806 nodeissupported04.xml +754/806 nodeissupported05.xml +755/806 nodenormalize01.xml +756/806 nodesetprefix01.xml +757/806 nodesetprefix02.xml +758/806 nodesetprefix03.xml +759/806 nodesetprefix04.xml +760/806 nodesetprefix05.xml +761/806 nodesetprefix06.xml +762/806 nodesetprefix07.xml +763/806 nodesetprefix08.xml +764/806 nodesetprefix09.xml +765/806 normalize01.xml +766/806 ownerDocument01.xml +767/806 ownerElement01.xml +768/806 ownerElement02.xml +769/806 prefix01.xml +770/806 prefix02.xml +771/806 prefix03.xml +772/806 prefix04.xml +773/806 prefix05.xml +774/806 prefix06.xml +775/806 prefix07.xml +776/806 prefix08.xml +777/806 prefix09.xml +778/806 prefix10.xml +779/806 prefix11.xml +780/806 publicId01.xml +781/806 removeAttributeNS01.xml +782/806 removeAttributeNS02.xml +783/806 removeNamedItemNS01.xml +784/806 removeNamedItemNS02.xml +785/806 removeNamedItemNS03.xml +786/806 setAttributeNS01.xml +787/806 setAttributeNS02.xml +788/806 setAttributeNS03.xml +789/806 setAttributeNS04.xml +790/806 setAttributeNS05.xml +791/806 setAttributeNS06.xml +792/806 setAttributeNS07.xml +793/806 setAttributeNS09.xml +794/806 setAttributeNS10.xml +795/806 setAttributeNodeNS01.xml +796/806 setAttributeNodeNS02.xml +implementationAttribute expandEntityReferences not supported, skipping test +797/806 setAttributeNodeNS03.xml +798/806 setAttributeNodeNS04.xml +799/806 setAttributeNodeNS05.xml +800/806 setNamedItemNS01.xml +801/806 setNamedItemNS02.xml +802/806 setNamedItemNS03.xml +803/806 setNamedItemNS04.xml +804/806 setNamedItemNS05.xml +805/806 systemId01.xml +0/763 tests failed; 43 tests were skipped \ No newline at end of file Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/GNUmakefile ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/GNUmakefile Sun Feb 17 09:26:33 2008 @@ -0,0 +1,7 @@ +all: + @echo no such target + @exit 1 + +.PHONY: clean +clean: + find . \( -name \*.fasl -o -name \*.x86f -o -name \*.lx64fsl \) -print0 | xargs -0 rm -f Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/OLDNEWS ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/OLDNEWS Sun Feb 17 09:26:33 2008 @@ -0,0 +1,272 @@ +Changes to Gilbert Baumann's Code +======================================== +(Stand dieser Liste: patch-190) + +base-0 + Import of Closure's src/xml and src/glisp + + +Build system +---------------- +patch-14 + dom-builder.lsp braucht package.lisp +patch-17 + xml-parse braucht dom-impl +patch-18 + xml-parse braucht encodings +patch-19 + xml-parse.lisp needs xml-stream.lisp +patch-157 + DOM in eigenes Verzeichnis und System verschoben +patch-158 + COPYING auch im DOM +patch-160 + tests in eigenes Verzeichnis verschoben +patch-184 + commented out most of dep-clisp for now +patch-185 + CLISP fixes + + +glisp durch runes ersetzt +---------------- +patch-139 patch-140 patch-141 patch-142 patch-143 + unbenutzte Funktionen aus glisp entfernt + GLISP keine COMMON-LISP-Symbole mehr exportieren lassen + glisp defpackage weiter vereinfacht +patch-148 + runes.lisp aufgeteilt in runes.lisp und syntax.lisp +patch-149 + CHARACTER-basierte Runen-Implementation +patch-150 + removed support for oldish gcl +patch-151 + removed dep-gcl-2.lisp +patch-152 + clarified glisp license as LLGPL as per Gilbert Baumann +patch-155 + GLISP in RUNES umbenannt +patch-156 + xstream (und encoding) nach runes verschoben +patch-178 +patch-180 + really fixed rune-char + + +DOM fixes +---------------- +patch-3 + add dom:remove-child, dom:import-node +patch-6 + fixed dom:remove-child +patch-7 + strings->rods in set-attribute, too +patch-21 + dom:item und dom:length fuer NodeList implementiert +patch-22 + s/remove-atttribute/remove-attribute +patch-23 + dom:remove-attribute-node korrigiert +patch-24 + neu: dom:remove-attribute +patch-25 + dom:normalize implementiert +patch-26 + get-elements-by-tag-name fuer Element implementiert +patch-32 + s/data/value/ fuer CHARACTER-DATA +patch-33 + Aufruf von Setter-Methoden +patch-34 + (setf value) nachgetragen +patch-35 + (DOM:NODE-VALUE ATTRIBUTE) korrigiert +patch-36 + writer fuer DOM:DATA +patch-37 + (setf dom:node-value) implementiert +patch-43 + hack: implemented CHILD-NODES for ENTITY-REFERENCE +patch-44 + ENTITY-REFERENCE-Kinder als read-only markieren +patch-45 + DOM-EXCEPTION implementiert +patch-46 + fixed special cases in delete-data and replace-data +patch-47 + delete-data: Arraytyp korrigiert +patch-48 + DOM:INSERT-DATA implementiert +patch-49 + bugfix: replace-data for count != (length arg) +patch-50 + patch-46 nachgebessert: offset == length ist OK +patch-51 + fixed special cases in dom:substring-data +patch-52 + fixed patch-36, my (setf dom:data) implementation was bogus +patch-55 + temporary fix: attributes are created with value "" +patch-58 + START-DTD, END-DTD, DOCUMENT-TYPE initialisation +patch-60 + neu: CLONE-NODE +patch-65, patch-66 + verify attribute name syntax in createAttribute +patch-67 + more NAME syntax checks: CREATE-ELEMENT, SET-ATTRIBUTE +patch-68 + CREATE-ATTRIBUTE: set SPECIFIED to true +patch-69, patch-70 + INUSE_ATTRIBUTE_ERR +patch-71 + hacked my resolve-entity function to return NIL for undefined entities +patch-72 + INVALID_CHARACTER_ERR in create-entity-reference, too +patch-73 + Implement no-op methods on (setf node-value) where required... +patch-74 + fixed get-elements-by-tag-name not to include the argument itself +patch-76, patch-77 + implemented DOM:SPLIT-TEXT +patch-80 + noch unfertig: initialisiere dom:enitities richtig, erzeuge Entity-Knoten +patch-82 + dom:notations fuellen +patch-85 + WRONG_DOCUMENT_ERR auch in set-attribute-node +patch-86 + WRONG_DOCUMENT_ERR nicht nur in set-attribute-node, sondern prinzipiell in set-named-item +patch-91 + :NOT_FOUND_ERR in remove-named-item +patch-94 + can-adopt-p implementiert +patch-95 + ENSURE-VALID-INSERTION-REQUEST korrigiert +patch-96 + normalize korrigiert: cdata-section nicht beruehren +patch-98 + DOCUMENTs have owner NIL +patch-101 + (setf dom:data) fuer PI korrigiert +patch-102 + NOT_FOUND_ERR in REMOVE-CHILD +patch-104 + oops, split-text korrigiert +patch-106 + NOT_FOUND_ERROR in removeAttributeNode sucht das Objekt, nicht seinen Namen +patch-107, patch-113 + Defaultwert fuer fehlende Attribute ist der leere Rod-String, nicht NIL +patch-118 + entity und notation maps sind read-only +patch-119 + dom:item liefert NIL bei ungueltigem index +patch-120, patch-122, patch-124 + NodeList reimplementiert +patch-121 + NAMED-NODE-MAP muss auch auf HIERARCHY_REQUEST_ERR pruefen... +patch-128 + ATTRIBUTE hat jetzt Kinder +patch-129 + auch Attribute normalisieren +patch-130 + (setf dom:value) auf einem Attribut darf ein etwaiges Kinderobjekt nicht wiederverwenden +patch-131 + replace-child fuer document-fragment implementiert +patch-132 + CAN-ADOPT-P fuer Parent ATTRIBUTE und Kind CDATA-SECTION korrigiert +patch-133 + DOCUMENT darf nur jeweils ein ELEMENT- und DOCTYPE-Kind haben +patch-137 + neu: map-node-list, do-node-list. ensure-valid-insertion-request korrigiert +patch-165 + ANSI conformance fix in MOVE +patch-181 + ignore fill-pointers in MOVE + +xml-parse.lisp changes +---------------- +patch-5 + (assert (eql initial-speed 1)) in make-xstream +patch-20 + added a forward declaration for *namespace-bindings* +patch-39 + fix for thread safety in p/document +patch-41 + Warnung ueber (nicht) redefinierte Attribute abschalten koennen +patch-54 + call sax:comment; create comment nodes +patch-89 + public-id und system-id der Entities uebergeben +patch-100 + Die XML Deklaration ist keine Processing Instruction. +patch-146 + SAX-Aufrufe korrigiert fuer DTD ohne ID; Entitydeklaration mit SYSTEM ID +patch-166 + added missing format argument in internal-entity-expansion +patch-172 + fixed rod type in appenddata +patch-174 + reordered definitions to avoid forward references +patch-177 + more SBCL warnings removed +patch-188 + new function parse-octets +(See also: patch-58, patch-80, patch-82) + + +DOM-Builder und SAX-Interface +---------------- +patch-57 + Warnungen beseitigt ("undefined variable") +patch-75 + fixed PARENT slot initialization and added a rant about the current implementation +patch-97 + CDATA sections bauen +patch-136 + normalisierte Elemente bauen + +(See also: patch-58, patch-80, patch-82, patch-86, patch-118, patch-120) + + +unparse +---------------- +patch-2 + export UNPARSE-DOCUMENT +patch-144 + Kommentare verstehen (und nicht ausgeben) +patch-189 + new function UNPARSE-DOCUMENT-TO-OCTETS + + +Misc. +---------------- +patch-9 + print elements with their tag-name +patch-11 + print attributes with name and value + +patch-138 + workaround, need to revert this later + +patch-10 reverted by patch-12 +patch-114 reverted by patch-115 +patch-63 reverted by patch-134 +patch-4 patch-38 patch-87 patch-90 patch-103 reverted by patch-154 +patch-154 STRING-DOM nicht mehr verwenden. File ist aber noch da. + + +domtest.cl +---------------- +patch-27 patch-28 patch-29 patch-30 patch-31 patch-40 patch-42 patch-53 +patch-59 patch-61 patch-62 patch-64 patch-78 patch-79 patch-83 patch-84 +patch-88 patch-92 patch-93 patch-99 patch-105 patch-108 patch-111 +patch-116 patch-117 patch-123 patch-153 patch-182 + DOM tests + + +xmlconf.cl +---------------- +patch-13 patch-15 patch-16 patch-147 patch-186 + Testfunktion fuer XML Conformance Test Suite +(need to merge this with Gilbert's work) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/README ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/README Sun Feb 17 09:26:33 2008 @@ -0,0 +1,29 @@ + +Closure XML Parser + + An XML parser written in Common Lisp. + + Closure XML was written by Gilbert Baumann (unk6 at + rz.uni-karlsruhe.de) as part of the Closure web browser. + + Contributions to the parser by + * Henrik Motakef (hmot at henrik-motakef.de) + * David Lichteblau (david@lichteblau.com) + + CXML implements a namespace-aware, validating XML 1.0 parser + as well as the DOM Level 2 Core interfaces. Two parser interfaces + are offered, one SAX-like, the other similar to StAX. + + CXML is licensed under Lisp-LGPL. + + Send bug reports to cxml-devel@common-lisp.net + (http://common-lisp.net/cgi-bin/mailman/listinfo/cxml-devel) + + +Documentation + + Please refer to http://common-lisp.net/project/cxml/ for details. + + The documentation is also available in the doc/ subdirectory of this + source distribution, run `make' in that directory to build HTML + for the XML sources (requires xsltproc). Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/TIMES ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/TIMES Sun Feb 17 09:26:33 2008 @@ -0,0 +1,41 @@ +Time required for parsing a simple document (wc: 99621 298859 3267087). + +;; CXML with NIL builder +;; (cxml:parse-file "~/test.xml" nil) + +; cpu time (non-gc) 12,940 msec user, 20 msec system +; cpu time (gc) 0 msec user, 0 msec system +; cpu time (total) 12,940 msec user, 20 msec system +; real time 12,991 msec +; space allocation: +; 4,184,599 cons cells, 47,682,392 other bytes, 0 static bytes + +;; CXML with xmls-compatible builder +;; (cxml:parse-file "~/test.xml" (cxml-xmls:make-xmls-builder)) + +; cpu time (non-gc) 14,370 msec user, 20 msec system +; cpu time (gc) 0 msec user, 0 msec system +; cpu time (total) 14,370 msec user, 20 msec system +; real time 14,387 msec +; space allocation: +; 8,667,564 cons cells, 47,682,600 other bytes, 0 static bytes + +;; For comparison: xmls.lisp +;; (with-open-file (s "~/test.xml") (xmls:parse s :compress-whitespace nil)) + +; cpu time (non-gc) 27,440 msec user, 50 msec system +; cpu time (gc) 860 msec user, 0 msec system +; cpu time (total) 28,300 msec user, 50 msec system +; real time 28,813 msec +; space allocation: +; 14,821,161 cons cells, 243,886,592 other bytes, 0 static bytes + +;; CXML with DOM builder +;; (cxml:parse-file "~/test.xml" (dom:make-dom-builder)) + +; cpu time (non-gc) 34,900 msec user, 40 msec system +; cpu time (gc) 760 msec user, 0 msec system +; cpu time (total) 35,660 msec user, 40 msec system +; real time 35,822 msec +; space allocation: +; 14,645,503 cons cells, 300,235,640 other bytes, 0 static bytes Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/XMLCONF ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/XMLCONF Sun Feb 17 09:26:33 2008 @@ -0,0 +1,1834 @@ +xmltest/not-wf/sa/001.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/002.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/003.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/004.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/005.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/006.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/007.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/008.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/009.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/010.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/011.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/012.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/013.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/014.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/015.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/016.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/017.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/018.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/019.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/020.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/021.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/022.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/023.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/024.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/025.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/026.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/027.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/028.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/029.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/030.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/031.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/032.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/033.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/034.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/035.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/036.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/037.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/038.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/039.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/040.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/041.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/042.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/043.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/044.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/045.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/046.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/047.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/048.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/049.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/050.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/051.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/052.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/053.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/054.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/055.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/056.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/057.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/058.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/059.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/060.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/061.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/062.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/063.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/064.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/065.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/066.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/067.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/068.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/069.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/070.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/071.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/072.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/073.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/074.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/075.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/076.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/077.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/078.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/079.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/080.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/081.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/082.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/083.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/084.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/085.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/086.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/087.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/088.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/089.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/090.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/091.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/092.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/093.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/094.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/095.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/096.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/097.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/098.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/099.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/100.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/101.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/102.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/103.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/104.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/105.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/106.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/107.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/108.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/109.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/110.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/111.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/112.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/113.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/114.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/115.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/116.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/117.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/118.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/119.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/120.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/121.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/122.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/123.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/124.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/125.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/126.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/127.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/128.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/129.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/130.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/131.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/132.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/133.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/134.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/135.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/136.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/137.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/138.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/139.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/140.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/141.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/142.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/143.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/144.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/145.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/146.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/147.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/148.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/149.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/150.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/151.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/152.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/153.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/154.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/155.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/156.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/157.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/158.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/159.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/160.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/161.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/162.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/163.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/164.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/165.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/166.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/167.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/168.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/169.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/170.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/171.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/172.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/173.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/174.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/sa/175.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/176.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/177.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/178.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/179.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/180.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/181.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/182.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/183.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/184.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/185.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/sa/186.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/not-sa/001.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/not-sa/002.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/not-sa/003.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/not-sa/004.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/not-sa/006.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/not-sa/007.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/not-sa/008.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/not-sa/009.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/ext-sa/001.xml [not validating:] not-wf [validating:] invalid +xmltest/not-wf/ext-sa/002.xml [not validating:] not-wf [validating:] not-wf +xmltest/not-wf/ext-sa/003.xml [not validating:] not-wf [validating:] not-wf +xmltest/invalid/002.xml [not validating:] input [validating:] invalid +xmltest/invalid/005.xml [not validating:] input [validating:] invalid +xmltest/invalid/006.xml [not validating:] input [validating:] invalid +xmltest/invalid/not-sa/022.xml [not validating:] input/output [validating:] invalid +xmltest/valid/sa/001.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/002.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/003.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/004.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/005.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/006.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/007.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/008.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/009.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/010.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/011.xml [not validating:] input/output [validating:] input/output +valid/sa/012.xml: test applies to parsers without namespace support, skipping +xmltest/valid/sa/013.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/014.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/015.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/016.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/017.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/018.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/019.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/020.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/021.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/022.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/023.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/024.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/025.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/026.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/027.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/028.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/029.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/030.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/031.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/032.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/033.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/034.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/035.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/036.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/037.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/038.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/039.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/040.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/041.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/042.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/043.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/044.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/045.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/046.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/047.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/048.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/049.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/050.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/051.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/052.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/053.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/054.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/055.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/056.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/057.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/058.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/059.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/060.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/061.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/062.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/063.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/064.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/065.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/066.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/067.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/068.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/069.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/070.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/071.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/072.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/073.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/074.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/075.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/076.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/077.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/078.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/079.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/080.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/081.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/082.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/083.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/084.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/085.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/086.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/087.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/088.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/089.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/090.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/091.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/092.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/093.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/094.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/095.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/096.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/097.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/098.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/099.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/100.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/101.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/102.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/103.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/104.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/105.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/106.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/107.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/108.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/109.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/110.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/111.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/112.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/113.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/114.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/115.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/116.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/117.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/118.xml [not validating:] input/output [validating:] input/output +xmltest/valid/sa/119.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/001.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/002.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/003.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/004.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/005.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/006.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/007.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/008.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/009.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/010.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/011.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/012.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/013.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/014.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/015.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/016.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/017.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/018.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/019.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/020.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/021.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/023.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/024.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/025.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/026.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/027.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/028.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/029.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/030.xml [not validating:] input/output [validating:] input/output +xmltest/valid/not-sa/031.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/001.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/002.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/003.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/004.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/005.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/006.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/007.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/008.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/009.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/011.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/012.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/013.xml [not validating:] input/output [validating:] input/output +xmltest/valid/ext-sa/014.xml [not validating:] input/output [validating:] input/output +japanese/pr-xml-little-endian.xml [not validating:] input [validating:] input +japanese/pr-xml-utf-16.xml [not validating:] input [validating:] input +japanese/pr-xml-utf-8.xml [not validating:] input [validating:] input +japanese/weekly-little-endian.xml [not validating:] input [validating:] input +japanese/weekly-utf-16.xml [not validating:] input [validating:] input +japanese/weekly-utf-8.xml [not validating:] input [validating:] input +sun/valid/pe01.xml [not validating:] input [validating:] input +sun/valid/dtd00.xml [not validating:] input/output [validating:] input/output +sun/valid/dtd01.xml [not validating:] input/output [validating:] input/output +sun/valid/element.xml [not validating:] input/output [validating:] input/output +sun/valid/ext01.xml [not validating:] input/output [validating:] input/output +sun/valid/ext02.xml [not validating:] input/output [validating:] input/output +sun/valid/not-sa01.xml [not validating:] input/output [validating:] input/output +sun/valid/not-sa02.xml [not validating:] input/output [validating:] input/output +sun/valid/not-sa03.xml [not validating:] input/output [validating:] input/output +sun/valid/not-sa04.xml [not validating:] input/output [validating:] input/output +sun/valid/notation01.xml [not validating:] input/output [validating:] input/output +sun/valid/optional.xml [not validating:] input/output [validating:] input/output +sun/valid/required00.xml [not validating:] input/output [validating:] input/output +sun/valid/sa01.xml [not validating:] input/output [validating:] input/output +sun/valid/sa02.xml [not validating:] input/output [validating:] input/output +sun/valid/sa03.xml [not validating:] input/output [validating:] input/output +sun/valid/sa04.xml [not validating:] input/output [validating:] input/output +sun/valid/sa05.xml [not validating:] input/output [validating:] input/output +sun/valid/sgml01.xml [not validating:] input/output [validating:] input/output +sun/valid/v-lang01.xml [not validating:] input/output [validating:] input/output +sun/valid/v-lang02.xml [not validating:] input/output [validating:] input/output +sun/valid/v-lang03.xml [not validating:] input/output [validating:] input/output +sun/valid/v-lang04.xml [not validating:] input/output [validating:] input/output +sun/valid/v-lang05.xml [not validating:] input/output [validating:] input/output +sun/valid/v-lang06.xml [not validating:] input/output [validating:] input/output +sun/valid/pe00.xml [not validating:] input/output [validating:] input/output +sun/valid/pe03.xml [not validating:] input/output [validating:] input/output +sun/valid/pe02.xml [not validating:] input/output [validating:] input/output +sun/invalid/dtd01.xml [not validating:] input [validating:] invalid +sun/invalid/dtd02.xml [not validating:] input [validating:] invalid +sun/invalid/dtd03.xml [not validating:] input [validating:] invalid +sun/invalid/el01.xml [not validating:] input [validating:] invalid +sun/invalid/el02.xml [not validating:] input [validating:] invalid +sun/invalid/el03.xml [not validating:] input [validating:] invalid +sun/invalid/el04.xml [not validating:] input [validating:] invalid +sun/invalid/el05.xml [not validating:] input [validating:] invalid +sun/invalid/el06.xml [not validating:] input [validating:] invalid +sun/invalid/id01.xml [not validating:] input [validating:] invalid +sun/invalid/id02.xml [not validating:] input [validating:] invalid +sun/invalid/id03.xml [not validating:] input [validating:] invalid +sun/invalid/id04.xml [not validating:] input [validating:] invalid +sun/invalid/id05.xml [not validating:] input [validating:] invalid +sun/invalid/id06.xml [not validating:] input [validating:] invalid +sun/invalid/id07.xml [not validating:] input [validating:] invalid +sun/invalid/id08.xml [not validating:] input [validating:] invalid +sun/invalid/id09.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa01.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa02.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa04.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa05.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa06.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa07.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa08.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa09.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa10.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa11.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa12.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa13.xml [not validating:] input [validating:] invalid +sun/invalid/not-sa14.xml [not validating:] input [validating:] invalid +sun/invalid/optional01.xml [not validating:] input [validating:] invalid +sun/invalid/optional02.xml [not validating:] input [validating:] invalid +sun/invalid/optional03.xml [not validating:] input [validating:] invalid +sun/invalid/optional04.xml [not validating:] input [validating:] invalid +sun/invalid/optional05.xml [not validating:] input [validating:] invalid +sun/invalid/optional06.xml [not validating:] input [validating:] invalid +sun/invalid/optional07.xml [not validating:] input [validating:] invalid +sun/invalid/optional08.xml [not validating:] input [validating:] invalid +sun/invalid/optional09.xml [not validating:] input [validating:] invalid +sun/invalid/optional10.xml [not validating:] input [validating:] invalid +sun/invalid/optional11.xml [not validating:] input [validating:] invalid +sun/invalid/optional12.xml [not validating:] input [validating:] invalid +sun/invalid/optional13.xml [not validating:] input [validating:] invalid +sun/invalid/optional14.xml [not validating:] input [validating:] invalid +sun/invalid/optional20.xml [not validating:] input [validating:] invalid +sun/invalid/optional21.xml [not validating:] input [validating:] invalid +sun/invalid/optional22.xml [not validating:] input [validating:] invalid +sun/invalid/optional23.xml [not validating:] input [validating:] invalid +sun/invalid/optional24.xml [not validating:] input [validating:] invalid +sun/invalid/optional25.xml [not validating:] input [validating:] invalid +sun/invalid/required00.xml [not validating:] input [validating:] invalid +sun/invalid/required01.xml [not validating:] input [validating:] invalid +sun/invalid/required02.xml [not validating:] input [validating:] invalid +sun/invalid/root.xml [not validating:] input [validating:] invalid +sun/invalid/attr01.xml [not validating:] input [validating:] invalid +sun/invalid/attr02.xml [not validating:] input [validating:] invalid +sun/invalid/attr03.xml [not validating:] input [validating:] invalid +sun/invalid/attr04.xml [not validating:] input [validating:] invalid +sun/invalid/attr05.xml [not validating:] input [validating:] invalid +sun/invalid/attr06.xml [not validating:] input [validating:] invalid +sun/invalid/attr07.xml [not validating:] input [validating:] invalid +sun/invalid/attr08.xml [not validating:] input [validating:] invalid +sun/invalid/attr09.xml [not validating:] input [validating:] invalid +sun/invalid/attr10.xml [not validating:] input [validating:] invalid +sun/invalid/attr11.xml [not validating:] input [validating:] invalid +sun/invalid/attr12.xml [not validating:] input [validating:] invalid +sun/invalid/attr13.xml [not validating:] input [validating:] invalid +sun/invalid/attr14.xml [not validating:] input [validating:] invalid +sun/invalid/attr15.xml [not validating:] input [validating:] invalid +sun/invalid/attr16.xml [not validating:] input [validating:] invalid +sun/invalid/utf16b.xml [not validating:] input [validating:] invalid +sun/invalid/utf16l.xml [not validating:] input [validating:] invalid +sun/invalid/empty.xml [not validating:] input [validating:] invalid +sun/not-wf/not-sa03.xml [not validating:] not-wf [validating:] invalid +sun/not-wf/attlist01.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist02.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist03.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist04.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist05.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist06.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist07.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist08.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist09.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist10.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/attlist11.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/cond01.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/cond02.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/content01.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/content02.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/content03.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/decl01.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/dtd00.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/dtd01.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/dtd02.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/dtd03.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/dtd04.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/dtd05.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/dtd07.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/element00.xml [not validating:] not-wf [validating:] invalid +sun/not-wf/element01.xml [not validating:] not-wf [validating:] invalid +sun/not-wf/element02.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/element03.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/element04.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/encoding01.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/encoding02.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/encoding03.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/encoding04.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/encoding05.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/encoding06.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/encoding07.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/pi.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/pubid01.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/pubid02.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/pubid03.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/pubid04.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/pubid05.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml01.xml [not validating:] not-wf [validating:] invalid +sun/not-wf/sgml02.xml [not validating:] not-wf [validating:] invalid +sun/not-wf/sgml03.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml04.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml05.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml06.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml07.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml08.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml09.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml10.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml11.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml12.xml [not validating:] not-wf [validating:] not-wf +sun/not-wf/sgml13.xml [not validating:] not-wf [validating:] not-wf +oasis/p01pass2.xml [not validating:] input [validating:] input +oasis/p06pass1.xml [not validating:] input [validating:] input +oasis/p07pass1.xml [not validating:] input [validating:] input +p08pass1.xml: test applies to parsers without namespace support, skipping +oasis/p09pass1.xml [not validating:] input [validating:] input +oasis/p12pass1.xml [not validating:] input [validating:] input +oasis/p22pass4.xml [not validating:] input [validating:] input +oasis/p22pass5.xml [not validating:] input [validating:] input +oasis/p22pass6.xml [not validating:] input [validating:] input +oasis/p28pass1.xml [not validating:] input [validating:] input +oasis/p28pass3.xml [not validating:] input [validating:] input +oasis/p28pass4.xml [not validating:] input [validating:] input +oasis/p28pass5.xml [not validating:] input [validating:] input +oasis/p29pass1.xml [not validating:] input [validating:] input +oasis/p30pass1.xml [not validating:] input [validating:] input +oasis/p30pass2.xml [not validating:] input [validating:] input +oasis/p31pass1.xml [not validating:] input [validating:] input +oasis/p31pass2.xml [not validating:] input [validating:] input +oasis/p43pass1.xml [not validating:] input [validating:] input +oasis/p45pass1.xml [not validating:] input [validating:] input +oasis/p46pass1.xml [not validating:] input [validating:] input +oasis/p47pass1.xml [not validating:] input [validating:] input +oasis/p48pass1.xml [not validating:] input [validating:] input +oasis/p49pass1.xml [not validating:] input [validating:] input +oasis/p50pass1.xml [not validating:] input [validating:] input +oasis/p51pass1.xml [not validating:] input [validating:] input +oasis/p52pass1.xml [not validating:] input [validating:] input +oasis/p53pass1.xml [not validating:] input [validating:] input +oasis/p54pass1.xml [not validating:] input [validating:] input +oasis/p55pass1.xml [not validating:] input [validating:] input +oasis/p56pass1.xml [not validating:] input [validating:] input +oasis/p57pass1.xml [not validating:] input [validating:] input +oasis/p58pass1.xml [not validating:] input [validating:] input +oasis/p59pass1.xml [not validating:] input [validating:] input +oasis/p60pass1.xml [not validating:] input [validating:] input +oasis/p61pass1.xml [not validating:] input [validating:] input +oasis/p62pass1.xml [not validating:] input [validating:] input +oasis/p63pass1.xml [not validating:] input [validating:] input +oasis/p64pass1.xml [not validating:] input [validating:] input +oasis/p68pass1.xml [not validating:] input [validating:] input +oasis/p69pass1.xml [not validating:] input [validating:] input +oasis/p70pass1.xml [not validating:] input [validating:] input +oasis/p71pass1.xml [not validating:] input [validating:] input +oasis/p72pass1.xml [not validating:] input [validating:] input +oasis/p73pass1.xml [not validating:] input [validating:] input +oasis/p76pass1.xml [not validating:] input [validating:] input +oasis/p01pass1.xml [not validating:] input [validating:] invalid +oasis/p01pass3.xml [not validating:] input [validating:] invalid +oasis/p03pass1.xml [not validating:] input [validating:] invalid +p04pass1.xml: test applies to parsers without namespace support, skipping +p05pass1.xml: test applies to parsers without namespace support, skipping +oasis/p06fail1.xml [not validating:] input [validating:] invalid +oasis/p08fail1.xml [not validating:] input [validating:] invalid +oasis/p08fail2.xml [not validating:] input [validating:] invalid +oasis/p10pass1.xml [not validating:] input [validating:] invalid +oasis/p14pass1.xml [not validating:] input [validating:] invalid +oasis/p15pass1.xml [not validating:] input [validating:] invalid +oasis/p16pass1.xml [not validating:] input [validating:] invalid +oasis/p16pass2.xml [not validating:] input [validating:] invalid +oasis/p16pass3.xml [not validating:] input [validating:] invalid +oasis/p18pass1.xml [not validating:] input [validating:] invalid +oasis/p22pass1.xml [not validating:] input [validating:] invalid +oasis/p22pass2.xml [not validating:] input [validating:] invalid +oasis/p22pass3.xml [not validating:] input [validating:] invalid +oasis/p23pass1.xml [not validating:] input [validating:] invalid +oasis/p23pass2.xml [not validating:] input [validating:] invalid +oasis/p23pass3.xml [not validating:] input [validating:] invalid +oasis/p23pass4.xml [not validating:] input [validating:] invalid +oasis/p24pass1.xml [not validating:] input [validating:] invalid +oasis/p24pass2.xml [not validating:] input [validating:] invalid +oasis/p24pass3.xml [not validating:] input [validating:] invalid +oasis/p24pass4.xml [not validating:] input [validating:] invalid +oasis/p25pass1.xml [not validating:] input [validating:] invalid +oasis/p25pass2.xml [not validating:] input [validating:] invalid +oasis/p26pass1.xml [not validating:] input [validating:] invalid +oasis/p27pass1.xml [not validating:] input [validating:] invalid +oasis/p27pass2.xml [not validating:] input [validating:] invalid +oasis/p27pass3.xml [not validating:] input [validating:] invalid +oasis/p27pass4.xml [not validating:] input [validating:] invalid +oasis/p32pass1.xml [not validating:] input [validating:] invalid +oasis/p32pass2.xml [not validating:] input [validating:] invalid +oasis/p39pass1.xml [not validating:] input [validating:] invalid +oasis/p39pass2.xml [not validating:] input [validating:] invalid +oasis/p40pass1.xml [not validating:] input [validating:] invalid +oasis/p40pass2.xml [not validating:] input [validating:] invalid +oasis/p40pass3.xml [not validating:] input [validating:] invalid +oasis/p40pass4.xml [not validating:] input [validating:] invalid +oasis/p41pass1.xml [not validating:] input [validating:] invalid +oasis/p41pass2.xml [not validating:] input [validating:] invalid +oasis/p42pass1.xml [not validating:] input [validating:] invalid +oasis/p42pass2.xml [not validating:] input [validating:] invalid +oasis/p44pass1.xml [not validating:] input [validating:] invalid +oasis/p44pass2.xml [not validating:] input [validating:] invalid +oasis/p44pass3.xml [not validating:] input [validating:] invalid +oasis/p44pass4.xml [not validating:] input [validating:] invalid +oasis/p44pass5.xml [not validating:] input [validating:] invalid +oasis/p66pass1.xml [not validating:] input [validating:] invalid +oasis/p74pass1.xml [not validating:] input [validating:] invalid +oasis/p75pass1.xml [not validating:] input [validating:] invalid +oasis/e2.xml [not validating:] input [validating:] invalid +oasis/p01fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p01fail2.xml [not validating:] not-wf [validating:] invalid +oasis/p01fail3.xml [not validating:] not-wf [validating:] invalid +oasis/p01fail4.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail10.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail11.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail12.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail13.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail14.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail15.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail16.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail17.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail18.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail19.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail2.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail20.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail21.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail22.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail23.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail24.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail25.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail26.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail27.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail28.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail29.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail3.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail30.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail31.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail4.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail5.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail6.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail7.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail8.xml [not validating:] not-wf [validating:] invalid +oasis/p02fail9.xml [not validating:] not-wf [validating:] invalid +oasis/p03fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail10.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail11.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail12.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail13.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail14.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail15.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail16.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail17.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail18.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail19.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail20.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail21.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail22.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail23.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail24.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail25.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail26.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail27.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail28.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail29.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail7.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail8.xml [not validating:] not-wf [validating:] not-wf +oasis/p03fail9.xml [not validating:] not-wf [validating:] not-wf +oasis/p04fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p04fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p04fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p05fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p05fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p05fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p05fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p05fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p09fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p09fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p09fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p09fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p09fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p10fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p10fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p10fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p11fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p11fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p12fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p12fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p12fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p12fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p12fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p12fail6.xml [not validating:] not-wf [validating:] not-wf +oasis/p12fail7.xml [not validating:] not-wf [validating:] not-wf +oasis/p14fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p14fail2.xml [not validating:] not-wf [validating:] invalid +oasis/p14fail3.xml [not validating:] not-wf [validating:] invalid +oasis/p15fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p15fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p15fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p16fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p16fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p16fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p18fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p18fail2.xml [not validating:] not-wf [validating:] invalid +oasis/p18fail3.xml [not validating:] not-wf [validating:] invalid +oasis/p22fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p22fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p23fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p23fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p23fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p23fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p23fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p24fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p24fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p25fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p26fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p26fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p27fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p28fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p29fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p30fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p31fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p32fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p32fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p32fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p32fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p32fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p39fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p39fail2.xml [not validating:] not-wf [validating:] invalid +oasis/p39fail3.xml [not validating:] not-wf [validating:] invalid +oasis/p39fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p39fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p40fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p40fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p40fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p40fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p41fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p41fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p41fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p42fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p42fail2.xml [not validating:] not-wf [validating:] invalid +oasis/p42fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p43fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p43fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p43fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p44fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p44fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p44fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p44fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p44fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p45fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p45fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p45fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p45fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p46fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p46fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p46fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p46fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p46fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p46fail6.xml [not validating:] not-wf [validating:] not-wf +oasis/p47fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p47fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p47fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p47fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p48fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p48fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p49fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p50fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p51fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p51fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p51fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p51fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p51fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p51fail6.xml [not validating:] not-wf [validating:] not-wf +oasis/p51fail7.xml [not validating:] not-wf [validating:] not-wf +oasis/p52fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p52fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p53fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p53fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p53fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p53fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p53fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p54fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p55fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p56fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p56fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p56fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p56fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p56fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p57fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p58fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p58fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p58fail3.xml [not validating:] not-wf [validating:] invalid +oasis/p58fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p58fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p58fail6.xml [not validating:] not-wf [validating:] not-wf +oasis/p58fail7.xml [not validating:] not-wf [validating:] not-wf +oasis/p58fail8.xml [not validating:] not-wf [validating:] not-wf +oasis/p59fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p59fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p59fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p60fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p60fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p60fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p60fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p60fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p61fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p62fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p62fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p63fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p63fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p64fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p64fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p66fail1.xml [not validating:] not-wf [validating:] invalid +oasis/p66fail2.xml [not validating:] not-wf [validating:] invalid +oasis/p66fail3.xml [not validating:] not-wf [validating:] invalid +oasis/p66fail4.xml [not validating:] not-wf [validating:] invalid +oasis/p66fail5.xml [not validating:] not-wf [validating:] invalid +oasis/p66fail6.xml [not validating:] not-wf [validating:] invalid +oasis/p68fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p68fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p68fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p69fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p69fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p69fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p70fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p71fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p71fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p71fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p71fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p72fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p72fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p72fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p72fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p73fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p73fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p73fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p73fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p73fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p74fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p74fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p74fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p75fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p75fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p75fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p75fail4.xml [not validating:] not-wf [validating:] not-wf +oasis/p75fail5.xml [not validating:] not-wf [validating:] not-wf +oasis/p75fail6.xml [not validating:] not-wf [validating:] not-wf +oasis/p76fail1.xml [not validating:] not-wf [validating:] not-wf +oasis/p76fail2.xml [not validating:] not-wf [validating:] not-wf +oasis/p76fail3.xml [not validating:] not-wf [validating:] not-wf +oasis/p76fail4.xml [not validating:] not-wf [validating:] not-wf +ibm/invalid/P28/ibm28i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P32/ibm32i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P32/ibm32i03.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P32/ibm32i04.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P39/ibm39i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P39/ibm39i02.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P39/ibm39i03.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P39/ibm39i04.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P41/ibm41i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P41/ibm41i02.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P45/ibm45i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P49/ibm49i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P50/ibm50i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P51/ibm51i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P51/ibm51i03.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i02.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i03.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i05.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i06.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i07.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i08.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i09.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i10.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i11.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i12.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i13.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i14.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i15.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i16.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i17.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P56/ibm56i18.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P58/ibm58i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P58/ibm58i02.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P59/ibm59i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P60/ibm60i01.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P60/ibm60i02.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P60/ibm60i03.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P60/ibm60i04.xml [not validating:] input/output [validating:] invalid +ibm/invalid/P76/ibm76i01.xml [not validating:] input/output [validating:] invalid +ibm/not-wf/P01/ibm01n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P01/ibm01n02.xml [not validating:] not-wf [validating:] invalid +ibm/not-wf/P01/ibm01n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n12.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n13.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n14.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n15.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n16.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n17.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n18.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n19.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n20.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n21.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n22.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n23.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n24.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n25.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n26.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n27.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n28.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n29.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n30.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n31.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n32.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P02/ibm02n33.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P03/ibm03n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n12.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n13.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n14.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n15.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n16.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n17.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P04/ibm04n18.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P05/ibm05n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P05/ibm05n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P05/ibm05n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P09/ibm09n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P09/ibm09n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P09/ibm09n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P09/ibm09n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P10/ibm10n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P10/ibm10n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P10/ibm10n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P10/ibm10n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P10/ibm10n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P10/ibm10n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P10/ibm10n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P10/ibm10n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P11/ibm11n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P11/ibm11n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P11/ibm11n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P11/ibm11n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P12/ibm12n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P12/ibm12n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P12/ibm12n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P13/ibm13n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P13/ibm13n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P13/ibm13n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P14/ibm14n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P14/ibm14n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P14/ibm14n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P15/ibm15n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P15/ibm15n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P15/ibm15n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P15/ibm15n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P16/ibm16n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P16/ibm16n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P16/ibm16n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P16/ibm16n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P17/ibm17n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P17/ibm17n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P17/ibm17n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P17/ibm17n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P18/ibm18n01.xml [not validating:] not-wf [validating:] invalid +ibm/not-wf/P18/ibm18n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P19/ibm19n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P19/ibm19n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P19/ibm19n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P20/ibm20n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P21/ibm21n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P21/ibm21n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P21/ibm21n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P22/ibm22n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P22/ibm22n02.xml [not validating:] not-wf [validating:] invalid +ibm/not-wf/P22/ibm22n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P23/ibm23n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P23/ibm23n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P23/ibm23n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P23/ibm23n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P23/ibm23n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P23/ibm23n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P24/ibm24n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P25/ibm25n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P25/ibm25n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P26/ibm26n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P27/ibm27n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P28/ibm28n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P28/ibm28n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P28/ibm28n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P28/ibm28n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P28/ibm28n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P28/ibm28n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P28/ibm28n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P28/ibm28n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/p28a/ibm28an01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P29/ibm29n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P29/ibm29n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P29/ibm29n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P29/ibm29n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P29/ibm29n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P29/ibm29n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P29/ibm29n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P30/ibm30n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P31/ibm31n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P32/ibm32n09.xml [not validating:] not-wf [validating:] invalid +ibm/not-wf/P39/ibm39n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P39/ibm39n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P39/ibm39n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P39/ibm39n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P39/ibm39n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P39/ibm39n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P40/ibm40n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P40/ibm40n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P40/ibm40n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P40/ibm40n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P40/ibm40n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n12.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n13.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P41/ibm41n14.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P42/ibm42n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P42/ibm42n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P42/ibm42n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P42/ibm42n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P42/ibm42n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P43/ibm43n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P43/ibm43n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P43/ibm43n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P43/ibm43n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P44/ibm44n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P44/ibm44n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P44/ibm44n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P44/ibm44n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P45/ibm45n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P46/ibm46n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P46/ibm46n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P46/ibm46n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P46/ibm46n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P46/ibm46n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P47/ibm47n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P47/ibm47n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P47/ibm47n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P47/ibm47n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P47/ibm47n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P47/ibm47n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P48/ibm48n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P48/ibm48n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P48/ibm48n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P48/ibm48n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P48/ibm48n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P48/ibm48n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P48/ibm48n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P49/ibm49n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P49/ibm49n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P49/ibm49n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P49/ibm49n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P49/ibm49n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P49/ibm49n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P50/ibm50n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P50/ibm50n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P50/ibm50n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P50/ibm50n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P50/ibm50n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P50/ibm50n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P50/ibm50n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P51/ibm51n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P51/ibm51n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P51/ibm51n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P51/ibm51n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P51/ibm51n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P51/ibm51n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P51/ibm51n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P52/ibm52n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P52/ibm52n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P52/ibm52n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P52/ibm52n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P52/ibm52n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P52/ibm52n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P53/ibm53n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P53/ibm53n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P53/ibm53n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P53/ibm53n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P53/ibm53n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P53/ibm53n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P53/ibm53n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P53/ibm53n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P54/ibm54n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P54/ibm54n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P55/ibm55n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P55/ibm55n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P55/ibm55n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P56/ibm56n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P56/ibm56n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P56/ibm56n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P56/ibm56n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P56/ibm56n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P56/ibm56n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P56/ibm56n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P57/ibm57n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P58/ibm58n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P58/ibm58n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P58/ibm58n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P58/ibm58n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P58/ibm58n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P58/ibm58n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P58/ibm58n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P58/ibm58n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P59/ibm59n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P59/ibm59n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P59/ibm59n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P59/ibm59n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P59/ibm59n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P59/ibm59n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P60/ibm60n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P60/ibm60n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P60/ibm60n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P60/ibm60n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P60/ibm60n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P60/ibm60n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P60/ibm60n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P60/ibm60n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P61/ibm61n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P62/ibm62n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P62/ibm62n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P62/ibm62n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P62/ibm62n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P62/ibm62n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P62/ibm62n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P62/ibm62n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P62/ibm62n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P63/ibm63n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P63/ibm63n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P63/ibm63n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P63/ibm63n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P63/ibm63n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P63/ibm63n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P63/ibm63n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P64/ibm64n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P64/ibm64n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P64/ibm64n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P65/ibm65n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P65/ibm65n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n12.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n13.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n14.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P66/ibm66n15.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n06.xml [not validating:] not-wf [validating:] invalid +ibm/not-wf/P68/ibm68n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P68/ibm68n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P69/ibm69n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P69/ibm69n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P69/ibm69n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P69/ibm69n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P69/ibm69n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P69/ibm69n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm70n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm71n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm71n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm71n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm71n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm71n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm71n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm71n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P71/ibm71n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P72/ibm72n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P73/ibm73n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P73/ibm73n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P74/ibm74n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n12.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P75/ibm75n13.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P76/ibm76n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P76/ibm76n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P76/ibm76n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P76/ibm76n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P76/ibm76n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P76/ibm76n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P76/ibm76n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P77/ibm77n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P77/ibm77n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P77/ibm77n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P77/ibm77n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P78/ibm78n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P78/ibm78n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P79/ibm79n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P79/ibm79n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P80/ibm80n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P80/ibm80n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P80/ibm80n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P80/ibm80n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P80/ibm80n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P80/ibm80n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P81/ibm81n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P82/ibm82n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P82/ibm82n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P82/ibm82n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P82/ibm82n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P82/ibm82n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P82/ibm82n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P82/ibm82n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P82/ibm82n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P83/ibm83n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P83/ibm83n02.xml [not validating:] not-wf [validating:] invalid +ibm/not-wf/P83/ibm83n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P83/ibm83n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P83/ibm83n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P83/ibm83n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n100.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n101.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n102.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n103.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n104.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n105.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n106.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n107.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n108.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n109.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n110.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n111.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n112.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n113.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n114.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n115.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n116.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n117.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n118.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n119.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n12.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n120.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n121.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n122.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n123.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n124.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n125.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n126.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n127.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n128.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n129.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n13.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n130.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n131.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n132.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n133.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n134.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n135.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n136.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n137.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n138.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n139.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n14.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n140.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n141.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n142.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n143.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n144.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n145.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n146.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n147.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n148.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n149.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n15.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n150.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n151.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n152.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n153.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n154.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n155.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n156.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n157.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n158.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n159.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n16.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n160.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n161.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n162.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n163.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n164.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n165.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n166.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n167.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n168.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n169.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n17.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n170.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n171.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n172.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n173.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n174.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n175.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n176.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n177.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n178.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n179.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n18.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n180.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n181.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n182.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n183.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n184.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n185.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n186.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n187.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n188.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n189.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n19.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n190.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n191.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n192.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n193.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n194.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n195.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n196.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n197.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n198.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n20.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n21.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n22.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n23.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n24.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n25.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n26.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n27.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n28.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n29.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n30.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n31.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n32.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n33.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n34.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n35.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n36.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n37.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n38.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n39.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n40.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n41.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n42.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n43.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n44.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n45.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n46.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n47.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n48.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n49.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n50.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n51.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n52.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n53.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n54.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n55.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n56.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n57.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n58.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n59.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n60.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n61.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n62.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n63.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n64.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n65.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n66.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n67.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n68.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n69.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n70.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n71.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n72.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n73.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n74.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n75.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n76.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n77.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n78.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n79.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n80.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n81.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n82.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n83.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n84.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n85.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n86.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n87.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n88.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n89.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n90.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n91.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n92.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n93.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n94.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n95.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n96.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n97.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n98.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P85/ibm85n99.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P86/ibm86n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P86/ibm86n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P86/ibm86n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P86/ibm86n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n12.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n13.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n14.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n15.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n16.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n17.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n18.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n19.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n20.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n21.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n22.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n23.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n24.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n25.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n26.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n27.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n28.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n29.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n30.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n31.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n32.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n33.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n34.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n35.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n36.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n37.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n38.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n39.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n40.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n41.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n42.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n43.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n44.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n45.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n46.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n47.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n48.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n49.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n50.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n51.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n52.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n53.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n54.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n55.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n56.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n57.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n58.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n59.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n60.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n61.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n62.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n63.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n64.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n66.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n67.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n68.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n69.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n70.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n71.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n72.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n73.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n74.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n75.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n76.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n77.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n78.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n79.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n80.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n81.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n82.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n83.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n84.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P87/ibm87n85.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n12.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n13.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n14.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n15.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P88/ibm88n16.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n01.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n02.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n03.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n04.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n05.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n06.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n07.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n08.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n09.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n10.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n11.xml [not validating:] not-wf [validating:] not-wf +ibm/not-wf/P89/ibm89n12.xml [not validating:] not-wf [validating:] not-wf +ibm/valid/P01/ibm01v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P02/ibm02v01.xml [not validating:] input [validating:] input +ibm/valid/P03/ibm03v01.xml [not validating:] input [validating:] input +ibm/valid/P09/ibm09v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P09/ibm09v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P09/ibm09v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P09/ibm09v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P09/ibm09v05.xml [not validating:] input/output [validating:] input/output +ibm/valid/P10/ibm10v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P10/ibm10v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P10/ibm10v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P10/ibm10v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P10/ibm10v05.xml [not validating:] input/output [validating:] input/output +ibm/valid/P10/ibm10v06.xml [not validating:] input/output [validating:] input/output +ibm/valid/P10/ibm10v07.xml [not validating:] input/output [validating:] input/output +ibm/valid/P10/ibm10v08.xml [not validating:] input/output [validating:] input/output +ibm/valid/P11/ibm11v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P11/ibm11v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P11/ibm11v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P11/ibm11v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P12/ibm12v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P12/ibm12v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P12/ibm12v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P12/ibm12v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P13/ibm13v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P14/ibm14v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P14/ibm14v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P14/ibm14v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P15/ibm15v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P15/ibm15v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P15/ibm15v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P15/ibm15v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P16/ibm16v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P16/ibm16v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P16/ibm16v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P17/ibm17v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P18/ibm18v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P19/ibm19v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P20/ibm20v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P20/ibm20v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P21/ibm21v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P22/ibm22v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P22/ibm22v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P22/ibm22v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P22/ibm22v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P22/ibm22v05.xml [not validating:] input/output [validating:] input/output +ibm/valid/P22/ibm22v06.xml [not validating:] input/output [validating:] input/output +ibm/valid/P22/ibm22v07.xml [not validating:] input/output [validating:] input/output +ibm/valid/P23/ibm23v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P23/ibm23v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P23/ibm23v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P23/ibm23v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P23/ibm23v05.xml [not validating:] input/output [validating:] input/output +ibm/valid/P23/ibm23v06.xml [not validating:] input/output [validating:] input/output +ibm/valid/P24/ibm24v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P24/ibm24v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P25/ibm25v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P25/ibm25v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P25/ibm25v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P25/ibm25v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P26/ibm26v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P27/ibm27v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P27/ibm27v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P27/ibm27v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P28/ibm28v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P30/ibm30v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P30/ibm30v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P31/ibm31v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P32/ibm32v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P32/ibm32v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P32/ibm32v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P32/ibm32v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P33/ibm33v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P34/ibm34v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P35/ibm35v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P36/ibm36v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P37/ibm37v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P38/ibm38v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P39/ibm39v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P40/ibm40v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P41/ibm41v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P42/ibm42v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P43/ibm43v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P44/ibm44v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P45/ibm45v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P47/ibm47v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P49/ibm49v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P50/ibm50v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P51/ibm51v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P51/ibm51v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P52/ibm52v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P54/ibm54v01.xml [not validating:] input [validating:] input +ibm/valid/P54/ibm54v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P54/ibm54v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P55/ibm55v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v05.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v06.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v07.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v08.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v09.xml [not validating:] input/output [validating:] input/output +ibm/valid/P56/ibm56v10.xml [not validating:] input/output [validating:] input/output +ibm/valid/P57/ibm57v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P58/ibm58v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P58/ibm58v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P59/ibm59v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P59/ibm59v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P60/ibm60v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P60/ibm60v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P60/ibm60v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P60/ibm60v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P61/ibm61v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P61/ibm61v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P62/ibm62v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P62/ibm62v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P62/ibm62v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P62/ibm62v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P62/ibm62v05.xml [not validating:] input/output [validating:] input/output +ibm/valid/P63/ibm63v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P63/ibm63v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P63/ibm63v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P63/ibm63v04.xml [not validating:] input/output [validating:] input/output +ibm/valid/P63/ibm63v05.xml [not validating:] input/output [validating:] input/output +ibm/valid/P64/ibm64v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P64/ibm64v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P64/ibm64v03.xml [not validating:] input/output [validating:] input/output +ibm/valid/P65/ibm65v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P65/ibm65v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P66/ibm66v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P67/ibm67v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P68/ibm68v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P68/ibm68v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P69/ibm69v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P69/ibm69v02.xml [not validating:] input/output [validating:] input/output +ibm/valid/P70/ibm70v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P78/ibm78v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P79/ibm79v01.xml [not validating:] input [validating:] input +ibm/valid/P82/ibm82v01.xml [not validating:] input/output [validating:] input/output +ibm/valid/P85/ibm85v01.xml [not validating:] input [validating:] input +ibm/valid/P86/ibm86v01.xml [not validating:] input [validating:] input +ibm/valid/P87/ibm87v01.xml [not validating:] input [validating:] input +ibm/valid/P88/ibm88v01.xml [not validating:] input [validating:] input +ibm/valid/P89/ibm89v01.xml [not validating:] input [validating:] input +eduni/namespaces/1.0/001.xml [not validating:] input [validating:] input +eduni/namespaces/1.0/002.xml [not validating:] input [validating:] input +eduni/namespaces/1.0/003.xml [not validating:] input [validating:] input +eduni/namespaces/1.0/007.xml [not validating:] input [validating:] input +eduni/namespaces/1.0/008.xml [not validating:] input [validating:] input +eduni/namespaces/1.0/009.xml [not validating:] not-wf [validating:] not-wf +eduni/namespaces/1.0/010.xml [not validating:] not-wf [validating:] not-wf +eduni/namespaces/1.0/011.xml [not validating:] not-wf [validating:] not-wf +eduni/namespaces/1.0/012.xml [not validating:] not-wf [validating:] not-wf +eduni/namespaces/1.0/013.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/014.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/015.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/016.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/017.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/018.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/019.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/020.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/021.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/022.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/023.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/024.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/025.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/026.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/027.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/028.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/029.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/030.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/031.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/032.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/033.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/034.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/035.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/036.xml [not validating:] not-wf [validating:] invalid +eduni/namespaces/1.0/037.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/038.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/039.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/040.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/041.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/042.xml [not validating:] not-wf [validating:] not-wf +eduni/namespaces/1.0/043.xml [not validating:] not-wf [validating:] not-wf +eduni/namespaces/1.0/044.xml [not validating:] not-wf [validating:] not-wf +eduni/namespaces/1.0/045.xml [not validating:] input [validating:] invalid +eduni/namespaces/1.0/046.xml [not validating:] input [validating:] invalid +0/1829 tests failed; 333 tests were skipped \ No newline at end of file Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/XMLS-SYMBOLS.diff ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/XMLS-SYMBOLS.diff Sun Feb 17 09:26:33 2008 @@ -0,0 +1,98 @@ +* looking for david@knowledgetools.de--cxml/cxml--devel--1.0--patch-309 to compare with +* comparing to david@knowledgetools.de--cxml/cxml--devel--1.0--patch-309 +M xml/xmls-compat.lisp + +* modified files + +--- orig/xml/xmls-compat.lisp ++++ mod/xml/xmls-compat.lisp +@@ -12,7 +12,8 @@ + (defpackage cxml-xmls + (:use :cl :runes) + (:export #:make-node #:node-name #:node-ns #:node-attrs #:node-children +- #:make-xmls-builder #:map-node)) ++ #:make-xmls-builder #:map-node ++ #:*identifier-case*)) + + (in-package :cxml-xmls) + +@@ -64,6 +65,10 @@ + + ;;;; SAX-Handler (Parser) + ++(defvar *identifier-case* nil ++ "One of NIL (don't intern names), :PRESERVE, :UPCASE, :DOWNCASE, or :INVERT ++ (intern name into the keyword package after adjusting case).") ++ + (defclass xmls-builder () + ((element-stack :initform nil :accessor element-stack) + (root :initform nil :accessor root))) +@@ -74,16 +79,46 @@ + (defmethod sax:end-document ((handler xmls-builder)) + (root handler)) + ++(defun string-invert-case (str) ++ (map 'string ++ (lambda (c) ++ (cond ++ ((upper-case-p c) (char-downcase c)) ++ ((lower-case-p c) (char-upcase c)) ++ (t c))) ++ str)) ++ ++(defun maybe-intern (name) ++ (if *identifier-case* ++ (let ((str (if (stringp name) name (rod-string name)))) ++ (intern (ecase *identifier-case* ++ (:preserve str) ++ (:upcase (string-upcase str)) ++ (:downcase (string-downcase str)) ++ (:invert (string-invert-case str))) ++ :keyword)) ++ name)) ++ ++(defun maybe-stringify (name) ++ (if (symbolp name) ++ (let ((str (symbol-name name))) ++ (ecase *identifier-case* ++ (:preserve str) ++ (:upcase (string-downcase str)) ++ (:downcase (string-upcase str)) ++ (:invert (string-invert-case str)))) ++ name)) ++ + (defmethod sax:start-element + ((handler xmls-builder) namespace-uri local-name qname attributes) + (declare (ignore namespace-uri)) + (setf local-name (or local-name qname)) + (let* ((attributes + (mapcar (lambda (attr) +- (list (sax:attribute-qname attr) ++ (list (maybe-intern (sax:attribute-qname attr)) + (sax:attribute-value attr))) + attributes)) +- (node (make-node :name local-name ++ (node (make-node :name (maybe-intern local-name) + :ns (let ((lq (length qname)) + (ll (length local-name))) + (if (eql lq ll) +@@ -124,7 +159,7 @@ + (labels ((walk (node) + (let* ((attlist + (compute-attributes node include-xmlns-attributes)) +- (lname (rod (node-name node))) ++ (lname (rod (maybe-stringify (node-name node)))) + (ns (rod (node-ns node))) + (qname (concatenate 'rod ns (rod ":") lname))) + ;; fixme: namespaces +@@ -141,6 +176,7 @@ + (remove nil + (mapcar (lambda (a) + (destructuring-bind (name value) a ++ (setf name (maybe-stringify name)) + (if (or xmlnsp (not (cxml::xmlns-attr-p (rod name)))) + (sax:make-attribute :qname (rod name) + :value (rod value) + + + Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/catalog.dtd ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/catalog.dtd Sun Feb 17 09:26:33 2008 @@ -0,0 +1,149 @@ +<!-- $Id: catalog.dtd,v 1.1.1.1 2005/03/13 18:02:52 david Exp $ --> + +<!ENTITY % pubIdChars "CDATA"> +<!ENTITY % publicIdentifier "%pubIdChars;"> +<!ENTITY % partialPublicIdentifier "%pubIdChars;"> +<!ENTITY % uriReference "CDATA"> +<!ENTITY % string "CDATA"> +<!ENTITY % systemOrPublic "(system|public)"> + +<!ENTITY % p ""> +<!ENTITY % s ""> +<!ENTITY % nsdecl "xmlns%s;"> + +<!ENTITY % catalog "%p;catalog"> +<!ENTITY % public "%p;public"> +<!ENTITY % system "%p;system"> +<!ENTITY % uri "%p;uri"> +<!ENTITY % rewriteSystem "%p;rewriteSystem"> +<!ENTITY % rewriteURI "%p;rewriteURI"> +<!ENTITY % delegatePublic "%p;delegatePublic"> +<!ENTITY % delegateSystem "%p;delegateSystem"> +<!ENTITY % delegateURI "%p;delegateURI"> +<!ENTITY % nextCatalog "%p;nextCatalog"> +<!ENTITY % group "%p;group"> + +<!ENTITY % local.catalog.mix ""> +<!ENTITY % local.catalog.attribs ""> + +<!ELEMENT %catalog; (%public;|%system;|%uri; + |%rewriteSystem;|%rewriteURI; + |%delegatePublic;|%delegateSystem;|%delegateURI; + |%nextCatalog;|%group; %local.catalog.mix;)+> +<!ATTLIST %catalog; + %nsdecl; %uriReference; #FIXED + 'urn:oasis:names:tc:entity:xmlns:xml:catalog' + prefer %systemOrPublic; #IMPLIED + xml:base %uriReference; #IMPLIED + %local.catalog.attribs; +> + +<!ENTITY % local.public.attribs ""> + +<!ELEMENT %public; EMPTY> +<!ATTLIST %public; + id ID #IMPLIED + publicId %publicIdentifier; #REQUIRED + uri %uriReference; #REQUIRED + xml:base %uriReference; #IMPLIED + %local.public.attribs; +> + +<!ENTITY % local.system.attribs ""> + +<!ELEMENT %system; EMPTY> +<!ATTLIST %system; + id ID #IMPLIED + systemId %string; #REQUIRED + uri %uriReference; #REQUIRED + xml:base %uriReference; #IMPLIED + %local.system.attribs; +> + +<!ENTITY % local.uri.attribs ""> + +<!ELEMENT %uri; EMPTY> +<!ATTLIST %uri; + id ID #IMPLIED + name %string; #REQUIRED + uri %uriReference; #REQUIRED + xml:base %uriReference; #IMPLIED + %local.uri.attribs; +> + +<!ENTITY % local.rewriteSystem.attribs ""> + +<!ELEMENT %rewriteSystem; EMPTY> +<!ATTLIST %rewriteSystem; + id ID #IMPLIED + systemIdStartString %string; #REQUIRED + rewritePrefix %string; #REQUIRED + %local.rewriteSystem.attribs; +> + +<!ENTITY % local.rewriteURI.attribs ""> + +<!ELEMENT %rewriteURI; EMPTY> +<!ATTLIST %rewriteURI; + id ID #IMPLIED + uriStartString %string; #REQUIRED + rewritePrefix %string; #REQUIRED + %local.rewriteURI.attribs; +> + +<!ENTITY % local.delegatePublic.attribs ""> + +<!ELEMENT %delegatePublic; EMPTY> +<!ATTLIST %delegatePublic; + id ID #IMPLIED + publicIdStartString %partialPublicIdentifier; #REQUIRED + catalog %uriReference; #REQUIRED + xml:base %uriReference; #IMPLIED + %local.delegatePublic.attribs; +> + +<!ENTITY % local.delegateSystem.attribs ""> + +<!ELEMENT %delegateSystem; EMPTY> +<!ATTLIST %delegateSystem; + id ID #IMPLIED + systemIdStartString %string; #REQUIRED + catalog %uriReference; #REQUIRED + xml:base %uriReference; #IMPLIED + %local.delegateSystem.attribs; +> + +<!ENTITY % local.delegateURI.attribs ""> + +<!ELEMENT %delegateURI; EMPTY> +<!ATTLIST %delegateURI; + id ID #IMPLIED + uriStartString %string; #REQUIRED + catalog %uriReference; #REQUIRED + xml:base %uriReference; #IMPLIED + %local.delegateURI.attribs; +> + +<!ENTITY % local.nextCatalog.attribs ""> + +<!ELEMENT %nextCatalog; EMPTY> +<!ATTLIST %nextCatalog; + id ID #IMPLIED + catalog %uriReference; #REQUIRED + xml:base %uriReference; #IMPLIED + %local.nextCatalog.attribs; +> + +<!ENTITY % local.group.mix ""> +<!ENTITY % local.group.attribs ""> + +<!ELEMENT %group; (%public;|%system;|%uri; + |%rewriteSystem;|%rewriteURI; + |%delegatePublic;|%delegateSystem;|%delegateURI; + |%nextCatalog; %local.group.mix;)+> +<!ATTLIST %group; + id ID #IMPLIED + prefer %systemOrPublic; #IMPLIED + xml:base %uriReference; #IMPLIED + %local.group.attribs; +> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/contrib/xhtmlgen.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/contrib/xhtmlgen.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,352 @@ +;; xhtmlgen.lisp +;; This version by david@lichteblau.com for headcraft (http://headcraft.de/) +;; +;; Derived from htmlgen.cl: +;; copyright (c) 1986-2000 Franz Inc, Berkeley, CA +;; +;; This code is free software; you can redistribute it and/or +;; modify it under the terms of the version 2.1 of +;; the GNU Lesser General Public License as published by +;; the Free Software Foundation, as clarified by the AllegroServe +;; prequel found in license-allegroserve.txt. +;; +;; This code is distributed in the hope that it will be useful, +;; but without any warranty; without even the implied warranty of +;; merchantability or fitness for a particular purpose. See the GNU +;; Lesser General Public License for more details. +;; +;; Version 2.1 of the GNU Lesser General Public License is in the file +;; license-lgpl.txt that was distributed with this file. +;; If it is not present, you can access it from +;; http://www.gnu.org/copyleft/lesser.txt (until superseded by a newer +;; version) or write to the Free Software Foundation, Inc., 59 Temple Place, +;; Suite 330, Boston, MA 02111-1307 USA + +(defpackage :xhtml-generator + (:use :common-lisp) + (:export #:with-html #:write-doctype)) + +(in-package :xhtml-generator) + +;; html generation + +(defstruct (html-process (:type list) (:constructor + make-html-process (key macro special + name-attr + ))) + key ; keyword naming this tag + macro ; the macro to define this + special ; if true then call this to process the keyword and return + ; the macroexpansion + name-attr ; attribute symbols which can name this object for subst purposes + ) + + +(defparameter *html-process-table* + (make-hash-table :test #'equal) ; #'eq is accurate but want to avoid rehashes + ) + +(defvar *html-sink*) + +(defun write-doctype (sink) + (sax:start-dtd sink + "html" + "-//W3C//DTD XHTML 1.0 Transitional//EN" + "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd") + (sax:end-dtd sink)) + +(defmacro with-html (sink &rest forms &environment env) + `(let ((*html-sink* ,sink)) + ,(process-html-forms forms env))) + +(defun get-process (form) + (let ((ent (gethash form *html-process-table*))) + (unless ent + (error "unknown html keyword ~s" form)) + ent)) + +(defun process-html-forms (forms env) + (let (res) + (flet ((do-ent (ent args argsp body) + ;; ent is an html-process object associated with the + ;; html tag we're processing + ;; args is the list of values after the tag in the form + ;; ((:tag &rest args) ....) + ;; argsp is true if this isn't a singleton tag (i.e. it has + ;; a body) .. (:tag ...) or ((:tag ...) ...) + ;; body is the body if any of the form + ;; + (let ((special (html-process-special ent))) + (push (if special + (funcall special ent args argsp body) + `(,(html-process-macro ent) + ,args + ,(process-html-forms body env))) + res)))) + (do* ((xforms forms (cdr xforms)) + (form (car xforms) (car xforms))) + ((null xforms)) + + (setq form (macroexpand form env)) + + (if (atom form) + (typecase form + (keyword (do-ent (get-process form) nil nil nil)) + (string (push `(sax:characters *html-sink* ,form) res)) + (t (push form res))) + (let ((first (car form))) + (cond + ((keywordp first) + ;; (:xxx . body) form + (do-ent (get-process (car form)) nil t (cdr form))) + ((and (consp first) (keywordp (car first))) + ;; ((:xxx args ) . body) + (do-ent (get-process (caar form)) (cdr first) t (cdr form))) + (t + (push form res))))))) + `(progn ,@(nreverse res)))) + +(defun html-body-key-form (string-code args body) + (unless (evenp (length args)) + (error "attribute list ~S isn't even" args)) + `(let ((.tagname. ,string-code)) + (sax:start-element *html-sink* nil nil .tagname. + (list + ,@(loop + for (name value) on args by #'cddr + collect + `(sax:make-attribute + :qname ,(etypecase name + (symbol (symbol-name name)) + (string name)) + :value ,value + :specified-p t)))) + ,@body + (sax:end-element *html-sink* nil nil .tagname.))) + +(defun emit-without-quoting (str) + (let ((s (cxml::chained-handler *html-sink*))) + (cxml::maybe-close-tag s) + (map nil (lambda (c) (cxml::write-rune (char-code c) s)) str))) + +(defun princ-http (val) + (warn "use of deprecated :PRINC (use :PRINC-SAFE instead?)") + (emit-without-quoting (princ-to-string val))) + +(defun prin1-http (val) + (warn "use of deprecated :PRIN1 (use :PRIN1-SAFE instead?)") + (emit-without-quoting (prin1-to-string val))) + +(defun princ-safe-http (val) + (sax:characters *html-sink* (princ-to-string val))) + +(defun prin1-safe-http (val) + (sax:characters *html-sink* (prin1-to-string val))) + + +;; -- defining how html tags are handled. -- +;; +;; most tags are handled in a standard way and the def-std-html +;; macro is used to define such tags +;; +;; Some tags need special treatment and def-special-html defines +;; how these are handled. The tags requiring special treatment +;; are the pseudo tags we added to control operations +;; in the html generator. +;; +;; +;; tags can be found in three ways: +;; :br - singleton, no attributes, no body +;; (:b "foo") - no attributes but with a body +;; ((:a href="foo") "balh") - attributes and body +;; + +(defmacro def-special-html (kwd fcn) + ;; kwd - the tag we're defining behavior for. + ;; fcn - function to compute the macroexpansion of a use of this + ;; tag. args to fcn are: + ;; ent - html-process object holding info on this tag + ;; args - list of attribute-values following tag + ;; argsp - true if there is a body in this use of the tag + ;; body - list of body forms. + `(setf (gethash ,kwd *html-process-table*) + (make-html-process ,kwd nil ,fcn nil))) + +(def-special-html :newline + #'(lambda (ent args argsp body) + (declare (ignore ent args argsp)) + (when body + (error "can't have a body with :newline -- body is ~s" body)) + (emit-without-quoting (string #\newline)))) + +(def-special-html :princ + #'(lambda (ent args argsp body) + (declare (ignore ent args argsp)) + `(progn ,@(mapcar #'(lambda (bod) + `(princ-http ,bod)) + body)))) + +(def-special-html :princ-safe + #'(lambda (ent args argsp body) + (declare (ignore ent args argsp)) + `(progn ,@(mapcar #'(lambda (bod) + `(princ-safe-http ,bod)) + body)))) + +(def-special-html :prin1 + #'(lambda (ent args argsp body) + (declare (ignore ent args argsp)) + `(progn ,@(mapcar #'(lambda (bod) + `(prin1-http ,bod)) + body)))) + +(def-special-html :prin1-safe + #'(lambda (ent args argsp body) + (declare (ignore ent args argsp)) + `(progn ,@(mapcar #'(lambda (bod) + `(prin1-safe-http ,bod)) + body)))) + +(def-special-html :comment + #'(lambda (ent args argsp body) + (declare (ignore ent args argsp body)) + `(warn ":COMMENT in html macro not supported yet"))) + +(defmacro def-std-html (kwd name-attrs) + (let ((mac-name (intern (format nil "~a-~a" :with-html kwd))) + (string-code (string-downcase (string kwd)))) + `(progn (setf (gethash ,kwd *html-process-table*) + (make-html-process ,kwd + ',mac-name + nil + ',name-attrs)) + (defmacro ,mac-name (args &rest body) + (html-body-key-form ,string-code args body))))) + +(def-std-html :a nil) +(def-std-html :abbr nil) +(def-std-html :acronym nil) +(def-std-html :address nil) +(def-std-html :applet nil) +(def-std-html :area nil) + +(def-std-html :b nil) +(def-std-html :base nil) +(def-std-html :basefont nil) +(def-std-html :bdo nil) +(def-std-html :bgsound nil) +(def-std-html :big nil) +(def-std-html :blink nil) +(def-std-html :blockquote nil) +(def-std-html :body nil) +(def-std-html :br nil) +(def-std-html :button nil) + +(def-std-html :caption nil) +(def-std-html :center nil) +(def-std-html :cite nil) +(def-std-html :code nil) +(def-std-html :col nil) +(def-std-html :colgroup nil) + +(def-std-html :dd nil) +(def-std-html :del nil) +(def-std-html :dfn nil) +(def-std-html :dir nil) +(def-std-html :div nil) +(def-std-html :dl nil) +(def-std-html :dt nil) + +(def-std-html :em nil) +(def-std-html :embed nil) + +(def-std-html :fieldset nil) +(def-std-html :font nil) +(def-std-html :form :name) +(def-std-html :frame nil) +(def-std-html :frameset nil) + +(def-std-html :h1 nil) +(def-std-html :h2 nil) +(def-std-html :h3 nil) +(def-std-html :h4 nil) +(def-std-html :h5 nil) +(def-std-html :h6 nil) +(def-std-html :head nil) +(def-std-html :hr nil) +(def-std-html :html nil) + +(def-std-html :i nil) +(def-std-html :iframe nil) +(def-std-html :ilayer nil) +(def-std-html :img :id) +(def-std-html :input nil) +(def-std-html :ins nil) +(def-std-html :isindex nil) + +(def-std-html :kbd nil) +(def-std-html :keygen nil) + +(def-std-html :label nil) +(def-std-html :layer nil) +(def-std-html :legend nil) +(def-std-html :li nil) +(def-std-html :link nil) +(def-std-html :listing nil) + +(def-std-html :map nil) +(def-std-html :marquee nil) +(def-std-html :menu nil) +(def-std-html :meta nil) +(def-std-html :multicol nil) + +(def-std-html :nobr nil) +(def-std-html :noembed nil) +(def-std-html :noframes nil) +(def-std-html :noscript nil) + +(def-std-html :object nil) +(def-std-html :ol nil) +(def-std-html :optgroup nil) +(def-std-html :option nil) + +(def-std-html :p nil) +(def-std-html :param nil) +(def-std-html :plaintext nil) +(def-std-html :pre nil) + +(def-std-html :q nil) + +(def-std-html :s nil) +(def-std-html :samp nil) +(def-std-html :script nil) +(def-std-html :select nil) +(def-std-html :server nil) +(def-std-html :small nil) +(def-std-html :spacer nil) +(def-std-html :span :id) +(def-std-html :strike nil) +(def-std-html :strong nil) +(def-std-html :style nil) +(def-std-html :sub nil) +(def-std-html :sup nil) + +(def-std-html :table :name) +(def-std-html :tbody nil) +(def-std-html :td nil) +(def-std-html :textarea nil) +(def-std-html :tfoot nil) +(def-std-html :th nil) +(def-std-html :thead nil) +(def-std-html :title nil) +(def-std-html :tr nil) +(def-std-html :tt nil) + +(def-std-html :u nil) +(def-std-html :ul nil) + +(def-std-html :var nil) + +(def-std-html :wbr nil) + +(def-std-html :xmp nil) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/cxml.asd ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/cxml.asd Sun Feb 17 09:26:33 2008 @@ -0,0 +1,113 @@ +(defpackage :cxml-system + (:use :asdf :cl)) +(in-package :cxml-system) + +(defclass dummy-cxml-component () ()) + +(defmethod asdf:component-name ((c dummy-cxml-component)) + :cxml) + +;; force loading of closure-common.asd, which installs *FEATURES* this +;; file depends on. Use MISSING-DEPENDENCY for asdf-install. +(unless (find-system :closure-common nil) + (error 'missing-dependency + :required-by (make-instance 'dummy-cxml-component) + :version nil + :requires :closure-common)) + +(defclass closure-source-file (cl-source-file) ()) + +#+scl +(pushnew 'uri-is-namestring *features*) + +#+sbcl +(defmethod perform :around ((o compile-op) (s closure-source-file)) + ;; shut up already. Correctness first. + (handler-bind ((sb-ext:compiler-note #'muffle-warning)) + (let (#+sbcl (*compile-print* nil)) + (call-next-method)))) + +(asdf:defsystem :cxml-xml + :default-component-class closure-source-file + :pathname (merge-pathnames + "xml/" + (make-pathname :name nil :type nil :defaults *load-truename*)) + :components + ((:file "package") + (:file "util" :depends-on ("package")) + (:file "sax-handler") + (:file "xml-name-rune-p" :depends-on ("package" "util")) + (:file "split-sequence" :depends-on ("package")) + (:file "xml-parse" :depends-on ("package" "util" "sax-handler" "split-sequence" "xml-name-rune-p")) + (:file "unparse" :depends-on ("xml-parse")) + (:file "xmls-compat" :depends-on ("xml-parse")) + (:file "recoder" :depends-on ("xml-parse")) + (:file "xmlns-normalizer" :depends-on ("xml-parse")) + (:file "space-normalizer" :depends-on ("xml-parse")) + (:file "catalog" :depends-on ("xml-parse")) + (:file "sax-proxy" :depends-on ("xml-parse"))) + :depends-on (:closure-common :puri #-scl :trivial-gray-streams)) + +(defclass utf8dom-file (closure-source-file) ((of))) + +(defmethod output-files ((operation compile-op) (c utf8dom-file)) + (let* ((normal (car (call-next-method))) + (name (concatenate 'string (pathname-name normal) "-utf8"))) + (list (make-pathname :name name :defaults normal)))) + +;; must be an extra method because of common-lisp-controller's :around method +(defmethod output-files :around ((operation compile-op) (c utf8dom-file)) + (let ((x (call-next-method))) + (setf (slot-value c 'of) (car x)) + x)) + +(defmethod perform ((o load-op) (c utf8dom-file)) + (load (slot-value c 'of))) + +(defmethod perform ((operation compile-op) (c utf8dom-file)) + (let ((*features* (cons 'utf8dom-file *features*)) + (*readtable* + (symbol-value (find-symbol "*UTF8-RUNES-READTABLE*" + :closure-common-system)))) + (call-next-method))) + +(asdf:defsystem :cxml-dom + :default-component-class closure-source-file + :pathname (merge-pathnames + "dom/" + (make-pathname :name nil :type nil :defaults *load-truename*)) + :components + ((:file "package") + (:file rune-impl :pathname "dom-impl" :depends-on ("package")) + (:file rune-builder :pathname "dom-builder" :depends-on (rune-impl)) + #+rune-is-integer + (utf8dom-file utf8-impl :pathname "dom-impl" :depends-on ("package")) + #+rune-is-integer + (utf8dom-file utf8-builder :pathname "dom-builder" :depends-on (utf8-impl)) + (:file "dom-sax" :depends-on ("package"))) + :depends-on (:cxml-xml)) + +(asdf:defsystem :cxml-klacks + :default-component-class closure-source-file + :pathname (merge-pathnames + "klacks/" + (make-pathname :name nil :type nil :defaults *load-truename*)) + :serial t + :components + ((:file "package") + (:file "klacks") + (:file "klacks-impl") + (:file "tap-source")) + :depends-on (:cxml-xml)) + +(asdf:defsystem :cxml-test + :default-component-class closure-source-file + :pathname (merge-pathnames + "test/" + (make-pathname :name nil :type nil :defaults *load-truename*)) + :components ((:file "domtest") (:file "xmlconf")) + :depends-on (:cxml-xml :cxml-klacks :cxml-dom)) + +(asdf:defsystem :cxml + :components () + :depends-on (:cxml-dom :cxml-klacks :cxml-test)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/GNUmakefile ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/GNUmakefile Sun Feb 17 09:26:33 2008 @@ -0,0 +1,6 @@ +all: dom.html index.html installation.html klacks.html quickstart.html sax.html xmls-compat.html + +%.html: %.xml html.xsl + xsltproc html.xsl $< >$@.tmp + mv $@.tmp $@ + chmod -w $@ Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/bg.png ============================================================================== Binary file. No diff available. Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/cxml.css ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/cxml.css Sun Feb 17 09:26:33 2008 @@ -0,0 +1,90 @@ +div.sidebar { + float: right; + min-width: 15%; + padding: 0pt 5pt 5pt 5pt; + font-family: verdana, arial; +} + +div.sidebar-title { + font-weight: bold; + background-color: #9c0000; + border: solid #9c0000; + border-top-width: 1px; + border-bottom-width: 2px; + border-left-width: 4px; + border-right-width: 0px; + padding-left: 1px; + margin: 0em 2pt 0px 2em; +} + +div.sidebar-title a { + color: #ffffff; +} + +div.sidebar-main { + background-color: #f7f7f7; + border: solid #9c0000; + border-top-width: 0px; + border-bottom-width: 0px; + border-left-width: 4px; + border-right-width: 0px; + margin: 0em 2pt 1em 2em; + padding: 1em; +} + +div.sidebar ul.main { + padding: 0pt 0pt 0pt 1em; + margin: 0 0 1em; +} + +div.sidebar ul.sub { + list-style-type: square; + padding: 0pt 0pt 0pt 1em; + margin: 0 0 1em; +} + +div.sidebar ul.hack { + padding: 0 0 0 0; + margin: 0 0 1em; + list-style-type: none; +} + +body { + color: #000000; + background-color: #ffffff; + margin-right: 0pt; + margin-bottom: 10%; + margin-left: 40px; + padding-left: 30px; + font-family: verdana, arial; + background-image: url(bg.png); + background-position: top left; + background-attachment: fixed; + background-repeat: no-repeat; +} + +h1 { + margin-left: -30px; +} + +h2,h3 { + margin-left: -30px; + margin-top: 2em; +} + +pre { + background-color: #eeeeee; + border: solid 1px #d0d0d0; + padding: 1em; + margin-right: 10%; +} + +.def { + background-color: #ddddff; + font-weight: bold; +} + +.nomargin { + margin-bottom: 0; + margin-top: 0; +} Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/dom.html ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/dom.html Sun Feb 17 09:26:33 2008 @@ -0,0 +1,198 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> +<title>CXML W3C DOM</title> +<link rel="stylesheet" type="text/css" href="cxml.css"> +</head> +<body> +<div class="sidebar"> +<div class="sidebar-title"><a href="index.html">Closure XML</a></div> +<div class="sidebar-main"><ul class="main"> +<li> +<a href="installation.html">Installing Closure XML</a><ul class="sub"> +<li><a href="installation.html#download"><b>Download</b></a></li> +<li><a href="installation.html#implementations">Implementation-specific notes</a></li> +<li><a href="installation.html#compilation">Compilation</a></li> +<li><a href="installation.html#tests">Tests</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li> +<li> +<a href="sax.html">SAX parsing and serialization</a><ul class="sub"> +<li><a href="sax.html#parser">Parsing and Validating</a></li> +<li><a href="sax.html#serialization">Serialization</a></li> +<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li> +<li><a href="sax.html#rods">Recoders</a></li> +<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li> +<li><a href="sax.html#catalogs">XML Catalogs</a></li> +<li><a href="sax.html#sax">SAX Interface</a></li> +</ul> +</li> +<li> +<a href="klacks.html">Klacks parser</a><ul class="sub"> +<li><a href="klacks.html#sources">Parsing incrementally</a></li> +<li><a href="klacks.html#convenience">Convenience functions</a></li> +<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li> +<li><a href="klacks.html#locator">Location information</a></li> +<li><a href="klacks.html#klacksax">Examples</a></li> +</ul> +</li> +<li> +<a href="dom.html">DOM implementation</a><ul class="sub"> +<li><a href="dom.html#parser">Parsing with the DOM builder</a></li> +<li><a href="dom.html#serialization">Serialization</a></li> +<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li> +</ul></div> +</div> + <h1>W3C DOM</h1> + <p> + CXML implements the DOM Level 2 Core interfaces.  For details + on DOM, please refer to the <a href="http://www.w3.org/TR/DOM-Level-2-Core/core.html">specification</a>. + </p> + + <a name="parser"></a> + <h3>Parsing into DOM</h3> + <p> + To parse an XML document into a DOM tree, use the SAX parser with a + DOM builder as the SAX handler. Example: + </p> + <pre>(cxml:parse-file "test.xml" (cxml-dom:make-dom-builder))</pre> + <p> + <div class="def">Function CXML-DOM:MAKE-DOM-BUILDER ()</div> + Create a SAX handler which builds a DOM document. + <p> + </p> + This functions returns a DOM builder that will work with the default + configuration of the SAX parser and is guaranteed to use + characters/strings instead of runes/rods, if that makes a + difference on the Lisp in question. + <p> + </p> + This is the same as <tt>rune-dom:make-dom-builder</tt> on Lisps + with Unicode support, and the same as + <tt>utf8-dom:make-dom-builder</tt> otherwise. + </p> + + <p> + <div class="def">Function RUNE-DOM:MAKE-DOM-BUILDER ()</div> + Create a SAX handler which builds a DOM document using runes and rods. + </p> + + <p> + <div class="def">Function UTF8-DOM:MAKE-DOM-BUILDER ()</div> + (Only on Lisps without Unicode support:) + Create a SAX handler which builds a DOM document using + UTF-8-encoded strings. + </p> + + <a name="serialization"></a> + <h3>Serializing DOM</h3> + <p> + To serialize a DOM document, use a SAX serialization sink as the + argument to <tt>dom:map-document</tt>, which generates SAX events + for the DOM tree. + </p> + <p> + Applications dealing with namespaces might want to inject a + <a href="sax.html#misc">namespace normalizer</a> into the + sink chain. + </p> + <p> + <div class="def">Function DOM:MAP-DOCUMENT (handler document &key include-xmlns-attributes include-default-values include-doctype)</div> + Traverse a DOM document and call SAX functions as if an XML + representation of the document was processed by a SAX parser. + </p> + <p>Keyword arguments:</p> + <ul> + <li> + <tt>include-xmlns-attributes</tt> -- defaults to + <tt>sax:*include-xmlns-attributes*</tt> + </li> + <li> + <tt>include-doctype</tt> -- One of <tt>nil</tt> (no doctype + declaration), <tt>:full-internal-subset</tt> (include a doctype + declaration and the full internal subset), or + <tt>:canonical-notations</tt> (write a doctype declaration + with an internal subset including only notations, as required + for canonical serialization). + </li> + <li> + <tt>include-default-values</tt> -- include attribute nodes with nil + <tt>dom:specified</tt>. + </li> + <li> + <tt>recode</tt> -- (ignored on Lisps with Unicode support.) If + true, recode UTF-8 strings to rods. Defaults to true if used + with a UTF-8 DOM document. It can be set to false manually to + suppress recoding in this case. + </li> + </ul> + + <a name="mapping"></a> + <h3>DOM/Lisp mapping</h3> + <p> + Note that there is no "standard" DOM mapping for Lisp. + </p> + <p> + DOM is <a href="http://www.w3.org/TR/DOM-Level-2-Core/idl-definitions.html">specified + in CORBA IDL</a>, but it refrains from using object-oriented IDL + features, allowing for a much more natural Lisp implemenation than + the the ordinary IDL/Lisp mapping would.  + Differences between CXML's DOM and the direct IDL/Lisp mapping: + </p> + <ul> + <li> + DOM function names are symbols in the <tt>DOM</tt> package (not + the <tt>OP</tt> package). + </li> + <li> + DOM functions have proper required arguments, not a huge + <tt>&rest</tt> lambda list. + </li> + <li> + Although most IDL interfaces are implemented as CLOS classes by + CXML, the Lisp types of DOM objects is not documented and cannot + be relied upon.  A node's type can be determined using + <tt>dom:node-type</tt> instead. + </li> + <li> + <tt>DOMString</tt> is mapped to <tt>rod</tt>, which is either + an <tt>(unsigned-byte 16)</tt> array type or a string type. + </li> + <li> + The IDL/Lisp mapping maps CORBA enums to Lisp keywords.  + Unfortunately, the DOM IDL does not use enums.  Instead, + both exception types and node types are defined integer + constants.  CXML chooses to ignore this definition and uses + keywords instead. + </li> + <li> + DOM uses StudlyCaps.  Lisp programmers don't.  We + insert <tt>#\-</tt> before every upper case letter preceded by a + lower case letter and before every upper case letter which is + followed by a lower case letter, but preceded by a capital + letter.  This algorithms leads to the natural Lisp spelling + of DOM function names. + </li> + <li> + Implementation note: DOM's <tt>NodeList</tt> does not + necessarily map to a native "sequence" type.  (For example, + node lists are objects in Java, not arrays.)  + <tt>NodeList</tt> is specified to reflect changes done after a + node list was created, so node lists cannot be Lisp lists.  + (A node list could be implemented as a CLOS object pointing to + said list though.)  Instead, CXML currently implements node + lists as adjustable vectors.  Note that code which relies on + this implementation and uses Lisp sequence functions + instead of sticking to <tt>dom:item</tt> and <tt>dom:length</tt> + is not portable.  As a compromise, you can use our + extensions <tt>dom:map-node-list</tt> or + <tt>dom:do-node-list</tt>, which can be implemented portably. + </li> + </ul> +</body> +</html> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/dom.xml ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/dom.xml Sun Feb 17 09:26:33 2008 @@ -0,0 +1,150 @@ +<documentation title="CXML W3C DOM"> + <h1>W3C DOM</h1> + <p> + CXML implements the DOM Level 2 Core interfaces.  For details + on DOM, please refer to the <a + href="http://www.w3.org/TR/DOM-Level-2-Core/core.html">specification</a>. + </p> + + <a name="parser"/> + <h3>Parsing into DOM</h3> + <p> + To parse an XML document into a DOM tree, use the SAX parser with a + DOM builder as the SAX handler. Example: + </p> + <pre>(cxml:parse-file "test.xml" (cxml-dom:make-dom-builder))</pre> + <p> + <div class="def">Function CXML-DOM:MAKE-DOM-BUILDER ()</div> + Create a SAX handler which builds a DOM document. + <p> + </p> + This functions returns a DOM builder that will work with the default + configuration of the SAX parser and is guaranteed to use + characters/strings instead of runes/rods, if that makes a + difference on the Lisp in question. + <p> + </p> + This is the same as <tt>rune-dom:make-dom-builder</tt> on Lisps + with Unicode support, and the same as + <tt>utf8-dom:make-dom-builder</tt> otherwise. + </p> + + <p> + <div class="def">Function RUNE-DOM:MAKE-DOM-BUILDER ()</div> + Create a SAX handler which builds a DOM document using runes and rods. + </p> + + <p> + <div class="def">Function UTF8-DOM:MAKE-DOM-BUILDER ()</div> + (Only on Lisps without Unicode support:) + Create a SAX handler which builds a DOM document using + UTF-8-encoded strings. + </p> + + <a name="serialization"/> + <h3>Serializing DOM</h3> + <p> + To serialize a DOM document, use a SAX serialization sink as the + argument to <tt>dom:map-document</tt>, which generates SAX events + for the DOM tree. + </p> + <p> + Applications dealing with namespaces might want to inject a + <a href="sax.html#misc">namespace normalizer</a> into the + sink chain. + </p> + <p> + <div class="def">Function DOM:MAP-DOCUMENT (handler document &key include-xmlns-attributes include-default-values include-doctype)</div> + Traverse a DOM document and call SAX functions as if an XML + representation of the document was processed by a SAX parser. + </p> + <p>Keyword arguments:</p> + <ul> + <li> + <tt>include-xmlns-attributes</tt> -- defaults to + <tt>sax:*include-xmlns-attributes*</tt> + </li> + <li> + <tt>include-doctype</tt> -- One of <tt>nil</tt> (no doctype + declaration), <tt>:full-internal-subset</tt> (include a doctype + declaration and the full internal subset), or + <tt>:canonical-notations</tt> (write a doctype declaration + with an internal subset including only notations, as required + for canonical serialization). + </li> + <li> + <tt>include-default-values</tt> -- include attribute nodes with nil + <tt>dom:specified</tt>. + </li> + <li> + <tt>recode</tt> -- (ignored on Lisps with Unicode support.) If + true, recode UTF-8 strings to rods. Defaults to true if used + with a UTF-8 DOM document. It can be set to false manually to + suppress recoding in this case. + </li> + </ul> + + <a name="mapping"/> + <h3>DOM/Lisp mapping</h3> + <p> + Note that there is no "standard" DOM mapping for Lisp. + </p> + <p> + DOM is <a + href="http://www.w3.org/TR/DOM-Level-2-Core/idl-definitions.html">specified + in CORBA IDL</a>, but it refrains from using object-oriented IDL + features, allowing for a much more natural Lisp implemenation than + the the ordinary IDL/Lisp mapping would.  + Differences between CXML's DOM and the direct IDL/Lisp mapping: + </p> + <ul> + <li> + DOM function names are symbols in the <tt>DOM</tt> package (not + the <tt>OP</tt> package). + </li> + <li> + DOM functions have proper required arguments, not a huge + <tt>&rest</tt> lambda list. + </li> + <li> + Although most IDL interfaces are implemented as CLOS classes by + CXML, the Lisp types of DOM objects is not documented and cannot + be relied upon.  A node's type can be determined using + <tt>dom:node-type</tt> instead. + </li> + <li> + <tt>DOMString</tt> is mapped to <tt>rod</tt>, which is either + an <tt>(unsigned-byte 16)</tt> array type or a string type. + </li> + <li> + The IDL/Lisp mapping maps CORBA enums to Lisp keywords.  + Unfortunately, the DOM IDL does not use enums.  Instead, + both exception types and node types are defined integer + constants.  CXML chooses to ignore this definition and uses + keywords instead. + </li> + <li> + DOM uses StudlyCaps.  Lisp programmers don't.  We + insert <tt>#\-</tt> before every upper case letter preceded by a + lower case letter and before every upper case letter which is + followed by a lower case letter, but preceded by a capital + letter.  This algorithms leads to the natural Lisp spelling + of DOM function names. + </li> + <li> + Implementation note: DOM's <tt>NodeList</tt> does not + necessarily map to a native "sequence" type.  (For example, + node lists are objects in Java, not arrays.)  + <tt>NodeList</tt> is specified to reflect changes done after a + node list was created, so node lists cannot be Lisp lists.  + (A node list could be implemented as a CLOS object pointing to + said list though.)  Instead, CXML currently implements node + lists as adjustable vectors.  Note that code which relies on + this implementation and uses Lisp sequence functions + instead of sticking to <tt>dom:item</tt> and <tt>dom:length</tt> + is not portable.  As a compromise, you can use our + extensions <tt>dom:map-node-list</tt> or + <tt>dom:do-node-list</tt>, which can be implemented portably. + </li> + </ul> +</documentation> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/html.xsl ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/html.xsl Sun Feb 17 09:26:33 2008 @@ -0,0 +1,110 @@ +<xsl:stylesheet xmlns:xsl="http://www.w3.org/1999/XSL/Transform" version="1.0"> + <xsl:output method="html" + indent="yes" + doctype-public="-//W3C//DTD HTML 4.01 Transitional//EN" + doctype-system="http://www.w3.org/TR/html4/loose.dtd"/> + + <xsl:template match="@*|node()"> + <xsl:copy> + <xsl:apply-templates select="@*|node()"/> + </xsl:copy> + </xsl:template> + + <xsl:template match="documentation"> + <html> + <head> + <title> + <xsl:value-of select="@title"/> + </title> + <link rel="stylesheet" type="text/css" href="cxml.css"/> + <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"/> + </head> + <body> + <div class="sidebar"> + <div class="sidebar-title"> + <a href="index.html">Closure XML</a> + </div> + <div class="sidebar-main"> + <ul class="main"> + <li> + <a href="installation.html">Installing Closure XML</a> + <ul class="sub"> + <li><a href="installation.html#download"><b>Download</b></a></li> + <li><a href="installation.html#implementations">Implementation-specific notes</a></li> + <li><a href="installation.html#compilation">Compilation</a></li> + <li><a href="installation.html#tests">Tests</a></li> + </ul> + </li> + <li> + <ul class="hack"> + <li> + <a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a> + </li> + </ul> + </li> + <li> + <a href="sax.html">SAX parsing and serialization</a> + <ul class="sub"> + <li><a href="sax.html#parser">Parsing and Validating</a></li> + <li><a href="sax.html#serialization">Serialization</a></li> + <li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li> + <li><a href="sax.html#rods">Recoders</a></li> + <li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li> + <li><a href="sax.html#catalogs">XML Catalogs</a></li> + <li><a href="sax.html#sax">SAX Interface</a></li> + </ul> + </li> + <li> + <a href="klacks.html">Klacks parser</a> + <ul class="sub"> + <li><a href="klacks.html#sources">Parsing incrementally</a></li> + <li><a href="klacks.html#convenience">Convenience functions</a></li> + <li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li> + <li><a href="klacks.html#locator">Location information</a></li> + <li><a href="klacks.html#klacksax">Examples</a></li> + </ul> + </li> + <li> + <a href="dom.html">DOM implementation</a> + <ul class="sub"> + <li><a href="dom.html#parser">Parsing with the DOM builder</a></li> + <li><a href="dom.html#serialization">Serialization</a></li> + <li><a href="dom.html#mapping">DOM/Lisp mapping</a></li> + </ul> + </li> + <li> + <ul class="hack"> + <li><a href="xmls-compat.html">XMLS Builder</a></li> + </ul> + </li> + </ul> + </div> + </div> + <xsl:apply-templates/> + </body> + </html> + </xsl:template> + + <xsl:template match="page-index"> + <ul> + <xsl:for-each select="//heading"> + <li> + <a href="#{generate-id()}"> + <xsl:copy> + <xsl:apply-templates select="node()"/> + </xsl:copy> + </a> + </li> + </xsl:for-each> + </ul> + </xsl:template> + + <xsl:template match="heading"> + <a name="{generate-id()}"/> + <h3> + <xsl:copy> + <xsl:apply-templates select="node()"/> + </xsl:copy> + </h3> + </xsl:template> +</xsl:stylesheet> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/index.html ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/index.html Sun Feb 17 09:26:33 2008 @@ -0,0 +1,256 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> +<title>Closure XML</title> +<link rel="stylesheet" type="text/css" href="cxml.css"> +</head> +<body> +<div class="sidebar"> +<div class="sidebar-title"><a href="index.html">Closure XML</a></div> +<div class="sidebar-main"><ul class="main"> +<li> +<a href="installation.html">Installing Closure XML</a><ul class="sub"> +<li><a href="installation.html#download"><b>Download</b></a></li> +<li><a href="installation.html#implementations">Implementation-specific notes</a></li> +<li><a href="installation.html#compilation">Compilation</a></li> +<li><a href="installation.html#tests">Tests</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li> +<li> +<a href="sax.html">SAX parsing and serialization</a><ul class="sub"> +<li><a href="sax.html#parser">Parsing and Validating</a></li> +<li><a href="sax.html#serialization">Serialization</a></li> +<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li> +<li><a href="sax.html#rods">Recoders</a></li> +<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li> +<li><a href="sax.html#catalogs">XML Catalogs</a></li> +<li><a href="sax.html#sax">SAX Interface</a></li> +</ul> +</li> +<li> +<a href="klacks.html">Klacks parser</a><ul class="sub"> +<li><a href="klacks.html#sources">Parsing incrementally</a></li> +<li><a href="klacks.html#convenience">Convenience functions</a></li> +<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li> +<li><a href="klacks.html#locator">Location information</a></li> +<li><a href="klacks.html#klacksax">Examples</a></li> +</ul> +</li> +<li> +<a href="dom.html">DOM implementation</a><ul class="sub"> +<li><a href="dom.html#parser">Parsing with the DOM builder</a></li> +<li><a href="dom.html#serialization">Serialization</a></li> +<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li> +</ul></div> +</div> + <h1>Closure XML Parser</h1> + + <p>An XML parser written in Common Lisp.</p> + + <p> + Closure XML was written + by <a href="http://www.stud.uni-karlsruhe.de/~unk6/">Gilbert + Baumann</a> as part of the Closure web browser and is now + maintained by + <a href="mailto:david@lichteblau.com">David Lichteblau</a>. + It is licensed under Lisp-LGPL. + </p> + + <p> + CXML implements a <a href="http://www.w3.org/TR/REC-xml-names/">namespace-aware</a>, + validating <a href="http://www.w3.org/TR/2000/REC-xml-20001006">XML 1.0</a> + parser as well as the <a href="http://www.w3.org/TR/DOM-Level-2-Core/">DOM Level 2 Core</a> + interfaces. Two parser interfaces are offered, one SAX-like, the + other similar to StAX. + </p> + + <p> + Send bug reports to <a href="mailto:cxml-devel@common-lisp.net">cxml-devel@common-lisp.net</a> + (<a href="http://common-lisp.net/cgi-bin/mailman/listinfo/cxml-devel">list + information</a>). + </p> + + <h3>Add-on features</h3> + <p> + The following libraries are available as separate downloads: + </p> + <p> + ⬗  + <a href="http://www.lichteblau.com/cxml-rng/">cxml-rng</a> +    + Relax NG validation + </p> + <p> + ⬗  + <a href="http://www.lichteblau.com/cxml-stp/">cxml-stp</a> +    + STP, an alternative to DOM + </p> + <p> + ⬗  + <a href="http://common-lisp.net/project/closure/closure-html/">Closure + HTML</a>: cxml can be used together with its sister project + Closure HTML to convert between HTML and XHTML. + </p> + + + <a name="changes"></a> + <h3>Recent Changes</h3> + <div style="background-color: #f7f7f7; width: 60%; border: solid #9c0000; margin: 0em 2pt 1em 2em; padding: 1em"> + Runes have now been moved into + a <b>separate CVS module</b> unter the + name <b>closure-common</b>. Releases will be available + as <b>separate tarballs</b> in the download directory. Please + refer to the <a href="installation.html#download"> + installation instructions</a> for details. + </div> + <p class="nomargin"><tt>rel-2007-xx-yy</tt></p> + <ul class="nomargin"> + <li> + Moved runes into a separate project. + </li> + <li> + Incompatible SAX changes: Added new classes + sax:abstract-handler, sax:content-handler, sax:default-handler. + Implementations of SAX handlers should now subclass one of + these classes. + </li> + <li> + fixed make-source :buffering nil, thanks to Magnus Henoch for + the report + </li> + <li> + fixed time and space usage in cases where entity references + follow each other (thanks to Ivan Shvedunov for the report) + </li> + <li> + In the DOM builder, grow a buffer for string normalization + exponentially, fixing a long-standing speed issue. + </li> + </ul> + <p class="nomargin"><tt>rel-2007-08-05</tt></p> + <ul class="nomargin"> + <li>Various DTD serialization fixes</li> + <li>UTF-8 fix, thanks to Francis Leboutte</li> + </ul> + <p class="nomargin"><tt>rel-2007-07-07</tt></p> + <ul class="nomargin"> + <li> + Fixed build on non-Unicode lisps. Fixed parsing on + non-Unicode lisps. Fixed Unicode detection on OpenMCL. + </li> + <li>New function <tt>cxml:parse</tt>.</li> + <li>Serialization no longer defaults to canonical form.</li> + <li>Fixed octet array argument to make-source.</li> + <li> + XMLS compatibility is not <i>bug-for-bug</i>-compatible with + XMLS any more. There is now a mode using pairs of local name + and namespace URI, and a second mode using qualified names + only. The old behaviour using pairs of prefix and local names + was removed. (Thanks to Douglas Crosher.) + </li> + <li> + SCL support (thanks to Douglas Crosher). Includes support for + implementations where URIs are valid namestrings, and a mode + where normal streams are used instead of xstreams and ystreams + (albeit both SCL-specific at this point). + </li> + <li>new convenience serialization function cxml:doctype. Various + DTD serialization fixes.</li> + </ul> + <p class="nomargin"><tt>rel-2007-05-26</tt></p> + <ul class="nomargin"> + <li>cxml.asd has been split up into <tt>cxml.asd</tt> for the + XML parser and <tt>runes.asd</tt> for the runes package, in + preparation of a complete split of the two systems. Future CXML + releases will use separate tarballs for <tt>runes</tt> + and <tt>cxml</tt>.</li> + <li>xml:base support (SAX and Klacks only, not yet used in DOM). + See documentation <a href="sax.html#saxparser">here</a> and <a href="klacks.html#locator">here</a>.</li> + <li>New class <tt>broadcast-handler</tt> as a generalization + of the older <tt>sax-proxy</tt>.</li> + <li>New class <tt>tapping-source</tt>, a klacks source that + relays events from an upstream klacks source unchanged, while also + emitting them as SAX events to a user-specified handler at the + same time.</li> + <li>Changed attributes to carry an lname even when occurring + without a namespace. Added new functions attribute*, + unparse-attribute, and macro with-element*, with-namespace* to + the SAX generation wrapper API.</li> + <li>Klacks improvements: Incompatibly changed + klacks:find-element and find-event to consider the current event + as a result. Added klacks-error, klacks:expect, klacks:skip, + klacks:expecting-element. Fixed serialize-event to generate + start-prefix-mapping and end-prefix-mapping events. New function + map-current-namespace-declarations.</li> + <li>fixed build with common-lisp-controller</li> + </ul> + <p class="nomargin"><tt>rel-2007-02-18</tt></p> + <ul class="nomargin"> + <li>New StAX-like parser interface.</li> + <li>Serialization fixes (thanks to Nathan Bird, Donavon Keithley).</li> + <li>characters.lisp cleanup (thanks to Nathan Bird).</li> + <li>Namespace normalizer bugfixes.</li> + <li>Minor changes: clone-node on document as an extension. DOM + class hierarchy reworked. New function parse-empty-document. + Fixed the DOM serializer to not throw away local names. + Fixed a long-standing bug in the parser for documents without a + doctype. ANSI conformance fixes.</li> + </ul> + <p class="nomargin"><tt>rel-2006-01-05</tt></p> + <ul class="nomargin"> + <li>Implemented DOM 2 Core.</li> + <li>Error handling overhaul.</li> + <li>UTF-8 string support in DOM on Lisps without Unicode characters.</li> + <li>Sink API has been changed.</li> + <li>Support internal subset serialization.</li> + <li>Whitespace normalizer.</li> + <li>Gilbert Baumann has clarified the license as Lisp-LGPL.</li> + <li>Use trivial-gray-streams.</li> + </ul> + <p class="nomargin"><tt>rel-2005-06-25</tt></p> + <ul class="nomargin"> + <li>Port to OpenMCL (thanks to Rudi Schlatte).</li> + <li>Port to LispWorks (thanks to Edi Weitz).</li> + <li>Minor new features: <tt>include-default-values</tt> argument to + <tt>make-xmls-builder</tt>; <tt>handler</tt> argument + to <tt>parse-dtd-stream</tt>; SAX proxy class</li> + <li>Various bugfixes.</li> + </ul> + <p class="nomargin"><tt>patch-357</tt> (2004-10-10)</p> + <ul class="nomargin"> + <li>Auto-detect unicode support for better asdf-installability.</li> + <li>Use the puri library for Sys-ID handling.</li> + <li>Semi-automatic caching of DTD instances.</li> + <li>Support user-defined entity resolvers.</li> + <li>Support for Oasis XML Catalogs.</li> + <li>xhtmlgen version of Franz htmlgen.</li> + <li>Fixes for SBCL's unicode support.</li> + </ul> + <p class="nomargin"><tt>patch-306</tt> (2004-09-03)</p> + <ul class="nomargin"> + <li>Event-based serialization which does not require DOM documents</li> + <li>XMLS compatiblity</li> + <li>minor bugfixes (thread safety; should work on clisp again)</li> + </ul> + <p class="nomargin"><tt>patch-279</tt> (2004-05-11)</p> + <ul class="nomargin"> + <li>Validation</li> + <li>bugfixes; XHTML DTD parses again; corrected SAX entity handling</li> + </ul> + <p class="nomargin"><tt>patch-204</tt></p> + <ul class="nomargin"> + <li>Renamed package <tt>XML</tt> to <tt>CXML</tt>.</li> + <li>The unparse functions support non-canonical output now.</li> + </ul> + <p class="nomargin"><tt>patch-191</tt> (2004-03-18)</p> + <ul class="nomargin"> + <li>Initial release.</li> + </ul> +</body> +</html> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/index.xml ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/index.xml Sun Feb 17 09:26:33 2008 @@ -0,0 +1,216 @@ +<documentation title="Closure XML"> + <h1>Closure XML Parser</h1> + + <p>An XML parser written in Common Lisp.</p> + + <p> + Closure XML was written + by <a href="http://www.stud.uni-karlsruhe.de/~unk6/">Gilbert + Baumann</a> as part of the Closure web browser and is now + maintained by + <a href="mailto:david@lichteblau.com">David Lichteblau</a>. + It is licensed under Lisp-LGPL. + </p> + + <p> + CXML implements a <a + href="http://www.w3.org/TR/REC-xml-names/">namespace-aware</a>, + validating <a + href="http://www.w3.org/TR/2000/REC-xml-20001006">XML 1.0</a> + parser as well as the <a + href="http://www.w3.org/TR/DOM-Level-2-Core/">DOM Level 2 Core</a> + interfaces. Two parser interfaces are offered, one SAX-like, the + other similar to StAX. + </p> + + <p> + Send bug reports to <a + href="mailto:cxml-devel@common-lisp.net">cxml-devel@common-lisp.net</a> + (<a + href="http://common-lisp.net/cgi-bin/mailman/listinfo/cxml-devel">list + information</a>). + </p> + + <h3>Add-on features</h3> + <p> + The following libraries are available as separate downloads: + </p> + <p> + ⬗  + <a href="http://www.lichteblau.com/cxml-rng/">cxml-rng</a> +    + Relax NG validation + </p> + <p> + ⬗  + <a href="http://www.lichteblau.com/cxml-stp/">cxml-stp</a> +    + STP, an alternative to DOM + </p> + <p> + ⬗  + <a href="http://common-lisp.net/project/closure/closure-html/">Closure + HTML</a>: cxml can be used together with its sister project + Closure HTML to convert between HTML and XHTML. + </p> + + + <a name="changes"/> + <h3>Recent Changes</h3> + <div style="background-color: #f7f7f7; + width: 60%; + border: solid #9c0000; + margin: 0em 2pt 1em 2em; + padding: 1em"> + Runes have now been moved into + a <b>separate CVS module</b> unter the + name <b>closure-common</b>. Releases will be available + as <b>separate tarballs</b> in the download directory. Please + refer to the <a href="installation.html#download"> + installation instructions</a> for details. + </div> + <p class="nomargin"><tt>rel-2007-xx-yy</tt></p> + <ul class="nomargin"> + <li> + Moved runes into a separate project. + </li> + <li> + Incompatible SAX changes: Added new classes + sax:abstract-handler, sax:content-handler, sax:default-handler. + Implementations of SAX handlers should now subclass one of + these classes. + </li> + <li> + fixed make-source :buffering nil, thanks to Magnus Henoch for + the report + </li> + <li> + fixed time and space usage in cases where entity references + follow each other (thanks to Ivan Shvedunov for the report) + </li> + <li> + In the DOM builder, grow a buffer for string normalization + exponentially, fixing a long-standing speed issue. + </li> + </ul> + <p class="nomargin"><tt>rel-2007-08-05</tt></p> + <ul class="nomargin"> + <li>Various DTD serialization fixes</li> + <li>UTF-8 fix, thanks to Francis Leboutte</li> + </ul> + <p class="nomargin"><tt>rel-2007-07-07</tt></p> + <ul class="nomargin"> + <li> + Fixed build on non-Unicode lisps. Fixed parsing on + non-Unicode lisps. Fixed Unicode detection on OpenMCL. + </li> + <li>New function <tt>cxml:parse</tt>.</li> + <li>Serialization no longer defaults to canonical form.</li> + <li>Fixed octet array argument to make-source.</li> + <li> + XMLS compatibility is not <i>bug-for-bug</i>-compatible with + XMLS any more. There is now a mode using pairs of local name + and namespace URI, and a second mode using qualified names + only. The old behaviour using pairs of prefix and local names + was removed. (Thanks to Douglas Crosher.) + </li> + <li> + SCL support (thanks to Douglas Crosher). Includes support for + implementations where URIs are valid namestrings, and a mode + where normal streams are used instead of xstreams and ystreams + (albeit both SCL-specific at this point). + </li> + <li>new convenience serialization function cxml:doctype. Various + DTD serialization fixes.</li> + </ul> + <p class="nomargin"><tt>rel-2007-05-26</tt></p> + <ul class="nomargin"> + <li>cxml.asd has been split up into <tt>cxml.asd</tt> for the + XML parser and <tt>runes.asd</tt> for the runes package, in + preparation of a complete split of the two systems. Future CXML + releases will use separate tarballs for <tt>runes</tt> + and <tt>cxml</tt>.</li> + <li>xml:base support (SAX and Klacks only, not yet used in DOM). + See documentation <a href="sax.html#saxparser">here</a> and <a + href="klacks.html#locator">here</a>.</li> + <li>New class <tt>broadcast-handler</tt> as a generalization + of the older <tt>sax-proxy</tt>.</li> + <li>New class <tt>tapping-source</tt>, a klacks source that + relays events from an upstream klacks source unchanged, while also + emitting them as SAX events to a user-specified handler at the + same time.</li> + <li>Changed attributes to carry an lname even when occurring + without a namespace. Added new functions attribute*, + unparse-attribute, and macro with-element*, with-namespace* to + the SAX generation wrapper API.</li> + <li>Klacks improvements: Incompatibly changed + klacks:find-element and find-event to consider the current event + as a result. Added klacks-error, klacks:expect, klacks:skip, + klacks:expecting-element. Fixed serialize-event to generate + start-prefix-mapping and end-prefix-mapping events. New function + map-current-namespace-declarations.</li> + <li>fixed build with common-lisp-controller</li> + </ul> + <p class="nomargin"><tt>rel-2007-02-18</tt></p> + <ul class="nomargin"> + <li>New StAX-like parser interface.</li> + <li>Serialization fixes (thanks to Nathan Bird, Donavon Keithley).</li> + <li>characters.lisp cleanup (thanks to Nathan Bird).</li> + <li>Namespace normalizer bugfixes.</li> + <li>Minor changes: clone-node on document as an extension. DOM + class hierarchy reworked. New function parse-empty-document. + Fixed the DOM serializer to not throw away local names. + Fixed a long-standing bug in the parser for documents without a + doctype. ANSI conformance fixes.</li> + </ul> + <p class="nomargin"><tt>rel-2006-01-05</tt></p> + <ul class="nomargin"> + <li>Implemented DOM 2 Core.</li> + <li>Error handling overhaul.</li> + <li>UTF-8 string support in DOM on Lisps without Unicode characters.</li> + <li>Sink API has been changed.</li> + <li>Support internal subset serialization.</li> + <li>Whitespace normalizer.</li> + <li>Gilbert Baumann has clarified the license as Lisp-LGPL.</li> + <li>Use trivial-gray-streams.</li> + </ul> + <p class="nomargin"><tt>rel-2005-06-25</tt></p> + <ul class="nomargin"> + <li>Port to OpenMCL (thanks to Rudi Schlatte).</li> + <li>Port to LispWorks (thanks to Edi Weitz).</li> + <li>Minor new features: <tt>include-default-values</tt> argument to + <tt>make-xmls-builder</tt>; <tt>handler</tt> argument + to <tt>parse-dtd-stream</tt>; SAX proxy class</li> + <li>Various bugfixes.</li> + </ul> + <p class="nomargin"><tt>patch-357</tt> (2004-10-10)</p> + <ul class="nomargin"> + <li>Auto-detect unicode support for better asdf-installability.</li> + <li>Use the puri library for Sys-ID handling.</li> + <li>Semi-automatic caching of DTD instances.</li> + <li>Support user-defined entity resolvers.</li> + <li>Support for Oasis XML Catalogs.</li> + <li>xhtmlgen version of Franz htmlgen.</li> + <li>Fixes for SBCL's unicode support.</li> + </ul> + <p class="nomargin"><tt>patch-306</tt> (2004-09-03)</p> + <ul class="nomargin"> + <li>Event-based serialization which does not require DOM documents</li> + <li>XMLS compatiblity</li> + <li>minor bugfixes (thread safety; should work on clisp again)</li> + </ul> + <p class="nomargin"><tt>patch-279</tt> (2004-05-11)</p> + <ul class="nomargin"> + <li>Validation</li> + <li>bugfixes; XHTML DTD parses again; corrected SAX entity handling</li> + </ul> + <p class="nomargin"><tt>patch-204</tt></p> + <ul class="nomargin"> + <li>Renamed package <tt>XML</tt> to <tt>CXML</tt>.</li> + <li>The unparse functions support non-canonical output now.</li> + </ul> + <p class="nomargin"><tt>patch-191</tt> (2004-03-18)</p> + <ul class="nomargin"> + <li>Initial release.</li> + </ul> +</documentation> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/installation.html ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/installation.html Sun Feb 17 09:26:33 2008 @@ -0,0 +1,156 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> +<title>CXML Installation</title> +<link rel="stylesheet" type="text/css" href="cxml.css"> +</head> +<body> +<div class="sidebar"> +<div class="sidebar-title"><a href="index.html">Closure XML</a></div> +<div class="sidebar-main"><ul class="main"> +<li> +<a href="installation.html">Installing Closure XML</a><ul class="sub"> +<li><a href="installation.html#download"><b>Download</b></a></li> +<li><a href="installation.html#implementations">Implementation-specific notes</a></li> +<li><a href="installation.html#compilation">Compilation</a></li> +<li><a href="installation.html#tests">Tests</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li> +<li> +<a href="sax.html">SAX parsing and serialization</a><ul class="sub"> +<li><a href="sax.html#parser">Parsing and Validating</a></li> +<li><a href="sax.html#serialization">Serialization</a></li> +<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li> +<li><a href="sax.html#rods">Recoders</a></li> +<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li> +<li><a href="sax.html#catalogs">XML Catalogs</a></li> +<li><a href="sax.html#sax">SAX Interface</a></li> +</ul> +</li> +<li> +<a href="klacks.html">Klacks parser</a><ul class="sub"> +<li><a href="klacks.html#sources">Parsing incrementally</a></li> +<li><a href="klacks.html#convenience">Convenience functions</a></li> +<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li> +<li><a href="klacks.html#locator">Location information</a></li> +<li><a href="klacks.html#klacksax">Examples</a></li> +</ul> +</li> +<li> +<a href="dom.html">DOM implementation</a><ul class="sub"> +<li><a href="dom.html#parser">Parsing with the DOM builder</a></li> +<li><a href="dom.html#serialization">Serialization</a></li> +<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li> +</ul></div> +</div> + <h1>Installation of Closure XML</h1> + + <a name="download"></a> + <h2>Download</h2> + <ul> + <li> + <div>Download <a href="http://common-lisp.net/project/cxml/download/">tarballs</a> for both cxml itself and closure-common.</div> + </li> + <li> + <div> + Or use anonymous CVS (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cxml/?cvsroot=cxml">browse</a>): + <pre>export CVSROOT=:pserver:anonymous:anonymous@common-lisp.net:/project/cxml/cvsroot +cvs co cxml +cvs co closure-common</pre> + </div> + </li> + </ul> + + <a name="implementations"></a> + <h2>Implementation-specific notes</h2> + <p> + CXML should be portable to all Common Lisp implementations + supported by <a href="http://common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>. + </p> + <ul> + <li> + The SBCL port uses 16 bit surrogate characters instead of taking + advantage of SBCL's full 21 bit character support. + </li> + </ul> + + <a name="compilation"></a> + <h2>Compilation</h2> + <p> + <a href="http://www.cliki.net/asdf">ASDF</a> is used for + compilation. The following instructions assume that ASDF has + already been loaded. + </p> + + <p> + <b>Prerequisites.</b> + CXML needs <a href="http://www.cliki.net/Puri">puri</a> and + <a href="http://www.common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>. + In addition, + <a href="http://www.cliki.net/closure-common">closure-common</a> + is required, which is a separate module in cxml CVS (see above for + check-out instructions). + </p> + + <p> + <b>Compiling and loading CXML.</b> + Register the .asd file, e.g. by symlinking it: + </p> + <pre>$ ln -sf `pwd`/cxml/cxml.asd /path/to/your/registry/ +$ ln -sf `pwd`/closure-common/closure-common.asd /path/to/your/registry/</pre> + <p>Then compile CXML using:</p> + <pre>* (asdf:operate 'asdf:load-op :cxml)</pre> + + <p> + You can then try the <a href="quickstart.html">quick-start example</a>. + </p> + + <a name="tests"></a> + <h2>Tests</h2> + <p>Check out the XML and DOM testsuites:</p> + <pre>$ export CVSROOT=:pserver:anonymous@dev.w3.org:/sources/public +$ cvs login # password is "anonymous" +$ cvs co 2001/XML-Test-Suite/xmlconf +$ cvs co -D '2005-05-06 23:00' 2001/DOM-Test-Suite +$ cd 2001/DOM-Test-Suite && ant dom1-dtd dom2-dtd</pre> + <p> + Omit <tt>-D</tt> to get the latest version, which may not work + with cxml yet. The <tt>ant</tt> step is necessary to run the DOM + tests. + </p> + <p>Usage:</p> + <pre>* (xmlconf:run-all-tests "/path/to/2001/XML-Test-Suite/xmlconf/") +* (domtest:run-all-tests "/path/to/2001/DOM-Test-Suite/") +</pre> + <p> + To compare your results with known output, refer to the files + <tt>XMLCONF</tt> and <tt>DOMTEST</tt> in the cxml distribution. + </p> + + <p> + <i>fixme</i>: Add an explanation of xml/sax-tests here. + </p> + + <p> + <b>fixme</b> domtest.lisp does not understand the current + testsuite driver anymore.  To fix this problem, revert the + affected files manually after check-out: + </p> + + <pre>$ cd 2001/XML-Test-Suite/xmlconf/ +xmltest$ patch -p0 -R </path/to/cxml/test/xmlconf-base.diff</pre> + + <p> + The log message for the changes reads "<i>Removed unnecessary + xml:base attribute</i>".  If I understand correctly, only + DOM 3 parsers provide the baseURI attribute necessary for + understanding <tt>xmlconf.xml</tt> now.  We don't have that + yet. + </p> +</body> +</html> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/installation.xml ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/installation.xml Sun Feb 17 09:26:33 2008 @@ -0,0 +1,107 @@ +<documentation title="CXML Installation"> + <h1>Installation of Closure XML</h1> + + <a name="download"/> + <h2>Download</h2> + <ul> + <li> + <div>Download <a href="http://common-lisp.net/project/cxml/download/">tarballs</a> for both cxml itself and closure-common.</div> + </li> + <li> + <div> + Or use anonymous CVS (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cxml/?cvsroot=cxml">browse</a>): + <pre>export CVSROOT=:pserver:anonymous:anonymous@common-lisp.net:/project/cxml/cvsroot +cvs co cxml +cvs co closure-common</pre> + </div> + </li> + </ul> + + <a name="implementations"/> + <h2>Implementation-specific notes</h2> + <p> + CXML should be portable to all Common Lisp implementations + supported by <a + href="http://common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>. + </p> + <ul> + <li> + The SBCL port uses 16 bit surrogate characters instead of taking + advantage of SBCL's full 21 bit character support. + </li> + </ul> + + <a name="compilation"/> + <h2>Compilation</h2> + <p> + <a href="http://www.cliki.net/asdf">ASDF</a> is used for + compilation. The following instructions assume that ASDF has + already been loaded. + </p> + + <p> + <b>Prerequisites.</b> + CXML needs <a href="http://www.cliki.net/Puri">puri</a> and + <a href="http://www.common-lisp.net/project/cl-plus-ssl/#trivial-gray-streams">trivial-gray-streams</a>. + In addition, + <a href="http://www.cliki.net/closure-common">closure-common</a> + is required, which is a separate module in cxml CVS (see above for + check-out instructions). + </p> + + <p> + <b>Compiling and loading CXML.</b> + Register the .asd file, e.g. by symlinking it: + </p> + <pre>$ ln -sf `pwd`/cxml/cxml.asd /path/to/your/registry/ +$ ln -sf `pwd`/closure-common/closure-common.asd /path/to/your/registry/</pre> + <p>Then compile CXML using:</p> + <pre>* (asdf:operate 'asdf:load-op :cxml)</pre> + + <p> + You can then try the <a href="quickstart.html">quick-start example</a>. + </p> + + <a name="tests"/> + <h2>Tests</h2> + <p>Check out the XML and DOM testsuites:</p> + <pre>$ export CVSROOT=:pserver:anonymous@dev.w3.org:/sources/public +$ cvs login # password is "anonymous" +$ cvs co 2001/XML-Test-Suite/xmlconf +$ cvs co -D '2005-05-06 23:00' 2001/DOM-Test-Suite +$ cd 2001/DOM-Test-Suite && ant dom1-dtd dom2-dtd</pre> + <p> + Omit <tt>-D</tt> to get the latest version, which may not work + with cxml yet. The <tt>ant</tt> step is necessary to run the DOM + tests. + </p> + <p>Usage:</p> + <pre>* (xmlconf:run-all-tests "/path/to/2001/XML-Test-Suite/xmlconf/") +* (domtest:run-all-tests "/path/to/2001/DOM-Test-Suite/") +</pre> + <p> + To compare your results with known output, refer to the files + <tt>XMLCONF</tt> and <tt>DOMTEST</tt> in the cxml distribution. + </p> + + <p> + <i>fixme</i>: Add an explanation of xml/sax-tests here. + </p> + + <p> + <b>fixme</b> domtest.lisp does not understand the current + testsuite driver anymore.  To fix this problem, revert the + affected files manually after check-out: + </p> + + <pre>$ cd 2001/XML-Test-Suite/xmlconf/ +xmltest$ patch -p0 -R </path/to/cxml/test/xmlconf-base.diff</pre> + + <p> + The log message for the changes reads "<i>Removed unnecessary + xml:base attribute</i>".  If I understand correctly, only + DOM 3 parsers provide the baseURI attribute necessary for + understanding <tt>xmlconf.xml</tt> now.  We don't have that + yet. + </p> +</documentation> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/klacks.html ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/klacks.html Sun Feb 17 09:26:33 2008 @@ -0,0 +1,460 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> +<title>CXML Klacks parser</title> +<link rel="stylesheet" type="text/css" href="cxml.css"> +</head> +<body> +<div class="sidebar"> +<div class="sidebar-title"><a href="index.html">Closure XML</a></div> +<div class="sidebar-main"><ul class="main"> +<li> +<a href="installation.html">Installing Closure XML</a><ul class="sub"> +<li><a href="installation.html#download"><b>Download</b></a></li> +<li><a href="installation.html#implementations">Implementation-specific notes</a></li> +<li><a href="installation.html#compilation">Compilation</a></li> +<li><a href="installation.html#tests">Tests</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li> +<li> +<a href="sax.html">SAX parsing and serialization</a><ul class="sub"> +<li><a href="sax.html#parser">Parsing and Validating</a></li> +<li><a href="sax.html#serialization">Serialization</a></li> +<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li> +<li><a href="sax.html#rods">Recoders</a></li> +<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li> +<li><a href="sax.html#catalogs">XML Catalogs</a></li> +<li><a href="sax.html#sax">SAX Interface</a></li> +</ul> +</li> +<li> +<a href="klacks.html">Klacks parser</a><ul class="sub"> +<li><a href="klacks.html#sources">Parsing incrementally</a></li> +<li><a href="klacks.html#convenience">Convenience functions</a></li> +<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li> +<li><a href="klacks.html#locator">Location information</a></li> +<li><a href="klacks.html#klacksax">Examples</a></li> +</ul> +</li> +<li> +<a href="dom.html">DOM implementation</a><ul class="sub"> +<li><a href="dom.html#parser">Parsing with the DOM builder</a></li> +<li><a href="dom.html#serialization">Serialization</a></li> +<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li> +</ul></div> +</div> + <h1>Klacks parser</h1> + <p> + The Klacks parser provides an alternative parsing interface, + similar in concept to Java's <a href="http://jcp.org/en/jsr/detail?id=173">Streaming API for + XML</a> (StAX). + </p> + <p> + It implements a streaming, "pull-based" API. This is different + from SAX, which is a "push-based" model. + </p> + <p> + Klacks is implemented using the same code base as the SAX parser + and has the same parsing characteristics (validation, namespace + support, entity resolution) while offering a more flexible interface + than SAX. + </p> + <p> + See below for <a href="#examples">examples</a>. + </p> + + <a name="sources"></a> + <h3>Parsing incrementally using sources</h3> + <p> + To parse using Klacks, create an XML <tt>source</tt> first. + </p> + <p> + <div class="def">Function CXML:MAKE-SOURCE (input &key validate + dtd root entity-resolver disallow-external-subset pathname)</div> + Create and return a source for <tt>input</tt>. + </p> + <p> + Exact behaviour depends on <tt>input</tt>, which can + be one of the following types: + </p> + <ul> + <li> + <tt>pathname</tt> -- a Common Lisp pathname. + Open the file specified by the pathname and create a source for + the resulting stream. See below for information on how to + close the stream. + </li> + <li> +<tt>stream</tt> -- a Common Lisp stream with element-type + <tt>(unsigned-byte 8)</tt>. See below for information on how to + close the stream. + </li> + <li> + <tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array. + The array is parsed directly, and interpreted according to the + encoding it specifies. + </li> + <li> + <tt>string</tt>/<tt>rod</tt> -- a rod (or <tt>string</tt> on + unicode-capable implementations). + Parses an XML document from the input string that has already + undergone external-format decoding. + </li> + </ul> + <p> + <b>Closing streams:</b> Sources can refer to Lisp streams that + need to be closed after parsing. This includes a stream passed + explicitly as <tt>input</tt>, a stream created implicitly for the + <tt>pathname</tt> case, as well as any streams created + automatically for external parsed entities referred to by the + document. + </p> + <p> + All these stream get closed automatically if end of file is + reached normally. Use <tt>klacks:close-source</tt> or + <tt>klacks:with-open-source</tt> to ensure that the streams get + closed otherwise. + </p> + <p> + <b>Buffering:</b> By default, the Klacks parser performs buffering + of octets being read from the stream as an optimization. This can + result in unwanted blocking if the stream is a socket and the + parser tries to read more data than required to parse the current + event. Use <tt>:buffering nil</tt> to disable this optimization. + </p> + <ul> + <li> + <tt>buffering</tt> -- Boolean, defaults to <tt>t</tt>. If + enabled, read data several kilobytes at time. If disabled, + read only single bytes at a time. + </li> + </ul> + <p> + The following <b>keyword arguments</b> have the same meaning as + with the SAX parser, please refer to the documentation of <a href="sax.html#parser">parse-file</a> for more information: + </p> + <ul> + <li> + <tt>validate</tt> + </li> + <li> + <tt>dtd</tt> + </li> + <li> +<tt>root</tt> + </li> + <li> + <tt>entity-resolver</tt> + </li> + <li> + <tt>disallow-internal-subset</tt> + </li> + </ul> + <p> + In addition, the following argument is for types of <tt>input</tt> + other than <tt>pathname</tt>: + </p> + <ul> + <li> + <tt>pathname</tt> -- If specified, defines the base URI of the + document based on this pathname instance. + </li> + </ul> + + <p> + Events are read from the stream using the following functions: + </p> + <div class="def">Function KLACKS:PEEK (source)</div> + <p> => :start-document<br> + or => :start-document, version, encoding, standalonep<br> + or => :dtd, name, public-id, system-id<br> + or => :start-element, uri, lname, qname<br> + or => :end-element, uri, lname, qname<br> + or => :characters, data<br> + or => :processing-instruction, target, data<br> + or => :comment, data<br> + or => :end-document, data<br> + or => nil + </p> + <p> + <tt>peek</tt> returns the current event's key and main values. + </p> + <p> + <div class="def">Function KLACKS:PEEK-NEXT (source) => key, value*</div> + </p> + <p> + Advance the source forward to the next event and returns it + like <tt>peek</tt> would. + </p> + <p> + <div class="def">Function KLACKS:PEEK-VALUE (source) => value*</div> + </p> + <p> + Like <tt>peek</tt>, but return only the values, not the key. + </p> + <p> + <div class="def">Function KLACKS:CONSUME (source) => key, value*</div> + </p> + <p> + Return the same values <tt>peek</tt> would, and in addition + advance the source forward to the next event. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-URI (source) => uri</div> + <div class="def">Function KLACKS:CURRENT-LNAME (source) => string</div> + <div class="def">Function KLACKS:CURRENT-QNAME (source) => string</div> + </p> + <p> + If the current event is :start-element or :end-element, return the + corresponding value. Else, signal an error. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-CHARACTERS (source) => string</div> + </p> + <p> + If the current event is :characters, return the character data + value. Else, signal an error. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-CDATA-SECTION-P (source) => boolean</div> + </p> + <p> + If the current event is :characters, determine whether the data was + specified using a CDATA section in the source document. Else, + signal an error. + </p> + <p> + <div class="def">Function KLACKS:MAP-CURRENT-NAMESPACE-DECLARATIONS (fn source) => nil</div> + </p> + <p> + For use only on :start-element and :end-element events, this + function report every namespace declaration on the current element. + On :start-element, these correspond to the xmlns attributes of the + start tag. On :end-element, the declarations of the corresponding + start tag are reported. No inherited namespaces are + included. <tt>fn</tt> is called only for each declaration with two + arguments, the prefix and uri. + </p> + <p> + <div class="def">Function KLACKS:MAP-ATTRIBUTES (fn source)</div> + </p> + <p> + Call <tt>fn</tt> for each attribute of the current start tag in + turn, and pass the following values as arguments to the function: + <ul> + <li>namespace uri</li> + <li>local name</li> + <li>qualified name</li> + <li>attribute value</li> + <li>a boolean indicating whether the attribute was specified + explicitly in the source document, rather than defaulted from + a DTD</li> + </ul> + Only valid for :start-element. + </p> + <p> + Return a list of SAX attribute structures for the current start tag. + Only valid for :start-element. + </p> + + <p> + <div class="def">Function KLACKS:CLOSE-SOURCE (source)</div> + Close all streams referred to by <tt>source</tt>. + </p> + <p> + <div class="def">Macro KLACKS:WITH-OPEN-SOURCE ((var source) &body body)</div> + Evaluate <tt>source</tt> to create a source object, bind it to + symbol <tt>var</tt> and evaluate <tt>body</tt> as an implicit progn. + Call <tt>klacks:close-source</tt> to close the source after + exiting <tt>body</tt>, whether normally or abnormally. + </p> + + <a name="convenience"></a> + <h3>Convenience functions</h3> + <p> + <div class="def">Function KLACKS:FIND-EVENT (source key)</div> + Read events from <tt>source</tt> and discard them until an event + of type <i>key</i> is found. Return values like <tt>peek</tt>, or + NIL if no such event was found. + </p> + <p> + <div class="def">Function KLACKS:FIND-ELEMENT (source &optional + lname uri)</div> + Read events from <tt>source</tt> and discard them until an event + of type :start-element is found with matching local name and + namespace uri is found. If <tt>lname</tt> is <tt>nil</tt>, any + tag name matches. If <tt>uri</tt> is <tt>nil</tt>, any + namespace matches. Return values like <tt>peek</tt> or NIL if no + such event was found. + </p> + <p> + <div class="def">Condition KLACKS:KLACKS-ERROR (xml-parse-error)</div> + The condition class signalled by <tt>expect</tt>. + </p> + <p> + <div class="def">Function KLACKS:EXPECT (source key &optional + value1 value2 value3)</div> + Assert that the current event is equal to (key value1 value2 + value3). (Ignore <i>value</i> arguments that are NIL.) If so, + return it as multiple values. Otherwise signal a + <tt>klacks-error</tt>. + </p> + <p> + <div class="def">Function KLACKS:SKIP (source key &optional + value1 value2 value3)</div> + <tt>expect</tt> the specific event, then <tt>consume</tt> it. + </p> + <p> + <div class="def">Macro KLACKS:EXPECTING-ELEMENT ((fn source + &optional lname uri) &body body</div> + Assert that the current event matches (:start-element uri lname). + (Ignore <i>value</i> arguments that are NIL) Otherwise signal a + <tt>klacks-error</tt>. + Evaluate <tt>body</tt> as an implicit progn. Finally assert that + the remaining event matches (:end-element uri lname). + </p> + + <a name="klacksax"></a> + <h3>Bridging Klacks and SAX</h3> + <p> + <div class="def">Function KLACKS:SERIALIZE-EVENT (source handler)</div> + Send the current klacks event from <tt>source</tt> as a SAX + event to the SAX <tt>handler</tt> and consume it. + </p> + <p> + <div class="def">Function KLACKS:SERIALIZE-ELEMENT (source handler + &key document-events)</div> + Read all klacks events from the following <tt>:start-element</tt> to + its <tt>:end-element</tt> and send them as SAX events + to <tt>handler</tt>. When this function is called, the current + event must be <tt>:start-element</tt>, else an error is + signalled. With <tt>document-events</tt> (the default), + <tt>sax:start-document</tt> and <tt>sax:end-document</tt> events + are sent around the element. + </p> + <p> + <div class="def">Function KLACKS:SERIALIZE-SOURCE (source handler)</div> + Read all klacks events from <tt>source</tt> and send them as SAX + events to the SAX <tt>handler</tt>. + </p> + <p> + <div class="def">Class KLACKS:TAPPING-SOURCE (source)</div> + A klacks source that relays events from an upstream klacks source + unchanged, while also emitting them as SAX events to a + user-specified handler at the same time. + </p> + <p> + <div class="def">Functon KLACKS:MAKE-TAPPING-SOURCE + (upstream-source &optional sax-handler)</div> + Create a tapping source relaying events + for <tt>upstream-source</tt>, and sending SAX events + to <tt>sax-handler</tt>. + </p> + + <a name="locator"></a> + <h3>Location information</h3> + <p> + <div class="def">Function KLACKS:CURRENT-LINE-NUMBER (source)</div> + Return an approximation of the current line number, or NIL. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-COLUMN-NUMBER (source)</div> + Return an approximation of the current column number, or NIL. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-SYSTEM-ID (source)</div> + Return the URI of the document being parsed. This is either the + main document, or the entity's system ID while contents of a parsed + general external entity are being processed. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-XML-BASE (source)</div> + Return the [Base URI] of the current element. This URI can differ from + the value returned by <tt>current-system-id</tt> if xml:base + attributes are present. + </p> + + <a name="examples"></a> + <h3>Examples</h3> + <p> + The following example illustrates creation of a klacks <tt>source</tt>, + use of the <tt>peek-next</tt> function to read individual events, + and shows some of the most common event types. + </p> + <pre>* <b>(defparameter *source* (cxml:make-source "<example>text</example>"))</b> +*SOURCE* + +* <b>(klacks:peek-next *source*)</b> +:START-DOCUMENT + +* <b>(klacks:peek-next *source*)</b> +:START-ELEMENT +NIL ;namespace URI +"example" ;local name +"example" ;qualified name + +* <b>(klacks:peek-next *source*)</b> +:CHARACTERS +"text" + +* <b>(klacks:peek-next *source*)</b> +:END-ELEMENT +NIL +"example" +"example" + +* <b>(klacks:peek-next *source*)</b> +:END-DOCUMENT + +* <b>(klacks:peek-next *source*)</b> +NIL</pre> + + <p> + In this example, <tt>find-element</tt> is used to skip over the + uninteresting events until the opening <tt>child1</tt> tag is + found. Then <tt>serialize-element</tt> is used to generate SAX + events for the following element, including its children, and an + xmls-compatible list structure is built from those + events. <tt>find-element</tt> skips over whitespace, + and <tt>find-event</tt> is used to parse up + to <tt>:end-document</tt>, ensuring that the source has been + closed. + </p> + <pre>* <b>(defparameter *source* + (cxml:make-source "<example> + <child1><p>foo</p></child1> + <child2 bar='baz'/> + </example>"))</b> +*SOURCE* + +* <b>(klacks:find-element *source* "child1")</b> +:START-ELEMENT +NIL +"child1" +"child1" + +* <b>(klacks:serialize-element *source* (cxml-xmls:make-xmls-builder))</b> +("child1" NIL ("p" NIL "foo")) + +* <b>(klacks:find-element *source*)</b> +:START-ELEMENT +NIL +"child2" +"child2" + +* <b>(klacks:serialize-element *source* (cxml-xmls:make-xmls-builder))</b> +("child2" (("bar" "baz"))) + +* <b>(klacks:find-event *source* :end-document)</b> +:END-DOCUMENT +NIL +NIL +NIL +</pre> +</body> +</html> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/klacks.xml ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/klacks.xml Sun Feb 17 09:26:33 2008 @@ -0,0 +1,410 @@ +<documentation title="CXML Klacks parser"> + <h1>Klacks parser</h1> + <p> + The Klacks parser provides an alternative parsing interface, + similar in concept to Java's <a + href="http://jcp.org/en/jsr/detail?id=173">Streaming API for + XML</a> (StAX). + </p> + <p> + It implements a streaming, "pull-based" API. This is different + from SAX, which is a "push-based" model. + </p> + <p> + Klacks is implemented using the same code base as the SAX parser + and has the same parsing characteristics (validation, namespace + support, entity resolution) while offering a more flexible interface + than SAX. + </p> + <p> + See below for <a href="#examples">examples</a>. + </p> + + <a name="sources"/> + <h3>Parsing incrementally using sources</h3> + <p> + To parse using Klacks, create an XML <tt>source</tt> first. + </p> + <p> + <div class="def">Function CXML:MAKE-SOURCE (input &key validate + dtd root entity-resolver disallow-external-subset pathname)</div> + Create and return a source for <tt>input</tt>. + </p> + <p> + Exact behaviour depends on <tt>input</tt>, which can + be one of the following types: + </p> + <ul> + <li> + <tt>pathname</tt> -- a Common Lisp pathname. + Open the file specified by the pathname and create a source for + the resulting stream. See below for information on how to + close the stream. + </li> + <li><tt>stream</tt> -- a Common Lisp stream with element-type + <tt>(unsigned-byte 8)</tt>. See below for information on how to + close the stream. + </li> + <li> + <tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array. + The array is parsed directly, and interpreted according to the + encoding it specifies. + </li> + <li> + <tt>string</tt>/<tt>rod</tt> -- a rod (or <tt>string</tt> on + unicode-capable implementations). + Parses an XML document from the input string that has already + undergone external-format decoding. + </li> + </ul> + <p> + <b>Closing streams:</b> Sources can refer to Lisp streams that + need to be closed after parsing. This includes a stream passed + explicitly as <tt>input</tt>, a stream created implicitly for the + <tt>pathname</tt> case, as well as any streams created + automatically for external parsed entities referred to by the + document. + </p> + <p> + All these stream get closed automatically if end of file is + reached normally. Use <tt>klacks:close-source</tt> or + <tt>klacks:with-open-source</tt> to ensure that the streams get + closed otherwise. + </p> + <p> + <b>Buffering:</b> By default, the Klacks parser performs buffering + of octets being read from the stream as an optimization. This can + result in unwanted blocking if the stream is a socket and the + parser tries to read more data than required to parse the current + event. Use <tt>:buffering nil</tt> to disable this optimization. + </p> + <ul> + <li> + <tt>buffering</tt> -- Boolean, defaults to <tt>t</tt>. If + enabled, read data several kilobytes at time. If disabled, + read only single bytes at a time. + </li> + </ul> + <p> + The following <b>keyword arguments</b> have the same meaning as + with the SAX parser, please refer to the documentation of <a + href="sax.html#parser">parse-file</a> for more information: + </p> + <ul> + <li> + <tt>validate</tt> + </li> + <li> + <tt>dtd</tt> + </li> + <li><tt>root</tt> + </li> + <li> + <tt>entity-resolver</tt> + </li> + <li> + <tt>disallow-internal-subset</tt> + </li> + </ul> + <p> + In addition, the following argument is for types of <tt>input</tt> + other than <tt>pathname</tt>: + </p> + <ul> + <li> + <tt>pathname</tt> -- If specified, defines the base URI of the + document based on this pathname instance. + </li> + </ul> + + <p> + Events are read from the stream using the following functions: + </p> + <div class="def">Function KLACKS:PEEK (source)</div> + <p> => :start-document<br/> + or => :start-document, version, encoding, standalonep<br/> + or => :dtd, name, public-id, system-id<br/> + or => :start-element, uri, lname, qname<br/> + or => :end-element, uri, lname, qname<br/> + or => :characters, data<br/> + or => :processing-instruction, target, data<br/> + or => :comment, data<br/> + or => :end-document, data<br/> + or => nil + </p> + <p> + <tt>peek</tt> returns the current event's key and main values. + </p> + <p> + <div class="def">Function KLACKS:PEEK-NEXT (source) => key, value*</div> + </p> + <p> + Advance the source forward to the next event and returns it + like <tt>peek</tt> would. + </p> + <p> + <div class="def">Function KLACKS:PEEK-VALUE (source) => value*</div> + </p> + <p> + Like <tt>peek</tt>, but return only the values, not the key. + </p> + <p> + <div class="def">Function KLACKS:CONSUME (source) => key, value*</div> + </p> + <p> + Return the same values <tt>peek</tt> would, and in addition + advance the source forward to the next event. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-URI (source) => uri</div> + <div class="def">Function KLACKS:CURRENT-LNAME (source) => string</div> + <div class="def">Function KLACKS:CURRENT-QNAME (source) => string</div> + </p> + <p> + If the current event is :start-element or :end-element, return the + corresponding value. Else, signal an error. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-CHARACTERS (source) => string</div> + </p> + <p> + If the current event is :characters, return the character data + value. Else, signal an error. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-CDATA-SECTION-P (source) => boolean</div> + </p> + <p> + If the current event is :characters, determine whether the data was + specified using a CDATA section in the source document. Else, + signal an error. + </p> + <p> + <div class="def">Function KLACKS:MAP-CURRENT-NAMESPACE-DECLARATIONS (fn source) => nil</div> + </p> + <p> + For use only on :start-element and :end-element events, this + function report every namespace declaration on the current element. + On :start-element, these correspond to the xmlns attributes of the + start tag. On :end-element, the declarations of the corresponding + start tag are reported. No inherited namespaces are + included. <tt>fn</tt> is called only for each declaration with two + arguments, the prefix and uri. + </p> + <p> + <div class="def">Function KLACKS:MAP-ATTRIBUTES (fn source)</div> + </p> + <p> + Call <tt>fn</tt> for each attribute of the current start tag in + turn, and pass the following values as arguments to the function: + <ul> + <li>namespace uri</li> + <li>local name</li> + <li>qualified name</li> + <li>attribute value</li> + <li>a boolean indicating whether the attribute was specified + explicitly in the source document, rather than defaulted from + a DTD</li> + </ul> + Only valid for :start-element. + </p> + <p> + Return a list of SAX attribute structures for the current start tag. + Only valid for :start-element. + </p> + + <p> + <div class="def">Function KLACKS:CLOSE-SOURCE (source)</div> + Close all streams referred to by <tt>source</tt>. + </p> + <p> + <div class="def">Macro KLACKS:WITH-OPEN-SOURCE ((var source) &body body)</div> + Evaluate <tt>source</tt> to create a source object, bind it to + symbol <tt>var</tt> and evaluate <tt>body</tt> as an implicit progn. + Call <tt>klacks:close-source</tt> to close the source after + exiting <tt>body</tt>, whether normally or abnormally. + </p> + + <a name="convenience"/> + <h3>Convenience functions</h3> + <p> + <div class="def">Function KLACKS:FIND-EVENT (source key)</div> + Read events from <tt>source</tt> and discard them until an event + of type <i>key</i> is found. Return values like <tt>peek</tt>, or + NIL if no such event was found. + </p> + <p> + <div class="def">Function KLACKS:FIND-ELEMENT (source &optional + lname uri)</div> + Read events from <tt>source</tt> and discard them until an event + of type :start-element is found with matching local name and + namespace uri is found. If <tt>lname</tt> is <tt>nil</tt>, any + tag name matches. If <tt>uri</tt> is <tt>nil</tt>, any + namespace matches. Return values like <tt>peek</tt> or NIL if no + such event was found. + </p> + <p> + <div class="def">Condition KLACKS:KLACKS-ERROR (xml-parse-error)</div> + The condition class signalled by <tt>expect</tt>. + </p> + <p> + <div class="def">Function KLACKS:EXPECT (source key &optional + value1 value2 value3)</div> + Assert that the current event is equal to (key value1 value2 + value3). (Ignore <i>value</i> arguments that are NIL.) If so, + return it as multiple values. Otherwise signal a + <tt>klacks-error</tt>. + </p> + <p> + <div class="def">Function KLACKS:SKIP (source key &optional + value1 value2 value3)</div> + <tt>expect</tt> the specific event, then <tt>consume</tt> it. + </p> + <p> + <div class="def">Macro KLACKS:EXPECTING-ELEMENT ((fn source + &optional lname uri) &body body</div> + Assert that the current event matches (:start-element uri lname). + (Ignore <i>value</i> arguments that are NIL) Otherwise signal a + <tt>klacks-error</tt>. + Evaluate <tt>body</tt> as an implicit progn. Finally assert that + the remaining event matches (:end-element uri lname). + </p> + + <a name="klacksax"/> + <h3>Bridging Klacks and SAX</h3> + <p> + <div class="def">Function KLACKS:SERIALIZE-EVENT (source handler)</div> + Send the current klacks event from <tt>source</tt> as a SAX + event to the SAX <tt>handler</tt> and consume it. + </p> + <p> + <div class="def">Function KLACKS:SERIALIZE-ELEMENT (source handler + &key document-events)</div> + Read all klacks events from the following <tt>:start-element</tt> to + its <tt>:end-element</tt> and send them as SAX events + to <tt>handler</tt>. When this function is called, the current + event must be <tt>:start-element</tt>, else an error is + signalled. With <tt>document-events</tt> (the default), + <tt>sax:start-document</tt> and <tt>sax:end-document</tt> events + are sent around the element. + </p> + <p> + <div class="def">Function KLACKS:SERIALIZE-SOURCE (source handler)</div> + Read all klacks events from <tt>source</tt> and send them as SAX + events to the SAX <tt>handler</tt>. + </p> + <p> + <div class="def">Class KLACKS:TAPPING-SOURCE (source)</div> + A klacks source that relays events from an upstream klacks source + unchanged, while also emitting them as SAX events to a + user-specified handler at the same time. + </p> + <p> + <div class="def">Functon KLACKS:MAKE-TAPPING-SOURCE + (upstream-source &optional sax-handler)</div> + Create a tapping source relaying events + for <tt>upstream-source</tt>, and sending SAX events + to <tt>sax-handler</tt>. + </p> + + <a name="locator"/> + <h3>Location information</h3> + <p> + <div class="def">Function KLACKS:CURRENT-LINE-NUMBER (source)</div> + Return an approximation of the current line number, or NIL. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-COLUMN-NUMBER (source)</div> + Return an approximation of the current column number, or NIL. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-SYSTEM-ID (source)</div> + Return the URI of the document being parsed. This is either the + main document, or the entity's system ID while contents of a parsed + general external entity are being processed. + </p> + <p> + <div class="def">Function KLACKS:CURRENT-XML-BASE (source)</div> + Return the [Base URI] of the current element. This URI can differ from + the value returned by <tt>current-system-id</tt> if xml:base + attributes are present. + </p> + + <a name="examples"/> + <h3>Examples</h3> + <p> + The following example illustrates creation of a klacks <tt>source</tt>, + use of the <tt>peek-next</tt> function to read individual events, + and shows some of the most common event types. + </p> + <pre>* <b>(defparameter *source* (cxml:make-source "<example>text</example>"))</b> +*SOURCE* + +* <b>(klacks:peek-next *source*)</b> +:START-DOCUMENT + +* <b>(klacks:peek-next *source*)</b> +:START-ELEMENT +NIL ;namespace URI +"example" ;local name +"example" ;qualified name + +* <b>(klacks:peek-next *source*)</b> +:CHARACTERS +"text" + +* <b>(klacks:peek-next *source*)</b> +:END-ELEMENT +NIL +"example" +"example" + +* <b>(klacks:peek-next *source*)</b> +:END-DOCUMENT + +* <b>(klacks:peek-next *source*)</b> +NIL</pre> + + <p> + In this example, <tt>find-element</tt> is used to skip over the + uninteresting events until the opening <tt>child1</tt> tag is + found. Then <tt>serialize-element</tt> is used to generate SAX + events for the following element, including its children, and an + xmls-compatible list structure is built from those + events. <tt>find-element</tt> skips over whitespace, + and <tt>find-event</tt> is used to parse up + to <tt>:end-document</tt>, ensuring that the source has been + closed. + </p> + <pre>* <b>(defparameter *source* + (cxml:make-source "<example> + <child1><p>foo</p></child1> + <child2 bar='baz'/> + </example>"))</b> +*SOURCE* + +* <b>(klacks:find-element *source* "child1")</b> +:START-ELEMENT +NIL +"child1" +"child1" + +* <b>(klacks:serialize-element *source* (cxml-xmls:make-xmls-builder))</b> +("child1" NIL ("p" NIL "foo")) + +* <b>(klacks:find-element *source*)</b> +:START-ELEMENT +NIL +"child2" +"child2" + +* <b>(klacks:serialize-element *source* (cxml-xmls:make-xmls-builder))</b> +("child2" (("bar" "baz"))) + +* <b>(klacks:find-event *source* :end-document)</b> +:END-DOCUMENT +NIL +NIL +NIL +</pre> +</documentation> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/quickstart.html ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/quickstart.html Sun Feb 17 09:26:33 2008 @@ -0,0 +1,312 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> +<title>CXML Quick-Start Example</title> +<link rel="stylesheet" type="text/css" href="cxml.css"> +</head> +<body> +<div class="sidebar"> +<div class="sidebar-title"><a href="index.html">Closure XML</a></div> +<div class="sidebar-main"><ul class="main"> +<li> +<a href="installation.html">Installing Closure XML</a><ul class="sub"> +<li><a href="installation.html#download"><b>Download</b></a></li> +<li><a href="installation.html#implementations">Implementation-specific notes</a></li> +<li><a href="installation.html#compilation">Compilation</a></li> +<li><a href="installation.html#tests">Tests</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li> +<li> +<a href="sax.html">SAX parsing and serialization</a><ul class="sub"> +<li><a href="sax.html#parser">Parsing and Validating</a></li> +<li><a href="sax.html#serialization">Serialization</a></li> +<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li> +<li><a href="sax.html#rods">Recoders</a></li> +<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li> +<li><a href="sax.html#catalogs">XML Catalogs</a></li> +<li><a href="sax.html#sax">SAX Interface</a></li> +</ul> +</li> +<li> +<a href="klacks.html">Klacks parser</a><ul class="sub"> +<li><a href="klacks.html#sources">Parsing incrementally</a></li> +<li><a href="klacks.html#convenience">Convenience functions</a></li> +<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li> +<li><a href="klacks.html#locator">Location information</a></li> +<li><a href="klacks.html#klacksax">Examples</a></li> +</ul> +</li> +<li> +<a href="dom.html">DOM implementation</a><ul class="sub"> +<li><a href="dom.html#parser">Parsing with the DOM builder</a></li> +<li><a href="dom.html#serialization">Serialization</a></li> +<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li> +</ul></div> +</div> + <h1>Quick-Start Example / FAQ</h1> + + <p> + Make sure to <a href="installation.html#installation">install and load</a> cxml first. + </p> + + <h3> + On this page + </h3> + <ul> +<li><a href="#id53435"><heading>Parsing a file</heading></a></li> +<li><a href="#id54079"><heading>Using DOM</heading></a></li> +<li><a href="#id54112"><heading>Serializing DOM</heading></a></li> +<li><a href="#id54132"><heading>Parsing into XMLS-like lists</heading></a></li> +<li><a href="#id54176"><heading>Parsing incrementally using Klacks</heading></a></li> +<li><a href="#id54210"><heading>Writing XML</heading></a></li> +<li><a href="#id54235"><heading>Help! CXML says 'URI scheme :HTTP not supported'</heading></a></li> +<li><a href="#id54302"><heading>Loading DTDs from local files</heading></a></li> +<li><a href="#id54328"><heading>Can I skip loading of DTDs entirely?</heading></a></li> +<li><a href="#id54364"><heading> + Catalogs: How can I use the HTML DTD installed by my distribution? + </heading></a></li> +<li><a href="#id54390"><heading> + Can I load DTDs through HTTP? + </heading></a></li> +</ul> + + <p> + To try the following examples, create a test file + called <tt>example.xml</tt>: + </p> + <pre>* <b>(with-open-file (s "example.xml" :direction :output) + (write-string "<test a='b'><child/></test>" s))</b></pre> + + <a name="id53435"></a><h3><heading>Parsing a file</heading></h3> + + <p>Parse <tt>example.xml</tt> into a DOM tree (<a href="sax.html#parser">read + more</a>):</p> + <pre>* <b>(cxml:parse-file "example.xml" (cxml-dom:make-dom-builder))</b> +#<DOM-IMPL::DOCUMENT @ #x72206172> + +;; save result for later: +* <b>(defparameter *example* *)</b> +*EXAMPLE*</pre> + + <a name="id54079"></a><h3><heading>Using DOM</heading></h3> + + <p>Inspect the DOM tree (<a href="sax.html#dom">read more</a>):</p> + <pre>* <b>(dom:document-element *example*)</b> +#<DOM-IMPL::ELEMENT test @ #x722b6ba2> + +* (<b>dom:tag-name</b> (dom:document-element *example*)) +"test" + +* (<b>dom:child-nodes</b> (dom:document-element *example*)) +#(#<DOM-IMPL::ELEMENT child @ #x722b6d8a>) + +* (<b>dom:get-attribute</b> (dom:document-element *example*) <b>"a"</b>) +"b"</pre> + + <a name="id54112"></a><h3><heading>Serializing DOM</heading></h3> + + <p>Serialize the DOM document back into a file (<a href="sax.html#serialization">read more</a>):</p> + <pre>(with-open-file (out "example.out" :direction :output :element-type '(unsigned-byte 8)) + <b>(dom:map-document (cxml:make-octet-stream-sink out) *example*)</b></pre> + + <a name="id54132"></a><h3><heading>Parsing into XMLS-like lists</heading></h3> + + <p> + If DOM is not the representation you want to you, parsing into + other data structures is possible using the same SAX parser + function, while using a different handler. + The XMLS builder is included for compatibility with XMLS, and also + also sample code (see cxml/xml/xmls-compat.lisp) for your own + handlers. + </p> + + <p>As an alternative to DOM, parse into xmls-compatible list + structure (<a href="xmls-compat.html">read more</a>):</p> + <pre>* <b>(cxml:parse-file "example.xml" (cxml-xmls:make-xmls-builder))</b> +("test" (("a" "b")) ("child" NIL))</pre> + + <p> + Again, serialization into XML is done using a sink as a SAX + handler and a data-structure specific function to generate SAX + events for the document, in this case <tt>cxml-xmls:map-node</tt>. + </p> + + <pre>* (with-open-file (out "example.out" :direction :output :element-type '(unsigned-byte 8)) + (<b>cxml-xmls:map-node (cxml:make-octet-stream-sink out) + '("test" (("a" "b")) ("child" nil)))</b>)</pre> + + <a name="id54176"></a><h3><heading>Parsing incrementally using Klacks</heading></h3> + + <p>Use klacks to read events from the parser incrementally. The + following example looks only for :start-element and :end-element + events and prints them (<a href="klacks.html">read more</a>):</p> + <pre>* <b>(klacks:with-open-source + (s (cxml:make-source #p"example.xml"))</b> + (loop + for key = <b>(klacks:peek s)</b> + while key + do + (case key + (:start-element + (format t "~A {" <b>(klacks:current-qname s)</b>)) + (:end-element + (format t "}"))) + <b>(klacks:consume s)</b>)) +test {child {}}</pre> + + <a name="id54210"></a><h3><heading>Writing XML</heading></h3> + + <p> + Serialization is always done using sinks, which accept SAX events, + but there are convenience functions and macros to make that easier + to use: + </p> + <pre>(cxml:with-xml-output (cxml:make-octet-stream-sink stream :indentation 2 :canonical nil) + (cxml:with-element "foo" + (cxml:attribute "xyz" "abc") + (cxml:with-element "bar" + (cxml:attribute "blub" "bla")) + (cxml:text "Hi there.")))</pre> + <p> + Prints this to <tt>stream</tt>: + </p> + <pre><foo xyz="abc"> + <bar blub="bla"></bar> + Hi there. +</foo></pre> + + <a name="id54235"></a><h3><heading>Help! CXML says 'URI scheme :HTTP not supported'</heading></h3> + + <p> + By default, this error will occur when the DTD (or generally, any + entity) has an http:// URL as its system ID. CXML itself + understands only file:// URLs, but allows users to customize the + behaviour for all URLs. + </p> + + <p> + The are several solutions to this, covered in detail below: + <ul> + <li> + Load the DTD/entity from local files using an entity resolver + </li> + <li> + Skip parsing of the DTD/entity entirely by pretending it is + empty, again using an entity resolver. + </li> + <li> + Use a <em>catalog</em> to make CXML find DTDs in the local + filesystem automatically. + </li> + <li> + Teach CXML actually load DTDs using HTTP. + </li> + </ul> + </p> + + <p> + Here are the example files for the following solutions to this + problem: + </p> + + <a href="http://www.lichteblau.com/blubba/dtdexample.xml"> + <tt>dtdexample.xml</tt>:</a> + <pre><!DOCTYPE test SYSTEM 'http://www.lichteblau.com/blubba/dtdexample.dtd'>; +<test a='b'>blub<child/></test></pre> + + <a href="http://www.lichteblau.com/blubba/dtdexample.dtd"> + <tt>dtdexample.dtd</tt></a>: + <pre><!ELEMENT test (#PCDATA|child)*> +<!ATTLIST test + a CDATA #REQUIRED + > + +<!ELEMENT child EMPTY> +</pre> + + <a name="id54302"></a><h3><heading>Loading DTDs from local files</heading></h3> + + <p> + Use the :entity-resolver argument to <tt>parse-file</tt> to + specify a function that maps System IDs and Public IDs to local + files of your choice: + </p> + + <pre>(let ((uri "http://www.lichteblau.com/blubba/dtdexample.dtd") + (pathname "dtdexample.dtd")) + (flet ((resolver (pubid sysid) + (declare (ignore pubid)) + <b>(when (puri:uri= sysid (puri:parse-uri uri)) + (open pathname :element-type '(unsigned-byte 8)))</b>)) + (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>)))</pre> + + + <a name="id54328"></a><h3><heading>Can I skip loading of DTDs entirely?</heading></h3> + + <p> + Yes and no. + </p> + <p> + <i>Yes</i>, you can force CXML to do this, see the following example. + </p> + + <p> + But no, skipping the DTD will not actually work if the document + references entities declared in the DTD, especially since neither + SAX nor DOM are able to report unresolved entity references in + attributes. + </p> + + <p> + The trick to make CXML skip the DTD is to pretend that it is empty + by returning a zero-length stream instead: + </p> + + <pre>(flet ((resolver (pubid sysid) + (declare (ignore pubid sysid)) + <b>(flexi-streams:make-in-memory-input-stream nil)</b>)) + (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>))</pre> + + <a name="id54364"></a><h3><heading> + Catalogs: How can I use the HTML DTD installed by my distribution? + </heading></h3> + + <p> + Rather than writing an entity resolver function yourself, CXML can + use XML catalogs to find DTDs and entity files on your local system. + </p> + <p> + Catalogs are particularly helpful for DTDs that are + pre-installed. For example, most Linux distributions include a + package for the XHTML DTD. The DTD will reside in a + distribution-dependent location, which the central catalog file + points to. + </p> + <p>By default, CXML looks for the catalog in /etc/xml/catalog + (Linux) and /usr/local/share/xml/catalog.ports (FreeBSD). + </p> + <pre>* <b>(setf cxml:*catalog* (cxml:make-catalog))</b> +* (cxml:parse-file "test.xhtml" (cxml-dom:make-dom-builder))</pre> + + <a name="id54390"></a><h3><heading> + Can I load DTDs through HTTP? + </heading></h3> + + <p> + Sure, just use an entity-resolver function that does it. + </p> + <p> + Install <a href="http://weitz.de/drakma/">Drakma</a> and try this: + </p> + <pre>(flet ((resolver (pubid sysid) + (declare (ignore pubid)) + <b>(when (eq (puri:uri-scheme sysid) :http) + (drakma:http-request sysid :want-stream t))</b>)) + (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>))</pre> +</body> +</html> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/quickstart.xml ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/quickstart.xml Sun Feb 17 09:26:33 2008 @@ -0,0 +1,247 @@ +<documentation title="CXML Quick-Start Example"> + <h1>Quick-Start Example / FAQ</h1> + + <p> + Make sure to <a href="installation.html#installation">install and load</a> cxml first. + </p> + + <h3> + On this page + </h3> + <page-index/> + + <p> + To try the following examples, create a test file + called <tt>example.xml</tt>: + </p> + <pre>* <b>(with-open-file (s "example.xml" :direction :output) + (write-string "<test a='b'><child/></test>" s))</b></pre> + + <heading>Parsing a file</heading> + + <p>Parse <tt>example.xml</tt> into a DOM tree (<a href="sax.html#parser">read + more</a>):</p> + <pre>* <b>(cxml:parse-file "example.xml" (cxml-dom:make-dom-builder))</b> +#<DOM-IMPL::DOCUMENT @ #x72206172> + +;; save result for later: +* <b>(defparameter *example* *)</b> +*EXAMPLE*</pre> + + <heading>Using DOM</heading> + + <p>Inspect the DOM tree (<a href="sax.html#dom">read more</a>):</p> + <pre>* <b>(dom:document-element *example*)</b> +#<DOM-IMPL::ELEMENT test @ #x722b6ba2> + +* (<b>dom:tag-name</b> (dom:document-element *example*)) +"test" + +* (<b>dom:child-nodes</b> (dom:document-element *example*)) +#(#<DOM-IMPL::ELEMENT child @ #x722b6d8a>) + +* (<b>dom:get-attribute</b> (dom:document-element *example*) <b>"a"</b>) +"b"</pre> + + <heading>Serializing DOM</heading> + + <p>Serialize the DOM document back into a file (<a + href="sax.html#serialization">read more</a>):</p> + <pre>(with-open-file (out "example.out" :direction :output :element-type '(unsigned-byte 8)) + <b>(dom:map-document (cxml:make-octet-stream-sink out) *example*)</b></pre> + + <heading>Parsing into XMLS-like lists</heading> + + <p> + If DOM is not the representation you want to you, parsing into + other data structures is possible using the same SAX parser + function, while using a different handler. + The XMLS builder is included for compatibility with XMLS, and also + also sample code (see cxml/xml/xmls-compat.lisp) for your own + handlers. + </p> + + <p>As an alternative to DOM, parse into xmls-compatible list + structure (<a href="xmls-compat.html">read more</a>):</p> + <pre>* <b>(cxml:parse-file "example.xml" (cxml-xmls:make-xmls-builder))</b> +("test" (("a" "b")) ("child" NIL))</pre> + + <p> + Again, serialization into XML is done using a sink as a SAX + handler and a data-structure specific function to generate SAX + events for the document, in this case <tt>cxml-xmls:map-node</tt>. + </p> + + <pre>* (with-open-file (out "example.out" :direction :output :element-type '(unsigned-byte 8)) + (<b>cxml-xmls:map-node (cxml:make-octet-stream-sink out) + '("test" (("a" "b")) ("child" nil)))</b>)</pre> + + <heading>Parsing incrementally using Klacks</heading> + + <p>Use klacks to read events from the parser incrementally. The + following example looks only for :start-element and :end-element + events and prints them (<a href="klacks.html">read more</a>):</p> + <pre>* <b>(klacks:with-open-source + (s (cxml:make-source #p"example.xml"))</b> + (loop + for key = <b>(klacks:peek s)</b> + while key + do + (case key + (:start-element + (format t "~A {" <b>(klacks:current-qname s)</b>)) + (:end-element + (format t "}"))) + <b>(klacks:consume s)</b>)) +test {child {}}</pre> + + <heading>Writing XML</heading> + + <p> + Serialization is always done using sinks, which accept SAX events, + but there are convenience functions and macros to make that easier + to use: + </p> + <pre>(cxml:with-xml-output (cxml:make-octet-stream-sink stream :indentation 2 :canonical nil) + (cxml:with-element "foo" + (cxml:attribute "xyz" "abc") + (cxml:with-element "bar" + (cxml:attribute "blub" "bla")) + (cxml:text "Hi there.")))</pre> + <p> + Prints this to <tt>stream</tt>: + </p> + <pre><foo xyz="abc"> + <bar blub="bla"></bar> + Hi there. +</foo></pre> + + <heading>Help! CXML says 'URI scheme :HTTP not supported'</heading> + + <p> + By default, this error will occur when the DTD (or generally, any + entity) has an http:// URL as its system ID. CXML itself + understands only file:// URLs, but allows users to customize the + behaviour for all URLs. + </p> + + <p> + The are several solutions to this, covered in detail below: + <ul> + <li> + Load the DTD/entity from local files using an entity resolver + </li> + <li> + Skip parsing of the DTD/entity entirely by pretending it is + empty, again using an entity resolver. + </li> + <li> + Use a <em>catalog</em> to make CXML find DTDs in the local + filesystem automatically. + </li> + <li> + Teach CXML actually load DTDs using HTTP. + </li> + </ul> + </p> + + <p> + Here are the example files for the following solutions to this + problem: + </p> + + <a href="http://www.lichteblau.com/blubba/dtdexample.xml"> + <tt>dtdexample.xml</tt>:</a> + <pre><!DOCTYPE test SYSTEM 'http://www.lichteblau.com/blubba/dtdexample.dtd'> +<test a='b'>blub<child/></test></pre> + + <a href="http://www.lichteblau.com/blubba/dtdexample.dtd"> + <tt>dtdexample.dtd</tt></a>: + <pre><!ELEMENT test (#PCDATA|child)*> +<!ATTLIST test + a CDATA #REQUIRED + > + +<!ELEMENT child EMPTY> +</pre> + + <heading>Loading DTDs from local files</heading> + + <p> + Use the :entity-resolver argument to <tt>parse-file</tt> to + specify a function that maps System IDs and Public IDs to local + files of your choice: + </p> + + <pre>(let ((uri "http://www.lichteblau.com/blubba/dtdexample.dtd") + (pathname "dtdexample.dtd")) + (flet ((resolver (pubid sysid) + (declare (ignore pubid)) + <b>(when (puri:uri= sysid (puri:parse-uri uri)) + (open pathname :element-type '(unsigned-byte 8)))</b>)) + (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>)))</pre> + + + <heading>Can I skip loading of DTDs entirely?</heading> + + <p> + Yes and no. + </p> + <p> + <i>Yes</i>, you can force CXML to do this, see the following example. + </p> + + <p> + But no, skipping the DTD will not actually work if the document + references entities declared in the DTD, especially since neither + SAX nor DOM are able to report unresolved entity references in + attributes. + </p> + + <p> + The trick to make CXML skip the DTD is to pretend that it is empty + by returning a zero-length stream instead: + </p> + + <pre>(flet ((resolver (pubid sysid) + (declare (ignore pubid sysid)) + <b>(flexi-streams:make-in-memory-input-stream nil)</b>)) + (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>))</pre> + + <heading> + Catalogs: How can I use the HTML DTD installed by my distribution? + </heading> + + <p> + Rather than writing an entity resolver function yourself, CXML can + use XML catalogs to find DTDs and entity files on your local system. + </p> + <p> + Catalogs are particularly helpful for DTDs that are + pre-installed. For example, most Linux distributions include a + package for the XHTML DTD. The DTD will reside in a + distribution-dependent location, which the central catalog file + points to. + </p> + <p>By default, CXML looks for the catalog in /etc/xml/catalog + (Linux) and /usr/local/share/xml/catalog.ports (FreeBSD). + </p> + <pre>* <b>(setf cxml:*catalog* (cxml:make-catalog))</b> +* (cxml:parse-file "test.xhtml" (cxml-dom:make-dom-builder))</pre> + + <heading> + Can I load DTDs through HTTP? + </heading> + + <p> + Sure, just use an entity-resolver function that does it. + </p> + <p> + Install <a href="http://weitz.de/drakma/">Drakma</a> and try this: + </p> + <pre>(flet ((resolver (pubid sysid) + (declare (ignore pubid)) + <b>(when (eq (puri:uri-scheme sysid) :http) + (drakma:http-request sysid :want-stream t))</b>)) + (cxml:parse-file "dtdexample.xml" (cxml-dom:make-dom-builder) <b>:entity-resolver #'resolver</b>))</pre> +</documentation> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/sax.html ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/sax.html Sun Feb 17 09:26:33 2008 @@ -0,0 +1,771 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> +<title>CXML SAX parser</title> +<link rel="stylesheet" type="text/css" href="cxml.css"> +</head> +<body> +<div class="sidebar"> +<div class="sidebar-title"><a href="index.html">Closure XML</a></div> +<div class="sidebar-main"><ul class="main"> +<li> +<a href="installation.html">Installing Closure XML</a><ul class="sub"> +<li><a href="installation.html#download"><b>Download</b></a></li> +<li><a href="installation.html#implementations">Implementation-specific notes</a></li> +<li><a href="installation.html#compilation">Compilation</a></li> +<li><a href="installation.html#tests">Tests</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li> +<li> +<a href="sax.html">SAX parsing and serialization</a><ul class="sub"> +<li><a href="sax.html#parser">Parsing and Validating</a></li> +<li><a href="sax.html#serialization">Serialization</a></li> +<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li> +<li><a href="sax.html#rods">Recoders</a></li> +<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li> +<li><a href="sax.html#catalogs">XML Catalogs</a></li> +<li><a href="sax.html#sax">SAX Interface</a></li> +</ul> +</li> +<li> +<a href="klacks.html">Klacks parser</a><ul class="sub"> +<li><a href="klacks.html#sources">Parsing incrementally</a></li> +<li><a href="klacks.html#convenience">Convenience functions</a></li> +<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li> +<li><a href="klacks.html#locator">Location information</a></li> +<li><a href="klacks.html#klacksax">Examples</a></li> +</ul> +</li> +<li> +<a href="dom.html">DOM implementation</a><ul class="sub"> +<li><a href="dom.html#parser">Parsing with the DOM builder</a></li> +<li><a href="dom.html#serialization">Serialization</a></li> +<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li> +</ul></div> +</div> + <h1>SAX parsing and serialization</h1> + + <a name="parser"></a> + + <p> + This chapter describes CXML's SAX-like parser interface. + </p> + <p> + The SAX layer is an important concept in CXML that users will + encounter in various situations: + </p> + <ul> + <li> + To <b>parse into DOM</b>, use the SAX parser as described below with + a <b>DOM builder</b> as the SAX handler. (Refer to <a href="dom.html#parser">make-dom-builder</a> for information about + DOM.) + </li> + <li> + <b>Serialization</b> is done using SAX, too. SAX handlers that + process and consume events without sending them to another + handler are called <i>sinks</i> in CXML. Serialization sinks + write XML output for the events they receive. For example, to + serialize DOM, use <tt>map-document</tt> to turn the DOM + document into SAX events together with a <tt>sink</tt> for + serialization. + </li> + <li> + SAX handlers can be chained together. Various SAX handlers + are offered that can be used in this way, transforming SAX + events before handing them to the next handler. This includes + handlers for <b>whitespace removal</b>, <b>namespace + normalization</b>, and rod-to-string <b>recoding</b>. + </li> + </ul> + <p> + However, SAX events are easier to generate than to process. That + is why CXML offers <i>Klacks</i>, a "pull-based" API in addition to SAX. + Klacks events are generally easier to process than to generate. + Please refer to the <a href="klacks.html">Klacks documentation</a> + for details. + </p> + + <h3>Parsing and Validating</h3> + <div style="border: 1px dotted black; width: 70%; padding: 1em"> + <p> + Old-style convenience functions: + </p> + <div style="font-weight: bold">Function CXML:PARSE-FILE (pathname handler &key ...)</div> + <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a pathname argument. + (But note that <tt>cxml:parse-file</tt> interprets string + arguments as namestrings, while <tt>cxml:parse</tt> expects + literal XML documents.) + </p> + <div style="font-weight: bold">Function CXML:PARSE-STREAM (stream handler &key ...)</div> + <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a stream argument.</p> + <div style="font-weight: bold">Function CXML:PARSE-OCTETS (octets handler &key ...)</div> + <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with an octet vector argument.</p> + <div style="font-weight: bold">Function CXML:PARSE-ROD (rod handler &key ...)</div> + <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a string argument.</p> + </div> + + <h4> + New all-in-one parser interface: + </h4> + <div class="def">Function CXML:PARSE (input handler &key ...)</div> + <p> + Parse an XML document, where input is a string, pathname, octet + vector, or stream. + Return values from this function depend on the SAX handler used.<br> + Arguments: + </p> + <ul> + <li> + <tt>input</tt> -- one of:<br> + <ul> + <li> + <tt>pathname</tt> -- a Common Lisp pathname. + Open the file specified by the pathname and parse its + contents as an XML document. + </li> + <li> +<tt>stream</tt> -- a Common Lisp stream with element-type + <tt>(unsigned-byte 8)</tt>. + </li> + <li> + <tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array. + The array is parsed directly, and interpreted according to the + encoding it specifies. + </li> + <li> + <tt>string</tt>/<tt>rod</tt> -- a rod (or <tt>string</tt> on + unicode-capable implementations). + Parses an XML document from the input string that has already + undergone external-format decoding. + </li> + </ul> + </li> + <li> +<tt>stream</tt> -- a Common Lisp stream with element-type + <tt>(unsigned-byte 8)</tt> +</li> + <li> +<tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array</li> + <li> +<tt>handler</tt> -- a SAX handler</li> + </ul> + <p> + Common keyword arguments: + </p> + <ul> + <li> + <tt>validate</tt> -- A boolean.  Defaults to + <tt>nil</tt>. If true, parse in validating mode, i.e. assert that + the document contains a DOCTYPE declaration and conforms to the + DTD declared. + </li> + <li> + <tt>dtd</tt> -- unless <tt>nil</tt>, an extid instance + specifying the external subset to load. This options overrides + the extid specified in the document type declaration, if any. + See below for <tt>make-extid</tt>. This option is useful + for verification purposes together with the <tt>root</tt> + and <tt>disallow-internal-subset</tt> arguments. + </li> + <li> +<tt>root</tt> -- the expected root element + name, or <tt>nil</tt> (the default). + </li> + <li> + <tt>entity-resolver</tt> -- <tt>nil</tt> or a function of two + arguments which is invoked for every entity referenced by the + document with the entity's Public ID (a rod) and System ID (an + URI object) as arguments. The function may either return + nil, CXML will then try to resolve the entity as usual. + Alternatively it may return a Common Lisp stream specialized on + <tt>(unsigned-byte 8)</tt> which will be used instead. (It may + also signal an error, of course, which can be useful to prohibit + parsed XML documents from including arbitrary files readable by + the parser.) + </li> + <li> + <tt>disallow-internal-subset</tt> -- a boolean. If true, signal + an error if the document contains an internal subset. + </li> + <li> + <tt>recode</tt> -- a boolean. (Ignored on Lisps with Unicode + support.) Recode rods to UTF-8 strings. Defaults to true. + Make sure to use <tt>utf8-dom:make-dom-builder</tt> if this + option is enabled and <tt>rune-dom:make-dom-builder</tt> + otherwise. + </li> + </ul> + <p> + Note: <tt>parse-rod</tt> assumes that the input has already been + decoded into Unicode runes and ignores the encoding + specified in the XML declaration, if any. + </p> + + <p> + <div class="def">Function CXML:PARSE-EMPTY-DOCUMENT (uri qname handler &key public-id system-id entity-resolver recode)</div> + </p> + <p> + Simulate parsing a document with a document element <tt>qname</tt> + having no attributes except for an optional namespace + declaration to <tt>uri</tt>. If an external ID is specified + (<tt>system-id</tt>, <tt>public-id</tt>), find, parse, and report + this DTD as if with <tt>parse-file</tt>, using the specified + entity resolver. + </p> + + <p> + <div class="def">Function CXML:PARSE-DTD-FILE (pathname)</div> + <div class="def">Function CXML:PARSE-DTD-STREAM (stream)</div> + Parse <a href="http://www.w3.org/TR/2000/REC-xml-20001006#NT-extSubset">declarations</a> + from a stand-alone file and return an object representing the DTD, + suitable as an argument to <tt>validate</tt>. + </p> + <ul> + <li> +<tt>pathname</tt> -- a Common Lisp pathname</li> + <li> +<tt>stream</tt> -- a Common Lisp stream with element-type + <tt>(unsigned-byte 8)</tt> +</li> + </ul> + + <p> + <div class="def">Function CXML:MAKE-EXTID (publicid systemid)</div> + Create an object representing the External ID composed + of the specified Public ID, a rod or <tt>nil</tt>, and System ID + (an URI object). + </p> + + <p> + <div class="def">Condition class CXML:XML-PARSE-ERROR ()</div> + Superclass of all conditions signalled by the CXML parser. + </p> + <p> + <div class="def">Condition class CXML:WELL-FORMEDNESS-VIOLATION (cxml:xml-parse-error)</div> + This condition is signalled for all well-formedness violations. + (Note that, when parsing document that is not well-formed in validating + mode, the parser might encounter validity errors before detecting + well-formedness problems, so also be prepared for <tt>validity-error</tt> + in that situation.) + </p> + <p> + <div class="def">Condition class CXML:VALIDITY-ERROR (cxml:xml-parse-error)</div> + Reports the violation of a validity constraint. + </p> + + <a name="serialization"></a> + <h3>Serialization</h3> + <p> + Serialization is performed using <tt>sink</tt> objects. There are + different kinds of sinks for output to lisp streams and vectors in + various flavours. + </p> + <p> + Technically, sinks are SAX handlers that write XML output for SAX + events sent to them. In practise, user code would normally not + generate those SAX events manually, and instead use a function + like <a href="dom.html#serialization">dom:map-document</a> or <a href="xmls-compat.html">xmls-compat:map-node</a> to serialize an + in-memory document. + </p> + <p> + In addition to <tt>map-document</tt>, cxml has a set of + convenience macros for serialization (see below for + <tt>with-xml-output</tt>, <tt>with-element</tt>, etc). + </p> + + <div style="background-color: #ddddff"> + Portable sinks:<br> + <span class="def">Function CXML:MAKE-OCTET-VECTOR-SINK (&rest keys) => sink</span><br> + <span class="def">Function CXML:MAKE-OCTET-STREAM-SINK (stream &rest keys) => sink</span><br> + <span class="def">Function CXML:MAKE-ROD-SINK (&rest keys) => sink</span><br> + <br> + Only on Lisps with Unicode support:<br> + <span class="def">Function CXML:MAKE-STRING-SINK</span> -- alias for <tt>cxml:make-rod-sink</tt><br> + <span class="def">Function CXML:MAKE-CHARACTER-STREAM-SINK (stream &rest keys) => sink</span><br> + <br> + Only on Lisps <em>without</em> Unicode support:<br> + <span class="def">Function CXML:MAKE-STRING-SINK/UTF8 (&rest keys) => sink</span><br> + <span class="def">Function CXML:MAKE-CHARACTER-STREAM-SINK/UTF8 (stream &rest keys) => sink</span><br> + </div> + <p> + Return a SAX serialization handle. + </p> + <ul> + <li> + The <tt>-octet-</tt> functions write the document encoded into + UTF-8. + <tt>make-octet-stream-sink</tt> works with Lisp streams of + element-type <tt>(unsigned-byte 8)</tt>. + <tt>make-octet-vector-sink</tt> returns a vector of + <tt>(unsigned-byte 8)</tt>. + </li> + <li> + <tt>make-character-stream-sink</tt> works with character + streams. It serializes the document into characters <em>without + encoding it into an external format</em>. When using these + functions, <em>take care to avoid encoding the result into + an incorrect external format</em>. (Note that characters undergo + external format conversion when written to a character stream. + If the document's XML declaration specifies an encoding, make + sure to specify this encoding as the external format if and when + writing the serialized document to a character stream. If the + document does not specify an encoding, either UTF-8 or UTF-16 + must be used.) This function is available only on Lisps with + unicode support. + </li> + <li> + <tt>make-rod-sink</tt> serializes the document into a vector of + runes <em>without encoding it into an external format</em>. + (On Lisp with unicode support, the result will be a string; + otherwise, a vector of character codes will be returned.) + The warnings given for <tt>make-character-stream-sink</tt> + apply to this function as well. + </li> + <li> + The <tt>/utf8</tt> functions write the document encoded into + characters representing a UTF-8 encoding. + When using these functions, <em>take care to avoid encoding the + result</em> into an external format for a second time. (Note + that characters undergo external format conversion when written + to a character stream. Since these functions already perform + external format conversion, make sure to specify an external + format that does "nothing" if and when writing the serialized document + to a character stream. ISO-8859-1 external formats usually + achieve the desired effect.) + <tt>make-character-stream-sink/utf8</tt> works with character streams. + <tt>make-string-sink/utf8</tt> returns a string. + These functions are available only on Lisps without unicode support. + </li> + </ul> + <p>Keyword arguments:</p> + <ul> + <li> + <tt>canonical</tt> -- canonical form, one of NIL, T, 1, 2 + </li> + <li> + <tt>indentation</tt> -- indentation level. An integer or <tt>nil</tt>. + </li> + </ul> + <p> + The following <tt>canonical</tt> values are allowed: + </p> + <ul> + <li> + <tt>t</tt> or <tt>1</tt>: <a href="http://www.w3.org/TR/2001/REC-xml-c14n-20010315">Canonical + XML</a> + </li> + <li> + <tt>2</tt>: <a href="http://dev.w3.org/cvsweb/~checkout~/2001/XML-Test-Suite/xmlconf/sun/cxml.html?content-type=text/html;%20charset=iso-8859-1">Second + Canonical Form</a> + </li> + <li> + <tt>NIL</tt>: Use a more readable non-canonical representation. + </li> + </ul> + <p> + An internal subset will be included in the result regardless of + the <tt>canonical</tt> setting. It is the responsibility of the + caller to not report an internal subset for + canonical <= 1, or only notations as required for + canonical = 2. For example, the + <tt>include-doctype</tt> argument to <tt>dom:map-document</tt> + should be set to <tt>nil</tt> for the former behaviour and + <tt>:canonical-notations</tt> for the latter. + </p> + <p> + With an <tt>indentation</tt> level, pretty-print the XML by + inserting additional whitespace.  Note that indentation + changes the document model and should only be used if whitespace + does not matter to the application. + </p> + + <p> + <div class="def">Macro CXML:WITH-XML-OUTPUT (sink &body body) => sink-specific result</div> + <div class="def">Macro CXML:WITH-NAMESPACE ((prefix uri) &body body) => result</div> + <div class="def">Macro CXML:WITH-ELEMENT (qname &body body) => result</div> + <div class="def">Macro CXML:WITH-ELEMENT* ((prefix lname) &body body) => result</div> + <div class="def">Function CXML:ATTRIBUTE (qname value) => value</div> + <div class="def">Generic Function CXML:UNPARSE-ATTRIBUTE (value) => string</div> + <div class="def">Function CXML:ATTRIBUTE* (prefix lname value) => value</div> + <div class="def">Function CXML:TEXT (data) => data</div> + <div class="def">Function CXML:CDATA (data) => data</div> + <div class="def">Function CXML:doctype (name public-id system-id &optional internal-subset)</div> + Convenience syntax for event-based serialization. + </p> + <p> + Example: + </p> + <pre>(with-xml-output (make-octet-stream-sink stream :indentation 2 :canonical nil) + (with-element "foo" + (attribute "xyz" "abc") + (with-element "bar" + (attribute "blub" "bla")) + (text "Hi there.")))</pre> + <p> + Prints this to <tt>stream</tt>: + </p> + <pre><foo xyz="abc"> + <bar blub="bla"></bar> + Hi there. +</foo></pre> + + <p> + <div class="def">Macro XHTML-GENERATOR:WITH-XHTML (sink &rest forms)</div> + <div class="def">Macro XHTML-GENERATOR:WRITE-DOCTYPE (sink)</div> + Macro <tt>with-xhtml</tt> is a modified version of + Franz' <tt>htmlgen</tt> works as a SAX driver for XHTML. + It aims to be a plug-in replacement for the <tt>html</tt> macro. + </p> + <p> + <tt>xhtmlgen</tt> is included as <tt>contrib/xhtmlgen.lisp</tt> in + the cxml distribution. Example: + </p> + <pre>(let ((sink (cxml:make-character-stream-sink *standard-output*))) + (sax:start-document sink) + (xhtml-generator:write-doctype sink) + (xhtml-generator:with-html sink + (:html + (:head + (:title "Titel")) + (:body + ((:p "style" "font-weight: bold") + "Inhalt") + (:ul + (:li "Eins") + (:li "Zwei") + (:li "Drei"))))) + (sax:end-document sink))</pre> + + <a name="misc"></a> + <h3>Miscellaneous SAX handlers</h3> + <p> + <div class="def">Function CXML:MAKE-VALIDATOR (dtd root)</div> + Create a SAX handler which validates against a DTD instance.  + The document's root element must be named <tt>root</tt>.  + Used with <tt>dom:map-document</tt>, this validates a document + object as if by re-reading it with a validating parser, except + that declarations recorded in the document instance are completely + ignored.<br> + Example: + </p> + <pre>(let ((d (parse-file "~/test.xml" (cxml-dom:make-dom-builder))) + (x (parse-dtd-file "~/test.dtd"))) + (dom:map-document (cxml:make-validator x #"foo") d))</pre> + + <p> + <div class="def">Class CXML:BROADCAST-HANDLER ()</div> + <div class="def">Accessor CXML:BROADCAST-HANDLER-HANDLERS</div> + <div class="def">Function CXML:MAKE-BROADCAST-HANDLER (&rest handlers)</div> + <tt>broadcast-handler</tt> is a SAX handler which passes every event it + receives on to each of several chained handlers, somewhat similar + to the way a <tt>broadcast-stream</tt> works. + </p> + <p> + You can subclass <tt>broadcast-stream</tt> to modify the events + before they are being passed on. Define methods on your handler + class for the events to be modified. All other events will pass + through to the chained handlers unmodified. + </p> + <p> + Broadcast handler functions return the result of calling the event + function on the <i>last</i> handler in the list. In particular, + the overall result from <tt>sax:end-document</tt> will be ignored + for all other handlers. + </p> + + <p> + <div class="def">Class CXML:SAX-PROXY (broadcast-handler)</div> + <div class="def">Accessor CXML:PROXY-CHAINED-HANDLER</div> + <tt>sax-proxy</tt> is a subclass of <tt>broadcast-handler</tt> + which sends events to exactly one chained handler. This class is + still included for compatibility with older versions of + CXML which did not include the more + general <tt>broadcast-handler</tt> yet, but has been retrofitted + as a subclass of the latter. + </p> + + <p> + <div class="def">Accessor CXML:MAKE-NAMESPACE-NORMALIZER (next-handler)</div> + </p> + <p> + Return a SAX handler that performs <a href="http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/namespaces-algorithms.html#normalizeDocumentAlgo">DOM + 3-style namespace normalization</a> on attribute lists in + <tt>start-element</tt> events before passing them on the next + handler. + </p> + <p> + <div class="def">Function CXML:MAKE-WHITESPACE-NORMALIZER (chained-handler &optional dtd)</div> + Return a SAX handler which removes whitespace from elements that + have <em>element content</em> and have not been declared to + preserve space using an xml:space attribute. + </p> + <p>Example:</p> + <pre>(cxml:parse-file "example.xml" + (cxml:make-whitespace-normalizer (cxml-dom:make-dom-builder)) + :validate t)</pre> + <p>Example input:</p> + <pre><!DOCTYPE test [ +<!ELEMENT test (foo,bar*)> +<!ATTLIST test a CDATA #IMPLIED> +<!ELEMENT foo #PCDATA> +<!ELEMENT bar (foo?)> +<!ATTLIST bar xml:space (default|preserve) "default"> +]> +<test a='b'> + <foo> </foo> + <bar> </bar> + <bar xml:space="preserve"> </bar> +</test> +</pre> + <p>Example result:</p> + <pre><test a="b"><foo> </foo><bar></bar><bar xml:space="preserve"> </bar></test></pre> + + <a name="rods"></a> + <h3>Recoders</h3> + <p> + Recoders are a mechanism used by CXML internally on Lisp implementations + without Unicode support to recode UTF-16 vectors (rods) of + integers (runes) into UTF-8 strings. + </p> + <p> + User code does not usually need to deal with recoders in current + versions of CXML. + </p> + <p> + <div class="def">Function CXML:MAKE-RECODER (chained-handler recoder-fn)</div> + Return a SAX handler which passes all events on to + <tt>chained-handler</tt> after converting all strings and rods + using <tt>recoder-fn</tt>, a function of one argument. + </p> + + <a name="dtdcache"></a> + <h3>Caching of DTD Objects</h3> + <p> + To avoid spending time parsing the same DTD over and over again, + CXML can cache DTD objects. The parser consults + <tt>cxml:*dtd-cache*</tt> whenever it is looking for an external + subset in a document which does not have an internal subset and + uses the cached DTD instance if one is present in the cache for + the System ID in question. + </p> + <p> + Note that DTDs do not expire from the cache automatically. + (Future versions of CXML might introduce automatic checks for + outdated DTDs.) + </p> + <p> + <div class="def">Variable CXML:*DTD-CACHE*</div> + The DTD cache object consulted by the parser when it needs a DTD. + </p> + <p> + <div class="def">Function CXML:MAKE-DTD-CACHE ()</div> + Return a new, empty DTD cache object. + </p> + <p> + <div class="def">Variable CXML:*CACHE-ALL-DTDS*</div> + If true, instructs the parser to enter all DTDs that could have + been cached into <tt>*dtd-cache*</tt> if they were not cached + already. Defaults to <tt>nil</tt>. + </p> + <p> + <div class="def">Reader CXML:GETDTD (uri dtd-cache)</div> + Return a cached instance of the DTD at <tt>uri</tt>, if present in + the cache, or <tt>nil</tt>. + </p> + <p> + <div class="def">Writer CXML:GETDTD (uri dtd-cache)</div> + Enter a new value for <tt>uri</tt> into <tt>dtd-cache</tt>. + </p> + <p> + <div class="def">Function CXML:REMDTD (uri dtd-cache)</div> + Ensure that no DTD is recorded for <tt>uri</tt> in the cache and + return true if such a DTD was present. + </p> + <p> + <div class="def">Function CXML:CLEAR-DTD-CACHE (dtd-cache)</div> + Remove all entries from <tt>dtd-cache</tt>. + </p> + <p> + <em>fixme:</em> thread-safety + </p> + + <a name="saxparser"></a> + <h3>Location information</h3> + <p> + <div class="def">Class SAX:SAX-PARSER ()</div> + A class providing location information through an + implementation-specific subclass. Parsers will use + <tt>sax:register-sax-parser</tt> to pass their parser instance to + the handler. The easiest way to receive sax parsers instances is + to inherit from sax-parser-mixin when defining a sax handler. + </p> + <p> + <div class="def">Class SAX:SAX-PARSER-MIXIN ()</div> + A mixin for sax handler classes that records the sax handler + object for use with the following functions. Trampoline methods + are provided that allow those functions to be called directly on + the sax-parser-mixin. + </p> + <p> + <div class="def">Function SAX:SAX-HANDLER (sax-handler-mixin) => sax-handler</div> + Return the sax-parser instance recorded by this handler, or NIL. + </p> + <p> + <div class="def">Function SAX:LINE-NUMBER (sax-parser)</div> + Return an approximation of the current line number, or NIL. + </p> + <p> + <div class="def">Function SAX:COLUMN-NUMBER (sax-parser)</div> + Return an approximation of the current column number, or NIL. + </p> + <p> + <div class="def">Function SAX:SYSTEM-ID (sax-parser)</div> + Return the URI of the document being parsed. This is either the + main document, or the entity's system ID while contents of a parsed + general external entity are being processed. + </p> + <p> + <div class="def">Function SAX:XML-BASE (sax-parser)</div> + Return the [Base URI] of the current element. This URI can differ from + the value returned by <tt>sax:system-id</tt> if xml:base + attributes are present. + </p> + + <a name="catalogs"></a> + <h3>XML Catalogs</h3> + <p> + External entities (for example, DTDs) are referred to using their + Public and System IDs. Usually the System ID, a URI, is used to + locate the entity. CXML itself handles only file://-URIs, but + many System IDs in practical use are http://-URIs. There are two + different mechanims applications can use to allow CXML to locate + entities using arbitrary Public ID or System ID: + </p> + <ul> + <li> + User-defined entity resolvers can be used to open entities using + arbitrary protocols. For example, an entity resolver could + handle all System-IDs with the <tt>http</tt> scheme using some + HTTP library. Refer to the description of the + <tt>entity-resolver</tt> keyword argument to parser functions (see <a href="#parser"><tt>cxml:parse-file</tt></a>) to more + information on entity resolvers. + </li> + <li> + XML Catalogs are (local) tables in XML syntax which map External + IDs to alternative System IDs. If, say, the xhtml DTD is + present in the local file system and the local copy has been + registered with the XML catalog, CXML will use the local copy of + the DTD instead of trying to open the version available using HTTP. + </li> + </ul> + <p> + This section describes XML Catalogs, the second solution. CXML + implements <a href="http://www.oasis-open.org/committees/entity/spec.html">Oasis + XML Catalogs</a>. + </p> + <p> + <div class="def">Variable CXML:*CATALOG*</div> + The XML Catalog object consulted by the parser before trying to + open an entity. Initially <tt>nil</tt>. + </p> + <p> + <div class="def">Variable CXML:*PREFER*</div> + The default "prefer" mode from the Catalog specification, one + of <tt>:public</tt> or <tt>:system</tt>. Defaults + to <tt>:public</tt>. + </p> + <p> + <div class="def">Function CXML:MAKE-CATALOG (&optional uris)</div> + Return a catalog object for the catalog files specified. + </p> + <p> + <div class="def">Function CXML:RESOLVE-URI (uri catalog)</div> + Look up <tt>uri</tt> in <tt>catalog</tt> and return the + resulting URI, or <tt>nil</tt> if no match was found. + </p> + <p> + <div class="def">Function CXML:RESOLVE-EXTID (publicid systemid catalog)</div> + Look up the External ID (<tt>publicid</tt>, <tt>systemid</tt>) + in <tt>catalog</tt> and return the resulting URI, or <tt>nil</tt> + if no match was found. + </p> + <p> + Example: + </p> + <pre>* (setf cxml:*catalog* nil) +* (cxml:parse-file "test.xhtml" nil) +=> Error: URI scheme :HTTP not supported + +* (setf cxml:*catalog* (cxml:make-catalog)) +* (cxml:parse-file "test.xhtml" nil) +;; no error! +NIL</pre> + <p> + Note that parsed catalog files are cached in the catalog object. + Catalog files cached do not expire automatically. To ensure that + all catalog files are parsed again, create a new catalog object. + </p> + + <a name="sax"></a> + <h2>SAX Interface</h2> + <p> + A SAX handler is an arbitrary objects that implements some of the + generic functions in the SAX package.  Note that no default + handler class is necessary, because all generic functions have default + methods which do nothing.  SAX functions are: + <div class="def">Function SAX:START-DOCUMENT (handler)</div> + <div class="def">Function SAX:END-DOCUMENT (handler)</div> + <br> + <div class="def">Function SAX:START-ELEMENT (handler namespace-uri local-name qname attributes)</div> + <div class="def">Function SAX:END-ELEMENT (handler namespace-uri local-name qname)</div> + <div class="def">Function SAX:START-PREFIX-MAPPING (handler prefix uri)</div> + <div class="def">Function SAX:END-PREFIX-MAPPING (handler prefix)</div> + <div class="def">Function SAX:PROCESSING-INSTRUCTION (handler target data)</div> + <div class="def">Function SAX:COMMENT (handler data)</div> + <div class="def">Function SAX:START-CDATA (handler)</div> + <div class="def">Function SAX:END-CDATA (handler)</div> + <div class="def">Function SAX:CHARACTERS (handler data)</div> + <br> + <div class="def">Function SAX:START-DTD (handler name public-id system-id)</div> + <div class="def">Function SAX:END-DTD (handler)</div> + <div class="def">Function SAX:START-INTERNAL-SUBSET (handler)</div> + <div class="def">Function SAX:END-INTERNAL-SUBSET (handler)</div> + <div class="def">Function SAX:UNPARSED-ENTITY-DECLARATION (handler name public-id system-id notation-name)</div> + <div class="def">Function SAX:EXTERNAL-ENTITY-DECLARATION (handler kind name public-id system-id)</div> + <div class="def">Function SAX:INTERNAL-ENTITY-DECLARATION (handler kind name value)</div> + <div class="def">Function SAX:NOTATION-DECLARATION (handler name public-id system-id)</div> + <div class="def">Function SAX:ELEMENT-DECLARATION (handler name model)</div> + <div class="def">Function SAX:ATTRIBUTE-DECLARATION (handler ename aname type default)</div> + <br> + <div class="def">Accessor SAX:ATTRIBUTE-PREFIX (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-NAMESPACE-URI (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-LOCAL-NAME (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-QNAME (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-SPECIFIED-P (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-VALUE (attribute)</div> + <br> + <div class="def">Function SAX:FIND-ATTRIBUTE (qname attributes)</div> + <div class="def">Function SAX:FIND-ATTRIBUTE-NS (uri lname attributes)</div> + </p> + <p> + The entity declaration methods are similar to Java SAX + definitions, but parameter entities are distinguished from + general entities not by a <tt>%</tt> prefix to the name, but by + the <tt>kind</tt> argument, either <tt>:parameter</tt> or + <tt>:general</tt>. + </p> + <p> + The arguments to <tt>sax:element-declaration</tt> and + <tt>sax:attribute-declaration</tt> differ significantly from their + Java counterparts. + </p> + <p> + <i>fixme</i>: For more information on these functions refer to the docstrings. + </p> +</body> +</html> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/sax.xml ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/sax.xml Sun Feb 17 09:26:33 2008 @@ -0,0 +1,722 @@ +<documentation title="CXML SAX parser"> + <h1>SAX parsing and serialization</h1> + + <a name="parser"/> + + <p> + This chapter describes CXML's SAX-like parser interface. + </p> + <p> + The SAX layer is an important concept in CXML that users will + encounter in various situations: + </p> + <ul> + <li> + To <b>parse into DOM</b>, use the SAX parser as described below with + a <b>DOM builder</b> as the SAX handler. (Refer to <a + href="dom.html#parser">make-dom-builder</a> for information about + DOM.) + </li> + <li> + <b>Serialization</b> is done using SAX, too. SAX handlers that + process and consume events without sending them to another + handler are called <i>sinks</i> in CXML. Serialization sinks + write XML output for the events they receive. For example, to + serialize DOM, use <tt>map-document</tt> to turn the DOM + document into SAX events together with a <tt>sink</tt> for + serialization. + </li> + <li> + SAX handlers can be chained together. Various SAX handlers + are offered that can be used in this way, transforming SAX + events before handing them to the next handler. This includes + handlers for <b>whitespace removal</b>, <b>namespace + normalization</b>, and rod-to-string <b>recoding</b>. + </li> + </ul> + <p> + However, SAX events are easier to generate than to process. That + is why CXML offers <i>Klacks</i>, a "pull-based" API in addition to SAX. + Klacks events are generally easier to process than to generate. + Please refer to the <a href="klacks.html">Klacks documentation</a> + for details. + </p> + + <h3>Parsing and Validating</h3> + <div style="border: 1px dotted black; + width: 70%; + padding: 1em"> + <p> + Old-style convenience functions: + </p> + <div style="font-weight: bold">Function CXML:PARSE-FILE (pathname handler &key ...)</div> + <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a pathname argument. + (But note that <tt>cxml:parse-file</tt> interprets string + arguments as namestrings, while <tt>cxml:parse</tt> expects + literal XML documents.) + </p> + <div style="font-weight: bold">Function CXML:PARSE-STREAM (stream handler &key ...)</div> + <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a stream argument.</p> + <div style="font-weight: bold">Function CXML:PARSE-OCTETS (octets handler &key ...)</div> + <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with an octet vector argument.</p> + <div style="font-weight: bold">Function CXML:PARSE-ROD (rod handler &key ...)</div> + <p style="margin-left: 2em">Same as <tt>cxml:parse</tt> with a string argument.</p> + </div> + + <h4> + New all-in-one parser interface: + </h4> + <div class="def">Function CXML:PARSE (input handler &key ...)</div> + <p> + Parse an XML document, where input is a string, pathname, octet + vector, or stream. + Return values from this function depend on the SAX handler used.<br/> + Arguments: + </p> + <ul> + <li> + <tt>input</tt> -- one of:<br/> + <ul> + <li> + <tt>pathname</tt> -- a Common Lisp pathname. + Open the file specified by the pathname and parse its + contents as an XML document. + </li> + <li><tt>stream</tt> -- a Common Lisp stream with element-type + <tt>(unsigned-byte 8)</tt>. + </li> + <li> + <tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array. + The array is parsed directly, and interpreted according to the + encoding it specifies. + </li> + <li> + <tt>string</tt>/<tt>rod</tt> -- a rod (or <tt>string</tt> on + unicode-capable implementations). + Parses an XML document from the input string that has already + undergone external-format decoding. + </li> + </ul> + </li> + <li><tt>stream</tt> -- a Common Lisp stream with element-type + <tt>(unsigned-byte 8)</tt></li> + <li><tt>octets</tt> -- an <tt>(unsigned-byte 8)</tt> array</li> + <li><tt>handler</tt> -- a SAX handler</li> + </ul> + <p> + Common keyword arguments: + </p> + <ul> + <li> + <tt>validate</tt> -- A boolean.  Defaults to + <tt>nil</tt>. If true, parse in validating mode, i.e. assert that + the document contains a DOCTYPE declaration and conforms to the + DTD declared. + </li> + <li> + <tt>dtd</tt> -- unless <tt>nil</tt>, an extid instance + specifying the external subset to load. This options overrides + the extid specified in the document type declaration, if any. + See below for <tt>make-extid</tt>. This option is useful + for verification purposes together with the <tt>root</tt> + and <tt>disallow-internal-subset</tt> arguments. + </li> + <li><tt>root</tt> -- the expected root element + name, or <tt>nil</tt> (the default). + </li> + <li> + <tt>entity-resolver</tt> -- <tt>nil</tt> or a function of two + arguments which is invoked for every entity referenced by the + document with the entity's Public ID (a rod) and System ID (an + URI object) as arguments. The function may either return + nil, CXML will then try to resolve the entity as usual. + Alternatively it may return a Common Lisp stream specialized on + <tt>(unsigned-byte 8)</tt> which will be used instead. (It may + also signal an error, of course, which can be useful to prohibit + parsed XML documents from including arbitrary files readable by + the parser.) + </li> + <li> + <tt>disallow-internal-subset</tt> -- a boolean. If true, signal + an error if the document contains an internal subset. + </li> + <li> + <tt>recode</tt> -- a boolean. (Ignored on Lisps with Unicode + support.) Recode rods to UTF-8 strings. Defaults to true. + Make sure to use <tt>utf8-dom:make-dom-builder</tt> if this + option is enabled and <tt>rune-dom:make-dom-builder</tt> + otherwise. + </li> + </ul> + <p> + Note: <tt>parse-rod</tt> assumes that the input has already been + decoded into Unicode runes and ignores the encoding + specified in the XML declaration, if any. + </p> + + <p> + <div class="def">Function CXML:PARSE-EMPTY-DOCUMENT (uri qname handler &key public-id system-id entity-resolver recode)</div> + </p> + <p> + Simulate parsing a document with a document element <tt>qname</tt> + having no attributes except for an optional namespace + declaration to <tt>uri</tt>. If an external ID is specified + (<tt>system-id</tt>, <tt>public-id</tt>), find, parse, and report + this DTD as if with <tt>parse-file</tt>, using the specified + entity resolver. + </p> + + <p> + <div class="def">Function CXML:PARSE-DTD-FILE (pathname)</div> + <div class="def">Function CXML:PARSE-DTD-STREAM (stream)</div> + Parse <a + href="http://www.w3.org/TR/2000/REC-xml-20001006#NT-extSubset">declarations</a> + from a stand-alone file and return an object representing the DTD, + suitable as an argument to <tt>validate</tt>. + </p> + <ul> + <li><tt>pathname</tt> -- a Common Lisp pathname</li> + <li><tt>stream</tt> -- a Common Lisp stream with element-type + <tt>(unsigned-byte 8)</tt></li> + </ul> + + <p> + <div class="def">Function CXML:MAKE-EXTID (publicid systemid)</div> + Create an object representing the External ID composed + of the specified Public ID, a rod or <tt>nil</tt>, and System ID + (an URI object). + </p> + + <p> + <div class="def">Condition class CXML:XML-PARSE-ERROR ()</div> + Superclass of all conditions signalled by the CXML parser. + </p> + <p> + <div class="def">Condition class CXML:WELL-FORMEDNESS-VIOLATION (cxml:xml-parse-error)</div> + This condition is signalled for all well-formedness violations. + (Note that, when parsing document that is not well-formed in validating + mode, the parser might encounter validity errors before detecting + well-formedness problems, so also be prepared for <tt>validity-error</tt> + in that situation.) + </p> + <p> + <div class="def">Condition class CXML:VALIDITY-ERROR (cxml:xml-parse-error)</div> + Reports the violation of a validity constraint. + </p> + + <a name="serialization"/> + <h3>Serialization</h3> + <p> + Serialization is performed using <tt>sink</tt> objects. There are + different kinds of sinks for output to lisp streams and vectors in + various flavours. + </p> + <p> + Technically, sinks are SAX handlers that write XML output for SAX + events sent to them. In practise, user code would normally not + generate those SAX events manually, and instead use a function + like <a href="dom.html#serialization">dom:map-document</a> or <a + href="xmls-compat.html">xmls-compat:map-node</a> to serialize an + in-memory document. + </p> + <p> + In addition to <tt>map-document</tt>, cxml has a set of + convenience macros for serialization (see below for + <tt>with-xml-output</tt>, <tt>with-element</tt>, etc). + </p> + + <div style="background-color: #ddddff"> + Portable sinks:<br/> + <span class="def">Function CXML:MAKE-OCTET-VECTOR-SINK (&rest keys) => sink</span><br/> + <span class="def">Function CXML:MAKE-OCTET-STREAM-SINK (stream &rest keys) => sink</span><br/> + <span class="def">Function CXML:MAKE-ROD-SINK (&rest keys) => sink</span><br/> + <br/> + Only on Lisps with Unicode support:<br/> + <span class="def">Function CXML:MAKE-STRING-SINK</span> -- alias for <tt>cxml:make-rod-sink</tt><br/> + <span class="def">Function CXML:MAKE-CHARACTER-STREAM-SINK (stream &rest keys) => sink</span><br/> + <br/> + Only on Lisps <em>without</em> Unicode support:<br/> + <span class="def">Function CXML:MAKE-STRING-SINK/UTF8 (&rest keys) => sink</span><br/> + <span class="def">Function CXML:MAKE-CHARACTER-STREAM-SINK/UTF8 (stream &rest keys) => sink</span><br/> + </div> + <p> + Return a SAX serialization handle. + </p> + <ul> + <li> + The <tt>-octet-</tt> functions write the document encoded into + UTF-8. + <tt>make-octet-stream-sink</tt> works with Lisp streams of + element-type <tt>(unsigned-byte 8)</tt>. + <tt>make-octet-vector-sink</tt> returns a vector of + <tt>(unsigned-byte 8)</tt>. + </li> + <li> + <tt>make-character-stream-sink</tt> works with character + streams. It serializes the document into characters <em>without + encoding it into an external format</em>. When using these + functions, <em>take care to avoid encoding the result into + an incorrect external format</em>. (Note that characters undergo + external format conversion when written to a character stream. + If the document's XML declaration specifies an encoding, make + sure to specify this encoding as the external format if and when + writing the serialized document to a character stream. If the + document does not specify an encoding, either UTF-8 or UTF-16 + must be used.) This function is available only on Lisps with + unicode support. + </li> + <li> + <tt>make-rod-sink</tt> serializes the document into a vector of + runes <em>without encoding it into an external format</em>. + (On Lisp with unicode support, the result will be a string; + otherwise, a vector of character codes will be returned.) + The warnings given for <tt>make-character-stream-sink</tt> + apply to this function as well. + </li> + <li> + The <tt>/utf8</tt> functions write the document encoded into + characters representing a UTF-8 encoding. + When using these functions, <em>take care to avoid encoding the + result</em> into an external format for a second time. (Note + that characters undergo external format conversion when written + to a character stream. Since these functions already perform + external format conversion, make sure to specify an external + format that does "nothing" if and when writing the serialized document + to a character stream. ISO-8859-1 external formats usually + achieve the desired effect.) + <tt>make-character-stream-sink/utf8</tt> works with character streams. + <tt>make-string-sink/utf8</tt> returns a string. + These functions are available only on Lisps without unicode support. + </li> + </ul> + <p>Keyword arguments:</p> + <ul> + <li> + <tt>canonical</tt> -- canonical form, one of NIL, T, 1, 2 + </li> + <li> + <tt>indentation</tt> -- indentation level. An integer or <tt>nil</tt>. + </li> + </ul> + <p> + The following <tt>canonical</tt> values are allowed: + </p> + <ul> + <li> + <tt>t</tt> or <tt>1</tt>: <a + href="http://www.w3.org/TR/2001/REC-xml-c14n-20010315">Canonical + XML</a> + </li> + <li> + <tt>2</tt>: <a + href="http://dev.w3.org/cvsweb/~checkout~/2001/XML-Test-Suite/xmlconf/sun/cxml.html?content-type=text/html;%20charset=iso-8859-1">Second + Canonical Form</a> + </li> + <li> + <tt>NIL</tt>: Use a more readable non-canonical representation. + </li> + </ul> + <p> + An internal subset will be included in the result regardless of + the <tt>canonical</tt> setting. It is the responsibility of the + caller to not report an internal subset for + canonical <= 1, or only notations as required for + canonical = 2. For example, the + <tt>include-doctype</tt> argument to <tt>dom:map-document</tt> + should be set to <tt>nil</tt> for the former behaviour and + <tt>:canonical-notations</tt> for the latter. + </p> + <p> + With an <tt>indentation</tt> level, pretty-print the XML by + inserting additional whitespace.  Note that indentation + changes the document model and should only be used if whitespace + does not matter to the application. + </p> + + <p> + <div class="def">Macro CXML:WITH-XML-OUTPUT (sink &body body) => sink-specific result</div> + <div class="def">Macro CXML:WITH-NAMESPACE ((prefix uri) &body body) => result</div> + <div class="def">Macro CXML:WITH-ELEMENT (qname &body body) => result</div> + <div class="def">Macro CXML:WITH-ELEMENT* ((prefix lname) &body body) => result</div> + <div class="def">Function CXML:ATTRIBUTE (qname value) => value</div> + <div class="def">Generic Function CXML:UNPARSE-ATTRIBUTE (value) => string</div> + <div class="def">Function CXML:ATTRIBUTE* (prefix lname value) => value</div> + <div class="def">Function CXML:TEXT (data) => data</div> + <div class="def">Function CXML:CDATA (data) => data</div> + <div class="def">Function CXML:doctype (name public-id system-id &optional internal-subset)</div> + Convenience syntax for event-based serialization. + </p> + <p> + Example: + </p> + <pre>(with-xml-output (make-octet-stream-sink stream :indentation 2 :canonical nil) + (with-element "foo" + (attribute "xyz" "abc") + (with-element "bar" + (attribute "blub" "bla")) + (text "Hi there.")))</pre> + <p> + Prints this to <tt>stream</tt>: + </p> + <pre><foo xyz="abc"> + <bar blub="bla"></bar> + Hi there. +</foo></pre> + + <p> + <div class="def">Macro XHTML-GENERATOR:WITH-XHTML (sink &rest forms)</div> + <div class="def">Macro XHTML-GENERATOR:WRITE-DOCTYPE (sink)</div> + Macro <tt>with-xhtml</tt> is a modified version of + Franz' <tt>htmlgen</tt> works as a SAX driver for XHTML. + It aims to be a plug-in replacement for the <tt>html</tt> macro. + </p> + <p> + <tt>xhtmlgen</tt> is included as <tt>contrib/xhtmlgen.lisp</tt> in + the cxml distribution. Example: + </p> + <pre>(let ((sink (cxml:make-character-stream-sink *standard-output*))) + (sax:start-document sink) + (xhtml-generator:write-doctype sink) + (xhtml-generator:with-html sink + (:html + (:head + (:title "Titel")) + (:body + ((:p "style" "font-weight: bold") + "Inhalt") + (:ul + (:li "Eins") + (:li "Zwei") + (:li "Drei"))))) + (sax:end-document sink))</pre> + + <a name="misc"/> + <h3>Miscellaneous SAX handlers</h3> + <p> + <div class="def">Function CXML:MAKE-VALIDATOR (dtd root)</div> + Create a SAX handler which validates against a DTD instance.  + The document's root element must be named <tt>root</tt>.  + Used with <tt>dom:map-document</tt>, this validates a document + object as if by re-reading it with a validating parser, except + that declarations recorded in the document instance are completely + ignored.<br/> + Example: + </p> + <pre>(let ((d (parse-file "~/test.xml" (cxml-dom:make-dom-builder))) + (x (parse-dtd-file "~/test.dtd"))) + (dom:map-document (cxml:make-validator x #"foo") d))</pre> + + <p> + <div class="def">Class CXML:BROADCAST-HANDLER ()</div> + <div class="def">Accessor CXML:BROADCAST-HANDLER-HANDLERS</div> + <div class="def">Function CXML:MAKE-BROADCAST-HANDLER (&rest handlers)</div> + <tt>broadcast-handler</tt> is a SAX handler which passes every event it + receives on to each of several chained handlers, somewhat similar + to the way a <tt>broadcast-stream</tt> works. + </p> + <p> + You can subclass <tt>broadcast-stream</tt> to modify the events + before they are being passed on. Define methods on your handler + class for the events to be modified. All other events will pass + through to the chained handlers unmodified. + </p> + <p> + Broadcast handler functions return the result of calling the event + function on the <i>last</i> handler in the list. In particular, + the overall result from <tt>sax:end-document</tt> will be ignored + for all other handlers. + </p> + + <p> + <div class="def">Class CXML:SAX-PROXY (broadcast-handler)</div> + <div class="def">Accessor CXML:PROXY-CHAINED-HANDLER</div> + <tt>sax-proxy</tt> is a subclass of <tt>broadcast-handler</tt> + which sends events to exactly one chained handler. This class is + still included for compatibility with older versions of + CXML which did not include the more + general <tt>broadcast-handler</tt> yet, but has been retrofitted + as a subclass of the latter. + </p> + + <p> + <div class="def">Accessor CXML:MAKE-NAMESPACE-NORMALIZER (next-handler)</div> + </p> + <p> + Return a SAX handler that performs <a + href="http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/namespaces-algorithms.html#normalizeDocumentAlgo">DOM + 3-style namespace normalization</a> on attribute lists in + <tt>start-element</tt> events before passing them on the next + handler. + </p> + <p> + <div class="def">Function CXML:MAKE-WHITESPACE-NORMALIZER (chained-handler &optional dtd)</div> + Return a SAX handler which removes whitespace from elements that + have <em>element content</em> and have not been declared to + preserve space using an xml:space attribute. + </p> + <p>Example:</p> + <pre>(cxml:parse-file "example.xml" + (cxml:make-whitespace-normalizer (cxml-dom:make-dom-builder)) + :validate t)</pre> + <p>Example input:</p> + <pre><!DOCTYPE test [ +<!ELEMENT test (foo,bar*)> +<!ATTLIST test a CDATA #IMPLIED> +<!ELEMENT foo #PCDATA> +<!ELEMENT bar (foo?)> +<!ATTLIST bar xml:space (default|preserve) "default"> +]> +<test a='b'> + <foo> </foo> + <bar> </bar> + <bar xml:space="preserve"> </bar> +</test> +</pre> + <p>Example result:</p> + <pre><test a="b"><foo> </foo><bar></bar><bar xml:space="preserve"> </bar></test></pre> + + <a name="rods"/> + <h3>Recoders</h3> + <p> + Recoders are a mechanism used by CXML internally on Lisp implementations + without Unicode support to recode UTF-16 vectors (rods) of + integers (runes) into UTF-8 strings. + </p> + <p> + User code does not usually need to deal with recoders in current + versions of CXML. + </p> + <p> + <div class="def">Function CXML:MAKE-RECODER (chained-handler recoder-fn)</div> + Return a SAX handler which passes all events on to + <tt>chained-handler</tt> after converting all strings and rods + using <tt>recoder-fn</tt>, a function of one argument. + </p> + + <a name="dtdcache"/> + <h3>Caching of DTD Objects</h3> + <p> + To avoid spending time parsing the same DTD over and over again, + CXML can cache DTD objects. The parser consults + <tt>cxml:*dtd-cache*</tt> whenever it is looking for an external + subset in a document which does not have an internal subset and + uses the cached DTD instance if one is present in the cache for + the System ID in question. + </p> + <p> + Note that DTDs do not expire from the cache automatically. + (Future versions of CXML might introduce automatic checks for + outdated DTDs.) + </p> + <p> + <div class="def">Variable CXML:*DTD-CACHE*</div> + The DTD cache object consulted by the parser when it needs a DTD. + </p> + <p> + <div class="def">Function CXML:MAKE-DTD-CACHE ()</div> + Return a new, empty DTD cache object. + </p> + <p> + <div class="def">Variable CXML:*CACHE-ALL-DTDS*</div> + If true, instructs the parser to enter all DTDs that could have + been cached into <tt>*dtd-cache*</tt> if they were not cached + already. Defaults to <tt>nil</tt>. + </p> + <p> + <div class="def">Reader CXML:GETDTD (uri dtd-cache)</div> + Return a cached instance of the DTD at <tt>uri</tt>, if present in + the cache, or <tt>nil</tt>. + </p> + <p> + <div class="def">Writer CXML:GETDTD (uri dtd-cache)</div> + Enter a new value for <tt>uri</tt> into <tt>dtd-cache</tt>. + </p> + <p> + <div class="def">Function CXML:REMDTD (uri dtd-cache)</div> + Ensure that no DTD is recorded for <tt>uri</tt> in the cache and + return true if such a DTD was present. + </p> + <p> + <div class="def">Function CXML:CLEAR-DTD-CACHE (dtd-cache)</div> + Remove all entries from <tt>dtd-cache</tt>. + </p> + <p> + <em>fixme:</em> thread-safety + </p> + + <a name="saxparser"/> + <h3>Location information</h3> + <p> + <div class="def">Class SAX:SAX-PARSER ()</div> + A class providing location information through an + implementation-specific subclass. Parsers will use + <tt>sax:register-sax-parser</tt> to pass their parser instance to + the handler. The easiest way to receive sax parsers instances is + to inherit from sax-parser-mixin when defining a sax handler. + </p> + <p> + <div class="def">Class SAX:SAX-PARSER-MIXIN ()</div> + A mixin for sax handler classes that records the sax handler + object for use with the following functions. Trampoline methods + are provided that allow those functions to be called directly on + the sax-parser-mixin. + </p> + <p> + <div class="def">Function SAX:SAX-HANDLER (sax-handler-mixin) => sax-handler</div> + Return the sax-parser instance recorded by this handler, or NIL. + </p> + <p> + <div class="def">Function SAX:LINE-NUMBER (sax-parser)</div> + Return an approximation of the current line number, or NIL. + </p> + <p> + <div class="def">Function SAX:COLUMN-NUMBER (sax-parser)</div> + Return an approximation of the current column number, or NIL. + </p> + <p> + <div class="def">Function SAX:SYSTEM-ID (sax-parser)</div> + Return the URI of the document being parsed. This is either the + main document, or the entity's system ID while contents of a parsed + general external entity are being processed. + </p> + <p> + <div class="def">Function SAX:XML-BASE (sax-parser)</div> + Return the [Base URI] of the current element. This URI can differ from + the value returned by <tt>sax:system-id</tt> if xml:base + attributes are present. + </p> + + <a name="catalogs"/> + <h3>XML Catalogs</h3> + <p> + External entities (for example, DTDs) are referred to using their + Public and System IDs. Usually the System ID, a URI, is used to + locate the entity. CXML itself handles only file://-URIs, but + many System IDs in practical use are http://-URIs. There are two + different mechanims applications can use to allow CXML to locate + entities using arbitrary Public ID or System ID: + </p> + <ul> + <li> + User-defined entity resolvers can be used to open entities using + arbitrary protocols. For example, an entity resolver could + handle all System-IDs with the <tt>http</tt> scheme using some + HTTP library. Refer to the description of the + <tt>entity-resolver</tt> keyword argument to parser functions (see <a + href="#parser"><tt>cxml:parse-file</tt></a>) to more + information on entity resolvers. + </li> + <li> + XML Catalogs are (local) tables in XML syntax which map External + IDs to alternative System IDs. If, say, the xhtml DTD is + present in the local file system and the local copy has been + registered with the XML catalog, CXML will use the local copy of + the DTD instead of trying to open the version available using HTTP. + </li> + </ul> + <p> + This section describes XML Catalogs, the second solution. CXML + implements <a + href="http://www.oasis-open.org/committees/entity/spec.html">Oasis + XML Catalogs</a>. + </p> + <p> + <div class="def">Variable CXML:*CATALOG*</div> + The XML Catalog object consulted by the parser before trying to + open an entity. Initially <tt>nil</tt>. + </p> + <p> + <div class="def">Variable CXML:*PREFER*</div> + The default "prefer" mode from the Catalog specification, one + of <tt>:public</tt> or <tt>:system</tt>. Defaults + to <tt>:public</tt>. + </p> + <p> + <div class="def">Function CXML:MAKE-CATALOG (&optional uris)</div> + Return a catalog object for the catalog files specified. + </p> + <p> + <div class="def">Function CXML:RESOLVE-URI (uri catalog)</div> + Look up <tt>uri</tt> in <tt>catalog</tt> and return the + resulting URI, or <tt>nil</tt> if no match was found. + </p> + <p> + <div class="def">Function CXML:RESOLVE-EXTID (publicid systemid catalog)</div> + Look up the External ID (<tt>publicid</tt>, <tt>systemid</tt>) + in <tt>catalog</tt> and return the resulting URI, or <tt>nil</tt> + if no match was found. + </p> + <p> + Example: + </p> + <pre>* (setf cxml:*catalog* nil) +* (cxml:parse-file "test.xhtml" nil) +=> Error: URI scheme :HTTP not supported + +* (setf cxml:*catalog* (cxml:make-catalog)) +* (cxml:parse-file "test.xhtml" nil) +;; no error! +NIL</pre> + <p> + Note that parsed catalog files are cached in the catalog object. + Catalog files cached do not expire automatically. To ensure that + all catalog files are parsed again, create a new catalog object. + </p> + + <a name="sax"/> + <h2>SAX Interface</h2> + <p> + A SAX handler is an arbitrary objects that implements some of the + generic functions in the SAX package.  Note that no default + handler class is necessary, because all generic functions have default + methods which do nothing.  SAX functions are: + <div class="def">Function SAX:START-DOCUMENT (handler)</div> + <div class="def">Function SAX:END-DOCUMENT (handler)</div> + <br/> + <div class="def">Function SAX:START-ELEMENT (handler namespace-uri local-name qname attributes)</div> + <div class="def">Function SAX:END-ELEMENT (handler namespace-uri local-name qname)</div> + <div class="def">Function SAX:START-PREFIX-MAPPING (handler prefix uri)</div> + <div class="def">Function SAX:END-PREFIX-MAPPING (handler prefix)</div> + <div class="def">Function SAX:PROCESSING-INSTRUCTION (handler target data)</div> + <div class="def">Function SAX:COMMENT (handler data)</div> + <div class="def">Function SAX:START-CDATA (handler)</div> + <div class="def">Function SAX:END-CDATA (handler)</div> + <div class="def">Function SAX:CHARACTERS (handler data)</div> + <br/> + <div class="def">Function SAX:START-DTD (handler name public-id system-id)</div> + <div class="def">Function SAX:END-DTD (handler)</div> + <div class="def">Function SAX:START-INTERNAL-SUBSET (handler)</div> + <div class="def">Function SAX:END-INTERNAL-SUBSET (handler)</div> + <div class="def">Function SAX:UNPARSED-ENTITY-DECLARATION (handler name public-id system-id notation-name)</div> + <div class="def">Function SAX:EXTERNAL-ENTITY-DECLARATION (handler kind name public-id system-id)</div> + <div class="def">Function SAX:INTERNAL-ENTITY-DECLARATION (handler kind name value)</div> + <div class="def">Function SAX:NOTATION-DECLARATION (handler name public-id system-id)</div> + <div class="def">Function SAX:ELEMENT-DECLARATION (handler name model)</div> + <div class="def">Function SAX:ATTRIBUTE-DECLARATION (handler ename aname type default)</div> + <br/> + <div class="def">Accessor SAX:ATTRIBUTE-PREFIX (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-NAMESPACE-URI (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-LOCAL-NAME (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-QNAME (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-SPECIFIED-P (attribute)</div> + <div class="def">Accessor SAX:ATTRIBUTE-VALUE (attribute)</div> + <br/> + <div class="def">Function SAX:FIND-ATTRIBUTE (qname attributes)</div> + <div class="def">Function SAX:FIND-ATTRIBUTE-NS (uri lname attributes)</div> + </p> + <p> + The entity declaration methods are similar to Java SAX + definitions, but parameter entities are distinguished from + general entities not by a <tt>%</tt> prefix to the name, but by + the <tt>kind</tt> argument, either <tt>:parameter</tt> or + <tt>:general</tt>. + </p> + <p> + The arguments to <tt>sax:element-declaration</tt> and + <tt>sax:attribute-declaration</tt> differ significantly from their + Java counterparts. + </p> + <p> + <i>fixme</i>: For more information on these functions refer to the docstrings. + </p> +</documentation> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/xmls-compat.html ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/xmls-compat.html Sun Feb 17 09:26:33 2008 @@ -0,0 +1,140 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> +<html> +<head> +<meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> +<title>CXML XMLS Compatibility</title> +<link rel="stylesheet" type="text/css" href="cxml.css"> +</head> +<body> +<div class="sidebar"> +<div class="sidebar-title"><a href="index.html">Closure XML</a></div> +<div class="sidebar-main"><ul class="main"> +<li> +<a href="installation.html">Installing Closure XML</a><ul class="sub"> +<li><a href="installation.html#download"><b>Download</b></a></li> +<li><a href="installation.html#implementations">Implementation-specific notes</a></li> +<li><a href="installation.html#compilation">Compilation</a></li> +<li><a href="installation.html#tests">Tests</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="quickstart.html"><b>Quick-Start Example / FAQ</b></a></li></ul></li> +<li> +<a href="sax.html">SAX parsing and serialization</a><ul class="sub"> +<li><a href="sax.html#parser">Parsing and Validating</a></li> +<li><a href="sax.html#serialization">Serialization</a></li> +<li><a href="sax.html#misc">Miscellaneous SAX handlers</a></li> +<li><a href="sax.html#rods">Recoders</a></li> +<li><a href="sax.html#dtdcache">Caching of DTD Objects</a></li> +<li><a href="sax.html#catalogs">XML Catalogs</a></li> +<li><a href="sax.html#sax">SAX Interface</a></li> +</ul> +</li> +<li> +<a href="klacks.html">Klacks parser</a><ul class="sub"> +<li><a href="klacks.html#sources">Parsing incrementally</a></li> +<li><a href="klacks.html#convenience">Convenience functions</a></li> +<li><a href="klacks.html#klacksax">Bridging Klacks and SAX</a></li> +<li><a href="klacks.html#locator">Location information</a></li> +<li><a href="klacks.html#klacksax">Examples</a></li> +</ul> +</li> +<li> +<a href="dom.html">DOM implementation</a><ul class="sub"> +<li><a href="dom.html#parser">Parsing with the DOM builder</a></li> +<li><a href="dom.html#serialization">Serialization</a></li> +<li><a href="dom.html#mapping">DOM/Lisp mapping</a></li> +</ul> +</li> +<li><ul class="hack"><li><a href="xmls-compat.html">XMLS Builder</a></li></ul></li> +</ul></div> +</div> + <h1>XMLS Builder</h1> + <p> + Like other XML parsers written in Lisp, CXML can work with + documents represented as list structures. The specific model + implemented by cxml is compatible with the <a href="http://common-lisp.net/project/xmls/">xmls parser</a>. Xmls + list structures are a simpler and faster alternative to full DOM + document trees. They also serve as an example showing how to + implement user-defined document models as an independent layer + over the the base parser (c.f. <tt>xml/xmls-compat.lisp</tt> in + the cxml distribution). However, note that the list structures do + not include all information available in DOM documents + (notably, things like <tt>dom:parent-node</tt>) and are + sometimes more difficult to work with because of that since many + DOM functions cannot be implemented on them. + </p> + <p> + <b>New namespace handling:</b> + XMLS compatibility is not <i>bug-for-bug</i>-compatible with + XMLS any more. There is now a mode using pairs of local name + and namespace URI, and a second mode using qualified names + only. The old behaviour using pairs of prefix and local names + was removed. + </p> + <p> + <strike> + fixme: It is unclear to me how namespaces are meant to + work in xmls, since xmls documentation differs from how xmls + actually works in current releases. Usually applications need to + know both the namespace prefix <em>and</em> the namespace URI. We + currently follow the xmls <em>implementation</em> and use the + namespace prefix instead of following its <em>documentation</em> which + shows the URI. We do not follow xmls in munging xmlns attribute + values. Attributes themselves have namespaces and it is not clear + to me how that works in xmls. + </strike> + </p> + <p> + <div class="def">Function CXML-XMLS:MAKE-XMLS-BUILDER (&key include-default-values include-namespace-uri)</div> + Create a SAX handler which builds XMLS list structures.  + If <tt>include-default-values</tt> is true, default values for + attributes declared in a DTD are included as attributes in the + xmls output. <tt>include-default-values</tt> is true by default + and can be set to <tt>nil</tt> to suppress inclusion of default + values. + </p> + <p> + If <tt>include-namespace-uri</tt> is true (the default), node + names and attribute names are pairs of local name and namespace + URI. (Except for attributes without a namespace, which are named + using a string.) Otherwise, nodes and attributes are named by + their qualified name. + </p> + <p> + Example: + </p> + <pre>(cxml:parse-file "test.xml" (cxml-xmls:make-xmls-builder))</pre> + <p> + <div class="def">Function CXML-XMLS:MAP-NODE (handler node &key include-xmlns-attributes include-namespace-uri)</div> + Traverse an XMLS document/node and call SAX functions as if an XML + representation of the document were processed by a SAX parser. + </p> + <p> + Use this function to serialize XMLS data. For example, we could + define a replacement for <tt>xmls:write-xml</tt> like this: + </p> + <pre>(defun write-xml (stream node &key indent) + (let ((sink (cxml:make-character-stream-sink + stream :canonical nil :indentation indent))) + (cxml-xmls:map-node sink node)))</pre> + <p> + <div class="def">Function CXML-XMLS:MAKE-NODE (&key name ns attrs + children) => xmls node</div> + Build a list node of the form + (<em>name</em> ((<em>name</em> <em>value</em>)<em>*</em>) <em>child*</em>). + </p> + <p> + The node list's <tt>car</tt> can also be a cons of local <tt>name</tt> + and namespace prefix <tt>ns</tt>. + </p> + <p> + <div class="def">Accessor CXML-XMLS:NODE-NAME (node)</div> + <div class="def">Accessor CXML-XMLS:NODE-NS (node)</div> + <div class="def">Accessor CXML-XMLS:NODE-ATTRS (node)</div> + <div class="def">Accessor CXML-XMLS:NODE-CHILDREN (node)</div> + Accessors for xmls node data. + </p> + <p> + </p> +</body> +</html> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/xmls-compat.xml ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/doc/xmls-compat.xml Sun Feb 17 09:26:33 2008 @@ -0,0 +1,91 @@ +<documentation title="CXML XMLS Compatibility"> + <h1>XMLS Builder</h1> + <p> + Like other XML parsers written in Lisp, CXML can work with + documents represented as list structures. The specific model + implemented by cxml is compatible with the <a + href="http://common-lisp.net/project/xmls/">xmls parser</a>. Xmls + list structures are a simpler and faster alternative to full DOM + document trees. They also serve as an example showing how to + implement user-defined document models as an independent layer + over the the base parser (c.f. <tt>xml/xmls-compat.lisp</tt> in + the cxml distribution). However, note that the list structures do + not include all information available in DOM documents + (notably, things like <tt>dom:parent-node</tt>) and are + sometimes more difficult to work with because of that since many + DOM functions cannot be implemented on them. + </p> + <p> + <b>New namespace handling:</b> + XMLS compatibility is not <i>bug-for-bug</i>-compatible with + XMLS any more. There is now a mode using pairs of local name + and namespace URI, and a second mode using qualified names + only. The old behaviour using pairs of prefix and local names + was removed. + </p> + <p> + <strike> + fixme: It is unclear to me how namespaces are meant to + work in xmls, since xmls documentation differs from how xmls + actually works in current releases. Usually applications need to + know both the namespace prefix <em>and</em> the namespace URI. We + currently follow the xmls <em>implementation</em> and use the + namespace prefix instead of following its <em>documentation</em> which + shows the URI. We do not follow xmls in munging xmlns attribute + values. Attributes themselves have namespaces and it is not clear + to me how that works in xmls. + </strike> + </p> + <p> + <div class="def">Function CXML-XMLS:MAKE-XMLS-BUILDER (&key include-default-values include-namespace-uri)</div> + Create a SAX handler which builds XMLS list structures.  + If <tt>include-default-values</tt> is true, default values for + attributes declared in a DTD are included as attributes in the + xmls output. <tt>include-default-values</tt> is true by default + and can be set to <tt>nil</tt> to suppress inclusion of default + values. + </p> + <p> + If <tt>include-namespace-uri</tt> is true (the default), node + names and attribute names are pairs of local name and namespace + URI. (Except for attributes without a namespace, which are named + using a string.) Otherwise, nodes and attributes are named by + their qualified name. + </p> + <p> + Example: + </p> + <pre>(cxml:parse-file "test.xml" (cxml-xmls:make-xmls-builder))</pre> + <p> + <div class="def">Function CXML-XMLS:MAP-NODE (handler node &key include-xmlns-attributes include-namespace-uri)</div> + Traverse an XMLS document/node and call SAX functions as if an XML + representation of the document were processed by a SAX parser. + </p> + <p> + Use this function to serialize XMLS data. For example, we could + define a replacement for <tt>xmls:write-xml</tt> like this: + </p> + <pre>(defun write-xml (stream node &key indent) + (let ((sink (cxml:make-character-stream-sink + stream :canonical nil :indentation indent))) + (cxml-xmls:map-node sink node)))</pre> + <p> + <div class="def">Function CXML-XMLS:MAKE-NODE (&key name ns attrs + children) => xmls node</div> + Build a list node of the form + (<em>name</em> ((<em>name</em> <em>value</em>)<em>*</em>) <em>child*</em>). + </p> + <p> + The node list's <tt>car</tt> can also be a cons of local <tt>name</tt> + and namespace prefix <tt>ns</tt>. + </p> + <p> + <div class="def">Accessor CXML-XMLS:NODE-NAME (node)</div> + <div class="def">Accessor CXML-XMLS:NODE-NS (node)</div> + <div class="def">Accessor CXML-XMLS:NODE-ATTRS (node)</div> + <div class="def">Accessor CXML-XMLS:NODE-CHILDREN (node)</div> + Accessors for xmls node data. + </p> + <p> + </p> +</documentation> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/documentation.css ============================================================================== Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-builder.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-builder.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,235 @@ +;;;; dom-builder.lisp -- DOM-building SAX handler +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;;; Author: Henrik Motakef <hmot@henrik-motakef.de> +;;;; Author: David Lichteblau <david@lichteblau.com> +;;;; Author: knowledgeTools Int. GmbH + +#-cxml-system::utf8dom-file +(in-package :rune-dom) + +#+cxml-system::utf8dom-file +(in-package :utf8-dom) + + +(defclass dom-builder (sax:content-handler) + ((document :initform nil :accessor document) + (element-stack :initform '() :accessor element-stack) + (internal-subset :accessor internal-subset) + (text-buffer :initform nil :accessor text-buffer))) + +#+(and rune-is-integer (not cxml-system::utf8dom-file)) +(defmethod hax:%want-strings-p ((handler dom-builder)) + nil) + +(defun make-dom-builder () + (make-instance 'dom-builder)) + +(defun fast-push (new-element vector) + (vector-push-extend new-element vector (max 1 (array-dimension vector 0)))) + +(defmethod sax:start-document ((handler dom-builder)) + (when (and sax:*namespace-processing* + (not (and sax:*include-xmlns-attributes* + sax:*use-xmlns-namespace*))) + (error "SAX configuration is incompatible with DOM: *namespace-processing* is activated, but *include-xmlns-attributes* or *use-xmlns-namespace* are not")) + (let ((document (make-instance 'document))) + (setf (slot-value document 'owner) nil + (slot-value document 'doc-type) nil) + (setf (document handler) document) + (push document (element-stack handler)))) + +;; fixme +(defmethod sax::dtd ((handler dom-builder) dtd) + (setf (slot-value (document handler) 'dtd) dtd)) + +(defmethod sax:end-document ((handler dom-builder)) + (let ((doctype (dom:doctype (document handler)))) + (when doctype + (setf (slot-value (dom:entities doctype) 'read-only-p) t) + (setf (slot-value (dom:notations doctype) 'read-only-p) t))) + (document handler)) + +(defmethod sax:entity-resolver ((handler dom-builder) resolver) + (setf (slot-value (document handler) 'entity-resolver) resolver)) + +(defmethod sax:start-dtd ((handler dom-builder) name publicid systemid) + (let* ((document (document handler)) + (doctype (%create-document-type name publicid systemid))) + (setf (slot-value doctype 'owner) document + (slot-value (dom:notations doctype) 'owner) document + (slot-value (dom:entities doctype) 'owner) document + (slot-value document 'doc-type) doctype))) + +(defmethod sax:start-internal-subset ((handler dom-builder)) + (setf (internal-subset handler) nil)) + +(defmethod sax:end-internal-subset ((handler dom-builder)) + (setf (dom::%internal-subset (slot-value (document handler) 'doc-type)) + (nreverse (internal-subset handler))) + (slot-makunbound handler 'internal-subset)) + +(macrolet ((defhandler (name &rest args) + `(defmethod ,name ((handler dom-builder) ,@args) + (when (slot-boundp handler 'internal-subset) + (push (list ',name ,@args) (internal-subset handler)))))) + (defhandler sax:unparsed-entity-declaration + name public-id system-id notation-name) + (defhandler sax:external-entity-declaration + kind name public-id system-id) + (defhandler sax:internal-entity-declaration + kind name value) + (defhandler sax:notation-declaration + name public-id system-id) + (defhandler sax:element-declaration + name model) + (defhandler sax:attribute-declaration + element-name attribute-name type default)) + +(defmethod sax:start-element + ((handler dom-builder) namespace-uri local-name qname attributes) + (check-type qname rod) ;catch recoder/builder mismatch + (flush-characters handler) + (with-slots (document element-stack) handler + (let* ((nsp sax:*namespace-processing*) + (element (make-instance 'element + :tag-name qname + :owner document + :namespace-uri (when nsp namespace-uri) + :local-name (when nsp local-name) + :prefix (%rod (when nsp (cxml::split-qname (real-rod qname)))))) + (parent (car element-stack)) + (anodes '())) + (dolist (attr attributes) + (let ((anode + (if nsp + (dom:create-attribute-ns document + (sax:attribute-namespace-uri attr) + (sax:attribute-qname attr)) + (dom:create-attribute document (sax:attribute-qname attr)))) + (text + (dom:create-text-node document (sax:attribute-value attr)))) + (setf (slot-value anode 'specified-p) + (sax:attribute-specified-p attr)) + (setf (slot-value anode 'owner-element) element) + (dom:append-child anode text) + (push anode anodes))) + (setf (slot-value element 'parent) parent) + (fast-push element (slot-value parent 'children)) + (let ((map + (make-instance 'attribute-node-map + :items anodes + :element-type :attribute + :element element + :owner document))) + (setf (slot-value element 'attributes) map) + (dolist (anode anodes) + (setf (slot-value anode 'map) map))) + (push element element-stack)))) + +(defmethod sax:end-element ((handler dom-builder) namespace-uri local-name qname) + (declare (ignore namespace-uri local-name qname)) + (flush-characters handler) + (pop (element-stack handler))) + +(defmethod sax:characters ((handler dom-builder) data) + (with-slots (text-buffer) handler + (cond + ((null text-buffer) + (setf text-buffer data)) + (t + (unless (array-has-fill-pointer-p text-buffer) + (setf text-buffer (make-array (length text-buffer) + :element-type 'rune + :adjustable t + :fill-pointer t + :initial-contents text-buffer))) + (let ((n (length text-buffer)) + (m (length data))) + (adjust-vector-exponentially text-buffer (+ n m) t) + (move data text-buffer 0 n m)))))) + +(defun flush-characters (handler) + (with-slots (document element-stack text-buffer) handler + (let ((data text-buffer)) + (when data + (when (array-has-fill-pointer-p data) + (setf data + (make-array (length data) + :element-type 'rune + :initial-contents data))) + (let ((parent (car element-stack))) + (if (eq (dom:node-type parent) :cdata-section) + (setf (dom:data parent) data) + (let ((node (dom:create-text-node document data))) + (setf (slot-value node 'parent) parent) + (fast-push node (slot-value (car element-stack) 'children))))) + (setf text-buffer nil))))) + +(defmethod sax:start-cdata ((handler dom-builder)) + (flush-characters handler) + (with-slots (document element-stack) handler + (let ((node (dom:create-cdata-section document #"")) + (parent (car element-stack))) + (setf (slot-value node 'parent) parent) + (fast-push node (slot-value parent 'children)) + (push node element-stack)))) + +(defmethod sax:end-cdata ((handler dom-builder)) + (flush-characters handler) + (let ((node (pop (slot-value handler 'element-stack)))) + (assert (eq (dom:node-type node) :cdata-section)))) + +(defmethod sax:processing-instruction ((handler dom-builder) target data) + (flush-characters handler) + (with-slots (document element-stack) handler + (let ((node (dom:create-processing-instruction document target data)) + (parent (car element-stack))) + (setf (slot-value node 'parent) parent) + (fast-push node (slot-value (car element-stack) 'children))))) + +(defmethod sax:comment ((handler dom-builder) data) + (flush-characters handler) + (with-slots (document element-stack) handler + (let ((node (dom:create-comment document data)) + (parent (car element-stack))) + (setf (slot-value node 'parent) parent) + (fast-push node (slot-value (car element-stack) 'children))))) + +(defmethod sax:unparsed-entity-declaration + ((handler dom-builder) name public-id system-id notation-name) + (set-entity handler name public-id system-id notation-name)) + +(defmethod sax:external-entity-declaration + ((handler dom-builder) kind name public-id system-id) + (ecase kind + (:general (set-entity handler name public-id system-id nil)) + (:parameter))) + +(defmethod sax:internal-entity-declaration + ((handler dom-builder) kind name value) + (declare (ignore value)) + (ecase kind + (:general (set-entity handler name nil nil nil)) + (:parameter))) + +(defun set-entity (handler name pid sid notation) + (dom:set-named-item (dom:entities (dom:doctype (document handler))) + (make-instance 'entity + :owner (document handler) + :name name + :public-id pid + :system-id sid + :notation-name notation))) + +(defmethod sax:notation-declaration + ((handler dom-builder) name public-id system-id) + (dom:set-named-item (dom:notations (dom:doctype (document handler))) + (make-instance 'notation + :owner (document handler) + :name name + :public-id public-id + :system-id system-id))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-impl.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-impl.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,1479 @@ +;;;; dom-impl.lisp -- Implementation of DOM 1 Core -*- package: rune-dom -*- +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;;; Author: David Lichteblau <david@lichteblau.com> +;;;; Author: knowledgeTools Int. GmbH + +#-cxml-system::utf8dom-file +(defpackage :rune-dom + (:use :cl :runes) + #+rune-is-character (:nicknames :cxml-dom) + (:export #:implementation #:make-dom-builder #:create-document)) + +#+cxml-system::utf8dom-file +(defpackage :utf8-dom + (:use :cl :utf8-runes) + (:nicknames :cxml-dom) + (:export #:implementation #:make-dom-builder #:create-document)) + +#-cxml-system::utf8dom-file +(in-package :rune-dom) + +#+cxml-system::utf8dom-file +(in-package :utf8-dom) + + +;; Classes + +(define-condition dom-exception (error) + ((key :initarg :key :reader dom-exception-key) + (string :initarg :string :reader dom-exception-string) + (arguments :initarg :arguments :reader dom-exception-arguments)) + (:report + (lambda (c s) + (format s "~A (~D):~%~?" + (dom-exception-key c) + (dom:code c) + (dom-exception-string c) + (dom-exception-arguments c))))) + +(defclass node (dom:node) + ((parent :initarg :parent :initform nil) + (children :initarg :children :initform (make-node-list)) + (owner :initarg :owner :initform nil) + (read-only-p :initform nil :reader read-only-p) + (map :initform nil))) + +(defmethod dom:prefix ((node node)) nil) +(defmethod dom:local-name ((node node)) nil) +(defmethod dom:namespace-uri ((node node)) nil) + +(defclass namespace-mixin () + ((prefix :initarg :prefix :reader dom:prefix) + (local-name :initarg :local-name :reader dom:local-name) + (namespace-uri :initarg :namespace-uri :reader dom:namespace-uri))) + +(defmethod (setf dom:prefix) (newval (node namespace-mixin)) + (assert-writeable node) + (when newval + (safe-split-qname (concatenate 'rod newval #":foo") + (dom:namespace-uri node))) + (setf (slot-value node 'prefix) newval)) + +(defclass document (node dom:document) + ((doc-type :initarg :doc-type :reader dom:doctype) + (dtd :initform nil :reader dtd) + (entity-resolver :initform nil))) + +(defclass document-fragment (node dom:document-fragment) + ()) + +(defclass character-data (node dom:character-data) + ((value :initarg :data :reader dom:data))) + +(defclass attribute (namespace-mixin node dom:attr) + ((name :initarg :name :reader dom:name) + (owner-element :initarg :owner-element :reader dom:owner-element) + (specified-p :initarg :specified-p :reader dom:specified))) + +(defmethod (setf dom:prefix) :before (newval (node attribute)) + (when (rod= (dom:node-name node) #"xmlns") + (dom-error :NAMESPACE_ERR "must not change xmlns attribute prefix"))) + +(defmethod (setf dom:prefix) :after (newval (node attribute)) + (setf (slot-value node 'name) + (concatenate 'rod newval #":" (dom:local-name node)))) + +(defmethod print-object ((object attribute) stream) + (print-unreadable-object (object stream :type t :identity t) + (format stream "~A=~S" + (rod-string (dom:name object)) + (rod-string (dom:value object))))) + +(defclass element (namespace-mixin node dom:element) + ((tag-name :initarg :tag-name :reader dom:tag-name) + (attributes :initarg :attributes :reader dom:attributes))) + +(defmethod (setf dom:prefix) :after (newval (node element)) + (setf (slot-value node 'tag-name) + (concatenate 'rod newval #":" (dom:local-name node)))) + +(defmethod print-object ((object element) stream) + (print-unreadable-object (object stream :type t :identity t) + (princ (rod-string (dom:tag-name object)) stream))) + +(defclass text (character-data dom:text) + ()) + +(defclass comment (character-data dom:comment) + ()) + +(defclass cdata-section (text dom:cdata-section) + ()) + +(defclass document-type (node dom:document-type) + ((name :initarg :name :reader dom:name) + (public-id :initarg :public-id :reader dom:public-id) + (system-id :initarg :system-id :reader dom:system-id) + (entities :initarg :entities :reader dom:entities) + (notations :initarg :notations :reader dom:notations) + (dom::%internal-subset :accessor dom::%internal-subset))) + +(defclass notation (node dom:notation) + ((name :initarg :name :reader dom:name) + (public-id :initarg :public-id :reader dom:public-id) + (system-id :initarg :system-id :reader dom:system-id))) + +(defclass entity (node dom:entity) + ((name :initarg :name :reader dom:name) + (public-id :initarg :public-id :reader dom:public-id) + (system-id :initarg :system-id :reader dom:system-id) + (notation-name :initarg :notation-name :reader dom:notation-name))) + +(defclass entity-reference (node dom:entity-reference) + ((name :initarg :name :reader dom:name))) + +(defclass processing-instruction (node dom:processing-instruction) + ((target :initarg :target :reader dom:target) + (data :initarg :data :reader dom:data))) + +(defclass named-node-map (dom:named-node-map) + ((items :initarg :items :reader dom:items + :initform nil) + (owner :initarg :owner :reader dom:owner-document) + (read-only-p :initform nil :reader read-only-p) + (element-type :initarg :element-type))) + +(defclass attribute-node-map (named-node-map) + ((element :initarg :element))) + + +;;; Implementation + +(defun %rod (x) + (etypecase x + (null x) + (rod x) + #+cxml-system::utf8dom-file (runes::rod (cxml::rod-to-utf8-string x)) + (string (string-rod x)) + (vector x))) + +#-cxml-system::utf8dom-file +(defun real-rod (x) + (%rod x)) + +#+cxml-system::utf8dom-file +(defun real-rod (x) + (etypecase x + (null x) + (runes::rod x) + (string (cxml::utf8-string-to-rod x)))) + +(defun valid-name-p (x) + (cxml::valid-name-p (real-rod x))) + +(defun assert-writeable (node) + (when (read-only-p node) + (dom-error :NO_MODIFICATION_ALLOWED_ERR "~S is marked read-only." node))) + +(defun dom:map-node-list (fn nodelist) + (dotimes (i (dom:length nodelist)) + (funcall fn (dom:item nodelist i)))) + +(defmacro dom:do-node-list ((var nodelist &optional resultform) &body body) + `(block nil + (dom:map-node-list (lambda (,var) ,@body) ,nodelist) + ,resultform)) + +(defun dom:map-node-map (fn node-map) + (with-slots (items) node-map + (mapc fn items))) + +(defmacro dom:do-node-map ((var node-map &optional resultform) &body body) + `(block nil + (dom:map-node-map (lambda (,var) ,@body) ,node-map) + ,resultform)) + +(defmacro dovector ((var vector &optional resultform) &body body) + `(loop + for ,var across ,vector do (progn ,@body) + ,@(when resultform `(finally (return ,resultform))))) + +(defun move (from to from-start to-start length) + ;; like (setf (subseq to to-start (+ to-start length)) + ;; (subseq from from-start (+ from-start length))) + ;; but without creating the garbage. + ;; Also, this is using AREF not ELT so that fill-pointers are ignored. + (if (< to-start from-start) + (loop + repeat length + for i from from-start + for j from to-start + do (setf (aref to j) (aref from i))) + (loop + repeat length + for i downfrom (+ from-start length -1) + for j downfrom (+ to-start length -1) + do (setf (aref to j) (aref from i))))) + +(defun adjust-vector-exponentially (vector new-dimension set-fill-pointer-p) + (let ((d (array-dimension vector 0))) + (when (< d new-dimension) + (loop + do (setf d (* 2 d)) + while (< d new-dimension)) + (adjust-array vector d)) + (when set-fill-pointer-p + (setf (fill-pointer vector) new-dimension)))) + +(defun make-space (vector &optional (n 1)) + (adjust-vector-exponentially vector (+ (length vector) n) nil)) + +(defun extension (vector) + (max (array-dimension vector 0) 1)) + +;; dom-exception + +(defun dom-error (key fmt &rest args) + (error 'dom-exception :key key :string fmt :arguments args)) + +(defmethod dom:code ((self dom-exception)) + (ecase (dom-exception-key self) + (:INDEX_SIZE_ERR 1) + (:DOMSTRING_SIZE_ERR 2) + (:HIERARCHY_REQUEST_ERR 3) + (:WRONG_DOCUMENT_ERR 4) + (:INVALID_CHARACTER_ERR 5) + (:NO_DATA_ALLOWED_ERR 6) + (:NO_MODIFICATION_ALLOWED_ERR 7) + (:NOT_FOUND_ERR 8) + (:NOT_SUPPORTED_ERR 9) + (:INUSE_ATTRIBUTE_ERR 10) + (:INVALID_STATE_ERR 11) + (:SYNTAX_ERR 12) + (:INVALID_MODIFICATION_ERR 13) + (:NAMESPACE_ERR 14) + (:INVALID_ACCESS_ERR 15))) + +;; dom-implementation protocol + +(defmethod dom:has-feature ((factory (eql 'implementation)) feature version) + (and (or (string-equal (rod-string feature) "xml") + (string-equal (rod-string feature) "core")) + (or (zerop (length version)) + (string-equal (rod-string version) "1.0") + (string-equal (rod-string version) "2.0")))) + +(defun %create-document-type (name publicid systemid) + (make-instance 'document-type + :name name + :notations (make-instance 'named-node-map + :element-type :notation + :owner nil) + :entities (make-instance 'named-node-map + :element-type :entity + :owner nil) + :public-id publicid + :system-id systemid)) + +(defmethod dom:create-document-type + ((factory (eql 'implementation)) name publicid systemid) + (safe-split-qname name #"") + (let ((result (%create-document-type name publicid systemid))) + (setf (slot-value (dom:entities result) 'read-only-p) t) + (setf (slot-value (dom:notations result) 'read-only-p) t) + result)) + +(defmethod dom:create-document + ((factory (eql 'implementation)) uri qname doctype) + (let ((document (make-instance 'document))) + (setf (slot-value document 'owner) nil + (slot-value document 'doc-type) doctype) + (when doctype + (unless (typep doctype 'document-type) + (dom-error :WRONG_DOCUMENT_ERR + "doctype was created by a different dom implementation")) + (when (dom:owner-document doctype) + (dom-error :WRONG_DOCUMENT_ERR "doctype already in use")) + (setf (slot-value doctype 'owner) document + (slot-value (dom:notations doctype) 'owner) document + (slot-value (dom:entities doctype) 'owner) document)) + (when (or uri qname) + (dom:append-child document (dom:create-element-ns document uri qname))) + document)) + +;; document-fragment protocol +;; document protocol + +(defmethod dom:implementation ((document document)) + 'implementation) + +(defmethod dom:document-element ((document document)) + (dovector (k (dom:child-nodes document)) + (cond ((typep k 'element) + (return k))))) + +(defmethod dom:create-element ((document document) tag-name) + (setf tag-name (%rod tag-name)) + (unless (valid-name-p tag-name) + (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string tag-name))) + (let ((result (make-instance 'element + :tag-name tag-name + :namespace-uri nil + :local-name nil + :prefix nil + :owner document))) + (setf (slot-value result 'attributes) + (make-instance 'attribute-node-map + :element-type :attribute + :owner document + :element result)) + (add-default-attributes result) + result)) + +(defun safe-split-qname (qname uri) + (unless (valid-name-p qname) + (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string qname))) + (multiple-value-bind (prefix local-name) + (handler-case + (cxml::split-qname (real-rod qname)) + (cxml:well-formedness-violation (c) + (dom-error :NAMESPACE_ERR "~A" c))) + (setf local-name (%rod local-name)) + (when prefix + (setf prefix (%rod prefix)) + (unless uri + (dom-error :NAMESPACE_ERR "prefix specified but no namespace URI")) + (when (and (rod= prefix #"xml") + (not (rod= uri #"http://www.w3.org/XML/1998/namespace"))) + (dom-error :NAMESPACE_ERR "invalid uri for prefix `xml'")) + (when (and (rod= prefix #"xmlns") + (not (rod= uri #"http://www.w3.org/2000/xmlns/"))) + (dom-error :NAMESPACE_ERR "invalid uri for prefix `xmlns'"))) + (values prefix local-name))) + +(defmethod dom:create-element-ns ((document document) uri qname) + (setf qname (%rod qname)) + (multiple-value-bind (prefix local-name) + (safe-split-qname qname uri) + (let ((result (make-instance 'element + :tag-name qname + :namespace-uri uri + :local-name local-name + :prefix prefix + :owner document))) + (setf (slot-value result 'attributes) + (make-instance 'attribute-node-map + :element-type :attribute + :owner document + :element result)) + (add-default-attributes result) + result))) + +(defmethod dom:create-document-fragment ((document document)) + (make-instance 'document-fragment + :owner document)) + +(defmethod dom:create-text-node ((document document) data) + (setf data (%rod data)) + (make-instance 'text + :data data + :owner document)) + +(defmethod dom:create-comment ((document document) data) + (setf data (%rod data)) + (make-instance 'comment + :data data + :owner document)) + +(defmethod dom:create-cdata-section ((document document) data) + (setf data (%rod data)) + (make-instance 'cdata-section + :data data + :owner document)) + +(defmethod dom:create-processing-instruction ((document document) target data) + (setf target (%rod target)) + (setf data (%rod data)) + (unless (valid-name-p target) + (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string target))) + (make-instance 'processing-instruction + :owner document + :target target + :data data)) + +(defmethod dom:create-attribute ((document document) name) + (setf name (%rod name)) + (unless (valid-name-p name) + (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string name))) + (make-instance 'attribute + :name name + :local-name nil + :prefix nil + :namespace-uri nil + :specified-p t + :owner-element nil + :owner document)) + +(defmethod dom:create-attribute-ns ((document document) uri qname) + (setf uri (%rod uri)) + (setf qname (%rod qname)) + (when (and (rod= qname #"xmlns") + (not (rod= uri #"http://www.w3.org/2000/xmlns/"))) + (dom-error :NAMESPACE_ERR "invalid uri for qname `xmlns'")) + (multiple-value-bind (prefix local-name) + (safe-split-qname qname uri) + (make-instance 'attribute + :name qname + :namespace-uri uri + :local-name local-name + :prefix prefix + :specified-p t + :owner-element nil + :owner document))) + +(defmethod dom:create-entity-reference ((document document) name) + (setf name (%rod name)) + (unless (valid-name-p name) + (dom-error :INVALID_CHARACTER_ERR "not a name: ~A" (rod-string name))) + (make-instance 'entity-reference + :name name + :owner document)) + +(defmethod get-elements-by-tag-name-internal (node tag-name) + (setf tag-name (%rod tag-name)) + (let ((result (make-node-list)) + (wild-p (rod= tag-name #"*"))) + (labels ((walk (n) + (dovector (c (dom:child-nodes n)) + (when (dom:element-p c) + (when (or wild-p (rod= tag-name (dom:node-name c))) + (vector-push-extend c result (extension result))) + (walk c))))) + (walk node)) + result)) + +(defmethod get-elements-by-tag-name-internal-ns (node uri lname) + (setf uri (%rod uri)) + (setf lname (%rod lname)) + (let ((result (make-node-list)) + (wild-uri-p (rod= uri #"*")) + (wild-lname-p (rod= lname #"*"))) + (labels ((walk (n) + (dovector (c (dom:child-nodes n)) + (when (dom:element-p c) + (when (and (or wild-lname-p (rod= lname (dom:local-name c))) + (or wild-uri-p (rod= uri (dom:namespace-uri c)))) + (vector-push-extend c result (extension result))) + (walk c))))) + (walk node)) + result)) + +(defmethod dom:get-elements-by-tag-name ((document document) tag-name) + (get-elements-by-tag-name-internal document tag-name)) + +(defmethod dom:get-elements-by-tag-name-ns ((document document) uri lname) + (get-elements-by-tag-name-internal-ns document uri lname)) + +(defmethod dom:get-element-by-id ((document document) id) + (block t + (unless (dtd document) + (return-from t nil)) + (setf id (%rod id)) + (labels ((walk (n) + (dovector (c (dom:child-nodes n)) + (when (dom:element-p c) + (let ((e (cxml::find-element + (real-rod (dom:tag-name c)) + (dtd document)))) + (when e + (dolist (a (cxml::elmdef-attributes e)) + (when (eq :ID (cxml::attdef-type a)) + (let* ((name (%rod (cxml::attdef-name a))) + (value (dom:get-attribute c name))) + (when (and value (rod= value id)) + (return-from t c))))))) + (walk c))))) + (walk document)))) + + +;;; Node + +(defmethod dom:has-attributes ((element node)) + nil) + +(defmethod dom:is-supported ((node node) feature version) + (dom:has-feature 'implementation feature version)) + +(defmethod dom:parent-node ((node node)) + (slot-value node 'parent)) + +(defmethod dom:child-nodes ((node node)) + (slot-value node 'children)) + +(defmethod dom:first-child ((node node)) + (dom:item (slot-value node 'children) 0)) + +(defmethod dom:last-child ((node node)) + (with-slots (children) node + (if (plusp (length children)) + (elt children (1- (length children))) + nil))) + +(defmethod dom:previous-sibling ((node node)) + (with-slots (parent) node + (when parent + (with-slots (children) parent + (let ((index (1- (position node children)))) + (if (eql index -1) + nil + (elt children index))))))) + +(defmethod dom:next-sibling ((node node)) + (with-slots (parent) node + (when parent + (with-slots (children) parent + (let ((index (1+ (position node children)))) + (if (eql index (length children)) + nil + (elt children index))))))) + +(defmethod dom:owner-document ((node node)) + (slot-value node 'owner)) + +(defun ensure-valid-insertion-request (node new-child) + (assert-writeable node) + (unless (can-adopt-p node new-child) + (dom-error :HIERARCHY_REQUEST_ERR "~S cannot adopt ~S." node new-child)) + #+(or) ;XXX needs to be moved elsewhere + (when (eq (dom:node-type node) :document) + (let ((child-type (dom:node-type new-child))) + (when (and (member child-type '(:element :document-type)) + (find child-type (dom:child-nodes node) :key #'dom:node-type)) + (dom-error :HIERARCHY_REQUEST_ERR + "~S cannot adopt a second child of type ~S." + node child-type)))) + (unless (eq (if (eq (dom:node-type node) :document) + node + (dom:owner-document node)) + (dom:owner-document new-child)) + (dom-error :WRONG_DOCUMENT_ERR + "~S cannot adopt ~S, since it was created by a different document." + node new-child)) + (do ((n node (dom:parent-node n))) + ((null n)) + (when (eq n new-child) + (dom-error :HIERARCHY_REQUEST_ERR + "~S cannot adopt ~S, since that would create a cycle" + node new-child))) + (unless (null (slot-value new-child 'parent)) + (dom:remove-child (slot-value new-child 'parent) new-child))) + +(defmethod dom:insert-before ((node node) (new-child node) ref-child) + (ensure-valid-insertion-request node new-child) + (with-slots (children) node + (if ref-child + (let ((i (position ref-child children))) + (unless i + (dom-error :NOT_FOUND_ERR "~S is no child of ~S." ref-child node)) + (make-space children 1) + (move children children i (1+ i) (- (length children) i)) + (incf (fill-pointer children)) + (setf (elt children i) new-child)) + (vector-push-extend new-child children (extension children))) + (setf (slot-value new-child 'parent) node) + new-child)) + +(defmethod dom:insert-before + ((node node) (fragment document-fragment) ref-child) + (let ((children (dom:child-nodes fragment))) + (cxml::while (plusp (length children)) + (dom:insert-before node (elt children 0) ref-child))) + fragment) + +(defmethod dom:replace-child ((node node) (new-child node) (old-child node)) + (ensure-valid-insertion-request node new-child) + (with-slots (children) node + (let ((i (position old-child children))) + (unless i + (dom-error :NOT_FOUND_ERR "~S is no child of ~S." old-child node)) + (setf (elt children i) new-child)) + (setf (slot-value new-child 'parent) node) + (setf (slot-value old-child 'parent) nil) + old-child)) + +(defmethod dom:replace-child + ((node node) (new-child document-fragment) (old-child node)) + (dom:insert-before node new-child old-child) + (dom:remove-child node old-child)) + +(defmethod dom:remove-child ((node node) (old-child node)) + (assert-writeable node) + (with-slots (children) node + (let ((i (position old-child children))) + (unless i + (dom-error :NOT_FOUND_ERR "~A not found in ~A" old-child node)) + (move children children (1+ i) i (- (length children) i 1)) + (decf (fill-pointer children))) + (setf (slot-value old-child 'parent) nil) + old-child)) + +(defmethod dom:append-child ((node node) (new-child node)) + (ensure-valid-insertion-request node new-child) + (with-slots (children) node + (vector-push-extend new-child children (extension children)) + (setf (slot-value new-child 'parent) node) + new-child)) + +(defmethod dom:has-child-nodes ((node node)) + (plusp (length (slot-value node 'children)))) + +(defmethod dom:append-child ((node node) (new-child document-fragment)) + (assert-writeable node) + (let ((children (dom:child-nodes new-child))) + (cxml::while (plusp (length children)) + (dom:append-child node (elt children 0)))) + new-child) + +;; was auf node noch implemetiert werden muss: +;; - node-type +;; - can-adopt-p +;; - ggf attributes +;; - node-name +;; - node-value + +;; node-name + +(defmethod dom:node-name ((self document)) + #"#document") + +(defmethod dom:node-name ((self document-fragment)) + #"#document-fragment") + +(defmethod dom:node-name ((self text)) + #"#text") + +(defmethod dom:node-name ((self cdata-section)) + #"#cdata-section") + +(defmethod dom:node-name ((self comment)) + #"#comment") + +(defmethod dom:node-name ((self attribute)) + (dom:name self)) + +(defmethod dom:node-name ((self element)) + (dom:tag-name self)) + +(defmethod dom:node-name ((self document-type)) + (dom:name self)) + +(defmethod dom:node-name ((self notation)) + (dom:name self)) + +(defmethod dom:node-name ((self entity)) + (dom:name self)) + +(defmethod dom:node-name ((self entity-reference)) + (dom:name self)) + +(defmethod dom:node-name ((self processing-instruction)) + (dom:target self)) + +;; node-type + +(defmethod dom:node-type ((self document)) :document) +(defmethod dom:node-type ((self document-fragment)) :document-fragment) +(defmethod dom:node-type ((self text)) :text) +(defmethod dom:node-type ((self comment)) :comment) +(defmethod dom:node-type ((self cdata-section)) :cdata-section) +(defmethod dom:node-type ((self attribute)) :attribute) +(defmethod dom:node-type ((self element)) :element) +(defmethod dom:node-type ((self document-type)) :document-type) +(defmethod dom:node-type ((self notation)) :notation) +(defmethod dom:node-type ((self entity)) :entity) +(defmethod dom:node-type ((self entity-reference)) :entity-reference) +(defmethod dom:node-type ((self processing-instruction)) :processing-instruction) + +;; node-value + +(defmethod dom:node-value ((self document)) nil) +(defmethod dom:node-value ((self document-fragment)) nil) +(defmethod dom:node-value ((self character-data)) (dom:data self)) +(defmethod dom:node-value ((self attribute)) (dom:value self)) +(defmethod dom:node-value ((self element)) nil) +(defmethod dom:node-value ((self document-type)) nil) +(defmethod dom:node-value ((self notation)) nil) +(defmethod dom:node-value ((self entity)) nil) +(defmethod dom:node-value ((self entity-reference)) nil) +(defmethod dom:node-value ((self processing-instruction)) (dom:data self)) + +;; (setf node-value), first the meaningful cases... + +(defmethod (setf dom:node-value) (newval (self character-data)) + (assert-writeable self) + (setf (dom:data self) newval)) + +(defmethod (setf dom:node-value) (newval (self attribute)) + (assert-writeable self) + (setf (dom:value self) newval)) + +(defmethod (setf dom:node-value) (newval (self processing-instruction)) + (assert-writeable self) + (setf (dom:data self) newval)) + +;; ... and (setf node-value), part II. The DOM Level 1 spec fails to explain +;; this case, but it is covered by the (Level 1) test suite and clarified +;; in Level 2: +;; nodeValue of type DOMString +;; The value of this node, depending on its type; see the +;; table above. When it is defined to be null, setting +;; it has no effect. + +(defmethod (setf dom:node-value) (newval (self element)) + (declare (ignore newval))) + +(defmethod (setf dom:node-value) (newval (self entity-reference)) + (declare (ignore newval))) + +(defmethod (setf dom:node-value) (newval (self entity)) + (declare (ignore newval))) + +(defmethod (setf dom:node-value) (newval (self document)) + (declare (ignore newval))) + +(defmethod (setf dom:node-value) (newval (self document-type)) + (declare (ignore newval))) + +(defmethod (setf dom:node-value) (newval (self document-fragment)) + (declare (ignore newval))) + +(defmethod (setf dom:node-value) (newval (self notation)) + (declare (ignore newval))) + +;; attributes + +;; (gibt es nur auf element) + +(defmethod dom:attributes ((self node)) + nil) + +;; dann fehlt noch can-adopt und attribute conventions fuer adoption + +;;; NodeList + +(defun make-node-list (&optional initial-contents) + (make-array (length initial-contents) + :adjustable t + :fill-pointer (length initial-contents) + :initial-contents initial-contents)) + +(defmethod dom:item ((self vector) index) + (if (< index (length self)) + (elt self index) + nil)) + +(defmethod dom:length ((self vector)) + (length self)) + +;;; NAMED-NODE-MAP + +(defmethod dom:get-named-item ((self named-node-map) name) + (setf name (%rod name)) + (with-slots (items) self + (dolist (k items nil) + (when (rod= name (dom:node-name k)) + (return k))))) + +(defmethod dom:get-named-item-ns ((self named-node-map) uri lname) + (setf uri (%rod uri)) + (setf lname (%rod lname)) + (with-slots (items) self + (dolist (k items nil) + (when (and (rod= uri (dom:namespace-uri k)) + (rod= lname (dom:local-name k))) + (return k))))) + +(defun %set-named-item (map arg test) + (assert-writeable map) + (unless (eq (dom:node-type arg) (slot-value map 'element-type)) + (dom-error :HIERARCHY_REQUEST_ERR + "~S cannot adopt ~S, since it is not of type ~S." + map arg (slot-value map 'element-type))) + (unless (eq (dom:owner-document map) (dom:owner-document arg)) + (dom-error :WRONG_DOCUMENT_ERR + "~S cannot adopt ~S, since it was created by a different document." + map arg)) + (let ((old-map (slot-value arg 'map))) + (when (and old-map (not (eq old-map map))) + (dom-error :INUSE_ATTRIBUTE_ERR "Attribute node already mapped" arg))) + (setf (slot-value arg 'map) map) + (with-slots (items) map + (dolist (k items (progn (setf items (cons arg items)) nil)) + (when (funcall test k) + (setf items (cons arg (delete k items))) + (return k))))) + +(defmethod dom:set-named-item ((self named-node-map) arg) + (let ((name (dom:node-name arg))) + (%set-named-item self arg (lambda (k) (rod= name (dom:node-name k)))))) + +(defmethod dom:set-named-item-ns ((self named-node-map) arg) + (let ((uri (dom:namespace-uri arg)) + (lname (dom:local-name arg))) + (%set-named-item self + arg + (lambda (k) + (and (rod= lname (dom:local-name k)) + (rod= uri (dom:namespace-uri k))))))) + +(defmethod dom:remove-named-item ((self named-node-map) name) + (assert-writeable self) + (setf name (%rod name)) + (with-slots (items) self + (dolist (k items (dom-error :NOT_FOUND_ERR "~A not found in ~A" name self)) + (cond ((rod= name (dom:node-name k)) + (setf items (delete k items)) + (return k)))))) + +(defmethod dom:remove-named-item-ns ((self named-node-map) uri lname) + (assert-writeable self) + (setf uri (%rod uri)) + (setf lname (%rod lname)) + (with-slots (items) self + (dolist (k items + (dom-error :NOT_FOUND_ERR "~A not found in ~A" lname self)) + (when (and (rod= lname (dom:local-name k)) + (rod= uri (dom:namespace-uri k))) + (setf items (delete k items)) + (return k))))) + +(defmethod dom:length ((self named-node-map)) + (with-slots (items) self + (length items))) + +(defmethod dom:item ((self named-node-map) index) + (with-slots (items) self + (do ((nthcdr items (cdr nthcdr)) + (i index (1- i))) + ((zerop i) (car nthcdr))))) + +;;; CHARACTER-DATA + +(defmethod (setf dom:data) (newval (self character-data)) + (assert-writeable self) + (setf newval (%rod newval)) + (setf (slot-value self 'value) newval)) + +(defmethod dom:length ((node character-data)) + (length (slot-value node 'value))) + +(defmethod dom:substring-data ((node character-data) offset count) + (with-slots (value) node + (unless (<= 0 offset (length value)) + (dom-error :INDEX_SIZE_ERR "offset is invalid")) + (let ((end (min (length value) (+ offset count)))) + (subseq value offset end)))) + +(defmethod dom:append-data ((node character-data) arg) + (assert-writeable node) + (setq arg (%rod arg)) + (with-slots (value) node + (setf value (concatenate 'rod value arg))) + (values)) + +(defmethod dom:delete-data ((node character-data) offset count) + (assert-writeable node) + (with-slots (value) node + (unless (<= 0 offset (length value)) + (dom-error :INDEX_SIZE_ERR "offset is invalid")) + (when (minusp count) + (dom-error :INDEX_SIZE_ERR "count is negative")) + (setf count (min count (- (length value) offset))) + (let ((new (make-array (- (length value) count) + :element-type (array-element-type value)))) + (replace new value + :start1 0 :end1 offset + :start2 0 :end2 offset) + (replace new value + :start1 offset :end1 (length new) + :start2 (+ offset count) :end2 (length value)) + (setf value new))) + (values)) + +(defmethod dom:replace-data ((node character-data) offset count arg) + ;; Although we could implement this by calling DELETE-DATA, then INSERT-DATA, + ;; we implement this function directly to avoid creating temporary garbage. + (assert-writeable node) + (setf arg (%rod arg)) + (with-slots (value) node + (unless (<= 0 offset (length value)) + (dom-error :INDEX_SIZE_ERR "offset is invalid")) + (when (minusp count) + (dom-error :INDEX_SIZE_ERR "count is negative")) + (setf count (min count (- (length value) offset))) + (if (= count (length arg)) + (replace value arg + :start1 offset :end1 (+ offset count) + :start2 0 :end2 count) + (let ((new (make-array (+ (length value) (length arg) (- count)) + :element-type (array-element-type value)))) + (replace new value :end1 offset) + (replace new arg :start1 offset) + (replace new value + :start1 (+ offset (length arg)) + :start2 (+ offset count)) + (setf value new)))) + (values)) + +(defmethod dom:insert-data ((node character-data) offset arg) + (assert-writeable node) + (setf arg (%rod arg)) + (with-slots (value) node + (unless (<= 0 offset (length value)) + (dom-error :INDEX_SIZE_ERR "offset is invalid")) + (let ((new (make-array (+ (length value) (length arg)) + :element-type (array-element-type value))) + (arglen (length arg))) + (replace new value :end1 offset) + (replace new arg :start1 offset) + (replace new value :start1 (+ offset arglen) :start2 offset) + (setf value new))) + (values)) + +;;; ATTR +;;; +;;; An attribute value can be read and set as a string using DOM:VALUE +;;; or frobbed by changing the attribute's children! +;;; +;;; We store the value in a TEXT node and read this node's DATA slot +;;; when asked for our VALUE -- until the user changes the child nodes, +;;; in which case we have to compute VALUE by traversing the children. + +(defmethod dom:value ((node attribute)) + (with-slots (children) node + (cond + ((zerop (length children)) + #.(rod-string "")) + ((and (eql (length children) 1) + (eq (dom:node-type (elt children 0)) :text)) + ;; we have as single TEXT-NODE child, just return its DATA + (dom:data (elt children 0))) + (t + ;; traverse children to compute value + (attribute-to-string node))))) + +(defmethod (setf dom:value) (new-value (node attribute)) + (assert-writeable node) + (let ((rod (%rod new-value))) + (with-slots (children owner) node + ;; remove children, add new TEXT-NODE child + ;; (alas, we must not reuse an old TEXT-NODE) + (cxml::while (plusp (length children)) + (dom:remove-child node (dom:last-child node))) + (dom:append-child node (dom:create-text-node owner rod)))) + new-value) + +(defun attribute-to-string (attribute) + (let ((stream (make-rod-stream))) + (flet ((doit () + (dovector (child (dom:child-nodes attribute)) + (write-attribute-child child stream)))) + (doit) + (initialize-rod-stream stream) + (doit)) + (rod-stream-buf stream))) + +(defmethod write-attribute-child ((node node) stream) + (put-rod (dom:node-value node) stream)) + +(defmethod write-attribute-child ((node entity-reference) stream) + (dovector (child (dom:child-nodes node)) + (write-attribute-child child stream))) + +;;; ROD-STREAM als Ersatz fuer MAKE-STRING-OUTPUT-STREAM zu verwenden, +;;; nur dass der Buffer statische Groesse hat. Solange er NIL ist, +;;; zaehlt der Stream nur die Runen. Dann ruft man INITIALIZE-ROD-STREAM +;;; auf, um den Buffer zu erzeugen und die Position zurueckzusetzen, und +;;; schreibt alles abermals. Dann ist der Buffer gefuellt. +(defstruct rod-stream + (buf nil) + (position 0)) + +(defun put-rod (rod rod-stream) + (let ((buf (rod-stream-buf rod-stream))) + (when buf + (move rod buf 0 (rod-stream-position rod-stream) (length rod))) + (incf (rod-stream-position rod-stream) (length rod))) + rod) + +(defun initialize-rod-stream (stream) + (setf (rod-stream-buf stream) (make-rod (rod-stream-position stream))) + (setf (rod-stream-position stream) 0) + stream) + +;;; ELEMENT + +(defmethod dom:has-attributes ((element element)) + (plusp (length (dom:items (dom:attributes element))))) + +(defmethod dom:has-attribute ((element element) name) + (and (dom:get-named-item (dom:attributes element) name) t)) + +(defmethod dom:has-attribute-ns ((element element) uri lname) + (and (dom:get-named-item-ns (dom:attributes element) uri lname) t)) + +(defmethod dom:get-attribute-node ((element element) name) + (dom:get-named-item (dom:attributes element) name)) + +(defmethod dom:set-attribute-node ((element element) (new-attr attribute)) + (assert-writeable element) + (dom:set-named-item (dom:attributes element) new-attr)) + +(defmethod dom:get-attribute-node-ns ((element element) uri lname) + (dom:get-named-item-ns (dom:attributes element) uri lname)) + +(defmethod dom:set-attribute-node-ns ((element element) (new-attr attribute)) + (assert-writeable element) + (dom:set-named-item-ns (dom:attributes element) new-attr)) + +(defmethod dom:get-attribute ((element element) name) + (let ((a (dom:get-attribute-node element name))) + (if a + (dom:value a) + #""))) + +(defmethod dom:get-attribute-ns ((element element) uri lname) + (let ((a (dom:get-attribute-node-ns element uri lname))) + (if a + (dom:value a) + #""))) + +(defmethod dom:set-attribute ((element element) name value) + (assert-writeable element) + (with-slots (owner) element + (let ((attr (dom:create-attribute owner name))) + (setf (slot-value attr 'owner-element) element) + (setf (dom:value attr) value) + (dom:set-attribute-node element attr)) + (values))) + +(defmethod dom:set-attribute-ns ((element element) uri lname value) + (assert-writeable element) + (with-slots (owner) element + (let ((attr (dom:create-attribute-ns owner uri lname))) + (setf (slot-value attr 'owner-element) element) + (setf (dom:value attr) value) + (dom:set-attribute-node-ns element attr)) + (values))) + +(defmethod dom:remove-attribute ((element element) name) + (assert-writeable element) + (dom:remove-attribute-node element (dom:get-attribute-node element name))) + +(defmethod dom:remove-attribute-ns ((elt element) uri lname) + (assert-writeable elt) + (dom:remove-attribute-node elt (dom:get-attribute-node-ns elt uri lname))) + +(defmethod dom:remove-attribute-node ((element element) (old-attr attribute)) + (assert-writeable element) + (with-slots (items) (dom:attributes element) + (unless (find old-attr items) + (dom-error :NOT_FOUND_ERR "Attribute not found.")) + (setf items (remove old-attr items)) + (maybe-add-default-attribute element old-attr) + old-attr)) + +;; eek, defaulting: + +(defun maybe-add-default-attribute (element old-attr) + (let* ((qname (dom:name old-attr)) + (dtd (dtd (slot-value element 'owner))) + (e (when dtd (cxml::find-element + (real-rod (dom:tag-name element)) + dtd))) + (a (when e (cxml::find-attribute e (real-rod qname))))) + (when (and a (listp (cxml::attdef-default a))) + (let ((new (add-default-attribute element a))) + (setf (slot-value new 'namespace-uri) (dom:namespace-uri old-attr)) + (setf (slot-value new 'prefix) (dom:prefix old-attr)) + (setf (slot-value new 'local-name) (dom:local-name old-attr)))))) + +(defun add-default-attributes (element) + (let* ((dtd (dtd (slot-value element 'owner))) + (e (when dtd (cxml::find-element + (real-rod (dom:tag-name element)) + dtd)))) + (when e + (dolist (a (cxml::elmdef-attributes e)) + (when (and a + (listp (cxml::attdef-default a)) + (not (dom:get-attribute-node + element + (%rod (cxml::attdef-name a))))) + (let ((anode (add-default-attribute element a))) + (multiple-value-bind (prefix local-name) + (handler-case + (cxml::split-qname (cxml::attdef-name a)) + (cxml:well-formedness-violation (c) + (dom-error :NAMESPACE_ERR "~A" c))) + (when prefix (setf prefix (%rod prefix))) + (setf local-name (%rod local-name)) + ;; das ist fuer importnode07. + ;; so richtig ueberzeugend finde ich das ja nicht. + (setf (slot-value anode 'prefix) prefix) + (setf (slot-value anode 'local-name) local-name)))))))) + +(defun add-default-attribute (element adef) + (let* ((value (second (cxml::attdef-default adef))) + (owner (slot-value element 'owner)) + (anode (dom:create-attribute owner (cxml::attdef-name adef))) + (text (dom:create-text-node owner value))) + (setf (slot-value anode 'specified-p) nil) + (setf (slot-value anode 'owner-element) element) + (dom:append-child anode text) + (push anode (slot-value (dom:attributes element) 'items)) + anode)) + +(defmethod dom:remove-named-item ((self attribute-node-map) name) + name + (let ((k (call-next-method))) + (maybe-add-default-attribute (slot-value self 'element) k) + k)) + +(defmethod dom:remove-named-item-ns ((self attribute-node-map) uri lname) + uri lname + (let ((k (call-next-method))) + (maybe-add-default-attribute (slot-value self 'element) k) + k)) + +(defmethod dom:get-elements-by-tag-name ((element element) name) + (assert-writeable element) + (get-elements-by-tag-name-internal element name)) + +(defmethod dom:get-elements-by-tag-name-ns ((element element) uri lname) + (assert-writeable element) + (get-elements-by-tag-name-internal-ns element uri lname)) + +(defmethod dom:set-named-item :after ((self attribute-node-map) arg) + (setf (slot-value arg 'owner-element) + (slot-value self 'element))) + +(defmethod dom:set-named-item-ns :after ((self attribute-node-map) arg) + (setf (slot-value arg 'owner-element) + (slot-value self 'element))) + +(defmethod dom:normalize ((node node)) + (assert-writeable node) + (labels ((walk (n) + (when (eq (dom:node-type n) :element) + (map nil #'walk (dom:items (dom:attributes n)))) + (let ((children (dom:child-nodes n)) + (i 0) + (previous nil)) + ;; careful here, we're modifying the array we are iterating over + (cxml::while (< i (length children)) + (let ((child (elt children i))) + (cond + ((not (eq (dom:node-type child) :text)) + (setf previous nil) + (incf i)) + ((and previous (eq (dom:node-type previous) :text)) + (setf (slot-value previous 'value) + (concatenate 'rod + (dom:data previous) + (dom:data child))) + (dom:remove-child n child) + ;; not (incf i) + ) + ((zerop (length (dom:data child))) + (dom:remove-child n child) + ;; not (incf i) + ) + (t + (setf previous child) + (incf i)))))) + (map nil #'walk (dom:child-nodes n)))) + (walk node)) + (values)) + +;;; TEXT + +(defmethod dom:split-text ((text text) offset) + (assert-writeable text) + (with-slots (owner parent value) text + (unless (<= 0 offset (length value)) + (dom-error :INDEX_SIZE_ERR "offset is invalid")) + (prog1 + (dom:insert-before parent + (dom:create-text-node owner (subseq value offset)) + (dom:next-sibling text)) + (setf value (subseq value 0 offset))))) + +;;; COMMENT -- nix +;;; CDATA-SECTION -- nix + +;;; DOCUMENT-TYPE + +(defmethod dom:internal-subset ((node document-type)) + ;; FIXME: encoding ist falsch, anderen sink nehmen! + (if (and (slot-boundp node 'dom::%internal-subset) + ;; die damen und herren von der test suite sind wohl der meinung, + ;; dass ein leeres internal subset nicht vorhanden ist und + ;; wir daher nil liefern sollen. bittesehr! + (dom::%internal-subset node)) + (let ((sink + #+rune-is-character (cxml:make-string-sink) + #-rune-is-character (cxml:make-string-sink/utf8))) + (dolist (def (dom::%internal-subset node)) + (apply (car def) sink (cdr def))) + (sax:end-document sink)) + nil)) + +;;; NOTATION -- nix +;;; ENTITY -- nix + +;;; ENTITY-REFERENCE + +(defmethod initialize-instance :after ((instance entity-reference) &key) + (let* ((owner (dom:owner-document instance)) + (handler (make-dom-builder)) + (resolver (slot-value owner 'entity-resolver))) + (when resolver + (setf (document handler) owner) + (push instance (element-stack handler)) + #+cxml-system::utf8dom-file + (setf handler (cxml:make-recoder handler #'cxml:rod-to-utf8-string)) + (funcall resolver (real-rod (dom:name instance)) handler) + (flush-characters handler))) + (labels ((walk (n) + (setf (slot-value n 'read-only-p) t) + (when (dom:element-p n) + (setf (slot-value (dom:attributes n) 'read-only-p) t) + (map nil #'walk (dom:items (dom:attributes n)))) + (map nil #'walk (dom:child-nodes n)))) + (walk instance))) + +;;; PROCESSING-INSTRUCTION + +(defmethod (setf dom:data) (newval (self processing-instruction)) + (assert-writeable self) + (setf newval (%rod newval)) + (setf (slot-value self 'data) newval)) + +;; das koennte man auch mit einer GF machen +(defun can-adopt-p (parent child) + (member (dom:node-type child) + (let ((default '(:element :processing-instruction :comment :text + :cdata-section :entity-reference))) + (etypecase parent + (document + '(:element :processing-instruction :comment :document-type)) + (document-fragment default) + (document-type nil) + (entity-reference default) + (element default) + (attribute '(:text :entity-reference)) + (processing-instruction nil) + (comment nil) + (text nil) + (cdata-section nil) + (entity default) + (notation nil))))) + + +;;; predicates + +(defmethod dom:node-p ((object node)) t) +(defmethod dom:node-p ((object t)) nil) + +(defmethod dom:document-p ((object document)) t) +(defmethod dom:document-p ((object t)) nil) + +(defmethod dom:document-fragment-p ((object document-fragment)) t) +(defmethod dom:document-fragment-p ((object t)) nil) + +(defmethod dom:character-data-p ((object character-data)) t) +(defmethod dom:character-data-p ((object t)) nil) + +(defmethod dom:attribute-p ((object attribute)) t) +(defmethod dom:attribute-p ((object t)) nil) + +(defmethod dom:element-p ((object element)) t) +(defmethod dom:element-p ((object t)) nil) + +(defmethod dom:text-node-p ((object text)) t) +(defmethod dom:text-node-p ((object t)) nil) + +(defmethod dom:comment-p ((object comment)) t) +(defmethod dom:comment-p ((object t)) nil) + +(defmethod dom:cdata-section-p ((object cdata-section)) t) +(defmethod dom:cdata-section-p ((object t)) nil) + +(defmethod dom:document-type-p ((object document-type)) t) +(defmethod dom:document-type-p ((object t)) nil) + +(defmethod dom:notation-p ((object notation)) t) +(defmethod dom:notation-p ((object t)) nil) + +(defmethod dom:entity-p ((object entity)) t) +(defmethod dom:entity-p ((object t)) nil) + +(defmethod dom:entity-reference-p ((object entity-reference)) t) +(defmethod dom:entity-reference-p ((object t)) nil) + +(defmethod dom:processing-instruction-p ((object processing-instruction)) t) +(defmethod dom:processing-instruction-p ((object t)) nil) + +(defmethod dom:named-node-map-p ((object named-node-map)) t) +(defmethod dom:named-node-map-p ((object t)) nil) + + +;;; IMPORT-NODE + +(defvar *clone-not-import* nil) ;not beautiful, I know. See below. + +(defmethod import-node-internal (class document node deep &rest initargs) + (let ((result (apply #'make-instance class :owner document initargs))) + (when deep + (dovector (child (dom:child-nodes node)) + (dom:append-child result (dom:import-node document child t)))) + result)) + +(defmethod dom:import-node ((document document) (node t) deep) + (declare (ignore deep)) + (dom-error :NOT_SUPPORTED_ERR "not implemented")) + +(defmethod dom:import-node ((document document) (node attribute) deep) + (declare (ignore deep)) + (import-node-internal 'attribute + document node + t + :specified-p (dom:specified node) + :name (dom:name node) + :namespace-uri (dom:namespace-uri node) + :local-name (dom:local-name node) + :prefix (dom:prefix node) + :owner-element nil)) + +(defmethod dom:import-node ((document document) (node document-fragment) deep) + (import-node-internal 'document-fragment document node deep)) + +(defmethod dom:import-node ((document document) (node element) deep) + (let* ((attributes (make-instance 'attribute-node-map + :element-type :attribute + :owner document)) + (result (import-node-internal 'element document node deep + :attributes attributes + :namespace-uri (dom:namespace-uri node) + :local-name (dom:local-name node) + :prefix (dom:prefix node) + :tag-name (dom:tag-name node)))) + (setf (slot-value attributes 'element) result) + (dolist (attribute (dom:items (dom:attributes node))) + (when (or (dom:specified attribute) *clone-not-import*) + (let ((attr (dom:import-node document attribute t))) + (if (dom:namespace-uri attribute) + (dom:set-attribute-node-ns result attr) + (dom:set-attribute-node result attr))))) + (add-default-attributes result) + result)) + +(defmethod dom:import-node ((document document) (node entity) deep) + (import-node-internal 'entity document node deep + :name (dom:name node) + :public-id (dom:public-id node) + :system-id (dom:system-id node) + :notation-name (dom:notation-name node))) + +(defmethod dom:import-node ((document document) (node entity-reference) deep) + (declare (ignore deep)) + (import-node-internal 'entity-reference document node nil + :name (dom:name node))) + +(defmethod dom:import-node ((document document) (node notation) deep) + (import-node-internal 'notation document node deep + :name (dom:name node) + :public-id (dom:public-id node) + :system-id (dom:system-id node))) + +(defmethod dom:import-node + ((document document) (node processing-instruction) deep) + (import-node-internal 'processing-instruction document node deep + :target (dom:target node) + :data (dom:data node))) + +;; TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE +(defmethod dom:import-node + ((document document) (node character-data) deep) + (import-node-internal (class-of node) document node deep + :data (copy-seq (dom:data node)))) + +;;; CLONE-NODE +;;; +;;; As far as I can tell, cloneNode is the same as importNode, except +;;; for one difference involving element attributes: importNode imports +;;; only specified attributes, cloneNode copies even default values. +;;; +;;; Since I don't want to reimplement all of importNode here, we run +;;; importNode with a special flag... + +(defmethod dom:clone-node ((node node) deep) + (let ((*clone-not-import* t)) + (dom:import-node (dom:owner-document node) node deep))) + +;; extension: +(defmethod dom:clone-node ((node document) deep) + (let* ((document (make-instance 'document)) + (original-doctype (dom:doctype node)) + (doctype + (when original-doctype + (make-instance 'document-type + :owner document + :name (dom:name original-doctype) + :public-id (dom:public-id original-doctype) + :system-id (dom:system-id original-doctype) + :notations (make-instance 'named-node-map + :element-type :notation + :owner document + :items (dom:items (dom:notations original-doctype))) + :entities (make-instance 'named-node-map + :element-type :entity + :owner document + :items (dom:items + (dom:entities original-doctype))))))) + (setf (slot-value document 'owner) nil) + (setf (slot-value document 'doc-type) doctype) + (setf (slot-value document 'dtd) (dtd node)) + (setf (slot-value document 'entity-resolver) + (slot-value node 'entity-resolver)) + (setf (slot-value (dom:entities doctype) 'read-only-p) t) + (setf (slot-value (dom:notations doctype) 'read-only-p) t) + (when (and doctype (slot-boundp doctype 'dom::%internal-subset)) + (setf (dom::%internal-subset doctype) + (dom::%internal-subset original-doctype))) + (when (and (dom:document-element node) deep) + (let* ((*clone-not-import* t) + (clone (dom:import-node document (dom:document-element node) t))) + (dom:append-child document clone))) + document)) + + +;;; Erweiterung + +(defun create-document (&optional document-element) + ;; Um ein neues Dokumentenobject zu erzeugen, parsen wir einfach ein + ;; Dummydokument. + (let* ((handler (make-dom-builder)) + (cxml::*ctx* (cxml::make-context :handler handler)) + (result + (progn + (sax:start-document handler) + (sax:end-document handler)))) + (when document-element + (dom:append-child result (dom:import-node result document-element t))) + result)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-sax.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/dom-sax.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,95 @@ +;;;; dom-sax.lisp -- DOM walker +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Author: David Lichteblau <david@lichteblau.com> +;;;; Copyright (c) 2004 knowledgeTools Int. GmbH + +(in-package :cxml) + +(defun dom:map-document + (handler document + &key (include-xmlns-attributes sax:*include-xmlns-attributes*) + include-doctype + include-default-values + (recode (and #+rune-is-integer (typep document 'utf8-dom::node)))) + (declare (ignorable recode)) + #+rune-is-integer + (when recode + (setf handler (make-recoder handler #'utf8-string-to-rod))) + (sax:start-document handler) + (when include-doctype + (let ((doctype (dom:doctype document))) + (when doctype + (sax:start-dtd handler + (dom:name doctype) + (dom:public-id doctype) + (dom:system-id doctype)) + (ecase include-doctype + (:full-internal-subset + (when (slot-boundp doctype 'dom::%internal-subset) + (sax:start-internal-subset handler) + (dolist (def (dom::%internal-subset doctype)) + (apply (car def) handler (cdr def))) + (sax:end-internal-subset handler))) + (:canonical-notations + ;; need notations for canonical mode 2 + (let* ((ns (dom:notations doctype)) + (a (make-array (dom:length ns)))) + (when (plusp (dom:length ns)) + (sax:start-internal-subset handler) + ;; get them + (dotimes (k (dom:length ns)) + (setf (elt a k) (dom:item ns k))) + ;; sort them + (setf a (sort a #'rod< :key #'dom:name)) + (loop for n across a do + (sax:notation-declaration handler + (dom:name n) + (dom:public-id n) + (dom:system-id n))) + (sax:end-internal-subset handler))))) + (sax:end-dtd handler)))) + (labels ((walk (node) + (dom:do-node-list (child (dom:child-nodes node)) + (ecase (dom:node-type child) + (:element + (let ((attlist + (compute-attributes child + include-xmlns-attributes + include-default-values)) + (uri (dom:namespace-uri child)) + (lname (dom:local-name child)) + (qname (dom:tag-name child))) + (sax:start-element handler uri lname qname attlist) + (walk child) + (sax:end-element handler uri lname qname))) + (:cdata-section + (sax:start-cdata handler) + (sax:characters handler (dom:data child)) + (sax:end-cdata handler)) + (:text + (sax:characters handler (dom:data child))) + (:comment + (sax:comment handler (dom:data child))) + (:processing-instruction + (sax:processing-instruction handler + (dom:target child) + (dom:data child))))))) + (walk document)) + (sax:end-document handler)) + +(defun compute-attributes (element xmlnsp defaultp) + (let ((results '())) + (dom:do-node-list (a (dom:attributes element)) + (when (and (or defaultp (dom:specified a)) + (or xmlnsp (not (cxml::xmlns-attr-p (rod (dom:name a)))))) + (push + (sax:make-attribute :qname (dom:name a) + :value (dom:value a) + :local-name (dom:local-name a) + :namespace-uri (dom:namespace-uri a) + :specified-p (dom:specified a)) + results))) + (reverse results))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/package.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/dom/package.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,161 @@ +;;;; package.lisp -- Paketdefinition +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. + +(in-package :cl-user) + +(defpackage :dom + (:use) + (:export + ;; DOM 2 functions + #:owner-element + #:import-node + #:create-element-ns + #:create-attribute-ns + #:get-elements-by-tag-name-ns + #:get-element-by-id + #:get-named-item-ns + #:set-named-item-ns + #:remove-named-item-ns + #:is-supported + #:has-attributes + #:namespace-uri + #:prefix + #:local-name + #:internal-subset + #:create-document-type + #:create-document + #:get-attribute-ns + #:set-attribute-ns + #:remove-attribute-ns + #:get-attribute-node-ns + #:set-attribute-node-ns + #:has-attribute + #:has-attribute-ns + + ;; DOM 1 functions + #:has-feature + #:doctype + #:implementation + #:document-element + #:create-element + #:create-document-fragment + #:create-text-node + #:create-comment + #:create-cdata-section + #:create-processing-instruction + #:create-attribute + #:create-entity-reference + #:get-elements-by-tag-name + #:node-name + #:node-value + #:node-type + #:parent-node + #:child-nodes + #:first-child + #:last-child + #:previous-sibling + #:next-sibling + #:attributes + #:owner-document + #:insert-before + #:replace-child + #:remove-child + #:append-child + #:has-child-nodes + #:clone-node + #:item + #:length + #:get-named-item + #:set-named-item + #:remove-named-item + #:data + #:substring-data + #:append-data + #:insert-data + #:delete-data + #:replace-data + #:name + #:specified + #:value + #:tag-name + #:get-attribute + #:set-attribute + #:remove-attribute + #:get-attribute-node + #:set-attribute-node + #:remove-attribute-node + #:normalize + #:split-text + #:entities + #:notations + #:public-id + #:system-id + #:notation-name + #:target + #:code + + ;; IDL interfaces, exported "inofficially" + #:node + #:document + #:document-fragment + #:character-data + #:attr + #:element + #:text + #:comment + #:cdata-section + #:document-type + #:notation + #:entity + #:entity-reference + #:processing-instruction + #:named-node-map + ;; no classes: +;;; #:dom-implementation +;;; #:node-list + + ;; + #:items + + ;; + #:node-p + #:document-p + #:document-fragment-p + #:character-data-p + #:attribute-p + #:element-p + #:text-node-p + #:comment-p + #:cdata-section-p + #:document-type-p + #:notation-p + #:entity-p + #:entity-reference-p + #:processing-instruction-p + #:named-node-map-p + + #:map-node-list + #:do-node-list + #:map-node-map + #:do-node-map + #:create-document + #:map-document)) + +(defclass dom:node () ()) +(defclass dom:document (dom:node) ()) +(defclass dom:document-fragment (dom:node) ()) +(defclass dom:character-data (dom:node) ()) +(defclass dom:attr (dom:node) ()) +(defclass dom:element (dom:node) ()) +(defclass dom:text (dom:character-data) ()) +(defclass dom:comment (dom:character-data) ()) +(defclass dom:cdata-section (dom:text) ()) +(defclass dom:document-type (dom:node) ()) +(defclass dom:notation (dom:node) ()) +(defclass dom:entity (dom:node) ()) +(defclass dom:entity-reference (dom:node) ()) +(defclass dom:processing-instruction (dom:node) ()) + +(defclass dom:named-node-map () ()) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/klacks-impl.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/klacks-impl.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,528 @@ +;;; -*- Mode: Lisp; readtable: runes; -*- +;;; (c) copyright 2007 David Lichteblau + +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Library General Public +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +(in-package :cxml) + +(defclass cxml-source (klacks:source) + (;; args to make-source + (context :initarg :context) + (validate :initarg :validate) + (root :initarg :root) + (dtd :initarg :dtd) + (error-culprit :initarg :error-culprit) + ;; current state + (continuation) + (current-key :initform nil) + (current-values) + (current-attributes) + (cdata-section-p :reader klacks:current-cdata-section-p) + ;; extra WITH-SOURCE magic + (data-behaviour :initform :DTD) + (namespace-stack :initform (list *initial-namespace-bindings*)) + (current-namespace-declarations) + (temporary-streams :initform nil) + (scratch-pad :initarg :scratch-pad) + (scratch-pad-2 :initarg :scratch-pad-2) + (scratch-pad-3 :initarg :scratch-pad-3) + (scratch-pad-4 :initarg :scratch-pad-4))) + +(defmethod klacks:close-source ((source cxml-source)) + (dolist (xstream (slot-value source 'temporary-streams)) + ;; fixme: error handling? + (close-xstream xstream))) + +(defmacro with-source ((source &rest slots) &body body) + (let ((s (gensym))) + `(let* ((,s ,source) + (*ctx* (slot-value ,s 'context)) + (*validate* (slot-value ,s 'validate)) + (*data-behaviour* (slot-value source 'data-behaviour)) + (*namespace-bindings* (car (slot-value source 'namespace-stack))) + (*scratch-pad* (slot-value source 'scratch-pad)) + (*scratch-pad-2* (slot-value source 'scratch-pad-2)) + (*scratch-pad-3* (slot-value source 'scratch-pad-3)) + (*scratch-pad-4* (slot-value source 'scratch-pad-4))) + (handler-case + (with-slots (,@slots) ,s + ,@body) + (runes-encoding:encoding-error (c) + (wf-error (slot-value ,s 'error-culprit) "~A" c)))))) + +(defun fill-source (source) + (with-slots (current-key current-values continuation) source + (unless current-key + (setf current-key :bogus) + (setf continuation (funcall continuation)) + (assert (not (eq current-key :bogus)))))) + +(defmethod klacks:peek ((source cxml-source)) + (with-source (source current-key current-values) + (fill-source source) + (apply #'values current-key current-values))) + +(defmethod klacks:peek-value ((source cxml-source)) + (with-source (source current-key current-values) + (fill-source source) + (apply #'values current-values))) + +(defmethod klacks:peek-next ((source cxml-source)) + (with-source (source current-key current-values) + (setf current-key nil) + (fill-source source) + (apply #'values current-key current-values))) + +(defmethod klacks:consume ((source cxml-source)) + (with-source (source current-key current-values) + (fill-source source) + (multiple-value-prog1 + (apply #'values current-key current-values) + (setf current-key nil)))) + +(defmethod klacks:map-attributes (fn (source cxml-source)) + (dolist (a (slot-value source 'current-attributes)) + (funcall fn + (sax:attribute-namespace-uri a) + (sax:attribute-local-name a) + (sax:attribute-qname a) + (sax:attribute-value a) + (sax:attribute-specified-p a)))) + +(defmethod klacks:get-attribute + ((source cxml-source) lname &optional uri) + (dolist (a (slot-value source 'current-attributes)) + (when (and (equal (sax:attribute-local-name a) lname) + (equal (sax:attribute-namespace-uri a) uri)) + (return (sax:attribute-value a))))) + +(defmethod klacks:list-attributes ((source cxml-source)) + (slot-value source 'current-attributes)) + +(defun make-source + (input &rest args + &key validate dtd root entity-resolver disallow-internal-subset + (buffering t) pathname) + (declare (ignore validate dtd root entity-resolver disallow-internal-subset)) + (etypecase input + (xstream + (when (and (not buffering) (< 1 (runes::xstream-speed input))) + (warn "make-source called with !buffering, but xstream is buffering")) + (let ((*ctx* nil)) + (let ((zstream (make-zstream :input-stack (list input)))) + (peek-rune input) + (with-scratch-pads () + (apply #'%make-source + zstream + (loop + for (name value) on args by #'cddr + unless (member name '(:pathname :buffering)) + append (list name value))))))) + (stream + (let ((xstream (make-xstream input :speed (if buffering 8192 1)))) + (setf (xstream-name xstream) + (make-stream-name + :entity-name "main document" + :entity-kind :main + :uri (safe-stream-sysid input))) + (apply #'make-source xstream args))) + (pathname + (let* ((xstream + (make-xstream (open input :element-type '(unsigned-byte 8)) + :speed (if buffering 8192 1)))) + (setf (xstream-name xstream) + (make-stream-name + :entity-name "main document" + :entity-kind :main + :uri (pathname-to-uri (merge-pathnames input)))) + (let ((source (apply #'make-source + xstream + :pathname input + args))) + (push xstream (slot-value source 'temporary-streams)) + source))) + (rod + (let ((xstream (string->xstream input))) + (setf (xstream-name xstream) + (make-stream-name + :entity-name "main document" + :entity-kind :main + :uri nil)) + (apply #'make-source xstream args))) + (array + (make-source (cxml::make-octet-input-stream input))))) + +(defun %make-source + (input &key validate dtd root entity-resolver disallow-internal-subset + error-culprit) + ;; check types of user-supplied arguments for better error messages: + (check-type validate boolean) + (check-type dtd (or null extid)) + (check-type root (or null rod)) + (check-type entity-resolver (or null function symbol)) + (check-type disallow-internal-subset boolean) + (let* ((xstream (car (zstream-input-stack input))) + (name (xstream-name xstream)) + (base (when name (stream-name-uri name))) + (context + (make-context :main-zstream input + :entity-resolver entity-resolver + :base-stack (list (or base "")) + :disallow-internal-subset disallow-internal-subset)) + (source + (make-instance 'cxml-source + :context context + :validate validate + :dtd dtd + :root root + :error-culprit error-culprit + :scratch-pad *scratch-pad* + :scratch-pad-2 *scratch-pad-2* + :scratch-pad-3 *scratch-pad-3* + :scratch-pad-4 *scratch-pad-4*))) + (setf (handler context) (make-instance 'klacks-dtd-handler :source source)) + (setf (slot-value source 'continuation) + (lambda () (klacks/xmldecl source input))) + source)) + +(defun klacks/xmldecl (source input) + (with-source (source current-key current-values) + (let ((hd (p/xmldecl input))) + (setf current-key :start-document) + (setf current-values + (when hd + (list (xml-header-version hd) + (xml-header-encoding hd) + (xml-header-standalone-p hd)))) + (lambda () + (klacks/misc*-2 source input + (lambda () + (klacks/doctype source input))))))) + +(defun klacks/misc*-2 (source input successor) + (with-source (source current-key current-values) + (multiple-value-bind (cat sem) (peek-token input) + (case cat + (:COMMENT + (setf current-key :comment) + (setf current-values (list sem)) + (consume-token input) + (lambda () (klacks/misc*-2 source input successor))) + (:PI + (setf current-key :processing-instruction) + (setf current-values (list (car sem) (cdr sem))) + (consume-token input) + (lambda () (klacks/misc*-2 source input successor))) + (:S + (consume-token input) + (klacks/misc*-2 source input successor)) + (t + (funcall successor)))))) + +(defun klacks/doctype (source input) + (with-source (source current-key current-values validate dtd) + (let ((cont (lambda () (klacks/finish-doctype source input))) + l) + (prog1 + (cond + ((eq (peek-token input) :<!DOCTYPE) + (setf l (cdr (p/doctype-decl input dtd))) + (lambda () (klacks/misc*-2 source input cont))) + (dtd + (setf l (cdr (synthesize-doctype dtd input))) + cont) + ((and validate (not dtd)) + (validity-error "invalid document: no doctype")) + (t + (return-from klacks/doctype + (funcall cont)))) + (destructuring-bind (&optional name extid) l + (setf current-key :dtd) + (setf current-values + (list name + (and extid (extid-public extid)) + (and extid (extid-system extid))))))))) + +(defun klacks/finish-doctype (source input) + (with-source (source current-key current-values root data-behaviour) + (ensure-dtd) + (when root + (setf (model-stack *ctx*) (list (make-root-model root)))) + (setf data-behaviour :DOC) + (setf *data-behaviour* :DOC) + (fix-seen-< input) + (let* ((final + (lambda () + (klacks/eof source input))) + (next + (lambda () + (setf data-behaviour :DTD) + (setf *data-behaviour* :DTD) + (klacks/misc*-2 source input final)))) + (klacks/element source input next)))) + +(defun klacks/eof (source input) + (with-source (source current-key current-values) + (p/eof input) + (klacks:close-source source) + (setf current-key :end-document) + (setf current-values nil) + (lambda () (klacks/nil source)))) + +(defun klacks/nil (source) + (with-source (source current-key current-values) + (setf current-key nil) + (setf current-values nil) + (labels ((klacks/done () + (setf current-key nil) + (setf current-values nil) + #'klacks/done)) + #'klacks/done))) + +(defun klacks/element (source input cont) + (with-source (source current-key current-values current-attributes + current-namespace-declarations) + (multiple-value-bind (cat n-b new-b uri lname qname attrs) (p/sztag input) + (setf current-key :start-element) + (setf current-values (list uri lname qname)) + (setf current-attributes attrs) + (setf current-namespace-declarations new-b) + (if (eq cat :stag) + (lambda () + (klacks/element-2 source input n-b cont)) + (lambda () + (klacks/ztag source cont)))))) + +(defun klacks/ztag (source cont) + (with-source (source current-key current-values current-attributes) + (setf current-key :end-element) + (setf current-attributes nil) + (validate-end-element *ctx* (third current-values)) + cont)) + +(defun klacks/element-2 (source input n-b cont) + (with-source (source + current-key current-values current-attributes namespace-stack + current-namespace-declarations) + (let ((values* current-values) + (new-b current-namespace-declarations)) + (setf current-attributes nil) + (push n-b namespace-stack) + (let ((finish + (lambda () + (setf current-namespace-declarations new-b) + (klacks/element-3 source input values* cont)))) + (klacks/content source input finish))))) + +(defun klacks/element-3 (source input tag-values cont) + (with-source (source current-key current-values current-attributes) + (setf current-key :end-element) + (setf current-values tag-values) + (let ((qname (third tag-values))) + (p/etag input qname) + (validate-end-element *ctx* qname)) + cont)) + +(defun klacks/content (source input cont) + (with-source (source current-key current-values cdata-section-p) + (let ((recurse (lambda () (klacks/content source input cont)))) + (multiple-value-bind (cat sem) (peek-token input) + (case cat + ((:stag :ztag) + (klacks/element source input recurse)) + ((:CDATA) + (process-characters input sem) + (setf current-key :characters) + (setf current-values (list sem)) + (setf cdata-section-p nil) + recurse) + ((:ENTITY-REF) + (let ((name sem)) + (consume-token input) + (klacks/entity-reference source input name recurse))) + ((:<!\[) + (setf current-key :characters) + (setf current-values (list (process-cdata-section input))) + (setf cdata-section-p t) + recurse) + ((:PI) + (setf current-key :processing-instruction) + (setf current-values (list (car sem) (cdr sem))) + (consume-token input) + recurse) + ((:COMMENT) + (setf current-key :comment) + (setf current-values (list sem)) + (consume-token input) + recurse) + (otherwise + (funcall cont))))))) + +(defun klacks/entity-reference (source zstream name cont) + (assert (not (zstream-token-category zstream))) + (with-source (source temporary-streams context) + (let ((new-xstream (entity->xstream zstream name :general nil))) + (push new-xstream temporary-streams) + (push :stop (zstream-input-stack zstream)) + (zstream-push new-xstream zstream) + (push (stream-name-uri (xstream-name new-xstream)) (base-stack context)) + (let ((next + (lambda () + (klacks/entity-reference-2 source zstream new-xstream cont)))) + (etypecase (checked-get-entdef name :general) + (internal-entdef + (klacks/content source zstream next)) + (external-entdef + (klacks/ext-parsed-ent source zstream next))))))) + +(defun klacks/entity-reference-2 (source zstream new-xstream cont) + (with-source (source temporary-streams context) + (unless (eq (peek-token zstream) :eof) + (wf-error zstream "Trailing garbage. - ~S" (peek-token zstream))) + (assert (eq (peek-token zstream) :eof)) + (assert (eq (pop (zstream-input-stack zstream)) new-xstream)) + (assert (eq (pop (zstream-input-stack zstream)) :stop)) + (pop (base-stack context)) + (setf (zstream-token-category zstream) nil) + (setf temporary-streams (remove new-xstream temporary-streams)) + (close-xstream new-xstream) + (funcall cont))) + +(defun klacks/ext-parsed-ent (source input cont) + (with-source (source) + (when (eq (peek-token input) :xml-decl) + (let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input)))))) + (setup-encoding input hd)) + (consume-token input)) + (set-full-speed input) + (klacks/content source input cont))) + + +;;;; terrible kludges + +(defclass klacks-dtd-handler (sax:default-handler) + ((handler-source :initarg :source :reader handler-source) + (internal-subset-p :initform nil :accessor handler-internal-subset-p))) + +(defmethod sax:start-internal-subset ((handler klacks-dtd-handler)) + (setf (slot-value (handler-source handler) 'internal-declarations) '()) + (setf (handler-internal-subset-p handler) t)) + +(defmethod sax:end-internal-subset ((handler klacks-dtd-handler)) + (setf (handler-internal-subset-p handler) nil)) + +(defmethod sax:entity-resolver ((handler klacks-dtd-handler) fn) + (setf (slot-value (handler-source handler) 'dom-impl-entity-resolver) fn)) + +(defmethod sax::dtd ((handler klacks-dtd-handler) dtd) + (setf (slot-value (handler-source handler) 'dom-impl-dtd) dtd)) + +(defmethod sax:end-dtd ((handler klacks-dtd-handler)) + (let ((source (handler-source handler))) + (when (slot-boundp source 'internal-declarations) + (setf (slot-value source 'internal-declarations) + (reverse (slot-value source 'internal-declarations))) + (setf (slot-value source 'external-declarations) + (reverse (slot-value source 'external-declarations)))))) + +(macrolet + ((defhandler (name &rest args) + `(defmethod ,name ((handler klacks-dtd-handler) ,@args) + (let ((source (handler-source handler)) + (spec (list ',name ,@args))) + (if (handler-internal-subset-p handler) + (push spec (slot-value source 'internal-declarations)) + (push spec (slot-value source 'external-declarations))))))) + (defhandler sax:unparsed-entity-declaration + name public-id system-id notation-name) + (defhandler sax:external-entity-declaration + kind name public-id system-id) + (defhandler sax:internal-entity-declaration + kind name value) + (defhandler sax:notation-declaration + name public-id system-id) + (defhandler sax:element-declaration + name model) + (defhandler sax:attribute-declaration + element-name attribute-name type default)) + + +;;;; locator + +(defun source-xstream (source) + (car (zstream-input-stack (main-zstream (slot-value source 'context))))) + +(defun source-stream-name (source) + (let ((xstream (source-xstream source))) + (if xstream + (xstream-name xstream) + nil))) + +(defmethod klacks:current-line-number ((source cxml-source)) + (let ((x (source-xstream source))) + (if x + (xstream-line-number x) + nil))) + +(defmethod klacks:current-column-number ((source cxml-source)) + (let ((x (source-xstream source))) + (if x + (xstream-column-number x) + nil))) + +(defmethod klacks:current-system-id ((source cxml-source)) + (let ((name (source-stream-name source))) + (if name + (stream-name-uri name) + nil))) + +(defmethod klacks:current-xml-base ((source cxml-source)) + (car (base-stack (slot-value source 'context)))) + +(defmethod klacks:map-current-namespace-declarations (fn (source cxml-source)) + (loop + for (prefix . uri) in (slot-value source 'current-namespace-declarations) + do + (funcall fn prefix uri))) + +(defmethod klacks:find-namespace-binding (prefix (source cxml-source)) + (with-source (source) + (find-namespace-binding prefix))) + +(defmethod klacks:decode-qname (qname (source cxml-source)) + (with-source (source) + (multiple-value-bind (prefix local-name) (split-qname qname) + (values (and prefix (find-namespace-binding prefix)) + local-name + prefix)))) + + +;;;; debugging + +#+(or) +(trace CXML::KLACKS/DOCTYPE + CXML::KLACKS/EXT-PARSED-ENT + CXML::KLACKS/MISC*-2 + CXML::KLACKS/ENTITY-REFERENCE + CXML::KLACKS/ENTITY-REFERENCE-2 + CXML::KLACKS/ELEMENT + CXML::KLACKS/ZTAG + CXML::KLACKS/XMLDECL + CXML::KLACKS/FINISH-DOCTYPE + CXML::KLACKS/ELEMENT-3 + CXML::KLACKS/EOF + CXML::KLACKS/ELEMENT-2 + CXML::KLACKS/CONTENT ) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/klacks.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/klacks.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,259 @@ +;;; -*- Mode: Lisp; readtable: runes; -*- +;;; (c) copyright 2007 David Lichteblau + +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Library General Public +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +(in-package :cxml) + +(defclass klacks:source () + ( + ;; fixme, terrible DTD kludges + (internal-declarations) + (external-declarations :initform nil) + (dom-impl-dtd :initform nil) + (dom-impl-entity-resolver :initform nil))) + +(defgeneric klacks:close-source (source)) + +(defgeneric klacks:peek (source)) +(defgeneric klacks:peek-value (source)) +(defgeneric klacks:consume (source)) + +(defgeneric klacks:map-attributes (fn source)) +(defgeneric klacks:list-attributes (source)) +(defgeneric klacks:get-attribute (source lname &optional uri)) +;;;(defgeneric klacks:current-uri (source)) +;;;(defgeneric klacks:current-lname (source)) +;;;(defgeneric klacks:current-qname (source)) +;;;(defgeneric klacks:current-characters (source)) +(defgeneric klacks:current-cdata-section-p (source)) +(defgeneric klacks:map-current-namespace-declarations (fn source)) + +(defgeneric klacks:current-line-number (source)) +(defgeneric klacks:current-column-number (source)) +(defgeneric klacks:current-system-id (source)) +(defgeneric klacks:current-xml-base (source)) + +(defgeneric klacks:find-namespace-binding (prefix source)) +(defgeneric klacks:decode-qname (qname source)) + +(defmacro klacks:with-open-source ((var source) &body body) + `(let ((,var ,source)) + (unwind-protect + (progn ,@body) + (klacks:close-source ,var)))) + +(defun klacks:current-uri (source) + (multiple-value-bind (key uri lname qname) (klacks:peek source) + (declare (ignore lname qname)) + (check-type key (member :start-element :end-element)) + uri)) + +(defun klacks:current-lname (source) + (multiple-value-bind (key uri lname qname) (klacks:peek source) + (declare (ignore uri qname)) + (check-type key (member :start-element :end-element)) + lname)) + +(defun klacks:current-qname (source) + (multiple-value-bind (key uri lname qname) (klacks:peek source) + (declare (ignore uri lname)) + (check-type key (member :start-element :end-element)) + qname)) + +(defun klacks:current-characters (source) + (multiple-value-bind (key characters) (klacks:peek source) + (check-type key (member :characters)) + characters)) + +(defun klacks:consume-characters (source) + (with-output-to-string (s) + (while (eq (klacks:peek source) :characters) + (write-string (klacks:current-characters source) s) + (klacks:consume source)))) + +(defun klacks:serialize-event (source handler &key (consume t)) + (multiple-value-bind (key a b c) (klacks:peek source) + (let ((result nil)) + (case key + (:start-document + (sax:start-document handler) + (loop for (prefix . uri) in *initial-namespace-bindings* do + (sax:start-prefix-mapping handler prefix uri))) + (:characters + (cond + ((klacks:current-cdata-section-p source) + (sax:start-cdata handler) + (sax:characters handler a) + (sax:end-cdata handler)) + (T + (sax:characters handler a)))) + (:processing-instruction + (sax:processing-instruction handler a b)) + (:comment + (sax:comment handler a)) + (:dtd + (sax:start-dtd handler a b c) + (when (slot-boundp source 'internal-declarations) + (sax:start-internal-subset handler) + (serialize-declaration-kludge + (slot-value source 'internal-declarations) + handler) + (sax:end-internal-subset handler)) + (serialize-declaration-kludge + (slot-value source 'external-declarations) + handler) + (sax:end-dtd handler) + (sax:entity-resolver handler + (slot-value source 'dom-impl-entity-resolver)) + (sax::dtd handler (slot-value source 'dom-impl-dtd))) + (:start-element + (klacks:map-current-namespace-declarations + (lambda (prefix uri) + (sax:start-prefix-mapping handler prefix uri)) + source) + (sax:start-element handler a b c (klacks:list-attributes source))) + (:end-element + (sax:end-element handler a b c) + (klacks:map-current-namespace-declarations + (lambda (prefix uri) + (declare (ignore uri)) + (sax:end-prefix-mapping handler prefix)) + source)) + (:end-document + (loop for (prefix . nil) in *initial-namespace-bindings* do + (sax:end-prefix-mapping handler prefix)) + (setf result (sax:end-document handler))) + ((nil) + (error "serialize-event read past end of document")) + (t + (error "unexpected klacks key: ~A" key))) + (when consume + (klacks:consume source)) + result))) + +(defun serialize-declaration-kludge (list handler) + (loop + for (fn . args) in list + do (apply fn handler args))) + +(defun klacks:serialize-source (source handler) + (loop + (let ((document (klacks:serialize-event source handler))) + (when document + (return document))))) + +(defclass klacksax (sax:sax-parser) + ((source :initarg :source))) + +(defmethod sax:line-number ((parser klacksax)) + (klacks:current-line-number (slot-value parser 'source))) + +(defmethod sax:column-number ((parser klacksax)) + (klacks:current-column-number (slot-value parser 'source))) + +(defmethod sax:system-id ((parser klacksax)) + (klacks:current-system-id (slot-value parser 'source))) + +(defmethod sax:xml-base ((parser klacksax)) + (klacks:current-xml-base (slot-value parser 'source))) + +(defun klacks:serialize-element (source handler &key (document-events t)) + (unless (eq (klacks:peek source) :start-element) + (error "not at start of element")) + (sax:register-sax-parser handler (make-instance 'klacksax :source source)) + (when document-events + (sax:start-document handler)) + (labels ((recurse () + (klacks:serialize-event source handler) + (loop + (let ((key (klacks:peek source))) + (ecase key + (:start-element (recurse)) + (:end-element (return)) + ((:characters :comment :processing-instruction) + (klacks:serialize-event source handler))))) + (klacks:serialize-event source handler))) + (recurse)) + (when document-events + (sax:end-document handler))) + +(defun klacks:find-element (source &optional lname uri) + (loop + (multiple-value-bind (key current-uri current-lname current-qname) + (klacks:peek source) + (case key + ((nil) + (return nil)) + (:start-element + (when (and (eq key :start-element) + (or (null lname) + (equal lname (klacks:current-lname source))) + (or (null uri) + (equal uri (klacks:current-uri source)))) + (return + (values key current-uri current-lname current-qname))))) + (klacks:consume source)))) + +(defun klacks:find-event (source key) + (loop + (multiple-value-bind (this a b c) + (klacks:peek source) + (cond + ((null this) + (return nil)) + ((eq this key) + (return (values this a b c)))) + (klacks:consume source)))) + +(define-condition klacks-error (xml-parse-error) ()) + +(defun klacks-error (fmt &rest args) + (%error 'klacks-error + nil + (format nil "Klacks assertion failed: ~?" fmt args))) + +(defun klacks:expect (source key &optional u v w) + (multiple-value-bind (this a b c) + (klacks:peek source) + (unless (eq this key) (klacks-error "expected ~A but got ~A" key this)) + (when (and u (not (equal a u))) + (klacks-error "expected ~A but got ~A" u a)) + (when (and v (not (equal b v))) + (klacks-error "expected ~A but got ~A" v b)) + (when (and w (not (equal c w))) + (klacks-error "expected ~A but got ~A" w c)) + (values this a b c))) + +(defun klacks:skip (source key &optional a b c) + (klacks:expect source key a b c) + (klacks:consume source)) + +(defun invoke-expecting-element (fn source &optional lname uri) + (multiple-value-bind (key a b) + (klacks:peek source) + (unless (eq key :start-element) + (klacks-error "expected ~A but got ~A" (or lname "element") key)) + (when (and uri (not (equal a uri))) + (klacks-error "expected ~A but got ~A" uri a)) + (when (and lname (not (equal b lname))) + (klacks-error "expected ~A but got ~A" lname b)) + (multiple-value-prog1 + (funcall fn) + (klacks:skip source :end-element a b)))) + +(defmacro klacks:expecting-element ((source &optional lname uri) &body body) + `(invoke-expecting-element (lambda () ,@body) ,source ,lname ,uri)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/package.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/package.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,63 @@ +;;; -*- Mode: Lisp; readtable: runes; -*- +;;; (c) copyright 2007 David Lichteblau + +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Library General Public +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +(defpackage klacks + (:use) + (:export #:source + #:close-source + #:with-open-source + + #:tapping-source + #:make-tapping-source + #:dribble-handler + + #:peek + #:peek-value + #:peek-next + #:consume + + #:expect + #:skip + #:find-element + #:find-event + #:expecting-element + + #:map-attributes + #:list-attributes + #:get-attribute + #:current-uri + #:current-lname + #:current-qname + #:current-characters + #:consume-characters + #:current-cdata-section-p + #:map-current-namespace-declarations + + #:serialize-event + #:serialize-element + #:serialize-source + + #:klacks-error + + #:current-line-number + #:current-column-number + #:current-system-id + #:current-xml-base + + #:find-namespace-binding + #:decode-qname)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/tap-source.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/klacks/tap-source.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,106 @@ +;;; -*- Mode: Lisp; readtable: runes; -*- +;;; (c) copyright 2007 David Lichteblau + +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Library General Public +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +(in-package :cxml) + +(defun klacks:make-tapping-source (upstream-source &optional sax-handler) + (make-instance 'klacks:tapping-source + :upstream-source upstream-source + :dribble-handler sax-handler)) + +(defclass klacks:tapping-source (klacks:source) + ((upstream-source :initarg :upstream-source :accessor upstream-source) + (dribble-handler :initarg :dribble-handler :accessor dribble-handler) + (seen-event-p :initform nil :accessor seen-event-p) + (document-done-p :initform nil :accessor document-done-p))) + +(defmethod initialize-instance :after ((instance klacks:tapping-source) &key) + (let ((s-p (make-instance 'klacksax :source (upstream-source instance)))) + (sax:register-sax-parser (dribble-handler instance) s-p))) + + +;;; event dribbling + +(defun maybe-dribble (source) + (unless (or (seen-event-p source) (document-done-p source)) + (when (eq (klacks:peek (upstream-source source)) :end-document) + (setf (document-done-p source) t)) + (klacks:serialize-event (upstream-source source) + (dribble-handler source) + :consume nil) + (setf (seen-event-p source) t))) + +(defmethod klacks:peek ((source klacks:tapping-source)) + (multiple-value-prog1 + (klacks:peek (upstream-source source)) + (maybe-dribble source))) + +(defmethod klacks:peek-value ((source klacks:tapping-source)) + (multiple-value-prog1 + (klacks:peek-value (upstream-source source)) + (maybe-dribble source))) + +(defmethod klacks:peek-next ((source klacks:tapping-source)) + (setf (seen-event-p source) nil) + (multiple-value-prog1 + (klacks:peek-next (upstream-source source)) + (maybe-dribble source))) + +(defmethod klacks:consume ((source klacks:tapping-source)) + (maybe-dribble source) + (multiple-value-prog1 + (klacks:consume (upstream-source source)) + (setf (seen-event-p source) nil))) + + +;;; loop through + +(defmethod klacks:close-source ((source klacks:tapping-source)) + (klacks:close-source (upstream-source source))) + +(defmethod klacks:map-attributes (fn (source klacks:tapping-source)) + (klacks:map-attributes fn (upstream-source source))) + +(defmethod klacks:map-current-namespace-declarations + (fn (source klacks:tapping-source)) + (klacks:map-current-namespace-declarations fn (upstream-source source))) + +(defmethod klacks:list-attributes ((source klacks:tapping-source)) + (klacks:list-attributes (upstream-source source))) + +(defmethod klacks:current-line-number ((source klacks:tapping-source)) + (klacks:current-line-number (upstream-source source))) + +(defmethod klacks:current-column-number ((source klacks:tapping-source)) + (klacks:current-column-number (upstream-source source))) + +(defmethod klacks:current-system-id ((source klacks:tapping-source)) + (klacks:current-system-id (upstream-source source))) + +(defmethod klacks:current-xml-base ((source klacks:tapping-source)) + (klacks:current-xml-base (upstream-source source))) + +(defmethod klacks:current-cdata-section-p ((source klacks:tapping-source)) + (klacks:current-cdata-section-p (upstream-source source))) + +(defmethod klacks:find-namespace-binding + (prefix (source klacks:tapping-source)) + (klacks:find-namespace-binding prefix (upstream-source source))) + +(defmethod klacks:decode-qname (qname (source klacks:tapping-source)) + (klacks:decode-qname qname (upstream-source source))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/mlisp-patch.diff ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/mlisp-patch.diff Sun Feb 17 09:26:33 2008 @@ -0,0 +1,68 @@ +--- xml/xml-parse.lisp ++++ xml/xml-parse.lisp +@@ -2497,20 +2497,20 @@ + (let ((input-var (gensym)) + (collect (gensym)) + (c (gensym))) +- `(LET ((,input-var ,input)) +- (MULTIPLE-VALUE-BIND (,res ,res-start ,res-end) +- (WITH-RUNE-COLLECTOR/RAW (,collect) +- (LOOP +- (LET ((,c (PEEK-RUNE ,input-var))) +- (COND ((EQ ,c :EOF) ++ `(let ((,input-var ,input)) ++ (multiple-value-bind (,res ,res-start ,res-end) ++ (with-rune-collector/raw (,collect) ++ (loop ++ (let ((,c (peek-rune ,input-var))) ++ (cond ((eq ,c :eof) + ;; xxx error message +- (RETURN)) +- ((FUNCALL ,predicate ,c) +- (RETURN)) ++ (return)) ++ ((funcall ,predicate ,c) ++ (return)) + (t + (,collect ,c) +- (CONSUME-RUNE ,input-var)))))) +- (LOCALLY ++ (consume-rune ,input-var)))))) ++ (locally + ,@body))))) + + (defun read-name-token (input) + + + +Index: xml/xml-name-rune-p.lisp +=================================================================== +RCS file: /project/cxml/cvsroot/cxml/xml/xml-name-rune-p.lisp,v +retrieving revision 1.2 +diff -r1.2 xml-name-rune-p.lisp +214,225c214,225 +< (DEFINLINE NAME-RUNE-P (RUNE) +< (SETF RUNE (RUNE-CODE RUNE)) +< (AND (<= 0 RUNE ,*max*) +< (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3))) +< (= 1 (SBIT ',(predicate-to-bv #'name-rune-p) +< (THE FIXNUM RUNE)))))) +< (DEFINLINE NAME-START-RUNE-P (RUNE) +< (SETF RUNE (RUNE-CODE RUNE)) +< (AND (<= 0 RUNE ,*MAX*) +< (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3))) +< (= 1 (SBIT ',(predicate-to-bv #'name-start-rune-p) +< (THE FIXNUM RUNE)))))))) )))) +--- +> (definline name-rune-p (rune) +> (setf rune (rune-code rune)) +> (and (<= 0 rune ,*max*) +> (locally (declare (optimize (safety 0) (speed 3))) +> (= 1 (sbit ',(predicate-to-bv #'name-rune-p) +> (the fixnum rune)))))) +> (definline name-start-rune-p (rune) +> (setf rune (rune-code rune)) +> (and (<= 0 rune ,*max*) +> (locally (declare (optimize (safety 0) (speed 3))) +> (= 1 (sbit ',(predicate-to-bv #'name-start-rune-p) +> (the fixnum rune)))))))) )))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/domtest.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/domtest.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,719 @@ +(defpackage :domtest + (:use :cl :cxml) + (:export #:run-all-tests)) +(defpackage :domtest-tests + (:use)) +(in-package :domtest) + + +;;;; allgemeine Hilfsfunktionen + +(defmacro string-case (keyform &rest clauses) + (let ((key (gensym "key"))) + `(let ((,key ,keyform)) + (declare (ignorable ,key)) + (cond + ,@(loop + for (keys . forms) in clauses + for test = (etypecase keys + (string `(string= ,key ,keys)) + (sequence `(find ,key ',keys :test 'string=)) + ((eql t) t)) + collect + `(,test ,@forms)))))) + +(defun rcurry (function &rest args) + (lambda (&rest more-args) + (apply function (append more-args args)))) + +(defmacro for ((&rest clauses) &rest body-forms) + `(%for ,clauses (progn ,@body-forms))) + +(defmacro for* ((&rest clauses) &rest body-forms) + `(%for* ,clauses (progn ,@body-forms))) + +(defmacro %for ((&rest clauses) body-form &rest finally-forms) + (for-aux 'for clauses body-form finally-forms)) + +(defmacro %for* ((&rest clauses) body-form &rest finally-forms) + (for-aux 'for* clauses body-form finally-forms)) + +(defmacro for-finish () + '(loop-finish)) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun for-aux (kind clauses body-form finally-forms) + ` (loop ,@ (loop for firstp = t then nil + for %clauses = clauses then (rest %clauses) + for clause = (first %clauses) then (first %clauses) + while (and %clauses (listp clause)) + append (cons (ecase kind + (for (if firstp 'as 'and)) + (for* 'as)) + (if (= 2 (length clause)) + (list (first clause) '= (second clause)) + clause)) + into result + finally (return (append result %clauses))) + do (progn ,body-form) + finally (progn ,@finally-forms)))) + + +;;;; spezielle Hilfsfunktionen + +(defun tag-name (elt) + (runes:rod-string (dom:tag-name elt))) + +(defmacro with-attributes ((&rest attributes) element &body body) + (let ((e (gensym "element"))) + `(let* ((,e ,element) + ,@(mapcar (lambda (var) + `(,var (dom:get-attribute ,e ,(symbol-name var)))) + attributes)) + ,@body))) + +(defun map-child-elements (result-type fn element &key name) + (remove '#1=#:void + (map result-type + (lambda (node) + (if (and (eq (dom:node-type node) :element) + (or (null name) + (equal (tag-name node) name))) + (funcall fn node) + '#1#)) + (dom:child-nodes element)))) + +(defmacro do-child-elements ((var element &key name) &body body) + `(block nil + (map-child-elements nil (lambda (,var) ,@body) ,element :name ,name))) + +(defun find-child-element (name element) + (do-child-elements (child element :name name) + (return child))) + +(defun %intern (name) + (unless (stringp name) + (setf name (runes:rod-string name))) + (if (zerop (length name)) + nil + (intern name :domtest-tests))) + +(defun replace-studly-caps (str) + (unless (stringp str) + (setf str (runes:rod-string str))) + ;; s/([A-Z][a-z])/-\1/ + (with-output-to-string (out) + (with-input-from-string (in str) + (for ((c = (read-char in nil nil)) + (previous = nil then c) + (next = (peek-char nil in nil nil)) + :while c) + (when (and previous + (upper-case-p c) next (lower-case-p next) + (not (lower-case-p previous))) + (write-char #\- out)) + (write-char (char-downcase c) out) + (when (and (lower-case-p c) next (upper-case-p next)) + (write-char #\- out)))))) + +(defun intern-dom (name) + (setf name (replace-studly-caps name)) + (when (eq :foo :FOO) + (setf name (string-upcase name))) + (intern name :dom)) + +(defun child-elements (element) + (map-child-elements 'list #'identity element)) + +(defun parse-java-literal (str) + (when (stringp str) + (setf str (runes:string-rod str))) + (cond + ((zerop (length str)) nil) + ((runes:rod= str #"true") + t) + ((runes:rod= str #"false") + nil) + ((digit-char-p (runes:rune-char (elt str 0))) + (parse-integer (runes:rod-string str))) + ((runes:rune= (elt str 0) #.(runes:char-rune #\")) + (let ((v (make-array 1 :fill-pointer 0 :adjustable t))) + (for* ((i = 1 :then (1+ i)) + (c = (elt str i)) + :until (runes:rune= c #.(runes:char-rune #\"))) + (if (runes:rune= c #.(runes:char-rune #\\)) + (let ((frob + (progn + (incf i) + (elt str i)))) + (ecase frob + ;; ... + (#/n (vector-push-extend #/newline v (length v))) + ((#/\\ #/\") (vector-push-extend #/\\ v (length v))))) + (vector-push-extend c v (length v)))) + (make-array (length v) :element-type 'runes:rune :initial-contents v))) + (t + (%intern str)))) + +(defun maybe-setf (place form) + (if place + `(setf ,place ,form) + form)) + +(defun nullify (str) + (if (zerop (length str)) nil str)) + + +;;;; dom1-interfaces.xml auslesen + +(defparameter *methods* '()) +(defparameter *fields* '()) + +(declaim (special *directory*)) +(declaim (special *files-directory*)) + +(defun read-members (&optional (directory *directory*)) + (let* ((pathname (merge-pathnames "build/dom2-interfaces.xml" directory)) + (builder (rune-dom:make-dom-builder)) + (library (dom:document-element + (cxml:parse-file pathname builder :recode nil))) + (methods '()) + (fields '())) + (do-child-elements (interface library :name "interface") + (do-child-elements (method interface :name "method") + (let ((parameters (find-child-element "parameters" method))) + (push (cons (dom:get-attribute method "name") + (map-child-elements 'list + (rcurry #'dom:get-attribute "name") + parameters + :name "param")) + methods))) + (do-child-elements (attribute interface :name "attribute") + (push (dom:get-attribute attribute "name") fields))) + (values methods fields))) + + +;;;; Conditions uebersetzen + +(defun translate-condition (element) + (string-case (tag-name element) + ("equals" (translate-equals element)) + ("notEquals" (translate-not-equals element)) + ("contentType" (translate-content-type element)) + ("implementationAttribute" (assert-have-implementation-attribute element)) + ("isNull" (translate-is-null element)) + ("not" (translate-is-null element)) + ("notNull" (translate-not-null element)) + ("or" (translate-or element)) + ("same" (translate-same element)) + ("less" (translate-less element)) + (t (error "unknown condition: ~A" element)))) + +(defun equalsp (a b test) + (when (dom:named-node-map-p a) + (setf a (dom:items a))) + (when (dom:named-node-map-p b) + (setf b (dom:items b))) + (if (and (typep a 'sequence) (typep b 'sequence)) + (null (set-exclusive-or (coerce a 'list) (coerce b 'list) :test test)) + (funcall test a b))) + +(defun %equal (a b) + (or (equal a b) (and (runes::rodp a) (runes::rodp b) (runes:rod= a b)))) + +(defun %equalp (a b) + (or (equalp a b) (and (runes::rodp a) (runes::rodp b) (runes:rod-equal a b)))) + +(defun translate-equals (element) + (with-attributes (|actual| |expected| |ignoreCase|) element + `(equalsp ,(%intern |actual|) + ,(parse-java-literal |expected|) + ',(if (parse-java-literal |ignoreCase|) '%equal '%equal)))) + +(defun translate-not-equals (element) + `(not ,(translate-equals element))) + +(defun translate-same (element) + (with-attributes (|actual| |expected|) element + `(eql ,(%intern |actual|) ,(parse-java-literal |expected|)))) + +(defun translate-less (element) + (with-attributes (|actual| |expected|) element + `(< ,(%intern |actual|) ,(parse-java-literal |expected|)))) + +(defun translate-or (element) + `(or ,@(map-child-elements 'list #'translate-condition element))) + +(defun translate-instance-of (element) + (with-attributes (|obj| |type|) element + `(eq (dom:node-type ,(%intern |obj|)) + ',(string-case (runes:rod-string |type|) + ("Document" :document) + ("DocumentFragment" :document-fragment) + ("Text" :text) + ("Comment" :comment) + ("CDATASection" :cdata-section) + ("Attr" :attribute) + ("Element" :element) + ("DocumentType" :document-type) + ("Notation" :notation) + ("Entity" :entity) + ("EntityReference" :entity-reference) + ("ProcessingInstruction" :processing-instruction) + (t (error "unknown interface: ~A" |type|)))))) + +(defun translate-is-null (element) + (with-attributes (|obj|) element + `(null ,(%intern |obj|)))) + +(defun translate-not-null (element) + (with-attributes (|obj|) element + (%intern |obj|))) + +(defun translate-content-type (element) ;XXX verstehe ich nicht + (with-attributes (|type|) element + `(equal ,|type| "text/xml"))) + +(defun translate-uri-equals (element) + (with-attributes + (|actual| + |scheme| |path| |host| |file| |name| |query| |fragment| |isAbsolute|) + element + |isAbsolute| + `(let ((uri (net.uri:parse-uri (runes:rod-string ,(%intern |actual|))))) + (flet ((uri-directory (path) + (namestring + (make-pathname :directory (pathname-directory path)))) + (uri-file (path) + (namestring (make-pathname :name (pathname-name path) + :type (pathname-type path)))) + (uri-name (path) + (pathname-name path)) + (maybe-equal (expected actual) + (if expected + (%equal (runes::rod expected) (runes::rod actual)) + t))) + (and (maybe-equal ,(parse-java-literal |scheme|) + (net.uri:uri-scheme uri)) + (maybe-equal ,(parse-java-literal |host|) + (net.uri:uri-host uri)) + (maybe-equal ,(parse-java-literal |path|) + (uri-directory (net.uri:uri-path uri))) + (maybe-equal ,(parse-java-literal |file|) + (uri-file (net.uri:uri-path uri))) + (maybe-equal ,(parse-java-literal |name|) + (uri-name (net.uri:uri-path uri))) + (maybe-equal ,(parse-java-literal |query|) + (net.uri:uri-query uri)) + (maybe-equal ,(parse-java-literal |fragment|) + (net.uri:uri-fragment uri))))))) + + +;;;; Statements uebersetzen + +(defun translate-statement (element) + (string-case (tag-name element) + ("append" (translate-append element)) + ("assertDOMException" (translate-assert-domexception element)) + ("assertEquals" (translate-assert-equals element)) + ("assertNotNull" (translate-assert-not-null element)) + ("assertInstanceOf" (translate-assert-instance-of element)) + ("assertNull" (translate-assert-null element)) + ("assertSame" (translate-assert-same element)) + ("assertSize" (translate-assert-size element)) + ("assertTrue" (translate-assert-true element)) + ("assertFalse" (translate-assert-false element)) + ("assertURIEquals" (translate-assert-uri-equals element)) + ("assign" (translate-assign element)) + ("for-each" (translate-for-each element)) + ("fail" (translate-fail element)) + ("hasFeature" (translate-has-feature element)) + ("if" (translate-if element)) + ("implementation" (translate-implementation element)) + ("increment" (translate-unary-assignment '+ element)) + ("decrement" (translate-unary-assignment '- element)) + ("length" (translate-length element)) + ("load" (translate-load element)) + ("nodeType" (translate-node-type element)) + ("plus" (translate-binary-assignment '+ element)) + ("try" (translate-try element)) + ("while" (translate-while element)) + (t (translate-member element)))) + +(defun translate-binary-assignment (fn element) + (with-attributes (|var| |op1| |op2|) element + (maybe-setf (%intern |var|) + `(,fn ,(parse-java-literal |op1|) + ,(parse-java-literal |op2|))))) + +(defun translate-assign (element) + (with-attributes (|var| |value|) element + (maybe-setf (%intern |var|) (parse-java-literal |value|)))) + +(defun translate-unary-assignment (fn element) + (with-attributes (|var| |value|) element + (maybe-setf (%intern |var|) + `(,fn ,(%intern |var|) ,(parse-java-literal |value|))))) + +(defun translate-load (load) + (with-attributes (|var| |href| |willBeModified|) load + (maybe-setf (%intern |var|) + `(load-file ,|href| ,(parse-java-literal |willBeModified|))))) + +(defun translate-implementation (elt) + (with-attributes (|var|) elt + (maybe-setf (%intern |var|) `'rune-dom:implementation))) + +(defun translate-length (load) + ;; XXX Soweit ich sehe unterscheiden die Tests nicht zwischen + ;; der Laenge von DOMString und der length()-Methode der uebrigen + ;; Interfaces. Also unterscheiden wir das erstmal manuell. + (with-attributes (|var| |obj|) load + (let ((obj (%intern |obj|))) + (maybe-setf (%intern |var|) + `(if (typep ,obj 'sequence) + (length ,obj) + (dom:length ,obj)))))) + +(defun translate-call (call method) + (let ((name (car method)) + (args (mapcar (lambda (name) + (parse-java-literal (dom:get-attribute call name))) + (cdr method)))) + (with-attributes (|var| |obj|) call + (maybe-setf (%intern |var|) + `(,(intern-dom name) ,(%intern |obj|) ,@args))))) + +(defun translate-get (call name) + (with-attributes (|var| |value| |obj|) call + (cond + ((nullify |var|) ;get + (maybe-setf (%intern |var|) `(,(intern-dom name) ,(%intern |obj|)))) + ((nullify |value|) ;set + `(setf (,(intern-dom name) ,(%intern |obj|)) + ,(parse-java-literal |value|))) + (t + (error "oops"))))) + +(defun translate-has-feature (element) + (with-attributes (|obj| |var| |feature| |version|) element + (if (nullify |obj|) + (translate-member element) + (maybe-setf (%intern |var|) + `(dom:has-feature 'rune-dom:implementation + ,(parse-java-literal |feature|) + ,(parse-java-literal |version|)))))) + +(defun translate-fail (element) + (declare (ignore element)) + `(error "failed")) + +(defun translate-node-type (element) + ;; XXX Das muessten eigentlich ints sein, sind aber Keywords in CXML. + (with-attributes (|var| |obj|) element + (maybe-setf (%intern |var|) + `(ecase (dom:node-type ,(%intern |obj|)) + (:element 1) + (:attribute 2) + (:text 3) + (:cdata-section 4) + (:entity-reference 5) + (:entity 6) + (:processing-instruction 7) + (:comment 8) + (:document 9) + (:document-type 10) + (:document-fragment 11) + (:notation 12))))) + +(defun translate-member (element) + (let* ((name (dom:tag-name element)) + (method (find name *methods* :key #'car :test #'runes:rod=)) + (field (find name *fields* :test #'runes:rod=))) + (cond + (method (translate-call element method)) + (field (translate-get element field)) + (t (error "unknown element ~A" element))))) + +(defun translate-assert-equals (element) + `(assert ,(translate-equals element))) + +(defun translate-assert-same (element) + `(assert ,(translate-same element))) + +(defun translate-assert-null (element) + (with-attributes (|actual|) element + `(assert (null ,(%intern |actual|))))) + +(defun translate-assert-not-null (element) + (with-attributes (|actual|) element + `(assert ,(%intern |actual|)))) + +(defun translate-assert-size (element) + (with-attributes (|collection| |size|) element + `(let ((collection ,(%intern |collection|))) + (when (dom:named-node-map-p collection) + (setf collection (dom:items collection))) + (assert (eql (length collection) ,(parse-java-literal |size|)))))) + +(defun translate-assert-instance-of (element) + `(assert ,(translate-instance-of element))) + +(defun translate-if (element) + (destructuring-bind (condition &rest rest) + (child-elements element) + (let (then else) + (dolist (r rest) + (when (equal (tag-name r) "else") + (setf else (child-elements r)) + (return)) + (push r then)) + `(cond + (,(translate-condition condition) + ,@(mapcar #'translate-statement (reverse then))) + (t + ,@(mapcar #'translate-statement else)))))) + +(defun translate-while (element) + (destructuring-bind (condition &rest body) + (child-elements element) + `(loop + while ,(translate-condition condition) + do (progn ,@(mapcar #'translate-statement body))))) + +(defun translate-assert-domexception (element) + (do-child-elements (c element) + (unless (equal (tag-name c) "metadata") + (return + `(block assert-domexception + (handler-bind + ((rune-dom::dom-exception + (lambda (c) + (when (eq (rune-dom::dom-exception-key c) + ,(intern (tag-name c) :keyword)) + (return-from assert-domexception))))) + ,@(translate-body c) + (error "expected exception ~A" ,(tag-name c)))))))) + +(defun translate-catch (catch return) + `(lambda (c) + ,@(map-child-elements + 'list + (lambda (exception) + `(when (eq (rune-dom::dom-exception-key c) + ,(intern (runes:rod-string (dom:get-attribute exception "code")) + :keyword)) + ,@(translate-body exception) + ,return)) + catch))) + +(defun translate-try (element) + `(block try + (handler-bind + ((rune-dom::dom-exception + ,(translate-catch + (do-child-elements (c element :name "catch") (return c)) + '(return-from try)))) + ,@(map-child-elements 'list + (lambda (c) + (if (equal (tag-name c) "catch") + nil + (translate-statement c))) + element)))) + +(defun translate-append (element) + (with-attributes (|collection| |item|) element + (let ((c (%intern |collection|)) + (i (%intern |item|))) + (maybe-setf c `(append ,c (list ,i)))))) + +(defun translate-assert-true (element) + (with-attributes (|actual|) element + `(assert ,(if (nullify |actual|) + (%intern |actual|) + (translate-condition + (do-child-elements (c element) (return c))))))) + +(defun translate-assert-false (element) + (with-attributes (|actual|) element + `(assert (not ,(%intern |actual|))))) + +(defun translate-assert-uri-equals (element) + `(assert ,(translate-uri-equals element))) + + +;;;; Tests uebersetzen + +(defun translate-body (element) + (map-child-elements 'list #'translate-statement element)) + +(defun translate-for-each (element) + (with-attributes (|collection| |member|) element + `(let ((collection ,(%intern |collection|))) + (when (dom:named-node-map-p collection) + (setf collection (dom:items collection))) + (map nil (lambda (,(%intern |member|)) ,@(translate-body element)) + collection)))) + +(defun assert-have-implementation-attribute (element) + (let ((attribute (runes:rod-string (dom:get-attribute element "name")))) + (string-case attribute + ;; fixme: expandEntityReferences sollten wir auch mal anschalten, wo + ;; wir uns schon die muehe machen... + ("validating" + (setf cxml::*validate* t)) + ("namespaceAware" + ;; ??? dom 2 ohne namespace-support gibt's doch gar nicht, + ;; ausser vielleicht in html-only implementationen, und dann sollen + ;; sie halt auf hasFeature "XML" testen. + ) + (t + (format t "~&implementationAttribute ~A not supported, skipping test~%" + attribute) + (throw 'give-up nil))))) + +(defun slurp-test (pathname) + (unless *fields* + (multiple-value-setq (*methods* *fields*) (read-members))) + (catch 'give-up + (let* ((builder (rune-dom:make-dom-builder)) + (cxml::*validate* nil) ;dom1.dtd is buggy + (test (dom:document-element + (cxml:parse-file pathname builder :recode nil))) + title + (bindings '()) + (code '())) + (declare (ignorable title)) + (do-child-elements (e test) + (string-case (tag-name e) + ("metadata" + (let ((title-element (find-child-element "title" e))) + (setf title (dom:data (dom:first-child title-element))))) + ("var" + (push (list (%intern (dom:get-attribute e "name")) + (string-case (runes:rod-string + (dom:get-attribute e "type")) + (("byte" "short" "int" "long") 0) + (t nil))) + bindings) + (let ((value (dom:get-attribute e "value"))) + (when value + (push `(setf ,(%intern (dom:get-attribute e "name")) + ,(parse-java-literal value)) + code))) + (do-child-elements (member e :name "member") e + (push `(setf ,(%intern (dom:get-attribute e "name")) + (append ,(%intern (dom:get-attribute e "name")) + (list + ,(parse-java-literal + (dom:data + (dom:item + (dom:child-nodes member) + 0)))))) + code))) + ("implementationAttribute" + (assert-have-implementation-attribute e)) + (t + (push (translate-statement e) code)))) + `(lambda () + (let ((*files-directory* ,*files-directory*) ;fuer copy&paste: + ,@bindings) + (declare (ignorable ,@(mapcar #'car bindings))) + ,@(reverse code)))))) + +(defun load-file (name &optional will-be-modified-p) + (declare (ignore will-be-modified-p)) + (setf name (runes:rod-string name)) + (cxml:parse-file + (make-pathname :name name :type "xml" :defaults *files-directory*) + (rune-dom:make-dom-builder) + :recode nil)) + +(defparameter *bad-tests* + '("hc_elementnormalize2.xml" + "hc_nodereplacechildnewchildexists.xml" + "characterdatadeletedatanomodificationallowederr.xml")) + +(defun dribble-tests (directory) + (let ((base (slot-value (asdf:find-system :cxml) 'asdf::relative-pathname))) + (with-open-file (*standard-output* + (merge-pathnames "DOMTEST" base) + :direction :output + :if-exists :supersede) + (run-all-tests directory)))) + +(defun run-all-tests (*directory* &optional verbose) + (let* ((cxml::*redefinition-warning* nil) + (n 0) + (i 0) + (ntried 0) + (nfailed 0)) + (flet ((parse (test-directory) + (let* ((all-tests (merge-pathnames "alltests.xml" test-directory)) + (builder (rune-dom:make-dom-builder)) + (suite (dom:document-element + (cxml:parse-file all-tests builder :recode nil))) + (*files-directory* + (merge-pathnames "files/" test-directory))) + (do-child-elements (member suite) + (unless + (or (equal (dom:tag-name member) "metadata") + (member (runes:rod-string + (dom:get-attribute member "href")) + *bad-tests* + :test 'equal)) + (incf n))) + suite)) + (run (test-directory suite) + (print test-directory) + (let ((*files-directory* + (merge-pathnames "files/" test-directory))) + (do-child-elements (member suite) + (let ((href (runes:rod-string + (dom:get-attribute member "href")))) + (unless (or (runes:rod= (dom:tag-name member) #"metadata") + (member href *bad-tests* :test 'equal)) + (format t "~&~D/~D ~A~%" i n href) + (let ((lisp (slurp-test + (merge-pathnames href test-directory)))) + (when verbose + (print lisp)) + (when lisp + (incf ntried) + (with-simple-restart (skip-test "Skip this test") + (handler-case + (let ((cxml::*validate* nil)) + (funcall (compile nil lisp))) + (serious-condition (c) + (incf nfailed) + (format t "~&TEST FAILED: ~A~&" c)))))) + (incf i))))))) + (let* ((d1 (merge-pathnames "tests/level1/core/" *directory*)) + (d2 (merge-pathnames "tests/level2/core/" *directory*)) + (suite1 (parse d1)) + (suite2 (parse d2))) + (run d1 suite1) + (run d2 suite2))) + (format t "~&~D/~D tests failed; ~D test~:P were skipped" + nfailed ntried (- n ntried)))) + +(defun run-test (*directory* level href) + (let* ((test-directory + (ecase level + (1 (merge-pathnames "tests/level1/core/" *directory*)) + (2 (merge-pathnames "tests/level2/core/" *directory*)))) + (*files-directory* (merge-pathnames "files/" test-directory)) + (lisp (slurp-test (merge-pathnames href test-directory))) + (cxml::*validate* nil)) + (print lisp) + (fresh-line) + (when lisp + (funcall (compile nil lisp))))) + +#+(or) +(domtest::run-all-tests "/home/david/2001/DOM-Test-Suite/") + +#+(or) +(domtest::run-test "/home/david/2001/DOM-Test-Suite/" + 1 + "attrcreatedocumentfragment.xml") Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/misc.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/misc.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,29 @@ +;;; +;;; When I'll grow up, I'll be a complete test suite. + +(deftest utf-8 + (flet ((doit (from below) + (loop for code from from below below do + (when (and (code-char code) + (not (eql code #xfffe)) + (not (eql code #xffff))) + (let* ((a (if (< code #x10000) + (format nil "abc~C" (code-char code)) + (let* ((x (- code #x10000)) + (lo (ldb (byte 10 0) x)) + (hi (ldb (byte 10 10) x))) + (format nil "abc~C~C" + (code-char (logior #xD800 hi)) + (code-char + (logior #xDC00 lo)))))) + (b (cxml:utf8-string-to-rod + (cxml:rod-to-utf8-string + a)))) + (unless (string= a b) + (format t "FAIL: ~S ~A ~A~%" + (code-char code) + (map 'vector #'char-code a) + (map 'vector #'char-code b)))))))) + (doit 32 #xD800) + (doit #x10000 char-code-limit) + (values))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/utf8domtest.diff ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/utf8domtest.diff Sun Feb 17 09:26:33 2008 @@ -0,0 +1,102 @@ +Index: test/domtest.lisp +=================================================================== +RCS file: /project/cxml/cvsroot/cxml/test/domtest.lisp,v +retrieving revision 1.13 +diff -u -r1.13 domtest.lisp +--- test/domtest.lisp 27 Dec 2005 00:21:37 -0000 1.13 ++++ test/domtest.lisp 27 Dec 2005 00:46:00 -0000 +@@ -137,21 +137,22 @@ + ((digit-char-p (runes:rune-char (elt str 0))) + (parse-integer (runes:rod-string str))) + ((runes:rune= (elt str 0) #.(runes:char-rune #\")) +- (let ((v (make-array 1 :fill-pointer 0 :adjustable t))) +- (for* ((i = 1 :then (1+ i)) +- (c = (elt str i)) +- :until (runes:rune= c #.(runes:char-rune #\"))) +- (if (runes:rune= c #.(runes:char-rune #\\)) +- (let ((frob +- (progn +- (incf i) +- (elt str i)))) +- (ecase frob +- ;; ... +- (#/n (vector-push-extend #/newline v (length v))) +- ((#/\\ #/\") (vector-push-extend #/\\ v (length v))))) +- (vector-push-extend c v (length v)))) +- (coerce v 'runes::simple-rod))) ++ (utf8-dom::%rod ++ (let ((v (make-array 1 :fill-pointer 0 :adjustable t))) ++ (for* ((i = 1 :then (1+ i)) ++ (c = (elt str i)) ++ :until (runes:rune= c #.(runes:char-rune #\"))) ++ (if (runes:rune= c #.(runes:char-rune #\\)) ++ (let ((frob ++ (progn ++ (incf i) ++ (elt str i)))) ++ (ecase frob ++ ;; ... ++ (#/n (vector-push-extend #/newline v (length v))) ++ ((#/\\ #/\") (vector-push-extend #/\\ v (length v))))) ++ (vector-push-extend c v (length v)))) ++ (coerce v 'runes::simple-rod)))) + (t + (%intern str)))) + +@@ -368,7 +369,7 @@ + + (defun translate-implementation (elt) + (with-attributes (|var|) elt +- (maybe-setf (%intern |var|) `'rune-dom:implementation))) ++ (maybe-setf (%intern |var|) `'utf8-dom:implementation))) + + (defun translate-length (load) + ;; XXX Soweit ich sehe unterscheiden die Tests nicht zwischen +@@ -406,7 +407,7 @@ + (if (nullify |obj|) + (translate-member element) + (maybe-setf (%intern |var|) +- `(dom:has-feature 'rune-dom:implementation ++ `(dom:has-feature 'utf8-dom:implementation + ,(parse-java-literal |feature|) + ,(parse-java-literal |version|)))))) + +@@ -493,9 +494,9 @@ + (return + `(block assert-domexception + (handler-bind +- ((rune-dom::dom-exception ++ ((utf8-dom::dom-exception + (lambda (c) +- (when (eq (rune-dom::dom-exception-key c) ++ (when (eq (utf8-dom::dom-exception-key c) + ,(intern (tag-name c) :keyword)) + (return-from assert-domexception))))) + ,@(translate-body c) +@@ -506,7 +507,7 @@ + ,@(map-child-elements + 'list + (lambda (exception) +- `(when (eq (rune-dom::dom-exception-key c) ++ `(when (eq (utf8-dom::dom-exception-key c) + ,(intern (runes:rod-string (dom:get-attribute exception "code")) + :keyword)) + ,@(translate-body exception) +@@ -516,7 +517,7 @@ + (defun translate-try (element) + `(block try + (handler-bind +- ((rune-dom::dom-exception ++ ((utf8-dom::dom-exception + ,(translate-catch + (do-child-elements (c element :name "catch") (return c)) + '(return-from try)))) +@@ -631,7 +632,7 @@ + (setf name (runes:rod-string name)) + (cxml:parse-file + (make-pathname :name name :type "xml" :defaults *files-directory*) +- (rune-dom:make-dom-builder))) ++ (cxml:make-recoder (utf8-dom:make-dom-builder) 'cxml:rod-to-utf8-string))) + + (defparameter *bad-tests* + '("hc_elementnormalize2.xml" Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/xmlconf-base.diff ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/xmlconf-base.diff Sun Feb 17 09:26:33 2008 @@ -0,0 +1,53 @@ +A recent check-in to the XML-Test-Suite's metadata has broken my parser for +xmlconf.xml. Apply this patch to revert it. + +Index: oasis/oasis.xml +=================================================================== +RCS file: /sources/public/2001/XML-Test-Suite/xmlconf/oasis/oasis.xml,v +retrieving revision 1.5 +retrieving revision 1.6 +diff -u -r1.5 -r1.6 +--- oasis/oasis.xml 16 May 2002 14:46:32 -0000 1.5 ++++ oasis/oasis.xml 4 Mar 2004 18:23:37 -0000 1.6 +@@ -1,6 +1,6 @@ + <?xml version='1.0' encoding='UTF-8'?> + +-<TESTCASES PROFILE='OASIS/NIST TESTS, 1-Nov-1998' xml:base="oasis/"> ++<TESTCASES PROFILE='OASIS/NIST TESTS, 1-Nov-1998'> + + <TEST TYPE='valid' SECTIONS='2.2 [1]' + ID='o-p01pass2' URI='p01pass2.xml'> +Index: xmltest/xmltest.xml +=================================================================== +RCS file: /sources/public/2001/XML-Test-Suite/xmlconf/xmltest/xmltest.xml,v +retrieving revision 1.9 +retrieving revision 1.10 +diff -u -r1.9 -r1.10 +--- xmltest/xmltest.xml 21 May 2002 19:05:57 -0000 1.9 ++++ xmltest/xmltest.xml 4 Mar 2004 18:25:11 -0000 1.10 +@@ -5,7 +5,7 @@ + All Rights Reserved. + --> + +-<TESTCASES PROFILE="James Clark XMLTEST cases, 18-Nov-1998" xml:base="xmltest/"> ++<TESTCASES PROFILE="James Clark XMLTEST cases, 18-Nov-1998"> + + <!-- Start: not-wf/sa --> + <TEST TYPE="not-wf" ENTITIES="none" ID="not-wf-sa-001" +Index: japanese/japanese.xml +=================================================================== +RCS file: /sources/public/2001/XML-Test-Suite/xmlconf/japanese/japanese.xml,v +retrieving revision 1.4 +retrieving revision 1.5 +diff -u -r1.4 -r1.5 +--- japanese/japanese.xml 26 Mar 2002 14:43:54 -0000 1.4 ++++ japanese/japanese.xml 4 Mar 2004 18:18:39 -0000 1.5 +@@ -5,7 +5,7 @@ + All Rights Reserved. + --> + +-<TESTCASES PROFILE="Fuji Xerox Japanese Text Tests" xml:base="japanese/"> ++<TESTCASES PROFILE="Fuji Xerox Japanese Text Tests"> + + <TEST TYPE="error" SECTIONS="4.3.3 [4,84]" + ID="pr-xml-euc-jp" ENTITIES="parameter" URI="pr-xml-euc-jp.xml"> Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/xmlconf.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/test/xmlconf.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,232 @@ +(defpackage xmlconf + (:use :cl :runes) + (:export #:run-all-tests)) +(in-package :xmlconf) + +(defun get-attribute (element name) + (rod-string (dom:get-attribute element name))) + +(defparameter *bad-tests* + '(;; TS14 + ;; http://lists.w3.org/Archives/Public/public-xml-testsuite/2002Mar/0001.html + "ibm-valid-P28-ibm28v02.xml" + "ibm-valid-P29-ibm29v01.xml" + "ibm-valid-P29-ibm29v02.xml")) + +(defun test-class (test) + (cond + ((not (and (let ((version (get-attribute test "RECOMMENDATION"))) + (cond + ((or (equal version "") ;XXX + (equal version "XML1.0") + (equal version "NS1.0")) + (cond + ((equal (get-attribute test "NAMESPACE") "no") + (format t "~A: test applies to parsers without namespace support, skipping~%" + (get-attribute test "URI")) + nil) + (t + t))) + ((equal version "XML1.1") + ;; not supported + nil) + (t + (warn "unrecognized RECOMMENDATION value: ~S" version) + nil))) + (not (member (get-attribute test "ID") *bad-tests* :test 'equal)))) + nil) + ((equal (get-attribute test "TYPE") "valid") :valid) + ((equal (get-attribute test "TYPE") "invalid") :invalid) + ((equal (get-attribute test "TYPE") "not-wf") :not-wf) + (t nil))) + +(defun test-pathnames (directory test) + (let* ((sub-directory + (loop + for parent = test then (dom:parent-node parent) + for base = (get-attribute parent "xml:base") + until (plusp (length base)) + finally (return (merge-pathnames base directory)))) + (uri (get-attribute test "URI")) + (output (get-attribute test "OUTPUT"))) + (values (merge-pathnames uri sub-directory) + (when (plusp (length output)) + (merge-pathnames output sub-directory))))) + +(defmethod serialize-document ((document t)) + (dom:map-document (cxml:make-octet-vector-sink :canonical 2) + document + :include-doctype :canonical-notations + :include-default-values t)) + +(defun file-contents (pathname) + (with-open-file (s pathname :element-type '(unsigned-byte 8)) + (let ((result + (make-array (file-length s) :element-type '(unsigned-byte 8)))) + (read-sequence result s ) + result))) + +(defun dribble-tests (parser-fn directory) + (let ((base (slot-value (asdf:find-system :cxml) 'asdf::relative-pathname))) + (with-open-file (*standard-output* + (merge-pathnames "XMLCONF" base) + :direction :output + :external-format :iso-8859-1 + :if-exists :supersede) + (run-all-tests parser-fn directory)))) + +(defvar *parser-fn* 'sax-test) + +(defun sax-test (filename handler &rest args) + (apply #'cxml:parse-file filename handler :recode nil args)) + +(defun klacks-test (filename handler &rest args) + (klacks:with-open-source + (s (apply #'cxml:make-source (pathname filename) args)) + (klacks:serialize-source s handler))) + +(defun run-all-tests (parser-fn directory) + (let* ((*parser-fn* parser-fn) + (pathname (merge-pathnames "xmlconf.xml" directory)) + (builder (rune-dom:make-dom-builder)) + (xmlconf (cxml:parse-file pathname builder :recode nil)) + (ntried 0) + (nfailed 0) + (nskipped 0) + ;; XXX someone found it funny to include invalid URIs in the + ;; test suite. And no, in "invalid" not "not-wf". + (puri:*strict-parse* nil)) + (dom:do-node-list (test (dom:get-elements-by-tag-name xmlconf "TEST")) + (let ((description + (apply #'concatenate + 'string + (map 'list + (lambda (child) + (if (dom:text-node-p child) + (rod-string (dom:data child)) + "")) + (dom:child-nodes test)))) + (class (test-class test))) + (cond + (class + (incf ntried) + (multiple-value-bind (pathname output) + (test-pathnames directory test) + (princ (enough-namestring pathname directory)) + (unless (probe-file pathname) + (error "file not found: ~A" pathname)) + (with-simple-restart (skip-test "Skip this test") + (unless (run-test class pathname output description) + (incf nfailed)) + (fresh-line)))) + (t + (incf nskipped))))) + (format t "~&~D/~D tests failed; ~D test~:P were skipped" + nfailed ntried nskipped))) + +(defmethod run-test :around (class pathname output description &rest args) + (declare (ignore class pathname output args)) + (handler-case + (call-next-method) + (serious-condition (c) + (format t " FAILED:~% ~A~%[~A]~%" c description) + nil))) + +(defmethod run-test ((class null) pathname output description &rest args) + (declare (ignore description)) + (let ((document (apply *parser-fn* + pathname + (rune-dom:make-dom-builder) + args))) + (cond + ((null output) + (format t " input")) + ((equalp (file-contents output) (serialize-document document)) + (format t " input/output")) + (t + (let ((error-output (make-pathname :type "error" :defaults output))) + (with-open-file (s error-output + :element-type '(unsigned-byte 8) + :direction :output + :if-exists :supersede) + (write-sequence (serialize-document document) s)) + (error "well-formed, but output ~S not the expected ~S~%" + error-output output)))) + t)) + +(defmethod run-test + ((class (eql :valid)) pathname output description &rest args) + (assert (null args)) + (and (progn + (format t " [not validating:]") + (run-test nil pathname output description :validate nil)) + (progn + (format t " [validating:]") + (run-test nil pathname output description :validate t)))) + +(defmethod run-test + ((class (eql :invalid)) pathname output description &rest args) + (assert (null args)) + (and (progn + (format t " [not validating:]") + (run-test nil pathname output description :validate nil)) + (handler-case + (progn + (format t " [validating:]") + (funcall *parser-fn* + pathname + (rune-dom:make-dom-builder) + :validate t) + (error "validity error not detected") + nil) + (cxml:validity-error () + (format t " invalid") + t)))) + +(defmethod run-test + ((class (eql :not-wf)) pathname output description &rest args) + (assert (null args)) + (handler-case + (progn + (format t " [not validating:]") + (funcall *parser-fn* + pathname + (rune-dom:make-dom-builder) + :validate nil) + (error "well-formedness violation not detected") + nil) + #+fixme-stp-test + (error () + (format t " unexpected-error") + t) + (cxml:well-formedness-violation () + (format t " not-wf") + t)) + (handler-case + (progn + (format t " [validating:]") + (funcall *parser-fn* + pathname + (rune-dom:make-dom-builder) + :validate t) + (error "well-formedness violation not detected") + nil) + #+fixme-stp-test + (error () + (format t " unexpected-error") + t) + (cxml:well-formedness-violation () + (format t " not-wf") + t) + (cxml:validity-error () + ;; das erlauben wir mal auch, denn valide => wf + (format t " invalid") + t))) + +#+(or) +(xmlconf::run-all-tests 'xmlconf::sax-test + "/home/david/2001/XML-Test-Suite/xmlconf/") + +#+(or) +(xmlconf::run-all-tests 'xmlconf::klacks-test + "/home/david/2001/XML-Test-Suite/xmlconf/") Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/catalog.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/catalog.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,349 @@ +;;;; catalogs.lisp -- XML Catalogs -*- Mode: Lisp; readtable: runes -*- +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Developed 2004 for headcraft - http://headcraft.de/ +;;;; Copyright: David Lichteblau + +(in-package :cxml) + +;;; http://www.oasis-open.org/committees/entity/spec.html +;;; +;;; Bugs: +;;; - We validate using the Catalog DTD while parsing, which is too strict +;;; and will will fail to parse files using other parser's extensions. +;;; (Jedenfalls behauptet das die Spec.) +;;; A long-term solution might be an XML Schema validator. + +(defvar *prefer* :public) +(defvar *default-catalog* + '(;; libxml standard + "/etc/xml/catalog" + ;; FreeBSD + "/usr/local/share/xml/catalog.ports")) + +(defstruct (catalog (:constructor %make-catalog ())) + main-files + (dtd-cache (make-dtd-cache)) + (file-table (puri:make-uri-space))) + +(defstruct (entry-file (:conc-name "")) + (system-entries) ;extid 2 + (rewrite-system-entries) ; 3 + (delegate-system-entries) ; 4 + (public-entries) ; 5 + (delegate-public-entries) ; 6 + (uri-entries) ;uri 2 + (rewrite-uri-entries) ; 3 + (delegate-uri-entries) ; 4 + (next-catalog-entries) ; 5/7 + ) + +(defun starts-with-p (string prefix) + (let ((mismatch (mismatch string prefix))) + (or (null mismatch) (= mismatch (length prefix))))) + +(defun normalize-public (str) + (setf str (rod-to-utf8-string (rod str))) + (flet ((whitespacep (c) + (find c #.(map 'string #'code-char '(#x9 #xa #xd #x20))))) + (let ((start (position-if-not #'whitespacep str)) + (end (position-if-not #'whitespacep str :from-end t)) + (spacep nil)) + (with-output-to-string (out) + (when start + (loop for i from start to end do + (let ((c (char str i))) + (cond + ((whitespacep c) + (unless spacep + (setf spacep t) + (write-char #\space out))) + (t + (setf spacep nil) + (write-char c out)))))))))) + +(defun normalize-uri (str) + (when (typep str 'puri:uri) + (setf str (puri:render-uri str nil))) + (setf str (rod-to-utf8-string (rod str))) + (with-output-to-string (out) + (loop for ch across str do + (let ((c (char-code ch))) + (if (< c 15) + (write-string (string-upcase (format nil "%~2,'0X" c)) out) + (write-char ch out)))))) + +(defun unwrap-publicid (str) + (normalize-public + (with-output-to-string (out) + (let ((i (length "urn:publicid:")) + (n (length str))) + (while (< i n) + (let ((c (char str i))) + (case c + (#\+ (write-char #\space out)) + (#\: (write-string "//" out)) + (#\; (write-string "::" out)) + (#\% + (let ((code + (parse-integer str + :start (+ i 1) + :end (+ i 3) + :radix 16))) + (write-char (code-char code) out)) + (incf i 2)) + (t (write-char c out)))) + (incf i)))))) + +(defun match-exact (key table &optional check-prefer) + (dolist (pair table) + (destructuring-bind (from to &optional prefer) pair + (when (and (equal key from) (or (not check-prefer) (eq prefer :public))) + (return to))))) + +(defun match-prefix/rewrite (key table &optional check-prefer) + (let ((match nil) + (match-length -1)) + (dolist (pair table) + (destructuring-bind (from to &optional prefer) pair + (when (and (or (not check-prefer) (eq prefer :public)) + (starts-with-p key from) + (> (length from) match-length)) + (setf match-length (length from)) + (setf match to)))) + (if match + (concatenate 'string + match + (subseq key match-length)) + nil))) + +(defun match-prefix/sorted (key table &optional check-prefer) + (let ((result '())) + (dolist (pair table) + (destructuring-bind (from to &optional prefer) pair + (when (and (or (not check-prefer) (eq prefer :public)) + (starts-with-p key from)) + (push (cons (length from) to) result)))) + (mapcar #'cdr (sort result #'> :key #'car)))) + +(defun resolve-extid (public system catalog) + (when public (setf public (normalize-public public))) + (when system (setf system (normalize-uri system))) + (when (and system (starts-with-p system "urn:publicid:")) + (let ((new-public (unwrap-publicid system))) + (assert (or (null public) (equal public new-public))) + (setf public new-public + system nil))) + (let ((files (catalog-main-files catalog)) + (seen '())) + (while files + (let ((file (pop files)) + (delegates nil)) + (unless (typep file 'entry-file) + (setf file (find-catalog-file file catalog))) + (unless (or (null file) (member file seen)) + (push file seen) + (when system + (let ((result + (or (match-exact system (system-entries file)) + (match-prefix/rewrite + system + (rewrite-system-entries file))))) + (when result + (return result)) + (setf delegates + (match-prefix/sorted + system + (delegate-system-entries file))))) + (when (and public (not delegates)) + (let* ((check-prefer (and system t)) + (result + (match-exact public + (public-entries file) + check-prefer))) + (when result + (return result)) + (setf delegates + (match-prefix/sorted + public + (delegate-public-entries file) + check-prefer)))) + (if delegates + (setf files delegates) + (setf files (append (next-catalog-entries file) files)))))))) + +(defun resolve-uri (uri catalog) + (setf uri (normalize-uri uri)) + (when (starts-with-p uri "urn:publicid:") + (return-from resolve-uri + (resolve-extid (unwrap-publicid uri) nil catalog))) + (let ((files (catalog-main-files catalog)) + (seen '())) + (while files + (let ((file (pop files))) + (unless (typep file 'entry-file) + (setf file (find-catalog-file file catalog))) + (unless (or (null file) (member file seen)) + (push file seen) + (let ((result + (or (match-exact uri (uri-entries file)) + (match-prefix/rewrite uri (rewrite-uri-entries file))))) + (when result + (return result)) + (let* ((delegate-entries + (delegate-uri-entries file)) + (delegates + (match-prefix/sorted uri delegate-entries))) + (if delegates + (setf files delegates) + (setf files (append (next-catalog-entries file) files)))))))))) + +(defun find-catalog-file (uri catalog) + (setf uri (if (stringp uri) (safe-parse-uri uri) uri)) + (let* ((*dtd-cache* (catalog-dtd-cache catalog)) + (*cache-all-dtds* t) + (file (parse-catalog-file uri))) + (when file + (let ((interned (puri:intern-uri uri (catalog-file-table catalog)))) + (setf (getf (puri:uri-plist interned) 'catalog) file))) + file)) + +(defun make-catalog (&optional (uris *default-catalog*)) + (let ((result (%make-catalog))) + (setf (catalog-main-files result) + (loop + for uri in uris + for file = (find-catalog-file uri result) + when file collect file)) + result)) + +(defun parse-catalog-file (uri) + (handler-case + (parse-catalog-file/strict uri) + ((or file-error xml-parse-error) (c) + (warn "ignoring catalog error: ~A" c)))) + +(defparameter *catalog-dtd* + (let* ((cxml + (slot-value (asdf:find-system :cxml) 'asdf::relative-pathname)) + (dtd (merge-pathnames "catalog.dtd" cxml))) + (with-open-file (s dtd :element-type '(unsigned-byte 8)) + (let ((bytes + (make-array (file-length s) :element-type '(unsigned-byte 8)))) + (read-sequence bytes s) + bytes)))) + +(defun parse-catalog-file/strict (uri) + (let* ((*catalog* nil) + (dtd-sysid + (puri:parse-uri "http://www.oasis-open.org/committees/entity/release/1.0/catalog.dtd"))) + (flet ((entity-resolver (public system) + (declare (ignore public)) + (if (puri:uri= system dtd-sysid) + (make-octet-input-stream *catalog-dtd*) + nil))) + (with-open-stream (s (open (uri-to-pathname uri) + :element-type '(unsigned-byte 8) + :direction :input)) + (parse-stream s + (make-instance 'catalog-parser :uri uri) + :validate nil + :dtd (make-extid nil dtd-sysid) + :root #"catalog" + :entity-resolver #'entity-resolver))))) + +(defclass catalog-parser () + ((result :initform (make-entry-file) :accessor result) + (next :initform '() :accessor next) + (prefer-stack :initform (list *prefer*) :accessor prefer-stack) + (catalog-base-stack :accessor catalog-base-stack))) + +(defmethod initialize-instance :after + ((instance catalog-parser) &key uri) + (setf (catalog-base-stack instance) (list uri))) + +(defmethod prefer ((handler catalog-parser)) + (car (prefer-stack handler))) + +(defmethod base ((handler catalog-parser)) + (car (catalog-base-stack handler))) + +(defun get-attribute/lname (name attributes) + (let ((a (find name attributes + :key (lambda (a) + (or (sax:attribute-local-name a) + (sax:attribute-qname a))) + :test #'string=))) + (and a (sax:attribute-value a)))) + +(defmethod sax:start-element ((handler catalog-parser) uri lname qname attrs) + (declare (ignore uri)) + (setf lname (or lname qname)) + ;; we can dispatch on lnames only because we validate against the DTD, + ;; which disallows other namespaces. + ;; FIXME: we don't, because we can't. + (push (let ((new (get-attribute/lname "prefer" attrs))) + (cond + ((equal new "public") :public) + ((equal new "system") :system) + ((null new) (prefer handler)))) + (prefer-stack handler)) + (push (string-or (get-attribute/lname "base" attrs) (base handler)) + (catalog-base-stack handler)) + (flet ((geturi (lname) + (puri:merge-uris + (safe-parse-uri (get-attribute/lname lname attrs)) + (base handler)))) + (cond + ((string= lname "public") + (push (list (normalize-public (get-attribute/lname "publicId" attrs)) + (geturi "uri") + (prefer handler)) + (public-entries (result handler)))) + ((string= lname "system") + (push (list (normalize-uri (get-attribute/lname "systemId" attrs)) + (geturi "uri")) + (system-entries (result handler)))) + ((string= lname "uri") + (push (list (normalize-uri (get-attribute/lname "name" attrs)) + (geturi "uri")) + (uri-entries (result handler)))) + ((string= lname "rewriteSystem") + (push (list (normalize-uri + (get-attribute/lname "systemIdStartString" attrs)) + (get-attribute/lname "rewritePrefix" attrs)) + (rewrite-system-entries (result handler)))) + ((string= lname "rewriteURI") + (push (list (normalize-uri + (get-attribute/lname "uriStartString" attrs)) + (get-attribute/lname "rewritePrefix" attrs)) + (rewrite-uri-entries (result handler)))) + ((string= lname "delegatePublic") + (push (list (normalize-public + (get-attribute/lname "publicIdStartString" attrs)) + (geturi "catalog") + (prefer handler)) + (delegate-public-entries (result handler)))) + ((string= lname "delegateSystem") + (push (list (normalize-uri + (get-attribute/lname "systemIdStartString" attrs)) + (geturi "catalog")) + (delegate-system-entries (result handler)))) + ((string= lname "delegateURI") + (push (list (normalize-uri + (get-attribute/lname "uriStartString" attrs)) + (geturi "catalog")) + (delegate-uri-entries (result handler)))) + ((string= lname "nextCatalog") + (push (geturi "catalog") + (next-catalog-entries (result handler))))))) + +(defmethod sax:end-element ((handler catalog-parser) uri lname qname) + (declare (ignore uri lname qname)) + (pop (catalog-base-stack handler)) + (pop (prefer-stack handler))) + +(defmethod sax:end-document ((handler catalog-parser)) + (result handler)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/package.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/package.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,99 @@ +;;;; package.lisp -- Paketdefinition +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. + +(in-package :cl-user) + +(defpackage :cxml + (:use :cl :runes :runes-encoding #-scl :trivial-gray-streams) + (:export + ;; xstreams + #:make-xstream + #:make-rod-xstream + #:close-xstream + #:read-rune + #:peek-rune + #:unread-rune + #:fread-rune + #:fpeek-rune + #:xstream-position + #:xstream-line-number + #:xstream-column-number + #:xstream-plist + #:xstream-encoding + + ;; xstream controller protocol + #:read-octects + #:xstream/close + + #:attribute-namespace-uri + #:attribute-local-name + #:attribute-qname + #:attribute-value + + #:parse + #:parse-file + #:parse-stream + #:parse-rod + #:parse-octets + #:parse-empty-document + + #:make-octet-vector-sink + #:make-octet-stream-sink + #:make-rod-sink + #+rune-is-character #:make-string-sink + #+rune-is-character #:make-character-stream-sink + ;; See comment in runes/package.lisp + ;; #-rune-is-character + #:make-string-sink/utf8 + ;; #-rune-is-character + #:make-character-stream-sink/utf8 + + #:with-xml-output + #:with-output-sink + #:with-namespace + #:with-element + #:with-element* + #:attribute + #:attribute* + #:unparse-attribute + #:cdata + #:text + #:doctype + + #:xml-parse-error + #:well-formedness-violation + #:validity-error + + #:parse-dtd-file + #:parse-dtd-stream + #:make-validator + + #:*cache-all-dtds* + #:*dtd-cache* + #:getdtd + #:remdtd + #:make-dtd-cache + #:clear-dtd-cache + #:make-extid + + #:*catalog* + #:*prefer* + #:make-catalog + #:resolve-uri + #:resolve-extid + + #:make-recoder + #:make-namespace-normalizer + #:make-whitespace-normalizer + #:rod-to-utf8-string + #:utf8-string-to-rod + + #:broadcast-handler + #:broadcast-handler-handlers + #:make-broadcast-handler + #:sax-proxy + #:proxy-chained-handler + + #:make-source)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/recoder.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/recoder.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,125 @@ +;;;; recoder.lisp -- SAX handler for string conversion +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Developed 2004 for headcraft - http://headcraft.de/ +;;;; Copyright: David Lichteblau + +(in-package :cxml) + +(defclass recoder () + ((recoder :initarg :recoder :accessor recoder) + (chained-handler :initarg :chained-handler :accessor chained-handler))) + +(defun make-recoder (chained-handler recoder-fn) + (make-instance 'recoder + :recoder recoder-fn + :chained-handler chained-handler)) + +(macrolet ((%string (rod) + `(let ((rod ,rod)) + (if (typep rod '(or rod string)) + (funcall (recoder handler) rod) + rod))) + (defwrapper (name (&rest args) &rest forms) + `(defmethod ,name ((handler recoder) ,@args) + (,name (chained-handler handler) ,@forms)))) + (defwrapper sax:start-document ()) + + (defwrapper sax:start-element + (namespace-uri local-name qname attributes) + (%string namespace-uri) + (%string local-name) + (%string qname) + (mapcar (lambda (attr) + (sax:make-attribute + :namespace-uri (%string (sax:attribute-namespace-uri attr)) + :local-name (%string (sax:attribute-local-name attr)) + :qname (%string (sax:attribute-qname attr)) + :value (%string (sax:attribute-value attr)) + :specified-p (sax:attribute-specified-p attr))) + attributes)) + + (defwrapper sax:start-prefix-mapping (prefix uri) + (%string prefix) + (%string uri)) + + (defwrapper sax:characters (data) + (%string data)) + + (defwrapper sax:processing-instruction (target data) + (%string target) + (%string data)) + + (defwrapper sax:end-prefix-mapping (prefix) + (%string prefix)) + + (defwrapper sax:end-element (namespace-uri local-name qname) + (%string namespace-uri) + (%string local-name) + (%string qname)) + + (defwrapper sax:end-document ()) + + (defwrapper sax:comment (data) + (%string data)) + + (defwrapper sax:start-cdata ()) + + (defwrapper sax:end-cdata ()) + + (defwrapper sax:start-dtd (name public-id system-id) + (%string name) + (%string public-id) + (%string system-id)) + + (defwrapper sax:start-internal-subset ()) + (defwrapper sax:end-internal-subset ()) + + (defwrapper sax:end-dtd ()) + + (defwrapper sax:unparsed-entity-declaration + (name public-id system-id notation-name) + (%string name) + (%string public-id) + (%string system-id) + (%string notation-name)) + + (defwrapper sax:external-entity-declaration + (kind name public-id system-id) + (%string kind) + (%string name) + (%string public-id) + (%string system-id)) + + (defwrapper sax:internal-entity-declaration + (kind name value) + kind + (%string name) + (%string value)) + + (defwrapper sax:notation-declaration + (name public-id system-id) + (%string name) + (%string public-id) + (%string system-id)) + + (defwrapper sax:element-declaration (name model) + (%string name) + model) + + (defwrapper sax:attribute-declaration + (element-name attribute-name type default) + (%string element-name) + (%string attribute-name) + (%string type) + (%string default)) + + (defwrapper sax:entity-resolver + (resolver) + resolver) + + (defwrapper sax::dtd + (dtd) + dtd)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-handler.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-handler.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,613 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: SAX; readtable: runes; Encoding: utf-8; -*- +;;; --------------------------------------------------------------------------- +;;; Title: A SAX2-like API for the xml parser +;;; Created: 2003-06-30 +;;; Author: Henrik Motakef <hmot@henrik-motakef.de> +;;; Author: David Lichteblau +;;; License: BSD +;;; --------------------------------------------------------------------------- +;;; (c) copyright 2003 by Henrik Motakef +;;; (c) copyright 2004 knowledgeTools Int. GmbH +;;; (c) copyright 2005-2007 David Lichteblau + +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions are +;;; met: +;;; +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution +;;; +;;; THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED +;;; WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +;;; MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +;;; IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, +;;; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +;;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +;;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +;;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING +;;; IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +;;; POSSIBILITY OF SUCH DAMAGE. + +;;; TODO/ Open Questions: + +;; o Missing stuff from Java SAX2: +;; * ignorable-whitespace +;; * skipped-entity +;; * The whole ErrorHandler class, this is better handled using +;; conditions (but isn't yet) + +(defpackage :sax + (:use :common-lisp) + (:export #:*namespace-processing* + #:*include-xmlns-attributes* + #:*use-xmlns-namespace* + + #:abstract-handler + #:content-handler + #:default-handler + + #:make-attribute + #:find-attribute + #:find-attribute-ns + #:attribute-namespace-uri + #:attribute-local-name + #:attribute-qname + #:attribute-value + #:attribute-specified-p + + #:start-document + #:start-prefix-mapping + #:start-element + #:characters + #:processing-instruction + #:end-element + #:end-prefix-mapping + #:end-document + #:comment + #:start-cdata + #:end-cdata + #:start-dtd + #:end-dtd + #:start-internal-subset + #:unparsed-internal-subset + #:end-internal-subset + #:unparsed-entity-declaration + #:external-entity-declaration + #:internal-entity-declaration + #:notation-declaration + #:element-declaration + #:attribute-declaration + #:entity-resolver + + #:sax-parser + #:sax-parser-mixin + #:register-sax-parser + #:line-number + #:column-number + #:system-id + #:xml-base)) + +(in-package :sax) + + +;;;; SAX-PARSER interface + +(defclass sax-parser () ()) + +(defclass sax-parser-mixin () ;deprecated + ((sax-parser :initform nil :reader sax-parser))) + +(defgeneric line-number (sax-parser) + (:documentation + "Return an approximation of the current line number, or NIL.") + (:method ((handler sax-parser-mixin)) + (if (sax-parser handler) + (line-number (sax-parser handler)) + nil))) + +(defgeneric column-number (sax-parser) + (:documentation + "Return an approximation of the current column number, or NIL.") + (:method ((handler sax-parser-mixin)) + (if (sax-parser handler) + (column-number (sax-parser handler)) + nil))) + +(defgeneric system-id (sax-parser) + (:documentation + "Return the URI of the document being parsed. This is either the + main document, or the entity's system ID while contents of a parsed + general external entity are being processed.") + (:method ((handler sax-parser-mixin)) + (if (sax-parser handler) + (system-id (sax-parser handler)) + nil))) + +(defgeneric xml-base (sax-parser) + (:documentation + "Return the [Base URI] of the current element. This URI can differ from + the value returned by SAX:SYSTEM-ID if xml:base attributes are present.") + (:method ((handler sax-parser-mixin)) + (if (sax-parser handler) + (xml-base (sax-parser handler)) + nil))) + + +;;;; Configuration variables + +;; The http://xml.org/sax/features/namespaces property +(defvar *namespace-processing* t + "If non-nil (the default), namespace processing is enabled. + +See also `start-element' and `end-element' for a detailed description +of the consequences of modifying this variable, and +`*include-xmlns-attributes*' and `*use-xmlns-namespace*' for further +related options.") + +;; The http://xml.org/sax/features/namespace-prefixes property. +(defvar *include-xmlns-attributes* t + "If non-nil, namespace declarations are reported as normal +attributes. + +This variable has no effect unless `*namespace-processing*' is +non-nil. + +See also `*use-xmlns-namespace*', and `start-element' for a detailed +description of the consequences of setting this variable.") + +(defvar *use-xmlns-namespace* t + "If this variable is nil (the default), attributes with a name like +'xmlns:x' are not considered to be in a namespace, following the +'Namespaces in XML' specification. + +If it is non-nil, such attributes are considered to be in a namespace +with the URI 'http://www.w3.org/2000/xmlns/', following an +incompatible change silently introduced in the errata to that spec, +and adopted by some W3C standards. + +For example, an attribute like xmlns:ex='http://example.com' would be +reported like this: + +*use-xmlns-namespace*: nil +namespace-uri: nil +local-name: nil +qname: #\"xmlns:ex\" + +*use-xmlns-namespace*: t +namespace-uri: #\"http://www.w3.org/2000/xmlns/\" +local-name: #\"ex\" +qname: #\"xmlns:ex\" + +Setting this variable has no effect unless both +`*namespace-processing*' and `*include-xmlns-attributes*' are non-nil.") + + +;;;; ATTRIBUTE + +(defstruct (standard-attribute (:constructor make-attribute)) + namespace-uri + local-name + qname + value + specified-p) + +(defmethod (setf attribute-namespace-uri) + (newval (attribute standard-attribute)) + (setf (standard-attribute-namespace-uri attribute) newval)) + +(defmethod (setf attribute-local-name) + (newval (attribute standard-attribute)) + (setf (standard-attribute-local-name attribute) newval)) + +(defmethod (setf attribute-qname) + (newval (attribute standard-attribute)) + (setf (standard-attribute-qname attribute) newval)) + +(defmethod (setf attribute-value) + (newval (attribute standard-attribute)) + (setf (standard-attribute-value attribute) newval)) + +(defmethod (setf attribute-specified-p) + (newval (attribute standard-attribute)) + (setf (standard-attribute-specified-p attribute) newval)) + +(defgeneric attribute-namespace-uri (attribute) + (:method ((attribute standard-attribute)) + (standard-attribute-namespace-uri attribute)) + (:method ((attribute hax:standard-attribute)) + "")) + +(defgeneric attribute-local-name (attribute) + (:method ((attribute standard-attribute)) + (standard-attribute-local-name attribute)) + (:method ((attribute hax:standard-attribute)) + (runes:rod-downcase (hax:attribute-name attribute)))) + +(defgeneric attribute-qname (attribute) + (:method ((attribute standard-attribute)) + (standard-attribute-qname attribute)) + (:method ((attribute hax:standard-attribute)) + (runes:rod-downcase (hax:attribute-name attribute)))) + +(defgeneric attribute-value (attribute) + (:method ((attribute standard-attribute)) + (standard-attribute-value attribute)) + (:method ((attribute hax:standard-attribute)) + (hax:attribute-value attribute))) + +(defgeneric attribute-specified-p (attribute) + (:method ((attribute standard-attribute)) + (standard-attribute-specified-p attribute)) + (:method ((attribute hax:standard-attribute)) + (hax:attribute-specified-p attribute))) + +(defmethod hax:attribute-name ((attribute standard-attribute)) + (attribute-local-name attribute)) + +(defmethod hax:attribute-value ((attribute standard-attribute)) + (attribute-value attribute)) + +(defmethod hax:attribute-specified-p ((attribute standard-attribute)) + (attribute-specified-p attribute)) + +(defun %rod= (x y) + ;; allow rods *and* strings *and* null + (cond + ((zerop (length x)) (zerop (length y))) + ((zerop (length y)) nil) + ((stringp x) (string= x y)) + (t (runes:rod= x y)))) + +(defun find-attribute (qname attrs) + (find qname attrs :key #'attribute-qname :test #'%rod=)) + +(defun find-attribute-ns (uri lname attrs) + (find-if (lambda (attr) + (and (%rod= uri (sax:attribute-namespace-uri attr)) + (%rod= lname (sax:attribute-local-name attr)))) + attrs)) + + +;;;; ABSTRACT-HANDLER and DEFAULT-HANDLER + +(defclass abstract-handler (sax-parser-mixin) ()) +(defclass content-handler (abstract-handler) ()) +(defclass default-handler (content-handler) ()) + + +;;;; EVENTS + +(macrolet ((define-event ((name default-handler-class) + (&rest args) + &body hax-body) + `(defgeneric ,name (handler ,@args) + (:method ((handler null) ,@args) + (declare (ignore ,@args)) + nil) + (:method ((handler t) ,@args) + (declare (ignore ,@args)) + (warn "deprecated SAX default method used by a handler ~ + that is not a subclass of SAX:ABSTRACT-HANDLER ~ + or HAX:ABSTRACT-HANDLER") + nil) + (:method ((handler abstract-handler) ,@args) + (declare (ignore ,@args)) + (error "SAX event ~A not implemented by this handler" + ',name)) + (:method ((handler ,default-handler-class) ,@args) + (declare (ignore ,@args)) + nil) + (:method ((handler hax:abstract-handler) ,@args) + (declare (ignorable ,@args)) + ,@hax-body)))) + (define-event (start-document default-handler) + () + nil) + + (define-event (start-element default-handler) + (namespace-uri local-name qname attributes) + (setf attributes + (remove "http://www.w3.org/2000/xmlns/" + attributes + :key #'attribute-namespace-uri + :test #'equal)) + (hax:start-element handler local-name attributes)) + + (define-event (start-prefix-mapping content-handler) + (prefix uri) + nil) + + (define-event (characters default-handler) + (data) + (hax:characters handler data)) + + (define-event (processing-instruction default-handler) + (target data) + nil) + + (define-event (end-prefix-mapping content-handler) + (prefix) + nil) + + (define-event (end-element default-handler) + (namespace-uri local-name qname) + (hax:end-element handler local-name)) + + (define-event (end-document default-handler) + () + (hax:end-document handler)) + + (define-event (comment content-handler) + (data) + (hax:comment handler data)) + + (define-event (start-cdata content-handler) + () + nil) + + (define-event (end-cdata content-handler) + () + nil) + + (define-event (start-dtd content-handler) + (name public-id system-id) + (hax:start-document handler name public-id system-id)) + + (define-event (end-dtd content-handler) + () + nil) + + (define-event (start-internal-subset content-handler) + () + nil) + + (define-event (end-internal-subset content-handler) + () + nil) + + (define-event (unparsed-internal-subset content-handler) + (str) + nil) + + (define-event (unparsed-entity-declaration content-handler) + (name public-id system-id notation-name) + nil) + + (define-event (external-entity-declaration content-handler) + (kind name public-id system-id) + nil) + + (define-event (internal-entity-declaration content-handler) + (kind name value) + nil) + + (define-event (notation-declaration content-handler) + (name public-id system-id) + nil) + + (define-event (element-declaration content-handler) + (name model) + nil) + + (define-event (attribute-declaration content-handler) + (element-name attribute-name type default) + nil) + + (define-event (entity-resolver content-handler) + (resolver) + nil) + + (define-event (dtd content-handler) + (dtd) + nil)) + +;;; special case: this method is defined on abstract-handler through +;;; sax-parser-mixin +(defgeneric register-sax-parser (handler sax-parser) + (:method ((handler null) sax-parser) + (declare (ignore sax-parser)) + nil) + (:method ((handler sax-parser-mixin) sax-parser) + (setf (slot-value handler 'sax-parser) sax-parser)) + (:method ((handler t) sax-parser) + (declare (ignore sax-parser)) + (warn "deprecated sax default method used by a handler ~ + that is not a subclass of sax:abstract-handler ~ + or hax:abstract-handler") + nil) + (:method ((handler hax:abstract-handler) sax-parser) + (declare (ignorable sax-parser)) nil)) + + +;;;; HAX to SAX + +(defmethod hax:start-document ((handler abstract-handler) name pubid sysid) + (sax:start-document handler) + (when sysid + (sax:start-dtd handler name pubid sysid) + (sax:end-dtd handler))) + +(defmethod hax:start-element ((handler abstract-handler) name attributes) + (setf name (runes:rod-downcase name)) + (when (equal name "html") + (sax:start-prefix-mapping handler "" "http://www.w3.org/1999/xhtml") + (when *include-xmlns-attributes* + (push (make-attribute :namespace-uri "http://www.w3.org/2000/xmlns/" + :local-name nil + :qname "xmlns" + :value "http://www.w3.org/1999/xhtml" + :specified-p t) + attributes))) + (sax:start-element handler + "http://www.w3.org/1999/xhtml" + name + name + attributes)) + +(defmethod hax:end-element ((handler abstract-handler) name) + (setf name (runes:rod-downcase name)) + (sax:end-element handler + "http://www.w3.org/1999/xhtml" + name + name) + (when (equal name "html") + (sax:end-prefix-mapping handler ""))) + +(defmethod hax:characters ((handler abstract-handler) data) + (sax:characters handler data)) + +(defmethod hax:comment ((handler abstract-handler) str) + (sax:comment handler str)) + +(defmethod hax:end-document ((handler abstract-handler)) + (sax:end-document handler)) + + + +;;;; Documentation + +(setf (documentation 'start-document 'function) + "Called at the beginning of the parsing process, +before any element, processing instruction or comment is reported. + +Handlers that need to maintain internal state may use this to perform +any neccessary initializations.") + +(setf (documentation 'start-element 'function) + "Called to report the beginning of an element. + +There will always be a corresponding call to end-element, even in the +case of an empty element (i.e. <foo/>). + +If the value of *namespaces* is non-nil, namespace-uri, local-name and +qname are rods. If it is nil, namespace-uri and local-name are always +nil, and it is not an error if the qname is not a well-formed +qualified element name (for example, if it contains more than one +colon). + +The attributes parameter is a list (in arbitrary order) of instances +of the `attribute' structure class. The for their namespace-uri and +local-name properties, the same rules as for the element name +apply. Additionally, namespace-declaring attributes (those whose name +is \"xmlns\" or starts with \"xmlns:\") are only included if +*include-xmlns-attributes* is non-nil.") + +(setf (documentation 'start-prefix-mapping 'function) + "Called when the scope of a new prefix -> namespace-uri mapping begins. + +This will always be called immediatly before the `start-element' event +for the element on which the namespaces are declared. + +Clients don't usually have to implement this except under special +circumstances, for example when they have to deal with qualified names +in textual content. The parser will handle namespaces of elements and +attributes on its own.") + +(setf (documentation 'characters 'function) + "Called for textual element content. + +The data is passed as a rod, with all entity references resolved. +It is possible that the character content of an element is reported +via multiple subsequent calls to this generic function.") + +(setf (documentation 'processing-instruction 'function) + "Called when a processing instruction is read. + +Both target and data are rods.") + +(setf (documentation 'end-prefix-mapping 'function) + "Called when a prefix -> namespace-uri mapping goes out of scope. + +This will always be called immediatly after the `end-element' event +for the element on which the namespace is declared. The order of the +end-prefix-mapping events is otherwise not guaranteed. + +Clients don't usually have to implement this except under special +circumstances, for example when they have to deal with qualified names +in textual content. The parser will handle namespaces of elements and +attributes on its own.") + +(setf (documentation 'end-element 'function) + "Called to report the end of an element. + +See the documentation for `start-element' for a description of the +parameters.") + +(setf (documentation 'end-document 'function) + "Called at the end of parsing a document. +This is always the last function called in the parsing process. + +In contrast to all of the other methods, the return value of this gf +is significant, it will be returned by the parse-file/stream/string function.") + +(setf (documentation 'start-cdata 'function) + "Called at the beginning of parsing a CDATA section. + +Handlers only have to implement this if they are interested in the +lexical structure of the parsed document. The content of the CDATA +section is reported via the `characters' generic function like all +other textual content.") + +(setf (documentation 'end-cdata 'function) + "Called at the end of parsing a CDATA section. + +Handlers only have to implement this if they are interested in the +lexical structure of the parsed document. The content of the CDATA +section is reported via the `characters' generic function like all +other textual content.") + +(setf (documentation 'start-dtd 'function) + "Called at the beginning of parsing a DTD.") + +(setf (documentation 'end-dtd 'function) + "Called at the end of parsing a DTD.") + +(setf (documentation 'start-internal-subset 'function) + "Reports that an internal subset is present. Called before +any definition from the internal subset is reported.") + +(setf (documentation 'end-internal-subset 'function) + "Called after processing of the internal subset has +finished, if present.") + +(setf (documentation 'unparsed-internal-subset 'function) + "Reports that an internal subset is present, but has not +been parsed and is available as a string.") + +(setf (documentation 'unparsed-entity-declaration 'function) + "Called when an unparsed entity declaration is seen in a DTD.") + +(setf (documentation 'external-entity-declaration 'function) + "Called when a parsed external entity declaration is seen in a DTD.") + +(setf (documentation 'internal-entity-declaration 'function) + "Called when an internal entity declaration is seen in a DTD.") + +(setf (documentation 'notation-declaration 'function) + "Called when a notation declaration is seen while parsing a DTD.") + +(setf (documentation 'element-declaration 'function) + "Called when a element declaration is seen in a DTD. Model is not a string, + but a nested list, with *, ?, +, OR, and AND being the operators, rods + as names, :EMPTY and :PCDATA as special tokens. (AND represents + sequences.)") + +(setf (documentation 'attribute-declaration 'function) + "Called when an attribute declaration is seen in a DTD. + type one of :CDATA, :ID, :IDREF, :IDREFS, + :ENTITY, :ENTITIES, :NMTOKEN, :NMTOKENS, + (:NOTATION <name>*), or (:ENUMERATION <name>*) + default :REQUIRED, :IMPLIED, (:FIXED content), or (:DEFAULT content)") + +(setf (documentation 'entity-resolver 'function) + "Called between sax:end-dtd and sax:end-document to register an entity + resolver, a function of two arguments: An entity name and SAX handler. + When called, the resolver function will parse the named entity's data.") + +(setf (documentation 'register-sax-parser 'function) + "Set the SAX-PARSER instance of this handler.") Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-proxy.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-proxy.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,68 @@ +;;;; sax-proxy.lisp +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Copyright (c) 2004 David Lichteblau +;;;; Author: David Lichteblau + +(in-package :cxml) + +(defclass broadcast-handler (sax:abstract-handler) + ((handlers :initform nil + :initarg :handlers + :accessor broadcast-handler-handlers))) + +(defun make-broadcast-handler (&rest handlers) + (make-instance 'broadcast-handler :handlers handlers)) + +(defclass sax-proxy (broadcast-handler) + ()) + +(defmethod initialize-instance + :after ((instance sax-proxy) &key chained-handler) + (setf (proxy-chained-handler instance) chained-handler)) + +(defmethod proxy-chained-handler ((instance sax-proxy)) + (car (broadcast-handler-handlers instance))) + +(defmethod (setf proxy-chained-handler) (newval (instance sax-proxy)) + (setf (broadcast-handler-handlers instance) (list newval))) + +#-rune-is-character +(defmethod hax:%want-strings-p ((handler broadcast-handler)) + (hax:%want-strings-p (car (broadcast-handler-handlers instance)))) + +(macrolet ((define-proxy-method (name (&rest args)) + `(defmethod ,name ((handler broadcast-handler) ,@args) + (let (result) + (dolist (next (broadcast-handler-handlers handler)) + (setf result (,name next ,@args))) + result)))) + (define-proxy-method sax:start-document ()) + (define-proxy-method sax:start-element (uri lname qname attributes)) + (define-proxy-method sax:start-prefix-mapping (prefix uri)) + (define-proxy-method sax:characters (data)) + (define-proxy-method sax:processing-instruction (target data)) + (define-proxy-method sax:end-prefix-mapping (prefix)) + (define-proxy-method sax:end-element (namespace-uri local-name qname)) + (define-proxy-method sax:end-document ()) + (define-proxy-method sax:comment (data)) + (define-proxy-method sax:start-cdata ()) + (define-proxy-method sax:end-cdata ()) + (define-proxy-method sax:start-dtd (name public-id system-id)) + (define-proxy-method sax:end-dtd ()) + (define-proxy-method sax:start-internal-subset ()) + (define-proxy-method sax:end-internal-subset ()) + (define-proxy-method sax:unparsed-entity-declaration (name pub sys not)) + (define-proxy-method sax:external-entity-declaration (kind name pub sys)) + (define-proxy-method sax:internal-entity-declaration (kind name value)) + (define-proxy-method sax:notation-declaration (name public-id system-id)) + (define-proxy-method sax:element-declaration (name model)) + (define-proxy-method sax:attribute-declaration (elt attr type default)) + (define-proxy-method sax:entity-resolver (resolver)) + (define-proxy-method sax::dtd (dtd))) + +(defmethod sax:register-sax-parser :after ((handler broadcast-handler) parser) + (dolist (next (broadcast-handler-handlers handler)) + (sax:register-sax-parser next parser))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/event-collecting-handler.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/event-collecting-handler.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,37 @@ +(in-package :sax-tests) + +(defclass event-collecting-handler () + ((event-list :initform '() :accessor event-list))) + +(defmethod start-document ((handler event-collecting-handler)) + (push (list :start-document) (event-list handler))) + +(defmethod start-element ((handler event-collecting-handler) ns-uri local-name qname attrs) + (push (list :start-element ns-uri local-name qname attrs) + (event-list handler))) + +(defmethod start-prefix-mapping ((handler event-collecting-handler) prefix uri) + (push (list :start-prefix-mapping prefix uri) + (event-list handler))) + +(defmethod characters ((handler event-collecting-handler) data) + (push (list :characters data) + (event-list handler))) + +(defmethod processing-instruction ((handler event-collecting-handler) target data) + (push (list :processing-instruction target data) + (event-list handler))) + +(defmethod end-prefix-mapping ((handler event-collecting-handler) prefix) + (push (list :end-prefix-mapping prefix) + (event-list handler))) + +(defmethod end-element ((handler event-collecting-handler) namespace-uri local-name qname) + (push (list :end-element namespace-uri local-name qname) + (event-list handler))) + +(defmethod end-document ((handler event-collecting-handler)) + (push (list :end-document) + (event-list handler)) + + (nreverse (event-list handler))) \ No newline at end of file Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/package.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/package.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,4 @@ +(defpackage :sax-tests + (:use :cl :xml :sax :glisp :rt) + (:export #:event-collecting-handler)) + Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/tests.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/sax-tests/tests.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,330 @@ +(in-package :sax-tests) + +(defun first-start-element-event (string) + (let ((events (cxml:parse-rod string (make-instance 'event-collecting-handler)))) + (find :start-element events :key #'car))) + + +;;; Attribute handling + +(deftest no-default-namespace-for-attributes + (let* ((evt (first-start-element-event "<x xmlns='http://example.com' a='b'/>")) + (attr (car (fifth evt)))) + (values + (attribute-namespace-uri attr) + (attribute-local-name attr))) + nil nil) + +(deftest attribute-uniqueness-1 + (handler-case + (cxml:parse-rod "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest attribute-uniqueness-2 + (handler-case + (cxml:parse-rod "<x xmlns:a='http://example.com' xmlns='http://example.com' a:a='1' a='1'/>") + (error () nil) + (:no-error (&rest junk) + (declare (ignore junk)) + t)) + t) + +(deftest attribute-uniqueness-3 + (let ((sax:*namespace-processing* nil)) + (handler-case + (cxml:parse-rod "<x xmlns:a='http://example.com' xmlns:b='http://example.com' a:a='1' b:a='1'/>") + (error () nil) + (:no-error (&rest junk) + (declare (ignore junk)) + t))) + t) + +;;; Namespace undeclaring + +(deftest undeclare-default-namespace-1 + (let* ((evts (cxml:parse-rod "<x xmlns='http://example.com'><y xmlns='' a='1'/></x>" + (make-instance 'event-collecting-handler))) + (start-elt-events (remove :start-element evts :test (complement #'eql) :key #'car)) + (evt1 (first start-elt-events)) + (evt2 (second start-elt-events ))) + (values + (rod= #"http://example.com" (second evt1)) + (second evt2) + (third evt2))) + t nil nil) + +(deftest undeclare-other-namespace + (handler-case + (cxml:parse-rod "<x:x xmlns:x='http://example.com'><x:y xmlns:x='' a='1'/></x:x>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + + +;;; Require names otherwise totally out of scope of the xmlns rec to be NcNames for no reason + +(deftest pi-names-are-ncnames-when-namespace-processing-1 + (handler-case + (cxml:parse-rod "<?a:b c?><x/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest pi-names-are-ncnames-when-namespace-processing-2 + (let ((sax:*namespace-processing* nil)) + (handler-case + (cxml:parse-rod "<?a:b c?><x/>") + (error () nil) + (:no-error (&rest junk) + (declare (ignore junk)) + t))) + t) + +(deftest entity-names-are-ncnames-when-namespace-processing-1 + (handler-case + (cxml:parse-rod "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest entity-names-are-ncnames-when-namespace-processing-2 + (handler-case + (cxml:parse-rod "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest entity-names-are-ncnames-when-namespace-processing-3 + (let ((sax:*namespace-processing* nil)) + (handler-case + (cxml:parse-rod "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x>&y:z;</x>") + (error () nil) + (:no-error (&rest junk) + (declare (ignore junk)) + t))) + t) + +(deftest entity-names-are-ncnames-when-namespace-processing-4 + (let ((sax:*namespace-processing* nil)) + (handler-case + (cxml:parse-rod "<!DOCTYPE x [ <!ENTITY y:z 'foo'> ]><x/>") + (error () nil) + (:no-error (&rest junk) + (declare (ignore junk)) + t))) + t) + +;;; Inclusion of xmlns attributes + +(deftest xmlns-attr-include-1 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (evt (first-start-element-event "<x xmlns='http://example.com'/>")) + (attrs (fifth evt))) + (length attrs)) + 1) + +(deftest xmlns-attr-discard-1 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* nil) + (evt (first-start-element-event "<x xmlns='http://example.com'/>")) + (attrs (fifth evt))) + (length attrs)) + 0) + +;;; Namespace of xmlns attributes + +(deftest xmlns-attr-ns-uri-1 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* nil) + (evt (first-start-element-event "<x xmlns='http://example.com'/>")) + (attrs (fifth evt))) + (attribute-namespace-uri (car attrs))) + nil) + +(deftest xmlns-attr-ns-uri-2 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* nil) + (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>")) + (attrs (fifth evt))) + (attribute-namespace-uri (car attrs))) + nil) + +(deftest xmlns-attr-ns-uri-3 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* t) + (evt (first-start-element-event "<x xmlns='http://example.com'/>")) + (attrs (fifth evt))) + (attribute-namespace-uri (car attrs))) + nil) + +(deftest xmlns-attr-ns-uri-4 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* t) + (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>")) + (attrs (fifth evt))) + (rod= #"http://www.w3.org/2000/xmlns/" (attribute-namespace-uri (car attrs)))) + t) + +(deftest xmlns-attr-ns-local-name-1 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* nil) + (evt (first-start-element-event "<x xmlns='http://example.com'/>")) + (attrs (fifth evt))) + (attribute-local-name (car attrs))) + nil) + +(deftest xmlns-attr-ns-local-name-2 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* nil) + (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>")) + (attrs (fifth evt))) + (attribute-local-name (car attrs))) + nil) + +(deftest xmlns-attr-ns-local-name-3 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* t) + (evt (first-start-element-event "<x xmlns='http://example.com'/>")) + (attrs (fifth evt))) + (attribute-local-name (car attrs))) + nil) + +(deftest xmlns-attr-ns-local-name-4 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* t) + (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>")) + (attrs (fifth evt))) + (rod= #"foo" (attribute-local-name (car attrs)))) + t) + +(deftest xmlns-attr-qname-1 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* nil) + (evt (first-start-element-event "<x xmlns='http://example.com'/>")) + (attrs (fifth evt))) + (rod= #"xmlns" (attribute-qname (car attrs)))) + t) + +(deftest xmlns-attr-qname-2 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* nil) + (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>")) + (attrs (fifth evt))) + (rod= #"xmlns:foo" (attribute-qname (car attrs)))) + t) + +(deftest xmlns-attr-qname-4 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* t) + (evt (first-start-element-event "<x xmlns='http://example.com'/>")) + (attrs (fifth evt))) + (rod= #"xmlns" (attribute-qname (car attrs)))) + t) + +(deftest xmlns-attr-qname-4 + (let* ((sax:*namespace-processing* t) + (sax:*include-xmlns-attributes* t) + (sax:*use-xmlns-namespace* t) + (evt (first-start-element-event "<x xmlns:foo='http://example.com'/>")) + (attrs (fifth evt))) + (rod= #"xmlns:foo" (attribute-qname (car attrs)))) + t) + + +;;; Predefined Namespaces + +(deftest redefine-xml-namespace-1 + (handler-case + (cxml:parse-rod "<x xmlns:xml='http://www.w3.org/XML/1998/namespace'/>") + (error () nil) + (:no-error (&rest junk) + (declare (ignore junk)) + t)) + t) + +(deftest redefine-xml-namespace-2 + (handler-case + (cxml:parse-rod "<x xmlns:xml='http://example.com/wrong-uri'/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest redefine-xml-namespace-3 + (handler-case + (cxml:parse-rod "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest redefine-xml-namespace-4 + (handler-case + (cxml:parse-rod "<x xmlns:wrong='http://www.w3.org/XML/1998/namespace'/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest redefine-xmlns-namespace-1 + (handler-case + (cxml:parse-rod "<x xmlns:xmlns='http://www.w3.org/2000/xmlns/'/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest redefine-xmlns-namespace-2 + (handler-case + (cxml:parse-rod "<x xmlns:xmlns='http://example.com/wrong-ns'/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest redefine-xmlns-namespace-3 + (handler-case + (cxml:parse-rod "<x xmlns:wrong='http://www.w3.org/2000/xmlns/'/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) + +(deftest redefine-xmlns-namespace-4 + (handler-case + (cxml:parse-rod "<x xmlns='http://www.w3.org/2000/xmlns/'/>") + (error () t) + (:no-error (&rest junk) + (declare (ignore junk)) + nil)) + t) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/space-normalizer.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/space-normalizer.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,62 @@ +;;;; space-normalizer.lisp -- whitespace removal +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Copyright (c) 2005 David Lichteblau + +(in-package :cxml) + +(defclass whitespace-normalizer (sax-proxy) + ((attributes :initform '(t) :accessor xml-space-attributes) + (models :initform nil :accessor xml-space-models) + (dtd :initarg :dtd :accessor xml-space-dtd))) + +(defun make-whitespace-normalizer (chained-handler &optional dtd) + (make-instance 'whitespace-normalizer + :dtd dtd + :chained-handler chained-handler)) + +(defmethod sax::dtd ((handler whitespace-normalizer) dtd) + (unless (xml-space-dtd handler) + (setf (xml-space-dtd handler) dtd))) + +(defmethod sax:start-element + ((handler whitespace-normalizer) uri lname qname attrs) + (declare (ignore uri lname)) + (let ((dtd (xml-space-dtd handler))) + (when dtd + (let ((xml-space + (sax:find-attribute (if (stringp qname) "xml:space" #"xml:space") + attrs))) + (push (if xml-space + (rod= (rod (sax:attribute-value xml-space)) #"default") + (car (xml-space-attributes handler))) + (xml-space-attributes handler))) + (let* ((e (cxml::find-element (rod qname) dtd)) + (cspec (when e (cxml::elmdef-content e)))) + (push (and (consp cspec) + (not (and (eq (car cspec) '*) + (let ((subspec (second cspec))) + (and (eq (car subspec) 'or) + (eq (cadr subspec) :PCDATA)))))) + (xml-space-models handler))))) + (call-next-method)) + +(defmethod sax:characters ((handler whitespace-normalizer) data) + (cond + ((and (xml-space-dtd handler) + (car (xml-space-attributes handler)) + (car (xml-space-models handler))) + (unless (every #'white-space-rune-p (rod data)) + (warn "non-whitespace character data in element content") + (call-next-method))) + (t + (call-next-method)))) + +(defmethod sax:end-element ((handler whitespace-normalizer) uri lname qname) + (declare (ignore uri lname qname)) + (when (xml-space-dtd handler) + (pop (xml-space-attributes handler)) + (pop (xml-space-models handler))) + (call-next-method)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/split-sequence.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/split-sequence.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,44 @@ +;;; This code was based on Arthur Lemmens' in +;;; <URL:http://groups.google.com/groups?as_umsgid=39F36F1A.B8F19D20%40simplex.nl>; + +(in-package :cxml) + +(defun split-sequence-if (predicate seq &key (count nil) (remove-empty-subseqs nil) (from-end nil) (start 0) (end nil) (key nil key-supplied)) + (let ((len (length seq)) + (other-keys (when key-supplied + (list :key key)))) + (unless end (setq end len)) + (if from-end + (loop for right = end then left + for left = (max (or (apply #'position-if predicate seq + :end right + :from-end t + other-keys) + -1) + (1- start)) + unless (and (= right (1+ left)) + remove-empty-subseqs) ; empty subseq we don't want + if (and count (>= nr-elts count)) + ;; We can't take any more. Return now. + return (values (nreverse subseqs) right) + else + collect (subseq seq (1+ left) right) into subseqs + and sum 1 into nr-elts + until (< left start) + finally (return (values (nreverse subseqs) (1+ left)))) + (loop for left = start then (+ right 1) + for right = (min (or (apply #'position-if predicate seq + :start left + other-keys) + len) + end) + unless (and (= right left) + remove-empty-subseqs) ; empty subseq we don't want + if (and count (>= nr-elts count)) + ;; We can't take any more. Return now. + return (values subseqs left) + else + collect (subseq seq left right) into subseqs + and sum 1 into nr-elts + until (>= right end) + finally (return (values subseqs right)))))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/unparse.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/unparse.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,684 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CXML; readtable: runes; Encoding: utf-8; -*- +;;; --------------------------------------------------------------------------- +;;; Title: Unparse XML +;;; Title: (including support for canonic XML according to J.Clark) +;;; Created: 1999-09-09 +;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;; Author: David Lichteblau <david@lichteblau.com> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1999 by Gilbert Baumann +;;; (c) copyright 2004 by knowledgeTools Int. GmbH +;;; (c) copyright 2004 by David Lichteblau (for headcraft.de) + +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Library General Public +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +(in-package :cxml) + +;; +;; | Canonical XML +;; | ============= +;; | +;; | This document defines a subset of XML called canonical XML. The +;; | intended use of canonical XML is in testing XML processors, as a +;; | representation of the result of parsing an XML document. +;; | +;; | Every well-formed XML document has a unique structurally equivalent +;; | canonical XML document. Two structurally equivalent XML documents have +;; | a byte-for-byte identical canonical XML document. Canonicalizing an +;; | XML document requires only information that an XML processor is +;; | required to make available to an application. +;; | +;; | A canonical XML document conforms to the following grammar: +;; | +;; | CanonXML ::= Pi* element Pi* +;; | element ::= Stag (Datachar | Pi | element)* Etag +;; | Stag ::= '<' Name Atts '>' +;; | Etag ::= '</' Name '>' +;; | Pi ::= '<?' Name ' ' (((Char - S) Char*)? - (Char* '?>' Char*)) '?>' +;; | Atts ::= (' ' Name '=' '"' Datachar* '"')* +;; | Datachar ::= '&' | '<' | '>' | '"' +;; | | ' '| ' '| ' ' +;; | | (Char - ('&' | '<' | '>' | '"' | #x9 | #xA | #xD)) +;; | Name ::= (see XML spec) +;; | Char ::= (see XML spec) +;; | S ::= (see XML spec) +;; | +;; | Attributes are in lexicographical order (in Unicode bit order). +;; | +;; | A canonical XML document is encoded in UTF-8. +;; | +;; | Ignorable white space is considered significant and is treated +;; | equivalently to data. +;; +;; -- James Clark (jjc@jclark.com) + + +;;;; SINK: an xml output sink + +(defclass sink (sax:content-handler) + ((ystream :initarg :ystream :accessor sink-ystream) + (width :initform 79 :initarg :width :accessor width) + (canonical :initform nil :initarg :canonical :accessor canonical) + (indentation :initform nil :initarg :indentation :accessor indentation) + (current-indentation :initform 0 :accessor current-indentation) + (notations :initform (make-buffer :element-type t) :accessor notations) + (name-for-dtd :accessor name-for-dtd) + (previous-notation :initform nil :accessor previous-notation) + (have-doctype :initform nil :accessor have-doctype) + (have-internal-subset :initform nil :accessor have-internal-subset) + (stack :initform nil :accessor stack))) + +#-rune-is-character +(defmethod hax:%want-strings-p ((handler sink)) + nil) + +(defmethod initialize-instance :after ((instance sink) &key) + (when (eq (canonical instance) t) + (setf (canonical instance) 1)) + (unless (member (canonical instance) '(nil 1 2)) + (error "Invalid canonical form: ~A" (canonical instance))) + (when (and (canonical instance) (indentation instance)) + (error "Cannot indent XML in canonical mode"))) + +(defun make-buffer (&key (element-type '(unsigned-byte 8))) + (make-array 1 + :element-type element-type + :adjustable t + :fill-pointer 0)) + +;; bisschen unschoen hier die ganze api zu duplizieren, aber die +;; ystreams sind noch undokumentiert +(macrolet ((define-maker (make-sink make-ystream &rest args) + `(defun ,make-sink (,@args &rest initargs) + (apply #'make-instance + 'sink + :ystream (,make-ystream ,@args) + initargs)))) + (define-maker make-octet-vector-sink make-octet-vector-ystream) + (define-maker make-octet-stream-sink make-octet-stream-ystream stream) + (define-maker make-rod-sink make-rod-ystream) + + #+rune-is-character + (define-maker make-character-stream-sink make-character-stream-ystream stream) + + #-rune-is-character + (define-maker make-string-sink/utf8 make-string-ystream/utf8) + + #-rune-is-character + (define-maker make-character-stream-sink/utf8 + make-character-stream-ystream/utf8 + stream)) + +#+rune-is-character +(defun make-string-sink (&rest args) (apply #'make-rod-sink args)) + + +(defmethod sax:end-document ((sink sink)) + (close-ystream (sink-ystream sink))) + + +;;;; doctype and notations + +(defmethod sax:start-document ((sink sink)) + (unless (canonical sink) + (%write-rod #"<?xml version=\"1.0\" encoding=\"UTF-8\"?>" sink) + (%write-rune #/U+000A sink))) + +(defmethod sax:start-dtd ((sink sink) name public-id system-id) + (setf (name-for-dtd sink) name) + (unless (canonical sink) + (ensure-doctype sink public-id system-id))) + +(defun ensure-doctype (sink &optional public-id system-id) + (unless (have-doctype sink) + (setf (have-doctype sink) t) + (%write-rod #"<!DOCTYPE " sink) + (%write-rod (name-for-dtd sink) sink) + (cond + ((not (zerop (length public-id))) + (%write-rod #" PUBLIC \"" sink) + (unparse-string public-id sink) + (%write-rod #"\" \"" sink) + (unparse-string system-id sink) + (%write-rod #"\"" sink)) + ((not (zerop (length system-id))) + (%write-rod #" SYSTEM \"" sink) + (unparse-string system-id sink) + (%write-rod #"\"" sink))))) + +(defmethod sax:start-internal-subset ((sink sink)) + (when (have-internal-subset sink) + (error "duplicate internal subset")) + (setf (have-internal-subset sink) t) + (ensure-doctype sink) + (%write-rod #" [" sink) + (%write-rune #/U+000A sink)) + +(defmethod sax:end-internal-subset ((sink sink)) + (ensure-doctype sink) + (%write-rod #"]" sink)) + +(defmethod sax:unparsed-internal-subset ((sink sink) str) + (when (have-internal-subset sink) + (error "duplicate internal subset")) + (setf (have-internal-subset sink) t) + (ensure-doctype sink) + (%write-rod #" [" sink) + (%write-rune #/U+000A sink) + (%write-rod str sink) + (%write-rod #"]" sink)) + +;; for the benefit of the XML test suite, prefer ' over " +(defun write-quoted-rod (x sink) + (let ((q (if (find #/' x) #/" #/' + ;; '" (thanks you Emacs indentation, the if ends here) + ))) + (%write-rune q sink) + (%write-rod x sink) + (%write-rune q sink))) + +(defmethod sax:notation-declaration ((sink sink) name public-id system-id) + (let ((prev (previous-notation sink))) + (when (and (and (canonical sink) (>= (canonical sink) 2)) + prev + (not (rod< prev name))) + (error "misordered notations; cannot unparse canonically")) + (setf (previous-notation sink) name)) + (%write-rod #"<!NOTATION " sink) + (%write-rod name sink) + (cond + ((zerop (length public-id)) + (%write-rod #" SYSTEM " sink) + (write-quoted-rod system-id sink)) + ((zerop (length system-id)) + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id sink)) + (t + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id sink) + (%write-rod #" " sink) + (write-quoted-rod system-id sink))) + (%write-rune #/> sink) + (%write-rune #/U+000A sink)) + +(defmethod sax:unparsed-entity-declaration + ((sink sink) name public-id system-id notation-name) + (unless (and (canonical sink) (< (canonical sink) 3)) + (%write-rod #"<!ENTITY " sink) + (%write-rod name sink) + (cond + ((zerop (length public-id)) + (%write-rod #" SYSTEM " sink) + (write-quoted-rod system-id sink)) + ((zerop (length system-id)) + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id sink)) + (t + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id sink) + (%write-rod #" " sink) + (write-quoted-rod system-id sink))) + (%write-rod #" NDATA " sink) + (%write-rod notation-name sink) + (%write-rune #/> sink) + (%write-rune #/U+000A sink))) + +(defmethod sax:external-entity-declaration + ((sink sink) kind name public-id system-id) + (when (canonical sink) + (error "cannot serialize parsed entities in canonical mode")) + (%write-rod #"<!ENTITY " sink) + (when (eq kind :parameter) + (%write-rod #" % " sink)) + (%write-rod name sink) + (cond + ((zerop (length public-id)) + (%write-rod #" SYSTEM " sink) + (write-quoted-rod system-id sink)) + ((zerop (length system-id)) + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id sink)) + (t + (%write-rod #" PUBLIC " sink) + (write-quoted-rod public-id sink) + (%write-rod #" " sink) + (write-quoted-rod system-id sink))) + (%write-rune #/> sink) + (%write-rune #/U+000A sink)) + +(defmethod sax:internal-entity-declaration ((sink sink) kind name value) + (when (canonical sink) + (error "cannot serialize parsed entities in canonical mode")) + (%write-rod #"<!ENTITY " sink) + (when (eq kind :parameter) + (%write-rod #" % " sink)) + (%write-rod name sink) + (%write-rune #/U+0020 sink) + (%write-rune #/\" sink) + (unparse-dtd-string value sink) + (%write-rune #/\" sink) + (%write-rune #/> sink) + (%write-rune #/U+000A sink)) + +(defmethod sax:element-declaration ((sink sink) name model) + (when (canonical sink) + (error "cannot serialize element type declarations in canonical mode")) + (%write-rod #"<!ELEMENT " sink) + (%write-rod name sink) + (%write-rune #/U+0020 sink) + (labels ((walk (m) + (cond + ((eq m :EMPTY) + (%write-rod "EMPTY" sink)) + ((eq m :PCDATA) + (%write-rod "#PCDATA" sink)) + ((atom m) + (unparse-string m sink)) + (t + (ecase (car m) + (and + (%write-rune #/\( sink) + (loop for (n . rest) on (cdr m) do + (walk n) + (when rest + (%write-rune #\, sink))) + (%write-rune #/\) sink)) + (or + (%write-rune #/\( sink) + (loop for (n . rest) on (cdr m) do + (walk n) + (when rest + (%write-rune #\| sink))) + (%write-rune #/\) sink)) + (* + (walk (second m)) + (%write-rod #/* sink)) + (+ + (walk (second m)) + (%write-rod #/+ sink)) + (? + (walk (second m)) + (%write-rod #/? sink))))))) + (walk model)) + (%write-rune #/> sink) + (%write-rune #/U+000A sink)) + +(defmethod sax:attribute-declaration ((sink sink) ename aname type default) + (when (canonical sink) + (error "cannot serialize attribute type declarations in canonical mode")) + (%write-rod #"<!ATTLIST " sink) + (%write-rod ename sink) + (%write-rune #/U+0020 sink) + (%write-rod aname sink) + (%write-rune #/U+0020 sink) + (cond + ((atom type) + (%write-rod (rod (string-upcase (symbol-name type))) sink)) + (t + (when (eq :NOTATION (car type)) + (%write-rod #"NOTATION " sink)) + (%write-rune #/\( sink) + (loop for (n . rest) on (cdr type) do + (%write-rod n sink) + (when rest + (%write-rune #\| sink))) + (%write-rune #/\) sink))) + (%write-rune #/U+0020 sink) + (cond + ((atom default) + (%write-rune #/# sink) + (%write-rod (rod (string-upcase (symbol-name default))) sink)) + (t + (when (eq :FIXED (car default)) + (%write-rod #"#FIXED " sink)) + (%write-rune #/\" sink) + (unparse-string (second default) sink) + (%write-rune #/\" sink))) + (%write-rune #/> sink) + (%write-rune #/U+000A sink)) + +(defmethod sax:end-dtd ((sink sink)) + (when (have-doctype sink) + (%write-rod #">" sink) + (%write-rune #/U+000A sink))) + + +;;;; elements + +(defstruct (tag (:constructor make-tag (name))) + name + (n-children 0) + (have-gt nil)) + +(defun sink-fresh-line (sink) + (unless (zerop (ystream-column (sink-ystream sink))) + (%write-rune #/U+000A sink) ;newline + (indent sink))) + +(defun maybe-close-tag (sink) + (let ((tag (car (stack sink)))) + (when (and (tag-p tag) (not (tag-have-gt tag))) + (setf (tag-have-gt tag) t) + (%write-rune #/> sink)))) + +(defmethod sax:start-element + ((sink sink) namespace-uri local-name qname attributes) + (declare (ignore namespace-uri local-name)) + (maybe-close-tag sink) + (when (stack sink) + (incf (tag-n-children (first (stack sink))))) + (push (make-tag qname) (stack sink)) + (when (indentation sink) + (sink-fresh-line sink) + (start-indentation-block sink)) + (%write-rune #/< sink) + (%write-rod qname sink) + (dolist (a (if (canonical sink) + (sort (copy-list attributes) + #'rod< + :key #'sax:attribute-qname) + attributes)) + (%write-rune #/space sink) + (%write-rod (sax:attribute-qname a) sink) + (%write-rune #/= sink) + (%write-rune #/\" sink) + (unparse-string (sax:attribute-value a) sink) + (%write-rune #/\" sink)) + (when (canonical sink) + (maybe-close-tag sink))) + +(defmethod sax:end-element + ((sink sink) namespace-uri local-name qname) + (declare (ignore namespace-uri local-name)) + (let ((tag (pop (stack sink)))) + (unless (tag-p tag) + (error "output does not nest: not in an element")) + (unless (rod= (tag-name tag) qname) + (error "output does not nest: expected ~A but got ~A" + (rod qname) (rod (tag-name tag)))) + (when (indentation sink) + (end-indentation-block sink) + (unless (zerop (tag-n-children tag)) + (sink-fresh-line sink))) + (cond + ((tag-have-gt tag) + (%write-rod '#.(string-rod "</") sink) + (%write-rod qname sink) + (%write-rod '#.(string-rod ">") sink)) + (t + (%write-rod #"/>" sink))))) + +(defmethod sax:processing-instruction ((sink sink) target data) + (maybe-close-tag sink) + (unless (rod-equal target '#.(string-rod "xml")) + (%write-rod '#.(string-rod "<?") sink) + (%write-rod target sink) + (cond + ((plusp (length data)) + (%write-rune #/space sink) + (%write-rod data sink)) + ((canonical sink) + (%write-rune #/space sink))) + (%write-rod '#.(string-rod "?>") sink))) + +(defmethod sax:start-cdata ((sink sink)) + (maybe-close-tag sink) + (push :cdata (stack sink))) + +(defmethod sax:characters ((sink sink) data) + (maybe-close-tag sink) + (cond + ((and (eq (car (stack sink)) :cdata) + (not (canonical sink)) + (not (search #"]]" data))) + (when (indentation sink) + (sink-fresh-line sink)) + (%write-rod #"<![CDATA[" sink) + ;; XXX signal error if body is unprintable? + (map nil (lambda (c) (%write-rune c sink)) data) + (%write-rod #"]]>" sink)) + (t + (if (indentation sink) + (unparse-indented-text data sink) + (let ((y (sink-ystream sink))) + (if (canonical sink) + (loop for c across data do (unparse-datachar c y)) + (loop for c across data do (unparse-datachar-readable c y)))))))) + +(defmethod sax:comment ((sink sink) data) + (maybe-close-tag sink) + (unless (canonical sink) + ;; XXX signal error if body is unprintable? + (%write-rod #"<!--" sink) + (map nil (lambda (c) (%write-rune c sink)) data) + (%write-rod #"-->" sink))) + +(defmethod sax:end-cdata ((sink sink)) + (unless (eq (pop (stack sink)) :cdata) + (error "output does not nest: not in a cdata section"))) + +(defun indent (sink) + (dotimes (x (current-indentation sink)) + (%write-rune #/U+0020 sink))) ; space + +(defun start-indentation-block (sink) + (incf (current-indentation sink) (indentation sink))) + +(defun end-indentation-block (sink) + (decf (current-indentation sink) (indentation sink))) + +(defun unparse-indented-text (data sink) + (flet ((whitespacep (x) + (or (rune= x #/U+000A) (rune= x #/U+0020)))) + (let* ((n (length data)) + (pos (position-if-not #'whitespacep data)) + (need-whitespace-p nil)) + (cond + ((zerop n)) + (pos + (sink-fresh-line sink) + (while (< pos n) + (let* ((w (or (position-if #'whitespacep data :start (1+ pos)) n)) + (next (or (position-if-not #'whitespacep data :start w) n))) + (when need-whitespace-p + (if (< (+ (ystream-column (sink-ystream sink)) w (- pos)) + (width sink)) + (%write-rune #/U+0020 sink) + (sink-fresh-line sink))) + (loop + with y = (sink-ystream sink) + for i from pos below w do + (unparse-datachar-readable (elt data i) y)) + (setf need-whitespace-p (< w n)) + (setf pos next)))) + (t + (%write-rune #/U+0020 sink)))))) + +(defun unparse-string (str sink) + (let ((y (sink-ystream sink))) + (loop for rune across str do (unparse-datachar rune y)))) + +(defun unparse-datachar (c ystream) + (cond ((rune= c #/&) (write-rod '#.(string-rod "&") ystream)) + ((rune= c #/<) (write-rod '#.(string-rod "<") ystream)) + ((rune= c #/>) (write-rod '#.(string-rod ">") ystream)) + ((rune= c #/\") (write-rod '#.(string-rod """) ystream)) + ((rune= c #/U+0009) (write-rod '#.(string-rod " ") ystream)) + ((rune= c #/U+000A) (write-rod '#.(string-rod " ") ystream)) + ((rune= c #/U+000D) (write-rod '#.(string-rod " ") ystream)) + (t + (write-rune c ystream)))) + +(defun unparse-datachar-readable (c ystream) + (cond ((rune= c #/&) (write-rod '#.(string-rod "&") ystream)) + ((rune= c #/<) (write-rod '#.(string-rod "<") ystream)) + ((rune= c #/>) (write-rod '#.(string-rod ">") ystream)) + ((rune= c #/\") (write-rod '#.(string-rod """) ystream)) + ((rune= c #/U+000D) (write-rod '#.(string-rod " ") ystream)) + (t + (write-rune c ystream)))) + +(defun unparse-dtd-string (str sink) + (let ((y (sink-ystream sink))) + (loop for rune across str do (unparse-dtd-char rune y)))) + +(defun unparse-dtd-char (c ystream) + (cond ((rune= c #/%) (write-rod '#.(string-rod "%") ystream)) + ((rune= c #/&) (write-rod '#.(string-rod "&") ystream)) + ((rune= c #/<) (write-rod '#.(string-rod "<") ystream)) + ((rune= c #/>) (write-rod '#.(string-rod ">") ystream)) + ((rune= c #/\") (write-rod '#.(string-rod """) ystream)) + ((rune= c #/U+0009) (write-rod '#.(string-rod " ") ystream)) + ((rune= c #/U+000A) (write-rod '#.(string-rod " ") ystream)) + ((rune= c #/U+000D) (write-rod '#.(string-rod " ") ystream)) + (t + (write-rune c ystream)))) + +(defun %write-rune (c sink) + (write-rune c (sink-ystream sink))) + +(defun %write-rod (r sink) + (write-rod r (sink-ystream sink))) + + +;;;; convenience functions for DOMless XML serialization + +(defvar *current-element*) +(defvar *sink*) +(defvar *unparse-namespace-bindings*) +(defvar *current-namespace-bindings*) + +(defmacro with-xml-output (sink &body body) + `(invoke-with-xml-output (lambda () ,@body) ,sink)) + +(defmacro with-output-sink ((var) &body body) + `(invoke-with-output-sink (lambda (,var) ,@body))) + +(defun invoke-with-xml-output (fn sink) + (let ((*sink* sink) + (*current-element* nil) + (*unparse-namespace-bindings* *initial-namespace-bindings*) + (*current-namespace-bindings* nil)) + (sax:start-document *sink*) + (funcall fn) + (sax:end-document *sink*))) + +(defun invoke-with-output-sink (fn) + (maybe-emit-start-tag) + (funcall fn *sink*)) + +(defmacro with-element (qname &body body) + `(invoke-with-element (lambda () ,@body) ,qname)) + +(defmacro with-element* ((prefix lname) &body body) + `(invoke-with-element* (lambda () ,@body) ,prefix ,lname)) + +(defmacro with-namespace ((prefix uri) &body body) + `(invoke-with-namespace (lambda () ,@body) ,prefix ,uri)) + +(defun doctype (name public-id system-id &optional internal-subset) + (sax:start-dtd *sink* name public-id system-id) + (when internal-subset + (sax:unparsed-internal-subset *sink* internal-subset)) + (sax:end-dtd *sink*)) + +(defun maybe-emit-start-tag () + (when *current-element* + ;; starting child node, need to emit opening tag of parent first: + (destructuring-bind ((uri lname qname) &rest attributes) *current-element* + (sax:start-element *sink* uri lname qname (reverse attributes))) + (setf *current-element* nil))) + +(defun invoke-with-namespace (fn prefix uri) + (let ((*unparse-namespace-bindings* + (acons prefix uri *unparse-namespace-bindings*)) + (*current-namespace-bindings* + (acons prefix uri *current-namespace-bindings*))) + (sax:start-prefix-mapping *sink* prefix uri) + (multiple-value-prog1 + (funcall fn) + (sax:end-prefix-mapping *sink* prefix)))) + +(defun invoke-with-element (fn qname) + (setf qname (rod qname)) + (multiple-value-bind (prefix lname) + (split-qname qname) + (invoke-with-element* fn prefix lname qname))) + +(defun find-unparse-namespace (prefix) + (cdr (assoc prefix *unparse-namespace-bindings* :test 'equal))) + +(defun invoke-with-element* (fn prefix lname &optional qname) + (setf prefix (when prefix (rod prefix))) + (setf lname (rod lname)) + (maybe-emit-start-tag) + (let* ((qname (or qname + (if prefix (concatenate 'rod prefix #":" lname) lname))) + (uri (find-unparse-namespace (or prefix #""))) + (*current-element* + (cons (list uri lname qname) + (mapcar (lambda (x) + (destructuring-bind (prefix &rest uri) x + (sax:make-attribute + :namespace-uri #"http://www.w3.org/2000/xmlns/" + :local-name prefix + :qname (if (zerop (length prefix)) + #"xmlns" + (concatenate 'rod #"xmlns:" prefix)) + :value uri))) + *current-namespace-bindings*)))) + (multiple-value-prog1 + (let ((*current-namespace-bindings* nil)) + (funcall fn)) + (maybe-emit-start-tag) + (sax:end-element *sink* uri lname qname)))) + +(defgeneric unparse-attribute (value)) +(defmethod unparse-attribute ((value string)) value) +(defmethod unparse-attribute ((value null)) nil) +(defmethod unparse-attribute ((value integer)) (write-to-string value)) + +(defun attribute (qname value) + (setf qname (rod qname)) + (multiple-value-bind (prefix lname) + (split-qname qname) + (attribute* prefix lname value qname))) + +(defun attribute* (prefix lname value &optional qname) + (setf value (unparse-attribute value)) + (when value + (setf prefix (when prefix (rod prefix))) + (setf lname (rod lname)) + (push (sax:make-attribute + :namespace-uri (find-unparse-namespace prefix) + :local-name lname + :qname (or qname + (if prefix (concatenate 'rod prefix #":" lname) lname)) + :value (rod value)) + (cdr *current-element*)))) + +(defun cdata (data) + (maybe-emit-start-tag) + (sax:start-cdata *sink*) + (sax:characters *sink* (rod data)) + (sax:end-cdata *sink*) + data) + +(defun text (data) + (maybe-emit-start-tag) + (sax:characters *sink* (rod data)) + data) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/util.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/util.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,73 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: RUNES; -*- +;;; --------------------------------------------------------------------------- +;;; Title: Some common utilities for the Closure browser +;;; Created: 1997-12-27 +;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1997-1999 by Gilbert Baumann + +;;; This code is free software; you can redistribute it and/or modify it +;;; under the terms of the version 2.1 of the GNU Lesser General Public +;;; License as published by the Free Software Foundation, as clarified +;;; by the "Preamble to the Gnu Lesser General Public License" found in +;;; the file COPYING. +;;; +;;; This code is distributed in the hope that it will be useful, +;;; but without any warranty; without even the implied warranty of +;;; merchantability or fitness for a particular purpose. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; Version 2.1 of the GNU Lesser General Public License is in the file +;;; COPYING that was distributed with this file. If it is not present, +;;; you can access it from http://www.gnu.org/copyleft/lesser.txt (until +;;; superseded by a newer version) or write to the Free Software +;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + +;; Changes +;; +;; When Who What +;; ---------------------------------------------------------------------------- +;; 1999-08-24 GB = fixed MULTIPLE-VALUE-OR it now takes any number of +;; subforms +;; + +(in-package :cxml) + +;;; -------------------------------------------------------------------------------- +;;; Meta functions + +(defun curry (fun &rest args) + #'(lambda (&rest more) + (apply fun (append args more)))) + +(defun rcurry (fun &rest args) + #'(lambda (&rest more) + (apply fun (append more args)))) + +(defun compose (f g) + #'(lambda (&rest args) + (funcall f (apply g args)))) + +;;; -------------------------------------------------------------------------------- +;;; while and until + +(defmacro while (test &body body) + `(until (not ,test) ,@body)) + +(defmacro until (test &body body) + `(do () (,test) ,@body)) + +;; prime numbers + +(defun primep (n) + "Returns true, iff `n' is prime." + (and (> n 2) + (do ((i 2 (+ i 1))) + ((> (* i i) n) t) + (cond ((zerop (mod n i)) (return nil)))))) + +(defun nearest-greater-prime (n) + "Returns the smallest prime number no less than `n'." + (cond ((primep n) n) + ((nearest-greater-prime (+ n 1))))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xml-name-rune-p.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xml-name-rune-p.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,185 @@ +;;;; xml-name-rune-p -- character class definitions +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> + +(in-package :cxml) + +#.(funcall + (compile + nil + '(lambda () + (let ((+max+ #xD800) + (base-char-ranges + #((#x0041 #x005A) (#x0061 #x007A) (#x00C0 #x00D6) (#x00D8 #x00F6) + (#x00F8 #x00FF) (#x0100 #x0131) (#x0134 #x013E) (#x0141 #x0148) + (#x014A #x017E) (#x0180 #x01C3) (#x01CD #x01F0) (#x01F4 #x01F5) + (#x01FA #x0217) (#x0250 #x02A8) (#x02BB #x02C1) (#x0386 #x0386) + (#x0388 #x038A) (#x038C #x038C) (#x038E #x03A1) (#x03A3 #x03CE) + (#x03D0 #x03D6) (#x03DA #x03DA) (#x03DC #x03DC) (#x03DE #x03DE) + (#x03E0 #x03E0) (#x03E2 #x03F3) (#x0401 #x040C) (#x040E #x044F) + (#x0451 #x045C) (#x045E #x0481) (#x0490 #x04C4) (#x04C7 #x04C8) + (#x04CB #x04CC) (#x04D0 #x04EB) (#x04EE #x04F5) (#x04F8 #x04F9) + (#x0531 #x0556) (#x0559 #x0559) (#x0561 #x0586) (#x05D0 #x05EA) + (#x05F0 #x05F2) (#x0621 #x063A) (#x0641 #x064A) (#x0671 #x06B7) + (#x06BA #x06BE) (#x06C0 #x06CE) (#x06D0 #x06D3) (#x06D5 #x06D5) + (#x06E5 #x06E6) (#x0905 #x0939) (#x093D #x093D) (#x0958 #x0961) + (#x0985 #x098C) (#x098F #x0990) (#x0993 #x09A8) (#x09AA #x09B0) + (#x09B2 #x09B2) (#x09B6 #x09B9) (#x09DC #x09DD) (#x09DF #x09E1) + (#x09F0 #x09F1) (#x0A05 #x0A0A) (#x0A0F #x0A10) (#x0A13 #x0A28) + (#x0A2A #x0A30) (#x0A32 #x0A33) (#x0A35 #x0A36) (#x0A38 #x0A39) + (#x0A59 #x0A5C) (#x0A5E #x0A5E) (#x0A72 #x0A74) (#x0A85 #x0A8B) + (#x0A8D #x0A8D) (#x0A8F #x0A91) (#x0A93 #x0AA8) (#x0AAA #x0AB0) + (#x0AB2 #x0AB3) (#x0AB5 #x0AB9) (#x0ABD #x0ABD) (#x0AE0 #x0AE0) + (#x0B05 #x0B0C) (#x0B0F #x0B10) (#x0B13 #x0B28) (#x0B2A #x0B30) + (#x0B32 #x0B33) (#x0B36 #x0B39) (#x0B3D #x0B3D) (#x0B5C #x0B5D) + (#x0B5F #x0B61) (#x0B85 #x0B8A) (#x0B8E #x0B90) (#x0B92 #x0B95) + (#x0B99 #x0B9A) (#x0B9C #x0B9C) (#x0B9E #x0B9F) (#x0BA3 #x0BA4) + (#x0BA8 #x0BAA) (#x0BAE #x0BB5) (#x0BB7 #x0BB9) (#x0C05 #x0C0C) + (#x0C0E #x0C10) (#x0C12 #x0C28) (#x0C2A #x0C33) (#x0C35 #x0C39) + (#x0C60 #x0C61) (#x0C85 #x0C8C) (#x0C8E #x0C90) (#x0C92 #x0CA8) + (#x0CAA #x0CB3) (#x0CB5 #x0CB9) (#x0CDE #x0CDE) (#x0CE0 #x0CE1) + (#x0D05 #x0D0C) (#x0D0E #x0D10) (#x0D12 #x0D28) (#x0D2A #x0D39) + (#x0D60 #x0D61) (#x0E01 #x0E2E) (#x0E30 #x0E30) (#x0E32 #x0E33) + (#x0E40 #x0E45) (#x0E81 #x0E82) (#x0E84 #x0E84) (#x0E87 #x0E88) + (#x0E8A #x0E8A) (#x0E8D #x0E8D) (#x0E94 #x0E97) (#x0E99 #x0E9F) + (#x0EA1 #x0EA3) (#x0EA5 #x0EA5) (#x0EA7 #x0EA7) (#x0EAA #x0EAB) + (#x0EAD #x0EAE) (#x0EB0 #x0EB0) (#x0EB2 #x0EB3) (#x0EBD #x0EBD) + (#x0EC0 #x0EC4) (#x0F40 #x0F47) (#x0F49 #x0F69) (#x10A0 #x10C5) + (#x10D0 #x10F6) (#x1100 #x1100) (#x1102 #x1103) (#x1105 #x1107) + (#x1109 #x1109) (#x110B #x110C) (#x110E #x1112) (#x113C #x113C) + (#x113E #x113E) (#x1140 #x1140) (#x114C #x114C) (#x114E #x114E) + (#x1150 #x1150) (#x1154 #x1155) (#x1159 #x1159) (#x115F #x1161) + (#x1163 #x1163) (#x1165 #x1165) (#x1167 #x1167) (#x1169 #x1169) + (#x116D #x116E) (#x1172 #x1173) (#x1175 #x1175) (#x119E #x119E) + (#x11A8 #x11A8) (#x11AB #x11AB) (#x11AE #x11AF) (#x11B7 #x11B8) + (#x11BA #x11BA) (#x11BC #x11C2) (#x11EB #x11EB) (#x11F0 #x11F0) + (#x11F9 #x11F9) (#x1E00 #x1E9B) (#x1EA0 #x1EF9) (#x1F00 #x1F15) + (#x1F18 #x1F1D) (#x1F20 #x1F45) (#x1F48 #x1F4D) (#x1F50 #x1F57) + (#x1F59 #x1F59) (#x1F5B #x1F5B) (#x1F5D #x1F5D) (#x1F5F #x1F7D) + (#x1F80 #x1FB4) (#x1FB6 #x1FBC) (#x1FBE #x1FBE) (#x1FC2 #x1FC4) + (#x1FC6 #x1FCC) (#x1FD0 #x1FD3) (#x1FD6 #x1FDB) (#x1FE0 #x1FEC) + (#x1FF2 #x1FF4) (#x1FF6 #x1FFC) (#x2126 #x2126) (#x212A #x212B) + (#x212E #x212E) (#x2180 #x2182) (#x3041 #x3094) (#x30A1 #x30FA) + (#x3105 #x312C) (#xAC00 #xD7A3))) + (ideographic-ranges #((#x3007 #x3007) (#x3021 #x3029)(#x4E00 #x9FA5))) + (combining-char-ranges + #((#x0300 #x0345) (#x0360 #x0361) (#x0483 #x0486) (#x0591 #x05A1) + (#x05A3 #x05B9) (#x05BB #x05BD) (#x05BF #x05BF) (#x05C1 #x05C2) + (#x05C4 #x05C4) (#x064B #x0652) (#x0670 #x0670) (#x06D6 #x06DC) + (#x06DD #x06DF) (#x06E0 #x06E4) (#x06E7 #x06E8) (#x06EA #x06ED) + (#x0901 #x0903) (#x093C #x093C) (#x093E #x094C) (#x094D #x094D) + (#x0951 #x0954) (#x0962 #x0963) (#x0981 #x0983) (#x09BC #x09BC) + (#x09BE #x09BE) (#x09BF #x09BF) (#x09C0 #x09C4) (#x09C7 #x09C8) + (#x09CB #x09CD) (#x09D7 #x09D7) (#x09E2 #x09E3) (#x0A02 #x0A02) + (#x0A3C #x0A3C) (#x0A3E #x0A3E) (#x0A3F #x0A3F) (#x0A40 #x0A42) + (#x0A47 #x0A48) (#x0A4B #x0A4D) (#x0A70 #x0A71) (#x0A81 #x0A83) + (#x0ABC #x0ABC) (#x0ABE #x0AC5) (#x0AC7 #x0AC9) (#x0ACB #x0ACD) + (#x0B01 #x0B03) (#x0B3C #x0B3C) (#x0B3E #x0B43) (#x0B47 #x0B48) + (#x0B4B #x0B4D) (#x0B56 #x0B57) (#x0B82 #x0B83) (#x0BBE #x0BC2) + (#x0BC6 #x0BC8) (#x0BCA #x0BCD) (#x0BD7 #x0BD7) (#x0C01 #x0C03) + (#x0C3E #x0C44) (#x0C46 #x0C48) (#x0C4A #x0C4D) (#x0C55 #x0C56) + (#x0C82 #x0C83) (#x0CBE #x0CC4) (#x0CC6 #x0CC8) (#x0CCA #x0CCD) + (#x0CD5 #x0CD6) (#x0D02 #x0D03) (#x0D3E #x0D43) (#x0D46 #x0D48) + (#x0D4A #x0D4D) (#x0D57 #x0D57) (#x0E31 #x0E31) (#x0E34 #x0E3A) + (#x0E47 #x0E4E) (#x0EB1 #x0EB1) (#x0EB4 #x0EB9) (#x0EBB #x0EBC) + (#x0EC8 #x0ECD) (#x0F18 #x0F19) (#x0F35 #x0F35) (#x0F37 #x0F37) + (#x0F39 #x0F39) (#x0F3E #x0F3E) (#x0F3F #x0F3F) (#x0F71 #x0F84) + (#x0F86 #x0F8B) (#x0F90 #x0F95) (#x0F97 #x0F97) (#x0F99 #x0FAD) + (#x0FB1 #x0FB7) (#x0FB9 #x0FB9) (#x20D0 #x20DC) (#x20E1 #x20E1) + (#x302A #x302F) (#x3099 #x3099) (#x309A #x309A)) + ) + (digit-ranges + #((#x0030 #x0039) (#x0660 #x0669) (#x06F0 #x06F9) (#x0966 #x096F) + (#x09E6 #x09EF) (#x0A66 #x0A6F) (#x0AE6 #x0AEF) (#x0B66 #x0B6F) + (#x0BE7 #x0BEF) (#x0C66 #x0C6F) (#x0CE6 #x0CEF) (#x0D66 #x0D6F) + (#x0E50 #x0E59) (#x0ED0 #x0ED9) (#x0F20 #x0F29))) + (extender-ranges + #((#x00B7 #x00B7) (#x02D0 #x02D0) (#x02D1 #x02D1) (#x0387 #x0387) + (#x0640 #x0640) (#x0E46 #x0E46) (#x0EC6 #x0EC6) (#x3005 #x3005) + (#x3031 #x3035) (#x309D #x309E) (#x30FC #x30FE)))) + (labels + ((rune-in-range-p (code range-vector) + (declare (type simple-vector range-vector)) + ;;we were always dealing with a sorted vector... bin search it + + (let ((start 0) + (end (length range-vector))) + (while (< start end) + (let ((mid-index (+ start (floor (- end start) 2)))) + (destructuring-bind (mid-item-low mid-item-high) + (aref range-vector mid-index) + (cond + ((< mid-item-high code) + (setf start (1+ mid-index))) + ((< code mid-item-low) + (setf end mid-index)) + (t + (return t)))))))) + + (name-start-rune-p (rune) + (or (letter-rune-p rune) + (= #.(char-code #\_) rune) + (= #.(char-code #\:) rune))) + + (name-rune-p (rune) + (or (letter-rune-p rune) + (digit-rune-p* rune) + (= rune #.(char-code #\.)) + (= rune #.(char-code #\-)) + (= rune #.(char-code #\_)) + (= rune #.(char-code #\:)) + (combining-rune-p rune) + (extender-rune-p rune))) + + (letter-rune-p (rune) + (or (base-rune-p rune) + (ideographic-rune-p rune))) + + (digit-rune-p* (rune) + (rune-in-range-p rune digit-ranges)) + + + (combining-rune-p (rune) + (rune-in-range-p rune combining-char-ranges)) + + (extender-rune-p (rune) + (rune-in-range-p rune extender-ranges)) + + (base-rune-p (rune) + (rune-in-range-p rune base-char-ranges)) + + (ideographic-rune-p (rune) + (rune-in-range-p rune ideographic-ranges)) + + + (predicate-to-bv (p) + (let ((r (make-array +max+ :element-type 'bit :initial-element 0))) + (dotimes (i +max+ r) + (when (funcall p i) + (setf (aref r i) 1))))) ) + + `(progn + (DEFINLINE NAME-RUNE-P (RUNE) + (SETF RUNE (RUNE-CODE RUNE)) + (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)) + (type fixnum rune)) + (AND (<= 0 RUNE ,+max+) + (= 1 (SBIT ',(predicate-to-bv #'name-rune-p) + RUNE))))) + (DEFINLINE NAME-START-RUNE-P (RUNE) + (SETF RUNE (RUNE-CODE RUNE)) + (LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)) + (type fixnum rune)) + (AND (<= 0 RUNE ,+MAX+) + (= 1 (SBIT ',(predicate-to-bv #'name-start-rune-p) + RUNE))))) + (definline valid-name-p (rod) + (and (plusp (length rod)) + (name-start-rune-p (elt rod 0)) + (every #'name-rune-p rod))) + (definline valid-nmtoken-p (rod) + (and (plusp (length rod)) + (every #'name-rune-p rod))))))))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xml-parse.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xml-parse.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,3732 @@ +;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: CXML; readtable: runes; -*- +;;; --------------------------------------------------------------------------- +;;; Title: XML parser +;;; Created: 1999-07-17 +;;; Author: Gilbert Baumann <unk6@rz.uni-karlsruhe.de> +;;; Author: Henrik Motakef <hmot@henrik-motakef.de> +;;; Author: David Lichteblau <david@lichteblau.com> +;;; License: Lisp-LGPL (See file COPYING for details). +;;; --------------------------------------------------------------------------- +;;; (c) copyright 1999 by Gilbert Baumann +;;; (c) copyright 2003 by Henrik Motakef +;;; (c) copyright 2004 knowledgeTools Int. GmbH +;;; (c) copyright 2004 David Lichteblau +;;; (c) copyright 2005 David Lichteblau + +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Library General Public +;;; License as published by the Free Software Foundation; either +;;; version 2 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Library General Public License for more details. +;;; +;;; You should have received a copy of the GNU Library General Public +;;; License along with this library; if not, write to the +;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;;; Boston, MA 02111-1307 USA. + +;;; Streams + +;;; xstreams + +;; For reading runes, I defined my own streams, called xstreams, +;; because we want to be fast. A function call or even a method call +;; per character is not acceptable, instead of that we define a +;; buffered stream with and advertised buffer layout, so that we +;; could use the trick stdio uses: READ-RUNE and PEEK-RUNE are macros, +;; directly accessing the buffer and only calling some underflow +;; handler in case of stream underflows. This will yield to quite a +;; performance boost vs calling READ-BYTE per character. + +;; Also we need to do encoding t conversion on ; this better done at large chunks of data rather than on a character +;; by character basis. This way we need a dispatch on the active +;; encoding only once in a while, instead of for each character. This +;; allows us to use a CLOS interface to do the underflow handling. + +;;; zstreams + +;; Now, for reading tokens, we define another kind of streams, called +;; zstreams. These zstreams also maintain an input stack to implement +;; inclusion of external entities. This input stack contains xstreams +;; or the special marker :STOP. Such a :STOP marker indicates, that +;; input should not continue there, but well stop; that is simulate an +;; EOF. The user is then responsible to pop this marker off the input +;; stack. +;; +;; This input stack is also used to detect circular entity inclusion. + +;; The zstream tokenizer recognizes the following types of tokens and +;; is controlled by the *DATA-BEHAVIOUR* flag. (Which should become a +;; slot of zstreams instead). + +;; Common +;; :xml-decl (<target> . <content>) ;processing-instruction starting with "<?xml" +;; :pi (<target> . <content>) ;processing-instruction +;; :stag (<name> . <atts>) ;start tag +;; :etag (<name> . <atts>) ;end tag +;; :ztag (<name> . <atts>) ;empty tag +;; :<!ELEMENT +;; :<!ENTITY +;; :<!ATTLIST +;; :<!NOTATION +;; :<!DOCTYPE +;; :<![ +;; :comment <content> + +;; *data-behaviour* = :DTD +;; +;; :nmtoken <interned-rod> +;; :#required +;; :#implied +;; :#fixed +;; :#pcdata +;; :s +;; :\[ :\] :\( :\) :|\ :\> :\" :\' :\, :\? :\* :\+ + +;; *data-behaviour* = :DOC +;; +;; :entity-ref <interned-rod> +;; :cdata <rod> + + +;;; TODO +;; +;; o provide for a faster DOM +;; +;; o morph zstream into a context object and thus also get rid of +;; special variables. Put the current DTD there too. +;; [partly done] + +;; o the *scratch-pad* hack should become something much more +;; reentrant, we could either define a system-wide resource +;; or allocate some scratch-pads per context. +;; [for thread-safety reasons the array are allocated per context now, +;; reentrancy is still open] + +;; o CR handling in utf-16 deocders +;; +;; o UCS-4 reader +;; +;; o max depth together with circle detection +;; (or proof, that our circle detection is enough). +;; [gemeint ist zstream-push--david] +;; +;; o better extensibility wrt character representation, one may want to +;; have +;; - UCS-4 in vectoren +;; +;; o xstreams auslagern, documententieren und dann auch in SGML und +;; CSS parser verwenden. (halt alles was zeichen liest). +;; [ausgelagert sind sie; dokumentiert "so la la"; die Reintegration +;; in Closure ist ein ganz anderes Thema] +;; +;; o recording of source locations for nodes. +;; +;; o based on the DTD and xml:space attribute implement HTML white +;; space rules. +;; +;; o on a parser option, do not expand external entities. + +;;;; Validity constraints: +;;;; (00) Root Element Type like (03), c.f. MAKE-ROOT-MODEL +;;;; (01) Proper Declaration/PE Nesting P/MARKUP-DECL +;;;; (02) Standalone Document Declaration all over the place [*] +;;;; (03) Element Valid VALIDATE-*-ELEMENT, -CHARACTERS +;;;; (04) Attribute Value Type VALIDATE-ATTRIBUTE +;;;; (05) Unique Element Type Declaration DEFINE-ELEMENT +;;;; (06) Proper Group/PE Nesting P/CSPEC +;;;; (07) No Duplicate Types LEGAL-CONTENT-MODEL-P +;;;; (08) ID VALIDATE-ATTRIBUTE +;;;; (09) One ID per Element Type DEFINE-ATTRIBUTE +;;;; (10) ID Attribute Default DEFINE-ATTRIBUTE +;;;; (11) IDREF VALIDATE-ATTRIBUTE, P/DOCUMENT +;;;; (12) Entity Name VALIDATE-ATTRIBUTE +;;;; (13) Name Token VALIDATE-ATTRIBUTE +;;;; (14) Notation Attributes VALIDATE-ATTRIBUTE, P/ATT-TYPE +;;;; (15) One Notation Per Element Type DEFINE-ATTRIBUTE +;;;; (16) No Notation on Empty Element DEFINE-ELEMENT, -ATTRIBUTE +;;;; (17) Enumeration VALIDATE-ATTRIBUTE +;;;; (18) Required Attribute PROCESS-ATTRIBUTES +;;;; (19) Attribute Default Legal DEFINE-ATTRIBUTE +;;;; (20) Fixed Attribute Default VALIDATE-ATTRIBUTE +;;;; (21) Proper Conditional Section/PE Nesting P/CONDITIONAL-SECT, ... +;;;; (22) Entity Declared [**] +;;;; (23) Notation Declared P/ENTITY-DEF, P/DOCUMENT +;;;; (24) Unique Notation Name DEFINE-NOTATION +;;;; +;;;; [*] Perhaps we could revert the explicit checks of (02), if we did +;;;; _not_ read external subsets of standalone documents when parsing in +;;;; validating mode. Violations of VC (02) constraints would then appear as +;;;; wellformedness violations, right? +;;;; +;;;; [**] Although I haven't investigated this properly yet, I believe that +;;;; we check this VC together with the WFC even in non-validating mode. + +(in-package :cxml) + +#+allegro +(setf (excl:named-readtable :runes) *readtable*) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defparameter *fast* '(optimize (speed 3) (safety 0))) + ;;(defparameter *fast* '(optimize (speed 2) (safety 3))) + ) + +;;; parser context + +(defvar *ctx* nil) + +(defstruct (context (:conc-name nil)) + handler + (dtd nil) + model-stack + ;; xml:base machen wir fuer klacks mal gleich als expliziten stack: + base-stack + (referenced-notations '()) + (id-table (%make-rod-hash-table)) + ;; FIXME: Wofuer ist name-hashtable da? Will man das wissen? + (name-hashtable (make-rod-hashtable :size 2000)) + (standalone-p nil) + (entity-resolver nil) + (disallow-internal-subset nil) + main-zstream) + +(defvar *expand-pe-p* nil) + +(defparameter *initial-namespace-bindings* + '((#"" . nil) + (#"xmlns" . #"http://www.w3.org/2000/xmlns/") + (#"xml" . #"http://www.w3.org/XML/1998/namespace"))) + +(defparameter *namespace-bindings* *initial-namespace-bindings*) + +;;;; --------------------------------------------------------------------------- +;;;; xstreams +;;;; + + +(defstruct (stream-name + (:print-function print-stream-name)) + entity-name + entity-kind + uri) + +(defun print-stream-name (object stream depth) + (declare (ignore depth)) + (format stream "[~A ~S ~A]" + (rod-string (stream-name-entity-name object)) + (stream-name-entity-kind object) + (stream-name-uri object))) + +(deftype read-element () 'rune) + +(defun call-with-open-xstream (fn stream) + (unwind-protect + (funcall fn stream) + (close-xstream stream))) + +(defmacro with-open-xstream ((var value) &body body) + `(call-with-open-xstream (lambda (,var) ,@body) ,value)) + +(defun call-with-open-xfile (continuation &rest open-args) + (let ((input (apply #'open (car open-args) :element-type '(unsigned-byte 8) (cdr open-args)))) + (unwind-protect + (progn + (funcall continuation (make-xstream input))) + (close input)))) + +(defmacro with-open-xfile ((stream &rest open-args) &body body) + `(call-with-open-xfile (lambda (,stream) .,body) .,open-args)) + +;;;; ------------------------------------------------------------------- +;;;; Rechnen mit Runen +;;;; + +;; Let us first define fast fixnum arithmetric get rid of type +;; checks. (After all we know what we do here). + +(defmacro fx-op (op &rest xs) + `(the fixnum (,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs)))) +(defmacro fx-pred (op &rest xs) + `(,op ,@(mapcar (lambda (x) `(the fixnum ,x)) xs))) + +(defmacro %+ (&rest xs) `(fx-op + ,@xs)) +(defmacro %- (&rest xs) `(fx-op - ,@xs)) +(defmacro %* (&rest xs) `(fx-op * ,@xs)) +(defmacro %/ (&rest xs) `(fx-op floor ,@xs)) +(defmacro %and (&rest xs) `(fx-op logand ,@xs)) +(defmacro %ior (&rest xs) `(fx-op logior ,@xs)) +(defmacro %xor (&rest xs) `(fx-op logxor ,@xs)) +(defmacro %ash (&rest xs) `(fx-op ash ,@xs)) +(defmacro %mod (&rest xs) `(fx-op mod ,@xs)) + +(defmacro %= (&rest xs) `(fx-pred = ,@xs)) +(defmacro %<= (&rest xs) `(fx-pred <= ,@xs)) +(defmacro %>= (&rest xs) `(fx-pred >= ,@xs)) +(defmacro %< (&rest xs) `(fx-pred < ,@xs)) +(defmacro %> (&rest xs) `(fx-pred > ,@xs)) + +;;; XXX Geschwindigkeit dieser Definitionen untersuchen! + +(defmacro rune-op (op &rest xs) + `(code-rune (,op ,@(mapcar (lambda (x) `(rune-code ,x)) xs)))) +(defmacro rune-pred (op &rest xs) + `(,op ,@(mapcar (lambda (x) `(rune-code ,x)) xs))) + +(defmacro %rune+ (&rest xs) `(rune-op + ,@xs)) +(defmacro %rune- (&rest xs) `(rune-op - ,@xs)) +(defmacro %rune* (&rest xs) `(rune-op * ,@xs)) +(defmacro %rune/ (&rest xs) `(rune-op floor ,@xs)) +(defmacro %rune-and (&rest xs) `(rune-op logand ,@xs)) +(defmacro %rune-ior (&rest xs) `(rune-op logior ,@xs)) +(defmacro %rune-xor (&rest xs) `(rune-op logxor ,@xs)) +(defmacro %rune-ash (a b) `(code-rune (ash (rune-code ,a) ,b))) +(defmacro %rune-mod (&rest xs) `(rune-op mod ,@xs)) + +(defmacro %rune= (&rest xs) `(rune-pred = ,@xs)) +(defmacro %rune<= (&rest xs) `(rune-pred <= ,@xs)) +(defmacro %rune>= (&rest xs) `(rune-pred >= ,@xs)) +(defmacro %rune< (&rest xs) `(rune-pred < ,@xs)) +(defmacro %rune> (&rest xs) `(rune-pred > ,@xs)) + +;;;; --------------------------------------------------------------------------- +;;;; rod hashtable +;;;; + +;;; make-rod-hashtable +;;; rod-hash-get hashtable rod &optional start end -> value ; successp +;;; (setf (rod-hash-get hashtable rod &optional start end) new-value +;;; + +(defstruct (rod-hashtable (:constructor make-rod-hashtable/low)) + size ;size of table + table ; + ) + +(defun make-rod-hashtable (&key (size 200)) + (setf size (nearest-greater-prime size)) + (make-rod-hashtable/low + :size size + :table (make-array size :initial-element nil))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defconstant +fixnum-bits+ + (1- (integer-length most-positive-fixnum)) + "Pessimistic approximation of the number of bits of fixnums.") + + (defconstant +fixnum-mask+ + (1- (expt 2 +fixnum-bits+)) + "Pessimistic approximation of the largest bit-mask, still being a fixnum.")) + +(definline stir (a b) + (%and +fixnum-mask+ + (%xor (%ior (%ash (%and a #.(ash +fixnum-mask+ -5)) 5) + (%ash a #.(- 5 +fixnum-bits+))) + b))) + +(definline rod-hash (rod start end) + "Compute a hash code out of a rod." + (let ((res (%- end start))) + (do ((i start (%+ i 1))) + ((%= i end)) + (declare (type fixnum i)) + (setf res (stir res (rune-code (%rune rod i))))) + res)) + +(definline rod=* (x y &key (start1 0) (end1 (length x)) + (start2 0) (end2 (length y))) + (and (%= (%- end1 start1) (%- end2 start2)) + (do ((i start1 (%+ i 1)) + (j start2 (%+ j 1))) + ((%= i end1) + t) + (unless (rune= (%rune x i) (%rune y j)) + (return nil))))) + +(definline rod=** (x y start1 end1 start2 end2) + (and (%= (%- end1 start1) (%- end2 start2)) + (do ((i start1 (%+ i 1)) + (j start2 (%+ j 1))) + ((%= i end1) + t) + (unless (rune= (%rune x i) (%rune y j)) + (return nil))))) + +(defun rod-hash-get (hashtable rod &optional (start 0) (end (length rod))) + (declare (type (simple-array rune (*)) rod)) + (let ((j (%mod (rod-hash rod start end) + (rod-hashtable-size hashtable)))) + (dolist (q (svref (rod-hashtable-table hashtable) j) + (values nil nil nil)) + (declare (type cons q)) + (when (rod=** (car q) rod 0 (length (the (simple-array rune (*)) (car q))) start end) + (return (values (cdr q) t (car q))))))) + +(defun rod-hash-set (new-value hashtable rod &optional (start 0) (end (length rod))) + (let ((j (%mod (rod-hash rod start end) + (rod-hashtable-size hashtable))) + (key nil)) + (dolist (q (svref (rod-hashtable-table hashtable) j) + (progn + (setf key (rod-subseq* rod start end)) + (push (cons key new-value) + (aref (rod-hashtable-table hashtable) j)))) + (when (rod=* (car q) rod :start2 start :end2 end) + (setf key (car q)) + (setf (cdr q) new-value) + (return))) + (values new-value key))) + +#-rune-is-character +(defun rod-subseq* (source start &optional (end (length source))) + (unless (and (typep start 'fixnum) (>= start 0)) + (error "~S is not a non-negative fixnum." start)) + (unless (and (typep end 'fixnum) (>= end start)) + (error "END argument, ~S, is not a fixnum no less than START, ~S." end start)) + (when (> start (length source)) + (error "START argument, ~S, should be no greater than length of rod." start)) + (when (> end (length source)) + (error "END argument, ~S, should be no greater than length of rod." end)) + (locally + (declare (type fixnum start end)) + (let ((res (make-rod (- end start)))) + (declare (type rod res)) + (do ((i (- (- end start) 1) (the fixnum (- i 1)))) + ((< i 0) res) + (declare (type fixnum i)) + (setf (%rune res i) (aref source (the fixnum (+ i start)))))))) + +#+rune-is-character +(defun rod-subseq* (source start &optional (end (length source))) + (subseq source start end)) + +(deftype ufixnum () `(unsigned-byte ,(integer-length most-positive-fixnum))) + +#-rune-is-character +(defun rod-subseq** (source start &optional (end (length source))) + (declare (type (simple-array rune (*)) source) + (type ufixnum start) + (type ufixnum end) + (optimize (speed 3) (safety 0))) + (let ((res (make-array (%- end start) :element-type 'rune))) + (declare (type (simple-array rune (*)) res)) + (let ((i (%- end start))) + (declare (type ufixnum i)) + (loop + (setf i (- i 1)) + (when (= i 0) + (return)) + (setf (%rune res i) (%rune source (the ufixnum (+ i start)))))) + res)) + +#+rune-is-character +(defun rod-subseq** (source start &optional (end (length source))) + (subseq source start end)) + +(defun (setf rod-hash-get) (new-value hashtable rod &optional (start 0) (end (length rod))) + (rod-hash-set new-value hashtable rod start end)) + +(defun intern-name (rod &optional (start 0) (end (length rod))) + (multiple-value-bind (value successp key) (rod-hash-get (name-hashtable *ctx*) rod start end) + (declare (ignore value)) + (if successp + key + (nth-value 1 (rod-hash-set t (name-hashtable *ctx*) rod start end))))) + +;;;; --------------------------------------------------------------------------- +;;;; +;;;; rod collector +;;;; + +(defvar *scratch-pad*) +(defvar *scratch-pad-2*) +(defvar *scratch-pad-3*) +(defvar *scratch-pad-4*) + +(declaim (type (simple-array rune (*)) + *scratch-pad* *scratch-pad-2* *scratch-pad-3* *scratch-pad-4*)) + +(defmacro with-scratch-pads ((&optional) &body body) + `(let ((*scratch-pad* (make-array 1024 :element-type 'rune)) + (*scratch-pad-2* (make-array 1024 :element-type 'rune)) + (*scratch-pad-3* (make-array 1024 :element-type 'rune)) + (*scratch-pad-4* (make-array 1024 :element-type 'rune))) + ,@body)) + +(defmacro %put-unicode-char (code-var put) + `(progn + (cond ((%> ,code-var #xFFFF) + (,put (the rune (code-rune (%+ #xD7C0 (%ash ,code-var -10))))) + (,put (the rune (code-rune (%ior #xDC00 (%and ,code-var #x03FF)))))) + (t + (,put (code-rune ,code-var)))))) + +(defun adjust-array-by-copying (old-array new-size) + "Adjust an array by copying and thus ensures, that result is a SIMPLE-ARRAY." + (let ((res (make-array new-size :element-type (array-element-type old-array)))) + (replace res old-array + :start1 0 :end1 (length old-array) + :start2 0 :end2 (length old-array)) + res)) + +(defmacro with-rune-collector-aux (scratch collect body mode) + (let ((rod (gensym)) + (n (gensym)) + (i (gensym)) + (b (gensym))) + `(let ((,n (length ,scratch)) + (,i 0) + (,b ,scratch)) + (declare (type fixnum ,n ,i)) + (macrolet + ((,collect (x) + `((lambda (x) + (locally + (declare #.*fast*) + (when (%>= ,',i ,',n) + (setf ,',n (* 2 ,',n)) + (setf ,',b + (setf ,',scratch + (adjust-array-by-copying ,',scratch ,',n)))) + (setf (aref (the (simple-array rune (*)) ,',b) ,',i) x) + (incf ,',i))) + ,x))) + ,@body + ,(ecase mode + (:intern + `(intern-name ,b 0 ,i)) + (:copy + `(let ((,rod (make-rod ,i))) + (while (not (%= ,i 0)) + (setf ,i (%- ,i 1)) + (setf (%rune ,rod ,i) + (aref (the (simple-array rune (*)) ,b) ,i))) + ,rod)) + (:raw + `(values ,b 0 ,i)) + ))))) + +'(defmacro with-rune-collector-aux (scratch collect body mode) + (let ((rod (gensym)) + (n (gensym)) + (i (gensym)) + (b (gensym))) + `(let ((,n (length ,scratch)) + (,i 0)) + (declare (type fixnum ,n ,i)) + (macrolet + ((,collect (x) + `((lambda (x) + (locally + (declare #.*fast*) + (when (%>= ,',i ,',n) + (setf ,',n (* 2 ,',n)) + (setf ,',scratch + (setf ,',scratch + (adjust-array-by-copying ,',scratch ,',n)))) + (setf (aref (the (simple-array rune (*)) ,',scratch) ,',i) x) + (incf ,',i))) + ,x))) + ,@body + ,(ecase mode + (:intern + `(intern-name ,scratch 0 ,i)) + (:copy + `(let ((,rod (make-rod ,i))) + (while (%> ,i 0) + (setf ,i (%- ,i 1)) + (setf (%rune ,rod ,i) + (aref (the (simple-array rune (*)) ,scratch) ,i))) + ,rod)) + (:raw + `(values ,scratch 0 ,i)) + ))))) + +(defmacro with-rune-collector ((collect) &body body) + `(with-rune-collector-aux *scratch-pad* ,collect ,body :copy)) + +(defmacro with-rune-collector-2 ((collect) &body body) + `(with-rune-collector-aux *scratch-pad-2* ,collect ,body :copy)) + +(defmacro with-rune-collector-3 ((collect) &body body) + `(with-rune-collector-aux *scratch-pad-3* ,collect ,body :copy)) + +(defmacro with-rune-collector-4 ((collect) &body body) + `(with-rune-collector-aux *scratch-pad-4* ,collect ,body :copy)) + +(defmacro with-rune-collector/intern ((collect) &body body) + `(with-rune-collector-aux *scratch-pad* ,collect ,body :intern)) + +(defmacro with-rune-collector/raw ((collect) &body body) + `(with-rune-collector-aux *scratch-pad* ,collect ,body :raw)) + +#| +(defmacro while-reading-runes ((reader stream-in) &rest body) + ;; Thou shalt not leave body via a non local exit + (let ((stream (make-symbol "STREAM")) + (rptr (make-symbol "RPTR")) + (fptr (make-symbol "FPTR")) + (buf (make-symbol "BUF")) ) + `(let* ((,stream ,stream-in) + (,rptr (xstream-read-ptr ,stream)) + (,fptr (xstream-fill-ptr ,stream)) + (,buf (xstream-buffer ,stream))) + (declare (type fixnum ,rptr ,fptr) + (type xstream ,stream)) + (macrolet ((,reader (res-var) + `(cond ((%= ,',rptr ,',fptr) + (setf (xstream-read-ptr ,',stream) ,',rptr) + (setf ,res-var (xstream-underflow ,',stream)) + (setf ,',rptr (xstream-read-ptr ,',stream)) + (setf ,',fptr (xstream-fill-ptr ,',stream)) + (setf ,',buf (xstream-buffer ,',stream))) + (t + (setf ,res-var + (aref (the (simple-array read-element (*)) ,',buf) + (the fixnum ,',rptr))) + (setf ,',rptr (%+ ,',rptr 1)))))) + (prog1 + (let () .,body) + (setf (xstream-read-ptr ,stream) ,rptr) ))))) +|# + +;;;; --------------------------------------------------------------------------- +;;;; DTD +;;;; + +(define-condition xml-parse-error (simple-error) ()) +(define-condition well-formedness-violation (xml-parse-error) ()) +(define-condition validity-error (xml-parse-error) ()) + +;; We make some effort to signal end of file as a special condition, but we +;; don't actually try very hard. Not sure whether we should. Right now I +;; would prefer not to document this class. +(define-condition end-of-xstream (well-formedness-violation) ()) + +(defun describe-xstream (x s) + (format s " Line ~D, column ~D in ~A~%" + (xstream-line-number x) + (xstream-column-number x) + (let ((name (xstream-name x))) + (cond + ((null name) + "<anonymous stream>") + ((eq :main (stream-name-entity-kind name)) + (stream-name-uri name)) + (t + name))))) + +(defun %error (class stream message) + (let* ((zmain (if *ctx* (main-zstream *ctx*) nil)) + (zstream (if (zstream-p stream) stream zmain)) + (xstream (if (xstream-p stream) stream nil)) + (s (make-string-output-stream))) + (write-line message s) + (when xstream + (write-line "Location:" s) + (describe-xstream xstream s)) + (when zstream + (let ((stack + (remove xstream (remove :stop (zstream-input-stack zstream))))) + (when stack + (write-line "Context:" s) + (dolist (x stack) + (describe-xstream x s))))) + (when (and zmain (not (eq zstream zmain))) + (let ((stack + (remove xstream (remove :stop (zstream-input-stack zmain))))) + (when stack + (write-line "Context in main document:" s) + (dolist (x stack) + (describe-xstream x s))))) + (error class + :format-control "~A" + :format-arguments (list (get-output-stream-string s))))) + +(defun validity-error (fmt &rest args) + (%error 'validity-error + nil + (format nil "Document not valid: ~?" fmt args))) + +(defun wf-error (stream fmt &rest args) + (%error 'well-formedness-violation + stream + (format nil "Document not well-formed: ~?" fmt args))) + +(defun eox (stream &optional x &rest args) + (%error 'end-of-xstream + stream + (format nil "End of file~@[: ~?~]" x args))) + +(defclass cxml-parser (sax:sax-parser) ((ctx :initarg :ctx))) + +(defun parser-xstream (parser) + (car (zstream-input-stack (main-zstream (slot-value parser 'ctx))))) + +(defun parser-stream-name (parser) + (let ((xstream (parser-xstream parser))) + (if xstream + (xstream-name xstream) + nil))) + +(defmethod sax:line-number ((parser cxml-parser)) + (let ((x (parser-xstream parser))) + (if x + (xstream-line-number x) + nil))) + +(defmethod sax:column-number ((parser cxml-parser)) + (let ((x (parser-xstream parser))) + (if x + (xstream-column-number x) + nil))) + +(defmethod sax:system-id ((parser cxml-parser)) + (let ((name (parser-stream-name parser))) + (if name + (stream-name-uri name) + nil))) + +(defmethod sax:xml-base ((parser cxml-parser)) + (car (base-stack (slot-value parser 'ctx)))) + +(defvar *validate* t) +(defvar *external-subset-p* nil) + +(defun validate-start-element (ctx name) + (when *validate* + (let* ((pair (car (model-stack ctx))) + (newval (funcall (car pair) name))) + (unless newval + (validity-error "(03) Element Valid: ~A" (rod-string name))) + (setf (car pair) newval) + (let ((e (find-element name (dtd ctx)))) + (unless e + (validity-error "(03) Element Valid: no definition for ~A" + (rod-string name))) + (maybe-compile-cspec e) + (push (copy-cons (elmdef-compiled-cspec e)) (model-stack ctx)))))) + +(defun copy-cons (x) + (cons (car x) (cdr x))) + +(defun validate-end-element (ctx name) + (when *validate* + (let ((pair (car (model-stack ctx)))) + (unless (eq (funcall (car pair) nil) t) + (validity-error "(03) Element Valid: ~A" (rod-string name))) + (pop (model-stack ctx))))) + +(defun validate-characters (ctx rod) + (when *validate* + (let ((pair (car (model-stack ctx)))) + (unless (funcall (cdr pair) rod) + (validity-error "(03) Element Valid: unexpected PCDATA"))))) + +(defun standalone-check-necessary-p (def) + (and *validate* + (standalone-p *ctx*) + (etypecase def + (elmdef (elmdef-external-p def)) + (attdef (attdef-external-p def))))) + +;; attribute validation, defaulting, and normalization -- except for for +;; uniqueness checks, which are done after namespaces have been declared +(defun process-attributes (ctx name attlist) + (let ((e (find-element name (dtd ctx)))) + (cond + (e + (dolist (ad (elmdef-attributes e)) ;handle default values + (unless (get-attribute (attdef-name ad) attlist) + (case (attdef-default ad) + (:IMPLIED) + (:REQUIRED + (when *validate* + (validity-error "(18) Required Attribute: ~S not specified" + (rod-string (attdef-name ad))))) + (t + (when (standalone-check-necessary-p ad) + (validity-error "(02) Standalone Document Declaration: missing attribute value")) + (push (sax:make-attribute :qname (attdef-name ad) + :value (cadr (attdef-default ad)) + :specified-p nil) + attlist))))) + (dolist (a attlist) ;normalize non-CDATA values + (let* ((qname (sax:attribute-qname a)) + (adef (find-attribute e qname))) + (when adef + (when (and *validate* + sax:*namespace-processing* + (eq (attdef-type adef) :ID) + (find #/: (sax:attribute-value a))) + (validity-error "colon in ID attribute")) + (unless (eq (attdef-type adef) :CDATA) + (let ((canon (canon-not-cdata-attval (sax:attribute-value a)))) + (when (and (standalone-check-necessary-p adef) + (not (rod= (sax:attribute-value a) canon))) + (validity-error "(02) Standalone Document Declaration: attribute value not normalized")) + (setf (sax:attribute-value a) canon)))))) + (when *validate* ;maybe validate attribute values + (dolist (a attlist) + (validate-attribute ctx e a)))) + ((and *validate* attlist) + (validity-error "(04) Attribute Value Type: no definition for element ~A" + (rod-string name))))) + attlist) + +(defun get-attribute (name attributes) + (member name attributes :key #'sax:attribute-qname :test #'rod=)) + +(defun validate-attribute (ctx e a) + (when (sax:attribute-specified-p a) ;defaults checked by DEFINE-ATTRIBUTE + (let* ((qname (sax:attribute-qname a)) + (adef + (or (find-attribute e qname) + (validity-error "(04) Attribute Value Type: not declared: ~A" + (rod-string qname))))) + (validate-attribute* ctx adef (sax:attribute-value a))))) + +(defun validate-attribute* (ctx adef value) + (let ((type (attdef-type adef)) + (default (attdef-default adef))) + (when (and (listp default) + (eq (car default) :FIXED) + (not (rod= value (cadr default)))) + (validity-error "(20) Fixed Attribute Default: expected ~S but got ~S" + (rod-string (cadr default)) + (rod-string value))) + (ecase (if (listp type) (car type) type) + (:ID + (unless (valid-name-p value) + (validity-error "(08) ID: not a name: ~S" (rod-string value))) + (when (eq (gethash value (id-table ctx)) t) + (validity-error "(08) ID: ~S not unique" (rod-string value))) + (setf (gethash value (id-table ctx)) t)) + (:IDREF + (validate-idref ctx value)) + (:IDREFS + (let ((names (split-names value))) + (unless names + (validity-error "(11) IDREF: malformed names")) + (mapc (curry #'validate-idref ctx) names))) + (:NMTOKEN + (validate-nmtoken value)) + (:NMTOKENS + (let ((tokens (split-names value))) + (unless tokens + (validity-error "(13) Name Token: malformed NMTOKENS")) + (mapc #'validate-nmtoken tokens))) + (:ENUMERATION + (unless (member value (cdr type) :test #'rod=) + (validity-error "(17) Enumeration: value not declared: ~S" + (rod-string value)))) + (:NOTATION + (unless (member value (cdr type) :test #'rod=) + (validity-error "(14) Notation Attributes: ~S" (rod-string value)))) + (:ENTITY + (validate-entity value)) + (:ENTITIES + (let ((names (split-names value))) + (unless names + (validity-error "(13) Name Token: malformed NMTOKENS")) + (mapc #'validate-entity names))) + (:CDATA)))) + +(defun validate-idref (ctx value) + (unless (valid-name-p value) + (validity-error "(11) IDREF: not a name: ~S" (rod-string value))) + (unless (gethash value (id-table ctx)) + (setf (gethash value (id-table ctx)) nil))) + +(defun validate-nmtoken (value) + (unless (valid-nmtoken-p value) + (validity-error "(13) Name Token: not a NMTOKEN: ~S" + (rod-string value)))) + +(defstruct (entdef (:constructor))) + +(defstruct (internal-entdef + (:include entdef) + (:constructor make-internal-entdef (value)) + (:conc-name #:entdef-)) + (value (error "missing argument") :type rod) + (expansion nil) + (external-subset-p *external-subset-p*)) + +(defstruct (external-entdef + (:include entdef) + (:constructor make-external-entdef (extid ndata)) + (:conc-name #:entdef-)) + (extid (error "missing argument") :type extid) + (ndata nil :type (or rod null))) + +(defun validate-entity (value) + (unless (valid-name-p value) + (validity-error "(12) Entity Name: not a name: ~S" (rod-string value))) + (let ((def (let ((*validate* + ;; Similarly the entity refs are internal and + ;; don't need normalization ... the unparsed + ;; entities (and entities) aren't "references" + ;; -- sun/valid/sa03.xml + nil)) + (get-entity-definition value :general (dtd *ctx*))))) + (unless (and (typep def 'external-entdef) (entdef-ndata def)) + ;; unparsed entity + (validity-error "(12) Entity Name: ~S" (rod-string value))))) + +(defun split-names (rod) + (flet ((whitespacep (x) + (or (rune= x #/U+0009) + (rune= x #/U+000A) + (rune= x #/U+000D) + (rune= x #/U+0020)))) + (if (let ((n (length rod))) + (and (not (zerop n)) + (or (whitespacep (rune rod 0)) + (whitespacep (rune rod (1- n)))))) + nil + (split-sequence-if #'whitespacep rod :remove-empty-subseqs t)))) + +(defun zstream-base-sysid (zstream) + (let ((base-sysid + (dolist (k (zstream-input-stack zstream)) + (let ((base-sysid (stream-name-uri (xstream-name k)))) + (when base-sysid (return base-sysid)))))) + base-sysid)) + +(defun absolute-uri (sysid source-stream) + (let ((base-sysid (zstream-base-sysid source-stream))) + ;; XXX is the IF correct? + (if base-sysid + (puri:merge-uris sysid base-sysid) + sysid))) + +(defstruct (extid (:constructor make-extid (public system))) + (public nil :type (or rod null)) + (system (error "missing argument") :type (or puri:uri null))) + +(defun absolute-extid (source-stream extid) + (let ((sysid (extid-system extid)) + (result (copy-extid extid))) + (setf (extid-system result) (absolute-uri sysid source-stream)) + result)) + +(defun define-entity (source-stream name kind def) + (setf name (intern-name name)) + (when (and sax:*namespace-processing* (find #/: name)) + (wf-error source-stream "colon in entity name")) + (let ((table + (ecase kind + (:general (dtd-gentities (dtd *ctx*))) + (:parameter (dtd-pentities (dtd *ctx*)))))) + (unless (gethash name table) + (when (and source-stream (handler *ctx*)) + (report-entity (handler *ctx*) kind name def)) + (when (typep def 'external-entdef) + (setf (entdef-extid def) + (absolute-extid source-stream (entdef-extid def)))) + (setf (gethash name table) + (cons *external-subset-p* def))))) + +(defun get-entity-definition (entity-name kind dtd) + (unless dtd + (wf-error nil "entity not defined: ~A" (rod-string entity-name))) + (destructuring-bind (extp &rest def) + (gethash entity-name + (ecase kind + (:general (dtd-gentities dtd)) + (:parameter (dtd-pentities dtd))) + '(nil)) + (when (and *validate* (standalone-p *ctx*) extp) + (validity-error "(02) Standalone Document Declaration: entity reference: ~S" + (rod-string entity-name))) + def)) + +(defun entity->xstream (zstream entity-name kind &optional internalp) + ;; `zstream' is for error messages + (let ((def (get-entity-definition entity-name kind (dtd *ctx*)))) + (unless def + (wf-error zstream "Entity '~A' is not defined." (rod-string entity-name))) + (let (r) + (etypecase def + (internal-entdef + (when (and (standalone-p *ctx*) + (entdef-external-subset-p def)) + (wf-error + zstream + "entity declared in external subset, but document is standalone")) + (setf r (make-rod-xstream (entdef-value def))) + (setf (xstream-name r) + (make-stream-name :entity-name entity-name + :entity-kind kind + :uri nil))) + (external-entdef + (when internalp + (wf-error zstream + "entity not internal: ~A" (rod-string entity-name))) + (when (entdef-ndata def) + (wf-error zstream + "reference to unparsed entity: ~A" + (rod-string entity-name))) + (setf r (xstream-open-extid (extid-using-catalog (entdef-extid def)))) + (setf (stream-name-entity-name (xstream-name r)) entity-name + (stream-name-entity-kind (xstream-name r)) kind))) + r))) + +(defun checked-get-entdef (name type) + (let ((def (get-entity-definition name type (dtd *ctx*)))) + (unless def + (wf-error nil "Entity '~A' is not defined." (rod-string name))) + def)) + +(defun xstream-open-extid* (entity-resolver pubid sysid) + (let* ((stream + (or (funcall (or entity-resolver (constantly nil)) pubid sysid) + (open (uri-to-pathname sysid) + :element-type '(unsigned-byte 8) + :direction :input)))) + (make-xstream stream + :name (make-stream-name :uri sysid) + :initial-speed 1))) + +(defun xstream-open-extid (extid) + (xstream-open-extid* (entity-resolver *ctx*) + (extid-public extid) + (extid-system extid))) + +(defun call-with-entity-expansion-as-stream (zstream cont name kind internalp) + ;; `zstream' is for error messages + (let ((in (entity->xstream zstream name kind internalp))) + (push (stream-name-uri (xstream-name in)) (base-stack *ctx*)) + (unwind-protect + (funcall cont in) + (pop (base-stack *ctx*)) + (close-xstream in)))) + +(defun ensure-dtd () + (unless (dtd *ctx*) + (setf (dtd *ctx*) (make-dtd)) + (define-default-entities))) + +(defun define-default-entities () + (define-entity nil #"lt" :general (make-internal-entdef #"<")) + (define-entity nil #"gt" :general (make-internal-entdef #">")) + (define-entity nil #"amp" :general (make-internal-entdef #"&")) + (define-entity nil #"apos" :general (make-internal-entdef #"'")) + (define-entity nil #"quot" :general (make-internal-entdef #"\""))) + +(defstruct attdef + ;; an attribute definition + element ;name of element this attribute belongs to + name ;name of attribute + type ;type of attribute; either one of :CDATA, :ID, :IDREF, :IDREFS, + ; :ENTITY, :ENTITIES, :NMTOKEN, :NMTOKENS, or + ; (:NOTATION <name>*) + ; (:ENUMERATION <name>*) + default ;default value of attribute: + ; :REQUIRED, :IMPLIED, (:FIXED content) or (:DEFAULT content) + (external-p *external-subset-p*) + ) + +(defstruct elmdef + ;; an element definition + name ;name of the element + content ;content model [*] + attributes ;list of defined attributes + compiled-cspec ;cons of validation function for contentspec + (external-p *external-subset-p*) + ) + +;; [*] in XML it is possible to define attributes before the element +;; itself is defined and since we hang attribute definitions into the +;; relevant element definitions, the `content' slot indicates whether an +;; element was actually defined. It is NIL until set to a content model +;; when the element type declaration is processed. + +(defun %make-rod-hash-table () + ;; XXX with portable hash tables, this is the only way to case-sensitively + ;; use rods. However, EQUALP often has horrible performance! Most Lisps + ;; provide extensions for user-defined equality, we should use them! There + ;; is also a home-made hash table for rods defined below, written by + ;; Gilbert (I think). We could also use that one, but I would prefer the + ;; first method, even if it's unportable. + (make-hash-table :test + #+rune-is-character 'equal + #-rune-is-character 'equalp)) + +(defstruct dtd + (elements (%make-rod-hash-table)) ;elmdefs + (gentities (%make-rod-hash-table)) ;general entities + (pentities (%make-rod-hash-table)) ;parameter entities + (notations (%make-rod-hash-table))) + +(defun make-dtd-cache () + (puri:make-uri-space)) + +(defvar *cache-all-dtds* nil) +(defvar *dtd-cache* (make-dtd-cache)) + +(defun remdtd (uri dtd-cache) + (setf uri (puri:intern-uri uri dtd-cache)) + (prog1 + (and (getf (puri:uri-plist uri) 'dtd) t) + (puri:unintern-uri uri dtd-cache))) + +(defun clear-dtd-cache (dtd-cache) + (puri:unintern-uri t dtd-cache)) + +(defun getdtd (uri dtd-cache) + (getf (puri:uri-plist (puri:intern-uri uri dtd-cache)) 'dtd)) + +(defun (setf getdtd) (newval uri dtd-cache) + (setf (getf (puri:uri-plist (puri:intern-uri uri dtd-cache)) 'dtd) newval) + newval) + + +;;;; + +(defun find-element (name dtd) + (gethash name (dtd-elements dtd))) + +(defun define-element (dtd element-name &optional content-model) + (let ((e (find-element element-name dtd))) + (cond + ((null e) + (prog1 + (setf (gethash element-name (dtd-elements dtd)) + (make-elmdef :name element-name :content content-model)) + (sax:element-declaration (handler *ctx*) element-name content-model))) + ((null content-model) + e) + (t + (when *validate* + (when (elmdef-content e) + (validity-error "(05) Unique Element Type Declaration")) + (when (eq content-model :EMPTY) + (dolist (ad (elmdef-attributes e)) + (let ((type (attdef-type ad))) + (when (and (listp type) (eq (car type) :NOTATION)) + (validity-error "(16) No Notation on Empty Element: ~S" + (rod-string element-name))))))) + (sax:element-declaration (handler *ctx*) element-name content-model) + (setf (elmdef-content e) content-model) + (setf (elmdef-external-p e) *external-subset-p*) + e)))) + +(defvar *redefinition-warning* nil) + +(defun define-attribute (dtd element name type default) + (let ((adef (make-attdef :element element + :name name + :type type + :default default)) + (e (or (find-element element dtd) + (define-element dtd element)))) + (when (and *validate* (listp default)) + (unless (eq (attdef-type adef) :CDATA) + (setf (second default) (canon-not-cdata-attval (second default)))) + (validate-attribute* *ctx* adef (second default))) + (cond ((find-attribute e name) + (when *redefinition-warning* + (warn "Attribute \"~A\" of \"~A\" not redefined." + (rod-string name) + (rod-string element)))) + (t + (when *validate* + (when (eq type :ID) + (when (find :ID (elmdef-attributes e) :key #'attdef-type) + (validity-error "(09) One ID per Element Type: element ~A" + (rod-string element))) + (unless (member default '(:REQUIRED :IMPLIED)) + (validity-error "(10) ID Attribute Default: ~A" + (rod-string element)))) + (flet ((notationp (type) + (and (listp type) (eq (car type) :NOTATION)))) + (when (notationp type) + (when (find-if #'notationp (elmdef-attributes e) + :key #'attdef-type) + (validity-error "(15) One Notation Per Element Type: ~S" + (rod-string element))) + (when (eq (elmdef-content e) :EMPTY) + (validity-error "(16) No Notation on Empty Element: ~S" + (rod-string element)))))) + (sax:attribute-declaration (handler *ctx*) element name type default) + (push adef (elmdef-attributes e)))))) + +(defun find-attribute (elmdef name) + (find name (elmdef-attributes elmdef) :key #'attdef-name :test #'rod=)) + +(defun define-notation (dtd name id) + (let ((ns (dtd-notations dtd))) + (when (gethash name ns) + (validity-error "(24) Unique Notation Name: ~S" (rod-string name))) + (setf (gethash name ns) id))) + +(defun find-notation (name dtd) + (gethash name (dtd-notations dtd))) + +;;;; --------------------------------------------------------------------------- +;;;; z streams and lexer +;;;; + +(defstruct zstream + token-category + token-semantic + input-stack) + +(defun call-with-zstream (fn zstream) + (unwind-protect + (funcall fn zstream) + (dolist (input (zstream-input-stack zstream)) + (cond #-x&y-streams-are-stream + ((xstream-p input) + (close-xstream input)) + #+x&y-streams-are-stream + ((streamp input) + (close input)))))) + +(defmacro with-zstream ((zstream &rest args) &body body) + `(call-with-zstream (lambda (,zstream) ,@body) + (make-zstream ,@args))) + +(defun read-token (input) + (cond ((zstream-token-category input) + (multiple-value-prog1 + (values (zstream-token-category input) + (zstream-token-semantic input)) + (setf (zstream-token-category input) nil + (zstream-token-semantic input) nil))) + (t + (read-token-2 input)))) + +(defun peek-token (input) + (cond ((zstream-token-category input) + (values + (zstream-token-category input) + (zstream-token-semantic input))) + (t + (multiple-value-bind (c s) (read-token input) + (setf (zstream-token-category input) c + (zstream-token-semantic input) s)) + (values (zstream-token-category input) + (zstream-token-semantic input))))) + +(defun read-token-2 (input) + (cond ((null (zstream-input-stack input)) + (values :eof nil)) + (t + (let ((c (peek-rune (car (zstream-input-stack input))))) + (cond ((eq c :eof) + (cond ((eq (cadr (zstream-input-stack input)) :stop) + (values :eof nil)) + (t + (close-xstream (pop (zstream-input-stack input))) + (if (null (zstream-input-stack input)) + (values :eof nil) + (values :S nil) ;fake #x20 after PE expansion + )))) + (t + (read-token-3 input))))))) + +(defvar *data-behaviour* + ) ;either :DTD or :DOC + +(defun read-token-3 (zinput) + (let ((input (car (zstream-input-stack zinput)))) + ;; PI Comment + (let ((c (read-rune input))) + (cond + ;; first the common tokens + ((rune= #/< c) + (read-token-after-|<| zinput input)) + ;; now dispatch + (t + (ecase *data-behaviour* + (:DTD + (cond ((rune= #/\[ c) :\[) + ((rune= #/\] c) :\]) + ((rune= #/\( c) :\() + ((rune= #/\) c) :\)) + ((rune= #/\| c) :\|) + ((rune= #/\> c) :\>) + ((rune= #/\" c) :\") + ((rune= #/\' c) :\') + ((rune= #/\, c) :\,) + ((rune= #/\? c) :\?) + ((rune= #/\* c) :\*) + ((rune= #/\+ c) :\+) + ((name-rune-p c) + (unread-rune c input) + (values :nmtoken (read-name-token input))) + ((rune= #/# c) + (let ((q (read-name-token input))) + (cond ((rod= q '#.(string-rod "REQUIRED")) :|#REQUIRED|) + ((rod= q '#.(string-rod "IMPLIED")) :|#IMPLIED|) + ((rod= q '#.(string-rod "FIXED")) :|#FIXED|) + ((rod= q '#.(string-rod "PCDATA")) :|#PCDATA|) + (t + (wf-error zinput "Unknown token: ~S." q))))) + ((or (rune= c #/U+0020) + (rune= c #/U+0009) + (rune= c #/U+000D) + (rune= c #/U+000A)) + (values :S nil)) + ((rune= #/% c) + (cond ((name-start-rune-p (peek-rune input)) + ;; an entity reference + (read-pe-reference zinput)) + (t + (values :%)))) + (t + (wf-error zinput "Unexpected character ~S." c)))) + (:DOC + (cond + ((rune= c #/&) + (multiple-value-bind (kind data) (read-entity-like input) + (cond ((eq kind :ENTITY-REFERENCE) + (values :ENTITY-REF data)) + ((eq kind :CHARACTER-REFERENCE) + (values :CDATA + (with-rune-collector (collect) + (%put-unicode-char data collect))))))) + (t + (unread-rune c input) + (values :CDATA (read-cdata input))))))))))) + +(definline check-rune (input actual expected) + (unless (eql actual expected) + (wf-error input "expected #/~A but found #/~A" + (rune-char expected) + (rune-char actual)))) + +(defun read-pe-reference (zinput) + (let* ((input (car (zstream-input-stack zinput))) + (nam (read-name-token input))) + (check-rune input #/\; (read-rune input)) + (cond (*expand-pe-p* + ;; no external entities here! + (let ((i2 (entity->xstream zinput nam :parameter))) + (zstream-push i2 zinput)) + (values :S nil) ;space before inserted PE expansion. + ) + (t + (values :PE-REFERENCE nam)) ))) + +(defun read-token-after-|<| (zinput input) + (let ((d (read-rune input))) + (cond ((eq d :eof) + (eox input "EOF after '<'")) + ((rune= #/! d) + (read-token-after-|<!| input)) + ((rune= #/? d) + (multiple-value-bind (target content) (read-pi input) + (cond ((rod= target '#.(string-rod "xml")) + (values :xml-decl (cons target content))) + ((rod-equal target '#.(string-rod "XML")) + (wf-error zinput + "You lost -- no XML processing instructions.")) + ((and sax:*namespace-processing* (position #/: target)) + (wf-error zinput + "Processing instruction target ~S is not a ~ + valid NcName." + (mu target))) + (t + (values :PI (cons target content)))))) + ((eq *data-behaviour* :DTD) + (unread-rune d input) + (unless (or (rune= #// d) (name-start-rune-p d)) + (wf-error zinput "Expected '!' or '?' after '<' in DTD.")) + (values :seen-< nil)) + ((rune= #// d) + (let ((c (peek-rune input))) + (cond ((name-start-rune-p c) + (read-tag-2 zinput input :etag)) + (t + (wf-error zinput + "Expecting name start rune after \"</\"."))))) + ((name-start-rune-p d) + (unread-rune d input) + (read-tag-2 zinput input :stag)) + (t + (wf-error zinput "Expected '!' or '?' after '<' in DTD."))))) + +(defun read-token-after-|<!| (input) + (let ((d (read-rune input))) + (cond ((eq d :eof) + (eox input "EOF after \"<!\".")) + ((name-start-rune-p d) + (unread-rune d input) + (let ((name (read-name-token input))) + (cond ((rod= name '#.(string-rod "ELEMENT")) :|<!ELEMENT|) + ((rod= name '#.(string-rod "ENTITY")) :|<!ENTITY|) + ((rod= name '#.(string-rod "ATTLIST")) :|<!ATTLIST|) + ((rod= name '#.(string-rod "NOTATION")) :|<!NOTATION|) + ((rod= name '#.(string-rod "DOCTYPE")) :|<!DOCTYPE|) + (t + (wf-error input"`<!~A' unknown." (rod-string name)))))) + ((rune= #/\[ d) + (values :|<![| nil)) + ((rune= #/- d) + (setf d (read-rune input)) + (cond ((rune= #/- d) + (values + :COMMENT + (read-comment-content input))) + (t + (wf-error input"Bad character ~S after \"<!-\"" d)))) + (t + (wf-error input "Bad character ~S after \"<!\"" d))))) + +(definline read-S? (input) + (while (member (peek-rune input) '(#/U+0020 #/U+0009 #/U+000A #/U+000D) + :test #'eql) + (consume-rune input))) + +(defun read-attribute-list (zinput input imagine-space-p) + (cond ((or imagine-space-p + (let ((c (peek-rune input))) + (and (not (eq c :eof)) + (space-rune-p c)))) + (read-S? input) + (cond ((eq (peek-rune input) :eof) + nil) + ((name-start-rune-p (peek-rune input)) + (cons (read-attribute zinput input) + (read-attribute-list zinput input nil))) + (t + nil))) + (t + nil))) + +(defun read-entity-like (input) + "Read an entity reference off the xstream `input'. Returns two values: + either :ENTITY-REFERENCE <interned-rod> in case of a named entity + or :CHARACTER-REFERENCE <integer> in case of character references. + The initial #\\& is considered to be consumed already." + (let ((c (peek-rune input))) + (cond ((eq c :eof) + (eox input "EOF after '&'")) + ((rune= c #/#) + (values :CHARACTER-REFERENCE (read-character-reference input))) + (t + (unless (name-start-rune-p (peek-rune input)) + (wf-error input "Expecting name after &.")) + (let ((name (read-name-token input))) + (setf c (read-rune input)) + (unless (rune= c #/\;) + (wf-error input "Expected \";\".")) + (values :ENTITY-REFERENCE name)))))) + +(defun read-tag-2 (zinput input kind) + (let ((name (read-name-token input)) + (atts nil)) + (setf atts (read-attribute-list zinput input nil)) + + ;; check for double attributes + (do ((q atts (cdr q))) + ((null q)) + (cond ((find (caar q) (cdr q) :key #'car) + (wf-error zinput "Attribute ~S has two definitions in element ~S." + (rod-string (caar q)) + (rod-string name))))) + + (cond ((eq (peek-rune input) #/>) + (consume-rune input) + (values kind (cons name atts))) + ((eq (peek-rune input) #//) + (consume-rune input) + (check-rune input #/> (read-rune input)) + (values :ztag (cons name atts))) + (t + (wf-error zinput "syntax error in read-tag-2.")) ))) + +(defun read-attribute (zinput input) + (unless (name-start-rune-p (peek-rune input)) + (wf-error zinput "Expected name.")) + ;; arg thanks to the post mortem nature of name space declarations, + ;; we could only process the attribute values post mortem. + (let ((name (read-name-token input))) + (while (let ((c (peek-rune input))) + (and (not (eq c :eof)) + (or (rune= c #/U+0020) + (rune= c #/U+0009) + (rune= c #/U+000A) + (rune= c #/U+000D)))) + (consume-rune input)) + (unless (eq (read-rune input) #/=) + (wf-error zinput "Expected \"=\".")) + (while (let ((c (peek-rune input))) + (and (not (eq c :eof)) + (or (rune= c #/U+0020) + (rune= c #/U+0009) + (rune= c #/U+000A) + (rune= c #/U+000D)))) + (consume-rune input)) + (cons name (read-att-value-2 input)))) + +(defun canon-not-cdata-attval (value) + ;; | If the declared value is not CDATA, then the XML processor must + ;; | further process the normalized attribute value by discarding any + ;; | leading and trailing space (#x20) characters, and by replacing + ;; | sequences of space (#x20) characters by a single space (#x20) + ;; | character. + (with-rune-collector (collect) + (let ((gimme-20 nil) + (anything-seen-p nil)) + (map nil (lambda (c) + (cond ((rune= c #/u+0020) + (setf gimme-20 t)) + (t + (when (and anything-seen-p gimme-20) + (collect #/u+0020)) + (setf gimme-20 nil) + (setf anything-seen-p t) + (collect c)))) + value)))) + +(definline data-rune-p (rune) + ;; any Unicode character, excluding the surrogate blocks, FFFE, and FFFF. + ;; + ;; FIXME: das halte ich fuer verkehrt. Surrogates als Unicode-Zeichen + ;; sind verboten. Das liegt hier aber nicht vor, denn wir arbeiten + ;; ja tatsaechlich mit UTF-16. Verboten ist es nur, wenn wir ein + ;; solches Zeichen beim Dekodieren finden, das wird aber eben + ;; in encodings.lisp bereits geprueft. --david + (let ((c (rune-code rune))) + (or (= c #x9) (= c #xA) (= c #xD) + (<= #x20 c #xD7FF) + (<= #xE000 c #xFFFD) + (<= #xD800 c #xDBFF) + (<= #xDC00 c #xDFFF)))) + +(defun read-att-value (zinput input mode &optional canon-space-p (delim nil)) + (with-rune-collector-2 (collect) + (labels ((muffle (input delim) + (let (c) + (loop + (setf c (read-rune input)) + (cond ((eql delim c) + (return)) + ((eq c :eof) + (eox input "EOF")) + ((rune= c #/&) + (setf c (peek-rune input)) + (cond ((eql c :eof) + (eox input)) + ((rune= c #/#) + (let ((c (read-character-reference input))) + (%put-unicode-char c collect))) + (t + (unless (name-start-rune-p (peek-rune input)) + (wf-error zinput "Expecting name after &.")) + (let ((name (read-name-token input))) + (setf c (read-rune input)) + (check-rune input c #/\;) + (ecase mode + (:ATT + (recurse-on-entity + zinput name :general + (lambda (zinput) + (muffle (car (zstream-input-stack zinput)) + :eof)) + t)) + (:ENT + ;; bypass, but never the less we + ;; need to check for legal + ;; syntax. + ;; Must it be defined? + ;; allerdings: unparsed sind verboten + (collect #/&) + (map nil (lambda (x) (collect x)) name) + (collect #/\; ))))))) + ((and (eq mode :ENT) (rune= c #/%)) + (let ((d (peek-rune input))) + (when (eq d :eof) + (eox input)) + (unless (name-start-rune-p d) + (wf-error zinput "Expecting name after %."))) + (let ((name (read-name-token input))) + (setf c (read-rune input)) + (check-rune input c #/\;) + (cond (*expand-pe-p* + (recurse-on-entity + zinput name :parameter + (lambda (zinput) + (muffle (car (zstream-input-stack zinput)) + :eof)))) + (t + (wf-error zinput "No PE here."))))) + ((and (eq mode :ATT) (rune= c #/<)) + (wf-error zinput "unexpected #\/<")) + ((and canon-space-p (space-rune-p c)) + (collect #/space)) + ((not (data-rune-p c)) + (wf-error zinput "illegal char: ~S." c)) + (t + (collect c))))))) + (declare (dynamic-extent #'muffle)) + (muffle input (or delim + (let ((delim (read-rune input))) + (unless (member delim '(#/\" #/\') :test #'eql) + (wf-error zinput "invalid attribute delimiter")) + delim)))))) + +(defun read-character-reference (input) + ;; The #/& is already read + (let ((res + (let ((c (read-rune input))) + (check-rune input c #/#) + (setq c (read-rune input)) + (cond ((eql c :eof) + (eox input)) + ((eql c #/x) + ;; hexadecimal + (setq c (read-rune input)) + (when (eql c :eof) + (eox input)) + (unless (digit-rune-p c 16) + (wf-error input "garbage in character reference")) + (prog1 + (parse-integer + (with-output-to-string (sink) + (write-char (rune-char c) sink) + (while (progn + (setq c (read-rune input)) + (when (eql c :eof) + (eox input)) + (digit-rune-p c 16)) + (write-char (rune-char c) sink))) + :radix 16) + (check-rune input c #/\;))) + ((rune<= #/0 c #/9) + ;; decimal + (prog1 + (parse-integer + (with-output-to-string (sink) + (write-char (rune-char c) sink) + (while (progn + (setq c (read-rune input)) + (when (eql c :eof) + (eox input)) + (rune<= #/0 c #/9)) + (write-char (rune-char c) sink))) + :radix 10) + (check-rune input c #/\;))) + (t + (wf-error input "Bad char in numeric character entity.")))))) + (unless (code-data-char-p res) + (wf-error + input + "expansion of numeric character reference (#x~X) is no data char." + res)) + res)) + +(defun read-pi (input) + ;; "<?" is already read + (let (name) + (let ((c (peek-rune input))) + (unless (name-start-rune-p c) + (wf-error input "Expecting name after '<?'")) + (setf name (read-name-token input))) + (cond + ((member (peek-rune input) '(#/U+0020 #/U+0009 #/U+000A #/U+000D) + :test #'eql) + (values name (read-pi-content input))) + (t + (unless (and (eql (read-rune input) #/?) + (eql (read-rune input) #/>)) + (wf-error input "malformed processing instruction")) + (values name ""))))) + +(defun read-pi-content (input) + (read-S? input) + (let (d) + (with-rune-collector (collect) + (block nil + (tagbody + state-1 + (setf d (read-rune input)) + (when (eq d :eof) + (eox input)) + (unless (data-rune-p d) + (wf-error input "Illegal char: ~S." d)) + (when (rune= d #/?) (go state-2)) + (collect d) + (go state-1) + state-2 ;; #/? seen + (setf d (read-rune input)) + (when (eq d :eof) + (eox input)) + (unless (data-rune-p d) + (wf-error input "Illegal char: ~S." d)) + (when (rune= d #/>) (return)) + (when (rune= d #/?) + (collect #/?) + (go state-2)) + (collect #/?) + (collect d) + (go state-1)))))) + +(defun read-comment-content (input &aux d) + (with-rune-collector (collect) + (block nil + (tagbody + state-1 + (setf d (read-rune input)) + (when (eq d :eof) + (eox input)) + (unless (data-rune-p d) + (wf-error input "Illegal char: ~S." d)) + (when (rune= d #/-) (go state-2)) + (collect d) + (go state-1) + state-2 ;; #/- seen + (setf d (read-rune input)) + (when (eq d :eof) + (eox input)) + (unless (data-rune-p d) + (wf-error input "Illegal char: ~S." d)) + (when (rune= d #/-) (go state-3)) + (collect #/-) + (collect d) + (go state-1) + state-3 ;; #/- #/- seen + (setf d (read-rune input)) + (when (eq d :eof) + (eox input)) + (unless (data-rune-p d) + (wf-error input "Illegal char: ~S." d)) + (when (rune= d #/>) (return)) + (wf-error input "'--' not allowed in a comment") + (when (rune= d #/-) + (collect #/-) + (go state-3)) + (collect #/-) + (collect #/-) + (collect d) + (go state-1))))) + +(defun read-cdata-sect (input &aux d) + ;; <![CDATA[ is already read + ;; read anything up to ]]> + (with-rune-collector (collect) + (block nil + (tagbody + state-1 + (setf d (read-rune input)) + (when (eq d :eof) + (eox input)) + (unless (data-rune-p d) + (wf-error input "Illegal char: ~S." d)) + (when (rune= d #/\]) (go state-2)) + (collect d) + (go state-1) + state-2 ;; #/] seen + (setf d (read-rune input)) + (when (eq d :eof) + (eox input)) + (unless (data-rune-p d) + (wf-error input "Illegal char: ~S." d)) + (when (rune= d #/\]) (go state-3)) + (collect #/\]) + (collect d) + (go state-1) + state-3 ;; #/\] #/\] seen + (setf d (read-rune input)) + (when (eq d :eof) + (eox input)) + (unless (data-rune-p d) + (wf-error input "Illegal char: ~S." d)) + (when (rune= d #/>) + (return)) + (when (rune= d #/\]) + (collect #/\]) + (go state-3)) + (collect #/\]) + (collect #/\]) + (collect d) + (go state-1))))) + +;; some character categories + +(defun space-rune-p (rune) + (declare (type rune rune)) + (or (rune= rune #/U+0020) + (rune= rune #/U+0009) + (rune= rune #/U+000A) + (rune= rune #/U+000D))) + +(defun code-data-char-p (c) + ;; any Unicode character, excluding the surrogate blocks, FFFE, and FFFF. + (or (= c #x9) (= c #xA) (= c #xD) + (<= #x20 c #xD7FF) + (<= #xE000 c #xFFFD) + (<= #x10000 c #x10FFFF))) + +(defun pubid-char-p (c) + (or (rune= c #/u+0020) (rune= c #/u+000D) (rune= c #/u+000A) + (rune<= #/a c #/z) + (rune<= #/A c #/Z) + (rune<= #/0 c #/9) + (member c '(#/- #/' #/\( #/\) #/+ #/, #/. #// + #/: #/= #/? #/\; #/! #/* #/# + #/@ #/$ #/_ #/%)))) + + +(defun expect (input category) + (multiple-value-bind (cat sem) (read-token input) + (unless (eq cat category) + (wf-error input "Expected ~S saw ~S [~S]" category cat sem)) + (values cat sem))) + +(defun consume-token (input) + (read-token input)) + +;;;; --------------------------------------------------------------------------- +;;;; Parser +;;;; + +(defun p/S (input) + ;; S ::= (#x20 | #x9 | #xD | #xA)+ + (expect input :S) + (while (eq (peek-token input) :S) + (consume-token input))) + +(defun p/S? (input) + ;; S ::= (#x20 | #x9 | #xD | #xA)+ + (while (eq (peek-token input) :S) + (consume-token input))) + +(defun p/nmtoken (input) + (nth-value 1 (expect input :nmtoken))) + +(defun p/name (input) + (let ((result (p/nmtoken input))) + (unless (name-start-rune-p (elt result 0)) + (wf-error input "Expected name.")) + result)) + +(defun p/attlist-decl (input) + ;; [52] AttlistDecl ::= '<!ATTLIST' S Name (S AttDef)* S? '>' + (let (elm-name) + (expect input :|<!ATTLIST|) + (p/S input) + (setf elm-name (p/nmtoken input)) + (loop + (let ((tok (read-token input))) + (case tok + (:S + (p/S? input) + (cond ((eq (peek-token input) :>) + (consume-token input) + (return)) + (t + (multiple-value-bind (name type default) (p/attdef input) + (define-attribute (dtd *ctx*) elm-name name type default)) ))) + (:> + (return)) + (otherwise + (wf-error input + "Expected either another AttDef or end of \"<!ATTLIST\". -- saw ~S." + tok))))))) + +(defun p/attdef (input) + ;; [53] AttDef ::= Name S AttType S DefaultDecl + (let (name type default) + (setf name (p/nmtoken input)) + (p/S input) + (setf type (p/att-type input)) + (p/S input) + (setf default (p/default-decl input)) + (values name type default))) + +(defun p/list (input item-parser delimiter) + ;; Parse something like S? <item> (S? <delimiter> <item>)* S? + ;; + (declare (type function item-parser)) + (let (res) + (p/S? input) + (setf res (list (funcall item-parser input))) + (loop + (p/S? input) + (cond ((eq (peek-token input) delimiter) + (consume-token input) + (p/S? input) + (push (funcall item-parser input) res)) + (t + (return)))) + (p/S? input) + (reverse res))) + +(defun p/att-type (input) + ;; [54] AttType ::= StringType | TokenizedType | EnumeratedType + ;; [55] StringType ::= 'CDATA' + ;; [56] TokenizedType ::= 'ID' /*VC: ID */ + ;; /*VC: One ID per Element Type */ + ;; /*VC: ID Attribute Default */ + ;; | 'IDREF' /*VC: IDREF */ + ;; | 'IDREFS' /*VC: IDREF */ + ;; | 'ENTITY' /*VC: Entity Name */ + ;; | 'ENTITIES' /*VC: Entity Name */ + ;; | 'NMTOKEN' /*VC: Name Token */ + ;; | 'NMTOKENS' /*VC: Name Token */ + ;; [57] EnumeratedType ::= NotationType | Enumeration + ;; [58] NotationType ::= 'NOTATION' S '(' S? Name (S? '|' S? Name)* S? ')' + ;; /* VC: Notation Attributes */ + ;; [59] Enumeration ::= '(' S? Nmtoken (S? '|' S? Nmtoken)* S? ')' /* VC: Enumeration */ + (multiple-value-bind (cat sem) (read-token input) + (cond ((eq cat :nmtoken) + (cond ((rod= sem '#.(string-rod "CDATA")) :CDATA) + ((rod= sem '#.(string-rod "ID")) :ID) + ((rod= sem '#.(string-rod "IDREF")) :IDREFS) + ((rod= sem '#.(string-rod "IDREFS")) :IDREFS) + ((rod= sem '#.(string-rod "ENTITY")) :ENTITY) + ((rod= sem '#.(string-rod "ENTITIES")) :ENTITIES) + ((rod= sem '#.(string-rod "NMTOKEN")) :NMTOKEN) + ((rod= sem '#.(string-rod "NMTOKENS")) :NMTOKENS) + ((rod= sem '#.(string-rod "NOTATION")) + (let (names) + (p/S input) + (expect input :\() + (setf names (p/list input #'p/nmtoken :\| )) + (expect input :\)) + (when *validate* + (setf (referenced-notations *ctx*) + (append names (referenced-notations *ctx*)))) + (cons :NOTATION names))) + (t + (wf-error input "In p/att-type: ~S ~S." cat sem)))) + ((eq cat :\() + ;; XXX Die Nmtoken-Syntax pruefen wir derzeit nur beim Validieren. + (let (names) + ;;(expect input :\() + (setf names (p/list input #'p/nmtoken :\| )) + (expect input :\)) + (cons :ENUMERATION names))) + (t + (wf-error input "In p/att-type: ~S ~S." cat sem)) ))) + +(defun p/default-decl (input) + ;; [60] DefaultDecl ::= '#REQUIRED' | '#IMPLIED' + ;; | (('#FIXED' S)? AttValue) /* VC: Required Attribute */ + ;; + ;; /* VC: Attribute Default Legal */ + ;; /* WFC: No < in Attribute Values */ + ;; /* VC: Fixed Attribute Default */ + (multiple-value-bind (cat sem) (peek-token input) + (cond ((eq cat :|#REQUIRED|) + (consume-token input) :REQUIRED) + ((eq cat :|#IMPLIED|) + (consume-token input) :IMPLIED) + ((eq cat :|#FIXED|) + (consume-token input) + (p/S input) + (list :FIXED (p/att-value input))) + ((or (eq cat :\') (eq cat :\")) + (list :DEFAULT (p/att-value input))) + (t + (wf-error input "p/default-decl: ~S ~S." cat sem)) ))) +;;;; + +;; [70] EntityDecl ::= GEDecl | PEDecl +;; [71] GEDecl ::= '<!ENTITY' S Name S EntityDef S? '>' +;; [72] PEDecl ::= '<!ENTITY' S '%' S Name S PEDef S? '>' +;; [73] EntityDef ::= EntityValue | (ExternalID NDataDecl?) +;; [74] PEDef ::= EntityValue | ExternalID +;; [75] ExternalID ::= 'SYSTEM' S SystemLiteral +;; | 'PUBLIC' S PubidLiteral S SystemLiteral +;; [76] NDataDecl ::= S 'NDATA' S Name /* VC: Notation Declared */ + +(defun p/entity-decl (input) + (let (name def kind) + (expect input :|<!ENTITY|) + (p/S input) + (cond ((eq (peek-token input) :%) + (setf kind :parameter) + (consume-token input) + (p/S input)) + (t + (setf kind :general))) + (setf name (p/name input)) + (p/S input) + (setf def (p/entity-def input kind)) + (define-entity input name kind def) + (p/S? input) + (expect input :\>))) + +(defun report-entity (h kind name def) + (etypecase def + (external-entdef + (let ((extid (entdef-extid def)) + (ndata (entdef-ndata def))) + (if ndata + (sax:unparsed-entity-declaration h + name + (extid-public extid) + (uri-rod (extid-system extid)) + ndata) + (sax:external-entity-declaration h + kind + name + (extid-public extid) + (uri-rod (extid-system extid)))))) + (internal-entdef + (sax:internal-entity-declaration h kind name (entdef-value def))))) + +(defun p/entity-def (input kind) + (multiple-value-bind (cat sem) (peek-token input) + (cond ((member cat '(:\" :\')) + (make-internal-entdef (p/entity-value input))) + ((and (eq cat :nmtoken) + (or (rod= sem '#.(string-rod "SYSTEM")) + (rod= sem '#.(string-rod "PUBLIC")))) + (let (extid ndata) + (setf extid (p/external-id input nil)) + (when (eq kind :general) ;NDATA allowed at all? + (cond ((eq (peek-token input) :S) + (p/S? input) + (when (and (eq (peek-token input) :nmtoken) + (rod= (nth-value 1 (peek-token input)) + '#.(string-rod "NDATA"))) + (consume-token input) + (p/S input) + (setf ndata (p/nmtoken input)) + (when *validate* + (push ndata (referenced-notations *ctx*))))))) + (make-external-entdef extid ndata))) + (t + (wf-error input "p/entity-def: ~S / ~S." cat sem)) ))) + +(defun p/entity-value (input) + (let ((delim (if (eq (read-token input) :\") #/\" #/\'))) + (read-att-value input + (car (zstream-input-stack input)) + :ENT + nil + delim))) + +(defun p/att-value (input) + (let ((delim (if (eq (read-token input) :\") #/\" #/\'))) + (read-att-value input + (car (zstream-input-stack input)) + :ATT + t + delim))) + +(defun p/external-id (input &optional (public-only-ok-p nil)) + ;; xxx public-only-ok-p + (multiple-value-bind (cat sem) (read-token input) + (cond ((and (eq cat :nmtoken) (rod= sem '#.(string-rod "SYSTEM"))) + (p/S input) + (make-extid nil (p/system-literal input))) + ((and (eq cat :nmtoken) (rod= sem '#.(string-rod "PUBLIC"))) + (let (pub sys) + (p/S input) + (setf pub (p/pubid-literal input)) + (when (eq (peek-token input) :S) + (p/S input) + (when (member (peek-token input) '(:\" :\')) + (setf sys (p/system-literal input)))) + (when (and (not public-only-ok-p) + (null sys)) + (wf-error input "System identifier needed for this PUBLIC external identifier.")) + (make-extid pub sys))) + (t + (wf-error input "Expected external-id: ~S / ~S." cat sem))))) + + +;; [11] SystemLiteral ::= ('"' [^"]* '"') | ("'" [^']* "'") +;; [12] PubidLiteral ::= '"' PubidChar* '"' | "'" (PubidChar - "'")* "'" +;; [13] PubidChar ::= #x20 | #xD | #xA | [a-zA-Z0-9] +;; | [-'()+,./:=?;!*#@$_%] + +(defun p/id (input) + (multiple-value-bind (cat) (read-token input) + (cond ((member cat '(:\" :\')) + (let ((delim (if (eq cat :\") #/\" #/\'))) + (with-rune-collector (collect) + (loop + (let ((c (read-rune (car (zstream-input-stack input))))) + (cond ((eq c :eof) + (eox input "EOF in system literal.")) + ((rune= c delim) + (return)) + (t + (collect c)))))))) + (t + (wf-error input "Expect either \" or \'."))))) + +;; it is important to cache the orginal URI rod, since the re-serialized +;; uri-string can be different from the one parsed originally. +(defun uri-rod (uri) + (if uri + (or (getf (puri:uri-plist uri) 'original-rod) + (rod (puri:render-uri uri nil))) + nil)) + +(defun safe-parse-uri (str) + ;; puri doesn't like strings starting with file:///, although that is a very + ;; common is practise. Cut it away, we don't distinguish between scheme + ;; :FILE and NIL anway. + (when (eql (search "file://" str) 0) + (setf str (subseq str (length "file://")))) + (puri:parse-uri (coerce str 'simple-string))) + +(defun p/system-literal (input) + (let* ((rod (p/id input)) + (result (safe-parse-uri (rod-string rod)))) + (setf (getf (puri:uri-plist result) 'original-rod) rod) + result)) + +(defun p/pubid-literal (input) + (let ((result (p/id input))) + (unless (every #'pubid-char-p result) + (wf-error input "Illegal pubid: ~S." (rod-string result))) + result)) + + +;;;; + +(defun p/element-decl (input) + (let (name content) + (expect input :|<!ELEMENT|) + (p/S input) + (setf name (p/nmtoken input)) + (p/S input) + (setf content (normalize-mixed-cspec (p/cspec input))) + (unless (legal-content-model-p content *validate*) + (wf-error input "Malformed or invalid content model: ~S." (mu content))) + (p/S? input) + (expect input :\>) + (when *validate* + (define-element (dtd *ctx*) name content)) + (list :element name content))) + +(defun maybe-compile-cspec (e) + (or (elmdef-compiled-cspec e) + (setf (elmdef-compiled-cspec e) + (let ((cspec (elmdef-content e))) + (unless cspec + (validity-error "(03) Element Valid: no definition for ~A" + (rod-string (elmdef-name e)))) + (multiple-value-call #'cons + (compile-cspec cspec (standalone-check-necessary-p e))))))) + +(defun make-root-model (name) + (cons (lambda (actual-name) + (if (rod= actual-name name) + (constantly :dummy) + nil)) + (constantly t))) + +;;; content spec validation: +;;; +;;; Given a `contentspec', COMPILE-CSPEC returns as multiple values two +;;; functions A and B of one argument to be called for every +;;; A. child element +;;; B. text child node +;;; +;;; Function A will be called with +;;; - the element name rod as its argument. If that element may appear +;;; at the current position, a new function to be called for the next +;;; child is returned. Otherwise NIL is returned. +;;; - argument NIL at the end of the element, it must then return T or NIL +;;; to indicate whether the end tag is valid. +;;; +;;; Function B will be called with the character data rod as its argument, it +;;; returns a boolean indicating whether this text node is allowed. +;;; +;;; That is, if one of the functions ever returns NIL, the node is +;;; rejected as invalid. + +(defun cmodel-done (actual-value) + (null actual-value)) + +(defun compile-cspec (cspec &optional standalone-check) + (cond + ((atom cspec) + (ecase cspec + (:EMPTY (values #'cmodel-done (constantly nil))) + (:PCDATA (values #'cmodel-done (constantly t))) + (:ANY + (values (labels ((doit (name) (if name #'doit t))) #'doit) + (constantly t))))) + ((and (eq (car cspec) '*) + (let ((subspec (second cspec))) + (and (eq (car subspec) 'or) (eq (cadr subspec) :PCDATA)))) + (values (compile-mixed (second cspec)) + (constantly t))) + (t + (values (compile-content-model cspec) + (lambda (rod) + (when standalone-check + (validity-error "(02) Standalone Document Declaration: whitespace")) + (every #'white-space-rune-p rod)))))) + +(defun compile-mixed (cspec) + ;; das koennten wir theoretisch auch COMPILE-CONTENT-MODEL erledigen lassen + (let ((allowed-names (cddr cspec))) + (labels ((doit (actual-name) + (cond + ((null actual-name) t) + ((member actual-name allowed-names :test #'rod=) #'doit) + (t nil)))) + #'doit))) + +(defun compile-content-model (cspec &optional (continuation #'cmodel-done)) + (if (vectorp cspec) + (lambda (actual-name) + (if (and actual-name (rod= cspec actual-name)) + continuation + nil)) + (ecase (car cspec) + (and + (labels ((traverse (seq) + (compile-content-model (car seq) + (if (cdr seq) + (traverse (cdr seq)) + continuation)))) + (traverse (cdr cspec)))) + (or + (let ((options (mapcar (rcurry #'compile-content-model continuation) + (cdr cspec)))) + (lambda (actual-name) + (some (rcurry #'funcall actual-name) options)))) + (? + (let ((maybe (compile-content-model (second cspec) continuation))) + (lambda (actual-name) + (or (funcall maybe actual-name) + (funcall continuation actual-name))))) + (* + (let (maybe-continuation) + (labels ((recurse (actual-name) + (if (null actual-name) + (funcall continuation actual-name) + (or (funcall maybe-continuation actual-name) + (funcall continuation actual-name))))) + (setf maybe-continuation + (compile-content-model (second cspec) #'recurse)) + #'recurse))) + (+ + (let ((it (cadr cspec))) + (compile-content-model `(and ,it (* ,it)) continuation)))))) + +(defun setp (list &key (test 'eql)) + (equal list (remove-duplicates list :test test))) + +(defun legal-content-model-p (cspec &optional validate) + (or (eq cspec :PCDATA) + (eq cspec :ANY) + (eq cspec :EMPTY) + (and (consp cspec) + (eq (car cspec) '*) + (consp (cadr cspec)) + (eq (car (cadr cspec)) 'or) + (eq (cadr (cadr cspec)) :PCDATA) + (every #'vectorp (cddr (cadr cspec))) + (if (and validate (not (setp (cddr (cadr cspec)) :test #'rod=))) + (validity-error "VC: No Duplicate Types (07)") + t)) + (labels ((walk (x) + (cond ((member x '(:PCDATA :ANY :EMPTY)) + nil) + ((atom x) t) + ((and (walk (car x)) + (walk (cdr x))))))) + (walk cspec)))) + +;; wir fahren besser, wenn wir machen: + +;; cspec ::= 'EMPTY' | 'ANY' | '#PCDATA' +;; | Name +;; | cs +;; cs ::= '(' S? cspec ( S? '|' S? cspec)* S? ')' ('?' | '*' | '+')? +;; und eine post factum analyse + +(defun p/cspec (input &optional recursivep) + (let ((term + (let ((names nil) op-cat op res stream) + (multiple-value-bind (cat sem) (peek-token input) + (cond ((eq cat :nmtoken) + (consume-token input) + (cond ((rod= sem '#.(string-rod "EMPTY")) + :EMPTY) + ((rod= sem '#.(string-rod "ANY")) + :ANY) + ((not recursivep) + (wf-error input "invalid content spec")) + (t + sem))) + ((eq cat :\#PCDATA) + (consume-token input) + :PCDATA) + ((eq cat :\() + (setf stream (car (zstream-input-stack input))) + (consume-token input) + (p/S? input) + (setq names (list (p/cspec input t))) + (p/S? input) + (cond ((member (peek-token input) '(:\| :\,)) + (setf op-cat (peek-token input)) + (setf op (if (eq op-cat :\,) 'and 'or)) + (while (eq (peek-token input) op-cat) + (consume-token input) + (p/S? input) + (push (p/cspec input t) names) + (p/S? input)) + (setf res (cons op (reverse names)))) + (t + (setf res (cons 'and names)))) + (p/S? input) + (expect input :\)) + (when *validate* + (unless (eq stream (car (zstream-input-stack input))) + (validity-error "(06) Proper Group/PE Nesting"))) + res) + (t + (wf-error input "p/cspec - ~s / ~s" cat sem))))))) + (cond ((eq (peek-token input) :?) (consume-token input) (list '? term)) + ((eq (peek-token input) :+) (consume-token input) (list '+ term)) + ((eq (peek-token input) :*) (consume-token input) (list '* term)) + (t + term)))) + +(defun normalize-mixed-cspec (cspec) + ;; der Parser oben funktioniert huebsch fuer die children-Regel, aber + ;; fuer Mixed ist das Ergebnis nicht praktisch, denn dort wollen wir + ;; eigentlich auf eine Liste von Namen in einheitlichem Format hinaus. + ;; Dazu normalisieren wir einfach in eine der beiden folgenden Formen: + ;; (* (or :PCDATA ...rods...)) -- und zwar exakt so! + ;; :PCDATA -- sonst ganz trivial + (flet ((trivialp (c) + (and (consp c) + (and (eq (car c) 'and) + (eq (cadr c) :PCDATA) + (null (cddr c)))))) + (if (or (trivialp cspec) ;(and PCDATA) + (and (consp cspec) ;(* (and PCDATA)) + (and (eq (car cspec) '*) + (null (cddr cspec)) + (trivialp (cadr cspec))))) + :PCDATA + cspec))) + +;; [52] AttlistDecl ::= '<!ATTLIST' S Name AttDef* S? '>' + + +;; [52] AttlistDecl ::= '<!ATTLIST' S Name AttDefs S? '>' +;; [52] AttlistDecl ::= '<!ATTLIST' S Name S? '>' +;; [53] AttDefs ::= S Name S AttType S DefaultDecl AttDefs +;; [53] AttDefs ::= + +(defun p/notation-decl (input) + (let (name id) + (expect input :|<!NOTATION|) + (p/S input) + (setf name (p/name input)) + (p/S input) + (setf id (p/external-id input t)) + (p/S? input) + (expect input :\>) + (sax:notation-declaration (handler *ctx*) + name + (if (extid-public id) + (normalize-public-id (extid-public id)) + nil) + (uri-rod (extid-system id))) + (when (and sax:*namespace-processing* (find #/: name)) + (wf-error input "colon in notation name")) + (when *validate* + (define-notation (dtd *ctx*) name id)) + (list :notation-decl name id))) + +(defun normalize-public-id (rod) + (with-rune-collector (collect) + (let ((gimme-20 nil) + (anything-seen-p nil)) + (map nil (lambda (c) + (cond + ((or (rune= c #/u+0009) + (rune= c #/u+000A) + (rune= c #/u+000D) + (rune= c #/u+0020)) + (setf gimme-20 t)) + (t + (when (and anything-seen-p gimme-20) + (collect #/u+0020)) + (setf gimme-20 nil) + (setf anything-seen-p t) + (collect c)))) + rod)))) + +;;; + +(defun p/conditional-sect (input) + (expect input :<!\[ ) + (let ((stream (car (zstream-input-stack input)))) + (p/S? input) + (multiple-value-bind (cat sem) (read-token input) + (cond ((and (eq cat :nmtoken) + (rod= sem '#.(string-rod "INCLUDE"))) + (p/include-sect input stream)) + ((and (eq cat :nmtoken) + (rod= sem '#.(string-rod "IGNORE"))) + (p/ignore-sect input stream)) + (t + (wf-error input "Expected INCLUDE or IGNORE after \"<![\".")))))) + +(defun p/cond-expect (input cat initial-stream) + (expect input cat) + (when *validate* + (unless (eq (car (zstream-input-stack input)) initial-stream) + (validity-error "(21) Proper Conditional Section/PE Nesting")))) + +(defun p/include-sect (input initial-stream) + ;; <![INCLUDE is already read. + (p/S? input) + (p/cond-expect input :\[ initial-stream) + (p/ext-subset-decl input) + (p/cond-expect input :\] initial-stream) + (p/cond-expect input :\] initial-stream) + (p/cond-expect input :\> initial-stream)) + +(defun p/ignore-sect (input initial-stream) + ;; <![IGNORE is already read. + ;; XXX Is VC 21 being checked for nested sections? + (p/S? input) + (p/cond-expect input :\[ initial-stream) + (let ((input (car (zstream-input-stack input)))) + (let ((level 0)) + (do ((c1 (read-rune input) (read-rune input)) + (c2 #/U+0000 c1) + (c3 #/U+0000 c2)) + ((= level -1)) + (declare (type fixnum level)) + (cond ((eq c1 :eof) + (eox input "EOF in <![IGNORE ... >"))) + (cond ((and (rune= c3 #/<) (rune= c2 #/!) (rune= c1 #/\[)) + (incf level))) + (cond ((and (rune= c3 #/\]) (rune= c2 #/\]) (rune= c1 #/>)) + (decf level))) ))) + (unless (eq (car (zstream-input-stack input)) initial-stream) + (validity-error "(21) Proper Conditional Section/PE Nesting"))) + +(defun p/ext-subset-decl (input) + ;; ( markupdecl | conditionalSect | S )* + (loop + (case (let ((*expand-pe-p* nil)) (peek-token input)) + (:|<![| (let ((*expand-pe-p* t)) (p/conditional-sect input))) + (:S (consume-token input)) + (:eof (return)) + ((:|<!ELEMENT| :|<!ATTLIST| :|<!ENTITY| :|<!NOTATION| :PI :COMMENT) + (let ((*expand-pe-p* t) + (*external-subset-p* t)) + (p/markup-decl input))) + ((:PE-REFERENCE) + (let ((name (nth-value 1 (read-token input)))) + (recurse-on-entity input name :parameter + (lambda (input) + (etypecase (checked-get-entdef name :parameter) + (external-entdef + (p/ext-subset input)) + (internal-entdef + (p/ext-subset-decl input))) + (unless (eq :eof (peek-token input)) + (wf-error input "Trailing garbage.")))))) + (otherwise (return)))) ) + +(defun p/markup-decl (input) + (peek-token input) + (let ((stream (car (zstream-input-stack input)))) + (multiple-value-prog1 + (p/markup-decl-unsafe input) + (when *validate* + (unless (eq stream (car (zstream-input-stack input))) + (validity-error "(01) Proper Declaration/PE Nesting")))))) + +(defun p/markup-decl-unsafe (input) + ;; markupdecl ::= elementdecl | AttlistDecl /* VC: Proper Declaration/PE Nesting */ + ;; | EntityDecl | NotationDecl + ;; | PI | Comment /* WFC: PEs in Internal Subset */ + (let ((token (peek-token input)) + (*expand-pe-p* (and *expand-pe-p* *external-subset-p*))) + (case token + (:|<!ELEMENT| (p/element-decl input)) + (:|<!ATTLIST| (p/attlist-decl input)) + (:|<!ENTITY| (p/entity-decl input)) + (:|<!NOTATION| (p/notation-decl input)) + (:PI + (let ((sem (nth-value 1 (read-token input)))) + (sax:processing-instruction (handler *ctx*) (car sem) (cdr sem)))) + (:COMMENT (consume-token input)) + (otherwise + (wf-error input "p/markup-decl ~S" (peek-token input)))))) + +(defun setup-encoding (input xml-header) + (when (xml-header-encoding xml-header) + (let ((enc (find-encoding (xml-header-encoding xml-header)))) + (cond (enc + (setf (xstream-encoding (car (zstream-input-stack input))) + enc)) + (t + (warn "There is no such encoding: ~S." (xml-header-encoding xml-header))))))) + +(defun set-full-speed (input) + (let ((xstream (car (zstream-input-stack input)))) + (when xstream + (set-to-full-speed xstream)))) + +(defun p/ext-subset (input) + (cond ((eq (peek-token input) :xml-decl) + (let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input)))))) + (setup-encoding input hd)) + (consume-token input))) + (set-full-speed input) + (p/ext-subset-decl input) + (unless (eq (peek-token input) :eof) + (wf-error input "Trailing garbage - ~S." (peek-token input)))) + +(defvar *catalog* nil) + +(defun extid-using-catalog (extid) + (if *catalog* + (let ((sysid + (resolve-extid (extid-public extid) + (extid-system extid) + *catalog*))) + (if sysid + (make-extid nil sysid) + extid)) + extid)) + +(defun p/doctype-decl (input &optional dtd-extid) + (let () + (let ((*expand-pe-p* nil) + name extid) + (expect input :|<!DOCTYPE|) + (p/S input) + (setq name (p/nmtoken input)) + (when *validate* + (setf (model-stack *ctx*) (list (make-root-model name)))) + (when (eq (peek-token input) :S) + (p/S input) + (unless (or (eq (peek-token input) :\[ ) + (eq (peek-token input) :\> )) + (setf extid (p/external-id input t)))) + (when dtd-extid + (setf extid dtd-extid)) + (p/S? input) + (sax:start-dtd (handler *ctx*) + name + (and extid (extid-public extid)) + (and extid (uri-rod (extid-system extid)))) + (when (eq (peek-token input) :\[ ) + (when (disallow-internal-subset *ctx*) + (wf-error input "document includes an internal subset")) + (ensure-dtd) + (consume-token input) + (sax:start-internal-subset (handler *ctx*)) + (while (progn (p/S? input) + (not (eq (peek-token input) :\] ))) + (if (eq (peek-token input) :PE-REFERENCE) + (let ((name (nth-value 1 (read-token input)))) + (recurse-on-entity input name :parameter + (lambda (input) + (etypecase (checked-get-entdef name :parameter) + (external-entdef + (p/ext-subset input)) + (internal-entdef + (p/ext-subset-decl input))) + (unless (eq :eof (peek-token input)) + (wf-error input "Trailing garbage."))))) + (let ((*expand-pe-p* t)) + (p/markup-decl input)))) + (consume-token input) + (sax:end-internal-subset (handler *ctx*)) + (p/S? input)) + (expect input :>) + (when extid + (let* ((effective-extid + (extid-using-catalog (absolute-extid input extid))) + (sysid (extid-system effective-extid)) + (fresh-dtd-p (null (dtd *ctx*))) + (cached-dtd + (and fresh-dtd-p + (not (standalone-p *ctx*)) + (getdtd sysid *dtd-cache*)))) + (cond + (cached-dtd + (setf (dtd *ctx*) cached-dtd) + (report-cached-dtd cached-dtd)) + (t + (let ((xi2 (xstream-open-extid effective-extid))) + (with-zstream (zi2 :input-stack (list xi2)) + (ensure-dtd) + (p/ext-subset zi2) + (when (and fresh-dtd-p + *cache-all-dtds* + *validate* + (not (standalone-p *ctx*))) + (setf (getdtd sysid *dtd-cache*) (dtd *ctx*))))))))) + (sax:end-dtd (handler *ctx*)) + (let ((dtd (dtd *ctx*))) + (sax:entity-resolver + (handler *ctx*) + (lambda (name handler) (resolve-entity name handler dtd))) + (sax::dtd (handler *ctx*) dtd)) + (list :DOCTYPE name extid)))) + +(defun report-cached-dtd (dtd) + (maphash (lambda (k v) + (report-entity (handler *ctx*) :general k (cdr v))) + (dtd-gentities dtd)) + (maphash (lambda (k v) + (report-entity (handler *ctx*) :parameter k (cdr v))) + (dtd-pentities dtd)) + (maphash (lambda (k v) + (sax:notation-declaration + (handler *ctx*) + k + (if (extid-public v) + (normalize-public-id (extid-public v)) + nil) + (uri-rod (extid-system v)))) + (dtd-notations dtd))) + +(defun p/misc*-2 (input) + ;; Misc* + (while (member (peek-token input) '(:COMMENT :PI :S)) + (case (peek-token input) + (:COMMENT + (sax:comment (handler *ctx*) (nth-value 1 (peek-token input)))) + (:PI + (sax:processing-instruction + (handler *ctx*) + (car (nth-value 1 (peek-token input))) + (cdr (nth-value 1 (peek-token input)))))) + (consume-token input))) + +(defun p/document + (input handler + &key validate dtd root entity-resolver disallow-internal-subset + (recode t)) + ;; check types of user-supplied arguments for better error messages: + (check-type validate boolean) + (check-type recode boolean) + (check-type dtd (or null extid)) + (check-type root (or null rod)) + (check-type entity-resolver (or null function symbol)) + (check-type disallow-internal-subset boolean) + #+rune-is-integer + (when recode + (setf handler (make-recoder handler #'rod-to-utf8-string))) + (let* ((xstream (car (zstream-input-stack input))) + (name (xstream-name xstream)) + (base (when name (stream-name-uri name))) + (*ctx* + (make-context :handler handler + :main-zstream input + :entity-resolver entity-resolver + :base-stack (list (or base "")) + :disallow-internal-subset disallow-internal-subset)) + (*validate* validate) + (*namespace-bindings* *initial-namespace-bindings*)) + (sax:register-sax-parser handler (make-instance 'cxml-parser :ctx *ctx*)) + (sax:start-document handler) + ;; document ::= XMLDecl? Misc* (doctypedecl Misc*)? element Misc* + ;; Misc ::= Comment | PI | S + ;; xmldecl::='<?xml' VersionInfo EncodingDecl? SDDecl? S? '?>' + ;; sddecl::= S 'standalone' Eq (("'" ('yes' | 'no') "'") | ('"' ('yes' | 'no') '"')) + (let ((*data-behaviour* :DTD)) + ;; optional XMLDecl? + (p/xmldecl input) + ;; Misc* + (p/misc*-2 input) + ;; (doctypedecl Misc*)? + (cond + ((eq (peek-token input) :<!DOCTYPE) + (p/doctype-decl input dtd) + (p/misc*-2 input)) + (dtd + (synthesize-doctype dtd input)) + ((and validate (not dtd)) + (validity-error "invalid document: no doctype"))) + (ensure-dtd) + ;; Override expected root element if asked to + (when root + (setf (model-stack *ctx*) (list (make-root-model root)))) + ;; element + (let ((*data-behaviour* :DOC)) + (fix-seen-< input) + (p/element input)) + ;; optional Misc* + (p/misc*-2 input) + (p/eof input) + (sax:end-document handler)))) + +(defun synthesize-doctype (dtd input) + (let ((dummy (string->xstream "<!DOCTYPE dummy>"))) + (setf (xstream-name dummy) + (make-stream-name + :entity-name "dummy doctype" + :entity-kind :main + :uri (zstream-base-sysid input))) + (with-zstream (zstream :input-stack (list dummy)) + (p/doctype-decl zstream dtd)))) + +(defun fix-seen-< (input) + (when (eq (peek-token input) :seen-<) + (multiple-value-bind (c s) + (read-token-after-|<| input (car (zstream-input-stack input))) + (setf (zstream-token-category input) c + (zstream-token-semantic input) s)))) + +(defun p/xmldecl (input) + ;; we will use the attribute-value parser for the xml decl. + (prog1 + (when (eq (peek-token input) :xml-decl) + (let ((hd (parse-xml-decl (cdr (nth-value 1 (peek-token input)))))) + (setf (standalone-p *ctx*) (eq (xml-header-standalone-p hd) :yes)) + (setup-encoding input hd) + (read-token input) + hd)) + (set-full-speed input))) + +(defun p/eof (input) + (unless (eq (peek-token input) :eof) + (wf-error input "Garbage at end of document.")) + (when *validate* + (maphash (lambda (k v) + (unless v + (validity-error "(11) IDREF: ~S not defined" (rod-string k)))) + (id-table *ctx*)) + + (dolist (name (referenced-notations *ctx*)) + (unless (find-notation name (dtd *ctx*)) + (validity-error "(23) Notation Declared: ~S" (rod-string name)))))) + +(defun p/element (input) + (multiple-value-bind (cat n-b new-b uri lname qname attrs) (p/sztag input) + (sax:start-element (handler *ctx*) uri lname qname attrs) + (when (eq cat :stag) + (let ((*namespace-bindings* n-b)) + (p/content input)) + (p/etag input qname)) + (sax:end-element (handler *ctx*) uri lname qname) + (undeclare-namespaces new-b) + (pop (base-stack *ctx*)) + (validate-end-element *ctx* qname))) + +(defun p/sztag (input) + (multiple-value-bind (cat sem) (read-token input) + (case cat + ((:stag :ztag)) + (:eof (eox input)) + (t (wf-error input "element expected"))) + (destructuring-bind (&optional name &rest raw-attrs) sem + (validate-start-element *ctx* name) + (let* ((attrs + (process-attributes *ctx* name (build-attribute-list raw-attrs))) + (*namespace-bindings* *namespace-bindings*) + new-namespaces) + (when sax:*namespace-processing* + (setf new-namespaces (declare-namespaces attrs)) + (mapc #'set-attribute-namespace attrs)) + (push (compute-base attrs) (base-stack *ctx*)) + (multiple-value-bind (uri prefix local-name) + (if sax:*namespace-processing* + (decode-qname name) + (values nil nil nil)) + (declare (ignore prefix)) + (check-attribute-uniqueness attrs) + (unless (or sax:*include-xmlns-attributes* + (null sax:*namespace-processing*)) + (setf attrs + (remove-if (compose #'xmlns-attr-p #'sax:attribute-qname) + attrs))) + (values cat + *namespace-bindings* + new-namespaces + uri local-name name attrs)))))) + +(defun p/etag (input qname) + (multiple-value-bind (cat2 sem2) (read-token input) + (unless (and (eq cat2 :etag) + (eq (car sem2) qname)) + (wf-error input "Bad nesting. ~S / ~S" + (mu qname) + (mu (cons cat2 sem2)))) + (when (cdr sem2) + (wf-error input "no attributes allowed in end tag")))) + +;; copy&paste from cxml-rng +(defun escape-uri (string) + (with-output-to-string (out) + (loop for c across (cxml::rod-to-utf8-string string) do + (let ((code (char-code c))) + ;; http://www.w3.org/TR/xlink/#link-locators + (if (or (>= code 127) (<= code 32) (find c "<>\"{}|\\^`")) + (format out "%~2,'0X" code) + (write-char c out)))))) + +(defun compute-base (attrs) + (let ((new (sax:find-attribute #"xml:base" attrs)) + (current (car (base-stack *ctx*)))) + (if new + (puri:merge-uris (escape-uri (sax:attribute-value new)) current) + current))) + +(defun process-characters (input sem) + (consume-token input) + (when (search #"]]>" sem) + (wf-error input "']]>' not allowed in CharData")) + (validate-characters *ctx* sem)) + +(defun process-cdata-section (input) + (consume-token input) + (let ((input (car (zstream-input-stack input)))) + (unless (and (rune= #/C (read-rune input)) + (rune= #/D (read-rune input)) + (rune= #/A (read-rune input)) + (rune= #/T (read-rune input)) + (rune= #/A (read-rune input)) + (rune= #/\[ (read-rune input))) + (wf-error input "After '<![', 'CDATA[' is expected.")) + (validate-characters *ctx* #"hack") ;anything other than whitespace + (read-cdata-sect input))) + +(defun p/content (input) + ;; [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)* + (loop + (multiple-value-bind (cat sem) (peek-token input) + (case cat + ((:stag :ztag) + (p/element input)) + ((:CDATA) + (process-characters input sem) + (sax:characters (handler *ctx*) sem)) + ((:ENTITY-REF) + (let ((name sem)) + (consume-token input) + (recurse-on-entity input name :general + (lambda (input) + (prog1 + (etypecase (checked-get-entdef name :general) + (internal-entdef (p/content input)) + (external-entdef (p/ext-parsed-ent input))) + (unless (eq (peek-token input) :eof) + (wf-error input "Trailing garbage. - ~S" + (peek-token input)))))))) + ((:<!\[) + (let ((data (process-cdata-section input))) + (sax:start-cdata (handler *ctx*)) + (sax:characters (handler *ctx*) data) + (sax:end-cdata (handler *ctx*)))) + ((:PI) + (consume-token input) + (sax:processing-instruction (handler *ctx*) (car sem) (cdr sem))) + ((:COMMENT) + (consume-token input) + (sax:comment (handler *ctx*) sem)) + (otherwise + (return)))))) + +;; [78] extParsedEnt ::= TextDecl? contentw +;; [79] extPE ::= TextDecl? extSubsetDecl + +(defstruct xml-header + version + encoding + (standalone-p nil)) + +(defun p/ext-parsed-ent (input) + ;; [78] extParsedEnt ::= '<?xml' VersionInfo? EncodingDecl S? '?>' content + (when (eq (peek-token input) :xml-decl) + (let ((hd (parse-text-decl (cdr (nth-value 1 (peek-token input)))))) + (setup-encoding input hd)) + (consume-token input)) + (set-full-speed input) + (p/content input)) + +(defun parse-xml-decl (content) + (let* ((res (make-xml-header)) + (i (make-rod-xstream content))) + (with-zstream (z :input-stack (list i)) + (let ((atts (read-attribute-list z i t))) + (unless (eq (peek-rune i) :eof) + (wf-error i "Garbage at end of XMLDecl.")) + ;; versioninfo muss da sein + ;; dann ? encodingdecl + ;; dann ? sddecl + ;; dann ende + (unless (eq (caar atts) (intern-name '#.(string-rod "version"))) + (wf-error i "XMLDecl needs version.")) + (unless (and (>= (length (cdar atts)) 1) + (every (lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9) + (rune= x #/_) + (rune= x #/.) + (rune= x #/:) + (rune= x #/-))) + (cdar atts))) + (wf-error i"Bad XML version number: ~S." (rod-string (cdar atts)))) + (setf (xml-header-version res) (rod-string (cdar atts))) + (pop atts) + (when (eq (caar atts) (intern-name '#.(string-rod "encoding"))) + (unless (and (>= (length (cdar atts)) 1) + (every (lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9) + (rune= x #/_) + (rune= x #/.) + (rune= x #/-))) + (cdar atts)) + ((lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z))) + (aref (cdar atts) 0))) + (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts)))) + (setf (xml-header-encoding res) (rod-string (cdar atts))) + (pop atts)) + (when (eq (caar atts) (intern-name '#.(string-rod "standalone"))) + (unless (or (rod= (cdar atts) '#.(string-rod "yes")) + (rod= (cdar atts) '#.(string-rod "no"))) + (wf-error i "XMLDecl's 'standalone' attribute must be exactly \"yes\" or \"no\" and not ~S." + (rod-string (cdar atts)))) + (setf (xml-header-standalone-p res) + (if (rod-equal '#.(string-rod "yes") (cdar atts)) + :yes + :no)) + (pop atts)) + (when atts + (wf-error i "Garbage in XMLDecl: ~A" (rod-string content))) + res)))) + +(defun parse-text-decl (content) + (let* ((res (make-xml-header)) + (i (make-rod-xstream content))) + (with-zstream (z :input-stack (list i)) + (let ((atts (read-attribute-list z i t))) + (unless (eq (peek-rune i) :eof) + (wf-error i "Garbage at end of TextDecl")) + ;; versioninfo optional + ;; encodingdecl muss da sein + ;; dann ende + (when (eq (caar atts) (intern-name '#.(string-rod "version"))) + (unless (and (>= (length (cdar atts)) 1) + (every (lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9) + (rune= x #/_) + (rune= x #/.) + (rune= x #/:) + (rune= x #/-))) + (cdar atts))) + (wf-error i "Bad XML version number: ~S." (rod-string (cdar atts)))) + (setf (xml-header-version res) (rod-string (cdar atts))) + (pop atts)) + (unless (eq (caar atts) (intern-name '#.(string-rod "encoding"))) + (wf-error i "TextDecl needs encoding.")) + (unless (and (>= (length (cdar atts)) 1) + (every (lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9) + (rune= x #/_) + (rune= x #/.) + (rune= x #/-))) + (cdar atts)) + ((lambda (x) + (or (rune<= #/a x #/z) + (rune<= #/A x #/Z) + (rune<= #/0 x #/9))) + (aref (cdar atts) 0))) + (wf-error i "Bad XML encoding name: ~S." (rod-string (cdar atts)))) + (setf (xml-header-encoding res) (rod-string (cdar atts))) + (pop atts) + (when atts + (wf-error i "Garbage in TextDecl: ~A" (rod-string content))))) + res)) + +;;;; --------------------------------------------------------------------------- +;;;; mu +;;;; + +(defun mu (x) + (cond ((stringp x) x) + ((vectorp x) (rod-string x)) + ((consp x) + (cons (mu (car x)) (mu (cdr x)))) + (x))) + +;;;; --------------------------------------------------------------------------- +;;;; User interface ;;;; + +#-cxml-system::uri-is-namestring +(defun specific-or (component &optional (alternative nil)) + (if (eq component :unspecific) + alternative + component)) + +(defun string-or (str &optional (alternative nil)) + (if (zerop (length str)) + alternative + str)) + +#-cxml-system::uri-is-namestring +(defun make-uri (&rest initargs &key path query &allow-other-keys) + (apply #'make-instance + 'puri:uri + :path (and path (escape-path path)) + :query (and query (escape-query query)) + initargs)) + +#-cxml-system::uri-is-namestring +(defun escape-path (list) + (puri::render-parsed-path list t)) + +#-cxml-system::uri-is-namestring +(defun escape-query (pairs) + (flet ((escape (str) + (puri::encode-escaped-encoding str puri::*reserved-characters* t))) + (let ((first t)) + (with-output-to-string (s) + (dolist (pair pairs) + (if first + (setf first nil) + (write-char #\& s)) + (write-string (escape (car pair)) s) + (write-char #\= s) + (write-string (escape (cdr pair)) s)))))) + +#-cxml-system::uri-is-namestring +(defun uri-parsed-query (uri) + (flet ((unescape (str) + (puri::decode-escaped-encoding str t puri::*reserved-characters*))) + (let ((str (puri:uri-query uri))) + (cond + (str + (let ((pairs '())) + (dolist (s (split-sequence-if (lambda (x) (eql x #\&)) str)) + (destructuring-bind (name value) + (split-sequence-if (lambda (x) (eql x #\=)) s) + (push (cons (unescape name) (unescape value)) pairs))) + (reverse pairs))) + (t + nil))))) + +#-cxml-system::uri-is-namestring +(defun query-value (name alist) + (cdr (assoc name alist :test #'equal))) + +#-cxml-system::uri-is-namestring +(defun pathname-to-uri (pathname) + (let ((path + (append (pathname-directory pathname) + (list + (if (specific-or (pathname-type pathname)) + (concatenate 'string + (pathname-name pathname) + "." + (pathname-type pathname)) + (pathname-name pathname)))))) + (if (eq (car path) :relative) + (make-uri :path path) + (make-uri :scheme :file + :host (concatenate 'string + (string-or (host-namestring pathname)) + "+" + (specific-or (pathname-device pathname))) + :path path)))) + +#+cxml-system::uri-is-namestring +(defun pathname-to-uri (pathname) + (puri:parse-uri (namestring pathname))) + +#-cxml-system::uri-is-namestring +(defun parse-name.type (str) + (if str + (let ((i (position #\. str :from-end t))) + (if i + (values (subseq str 0 i) (subseq str (1+ i))) + (values str nil))) + (values nil nil))) + +#-cxml-system::uri-is-namestring +(defun uri-to-pathname (uri) + (let ((scheme (puri:uri-scheme uri)) + (path (puri:uri-parsed-path uri))) + (unless (member scheme '(nil :file)) + (error 'xml-parse-error + :format-control "URI scheme ~S not supported" + :format-arguments (list scheme))) + (if (eq (car path) :relative) + (multiple-value-bind (name type) + (parse-name.type (car (last path))) + (make-pathname :directory (butlast path) + :name name + :type type)) + (multiple-value-bind (name type) + (parse-name.type (car (last (cdr path)))) + (destructuring-bind (host device) + (split-sequence-if (lambda (x) (eql x #\+)) + (or (puri:uri-host uri) "+")) + (make-pathname :host (string-or host) + :device (string-or device) + :directory (cons :absolute (butlast (cdr path))) + :name name + :type type)))))) +#+cxml-system::uri-is-namestring +(defun uri-to-pathname (uri) + (let ((pathname (puri:render-uri uri nil))) + (when (equalp (pathname-host pathname) "+") + (setf (slot-value pathname 'lisp::host) "localhost")) + pathname)) + +(defun parse + (input handler &rest args + &key validate dtd root entity-resolver disallow-internal-subset + recode pathname) + (declare (ignore validate dtd root entity-resolver disallow-internal-subset + recode)) + (let ((args + (loop + for (name value) on args by #'cddr + unless (eq name :pathname) + append (list name value)))) + (etypecase input + (xstream (apply #'parse-xstream input handler args)) + (pathname (apply #'parse-file input handler args)) + (rod (apply #'parse-rod input handler args)) + (array (apply #'parse-octets input handler args)) + (stream + (let ((xstream (make-xstream input :speed 8192))) + (setf (xstream-name xstream) + (make-stream-name + :entity-name "main document" + :entity-kind :main + :uri (pathname-to-uri + (merge-pathnames (or pathname (pathname input)))))) + (apply #'parse-xstream xstream handler args)))))) + +(defun parse-xstream (xstream handler &rest args) + (let ((*ctx* nil)) + (handler-case + (with-zstream (zstream :input-stack (list xstream)) + (peek-rune xstream) + (with-scratch-pads () + (apply #'p/document zstream handler args))) + (runes-encoding:encoding-error (c) + (wf-error xstream "~A" c))))) + +(defun parse-file (filename handler &rest args) + (with-open-xfile (input filename) + (setf (xstream-name input) + (make-stream-name + :entity-name "main document" + :entity-kind :main + :uri (pathname-to-uri (merge-pathnames filename)))) + (apply #'parse-xstream input handler args))) + +(defun resolve-synonym-stream (stream) + (while (typep stream 'synonym-stream) + (setf stream (symbol-value (synonym-stream-symbol stream)))) + stream) + +(defun safe-stream-sysid (stream) + (if (and (typep (resolve-synonym-stream stream) 'file-stream) + ;; ignore-errors, because sb-bsd-sockets creates instances of + ;; FILE-STREAMs that aren't + (ignore-errors (pathname stream))) + (pathname-to-uri (merge-pathnames (pathname stream))) + nil)) + +(defun parse-stream (stream handler &rest args) + (let ((xstream + (make-xstream + stream + :name (make-stream-name + :entity-name "main document" + :entity-kind :main + :uri (safe-stream-sysid stream)) + :initial-speed 1))) + (apply #'parse-xstream xstream handler args))) + +(defun parse-empty-document + (uri qname handler &key public-id system-id entity-resolver (recode t)) + (check-type uri (or null rod)) + (check-type qname (or null rod)) + (check-type public-id (or null rod)) + (check-type system-id (or null puri:uri)) + (check-type entity-resolver (or null function symbol)) + (check-type recode boolean) + #+rune-is-integer + (when recode + (setf handler (make-recoder handler #'rod-to-utf8-string))) + (let ((*ctx* + (make-context :handler handler :entity-resolver entity-resolver)) + (*validate* nil) + (extid + (when (or public-id system-id) + (extid-using-catalog (make-extid public-id system-id))))) + (sax:start-document handler) + (when extid + (sax:start-dtd handler + qname + (and public-id) + (and system-id (uri-rod system-id))) + (setf (dtd *ctx*) (getdtd (extid-system extid) *dtd-cache*)) + (unless (dtd *ctx*) + (with-scratch-pads () + (let ((*data-behaviour* :DTD)) + (let ((xi2 (xstream-open-extid extid))) + (with-zstream (zi2 :input-stack (list xi2)) + (ensure-dtd) + (p/ext-subset zi2)))))) + (sax:end-dtd handler) + (let ((dtd (dtd *ctx*))) + (sax:entity-resolver handler (lambda (n h) (resolve-entity n h dtd))) + (sax::dtd handler dtd))) + (ensure-dtd) + (when (or uri qname) + (let* ((attrs + (when uri + (list (sax:make-attribute :qname #"xmlns" + :value (rod uri) + :specified-p t)))) + (*namespace-bindings* *namespace-bindings*) + new-namespaces) + (when sax:*namespace-processing* + (setf new-namespaces (declare-namespaces attrs)) + (mapc #'set-attribute-namespace attrs)) + (multiple-value-bind (uri prefix local-name) + (if sax:*namespace-processing* (decode-qname qname) nil) + (declare (ignore prefix)) + (unless (or sax:*include-xmlns-attributes* + (null sax:*namespace-processing*)) + (setf attrs nil)) + (sax:start-element (handler *ctx*) uri local-name qname attrs) + (sax:end-element (handler *ctx*) uri local-name qname)) + (undeclare-namespaces new-namespaces))) + (sax:end-document handler))) + +(defun parse-dtd-file (filename &optional handler) + (with-open-file (s filename :element-type '(unsigned-byte 8)) + (parse-dtd-stream s handler))) + +(defun parse-dtd-stream (stream &optional handler) + (let ((input (make-xstream stream))) + (setf (xstream-name input) + (make-stream-name + :entity-name "dtd" + :entity-kind :main + :uri (safe-stream-sysid stream))) + (let ((*ctx* (make-context :handler handler)) + (*validate* t) + (*data-behaviour* :DTD)) + (with-zstream (zstream :input-stack (list input)) + (with-scratch-pads () + (ensure-dtd) + (peek-rune input) + (p/ext-subset zstream) + (dtd *ctx*)))))) + +(defun parse-rod (string handler &rest args) + (let ((xstream (string->xstream string))) + (setf (xstream-name xstream) + (make-stream-name + :entity-name "main document" + :entity-kind :main + :uri nil)) + (apply #'parse-xstream xstream handler args))) + +(defun string->xstream (string) + (make-rod-xstream (string-rod string))) + +(defun parse-octets (octets handler &rest args) + (apply #'parse-stream (make-octet-input-stream octets) handler args)) + +;;;; + +(defun zstream-push (new-xstream zstream) + (cond ((find-if (lambda (x) + (and (xstream-p x) + (eql (stream-name-entity-name (xstream-name x)) + (stream-name-entity-name (xstream-name new-xstream))) + (eql (stream-name-entity-kind (xstream-name x)) + (stream-name-entity-kind (xstream-name new-xstream))))) + (zstream-input-stack zstream)) + (wf-error zstream "Infinite recursion."))) + (push new-xstream (zstream-input-stack zstream)) + zstream) + +(defun recurse-on-entity (zstream name kind continuation &optional internalp) + (assert (not (zstream-token-category zstream))) + (call-with-entity-expansion-as-stream + zstream + (lambda (new-xstream) + (push :stop (zstream-input-stack zstream)) + (zstream-push new-xstream zstream) + (prog1 + (funcall continuation zstream) + (assert (eq (peek-token zstream) :eof)) + (assert (eq (pop (zstream-input-stack zstream)) new-xstream)) + (close-xstream new-xstream) + (assert (eq (pop (zstream-input-stack zstream)) :stop)) + (setf (zstream-token-category zstream) nil) + '(consume-token zstream)) ) + name + kind + internalp)) + +#|| +(defmacro read-data-until* ((predicate input res res-start res-end) &body body) + ;; fast variant -- for now disabled for no apparent reason + ;; -> res, res-start, res-end + `(let* ((rptr (xstream-read-ptr ,input)) + (p0 rptr) + (fptr (xstream-fill-ptr ,input)) + (buf (xstream-buffer ,input)) + ,res ,res-start ,res-end) + (declare (type fixnum rptr fptr p0) + (type (simple-array read-element (*)) buf)) + (loop + (cond ((%= rptr fptr) + ;; underflow -- hmm inject the scratch-pad with what we + ;; read and continue, while using read-rune and collecting + ;; d.h. besser waere hier auch while-reading zu benutzen. + (setf (xstream-read-ptr ,input) rptr) + (multiple-value-setq (,res ,res-start ,res-end) + (with-rune-collector/raw (collect) + (do ((i p0 (%+ i 1))) + ((%= i rptr)) + (collect (%rune buf i))) + (let (c) + (loop + (cond ((%= rptr fptr) + (setf (xstream-read-ptr ,input) rptr) + (setf c (peek-rune input)) + (cond ((eq c :eof) + (return))) + (setf rptr (xstream-read-ptr ,input) + fptr (xstream-fill-ptr ,input) + buf (xstream-buffer ,input))) + (t + (setf c (%rune buf rptr)))) + (cond ((,predicate c) + ;; we stop + (setf (xstream-read-ptr ,input) rptr) + (return)) + (t + ;; we continue + (collect c) + (setf rptr (%+ rptr 1))) ))))) + (return)) + ((,predicate (%rune buf rptr)) + ;; we stop + (setf (xstream-read-ptr ,input) rptr) + (setf ,res buf ,res-start p0 ,res-end rptr) + (return) ) + (t + we continue + (sf rptr (%+ rptr 1))) )) + ,@body )) +||# + +(defmacro read-data-until* ((predicate input res res-start res-end) &body body) + "Read data from `input' until `predicate' applied to the read char + turns true. Then execute `body' with `res', `res-start', `res-end' + bound to denote a subsequence (of RUNEs) containing the read portion. + The rune upon which `predicate' turned true is neither consumed from + the stream, nor included in `res'. + + Keep the predicate short, this it may be included more than once into + the macro's expansion." + ;; + (let ((input-var (gensym)) + (collect (gensym)) + (c (gensym))) + `(LET ((,input-var ,input)) + (MULTIPLE-VALUE-BIND (,res ,res-start ,res-end) + (WITH-RUNE-COLLECTOR/RAW (,collect) + (LOOP + (LET ((,c (PEEK-RUNE ,input-var))) + (COND ((EQ ,c :EOF) + ;; xxx error message + (RETURN)) + ((FUNCALL ,predicate ,c) + (RETURN)) + (t + (,collect ,c) + (CONSUME-RUNE ,input-var)))))) + (LOCALLY + ,@body))))) + +(defun read-name-token (input) + (read-data-until* ((lambda (rune) + (declare (type rune rune)) + (not (name-rune-p rune))) + input + r rs re) + (intern-name r rs re))) + +(defun read-cdata (input) + (read-data-until* ((lambda (rune) + (declare (type rune rune)) + (when (and (%rune< rune #/U+0020) + (not (or (%rune= rune #/U+0009) + (%rune= rune #/U+000a) + (%rune= rune #/U+000d)))) + (wf-error input "code point invalid: ~A" rune)) + (or (%rune= rune #/<) (%rune= rune #/&))) + input + source start end) + (locally + (declare (type (simple-array rune (*)) source) + (type ufixnum start) + (type ufixnum end) + (optimize (speed 3) (safety 0))) + (let ((res (make-array (%- end start) :element-type 'rune))) + (declare (type (simple-array rune (*)) res)) + (let ((i (%- end start))) + (declare (type ufixnum i)) + (loop + (setf i (- i 1)) + (setf (%rune res i) (%rune source (the ufixnum (+ i start)))) + (when (= i 0) + (return)))) + res)))) + +;; used only by read-att-value-2 +(defun internal-entity-expansion (name) + (let ((def (get-entity-definition name :general (dtd *ctx*)))) + (unless def + (wf-error nil "Entity '~A' is not defined." (rod-string name))) + (unless (typep def 'internal-entdef) + (wf-error nil "Entity '~A' is not an internal entity." name)) + (or (entdef-expansion def) + (setf (entdef-expansion def) (find-internal-entity-expansion name))))) + +;; used only by read-att-value-2 +(defun find-internal-entity-expansion (name) + (with-zstream (zinput) + (with-rune-collector-3 (collect) + (labels ((muffle (input) + (let (c) + (loop + (setf c (read-rune input)) + (cond ((eq c :eof) + (return)) + ((rune= c #/&) + (setf c (peek-rune input)) + (cond ((eql c :eof) + (eox input)) + ((rune= c #/#) + (let ((c (read-character-reference input))) + (%put-unicode-char c collect))) + (t + (unless (name-start-rune-p c) + (wf-error zinput "Expecting name after &.")) + (let ((name (read-name-token input))) + (setf c (read-rune input)) + (check-rune input c #/\;) + (recurse-on-entity + zinput name :general + (lambda (zinput) + (muffle (car (zstream-input-stack zinput))))))))) + ((rune= c #/<) + (wf-error zinput "unexpected #\/<")) + ((space-rune-p c) + (collect #/space)) + ((not (data-rune-p c)) + (wf-error zinput "illegal char: ~S." c)) + (t + (collect c))))))) + (declare (dynamic-extent #'muffle)) + (recurse-on-entity + zinput name :general + (lambda (zinput) + (muffle (car (zstream-input-stack zinput))))))))) + +;; callback for DOM +(defun resolve-entity (name handler dtd) + (let ((*validate* nil)) + (if (get-entity-definition name :general dtd) + (let* ((*ctx* (make-context :handler handler :dtd dtd)) + (*data-behaviour* :DOC)) + (with-zstream (input) + (with-scratch-pads () + (recurse-on-entity + input name :general + (lambda (input) + (prog1 + (etypecase (checked-get-entdef name :general) + (internal-entdef (p/content input)) + (external-entdef (p/ext-parsed-ent input))) + (unless (eq (peek-token input) :eof) + (wf-error input "Trailing garbage. - ~S" + (peek-token input))))))))) + nil))) + +(defun read-att-value-2 (input) + (let ((delim (read-rune input))) + (when (eql delim :eof) + (eox input)) + (unless (member delim '(#/\" #/\') :test #'eql) + (wf-error input + "Bad attribute value delimiter ~S, must be either #\\\" or #\\\'." + (rune-char delim))) + (with-rune-collector-4 (collect) + (loop + (let ((c (read-rune input))) + (cond ((eq c :eof) + (eox input "EOF")) + ((rune= c delim) + (return)) + ((rune= c #/<) + (wf-error input "'<' not allowed in attribute values")) + ((rune= #/& c) + (multiple-value-bind (kind sem) (read-entity-like input) + (ecase kind + (:CHARACTER-REFERENCE + (%put-unicode-char sem collect)) + (:ENTITY-REFERENCE + (let* ((exp (internal-entity-expansion sem)) + (n (length exp))) + (declare (type (simple-array rune (*)) exp)) + (do ((i 0 (%+ i 1))) + ((%= i n)) + (collect (%rune exp i)))))))) + ((space-rune-p c) + (collect #/u+0020)) + (t + (collect c)))))))) + +;;;;;;;;;;;;;;;;; + +;;; Namespace stuff + +;; We already know that name is part of a valid XML name, so all we +;; have to check is that the first rune is a name-start-rune and that +;; there is not colon in it. +(defun nc-name-p (name) + (and (plusp (length name)) + (name-start-rune-p (rune name 0)) + (notany #'(lambda (rune) (rune= #/: rune)) name))) + +(defun split-qname (qname) + (declare (type runes:simple-rod qname)) + (let ((pos (position #/: qname))) + (if pos + (let ((prefix (subseq qname 0 pos)) + (local-name (subseq qname (1+ pos)))) + (when (zerop pos) + (wf-error nil "empty namespace prefix")) + (if (nc-name-p local-name) + (values prefix local-name) + (wf-error nil "~S is not a valid NcName." + (rod-string local-name)))) + (values () qname)))) + +(defun decode-qname (qname) + "decode-qname name => namespace-uri, prefix, local-name" + (declare (type runes:simple-rod qname)) + (multiple-value-bind (prefix local-name) (split-qname qname) + (let ((uri (find-namespace-binding prefix))) + (if uri + (values uri prefix local-name) + (values nil nil qname))))) + + +(defun find-namespace-binding (prefix) + (cdr (or (assoc (or prefix #"") *namespace-bindings* :test #'rod=) + (wf-error nil "Undeclared namespace prefix: ~A" (rod-string prefix))))) + +;; FIXME: Should probably be refactored by adding :start and :end to rod=/rod-equal +(defun rod-starts-with (prefix rod) + (and (<= (length prefix) (length rod)) + (dotimes (i (length prefix) t) + (unless (rune= (rune prefix i) (rune rod i)) + (return nil))))) + +(defun xmlns-attr-p (attr-name) + (rod-starts-with #.(string-rod "xmlns") attr-name)) + +(defun attrname->prefix (attrname) + (if (< 5 (length attrname)) + (subseq attrname 6) + nil)) + +(defun find-namespace-declarations (attributes) + (loop + for attribute in attributes + for qname = (sax:attribute-qname attribute) + when (xmlns-attr-p qname) + collect (cons (attrname->prefix qname) (sax:attribute-value attribute)))) + +(defun declare-namespaces (attributes) + (let ((ns-decls (find-namespace-declarations attributes))) + (dolist (ns-decl ns-decls) + ;; check some namespace validity constraints + (let ((prefix (car ns-decl)) + (uri (cdr ns-decl))) + (cond + ((and (rod= prefix #"xml") + (not (rod= uri #"http://www.w3.org/XML/1998/namespace"))) + (wf-error nil + "Attempt to rebind the prefix \"xml\" to ~S." (mu uri))) + ((and (rod= uri #"http://www.w3.org/XML/1998/namespace") + (not (rod= prefix #"xml"))) + (wf-error nil + "The namespace ~ + URI \"http://www.w3.org/XML/1998/namespace\" may not ~ + be bound to the prefix ~S, only \"xml\" is legal." + (mu prefix))) + ((and (rod= prefix #"xmlns") + (rod= uri #"http://www.w3.org/2000/xmlns/")) + (wf-error nil + "Attempt to bind the prefix \"xmlns\" to its predefined ~ + URI \"http://www.w3.org/2000/xmlns/\", which is ~ + forbidden for no good reason.")) + ((rod= prefix #"xmlns") + (wf-error nil + "Attempt to bind the prefix \"xmlns\" to the URI ~S, ~ + but it may not be declared." (mu uri))) + ((rod= uri #"http://www.w3.org/2000/xmlns/") + (wf-error nil + "The namespace URI \"http://www.w3.org/2000/xmlns/\" may ~ + not be bound to prefix ~S (or any other)." (mu prefix))) + ((and (rod= uri #"") prefix) + (wf-error nil + "Only the default namespace (the one without a prefix) ~ + may be bound to an empty namespace URI, thus ~ + undeclaring it.")) + (t + (push (cons prefix (if (rod= #"" uri) nil uri)) + *namespace-bindings*) + (sax:start-prefix-mapping (handler *ctx*) + (car ns-decl) + (cdr ns-decl)))))) + ns-decls)) + +(defun undeclare-namespaces (ns-decls) + (dolist (ns-decl ns-decls) + (sax:end-prefix-mapping (handler *ctx*) (car ns-decl)))) + +(defun build-attribute-list (attr-alist) + ;; fixme: if there is a reason this function reverses attribute order, + ;; it should be documented. + (let (attributes) + (dolist (pair attr-alist) + (push (sax:make-attribute :qname (car pair) + :value (cdr pair) + :specified-p t) + attributes)) + attributes)) + +(defun check-attribute-uniqueness (attributes) + ;; 5.3 Uniqueness of Attributes + ;; In XML documents conforming to [the xmlns] specification, no + ;; tag may contain two attributes which: + ;; 1. have identical names, or + ;; 2. have qualified names with the same local part and with + ;; prefixes which have been bound to namespace names that are + ;; identical. + ;; + ;; 1. is checked by read-tag-2, so we only deal with 2 here + (loop for (attr-1 . rest) on attributes do + (when (and (sax:attribute-namespace-uri attr-1) + (find-if (lambda (attr-2) + (and (rod= (sax:attribute-namespace-uri attr-1) + (sax:attribute-namespace-uri attr-2)) + (rod= (sax:attribute-local-name attr-1) + (sax:attribute-local-name attr-2)))) + rest)) + (wf-error nil + "Multiple definitions of attribute ~S in namespace ~S." + (mu (sax:attribute-local-name attr-1)) + (mu (sax:attribute-namespace-uri attr-1)))))) + +(defun set-attribute-namespace (attribute) + (let ((qname (sax:attribute-qname attribute))) + (if (and sax:*use-xmlns-namespace* (rod= qname #"xmlns")) + (setf (sax:attribute-namespace-uri attribute) + #"http://www.w3.org/2000/xmlns/") + (multiple-value-bind (prefix local-name) (split-qname qname) + (when (and prefix ;; default namespace doesn't apply to attributes + (or (not (rod= #"xmlns" prefix)) + sax:*use-xmlns-namespace*)) + (setf (sax:attribute-namespace-uri attribute) + (decode-qname qname))) + (setf (sax:attribute-local-name attribute) local-name))))) + +;;;;;;;;;;;;;;;;; + +;; System Identifier Protocol + +;; A system identifier is an object obeying to the system identifier +;; protocol. Often something like an URL or a pathname. + +;; OPEN-SYS-ID sys-id [generic function] +;; +;; Opens the resource associated with the system identifier `sys-id' +;; for reading and returns a stream. For now it is expected, that the +;; stream is an octet stream (one of element type (unsigned-byte 8)). +;; +;; More precisely: The returned object only has to obey to the xstream +;; controller protocol. (That is it has to provide implementations for +;; READ-OCTETS and XSTREAM-CONTROLLER-CLOSE). + +;; MERGE-SYS-ID sys-id base [generic function] +;; +;; Merges two system identifiers. That is resolve `sys-id' relative to +;; `base' yielding an absolute system identifier suitable for +;; OPEN-SYS-ID. + + +;;;;;;;;;;;;;;;;; +;;; SAX validation handler + +(defclass validator () + ((context :initarg :context :accessor context) + (cdatap :initform nil :accessor cdatap))) + +(defun make-validator (dtd root) + (make-instance 'validator + :context (make-context + :handler nil + :dtd dtd + :model-stack (list (make-root-model root))))) + +(macrolet ((with-context ((validator) &body body) + `(let ((*ctx* (context ,validator)) + (*validate* t)) + (with-scratch-pads () ;nicht schoen + ,@body)))) + (defmethod sax:start-element ((handler validator) uri lname qname attributes) + uri lname + (with-context (handler) + (validate-start-element *ctx* qname) + (process-attributes *ctx* qname attributes))) + + (defmethod sax:start-cdata ((handler validator)) + (setf (cdatap handler) t)) + + (defmethod sax:characters ((handler validator) data) + (with-context (handler) + (validate-characters *ctx* (if (cdatap handler) #"hack" data)))) + + (defmethod sax:end-cdata ((handler validator)) + (setf (cdatap handler) nil)) + + (defmethod sax:end-element ((handler validator) uri lname qname) + uri lname + (with-context (handler) + (validate-end-element *ctx* qname)))) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xmlns-normalizer.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xmlns-normalizer.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,136 @@ +;;;; xmlns-normalizer.lisp -- DOM 3-style namespace normalization +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Copyright (c) 2005 David Lichteblau + +;;;; Hier eine Variante des reichlich furchtbaren Algorithmus zur +;;;; Namespace-Normalisierung aus DOM 3 Core.[1] +;;;; +;;;; Gebraucht wir die Sache, weil Element- und Attributknoten in DOM +;;;; zwar ein Prefix-Attribut speichern, massgeblich fuer ihren Namespace +;;;; aber nur die URI sein soll. Und eine Anpassung der zugehoerigen +;;;; xmlns-Attribute findet bei Veraenderungen im DOM-Baum nicht statt, +;;;; bzw. wird dem Nutzer ueberlassen. +;;;; +;;;; Daher muss letztlich spaetestens beim Serialisieren eine +;;;; Namespace-Deklaration fuer die angegebene URI nachgetragen und das +;;;; Praefix ggf. umbenannt werden, damit am Ende doch etwas +;;;; Namespace-konformes heraus kommt. +;;;; +;;;; Und das nennen sie dann Namespace-Support. +;;;; +;;;; [1] http://www.w3.org/TR/2004/REC-DOM-Level-3-Core-20040407/namespaces-algorithm... + +(in-package :cxml) + +(defclass namespace-normalizer (sax-proxy) + ((xmlns-stack :initarg :xmlns-stack :accessor xmlns-stack))) + +(defvar *xmlns-namespace* #"http://www.w3.org/2000/xmlns/") + +(defun make-namespace-normalizer (chained-handler) + (make-instance 'namespace-normalizer + :xmlns-stack (list (mapcar (lambda (cons) + (make-xmlns-attribute (car cons) (cdr cons))) + *initial-namespace-bindings*)) + :chained-handler chained-handler)) + +(defun normalizer-find-prefix (handler prefix) + (when (zerop (length prefix)) + (setf prefix #"xmlns")) + (block t + (dolist (bindings (xmlns-stack handler)) + (dolist (attribute bindings) + (when (rod= (sax:attribute-local-name attribute) prefix) + (return-from t attribute)))))) + +(defun normalizer-find-uri (handler uri) + (block t + (dolist (bindings (xmlns-stack handler)) + (dolist (attribute bindings) + (when (and (rod= (sax:attribute-value attribute) uri) + ;; default-namespace interessiert uns nicht + (not (rod= (sax:attribute-qname attribute) #"xmlns"))) + (return-from t attribute)))))) + +(defun make-xmlns-attribute (prefix uri) + (if (and (plusp (length prefix)) (not (equal prefix #"xmlns"))) + (sax:make-attribute + :qname (concatenate 'rod #"xmlns:" prefix) + :namespace-uri *xmlns-namespace* + :local-name prefix + :value uri) + (sax:make-attribute + :qname #"xmlns" + :namespace-uri *xmlns-namespace* + :local-name #"xmlns" + :value uri))) + +(defun rename-attribute (a new-prefix) + (setf (sax:attribute-qname a) + (concatenate 'rod new-prefix #":" (sax:attribute-local-name a)))) + +(defmethod sax:start-element + ((handler namespace-normalizer) uri lname qname attrs) + (when (null uri) + (setf uri #"")) + (let ((normal-attrs '())) + (push nil (xmlns-stack handler)) + (dolist (a attrs) + (if (rod= *xmlns-namespace* (sax:attribute-namespace-uri a)) + (push a (car (xmlns-stack handler))) + (push a normal-attrs))) + (flet ((push-namespace (prefix uri) + (let ((new (make-xmlns-attribute prefix uri))) + (unless (find (sax:attribute-qname new) + attrs + :test #'rod= + :key #'sax:attribute-qname) + (push new (car (xmlns-stack handler))) + (push new attrs))))) + (multiple-value-bind (prefix local-name) (split-qname qname) + (setf lname local-name) + (let ((binding (normalizer-find-prefix handler prefix))) + (cond + ((null binding) + (unless (and (null prefix) (zerop (length uri))) + (push-namespace prefix uri))) + ((rod= (sax:attribute-value binding) uri)) + ((member binding (car (xmlns-stack handler))) + (setf (sax:attribute-value binding) uri)) + (t + (push-namespace prefix uri))))) + (dolist (a normal-attrs) + (let ((u (sax:attribute-namespace-uri a))) + (when u + (let* ((prefix (split-qname (sax:attribute-qname a))) + (prefix-binding + (when prefix + (normalizer-find-prefix handler prefix)))) + (when (or (null prefix-binding) + (not (rod= (sax:attribute-value prefix-binding) u))) + (let ((uri-binding (normalizer-find-uri handler u))) + (cond + (uri-binding + (rename-attribute + a + (sax:attribute-local-name uri-binding))) + ((and prefix (null prefix-binding)) + (push-namespace prefix u)) + (t + (loop + for i from 1 + for prefix = (rod (format nil "NS~D" i)) + unless (normalizer-find-prefix handler prefix) + do + (push-namespace prefix u) + (rename-attribute a prefix) + (return)))))))))))) + (sax:start-element (proxy-chained-handler handler) uri lname qname attrs)) + +(defmethod sax:end-element ((handler namespace-normalizer) uri lname qname) + (declare (ignore qname)) + (pop (xmlns-stack handler)) + (sax:end-element (proxy-chained-handler handler) (or uri #"") lname qname)) Added: branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xmls-compat.lisp ============================================================================== --- (empty file) +++ branches/trunk-reorg/thirdparty/cxml-2007-10-21/xml/xmls-compat.lisp Sun Feb 17 09:26:33 2008 @@ -0,0 +1,243 @@ +;;;; xml-compat.lisp -- XMLS-compatible data structures +;;;; +;;;; This file is part of the CXML parser, released under Lisp-LGPL. +;;;; See file COPYING for details. +;;;; +;;;; Developed 2004 for headcraft - http://headcraft.de/ +;;;; Copyright: David Lichteblau + +(defpackage cxml-xmls + (:use :cl :runes) + (:export #:make-node #:node-name #:node-ns #:node-attrs #:node-children + #:make-xmls-builder #:map-node)) + +(in-package :cxml-xmls) + + +;;;; Knoten + +(defun make-node (&key name ns attrs children) + `(,(if ns (cons name ns) name) + ,attrs + ,@children)) + +(defun node-name (node) + (let ((car (car node))) + (if (consp car) + (car car) + car))) + +(defun (setf node-name) (newval node) + (let ((car (car node))) + (if (consp car) + (setf (car car) newval) + (setf (car node) newval)))) + +(defun node-ns (node) + (let ((car (car node))) + (if (consp car) + (cdr car) + nil))) + +(defun (setf node-ns) (newval node) + (let ((car (car node))) + (if (consp car) + (setf (cdr car) newval) + (setf (car node) (cons car newval))) + newval)) + +(defun node-attrs (node) + (cadr node)) + +(defun (setf node-attrs) (newval node) + (setf (cadr node) newval)) + +(defun node-children (node) + (cddr node)) + +(defun (setf node-children) (newval node) + (setf (cddr node) newval)) + + +;;;; SAX-Handler (Parser) + +(defclass xmls-builder () + ((element-stack :initform nil :accessor element-stack) + (root :initform nil :accessor root) + (include-default-values :initform t + :initarg :include-default-values + :accessor include-default-values) + (include-namespace-uri :initform t + :initarg :include-namespace-uri + :accessor include-namespace-uri))) + +(defun make-xmls-builder (&key (include-default-values t) + (include-namespace-uri t)) + "Make a XMLS style builder. When 'include-namespace-uri is true a modified + XMLS tree is generated that includes the element namespace URI rather than + the qualified name prefix and also includes the namespace URI for attributes." + (make-instance 'xmls-builder + :include-default-values include-default-values + :include-namespace-uri include-namespace-uri)) + +(defmethod sax:end-document ((handler xmls-builder)) + (root handler)) + +(defmethod sax:start-element + ((handler xmls-builder) namespace-uri local-name qname attributes) + (let* ((include-default-values (include-default-values handler)) + (include-namespace-uri (include-namespace-uri handler)) + (attributes + (loop + for attr in attributes + for attr-namespace-uri = (sax:attribute-namespace-uri attr) + for attr-local-name = (sax:attribute-local-name attr) + when (and (or (sax:attribute-specified-p attr) + include-default-values) + #+(or) + (or (not include-namespace-uri) + (not attr-namespace-uri) + attr-local-name)) + collect + (list (cond (include-namespace-uri + (cond (attr-namespace-uri + (cons attr-local-name attr-namespace-uri)) + (t + (sax:attribute-qname attr)))) + (t + (sax:attribute-qname attr))) + (sax:attribute-value attr)))) + (namespace (when include-namespace-uri namespace-uri)) + (node (make-node :name local-name + :ns namespace + :attrs attributes)) + (parent (car (element-stack handler)))) + (if parent + (push node (node-children parent)) + (setf (root handler) node)) + (push node (element-stack handler)))) + +(defmethod sax:end-element + ((handler xmls-builder) namespace-uri local-name qname) + (declare (ignore namespace-uri local-name qname)) + (let ((node (pop (element-stack handler)))) + (setf (node-children node) (reverse (node-children node))))) + +(defmethod sax:characters ((handler xmls-builder) data) + (let* ((parent (car (element-stack handler))) + (prev (car (node-children parent)))) + ;; Be careful to accept both rods and strings here, so that xmls can be + ;; used with strings even if cxml is configured to use octet string rods. + (if (typep prev '(or rod string)) + ;; um entities herum wird SAX:CHARACTERS mehrfach aufgerufen fuer + ;; den gleichen Textknoten. Hier muessen wir den bestehenden Knoten + ;; erweitern, sonst ist das Dokument nicht normalisiert. + ;; (XXX Oder sollte man besser den Parser entsprechend aendern?) + (setf (car (node-children parent)) + (concatenate `(vector ,(array-element-type prev)) + prev + data)) + (push data (node-children parent))))) + + +;;;; SAX-Treiber (fuer Serialisierung) + +(defun map-node + (handler node + &key (include-xmlns-attributes sax:*include-xmlns-attributes*) + (include-namespace-uri t)) + (if include-namespace-uri + (map-node/lnames (cxml:make-namespace-normalizer handler) + node + include-xmlns-attributes) + (map-node/qnames handler node include-xmlns-attributes))) + +(defun map-node/lnames (handler node include-xmlns-attributes) + (sax:start-document handler) + (labels ((walk (node) + (unless (node-ns node) + (error "serializing with :INCLUDE-NAMESPACE-URI, but node ~ + was created without namespace URI")) + (let* ((attlist + (compute-attributes/lnames node include-xmlns-attributes)) + (uri (node-ns node)) + (lname (node-name node)) + (qname lname) ;let the normalizer fix it + ) + (sax:start-element handler uri lname qname attlist) + (dolist (child (node-children node)) + (typecase child + (list (walk child)) + ((or string rod) + (sax:characters handler (string-rod child))))) + (sax:end-element handler uri lname qname)))) + (walk node)) + (sax:end-document handler)) + +(defun map-node/qnames (handler node include-xmlns-attributes) + (sax:start-document handler) + (labels ((walk (node) + (when (node-ns node) + (error "serializing without :INCLUDE-NAMESPACE-URI, but node ~ + was created with a namespace URI")) + (let* ((attlist + (compute-attributes/qnames node include-xmlns-attributes)) + (qname (string-rod (node-name node))) + (lname (nth-value 1 (cxml::split-qname qname)))) + (sax:start-element handler nil lname qname attlist) + (dolist (child (node-children node)) + (typecase child + (list (walk child)) + ((or string rod) + (sax:characters handler (string-rod child))))) + (sax:end-element handler nil lname qname)))) + (walk node)) + (sax:end-document handler)) + +(defun compute-attributes/lnames (node xmlnsp) + (remove nil + (mapcar (lambda (a) + (destructuring-bind (name value) a + (unless (listp name) + (setf name (cons name nil))) + (destructuring-bind (lname &rest uri) name + (cond + ((not (equal uri "http://www.w3.org/2000/xmlns/")) + (sax:make-attribute + ;; let the normalizer fix the qname + :qname (if uri + (string-rod (concatenate 'string + "dummy:" + lname)) + (string-rod lname)) + :local-name (string-rod lname) + :namespace-uri uri + :value (string-rod value) + :specified-p t)) + (xmlnsp + (sax:make-attribute + :qname (string-rod + (if lname + (concatenate 'string "xmlns:" lname) + "xmlns")) + :local-name (string-rod lname) + :namespace-uri uri + :value (string-rod value) + :specified-p t)))))) + (node-attrs node)))) + +(defun compute-attributes/qnames (node xmlnsp) + (remove nil + (mapcar (lambda (a) + (destructuring-bind (name value) a + (when (listp name) + (error "serializing without :INCLUDE-NAMESPACE-URI, ~ + but attribute was created with a namespace ~ + URI")) + (if (or xmlnsp + (not (cxml::xmlns-attr-p (string-rod name)))) + (sax:make-attribute :qname (string-rod name) + :value (string-rod value) + :specified-p t) + nil))) + (node-attrs node))))