[cxml-cvs] CVS cxml/klacks

[dlichteblau]

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

Modified Files:
	klacks-impl.lisp klacks.lisp package.lisp 
Log Message:
find-element, find-event


--- /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp	2007/02/18 15:27:30	1.4
+++ /project/cxml/cvsroot/cxml/klacks/klacks-impl.lisp	2007/02/18 16:46:33	1.5
@@ -79,6 +79,12 @@
     (fill-source source)
     (apply #'values current-values)))
 
+(defmethod klacks:peek-next ((source cxml-source))
+  (with-source (source current-key current-values)
+    (setf current-key nil)
+    (fill-source source)
+    (apply #'values current-key current-values)))
+
 (defmethod klacks:consume ((source cxml-source))
   (with-source (source current-key current-values)
     (fill-source source)
--- /project/cxml/cvsroot/cxml/klacks/klacks.lisp	2007/02/18 14:35:15	1.2
+++ /project/cxml/cvsroot/cxml/klacks/klacks.lisp	2007/02/18 16:46:33	1.3
@@ -69,9 +69,9 @@
     (check-type key (member :characters))
     characters))
 
-(defun klacks:serialize-source (source handler)
-  (loop
-    (multiple-value-bind (key a b c) (klacks:peek source)
+(defun klacks:serialize-event (source handler)
+  (multiple-value-bind (key a b c) (klacks:peek source)
+    (let ((result nil))
       (case key
 	(:start-document
 	  (sax:start-document handler))
@@ -107,12 +107,66 @@
 	(:end-element
 	  (sax:end-element handler a b c))
 	(:end-document
-	  (return (sax:end-document handler)))
+	  (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))))
+      (klacks:consume source)
+      result)))
 
 (defun serialize-declaration-kludge (list handler)
   (loop
       for (fn . args) in list
       do (apply fn handler args)))
+
+(defun klacks:serialize-source (source handler)
+  (loop
+    (let ((document (klacks:serialize-event source handler)))
+      (when document
+	(return document)))))
+
+(defun klacks:serialize-element (source handler &key (document-events t))
+  (unless (eq (klacks:peek source) :start-element)
+    (error "not at start of element"))
+  (when document-events
+    (sax:start-document handler))
+  (labels ((recurse ()
+	     (klacks:serialize-event source handler)
+	     (loop
+	       (let ((key (klacks:peek source)))
+		 (ecase key
+		   (:start-element (recurse))
+		   (:end-element (return))
+		   ((:characters :comment :processing-instruction)
+		     (klacks:serialize-event source handler)))))
+	     (klacks:serialize-event source handler)))
+    (recurse))
+  (when document-events
+    (sax:end-document handler)))
+
+(defun klacks:find-element (source &optional lname uri)
+  (loop
+    (multiple-value-bind (key current-uri current-lname current-qname)
+	(klacks:peek-next source)
+      (case key
+	((nil)
+	  (return nil))
+	(:start-element
+	  (when (and (eq key :start-element)
+		     (or (null lname)
+			 (equal lname (klacks:current-lname source)))
+		     (or (null uri)
+			 (equal uri (klacks:current-uri source))))
+	    (return
+	      (values key current-uri current-lname current-qname))))))))
+
+(defun klacks:find-event (source key)
+  (loop
+    (multiple-value-bind (this a b c)
+	(klacks:peek-next source)
+      (cond
+	((null this)
+	  (return nil))
+	((eq this key)
+	  (return (values this a b c)))))))
--- /project/cxml/cvsroot/cxml/klacks/package.lisp	2007/02/11 18:21:21	1.1
+++ /project/cxml/cvsroot/cxml/klacks/package.lisp	2007/02/18 16:46:33	1.2
@@ -24,6 +24,11 @@
 
 	   #:peek
 	   #:peek-value
+	   #:peek-next
+	   #:consume
+
+	   #:find-element
+	   #:find-event
 
 	   #:map-attributes
 	   #:list-attributes
@@ -33,6 +38,6 @@
 	   #:current-characters
 	   #:current-cdata-section-p
 	   
-	   #:consume
-
+	   #:serialize-event
+	   #:serialize-element
 	   #:serialize-source))