[cxml-cvs] CVS update: cxml/dom/dom-impl.lisp

[David Lichteblau]

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

Modified Files:
	dom-impl.lisp 
Log Message:
 782/808 removeAttributeNS02.xml
-TEST FAILED: There is no applicable method for the generic function
-               #<STANDARD-GENERIC-FUNCTION DOM:NAMESPACE-URI (2)>
-             when called with arguments
-               (NIL).

Date: Sun Dec 11 21:04:07 2005
Author: dlichteblau

Index: cxml/dom/dom-impl.lisp
diff -u cxml/dom/dom-impl.lisp:1.28 cxml/dom/dom-impl.lisp:1.29
--- cxml/dom/dom-impl.lisp:1.28	Sun Dec 11 20:54:57 2005
+++ cxml/dom/dom-impl.lisp	Sun Dec 11 21:04:06 2005
@@ -1039,19 +1039,23 @@
     (unless (find old-attr items)
       (dom-error :NOT_FOUND_ERR "Attribute not found."))
     (setf items (remove old-attr items))
-    (maybe-add-default-attribute element (dom:name old-attr))
+    (maybe-add-default-attribute element old-attr)
     old-attr))
 
 ;; eek, defaulting:
 
-(defun maybe-add-default-attribute (element name)
-  (let* ((dtd (dtd (slot-value element 'owner)))
+(defun maybe-add-default-attribute (element old-attr)
+  (let* ((qname (dom:name old-attr))
+	 (dtd (dtd (slot-value element 'owner)))
          (e (when dtd (cxml::find-element
 		       (cxml::rod (dom:tag-name element))
 		       dtd)))
-         (a (when e (cxml::find-attribute e name))))
+         (a (when e (cxml::find-attribute e qname))))
     (when (and a (listp (cxml::attdef-default a)))
-      (add-default-attribute element a))))
+      (let ((new (add-default-attribute element a)))
+	(setf (slot-value new 'namespace-uri) (dom:namespace-uri old-attr))
+	(setf (slot-value new 'prefix) (dom:prefix old-attr))
+	(setf (slot-value new 'local-name) (dom:local-name old-attr))))))
 
 (defun add-default-attributes (element)
   (let* ((dtd (dtd (slot-value element 'owner)))
@@ -1065,7 +1069,16 @@
 		   (not (dom:get-attribute-node
 			 element
 			 (cxml::attdef-name a))))
-          (add-default-attribute element a))))))
+          (let ((anode (add-default-attribute element a)))
+	    (multiple-value-bind (prefix local-name)
+		(handler-case
+		    (cxml::split-qname (cxml::attdef-name a))
+		  (cxml:well-formedness-violation (c)
+		    (dom-error :NAMESPACE_ERR "~A" c)))
+	      ;; das ist fuer importnode07.
+	      ;; so richtig ueberzeugend finde ich das ja nicht.
+	      (setf (slot-value anode 'prefix) prefix)
+	      (setf (slot-value anode 'local-name) local-name))))))))
 
 (defun add-default-attribute (element adef)
   (let* ((value (second (cxml::attdef-default adef)))
@@ -1074,25 +1087,20 @@
          (text (dom:create-text-node owner value)))
     (setf (slot-value anode 'specified-p) nil)
     (setf (slot-value anode 'owner-element) element)
-    (multiple-value-bind (prefix local-name)
-	(handler-case
-	    (cxml::split-qname (cxml::attdef-name adef))
-	  (cxml:well-formedness-violation (c)
-	    (dom-error :NAMESPACE_ERR "~A" c)))
-      ;; das ist fuer importnode07.
-      ;; so richtig ueberzeugend finde ich das ja nicht.
-      (setf (slot-value anode 'prefix) prefix)
-      (setf (slot-value anode 'local-name) local-name))
     (dom:append-child anode text)
-    (push anode (slot-value (dom:attributes element) 'items))))
+    (push anode (slot-value (dom:attributes element) 'items))
+    anode))
 
-(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 ((self attribute-node-map) name)
+  name
+  (let ((k (call-next-method)))
+    (maybe-add-default-attribute (slot-value self 'element) k)
+    k))
 
-(defmethod dom:remove-named-item-ns
-    ((self attribute-node-map) uri lname)
+(defmethod dom:remove-named-item-ns ((self attribute-node-map) uri lname)
+  uri lname
   (let ((k (call-next-method)))
-    (maybe-add-default-attribute (slot-value self 'element) (dom:node-name k))
+    (maybe-add-default-attribute (slot-value self 'element) k)
     k))
 
 (defmethod dom:get-elements-by-tag-name ((element element) name)