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

doc/GNUmakefile

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

doc/index.xml

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

doc/installation.xml

@@ -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
+      <pre>cvs -d :pserver:anonymous:anonymous@common-lisp.net:/project/cxml/cvsroot co cxml</pre>
-$ cvs login
-Logging in to :pserver:anonymous@common-lisp.net:2401/project/cxml/cvsroot
-CVS password: anonymous
-$ cvs co cxml</pre>
         </div>
       </li>
     </ul>

doc/klacks.xml

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

klacks/klacks.lisp

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

klacks/package.lisp

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

xml/xml-parse.lisp

@@ -948,12 +948,9 @@
       (wf-error nil "Entity '~A' is not defined." (rod-string name)))
     def))
 
-(defun xstream-open-extid (extid)
+(defun xstream-open-extid* (entity-resolver pubid sysid)
-  (let* ((sysid (extid-system extid))
+  (let* ((stream
-         (stream
+          (or (funcall (or entity-resolver (constantly nil)) pubid sysid)
-          (or (funcall (or (entity-resolver *ctx*) (constantly nil))
-                       (extid-public extid)
-                       (extid-system extid))
               (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)
+	    (setf (sax:attribute-namespace-uri attribute)
-		(decode-qname qname)
+		  (decode-qname qname)))
-	      (declare (ignore prefix))
+	  (setf (sax:attribute-local-name attribute) local-name)))))
-	      (setf (sax:attribute-namespace-uri attribute) uri)
-	      (setf (sax:attribute-local-name attribute) local-name)))))))
 
 ;;;;;;;;;;;;;;;;;