[Only print necessary xmlns declarations
clinton@unknownlamer.org**20090501063814
 Ignore-this: bebb8930e0ef42751d27c04742d91db4
 And the prototype implementation grows even more evil...
] hunk ./src/xmlisp2.lisp 247
+(defun package->xmlns-attribute (package)
+  (sax:make-attribute
+   :namespace-uri "http://www.w3.org/2000/xmlns/"
+   :local-name (package-name package)
+   :qname (format nil "xmlns:~A" (package-name package))
+   :value (package->xmlns package)
+   :specified-p t))
+
+(defvar *current-namespaces* nil)
+
hunk ./src/xmlisp2.lisp 261
-	 (xmlns (package->xmlns class-name-package)))
-    #+nil(break "~A ~A ~A" class-name class-name-package xmlns)
-    (sax:start-element sink xmlns (symbol-local-name class-name)
-		       (symbol-qualified-name class-name)
-		       (nconc
-			(mapcan (lambda (slot)
-				  (let ((name (c2mop:slot-definition-name slot))
-					(type (c2mop:slot-definition-type slot)))
-				    (when (and (serialize-slot-p object name)
-					       (serialize-as-attribute-p object
-									 name
-									 type))
-				      (list (sax:make-attribute
-					     :namespace-uri (symbol-uri name)
-					     :local-name (symbol-local-name name)
-					     :qname (symbol-qualified-name name)
-					     :value (lisp-value->xml-value
-						     (slot-value object name))
-					     :specified-p t)))))
-				(c2mop:class-slots (class-of object)))
-			(mapcar (lambda (package)
-				  (sax:make-attribute
-				   :namespace-uri "http://www.w3.org/2000/xmlns/"
-				   :local-name (package-name package)
-				   :qname (format nil "xmlns:~A" (package-name package))
-				   :value (package->xmlns package)
-				   :specified-p t))
-				(remove-duplicates
-				 (mapcar (compose #'symbol-package
-						  #'c2mop:slot-definition-name)
-					 (c2mop:class-slots (class-of object)))))))
-    (mapc (lambda (slot-def)
-	    (serialize-xml-object
-	     (slot-value object
-			 (c2mop:slot-definition-name slot-def))
-	     sink))
-	  (remove-if-not (lambda (slot)
-			   (let ((name (c2mop:slot-definition-name slot))
-				       (type (c2mop:slot-definition-type slot)))
-			     (and (serialize-slot-p object name)
-				  (serialize-as-subelement-p object
-							     name
-							     type))))
-			 (c2mop:class-slots (class-of object))))
+	 (xmlns (package->xmlns class-name-package))
+	 (xmlns-attributes (remove-if
+			    (lambda (ns)
+			      (some (lambda (namespaces)
+				      (member ns
+					      namespaces
+					      :test (lambda (i1 i2)
+						      (string=
+						       (sax:attribute-value i1)
+						       (sax:attribute-value i2)))))
+				    *current-namespaces*))
+			    (cons (package->xmlns-attribute class-name-package)
+				  (mapcar #'package->xmlns-attribute
+					  (remove-duplicates
+					   (mapcar (compose
+						    #'symbol-package
+						    #'c2mop:slot-definition-name)
+						   (c2mop:class-slots
+						    (class-of object)))))))))
+    (let ((*current-namespaces* (cons xmlns-attributes *current-namespaces*)))
+      #+nil(break "~A ~A ~A" class-name class-name-package xmlns)
+      (sax:start-element sink xmlns (symbol-local-name class-name)
+			 (symbol-qualified-name class-name)
+			 (nconc
+			  (mapcan (lambda (slot)
+				    (let ((name (c2mop:slot-definition-name slot))
+					  (type (c2mop:slot-definition-type slot)))
+				      (when (and (serialize-slot-p object name)
+						 (serialize-as-attribute-p object
+									   name
+									   type))
+					(list (sax:make-attribute
+					       :namespace-uri (symbol-uri name)
+					       :local-name (symbol-local-name name)
+					       :qname (symbol-qualified-name name)
+					       :value (lisp-value->xml-value
+						       (slot-value object name))
+					       :specified-p t)))))
+				  (c2mop:class-slots (class-of object)))
+			  xmlns-attributes))
+      (mapc (lambda (slot-def)
+	      (serialize-xml-object
+	       (slot-value object
+			   (c2mop:slot-definition-name slot-def))
+	       sink))
+	    (remove-if-not (lambda (slot)
+			     (let ((name (c2mop:slot-definition-name slot))
+				   (type (c2mop:slot-definition-type slot)))
+			       (and (serialize-slot-p object name)
+				    (serialize-as-subelement-p object
+							       name
+							       type))))
+			   (c2mop:class-slots (class-of object)))))