Commit 5a0e7057 authored by david's avatar david

Revision: cxml--devel--1.0--patch-3

Archive: david@knowledgetools.de--cxml
Creator: David Lichteblau <david@knowledgetools.de>
Date: Wed Jan  7 21:14:38 CET 2004
Standard-date: 2004-01-07 20:14:38 GMT
Modified-files: xml/dom-impl.lisp xml/dompack.lisp
New-patches: david@knowledgetools.de--cxml/cxml--devel--1.0--patch-3
Summary: add dom:remove-child, dom:import-node
Keywords:

  - dom:get-elements-by-tag-name: tag-name-eq workaround
  - dom:remove-child: new function
  - dom:import-node: new function (DOM2)
parent c73b07b7
......@@ -133,7 +133,10 @@
(let ((result nil))
(setf tag-name (rod tag-name))
(let ((wild-p (rod= tag-name '#.(string-rod "*"))))
(labels ((walk (n)
(labels ((tag-name-eq (a b)
;; XXX ist das richtig? TAG-NAME-EQ war undefiniert
(rod= a b))
(walk (n)
(when (and (dom:element-p n)
(or wild-p (tag-name-eq tag-name (dom:node-name n))))
(push n result))
......@@ -236,6 +239,12 @@
(return))))
old-child))
(defmethod dom:remove-child ((node node) (old-child node))
(with-slots (children) old-child
(setf children (remove old-child children))
(setf (slot-value old-child 'parent) nil)
old-child))
(defmethod dom:append-child ((node node) (new-child node))
(ensure-valid-insertion-request node new-child)
(with-slots (children) node
......@@ -510,3 +519,63 @@
(defmethod dom:named-node-map-p ((object named-node-map)) t)
(defmethod dom:named-node-map-p ((object t)) nil)
;; importNode
(defmethod import-node-internal (class document node deep &rest initargs)
(let ((result (apply #'make-instance class :owner document initargs)))
(when deep
(dolist (child (dom:child-nodes node))
(dom:append-child result (dom:import-node document child t))))))
(defmethod dom:import-node ((document document) (node attribute) deep)
(declare (ignore deep))
(import-node-internal 'attribute document node t
:name (dom:name node)
:value (dom:value node)))
(defmethod dom:import-node ((document document) (node document-fragment) deep)
(import-node-internal 'document-fragment document node deep))
(defmethod dom:import-node ((document document) (node element) deep)
(let ((result (import-node-internal 'element document node deep
:tag-name (dom:tag-name node))))
(dolist (attribute (dom:items (dom:attributes node)))
(when (dom:specified attribute)
(dom:set-attribute result (dom:name attribute) (dom:value attribute))))
result))
(defmethod dom:import-node ((document document) (node entity) deep)
(import-node-internal 'entity document node deep
:public-id (dom:public-id node)
:system-id (dom:system-id node)
:notation-name (dom:notation-name node)))
(defmethod dom:import-node ((document document) (node entity-reference) deep)
(declare (ignore deep))
#+(or)
(import-node-internal 'entity-reference document node nil
:name (dom:name node))
;; XXX If the document being imported into provides a definition for
;; this entity name, its value is assigned.
(error "not implemented"))
(defmethod dom:import-node ((document document) (node notation) deep)
(import-node-internal 'notation document node deep
:name (dom:name node)
:public-id (dom:public-id node)
:system-id (dom:system-id node)))
(defmethod dom:import-node
((document document) (node processing-instruction) deep)
(import-node-internal 'notation document node deep
:name (dom:name node)
:public-id (dom:public-id node)
:system-id (dom:system-id node)))
;; TEXT_NODE, CDATA_SECTION_NODE, COMMENT_NODE
(defmethod dom:import-node
((document document) (node character-data) deep)
(import-node-internal (class-of node) document node deep
:data (dom:data node)))
(defpackage :dom
(in-package :cl-user)
(defpackage :cdom
(:use)
(:export
......@@ -62,6 +64,7 @@
#:system-id
#:notation-name
#:target
#:import-node
;; protocol classes
#:dom-implementation
......@@ -99,4 +102,4 @@
#:entity-reference-p
#:processing-instruction-p
#:named-node-map-p
))
\ No newline at end of file
))
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment