[cxml-cvs] CVS cxml/klacks

[dlichteblau]

Update of /project/cxml/cvsroot/cxml/klacks
In directory clnet:/tmp/cvs-serv1722/klacks

Modified Files:
	klacks.lisp package.lisp 
Log Message:
      <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>


--- /project/cxml/cvsroot/cxml/klacks/klacks.lisp	2007/02/18 16:46:33	1.3
+++ /project/cxml/cvsroot/cxml/klacks/klacks.lisp	2007/03/04 18:30:41	1.4
@@ -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 () , at body) ,source ,lname ,uri))
--- /project/cxml/cvsroot/cxml/klacks/package.lisp	2007/02/18 16:46:33	1.2
+++ /project/cxml/cvsroot/cxml/klacks/package.lisp	2007/03/04 18:30:41	1.3
@@ -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))