OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ <li>New class <tt>broadcast-handler</tt> as a generalization

Browse Source 
+      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>
This commit is contained in:
dlichteblau
2007-04-22 13:23:54 +00:00
parent c43b58dd3e
commit b8ba07a919
11 changed files with 264 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
klacks/klacks-impl.lisp
View File

@ -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

27
klacks/klacks.lisp
View File

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

8
klacks/package.lisp
View File

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

103
klacks/tap-source.lisp Normal file
View File

@ -0,0 +1,103 @@
;;; -*- 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)))