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

<li>Fixed attributes to carry an lname even without when occurring

Browse Source 
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>
This commit is contained in:
dlichteblau
2007-03-04 18:30:40 +00:00
parent 818cc0f492
commit 21aa3df3bd
7 changed files with 100 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
doc/GNUmakefile
View File

@ -1,4 +1,5 @@
all: dom.html index.html installation.html klacks.html quickstart.html sax.html xmls-compat.html
%.html: %.xml html.xsl
xsltproc html.xsl $< >$@
xsltproc html.xsl $< >$@.tmp
mv $@.tmp $@

9
doc/index.xml
View File

@ -50,6 +50,15 @@
<a name="changes"/>
<h2>Recent Changes</h2>
<p class="nomargin"><tt>rel-2007-xx-yy</tt></p>
<ul class="nomargin">
<li>Fixed attributes to carry an lname even without 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>
</ul>
<p class="nomargin"><tt>rel-2007-02-18</tt></p>
<ul class="nomargin">
<li>New StAX-like parser interface.</li>

6
doc/installation.xml
View File

@ -10,11 +10,7 @@
<li>
<div>
Anoncvs (<a href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cxml/?cvsroot=cxml">browse</a>):
<pre>$ export CVSROOT=:pserver:anonymous@common-lisp.net:/project/cxml/cvsroot
$ cvs login
Logging in to :pserver:anonymous@common-lisp.net:2401/project/cxml/cvsroot
CVS password: anonymous
$ cvs co cxml</pre>
<pre>cvs -d :pserver:anonymous:anonymous@common-lisp.net:/project/cxml/cvsroot co cxml</pre>
</div>
</li>
</ul>

26
doc/klacks.xml
View File

@ -231,6 +231,32 @@
namespace matches. Return values like <tt>peek</tt> or NIL if no
such event was found.
</p>
<p>
<div class="def">Condition KLACKS:KLACKS-ERROR (xml-parse-error)</div>
The condition class signalled by <tt>expect</tt>.
</p>
<p>
<div class="def">Function KLACKS:EXPECT (source key &amp;optional
value1 value2 value3)</div>
Assert that the current event is equal to (key value1 value2
value3). (Ignore <i>value</i> arguments that are NIL.) If so,
return it as multiple values. Otherwise signal a
<tt>klacks-error</tt>.
</p>
<p>
<div class="def">Function KLACKS:SKIP (source key &amp;optional
value1 value2 value3)</div>
<tt>expect</tt> the specific event, then <tt>consume</tt> it.
</p>
<p>
<div class="def">Macro KLACKS:EXPECTING-ELEMENT ((fn source
&amp;optional lname uri) &amp;body body</div>
Assert that the current event matches (:start-element uri lname).
(Ignore <i>value</i> arguments that are NIL) Otherwise signal a
<tt>klacks-error</tt>.
Evaluate <tt>body</tt> as an implicit progn. Finally assert that
the remaining event matches (:end-element uri lname).
</p>
<a name="klacksax"/>
<h3>Bridging Klacks and SAX</h3>

49
klacks/klacks.lisp
View File

@ -148,7 +148,7 @@
(defun klacks:find-element (source &optional lname uri)
(loop
(multiple-value-bind (key current-uri current-lname current-qname)
(klacks:peek-next source)
(klacks:peek source)
(case key
((nil)
(return nil))
@ -159,14 +159,55 @@
(or (null uri)
(equal uri (klacks:current-uri source))))
(return
(values key current-uri current-lname current-qname))))))))
(values key current-uri current-lname current-qname)))))
(klacks:consume source))))
(defun klacks:find-event (source key)
(loop
(multiple-value-bind (this a b c)
(klacks:peek-next source)
(klacks:peek source)
(cond
((null this)
(return nil))
((eq this key)
(return (values this a b c)))))))
(return (values this a b c))))
(klacks:consume source))))
(define-condition klacks-error (xml-parse-error) ())
(defun klacks-error (fmt &rest args)
(%error 'klacks-error
nil
(format nil "Klacks assertion failed: ~?" fmt args)))
(defun klacks:expect (source key &optional u v w)
(multiple-value-bind (this a b c)
(klacks:peek source)
(unless (eq this key) (klacks-error "expected ~A but got ~A" key this))
(when (and u (not (equal a u)))
(klacks-error "expected ~A but got ~A" u a))
(when (and v (not (equal b v)))
(klacks-error "expected ~A but got ~A" v b))
(when (and w (not (equal c w)))
(klacks-error "expected ~A but got ~A" w c))
(values this a b c)))
(defun klacks:skip (source key &optional a b c)
(klacks:expect source key a b c)
(klacks:consume source))
(defun invoke-expecting-element (fn source &optional lname uri)
(multiple-value-bind (key a b)
(klacks:peek source)
(unless (eq key :start-element)
(klacks-error "expected ~A but got ~A" (or lname "element") key))
(when (and uri (not (equal a uri)))
(klacks-error "expected ~A but got ~A" uri a))
(when (and lname (not (equal b lname)))
(klacks-error "expected ~A but got ~A" lname b))
(multiple-value-prog1
(funcall fn)
(klacks:skip source :end-element a b))))
(defmacro klacks:expecting-element ((source &optional lname uri) &body body)
`(invoke-expecting-element (lambda () ,@body) ,source ,lname ,uri))

7
klacks/package.lisp
View File

@ -27,8 +27,11 @@
#:peek-next
#:consume
#:expect
#:skip
#:find-element
#:find-event
#:expecting-element
#:map-attributes
#:list-attributes
@ -40,4 +43,6 @@
#:serialize-event
#:serialize-element
#:serialize-source))
#:serialize-source
#:klacks-error))

23
xml/xml-parse.lisp
View File

@ -948,12 +948,9 @@
(wf-error nil "Entity '~A' is not defined." (rod-string name)))
def))
(defun xstream-open-extid (extid)
(let* ((sysid (extid-system extid))
(stream
(or (funcall (or (entity-resolver *ctx*) (constantly nil))
(extid-public extid)
(extid-system extid))
(defun xstream-open-extid* (entity-resolver pubid sysid)
(let* ((stream
(or (funcall (or entity-resolver (constantly nil)) pubid sysid)
(open (uri-to-pathname sysid)
:element-type '(unsigned-byte 8)
:direction :input))))
@ -961,6 +958,11 @@
:name (make-stream-name :uri sysid)
:initial-speed 1)))
(defun xstream-open-extid (extid)
(xstream-open-extid* (entity-resolver *ctx*)
(extid-public extid)
(extid-system extid)))
(defun call-with-entity-expansion-as-stream (zstream cont name kind internalp)
;; `zstream' is for error messages
(let ((in (entity->xstream zstream name kind internalp)))
@ -3568,15 +3570,12 @@
(setf (sax:attribute-namespace-uri attribute)
#"http://www.w3.org/2000/xmlns/")
(multiple-value-bind (prefix local-name) (split-qname qname)
(declare (ignorable local-name))
(when (and prefix ;; default namespace doesn't apply to attributes
(or (not (rod= #"xmlns" prefix))
sax:*use-xmlns-namespace*))
(multiple-value-bind (uri prefix local-name)
(decode-qname qname)
(declare (ignore prefix))
(setf (sax:attribute-namespace-uri attribute) uri)
(setf (sax:attribute-local-name attribute) local-name)))))))
(setf (sax:attribute-namespace-uri attribute)
(decode-qname qname)))
(setf (sax:attribute-local-name attribute) local-name)))))
;;;;;;;;;;;;;;;;;