[bknr-cvs] r2522 - in branches/trunk-reorg/bknr/web/src: . images rss web
by hhubner＠common-lisp.net 17 Feb '08
by hhubner＠common-lisp.net 17 Feb '08
17 Feb '08
Author: hhubner
Date: Sun Feb 17 14:25:56 2008
New Revision: 2522
Removed:
branches/trunk-reorg/bknr/web/src/rss/parse-atom.lisp
branches/trunk-reorg/bknr/web/src/rss/parse-rss091.lisp
branches/trunk-reorg/bknr/web/src/rss/parse-rss10.lisp
branches/trunk-reorg/bknr/web/src/rss/parse-rss20.lisp
branches/trunk-reorg/bknr/web/src/rss/parse-xml.lisp
branches/trunk-reorg/bknr/web/src/rss/test.lisp
Modified:
branches/trunk-reorg/bknr/web/src/bknr-web.asd
branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp
branches/trunk-reorg/bknr/web/src/images/image.lisp
branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp
branches/trunk-reorg/bknr/web/src/packages.lisp
branches/trunk-reorg/bknr/web/src/rss/rss.lisp
branches/trunk-reorg/bknr/web/src/web/handlers.lisp
branches/trunk-reorg/bknr/web/src/web/menu.lisp
branches/trunk-reorg/bknr/web/src/web/site.lisp
branches/trunk-reorg/bknr/web/src/web/tags.lisp
branches/trunk-reorg/bknr/web/src/web/template-handler.lisp
branches/trunk-reorg/bknr/web/src/web/web-macros.lisp
Log:
Docstrings.
Cleaning up: The old RSS parsing code is now gone, as it was not used and
did not work any more.
HANDLER-MATCHES renamed to HANDLER-MATCHES-P
Modified: branches/trunk-reorg/bknr/web/src/bknr-web.asd
==============================================================================
--- branches/trunk-reorg/bknr/web/src/bknr-web.asd (original)
+++ branches/trunk-reorg/bknr/web/src/bknr-web.asd Sun Feb 17 14:25:56 2008
@@ -49,16 +49,7 @@
:depends-on ("hyperspec")))
:depends-on ("packages"))
- (:module "rss" :components ((:file "rss")
- (:file "parse-xml")
- (:file "parse-rss10"
- :depends-on ("parse-xml" "rss"))
- (:file "parse-rss091"
- :depends-on ("parse-xml" "rss"))
- (:file "parse-atom"
- :depends-on ("parse-xml" "rss"))
- (:file "parse-rss20"
- :depends-on ("parse-xml" "rss")))
+ (:module "rss" :components ((:file "rss"))
:depends-on ("packages"))
(:module "web" :components ((:file "site")
Modified: branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/images/image-handlers.lisp Sun Feb 17 14:25:56 2008
@@ -10,12 +10,13 @@
(setf (header-out :cache-control) (format nil "max-age=~A" max-age)))
(unless (zerop date)
(setf (header-out :last-modified) (rfc-1123-date date)))
- (with-http-body ()
+ (let ((stream (send-headers)))
+ (setf (flex:flexi-stream-element-type stream) 'flex:octet)
(setf (save-alpha-p :image image) t)
(if (member image-format '(:jpg :jpeg))
- (write-image-to-stream *html-stream* image-format :image image :quality quality)
- (write-image-to-stream *html-stream* image-format :image image))
- (finish-output *html-stream*))))
+ (write-image-to-stream stream image-format :image image :quality quality)
+ (write-image-to-stream stream image-format :image image))
+ (finish-output stream))))
(defmethod store-image-xml-info ((image store-image))
(cxml:with-element "image"
@@ -52,9 +53,6 @@
(defmethod object-list-handler-title ((handler image-page-handler) object)
"bknr images")
-(defmethod object-list-handler-rss-link ((handler image-page-handler) object)
- "/image-rss")
-
(defmethod object-list-handler-get-objects ((handler image-page-handler) object)
(all-store-images))
@@ -65,7 +63,6 @@
(defmethod handle-object ((handler image-page-handler) images)
(let ((results (make-keyword-results (object-list-handler-get-objects handler images))))
(with-bknr-page (:title (object-list-handler-title handler images))
- (cmslink (object-list-handler-rss-link handler images) "rss")
(image-page results))))
(defclass upload-image-handler (form-handler)
@@ -114,10 +111,6 @@
(defmethod object-list-handler-title ((handler image-keyword-handler) keyword)
(format nil "bknr keyword images: ~a" keyword))
-(defmethod object-list-handler-rss-link ((handler image-keyword-handler) keyword)
- (format nil "/keyword-rss/~A"
- (string-downcase (symbol-name keyword))))
-
(defclass image-union-handler (image-page-handler keywords-handler)
())
@@ -127,9 +120,6 @@
(defmethod object-list-handler-title ((handler image-union-handler) keywords)
(format nil "bknr union images: ~a" keywords))
-(defmethod object-list-handler-rss-link ((handler image-union-handler) keywords)
- (format nil "/union-rss/~A" (parse-url)))
-
(defclass image-intersection-handler (image-page-handler keywords-handler)
())
@@ -139,43 +129,6 @@
(defmethod object-list-handler-title ((handler image-intersection-handler) keywords)
(format nil "bknr intersection images: ~a" keywords))
-(defmethod object-list-handler-rss-link ((handler image-intersection-handler) keywords)
- (format nil "/intersection-rss/~A" (parse-url)))
-
-;;; rss image feeds
-#|
-(defclass rss-image-handler (object-rss-handler image-page-handler)
- ())
-
-(defmethod create-object-rss-feed ((handler rss-image-handler) object)
- (let* ((url (website-url (page-handler-site handler)))
- (image-items (mapcar #'(lambda (image)
- (store-image-to-rss-item image :url url))
- (subseq (sort (object-list-handler-get-objects handler object)
- #'> :key #'blob-timestamp)
- 0 20))))
- (if image-items
- (make-instance 'rss-feed
- :channel (make-instance
- 'rss-channel
- :about (render-uri url nil)
- :title (object-list-handler-title handler object)
- :link (render-uri url nil)
- :items (mapcar #'rss-item-link image-items))
- :items image-items)
- (make-instance 'rss-feed :channel (make-instance 'rss-channel
- :about "no such keyword"
- :title "no such keyword")))))
-
-(defclass rss-image-keyword-handler (rss-image-handler image-keyword-handler)
- ())
-
-(defclass rss-image-union-handler (rss-image-handler image-union-handler)
- ())
-
-(defclass rss-image-intersection-handler (rss-image-handler image-intersection-handler)
- ())
-|#
(defclass xml-image-browser-handler (image-handler xml-object-handler)
())
@@ -203,12 +156,6 @@
("/image-keyword" image-keyword-handler)
("/image-union" image-union-handler)
("/image-intersection" image-intersection-handler)
- #|
- ("/rss-image" rss-image-handler)
- ("/rss-image-keyword" rss-image-keyword-handler)
- ("/rss-image-union" rss-image-union-handler)
- ("/rss-image-intersection" rss-image-intersection-handler)
- |#
("/image" imageproc-handler)
("/image-import" image-import-handler)
("/session-image" session-image-handler)
Modified: branches/trunk-reorg/bknr/web/src/images/image.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/images/image.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/images/image.lisp Sun Feb 17 14:25:56 2008
@@ -103,26 +103,6 @@
(store-image-with-name image-id)))
(keyword (store-image-with-name (string-downcase (symbol-name image-id))))))
-(defmethod store-image-to-rss-item ((image store-image) &key (url (parse-uri "")))
- (let ((image-url (render-uri (merge-uris (parse-uri (format nil "/image/~a"
- (store-object-id image)))
- url) nil))
- (browse-url (render-uri (merge-uris (parse-uri (format nil "/browse-image/~A"
- (store-object-id image)))
- url) nil)) )
- (make-instance 'rss-item
- :about browse-url
- :title (store-image-name image)
- :link browse-url
- :desc (with-output-to-string (s)
- (html-stream s ((:a :href image-url)
- ((:img :src
- (concatenate 'string
- image-url
- "/thumbnail,,320,200")
- :align "left")))))
- :date (blob-timestamp image))))
-
;;; import
(defun import-image (pathname &key name user keywords directory (keywords-from-dir t) (class-name 'store-image) initargs)
"Create blob from given file"
Modified: branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/images/imageproc-handler.lisp Sun Feb 17 14:25:56 2008
@@ -34,9 +34,7 @@
(when (and (true-color-p working-image)
(not (true-color-p input-image)))
(true-color-to-palette :dither t :image working-image :colors-wanted 256))
- (let ((stream (send-headers)))
- (setf (flex:flexi-stream-element-type stream) 'flex:octet)
- (write-image-to-stream stream (image-type-keyword image) :image working-image))
+ (emit-image-to-browser working-image (image-type-keyword image))
(unless (eq working-image input-image)
(destroy-image working-image)))))
Modified: branches/trunk-reorg/bknr/web/src/packages.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/packages.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/packages.lisp Sun Feb 17 14:25:56 2008
@@ -20,17 +20,8 @@
(defpackage :bknr.rss
(:use :cl :cl-user :cl-ppcre :bknr.utils :bknr.xml :puri :cxml-xmls :bknr.datastore :bknr.indices :cxml)
- (:export #:xml-escape
- #:*img-src-scanner*
- #:*a-href-scanner*
- #:*link-href-scanner*
- #:replace-relative-links
- #:make-absolute-url
-
- #:rss-to-xml
- #:merge-feeds
+ (:export ;; channel
- ;; channel
#:rss-channel
#:find-rss-channel
#:make-rss-channel
@@ -44,13 +35,6 @@
#:rss-channel-items
#:rss-channel-xml
- ;; image
- #:rss-image
- #:rss-image-about
- #:rss-image-title
- #:rss-image-url
- #:rss-image-link
-
;; item
#:rss-item
#:rss-item-channel
@@ -65,22 +49,7 @@
#:rss-item-enclosure
#:rss-item-guid
#:rss-item-source
- #:rss-item-encoded-content
-
- ;; textinput
- #:rss-textinput
- #:rss-textinput-about
- #:rss-textinput-title
- #:rss-textinput-desc
- #:rss-textinput-link
- #:rss-textinput-name
-
- #:parse-rss091-feed
- #:parse-rss10-feed
- #:parse-rss20-feed
- #:parse-atom-feed
-
- #:*base-url*))
+ #:rss-item-encoded-content))
(defpackage :bknr.events
(:use :cl
@@ -292,13 +261,12 @@
#:website-session-info
#:website-base-href
#:website-make-path
- #:website-rss-feed-url
#:host
#:publish-site
#:publish-handler
#:unpublish
- #:handler-matches
+ #:handler-matches-p
#:handle-object
#:handle-object-form
#:handle-form
@@ -357,7 +325,6 @@
#:object-list-handler
#:object-list-handler-get-objects
#:object-list-handler-title
- #:object-list-handler-rss-link
#:object-list-handler-show-object-xml
#:object-date-list-handler
#:object-date-list-handler-grouped-objects
Modified: branches/trunk-reorg/bknr/web/src/rss/rss.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/rss/rss.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/rss/rss.lisp Sun Feb 17 14:25:56 2008
@@ -4,33 +4,7 @@
;; This package aids in the automatic generation of RSS channels.
-;; Class rss-channel models one rss channel. Items are added to a
-;; channel by deriving other persistent classes from the (mixin) class
-;; rss-item. When an object of such a derived class is created, it is
-;; automatically added to its RSS channel. Likewise, it is
-;; automatically deleted from the channel when it is deleted.
-
-;; The channel that an item is put into is defined by the generic
-;; function rss-item-channel which needs to be specialized for each
-;; item class. The default method of this generic function specifies
-;; nil as channel, which results in the creation of a warning message
-;; when an object of this class is created.
-
-;; The rss-item-channel method may return the channel either as a
-;; string or as a channel object.
-
-;; Subclasses of rss-item should provide methods for some of the
-;; generic functions (rss-item-channel rss-item-title rss-item-link
-;; rss-item-description rss-item-author rss-item-category
-;; rss-item-comments rss-item-enclosure rss-item-guid
-;; rss-item-source). These functions are called when the RSS file for
-;; the channel is generated and provide the
-
-;; One rss-item can only be in one channel.
-
-;; The channel object has more required elements than the standard
-;; specifies in order to make the generated feed documents more widely
-;; accepted.
+;; See the documentation to class RSS-CHANNEL for an overview.
;;; Paul Graham, On Lisp, p191
(defmacro aif (test-form then-form &optional else-form)
@@ -48,17 +22,46 @@
(description :update)
(last-update :update :initform (get-universal-time))
(max-item-age :update :initform (* 4 7 3600))
- (items :update :initform nil)))
+ (items :update :initform nil))
+ (:documentation "RSS-CHANNEL models one rss channel. Items are
+added to a channel by deriving other persistent classes from the mixin
+class RSS-ITEM. When an object of such a derived class is created, it
+is automatically added to its RSS channel. Likewise, it is
+automatically deleted from the channel when it is deleted.
+
+The channel that an item is put into is defined by the generic
+function RSS-ITEM-CHANNEL which needs to be specialized for each item
+class. The default method of this generic function specifies nil as
+channel, which results in the creation of a warning message when an
+object of this class is created.
+
+The RSS-ITEM-CHANNEL method may return the channel either as a string
+or as a channel object.
+
+Subclasses of RSS-ITEM should provide methods for some of the generic
+functions (RSS-ITEM-CHANNEL RSS-ITEM-TITLE RSS-ITEM-LINK
+RSS-ITEM-DESCRIPTION RSS-ITEM-AUTHOR RSS-ITEM-CATEGORY
+RSS-ITEM-COMMENTS RSS-ITEM-ENCLOSURE RSS-ITEM-GUID RSS-ITEM-SOURCE).
+These functions are called when the RSS file for the channel is
+generated and provide the content in the RSS items.
+
+One RSS-ITEM can only be in one channel, which is a restriction that
+may eventually be removed.
+
+The channel object has more required elements than specified by the
+standard in order to make the generated feed documents more widely
+accepted."))
(defmethod prepare-for-snapshot ((channel rss-channel))
+ "When snapshotting, remove items from CHANNEL that are destroyed."
(setf (rss-channel-items channel) (remove-if #'object-destroyed-p (rss-channel-items channel))))
;; Mixin for items
(define-persistent-class rss-item ()
- ())
-
-(defgeneric rss-item-pub-date (item))
+ ()
+ (:documentation "Mixin class for RSS items. See documentation for
+class RSS-CHANNEL for an overview."))
(defun make-rss-channel (name title description link &rest args)
(apply #'make-object 'rss-channel :name name :title title :description description :link link args))
@@ -85,42 +88,41 @@
(rss-channel-items channel)))
(rss-item-xml item))))))
-(defmethod rss-channel-items ((channel rss-channel))
- "Return all non-expired items in channel."
- (let ((expiry-time (- (get-universal-time) (rss-channel-max-item-age channel))))
- (remove-if (lambda (item) (or (object-destroyed-p item)
- (< (rss-item-pub-date item) expiry-time)))
- (slot-value channel 'items))))
+(defgeneric rss-channel-items (channel)
+ (:documentation "Return all non-expired items in channel.")
+ (:method ((channel rss-channel))
+ (let ((expiry-time (- (get-universal-time) (rss-channel-max-item-age channel))))
+ (remove-if (lambda (item) (or (object-destroyed-p item)
+ (< (rss-item-pub-date item) expiry-time)))
+ (slot-value channel 'items)))))
(deftransaction rss-channel-cleanup (channel)
"Remove expired items from the items list. Can be used to reduce
the memory footprint of very high volume channels."
(setf (slot-value channel 'items) (rss-channel-items channel)))
-;; Internal helper functions to find a channel
-
-(defmethod remove-item ((channel rss-channel) item)
- "Remove item from channel. May only be called within transaction context."
- (setf (slot-value channel 'items) (remove item (rss-channel-items channel))))
-
-(defmethod remove-item ((channel string) item)
- (aif (find-rss-channel channel)
- (remove-item it item)))
-
-(defmethod remove-item ((channel (eql nil)) item)
- (warn "no RSS channel defined for item ~A" item))
-
-(defmethod add-item ((channel rss-channel) item)
- "Add item to channel. May only be called within transaction context."
- (setf (slot-value channel 'items) (cons item (rss-channel-items channel))))
-
-(defmethod add-item ((channel string) item)
- (aif (find-rss-channel channel)
- (add-item it item)
- (warn "can't find RSS channel ~A to add newly created item ~A to" channel item)))
-
-(defmethod add-item ((channel (eql nil)) item)
- (warn "no RSS channel defined for item ~A" item))
+(defgeneric remove-item (channel item)
+ (:documentation "Remove ITEM from CHANNEL. May only be called
+within transaction context.")
+ (:method ((channel rss-channel) item)
+ (setf (slot-value channel 'items) (remove item (rss-channel-items channel))))
+ (:method ((channel string) item)
+ (aif (find-rss-channel channel)
+ (remove-item it item)))
+ (:method ((channel (eql nil)) item)
+ (warn "no RSS channel defined for item ~A" item)))
+
+(defgeneric add-item (channel item)
+ (:documentation "Add ITEM to CHANNEL. May only be called within
+transaction context.")
+ (:method ((channel rss-channel) item)
+ (setf (slot-value channel 'items) (cons item (rss-channel-items channel))))
+ (:method ((channel string) item)
+ (aif (find-rss-channel channel)
+ (add-item it item)
+ (warn "can't find RSS channel ~A to add newly created item ~A to" channel item)))
+ (:method ((channel (eql nil)) item)
+ (warn "no RSS channel defined for item ~A" item)))
(defmethod initialize-persistent-instance :after ((rss-item rss-item))
(add-item (rss-item-channel rss-item) rss-item))
@@ -129,12 +131,14 @@
(remove-item (rss-item-channel rss-item) rss-item))
(defun item-slot-element (item slot-name)
+ "Cheapo helper function to map from a pseudo slot name to an accessor."
(let ((accessor (find-symbol (format nil "RSS-ITEM-~A" slot-name) (find-package :bknr.rss))))
(aif (funcall accessor item)
(with-element (string-downcase (symbol-name slot-name))
(text it)))))
(defun rss-item-xml (item)
+ "Generate RSS XML for ITEM using CXML's unparse functionality."
(with-element "item"
(dolist (slot '(title link author category comments enclosure source))
(item-slot-element item slot))
@@ -154,27 +158,41 @@
;; All items present on an RSS stream can implement the access
;; methods below.
-(defmethod rss-item-published (item)
- t)
+(defgeneric rss-item-pub-date (item)
+ (:documentation "The default implementation for the publication date
+delivers the current system date/time as publication date.")
+ (:method (item)
+ (warn "no rss-item-pub-date defined for class ~A, using current date/time" (class-of item))
+ (get-universal-time)))
-(defmethod rss-item-pub-date (item)
- "The default implementation for the publication date delivers the
-current system date/time as publication date."
- (warn "no rss-item-pub-date defined for class ~A, using current date/time" (class-of item))
- (get-universal-time))
-
-(defmethod rss-item-channel (item))
-(defmethod rss-item-title (item))
-(defmethod rss-item-link (item))
-(defmethod rss-item-description (item))
-(defmethod rss-item-author (item))
-(defmethod rss-item-category (item))
-(defmethod rss-item-comments (item))
-(defmethod rss-item-enclosure (item))
-(defmethod rss-item-guid (item))
-(defmethod rss-item-source (item))
-(defgeneric rss-item-encoded-content (item)
- (:documentation "Return the content for ITEM in encoded (usually HTML) form as string.")
+(defgeneric rss-item-published (item)
+ (:documentation "Return non-nil if the ITEM is published.
+Non-published items are not put into generated XML by
+RSS-CHANNEL-XML.")
(:method (item)
- (declare (ignore item))
- nil))
+ t))
+
+(defmacro define-rss-item-field (field-name
+ &key
+ (documentation (format nil "Return the ~(~A~) of the ITEM as a string" field-name))
+ mandatory)
+ `(defgeneric ,(intern (format nil "RSS-ITEM-~A" field-name)) (item)
+ (:documentation ,(format nil "~A~@[ (optional)~]"
+ documentation (not mandatory)))
+ ,@(unless mandatory
+ '((:method (item) nil)))))
+
+(define-rss-item-field channel
+ :documentation "Return the channel that the ITEM is published in."
+ :mandatory t)
+(define-rss-item-field title)
+(define-rss-item-field link)
+(define-rss-item-field description)
+(define-rss-item-field author)
+(define-rss-item-field category)
+(define-rss-item-field comments)
+(define-rss-item-field enclosure)
+(define-rss-item-field guid)
+(define-rss-item-field source)
+(define-rss-item-field encoded-content
+ :documentation "Return the content for ITEM in encoded (usually HTML) form as string.")
Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/handlers.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/handlers.lisp Sun Feb 17 14:25:56 2008
@@ -503,13 +503,13 @@
(defgeneric object-date-list-handler-grouped-objects (handler object))
-(defmethod object-date-list-handler-date ((handler object-date-list-handler)
- object)
- (with-query-params (date)
- (get-daytime (if date
- (or (parse-integer date :junk-allowed t)
- (get-universal-time))
- (get-universal-time)))))
+(defgeneric object-date-list-handler-date (handler object)
+ (:method ((handler object-date-list-handler) object)
+ (with-query-params (date)
+ (get-daytime (if date
+ (or (parse-integer date :junk-allowed t)
+ (get-universal-time))
+ (get-universal-time))))))
(defclass admin-only-handler ()
())
Modified: branches/trunk-reorg/bknr/web/src/web/menu.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/menu.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/menu.lisp Sun Feb 17 14:25:56 2008
@@ -44,6 +44,7 @@
(let* ((menu (bknr.impex:parse-xml-file
#+cmu (ext:unix-namestring (merge-pathnames config *default-pathname-defaults*))
#+sbcl (sb-int:unix-namestring (merge-pathnames config *default-pathname-defaults*))
+ #-(or cmu sbcl) (namestring (probe-file (merge-pathnames config *default-pathname-defaults*)))
*menu-def-classes*)))
(html
((:div :class container-class)
Modified: branches/trunk-reorg/bknr/web/src/web/site.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/site.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/site.lisp Sun Feb 17 14:25:56 2008
@@ -5,6 +5,6 @@
(defparameter *thumbnail-max-width* 108)
(defparameter *thumbnail-max-height* 54)
-;; default billboard to show on home page
-(defparameter *default-billboard* "main")
+(defparameter *default-billboard* "main"
+ "default billboard to show on home page")
Modified: branches/trunk-reorg/bknr/web/src/web/tags.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/tags.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/tags.lisp Sun Feb 17 14:25:56 2008
@@ -61,6 +61,7 @@
(html ((:input :type "checkbox" :name name) (:princ-safe value)))))
(define-bknr-tag date-field (name &key date (show-time t))
+ "Generate a date entry widget using HTML <select> elements."
(unless date
(setf date (get-universal-time)))
(multiple-value-bind (sec min hour day month year)
Modified: branches/trunk-reorg/bknr/web/src/web/template-handler.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/template-handler.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/template-handler.lisp Sun Feb 17 14:25:56 2008
@@ -300,7 +300,7 @@
(defmacro with-error-handlers ((handler) &body body)
`(invoke-with-error-handlers (lambda () ,@body) ,handler))
-(defmethod handler-matches ((handler template-handler))
+(defmethod handler-matches-p ((handler template-handler))
(handler-case
(find-template-pathname handler (script-name))
(template-not-found (c)
Modified: branches/trunk-reorg/bknr/web/src/web/web-macros.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/web-macros.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/web-macros.lisp Sun Feb 17 14:25:56 2008
@@ -80,6 +80,8 @@
:value ,(or variable ""))))
(defmacro html-warn (&rest warning)
+ "Generate a warning on the console and write the warning into the
+currently generated XHTML output as a comment."
`(progn
(html (:princ-safe (format nil "<!-- ~a -->~%" (format nil ,@warning))))
(warn ,@warning)))
1
0
[bknr-cvs] r2521 - in branches/trunk-reorg/bknr/datastore/src: indices utils
by ksprotte＠common-lisp.net 17 Feb '08
by ksprotte＠common-lisp.net 17 Feb '08
17 Feb '08
Author: ksprotte
Date: Sun Feb 17 11:38:38 2008
New Revision: 2521
Modified:
branches/trunk-reorg/bknr/datastore/src/indices/package.lisp
branches/trunk-reorg/bknr/datastore/src/utils/package.lisp
branches/trunk-reorg/bknr/datastore/src/utils/smbpasswd.lisp
Log:
#+cmu removed :use :ext from defpackages bknr.utils and bknr.indices
as this does not seem to be needed and causes a symbol conflict
Modified: branches/trunk-reorg/bknr/datastore/src/indices/package.lisp
==============================================================================
--- branches/trunk-reorg/bknr/datastore/src/indices/package.lisp (original)
+++ branches/trunk-reorg/bknr/datastore/src/indices/package.lisp Sun Feb 17 11:38:38 2008
@@ -3,7 +3,6 @@
(defpackage :bknr.indices
(:use :cl
#+clisp :ext
- #+cmu :ext
#+sbcl :sb-ext
:cl-user
:bknr.utils
Modified: branches/trunk-reorg/bknr/datastore/src/utils/package.lisp
==============================================================================
--- branches/trunk-reorg/bknr/datastore/src/utils/package.lisp (original)
+++ branches/trunk-reorg/bknr/datastore/src/utils/package.lisp Sun Feb 17 11:38:38 2008
@@ -5,7 +5,6 @@
:cl-ppcre
:cl-interpol
:md5
- #+cmu :extensions
#+sbcl :sb-ext
#+cmu :mp
#+openmcl :ccl)
Modified: branches/trunk-reorg/bknr/datastore/src/utils/smbpasswd.lisp
==============================================================================
--- branches/trunk-reorg/bknr/datastore/src/utils/smbpasswd.lisp (original)
+++ branches/trunk-reorg/bknr/datastore/src/utils/smbpasswd.lisp Sun Feb 17 11:38:38 2008
@@ -29,9 +29,9 @@
(let ((process
(ext:run-program +smb-wrapper-program+ args :output stream :error :output)))
(unwind-protect
- (unless (zerop (process-exit-code process))
+ (unless (zerop (ext:process-exit-code process))
(error (make-condition 'smb-password-error :message (get-output-stream-string stream))))
- (process-close process)))
+ (ext:process-close process)))
#+openmcl
(ccl::run-program +smb-wrapper-program+
args
1
0
[bknr-cvs] r2520 - in branches/trunk-reorg/thirdparty: closure-common-2007-10-21 cxml-2007-08-05 cxml-2007-10-21 cxml-2007-10-21/contrib cxml-2007-10-21/doc cxml-2007-10-21/dom cxml-2007-10-21/klacks cxml-2007-10-21/test cxml-2007-10-21/xml cxml-2007-10-21/xml/sax-tests
by ksprotte＠common-lisp.net 17 Feb '08
by ksprotte＠common-lisp.net 17 Feb '08
17 Feb '08
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(a)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(a)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(a)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(a)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(a)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(a)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(a)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(a)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(a)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(a)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(a)knowledgetools.de--cxml/cxml--devel--1.0--patch-309 to compare with
+* comparing to david(a)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(a)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(a)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(a)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.ht…">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-algorith…">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.ht…">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-algorith…">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(a)rz.uni-karlsruhe.de>
+;;;; Author: Henrik Motakef <hmot(a)henrik-motakef.de>
+;;;; Author: David Lichteblau <david(a)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(a)rz.uni-karlsruhe.de>
+;;;; Author: David Lichteblau <david(a)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(a)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(a)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(a)rz.uni-karlsruhe.de>
+;;; Author: David Lichteblau <david(a)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(a)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(a)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(a)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(a)rz.uni-karlsruhe.de>
+;;; Author: Henrik Motakef <hmot(a)henrik-motakef.de>
+;;; Author: David Lichteblau <david(a)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-algorith…
+
+(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))))
1
0
[bknr-cvs] r2519 - branches/trunk-reorg/thirdparty/uffi-1.6.0/src
by hhubner＠common-lisp.net 17 Feb '08
by hhubner＠common-lisp.net 17 Feb '08
17 Feb '08
Author: hhubner
Date: Sun Feb 17 05:22:50 2008
New Revision: 2519
Modified:
branches/trunk-reorg/thirdparty/uffi-1.6.0/src/aggregates.lisp
Log:
Another CCL fix. DEFSETF is not required if the read expansion is setfable. The previous implementation did not work.
Modified: branches/trunk-reorg/thirdparty/uffi-1.6.0/src/aggregates.lisp
==============================================================================
--- branches/trunk-reorg/thirdparty/uffi-1.6.0/src/aggregates.lisp (original)
+++ branches/trunk-reorg/thirdparty/uffi-1.6.0/src/aggregates.lisp Sun Feb 17 05:22:50 2008
@@ -118,13 +118,6 @@
`(ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot))))
)
-#+(or openmcl digitool)
-(defmacro set-slot-value (obj type slot value) ;use setf to set values
- `(setf (ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot)))) ,value))
-
-#+(or openmcl digitool)
-(defsetf get-slot-value set-slot-value)
-
(defmacro get-slot-pointer (obj type slot)
#+(or lispworks cmu sbcl scl) (declare (ignore type))
1
0
[bknr-cvs] r2518 - trunk/projects/lisp-ecoop/website/templates
by hhubner＠common-lisp.net 17 Feb '08
by hhubner＠common-lisp.net 17 Feb '08
17 Feb '08
Author: hhubner
Date: Sun Feb 17 02:29:01 2008
New Revision: 2518
Modified:
trunk/projects/lisp-ecoop/website/templates/menu.xml
Log:
Remove "people" and "submissions" from menu as long as they are empty
Modified: trunk/projects/lisp-ecoop/website/templates/menu.xml
==============================================================================
--- trunk/projects/lisp-ecoop/website/templates/menu.xml (original)
+++ trunk/projects/lisp-ecoop/website/templates/menu.xml Sun Feb 17 02:29:01 2008
@@ -2,15 +2,12 @@
<menu name="main">
<item url="home" title="Home" />
<item url="news" title="News" />
+ <!--
<item url="people" title="People" />
+ -->
<item url="programme" title="Programme" />
- <item url="submissions" title="Submissions" />
- <item url="contact" title="Organization / Contact" />
<!--
- <item url="schedule" title="Schedule" />
- <item url="registration" title="Registration" />
- <item url="papers" title="Papers" />
- <item url="groups" title ="Breakout Groups" />
- <item url="guidelines" title="Submission" />
+ <item url="submissions" title="Submissions" />
-->
+ <item url="contact" title="Organization / Contact" />
</menu>
1
0
[bknr-cvs] r2517 - branches/trunk-reorg/projects/lisp-ecoop/website/templates
by hhubner＠common-lisp.net 17 Feb '08
by hhubner＠common-lisp.net 17 Feb '08
17 Feb '08
Author: hhubner
Date: Sun Feb 17 02:26:33 2008
New Revision: 2517
Modified:
branches/trunk-reorg/projects/lisp-ecoop/website/templates/menu.xml
Log:
Remove "people" and "submissions" menu entries as long as they are
empty.
Modified: branches/trunk-reorg/projects/lisp-ecoop/website/templates/menu.xml
==============================================================================
--- branches/trunk-reorg/projects/lisp-ecoop/website/templates/menu.xml (original)
+++ branches/trunk-reorg/projects/lisp-ecoop/website/templates/menu.xml Sun Feb 17 02:26:33 2008
@@ -2,15 +2,12 @@
<menu name="main">
<item url="home" title="Home" />
<item url="news" title="News" />
+ <!--
<item url="people" title="People" />
+ -->
<item url="programme" title="Programme" />
- <item url="submissions" title="Submissions" />
- <item url="contact" title="Organization / Contact" />
<!--
- <item url="schedule" title="Schedule" />
- <item url="registration" title="Registration" />
- <item url="papers" title="Papers" />
- <item url="groups" title ="Breakout Groups" />
- <item url="guidelines" title="Submission" />
+ <item url="submissions" title="Submissions" />
-->
+ <item url="contact" title="Organization / Contact" />
</menu>
1
0
16 Feb '08
Author: hhubner
Date: Sat Feb 16 15:00:17 2008
New Revision: 2516
Modified:
branches/trunk-reorg/bknr/web/src/web/handlers.lisp
Log:
Docstrings
Modified: branches/trunk-reorg/bknr/web/src/web/handlers.lisp
==============================================================================
--- branches/trunk-reorg/bknr/web/src/web/handlers.lisp (original)
+++ branches/trunk-reorg/bknr/web/src/web/handlers.lisp Sat Feb 16 15:00:17 2008
@@ -66,7 +66,11 @@
:import-spool-directory #p"/home/bknr/spool/"
:template-base-directory nil
:template-command-packages nil
- :rss-feed-url nil))
+ :rss-feed-url nil)
+ (:documentation "Class to hold all information on a web server that
+is served within BKNR. Currently, this is a singleton object, and
+*WEBSITE* will point to the only instance. Eventually, multiple
+WEBSITE instances for virtual hosts may be supported."))
(defmethod initialize-instance :after ((website website) &key &allow-other-keys)
(when *website*
@@ -86,9 +90,20 @@
(defmethod website-make-path ((website website) path)
(format nil "~A~A" (website-base-href website) (relative path)))
-(defgeneric publish-handler (website handler))
-(defgeneric handler-matches (handler))
-(defgeneric publish-site (website))
+(defgeneric publish-handler (website handler)
+ (:documentation "Publish HANDLER on WEBSITE, thereby adding it to
+the chain of handlers that is searched to handle an incoming
+request."))
+
+(defgeneric handler-matches-p (handler)
+ (:documentation "Determine whether HANDLER is willing to handle the
+current request. Returns non-NIL if the HANDLER wants to handle the request
+NIL otherwise."))
+
+(defgeneric publish-site (website)
+ (:documentation "Publish all handlers defined in WEBSITE.
+
+XXX When is this called?"))
(defun handler-definition-name (handler-definition)
(first handler-definition))
@@ -191,9 +206,21 @@
(print-unreadable-object (handler stream :type t)
(format stream "~A" (page-handler-prefix handler))))
-(defgeneric handle (page-handler))
-(defgeneric authorized-p (page-handler))
-(defgeneric page-handler-url (page-handler))
+(defgeneric handle (page-handler)
+ (:documentation "Handle an incoming HTTP request, returning either a
+string or an (array (unsigned-byte 8) (*)) with the response
+contents. Alternatively, the handler may call (SEND-HEADERS) to
+get access to the response stream and output the data to it."))
+
+(defgeneric authorized-p (page-handler)
+ (:documentation "Return non-nil if the request is authorized to be
+executed on PAGE-HANDLER
+
+XXX wouldn't it be better if handler-matches-p checked
+authorization?"))
+
+(defgeneric page-handler-url (page-handler)
+ (:documentation "Return the full base URL for PAGE-HANDLER."))
(defmethod handler-path ((handler page-handler))
(subseq (script-name)
@@ -266,7 +293,7 @@
(defun bknr-dispatch (request)
(declare (ignore request))
- (let ((handler (find-if #'handler-matches (website-handlers *website*))))
+ (let ((handler (find-if #'handler-matches-p (website-handlers *website*))))
(cond
(handler
(start-session)
@@ -279,7 +306,7 @@
(defmethod publish-handler ((website website) (handler page-handler))
(setf *handlers* (append *handlers* (list handler))))
-(defmethod handler-matches ((handler page-handler))
+(defmethod handler-matches-p ((handler page-handler))
(string-equal (page-handler-prefix handler)
(script-name)))
@@ -296,7 +323,10 @@
(redirect (random-elt (redirect-handler-to page-handler))))
(defclass form-handler (page-handler)
- ())
+ ()
+ (:documentation "A FORM-HANDLER is a handler that processes form
+submissions. The handler generic function for FORM-HANDLER subclasses
+is called HANDLE-FORM."))
(define-condition form-condition (condition)
((reason :initarg :reason
@@ -315,7 +345,12 @@
(signal (make-condition 'form-field-missing-condition
:field ',field-name))))
-(defgeneric handle-form (page-handler action))
+(defgeneric handle-form (page-handler action)
+ (:documentation "Handle form submission for PAGE-HANDLER. The
+form variable \"action\" will be parsed into a keyword and passwd to
+the invocation of this generic function as ACTION. Methods are meant
+to specialize on individual keywords to handle different actions that
+the form supports."))
(defmethod handle ((page-handler form-handler))
(let* ((form (query-param "action"))
@@ -323,7 +358,11 @@
(handle-form page-handler form-keyword)))
(defclass prefix-handler (page-handler)
- ())
+ ()
+ (:documentation "A PREFIX-HANDLER is a handler that is invoked for
+URLs with a certain prefix, as determined by the :PREFIX
+initialization argument. It is used as a mixin class and only
+provides for a HANDLER-MATCHES-P method."))
#+(or)
(defmethod initialize-instance :after ((handler prefix-handler) &key)
@@ -331,7 +370,7 @@
(1- (length (page-handler-prefix handler)))))
(warn "prefix handler ~A does not have prefix ending with / - may match unexpectedly" handler)))
-(defmethod handler-matches ((handler prefix-handler))
+(defmethod handler-matches-p ((handler prefix-handler))
(and (>= (length (script-name))
(length (page-handler-prefix handler)))
(string-equal (page-handler-prefix handler)
@@ -340,20 +379,26 @@
(defclass directory-handler (prefix-handler)
((destination :initarg :destination
- :reader page-handler-destination)))
+ :reader page-handler-destination))
+ (:documentation
+ "Handler for a directory in the file system. Publishes all files
+in the directory DESTINATION under their relative path name."))
+
+(defgeneric request-relative-pathname (directory-handler)
+ (:documentation "Return the relative pathname for the current
+request as determined by DIRECTORY-HANDLER.")
+ (:method ((handler directory-handler))
+ (or (aux-request-value 'request-relative-pathname)
+ (setf (aux-request-value 'request-relative-pathname)
+ (pathname (subseq (script-name) (1+ (length (page-handler-prefix handler)))))))))
-(defmethod request-pathname ((handler directory-handler))
- (or (aux-request-value 'request-pathname)
- (setf (aux-request-value 'request-pathname)
- (subseq (script-name) (1+ (length (page-handler-prefix handler)))))))
-
-(defmethod handler-matches ((handler directory-handler))
+(defmethod handler-matches-p ((handler directory-handler))
(and (call-next-method)
- (probe-file (merge-pathnames (request-pathname handler)
+ (probe-file (merge-pathnames (request-relative-pathname handler)
(page-handler-destination handler)))))
(defmethod handle ((handler directory-handler))
- (handle-static-file (merge-pathnames (request-pathname handler)
+ (handle-static-file (merge-pathnames (request-relative-pathname handler)
(page-handler-destination handler))))
(defclass file-handler (page-handler)
@@ -361,34 +406,64 @@
:reader page-handler-destination)
(content-type :initarg :content-type
:reader page-handler-content-type))
- (:default-initargs :content-type "text/plain"))
+ (:default-initargs :content-type "text/plain")
+ (:documentation "A FILE-HANDLER is used to publish a single file
+under an URL. :DESTINATION is the pathname of the file to publish,
+:CONTENT-TYPE is the content type to use."))
(defmethod handle ((handler file-handler))
- (handle-static-file (page-handler-destination handler)))
+ (handle-static-file (page-handler-destination handler) (page-handler-content-type handler)))
(defclass object-handler (prefix-handler)
((query-function :initarg :query-function :reader object-handler-query-function)
(object-class :initarg :object-class :reader object-handler-object-class))
- (:default-initargs :object-class t :query-function nil))
-
-(defgeneric object-handler-get-object (object-handler))
-(defgeneric handle-object (object-handler object))
-
-(defmethod object-handler-get-object ((handler object-handler))
- (let ((id (parse-url)))
- (when id
- (find-store-object id
- :class (object-handler-object-class handler)
- :query-function (object-handler-query-function handler)))))
+ (:default-initargs :object-class t :query-function nil)
+ (:documentation "An OBJECT-HANDLER handles requests for a persistent
+object in the BKNR datastore. The first component of the relative
+path of the request is used as the key to locate the object. The
+object is looked up using the OBJECT-HANDLER-GET-OBJECT generic
+function, which will, by default, call FIND-STORE-OBJECT with the key
+as argument.
+
+The :QUERY-FUNCTION initarg may be supplied to set up a query function
+that maps from the key to an object. It is typically used to
+implement lookup by name.
+
+The :OBJECT-CLASS initarg may be supplied to restrict the handler to
+operate on objects of that class or its subclass. If the key
+specifies the ID of an object that has a different class or if the
+QUERY-FUNCTION returns an object of a different class, a run-time
+error is signaled."))
+
+(defgeneric object-handler-get-object (object-handler)
+ (:documentation "Implement object lookup. Methods return the object
+that the current request should operate upon. The default method for
+the OBJECT handler class performs a lookup using FIND-STORE-OBJECT.")
+ (:method ((handler object-handler))
+ (let ((id (parse-url)))
+ (when id
+ (find-store-object id
+ :class (object-handler-object-class handler)
+ :query-function (object-handler-query-function handler))))))
+
+(defgeneric handle-object (object-handler object)
+ (:documentation "Handle the current to the OBJECT-HANDLER. OBJECT
+is the object as looked up by OBJECT-HANDLER-GET-OBJECT."))
(defmethod handle ((handler object-handler))
(let ((object (object-handler-get-object handler)))
(handle-object handler object)))
(defclass edit-object-handler (form-handler object-handler)
- ())
-
-(defgeneric handle-object-form (handler action object))
+ ()
+ (:documentation "Combined FORM-HANDLER and OBJECT-HANDLER class that
+is used as a base class for handlers that edit an object using a HTML
+form."))
+
+(defgeneric handle-object-form (handler action object)
+ (:documentation "Perform ACTION, a keyword that has been determined by
+parsing the \"action\" input element of the current HTML form, on
+OBJECT, which is parsed using the mechanism of an OBJECT-HANDLER."))
(defmethod handle-form ((handler edit-object-handler) action)
(let ((object (object-handler-get-object handler)))
1
0
Author: ksprotte
Date: Sat Feb 16 11:10:41 2008
New Revision: 2515
Modified:
branches/bos/projects/bos/build.lisp
Log:
dummy commit - nothing changed
Modified: branches/bos/projects/bos/build.lisp
==============================================================================
--- branches/bos/projects/bos/build.lisp (original)
+++ branches/bos/projects/bos/build.lisp Sat Feb 16 11:10:41 2008
@@ -10,7 +10,7 @@
;;;
;;; Lisp-Image fuer das Deployment dumpen
-;;;
+;;;
(defun read-configuration (pathname)
(with-open-file (s pathname)
1
0
Author: ksprotte
Date: Sat Feb 16 09:06:42 2008
New Revision: 2514
Modified:
branches/bos/modules/mail/mail.lisp
Log:
fix for regex-replace-all in mail.lisp
third arg was missing
Modified: branches/bos/modules/mail/mail.lisp
==============================================================================
--- branches/bos/modules/mail/mail.lisp (original)
+++ branches/bos/modules/mail/mail.lisp Sat Feb 16 09:06:42 2008
@@ -97,7 +97,8 @@
*message-id-re*
(first (if (header :in-reply-to)
(split #?/\s+/ (header :in-reply-to))
- (last (split #?/\s+/ (header :references))))))
+ (last (split #?/\s+/ (header :references)))))
+ #?/\1/)
:headers headers
:body body)))))
1
0
Author: ksprotte
Date: Sat Feb 16 08:03:04 2008
New Revision: 2513
Modified:
branches/bos/projects/bos/Makefile
branches/bos/projects/bos/build.sh
Log:
bos added -batch option to build.sh
Modified: branches/bos/projects/bos/Makefile
==============================================================================
--- branches/bos/projects/bos/Makefile (original)
+++ branches/bos/projects/bos/Makefile Sat Feb 16 08:03:04 2008
@@ -5,7 +5,7 @@
lisp -load make-base-lisp.lisp
bos.core: cmucl.core build.sh load.lisp build.lisp
- ./build.sh
+ ./build.sh -batch
# run with slime
.PHONY: slime
Modified: branches/bos/projects/bos/build.sh
==============================================================================
--- branches/bos/projects/bos/build.sh (original)
+++ branches/bos/projects/bos/build.sh Sat Feb 16 08:03:04 2008
@@ -2,4 +2,4 @@
set -x
(cd ../../thirdparty/cl-gd && make)
-lisp -core cmucl.core -noinit -load load.lisp -load build.lisp
+lisp "$@" -core cmucl.core -noinit -load load.lisp -load build.lisp
1
0