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

3
cxml.asd
View File

@ -118,7 +118,8 @@
:components
((:file "package")
(:file "klacks")
(:file "klacks-impl"))
(:file "klacks-impl")
(:file "tap-source"))
:depends-on (:cxml-xml))
(asdf:defsystem :cxml-test

10
doc/cxml.css
View File

@ -10,10 +10,11 @@ div.sidebar-title {
background-color: #9c0000;
border: solid #9c0000;
border-top-width: 1px;
border-bottom-width: 0px;
border-bottom-width: 2px;
border-left-width: 4px;
border-right-width: 0px;
margin: 0em 2pt 1px 2em;
padding-left: 1px;
margin: 0em 2pt 0px 2em;
}
div.sidebar-title a {
@ -21,15 +22,14 @@ div.sidebar-title a {
}
div.sidebar-main {
background-color: #eeeeee;
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-top: 2px;
padding-left: 2px;
padding: 1em;
}
div.sidebar ul.main {

12
doc/index.xml
View File

@ -55,12 +55,20 @@
<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>Fixed attributes to carry an lname even without when occurring
<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.</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.</li>
klacks:expecting-element. Fixed serialize-event to generate
start-prefix-mapping and end-prefix-mapping events. New function
map-current-namespace-declarations.</li>
</ul>
<p class="nomargin"><tt>rel-2007-02-18</tt></p>
<ul class="nomargin">

25
doc/klacks.xml
View File

@ -179,6 +179,18 @@
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>
@ -281,6 +293,19 @@
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 &amp;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>

37
doc/sax.xml
View File

@ -358,16 +358,35 @@
(dom:map-document (cxml:make-validator x #"foo") d))</pre>
<p>
<div class="def">Class CXML:SAX-PROXY ()</div>
<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 (&amp;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 SAX handler which passes all events it
receives on to a user-defined second handler, which defaults
to <tt>nil</tt>. Use <tt>sax-proxy</tt> to modify the events a
SAX handler receives by defining your own subclass
of <tt>sax-proxy</tt>. 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.
<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>

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

8
xml/package.lisp
View File

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

35
xml/sax-proxy.lisp
View File

@ -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) ,@args)
(,name (proxy-chained-handler handler) ,@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))
@ -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)))