Update of /project/cxml/cvsroot/cxml/dom In directory common-lisp.net:/tmp/cvs-serv31930/dom

Modified Files: dom-builder.lisp dom-impl.lisp Log Message: am dom rumgeschraubt und sax-defaults geaendert vielleicht teilweise verkehrt

Date: Sun Dec 4 21:35:15 2005 Author: dlichteblau

Index: cxml/dom/dom-builder.lisp diff -u cxml/dom/dom-builder.lisp:1.4 cxml/dom/dom-builder.lisp:1.5 --- cxml/dom/dom-builder.lisp:1.4 Sun Dec 4 19:43:54 2005 +++ cxml/dom/dom-builder.lisp Sun Dec 4 21:35:15 2005 @@ -22,6 +22,10 @@ (vector-push-extend new-element vector (max 1 (array-dimension vector 0))))

(defmethod sax:start-document ((handler dom-builder)) + (when (and sax:*namespace-processing* + (not (and sax:*include-xmlns-attributes* + sax:*use-xmlns-namespace*))) + (error "SAX configuration is incompatible with DOM: *namespace-processing* is activated, but *include-xmlns-attributes* or *use-xmlns-namespace* are not")) (let ((document (make-instance 'dom-impl::document))) (setf (slot-value document 'dom-impl::owner) nil (slot-value document 'dom-impl::doc-type) nil) @@ -86,7 +90,9 @@ (anodes '())) (dolist (attr attributes) (let ((anode - (dom:create-attribute document (sax:attribute-qname attr))) + (dom:create-attribute-ns document + (sax:attribute-namespace-uri attr) + (sax:attribute-qname attr))) (text (dom:create-text-node document (sax:attribute-value attr)))) (setf (slot-value anode 'dom-impl::specified-p)

Index: cxml/dom/dom-impl.lisp diff -u cxml/dom/dom-impl.lisp:1.5 cxml/dom/dom-impl.lisp:1.6 --- cxml/dom/dom-impl.lisp:1.5 Sun Dec 4 19:43:56 2005 +++ cxml/dom/dom-impl.lisp Sun Dec 4 21:35:15 2005 @@ -39,7 +39,7 @@ (defmethod dom:namespace-uri ((node node)) nil)

(defclass namespace-mixin () - ((prefix :initarg :prefix :reader dom:prefix) + ((prefix :initarg :prefix :accessor dom:prefix) (local-name :initarg :local-name :reader dom:local-name) (namespace-uri :initarg :namespace-uri :reader dom:namespace-uri)))

@@ -267,11 +267,11 @@ (cxml:well-formedness-violation (c) (dom-error :NAMESPACE_ERR "~A" c))) (when prefix - (when (and (rod= prefix "xml") - (not (rod= uri "http://www.w3.org/XML/1998/namespace"))) + (when (and (rod= prefix #"xml") + (not (rod= uri #"http://www.w3.org/XML/1998/namespace"))) (dom-error :NAMESPACE_ERR "invalid uri for prefix `xml'")) - (when (and (rod= prefix "xmlns") - (not (rod= uri "http://www.w3.org/2000/xmlns/"))) + (when (and (rod= prefix #"xmlns") + (not (rod= uri #"http://www.w3.org/2000/xmlns/"))) (dom-error :NAMESPACE_ERR "invalid uri for prefix `xmlns'"))) (values prefix local-name)))

@@ -335,6 +335,7 @@ :prefix nil :namespace-uri nil :specified-p t + :owner-element nil :owner document))

(defmethod dom:create-attribute-ns ((document document) uri qname) @@ -348,6 +349,7 @@ :local-name local-name :prefix prefix :specified-p t + :owner-element nil :owner document)))

(defmethod dom:create-entity-reference ((document document) name) @@ -361,7 +363,7 @@ (defmethod get-elements-by-tag-name-internal (node tag-name) (setf tag-name (rod tag-name)) (let ((result (make-node-list)) - (wild-p (rod= tag-name '#.(string-rod "*")))) + (wild-p (rod= tag-name #"*"))) (labels ((walk (n) (dovector (c (dom:child-nodes n)) (when (dom:element-p c) @@ -375,8 +377,8 @@ (setf uri (rod uri)) (setf lname (rod lname)) (let ((result (make-node-list)) - (wild-uri-p (rod= uri '#.(string-rod "*"))) - (wild-lname-p (rod= lname '#.(string-rod "*")))) + (wild-uri-p (rod= uri #"*")) + (wild-lname-p (rod= lname #"*"))) (labels ((walk (n) (dovector (c (dom:child-nodes n)) (when (dom:element-p c) @@ -1030,6 +1032,12 @@ (defmethod dom:remove-named-item :after ((self attribute-node-map) name) (maybe-add-default-attribute (slot-value self 'element) name))

+(defmethod dom:remove-named-item-ns + ((self attribute-node-map) uri lname) + (let ((k (call-next-method))) + (maybe-add-default-attribute (slot-value self 'element) (dom:node-name k)) + k)) + (defmethod dom:get-elements-by-tag-name ((element element) name) (assert-writeable element) (get-elements-by-tag-name-internal element name)) @@ -1039,6 +1047,10 @@ (get-elements-by-tag-name-internal-ns element uri lname))

(defmethod dom:set-named-item :after ((self attribute-node-map) arg) + (setf (slot-value arg 'owner-element) + (slot-value self 'element))) + +(defmethod dom:set-named-item-ns :after ((self attribute-node-map) arg) (setf (slot-value arg 'owner-element) (slot-value self 'element)))