o Add support for including the namespace URI in the element and attribute names.
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