am dom rumgeschraubt und sax-defaults geaendert
vielleicht teilweise verkehrt
This commit is contained in:
@ -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)
|
||||
|
||||
@ -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))
|
||||
@ -1042,6 +1050,10 @@
|
||||
(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)))
|
||||
|
||||
(defmethod dom:normalize ((node node))
|
||||
(assert-writeable node)
|
||||
(labels ((walk (n)
|
||||
|
||||
Reference in New Issue
Block a user