Update of /project/cxml/cvsroot/cxml/dom In directory clnet:/tmp/cvs-serv30752/dom

Modified Files: dom-impl.lisp Log Message: new feature: clone-node von document bugfix: entities und notations auch in create-document-type readonly

--- /project/cxml/cvsroot/cxml/dom/dom-impl.lisp 2006/08/20 12:19:01 1.38 +++ /project/cxml/cvsroot/cxml/dom/dom-impl.lisp 2006/08/20 12:55:30 1.39 @@ -282,7 +282,10 @@ (defmethod dom:create-document-type ((factory (eql 'implementation)) name publicid systemid) (safe-split-qname name #"") - (%create-document-type name publicid systemid)) + (let ((result (%create-document-type name publicid systemid))) + (setf (slot-value (dom:entities result) 'read-only-p) t) + (setf (slot-value (dom:notations result) 'read-only-p) t) + result))

(defmethod dom:create-document ((factory (eql 'implementation)) uri qname doctype) @@ -1422,6 +1425,42 @@ (let ((*clone-not-import* t)) (dom:import-node (dom:owner-document node) node deep)))

+;; extension: +(defmethod dom:clone-node ((node document) deep) + (let* ((document (make-instance 'document)) + (original-doctype (dom:doctype node)) + (doctype + (when original-doctype + (make-instance 'document-type + :owner document + :name (dom:name original-doctype) + :public-id (dom:public-id original-doctype) + :system-id (dom:system-id original-doctype) + :notations (make-instance 'named-node-map + :element-type :notation + :owner document + :items (dom:items (dom:notations original-doctype))) + :entities (make-instance 'named-node-map + :element-type :entity + :owner document + :items (dom:items + (dom:entities original-doctype))))))) + (setf (slot-value document 'owner) nil) + (setf (slot-value document 'doc-type) doctype) + (setf (slot-value document 'dtd) (dtd node)) + (setf (slot-value document 'entity-resolver) + (slot-value node 'entity-resolver)) + (setf (slot-value (dom:entities doctype) 'read-only-p) t) + (setf (slot-value (dom:notations doctype) 'read-only-p) t) + (when doctype + (setf (dom::%internal-subset doctype) + (dom::%internal-subset original-doctype))) + (when (and (dom:document-element node) deep) + (let* ((*clone-not-import* t) + (clone (dom:import-node document (dom:document-element node) t))) + (dom:append-child document clone))) + document)) +

;;; Erweiterung