? dom-impl-children.diff
Index: dom-impl.lisp
===================================================================
RCS file: /project/cxml/cvsroot/cxml/dom/dom-impl.lisp,v
retrieving revision 1.37
diff -u -r1.37 dom-impl.lisp
--- dom-impl.lisp	23 Jan 2006 21:54:07 -0000	1.37
+++ dom-impl.lisp	12 Jun 2006 22:34:27 -0000
@@ -42,7 +42,7 @@
 
 (defclass node ()
   ((parent      :initarg :parent        :initform nil)
-   (children    :initarg :children      :initform (make-node-list))
+   (children    :initarg :children      :initform nil)
    (owner       :initarg :owner         :initform nil)
    (read-only-p :initform nil           :reader read-only-p)
    (map         :initform nil)))
@@ -232,8 +232,6 @@
 (defun make-space (vector &optional (n 1))
   (adjust-vector-exponentially vector (+ (length vector) n) nil))
 
-(defun extension (vector)
-  (max (array-dimension vector 0) 1))
 
 ;; dom-exception
 
@@ -448,7 +446,7 @@
 	       (dovector (c (dom:child-nodes n))
 		 (when (dom:element-p c)
 		   (when (or wild-p (rod= tag-name (dom:node-name c)))
-		     (vector-push-extend c result (extension result)))
+		     (vector-push-extend c result))
 		   (walk c)))))
       (walk node))
     result))
@@ -464,7 +462,7 @@
 		 (when (dom:element-p c)
 		   (when (and (or wild-lname-p (rod= lname (dom:local-name c)))
 			      (or wild-uri-p (rod= uri (dom:namespace-uri c))))
-		     (vector-push-extend c result (extension result)))
+		     (vector-push-extend c result ))
 		   (walk c)))))
       (walk node))
     result))
@@ -512,13 +510,13 @@
   (slot-value node 'children))
 
 (defmethod dom:first-child ((node node))
-  (dom:item (slot-value node 'children) 0))
+  (and (dom:has-child-nodes node)
+       (dom:item (slot-value node 'children) 0)))
 
 (defmethod dom:last-child ((node node))
   (with-slots (children) node
-    (if (plusp (length children))
-        (elt children (1- (length children)))
-        nil)))
+    (and (dom:has-child-nodes node)
+	 (elt children (1- (length children))))))
 
 (defmethod dom:previous-sibling ((node node))
   (with-slots (parent) node
@@ -570,9 +568,11 @@
     (dom:remove-child (slot-value new-child 'parent) new-child)))
 
 (defmethod dom:insert-before ((node node) (new-child node) ref-child)
-  (ensure-valid-insertion-request node new-child)
-  (with-slots (children) node
-    (if ref-child
+  (if ref-child
+      (with-slots (children) node
+	(ensure-valid-insertion-request node new-child)
+	(unless children
+	  (setf children (make-node-list)))
         (let ((i (position ref-child children)))
           (unless i
             (dom-error :NOT_FOUND_ERR "~S is no child of ~S." ref-child node))
@@ -580,9 +580,10 @@
           (move children children i (1+ i) (- (length children) i))
           (incf (fill-pointer children))
           (setf (elt children i) new-child))
-        (vector-push-extend new-child children (extension children)))
-    (setf (slot-value new-child 'parent) node)
-    new-child))
+        
+	(setf (slot-value new-child 'parent) node)
+	new-child)
+      (dom:append-child node new-child)))
 
 (defmethod dom:insert-before ((node node) (fragment document-fragment) ref-child)
   (dovector (child (dom:child-nodes fragment))
@@ -619,7 +620,9 @@
 (defmethod dom:append-child ((node node) (new-child node))
   (ensure-valid-insertion-request node new-child)
   (with-slots (children) node
-    (vector-push-extend new-child children (extension children))
+    (unless children
+      (setf children (make-node-list)))
+    (vector-push-extend new-child children )
     (setf (slot-value new-child 'parent) node)
     new-child))
 
@@ -760,10 +763,15 @@
 ;;; NodeList
 
 (defun make-node-list (&optional initial-contents)
-  (make-array (length initial-contents)
-              :adjustable t
-              :fill-pointer (length initial-contents)
-              :initial-contents initial-contents))
+  (let ((len (length initial-contents)))
+    (if (plusp len)
+	(make-array len
+		    :adjustable t
+		    :fill-pointer len
+		    :initial-contents initial-contents)
+	(make-array 4
+		    :adjustable t
+		    :fill-pointer 0))))
 
 (defmethod dom:item ((self vector) index)
   (if (< index (length self))
@@ -772,6 +780,8 @@
 
 (defmethod dom:length ((self vector))
   (length self))
+(defmethod dom:length ((null null))
+  0)
 
 ;;; NAMED-NODE-MAP
 
@@ -950,7 +960,7 @@
 (defmethod dom:value ((node attribute))
   (with-slots (children) node
     (cond
-      ((zerop (length children))
+      ((not (dom:has-child-nodes node))
         #.(rod-string ""))
       ((and (eql (length children) 1)
             (eq (dom:node-type (elt children 0)) :text))
@@ -966,7 +976,7 @@
     (with-slots (children owner) node
       ;; remove children, add new TEXT-NODE child
       ;; (alas, we must not reuse an old TEXT-NODE)
-      (cxml::while (plusp (length children))
+      (cxml::while (dom:has-child-nodes node)
         (dom:remove-child node (dom:last-child node)))
       (dom:append-child node (dom:create-text-node owner rod))))
   new-value)
