1 ;;; -*- Mode: Lisp; readtable: runes; -*-
2 ;;; (c) copyright 2007 David Lichteblau
4 ;;; This library is free software; you can redistribute it and/or
5 ;;; modify it under the terms of the GNU Library General Public
6 ;;; License as published by the Free Software Foundation; either
7 ;;; version 2 of the License, or (at your option) any later version.
9 ;;; This library is distributed in the hope that it will be useful,
10 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12 ;;; Library General Public License for more details.
14 ;;; You should have received a copy of the GNU Library General Public
15 ;;; License along with this library; if not, write to the
16 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17 ;;; Boston, MA 02111-1307 USA.
21 (defun klacks:make-tapping-source
(upstream-source &optional sax-handler
)
22 (make-instance 'klacks
:tapping-source
23 :upstream-source upstream-source
24 :dribble-handler sax-handler
))
26 (defclass klacks
:tapping-source
(klacks:source
)
27 ((upstream-source :initarg
:upstream-source
:accessor upstream-source
)
28 (dribble-handler :initarg
:dribble-handler
:accessor dribble-handler
)
29 (seen-event-p :initform nil
:accessor seen-event-p
)
30 (document-done-p :initform nil
:accessor document-done-p
)))
32 (defmethod initialize-instance :after
((instance klacks
:tapping-source
) &key
)
33 (let ((s-p (make-instance 'klacksax
:source
(upstream-source instance
))))
34 (sax:register-sax-parser
(dribble-handler instance
) s-p
)))
39 (defun maybe-dribble (source)
40 (unless (or (seen-event-p source
) (document-done-p source
))
41 (when (eq (klacks:peek
(upstream-source source
)) :end-document
)
42 (setf (document-done-p source
) t
))
43 (klacks:serialize-event
(upstream-source source
)
44 (dribble-handler source
)
46 (setf (seen-event-p source
) t
)))
48 (defmethod klacks:peek
((source klacks
:tapping-source
))
50 (klacks:peek
(upstream-source source
))
51 (maybe-dribble source
)))
53 (defmethod klacks:peek-value
((source klacks
:tapping-source
))
55 (klacks:peek-value
(upstream-source source
))
56 (maybe-dribble source
)))
58 (defmethod klacks:peek-next
((source klacks
:tapping-source
))
59 (setf (seen-event-p source
) nil
)
61 (klacks:peek-next
(upstream-source source
))
62 (maybe-dribble source
)))
64 (defmethod klacks:consume
((source klacks
:tapping-source
))
65 (maybe-dribble source
)
67 (klacks:consume
(upstream-source source
))
68 (setf (seen-event-p source
) nil
)))
73 (defmethod klacks:close-source
((source klacks
:tapping-source
))
74 (klacks:close-source
(upstream-source source
)))
76 (defmethod klacks:map-attributes
(fn (source klacks
:tapping-source
))
77 (klacks:map-attributes fn
(upstream-source source
)))
79 (defmethod klacks:map-current-namespace-declarations
80 (fn (source klacks
:tapping-source
))
81 (klacks:map-current-namespace-declarations fn
(upstream-source source
)))
83 (defmethod klacks:list-attributes
((source klacks
:tapping-source
))
84 (klacks:list-attributes
(upstream-source source
)))
86 (defmethod klacks:current-line-number
((source klacks
:tapping-source
))
87 (klacks:current-line-number
(upstream-source source
)))
89 (defmethod klacks:current-column-number
((source klacks
:tapping-source
))
90 (klacks:current-column-number
(upstream-source source
)))
92 (defmethod klacks:current-system-id
((source klacks
:tapping-source
))
93 (klacks:current-system-id
(upstream-source source
)))
95 (defmethod klacks:current-xml-base
((source klacks
:tapping-source
))
96 (klacks:current-xml-base
(upstream-source source
)))
98 (defmethod klacks:current-cdata-section-p
((source klacks
:tapping-source
))
99 (klacks:current-cdata-section-p
(upstream-source source
)))
101 (defmethod klacks:find-namespace-binding
102 (prefix (source klacks
:tapping-source
))
103 (klacks:find-namespace-binding prefix
(upstream-source source
)))
105 (defmethod klacks:decode-qname
(qname (source klacks
:tapping-source
))
106 (klacks:decode-qname qname
(upstream-source source
)))