[cxml-devel] Patch: Add XMLS support for including the namespace URI in the element and attribute names.

[Douglas Crosher]

o Add support for including the namespace URI in the element and
   attribute names.

-------------- next part --------------
o Add support for including the namespace URI in the element and
  attribute names.


Index: xml/xmls-compat.lisp
===================================================================
RCS file: /project/cxml/cvsroot/cxml/xml/xmls-compat.lisp,v
retrieving revision 1.3
diff -u -r1.3 xmls-compat.lisp
--- xml/xmls-compat.lisp	15 May 2006 21:57:47 -0000	1.3
+++ xml/xmls-compat.lisp	13 Jun 2007 08:15:07 -0000
@@ -69,32 +69,56 @@
      (root :initform nil :accessor root)
      (include-default-values :initform t
                              :initarg :include-default-values
-                             :accessor include-default-values)))
-
-(defun make-xmls-builder (&key (include-default-values t))
-  (make-instance 'xmls-builder :include-default-values include-default-values))
+                             :accessor include-default-values)
+     (include-namespace-uri :initform nil
+			    :initarg :include-namespace-uri
+			    :accessor include-namespace-uri)))
+
+(defun make-xmls-builder (&key (include-default-values t)
+			  (include-namespace-uri nil))
+  "Make a XMLS style builder.  When 'include-namespace-uri is true a modified
+  XMLS tree is generated that includes the element namespace URI rather than
+  the qualified name prefix and also includes the namespace URI for attributes."
+  (make-instance 'xmls-builder :include-default-values include-default-values
+		 :include-namespace-uri include-namespace-uri))
 
 (defmethod sax:end-document ((handler xmls-builder))
   (root handler))
 
 (defmethod sax:start-element
     ((handler xmls-builder) namespace-uri local-name qname attributes)
-  (declare (ignore namespace-uri))
   (setf local-name (or local-name qname))
-  (let* ((attributes
+  (let* ((include-default-values (include-default-values handler))
+	 (include-namespace-uri (include-namespace-uri handler))
+	 (attributes
           (loop
               for attr in attributes
-              when (or (sax:attribute-specified-p attr)
-                       (include-default-values handler))
+	      for attr-namespace-uri = (sax:attribute-namespace-uri attr)
+	      for attr-local-name = (sax:attribute-local-name attr)
+              when (and (or (sax:attribute-specified-p attr)
+			    include-default-values)
+			(or (not include-namespace-uri)
+			    (not attr-namespace-uri)
+			    attr-local-name))
               collect
-                (list (sax:attribute-qname attr)
+                (list (cond (include-namespace-uri
+			     (cond (attr-namespace-uri
+				    (cons attr-local-name attr-namespace-uri))
+				   (t
+				    (sax:attribute-qname attr))))
+                            (t
+                             (sax:attribute-qname attr)))
                       (sax:attribute-value attr))))
+	 (namespace (cond (include-namespace-uri
+			   namespace-uri)
+			  (t
+			   (let ((lq (length qname))
+				 (ll (length local-name)))
+			     (if (eql lq ll)
+				 nil
+				 (subseq qname 0 (- lq ll 1)))))))
          (node (make-node :name local-name
-                          :ns (let ((lq (length qname))
-                                    (ll (length local-name)))
-                                (if (eql lq ll)
-                                    nil
-                                    (subseq qname 0 (- lq ll 1))))
+                          :ns namespace
                           :attrs attributes))
          (parent (car (element-stack handler))))
     (if parent