--- /project/cxml/cvsroot/cxml/doc/klacks.xml 2007/03/04 21:04:11 1.8
+++ /project/cxml/cvsroot/cxml/doc/klacks.xml 2007/04/22 13:23:54 1.9
@@ -180,6 +180,18 @@
signal an error.
+
Function KLACKS:MAP-CURRENT-NAMESPACE-DECLARATIONS (fn source) => nil
+
+
+ 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. fn is called only for each declaration with two
+ arguments, the prefix and uri.
+
+
Function KLACKS:MAP-ATTRIBUTES (fn source)
@@ -281,6 +293,19 @@
Read all klacks events from source and send them as SAX
events to the SAX handler.
+
+
Class KLACKS:TAPPING-SOURCE (source)
+ 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.
+
+
+
Functon KLACKS:MAKE-TAPPING-SOURCE
+ (upstream-source &optional sax-handler)
+ Create a tapping source relaying events
+ for upstream-source, and sending SAX events
+ to sax-handler.
+
Location information
--- /project/cxml/cvsroot/cxml/doc/sax.xml 2007/03/04 21:04:11 1.2
+++ /project/cxml/cvsroot/cxml/doc/sax.xml 2007/04/22 13:23:54 1.3
@@ -358,16 +358,35 @@
(dom:map-document (cxml:make-validator x #"foo") d))
-
Class CXML:SAX-PROXY ()
+ Class CXML:BROADCAST-HANDLER ()
+ Accessor CXML:BROADCAST-HANDLER-HANDLERS
+ Function CXML:MAKE-BROADCAST-HANDLER (&rest handlers)
+ broadcast-handler is a SAX handler which passes every event it
+ receives on to each of several chained handlers, somewhat similar
+ to the way a broadcast-stream works.
+
+
+ You can subclass broadcast-stream 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.
+
+
+ Broadcast handler functions return the result of calling the event
+ function on the last handler in the list. In particular,
+ the overall result from sax:end-document will be ignored
+ for all other handlers.
+
+
+
+
Class CXML:SAX-PROXY (broadcast-handler)
Accessor CXML:PROXY-CHAINED-HANDLER
- sax-proxy is a SAX handler which passes all events it
- receives on to a user-defined second handler, which defaults
- to nil. Use sax-proxy to modify the events a
- SAX handler receives by defining your own subclass
- of sax-proxy. Setting the chained handler to the target
- handler, and define methods on your handler class for the events
- to be modified. All other events will pass through to the chained
- handler unmodified.
+ sax-proxy is a subclass of broadcast-handler
+ 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 broadcast-handler yet, but has been retrofitted
+ as a subclass of the latter.
From dlichteblau at common-lisp.net Sun Apr 22 13:23:55 2007
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 22 Apr 2007 09:23:55 -0400 (EDT)
Subject: [cxml-cvs] CVS cxml/klacks
Message-ID: <20070422132355.6670116@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/klacks
In directory clnet:/tmp/cvs-serv17056/klacks
Modified Files:
klacks-impl.lisp klacks.lisp package.lisp
Added Files:
tap-source.lisp
Log Message:
+
- New class broadcast-handler as a generalization
+ of the older sax-proxy.
+ - New class tapping-source, 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.
+ Fixed serialize-event to generate
+ start-prefix-mapping and end-prefix-mapping events. New function
+ map-current-namespace-declarations.
--- /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/03/04 21:41:07 1.7
+++ /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp 2007/04/22 13:23:55 1.8
@@ -34,6 +34,7 @@
;; 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)
@@ -281,12 +282,13 @@
#'klacks/done)))
(defun klacks/element (source input cont)
- (with-source (source current-key current-values current-attributes)
+ (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)
- (declare (ignore new-b))
(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))
@@ -297,19 +299,20 @@
(with-source (source current-key current-values current-attributes)
(setf current-key :end-element)
(setf current-attributes nil)
- ;; fixme: (undeclare-namespaces new-b)
(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)
- (let ((values* current-values))
+ 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 ()
- (pop namespace-stack)
+ (setf current-namespace-declarations new-b)
(klacks/element-3 source input values* cont))))
(klacks/content source input finish)))))
@@ -319,7 +322,6 @@
(setf current-values tag-values)
(let ((qname (third tag-values)))
(p/etag input qname)
- ;; fixme: (undeclare-namespaces new-b)
(validate-end-element *ctx* qname))
cont))
@@ -479,6 +481,23 @@
(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
--- /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/03/04 21:41:07 1.6
+++ /project/cxml/cvsroot/cxml/klacks/klacks.lisp 2007/04/22 13:23:55 1.7
@@ -39,12 +39,17 @@
;;;(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:map-previous-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
@@ -74,12 +79,14 @@
(check-type key (member :characters))
characters))
-(defun klacks:serialize-event (source handler)
+(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))
+ (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)
@@ -108,16 +115,28 @@
(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))
+ (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)))
- (klacks:consume source)
+ (when consume
+ (klacks:consume source))
result)))
(defun serialize-declaration-kludge (list handler)
--- /project/cxml/cvsroot/cxml/klacks/package.lisp 2007/03/04 21:41:07 1.4
+++ /project/cxml/cvsroot/cxml/klacks/package.lisp 2007/04/22 13:23:55 1.5
@@ -21,6 +21,8 @@
(:export #:source
#:close-source
#:with-open-source
+ #:tapping-source
+ #:make-tapping-source
#:peek
#:peek-value
@@ -40,6 +42,7 @@
#:current-qname
#:current-characters
#:current-cdata-section-p
+ #:map-current-namespace-declarations
#:serialize-event
#:serialize-element
@@ -50,4 +53,7 @@
#:current-line-number
#:current-column-number
#:current-system-id
- #:current-xml-base))
+ #:current-xml-base
+
+ #:find-namespace-binding
+ #:decode-qname))
--- /project/cxml/cvsroot/cxml/klacks/tap-source.lisp 2007/04/22 13:23:55 NONE
+++ /project/cxml/cvsroot/cxml/klacks/tap-source.lisp 2007/04/22 13:23:55 1.1
;;; -*- 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)))
(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 (seen-event-p source)
(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)))
From dlichteblau at common-lisp.net Sun Apr 22 13:24:03 2007
From: dlichteblau at common-lisp.net (dlichteblau)
Date: Sun, 22 Apr 2007 09:24:03 -0400 (EDT)
Subject: [cxml-cvs] CVS cxml/xml
Message-ID: <20070422132403.E43C913027@common-lisp.net>
Update of /project/cxml/cvsroot/cxml/xml
In directory clnet:/tmp/cvs-serv17056/xml
Modified Files:
package.lisp sax-proxy.lisp
Log Message:
+ - New class broadcast-handler as a generalization
+ of the older sax-proxy.
+ - New class tapping-source, 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.
+ Fixed serialize-event to generate
+ start-prefix-mapping and end-prefix-mapping events. New function
+ map-current-namespace-declarations.
--- /project/cxml/cvsroot/cxml/xml/package.lisp 2007/02/11 18:21:21 1.14
+++ /project/cxml/cvsroot/cxml/xml/package.lisp 2007/04/22 13:23:55 1.15
@@ -78,11 +78,15 @@
#:resolve-extid
#:make-recoder
- #:sax-proxy
- #:proxy-chained-handler
#: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))
--- /project/cxml/cvsroot/cxml/xml/sax-proxy.lisp 2005/12/29 00:31:36 1.4
+++ /project/cxml/cvsroot/cxml/xml/sax-proxy.lisp 2007/04/22 13:23:55 1.5
@@ -8,14 +8,33 @@
(in-package :cxml)
-(defclass sax-proxy ()
- ((chained-handler :initform nil
- :initarg :chained-handler
- :accessor proxy-chained-handler)))
+(defclass broadcast-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)))
(macrolet ((define-proxy-method (name (&rest args))
- `(defmethod ,name ((handler sax-proxy) , at args)
- (,name (proxy-chained-handler handler) , at args))))
+ `(defmethod ,name ((handler broadcast-handler) , at args)
+ (let (result)
+ (dolist (next (broadcast-handler-handlers handler))
+ (setf result (,name next , at 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))
@@ -39,3 +58,7 @@
(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 sax-proxy) parser)
+ (dolist (next (broadcast-handler-handlers handler))
+ (sax:register-sax-parser next parser)))