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: + <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>

+ Fixed serialize-event to generate + start-prefix-mapping and end-prefix-mapping events. New function + map-current-namespace-declarations.</li>

--- /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)))