1 ;;; dom.el --- DOM implementation
3 ;; Copyright (C) 2001 Alex Schroeder <alex@gnu.org>
5 ;; Author: Alex Schroeder <alex@gnu.org>
6 ;; Henrik.Motakef <elisp@henrik-motakef.de>
7 ;; Maintainer: Henrik.Motakef <elisp@henrik-motakef.de>
10 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?XmlParser
11 ;; Version: $Id: dom.el,v 1.1 2002/08/14 20:22:21 henrik Exp henrik $
13 ;; This file is not part of GNU Emacs.
15 ;; This is free software; you can redistribute it and/or modify it under
16 ;; the terms of the GNU General Public License as published by the Free
17 ;; Software Foundation; either version 2, or (at your option) any later
20 ;; This is distributed in the hope that it will be useful,
21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
28 ;; Boston, MA 02111-1307, USA.
32 ;; If you are working with XML documents, the parsed data structure
33 ;; returned by the XML parser (xml.el) may be enough for you: Lists of
34 ;; lists, symbols, strings, plus a number of accessor functions.
36 ;; If you want a more elaborate data structure to work with your XML
37 ;; document, you can create a document object model (DOM) from the XML
38 ;; data structure using dom.el.
40 ;; You can create a DOM from XML using `dom-make-document-from-xml'.
41 ;; Note that `xml-parse-file' will return a list of top level elements
42 ;; found in the file, so you must choose one element in that list.
45 ;; (setq doc (dom-make-document-from-xml (car (xml-parse-file "sample.xml"))))
47 ;; Note that this DOM implementation uses the attributes and tag names
48 ;; used by the XML parser. If the XML parser uses symbols instead of
49 ;; string (like xml.el does), then dom.el will also use symbols. If the
50 ;; XML parsers uses strings (like xml-parse.el does), then dom.el will
53 ;; It should be trivial to write functions analogous to the
54 ;; dom-*-from-xml functions in order to use an another XML parsers (from
55 ;; psgml.el, for example).
57 ;;; On Interfaces and Classes
59 ;; The elisp DOM implementation uses the dom-node structure to store all
60 ;; attributes. The various interfaces consist of sets of functions to
61 ;; manipulate these dom-nodes. The functions of a certain interface
62 ;; share the same prefix.
66 ;; The test code assumes a file named sample.xml with the following
69 ;; <book id="compiler">
72 ;; <title>My own book!</title>
73 ;; <edition>First</edition>
76 ;; <firstname>John</firstname>
77 ;; <surname>Wiegley</surname>
83 ;; <title>A very small chapter</title>
84 ;; <para>Wonder where the content is...</para>
93 ;;; Exception DOMException
95 ;; DOM operations only raise exceptions in "exceptional" circumstances,
96 ;; i.e., when an operation is impossible to perform (either for logical
97 ;; reasons, because data is lost, or because the implementation has
98 ;; become unstable). In general, DOM methods return specific error
99 ;; values in ordinary processing situations, such as out-of-bound errors
100 ;; when using NodeList.
102 ;; Implementations should raise other exceptions under other
103 ;; circumstances. For example, implementations should raise an
104 ;; implementation-dependent exception if a null argument is passed.
106 ;; Some languages and object systems do not support the concept of
107 ;; exceptions. For such systems, error conditions may be indicated using
108 ;; native error reporting mechanisms. For some bindings, for example,
109 ;; methods may return error codes similar to those listed in the
110 ;; corresponding method descriptions.
113 ;; Note that the numeric code is not used at the moment.
114 '((dom-hierarchy-request-err 3
115 "Node doesn't belong here")
116 (dom-wrong-document-err 4
117 "Node is used in a different document than the one that created it")
119 "A reference to a node was made in a context where it does not exist"))))
123 (list 'error 'dom-exception (nth 0 err)))
128 (defun dom-exception (exception &rest data)
129 "Signal error EXCEPTION, possibly providing DATA.
130 The error signaled has the condition 'dom-exception in addition
131 to the catch-all 'error and EXCEPTION itself."
132 ;; FIXME: Redefine this to do something else?
133 (signal exception data))
135 ;;; Interface Document
137 ;; The Document interface represents the entire HTML or XML document.
138 ;; Conceptually, it is the root of the document tree, and provides the
139 ;; primary access to the document's data.
141 ;; Since elements, text nodes, comments, processing instructions, etc.
142 ;; cannot exist outside the context of a Document, the Document interface
143 ;; also contains the factory methods needed to create these objects. The
144 ;; Node objects created have a ownerDocument attribute which associates
145 ;; them with the Document within whose context they were created.
149 ;; Creates an Attr of the given name. Note that the Attr instance can
150 ;; then be set on an Element using the setAttributeNode method.
152 (defun dom-document-create-attribute (doc name)
153 "Create an attribute of the given NAME.
154 DOC is the owner-document."
156 (setq name (intern name)))
159 :type dom-attribute-node
160 :owner-document doc))
164 ;; Creates an element of the type specified. Note that the instance
165 ;; returned implements the Element interface, so attributes can be
166 ;; specified directly on the returned object.
168 ;; FIXME: In addition, if there are known attributes with default
169 ;; values, Attr nodes representing them are automatically created and
170 ;; attached to the element. (not implemented)
172 (defun dom-document-create-element (doc type)
173 "Create an element of the given TYPE.
174 TYPE will be interned, if it is a string.
175 DOC is the owner-document."
177 (setq type (intern type)))
180 :type dom-element-node
181 :owner-document doc))
185 ;; Creates a Text node given the specified string.
187 (defun dom-document-create-text-node (doc data)
188 "Create an element of the type specified by the tag NAME.
189 DOC is the owner-document."
191 :name dom-text-node-name
194 :owner-document doc))
196 ;; getElementsByTagName
198 ;; Returns a NodeList of all the Elements with a given tag name in the
199 ;; order in which they are encountered in a preorder traversal of the
202 (defun dom-document-get-elements-by-tag-name (doc tagname)
203 "Return a list of all the elements with the given tagname.
204 The elements are returned in the order in which they are encountered in
205 a preorder traversal of the document tree. The special value \"*\"
207 (dom-element-get-elements-by-tag-name-1
208 (dom-document-element doc)
213 ;; The Node interface is the primary datatype for the entire Document
214 ;; Object Model. It represents a single node in the document tree. While
215 ;; all objects implementing the Node interface expose methods for dealing
216 ;; with children, not all objects implementing the Node interface may have
217 ;; children. For example, Text nodes may not have children, and adding
218 ;; children to such nodes results in a DOMException being raised.
220 ;; The attributes name, value and attributes are included as a mechanism
221 ;; to get at node information without casting down to the specific
222 ;; derived interface. In cases where there is no obvious mapping of
223 ;; these attributes for a specific type (e.g., value for an Element or
224 ;; attributes for a Comment), this returns null. Note that the
225 ;; specialized interfaces may contain additional and more convenient
226 ;; mechanisms to get and set the relevant information.
228 ;; FIXME: Use symbols instead of numbers?
229 (defconst dom-element-node 1)
230 (defconst dom-attribute-node 2)
231 (defconst dom-text-node 3)
232 ; (defconst dom-cdata-section-node 4)
233 ; (defconst dom-entity-reference-node 5)
234 ; (defconst dom-entity-node 6)
235 ; (defconst dom-processing-instruction-node 7)
236 ; (defconst dom-comment-node 8)
237 (defconst dom-document-node 9)
238 ; (defconst dom-document-type-node 10)
239 ; (defconst dom-document-fragment-node 11)
240 ; (defconst dom-notation-node 12)
242 ;; Default names used for Text and Document nodes.
244 (defconst dom-text-node-name '\#text)
245 (defconst dom-document-node-name '\#document)
247 ;; readonly attribute DOMString nodeName;
248 ;; attribute DOMString nodeValue;
249 ;; readonly attribute unsigned short nodeType;
250 ;; readonly attribute Node parentNode;
251 ;; readonly attribute NodeList childNodes;
252 ;; readonly attribute Node firstChild;
253 ;; readonly attribute Node lastChild;
254 ;; readonly attribute Node previousSibling;
255 ;; readonly attribute Node nextSibling;
256 ;; readonly attribute NamedNodeMap attributes;
257 ;; readonly attribute Document ownerDocument;
260 (name nil :read-only t)
262 (type nil :read-only t)
268 (defstruct (dom-document (:include dom-node))
271 (defstruct (dom-element (:include dom-node)))
273 (defstruct (dom-attr (:include dom-node))
277 (defstruct (dom-character-data (:include dom-node)))
279 (defstruct (dom-text (:include dom-character-data)))
281 ;; All functions defined for nodes are defined for documents and
282 ;; elements as well. Use `dom-node-defun' to define aliases.
284 (defun dom-node-defun (func)
285 "Define aliases for symbol FUNC.
286 FUNC must have the form dom-node-foo. The aliases created will be named
287 dom-document-foo, dom-element-foo, and dom-attr-foo."
288 (if (and (fboundp func)
289 (string-match "^dom-node-" (symbol-name func)))
290 (let ((method (substring (symbol-name func) 9)))
291 (mapc (lambda (prefix)
293 (intern (concat prefix method)) func))
294 '("dom-document-" "dom-element-" "dom-attr-")))
295 (error "%S is not a dom function" func)))
297 ;; The followin functions implement the virtual attributes firstChild,
298 ;; lastChild, previousSibling and nextSibling.
300 (defun dom-node-first-child (node)
301 (car (dom-node-child-nodes node)))
302 (dom-node-defun 'dom-node-first-child)
304 (defun dom-node-last-child (node)
305 (car (last (dom-node-child-nodes node))))
306 (dom-node-defun 'dom-node-last-child)
308 (defun dom-node-previous-sibling (node)
309 (let ((parent (dom-node-parent-node node)))
311 (let ((list (dom-node-child-nodes parent))
314 (while (and (not done) list)
315 (if (eq (car list) node)
317 (setq prev (car list)
320 (dom-node-defun 'dom-node-previous-sibling)
322 (defun dom-node-next-sibling (node)
323 (let ((parent (dom-node-parent-node node)))
325 (nth 1 (memq node (dom-node-child-nodes parent))))))
326 (dom-node-defun 'dom-node-next-sibling)
330 ;; Adds the node newChild to the end of the list of children of
331 ;; this node. If the newChild is already in the tree, it is
334 ;; FIXME: newChild of type Node: The node to add. If it is a DocumentFragment
335 ;; object, the entire contents of the document fragment are moved into
336 ;; the child list of this node
338 (defun dom-node-append-child (node new-child)
339 "Adds NEW-CHILD to the end of the list of children of NODE.
340 If NEW-CHILD is already in the document tree, it is first removed.
341 NEW-CHILD will be removed from anywhere in the document!
342 Return the node added."
343 (dom-node-test-new-child node new-child)
344 (dom-node-unlink-child-from-parent new-child)
345 ;; add new-child at the end of the list
346 (let ((children (dom-node-child-nodes node)))
347 (setf (dom-node-child-nodes node) (nconc children (list new-child))))
348 (setf (dom-node-parent-node new-child) node)
350 (dom-node-defun 'dom-node-append-child)
354 ;; Returns a duplicate of this node, i.e., serves as a generic copy
355 ;; constructor for nodes. The duplicate node has no parent; (parentNode
358 ;; FIXME: Cloning an Element copies all attributes and their values,
359 ;; including those generated by the XML processor to represent defaulted
360 ;; attributes, but this method does not copy any text it contains unless
361 ;; it is a deep clone, since the text is contained in a child Text
362 ;; node. Cloning an Attribute directly, as opposed to be cloned as part
363 ;; of an Element cloning operation, returns a specified attribute
364 ;; (specified is true). Cloning any other type of node simply returns a
365 ;; copy of this node. (the attribute specified is not implemented)
367 ;; FIXME: Note that cloning an immutable subtree results in a mutable
368 ;; copy, but the children of an EntityReference clone are readonly. In
369 ;; addition, clones of unspecified Attr nodes are specified. And,
370 ;; cloning Document, DocumentType, Entity, and Notation nodes is
371 ;; implementation dependent. (immutable subtrees not implemented)
373 ;; FIXME: The specification says nothing about nextSibling and
374 ;; previousSibling. We set these to nil as well, matching parentNode.
376 (defun dom-node-clone-node (node &optional deep)
377 "Return a duplicate of NODE.
378 The duplicate node has no parent. Cloning will copy all attributes and
379 their values, but this method does not copy any text it contains unless
380 it is a DEEP clone, since the text is contained in a child text node.
382 When the optional argument DEEP is non-nil, this recursively clones the
383 subtree under the specified node; if false, clone only the node itself
384 \(and its attributes, if it has any)."
385 ;; We don't want to call this recursively because of performance.
386 (let* ((first-copy (copy-dom-node node))
389 ;; unlink neighbours of the first copy
390 (setf (dom-node-parent-node first-copy) nil)
392 ;; prevent sharing of text in text nodes
393 (let ((value (dom-node-value copy)))
394 (when (and value (sequencep value))
395 (setf (dom-node-value copy) (copy-sequence value))))
396 ;; copy attributes, and prevent sharing of text in attribute nodes
397 (let ((attributes (mapcar 'copy-dom-node (dom-node-attributes copy))))
399 (let ((value (dom-node-value attr)))
400 (when (and value (sequencep value))
401 (setf (dom-node-value attr) (copy-sequence value)))))
403 (setf (dom-node-attributes copy) attributes))
405 ;; if this is not a deep copy, we are done
407 ;; first clone all children
408 (let ((children (mapcar 'copy-dom-node (dom-node-child-nodes copy)))
411 ;; set the children info for the parent
412 (setf (dom-node-child-nodes parent) children)
413 ;; set parent for all children
414 (mapc (lambda (child)
415 (setf (dom-node-parent-node child) parent))
417 ;; move to the next copy, depth first, storing missed branches
418 ;; on the stack -- note that "node" continues to refer to the
419 ;; original node, it should not be used within the while copy
422 (cond ((dom-element-first-child copy)
423 (when (dom-element-next-sibling copy)
424 (push (dom-element-next-sibling copy) stack))
425 (dom-element-first-child copy))
426 ((dom-element-next-sibling copy))
429 (dom-node-defun 'dom-node-clone-node)
431 ;; hasAttributes introduced in DOM Level 2
433 ;; Returns whether this node (if it is an element) has any
436 (defun dom-node-has-attributes (node)
437 "Return t when NODE has any attributes."
438 (not (null (dom-node-attributes node))))
439 (dom-node-defun 'dom-node-has-attributes)
443 ;; Returns whether this node has any children.
445 (defun dom-node-has-child-nodes (node)
446 "Return t when NODE has any child nodes."
447 (not (null (dom-node-child-nodes node))))
448 (dom-node-defun 'dom-node-has-child-nodes)
452 ;; Inserts the node newChild before the existing child node refChild. If
453 ;; refChild is null, insert newChild at the end of the list of children.
455 ;; FIXME: If newChild is a DocumentFragment object, all of its children
456 ;; are inserted, in the same order, before refChild. If the newChild is
457 ;; already in the tree, it is first removed.
459 (defun dom-node-insert-before (node new-child &optional ref-child)
460 "Insert NEW-CHILD before NODE's existing child REF-CHILD.
461 If optional argument REF-CHILD is nil or not given, insert NEW-CHILD at
462 the end of the list of NODE's children.
463 If NEW-CHILD is already in the document tree, it is first removed.
464 NEW-CHILD will be removed from anywhere in the document!
465 Return the node added."
466 ;; without ref-child, append it at the end of the list
468 (dom-node-append-child node new-child)
469 (dom-node-test-new-child node new-child)
470 (dom-node-unlink-child-from-parent new-child)
471 ;; find the correct position and insert new-child
472 (let ((children (dom-node-child-nodes node))
474 (while (and (not done) children)
475 (if (eq ref-child (car children))
477 ;; if the first child is ref-child, set the list anew
479 (setf (dom-node-child-nodes node)
480 (cons new-child children))
481 ;; else splice new-child into the list
482 (setcdr child-cell (cons new-child children)))
484 ;; if we didn't find it, advance
485 (setq child-cell children
486 children (cdr children))))
488 (dom-exception 'dom-not-found-err)))
490 (dom-node-defun 'dom-node-insert-before)
494 ;; Removes the child node indicated by oldChild from the list of
495 ;; children, and returns it.
497 (defun dom-node-remove-child (node old-child)
498 "Remove OLD-CHILD from the list of NODE's children and return it.
499 This is very similar to `dom-node-unlink-child-from-parent' but it will
500 raise an exception if OLD-CHILD is NODE's child."
501 (let ((children (dom-node-child-nodes node)))
502 (if (memq old-child children)
503 (setf (dom-node-child-nodes node) (delq old-child children)
504 (dom-node-parent-node old-child) nil)
505 (dom-exception 'dom-not-found-err))
507 (dom-node-defun 'dom-node-remove-child)
511 ;; Replaces the child node oldChild with newChild in the list of
512 ;; children, and returns the oldChild node.
514 ;; FIXME: If newChild is a DocumentFragment object, oldChild is replaced
515 ;; by all of the DocumentFragment children, which are inserted in the
518 ;; If the newChild is already in the tree, it is first removed.
520 (defun dom-node-replace-child (node new-child old-child)
521 "Replace OLD-CHILD with NEW-CHILD in the list NODE's children.
523 (dom-node-test-new-child node new-child)
524 (dom-node-unlink-child-from-parent new-child)
525 (let ((children (dom-node-child-nodes node)))
526 (unless (memq old-child children)
527 (dom-exception 'dom-not-found-err))
528 (setf (dom-node-child-nodes node)
529 (nsubstitute new-child old-child children)))
530 ;; set parent of new-child and old-child
531 (setf (dom-node-parent-node old-child) nil
532 (dom-node-parent-node new-child) node))
533 (dom-node-defun 'dom-node-replace-child)
535 ;; textContent of type DOMString, introduced in DOM Level 3
537 ;; This attribute returns the text content of this node and its
540 ;; FIXME: When set, any possible children this node may have are
541 ;; removed and replaced by a single Text node containing the string this
542 ;; attribute is set to. (not implemented yet)
544 ;; On getting, no serialization is performed, the returned string does
545 ;; not contain any markup. Similarly, on setting, no parsing is
546 ;; performed either, the input string is taken as pure textual content.
548 (defun dom-node-text-content (node)
549 "Return the text content of NODE and its children.
550 If NODE is an attribute or a text node, its value is returned."
551 (if (or (dom-attr-p node)
553 (dom-node-value node)
555 (mapcar 'dom-node-value
556 (dom-element-get-elements-by-tag-name
557 node dom-text-node-name)))))
558 (dom-node-defun 'dom-node-text-content)
560 (defun dom-node-set-text-content (node data)
561 "Set the text content of NODE, replacing all its children.
562 If NODE is an attribute or a text node, its value is set."
563 (if (or (dom-attr-p node)
565 (setf (dom-node-value node) data)
566 (setf (dom-node-child-nodes node)
567 (list (dom-document-create-text-node
568 (dom-node-owner-document node)
570 (dom-node-defun 'dom-node-set-text-content)
572 (defsetf dom-node-text-content dom-node-set-text-content)
574 ;;; Utility functions
576 ;; These utility functions are defined for nodes only.
578 (defun dom-node-ancestor-p (node ancestor)
579 "Return t if ANCESTOR is an ancestor of NODE in the tree."
580 (let ((parent (dom-node-parent-node node))
582 (while (and (not result) parent)
583 (setq result (eq parent ancestor)
584 parent (dom-node-parent-node parent)))
587 (defun dom-node-valid-child (node child)
588 "Return t if CHILD is a valid child for NODE.
589 This depends on the node-type of NODE and CHILD."
590 ;; FIXME: Add stuff as we go along.
593 (defun dom-node-test-new-child (node new-child)
594 "Check wether NEW-CHILD is acceptable addition to NODE's children."
595 (when (or (dom-node-ancestor-p node new-child)
597 (not (dom-node-valid-child node new-child)))
598 (dom-exception 'dom-hierarchy-request-err))
599 (when (not (eq (dom-node-owner-document node)
600 (dom-node-owner-document new-child)))
601 (dom-exception 'dom-wrong-document-err))
604 (defun dom-node-unlink-child-from-parent (node)
605 "Unlink NODE from is previous location.
606 This is very similar to `dom-node-remove-child' but it will check wether
607 this node is the child of a particular other node."
608 ;; remove node from it's old position
609 (let ((parent (dom-node-parent-node node)))
611 ;; remove from parent's child-nodes and set own parent to nil
612 (setf (dom-node-child-nodes parent)
613 (delq node (dom-node-child-nodes parent))
614 (dom-node-parent-node node)
618 ;;; Interface NodeList
620 ;; The NodeList interface provides the abstraction of an ordered
621 ;; collection of nodes, without defining or constraining how this
622 ;; collection is implemented. NodeList objects in the DOM are live.
624 ;; The items in the NodeList are accessible via an integral index,
627 ;; This provides alternate names for plain lisp list accessor functions.
629 (defalias 'dom-node-list-length 'length)
631 (defun dom-node-list-item (list index); for the sake of argument order
632 "Return element at INDEX in LIST.
633 Equivalent to (nth INDEX NODE)."
638 ;; The Attr interface represents an attribute in an Element object.
639 ;; Typically the allowable values for the attribute are defined in a
640 ;; document type definition.
642 ;; Attr objects inherit the Node interface, but since they are not
643 ;; actually child nodes of the element they describe, the DOM does not
644 ;; consider them part of the document tree. Thus, the Node attributes
645 ;; parentNode, previousSibling, and nextSibling have a null value for Attr
646 ;; objects. The DOM takes the view that attributes are properties of
647 ;; elements rather than having a separate identity from the elements they
648 ;; are associated with; this should make it more efficient to implement
649 ;; such features as default attributes associated with all elements of a
650 ;; given type. Furthermore, Attr nodes may not be immediate children of a
651 ;; DocumentFragment. However, they can be associated with Element nodes
652 ;; contained within a DocumentFragment. In short, users and implementors
653 ;; of the DOM need to be aware that Attr nodes have some things in common
654 ;; with other objects inheriting the Node interface, but they also are
657 ;; The attribute's effective value is determined as follows: if this
658 ;; attribute has been explicitly assigned any value, that value is the
659 ;; attribute's effective value; otherwise, if there is a declaration for
660 ;; this attribute, and that declaration includes a default value, then
661 ;; that default value is the attribute's effective value; otherwise, the
662 ;; attribute does not exist on this element in the structure model until
663 ;; it has been explicitly added. Note that the nodeValue attribute on the
664 ;; Attr instance can also be used to retrieve the string version of the
665 ;; attribute's value(s).
667 ;; In XML, where the value of an attribute can contain entity references,
668 ;; the child nodes of the Attr node may be either Text or EntityReference
669 ;; nodes (when these are in use; see the description of EntityReference
670 ;; for discussion). Because the DOM Core is not aware of attribute types,
671 ;; it treats all attribute values as simple strings, even if the DTD or
672 ;; schema declares them as having tokenized types.
674 ;; ownerElement of type Element, readonly, introduced in DOM Level 2
676 ;; The Element node this attribute is attached to or null if
677 ;; this attribute is not in use.
681 ;; The Element interface represents an element in an HTML or XML
682 ;; document. Elements may have attributes associated with them; since
683 ;; the Element interface inherits from Node, the generic Node interface
684 ;; attribute attributes may be used to retrieve the set of all
685 ;; attributes for an element. There are methods on the Element interface
686 ;; to retrieve either an Attr object by name or an attribute value by
687 ;; name. In XML, where an attribute value may contain entity references,
688 ;; an Attr object should be retrieved to examine the possibly fairly
689 ;; complex sub-tree representing the attribute value. On the other hand,
690 ;; in HTML, where all attributes have simple string values, methods to
691 ;; directly access an attribute value can safely be used as a
694 (defun dom-element-get-elements-by-tag-name-1 (element name)
695 "Return a list of elements with tag NAME.
696 The elements are ELEMENT, its siblings, and their descendants.
697 This is used by `dom-element-get-elements-by-tag-name' and
698 `dom-document-get-elements-by-tag-name'."
699 ;; We don't want to call this recursively because of performance.
702 (when (or (string= name "*")
703 (string= name (dom-node-name element)))
704 (setq result (cons element result)))
706 (cond ((dom-node-first-child element)
707 (when (dom-node-next-sibling element)
708 (push (dom-node-next-sibling element) stack))
709 (dom-node-first-child element))
710 ((dom-node-next-sibling element))
714 (defun dom-element-get-elements-by-tag-name (element name)
715 "Return a list of all descendant of ELEMENT with tag NAME.
716 The elements are returned in the order in which they are encountered in
717 a preorder traversal of this element tree."
718 (dom-element-get-elements-by-tag-name-1
719 (dom-element-first-child element)
724 ;; The Text interface inherits from CharacterData and represents the
725 ;; textual content (termed character data in XML) of an Element or Attr.
726 ;; If there is no markup inside an element's content, the text is
727 ;; contained in a single object implementing the Text interface that is
728 ;; the only child of the element. If there is markup, it is parsed into
729 ;; the information items (elements, comments, etc.) and Text nodes that
730 ;; form the list of children of the element.
732 ;; When a document is first made available via the DOM, there is only one
733 ;; Text node for each block of text. Users may create adjacent Text nodes
734 ;; that represent the contents of a given element without any intervening
735 ;; markup, but should be aware that there is no way to represent the
736 ;; separations between these nodes in XML or HTML, so they will not (in
737 ;; general) persist between DOM editing sessions. The normalize() method
738 ;; on Node merges any such adjacent Text objects into a single node for
739 ;; each block of text.
741 ;; Character data is represented as a plain string.
745 ;;; Converting XML to DOM
747 ;; Converting XML (hierarchy of nodes, simple lists, symbols and
748 ;; strings) to DOM (hierarchy of dom-nodes, defstructs from CL)
750 (defun dom-make-attribute-from-xml (attribute element doc)
751 "Make a DOM node of attributes based on ATTRIBUTE.
752 Called from `dom-make-element-from-xml'.
753 ELEMENT is the owner-element.
754 DOC is the owner-document."
755 (let* ((name (car attribute))
756 (value (cdr attribute))
757 (attr (dom-document-create-attribute doc name)))
758 (setf (dom-attr-value attr) value
759 (dom-attr-owner-element attr) element)
762 (defun dom-add-children (parent children)
763 "Add CHILDREN to PARENT.
764 CHILDREN is a list of XML NODE elements. Each must
765 be converted to a dom-node first."
767 (setf (dom-node-child-nodes parent)
768 (mapcar (lambda (child)
769 (dom-make-node-from-xml
771 (dom-node-owner-document parent)))
773 (mapc (lambda (child)
774 (setf (dom-node-parent-node child)
776 (dom-node-child-nodes parent))))
778 (defun dom-make-element-from-xml (node owner)
779 "Make a DOM element based on NODE.
780 Called from `dom-make-node-from-xml'.
781 The atttributes are created by `dom-make-attribute-from-xml'.
782 OWNER is stored as the owner-document."
783 (let* ((children (xml-node-children node))
784 (attributes (xml-node-attributes node))
785 (type (xml-node-name node))
786 (element (dom-document-create-element owner type)))
788 (setf (dom-node-attributes element)
789 (mapcar (lambda (attribute)
790 (dom-make-attribute-from-xml attribute element owner))
793 (dom-add-children element children))
796 (defun dom-make-node-from-xml (node owner)
797 "Make a DOM node based on NODE.
798 If NODE is a list, the node is created by `dom-make-element-from-xml'.
799 OWNER is stored as the owner-document."
800 (cond ((stringp node)
801 (dom-document-create-text-node owner node))
803 (dom-make-element-from-xml node owner))
805 (error "Illegal node: %S" node))))
807 (defun dom-make-document-from-xml (node)
808 "Return a DOM document based on NODE.
809 NODE is a node as returned by `xml-parse-file', either
810 a string or a list. The DOM nodes are created using
811 `dom-make-node-from-xml'.
813 Note that `xml-parse-file' returns a list of elements.
814 You can only pass one of these nodes as NODE."
815 (let* ((doc (make-dom-document
816 :name dom-document-node-name
817 :type dom-document-node))
818 (node (dom-make-node-from-xml node doc)))
819 (setf (dom-document-owner-document doc) doc; required in dom-add-children
820 (dom-document-element doc) node)
826 (when (file-readable-p "sample.xml")
827 (let ((data (car (xml-parse-file "sample.xml"))))
828 ;; (setq data (car (xml-parse-file "sample.xml")))
829 (assert (fboundp 'dom-node-name))
830 (assert (fboundp 'dom-document-name))
831 (assert (fboundp 'dom-element-name))
832 (assert (fboundp 'dom-attr-name))
834 (let ((attr (dom-make-attribute-from-xml
835 (car (xml-node-attributes data)) 'none 'none)))
836 (assert (string= "id" (dom-node-name attr)))
837 (assert (string= "compiler" (dom-node-value attr)))
838 (assert (eq dom-attribute-node (dom-node-type attr))))
840 (let ((element (dom-make-node-from-xml data 'no-owner)))
841 (assert (string= "book" (dom-node-name element)))
842 (assert (string= "id" (dom-node-name
843 (car (dom-node-attributes element)))))
844 (assert (string= "compiler"
846 (car (dom-node-attributes element)))))
847 (assert (string= "bookinfo"
849 (first (dom-node-child-nodes element)))))
850 (assert (string= "chapter"
852 (second (dom-node-child-nodes element)))))
854 (dom-node-child-nodes
856 (dom-node-child-nodes
858 (dom-node-child-nodes element))))))))
859 (assert (eq 'title (dom-node-name title)))
860 (assert (string= "My own book!"
862 (first (dom-node-child-nodes title)))))))
864 (let ((doc (dom-make-document-from-xml data)))
865 (assert (eq dom-document-node-name (dom-document-name doc)))
866 (assert (string= "book" (dom-node-name (dom-document-element doc))))
867 (assert (eq (dom-node-parent-node
868 (first (dom-node-child-nodes (dom-document-element doc))))
869 (dom-document-element doc)))
870 (assert (eq (first (dom-node-child-nodes (dom-document-element doc)))
871 (dom-node-first-child (dom-document-element doc))))
872 (assert (eq (dom-node-next-sibling
873 (first (dom-node-child-nodes (dom-document-element doc))))
874 (second (dom-node-child-nodes (dom-document-element doc)))))
876 (dom-node-owner-document
877 (dom-node-first-child (dom-document-element doc)))))
878 (assert (string= "chapter"
880 (dom-element-last-child
881 (dom-document-element doc)))))
882 (assert (eq nil (dom-node-previous-sibling (dom-document-element doc)))))
884 (assert (eq 3 (dom-node-list-length '(1 2 3))))
886 (assert (eq 2 (dom-node-list-item '(1 2 3) 1)))
888 (let ((doc (dom-make-document-from-xml data)))
889 (assert (equal (mapcar 'dom-node-name
890 (dom-document-get-elements-by-tag-name
892 '(book bookinfo bookbiblio title \#text edition
893 \#text authorgroup author firstname \#text
894 surname \#text chapter title \#text para
896 (assert (equal (mapcar 'dom-node-name
897 (dom-document-get-elements-by-tag-name
900 (assert (equal (mapcar 'dom-node-name
901 (dom-element-get-elements-by-tag-name
902 (dom-document-element doc) 'title))
904 (assert (equal (mapcar (lambda (element)
906 (dom-element-first-child element)))
907 (dom-document-get-elements-by-tag-name
909 '("My own book!" "A very small chapter"))))
911 (let* ((doc (dom-make-document-from-xml data))
912 (ancestor (dom-document-element doc))
913 (child (car (dom-document-get-elements-by-tag-name doc 'title))))
914 (assert (dom-node-ancestor-p child ancestor)))
916 (let* ((doc (dom-make-document-from-xml data))
917 (book (dom-document-element doc))
918 (old-chapter (dom-element-last-child book))
919 (new-chapter (dom-document-create-element doc 'chapter)))
920 (assert (string= (dom-node-name
921 (dom-element-append-child book new-chapter))
923 (assert (equal (mapcar 'dom-element-name
924 (dom-element-child-nodes book))
925 '(bookinfo chapter chapter)))
926 (assert (eq (dom-element-last-child book) new-chapter))
927 (assert (not (eq (dom-element-last-child book) old-chapter)))
928 (assert (eq (dom-element-next-sibling old-chapter) new-chapter))
929 (assert (eq (dom-element-previous-sibling new-chapter) old-chapter))
930 (assert (eq (dom-element-parent-node new-chapter) book))
931 (assert (dom-node-ancestor-p new-chapter book))
932 (assert (not (eq t (condition-case var
933 (dom-element-append-child book new-chapter)
934 ('dom-hierarchy-request-err
936 (assert (eq t (condition-case var
937 (dom-element-append-child new-chapter book)
938 ('dom-hierarchy-request-err
941 (let* ((doc (dom-make-document-from-xml data))
942 (book (dom-document-element doc))
943 (old-chapter (dom-element-last-child book))
944 (new-chapter (dom-document-create-element doc 'chapter))
945 (new-title (dom-document-create-element doc 'title))
946 (text (dom-document-create-text-node doc "Test Chapter")))
947 (assert (eq text (dom-element-append-child
948 (dom-element-append-child
949 (dom-element-append-child book new-chapter)
952 (assert (= 2 (length (dom-node-child-nodes old-chapter))))
953 (assert (= 1 (length (dom-node-child-nodes new-chapter))))
954 (assert (string= "title" (dom-node-name
955 (car (dom-node-child-nodes new-chapter)))))
956 (assert (eq (car (dom-node-child-nodes new-chapter))
957 (dom-node-first-child new-chapter)))
958 (assert (eq new-title
959 (dom-node-first-child new-chapter)))
961 (dom-node-first-child new-title)))
963 (mapcar (lambda (node)
965 (dom-node-first-child node)))
966 (dom-document-get-elements-by-tag-name doc 'title))
967 '("My own book!" "A very small chapter" "Test Chapter"))))
969 (let* ((doc (dom-make-document-from-xml data))
970 (book (dom-document-element doc))
971 (copy (dom-node-clone-node book)))
972 (assert (not (eq book copy)))
973 (assert (eq (dom-node-child-nodes book)
974 (dom-node-child-nodes copy)))
975 (assert (eq (car (dom-node-child-nodes book))
976 (car (dom-node-child-nodes copy))))
977 (assert (eq (dom-node-first-child book)
978 (dom-node-first-child copy)))
979 (assert (eq (dom-node-last-child book)
980 (dom-node-last-child copy)))
981 (assert (not (eq (dom-node-attributes book)
982 (dom-node-attributes copy))))
983 (assert (eq (dom-node-name (car (dom-node-attributes book)))
984 (dom-node-name (car (dom-node-attributes copy)))))
985 (assert (not (eq (dom-node-value (car (dom-node-attributes book)))
986 (dom-node-value (car (dom-node-attributes copy))))))
987 (assert (equal (dom-node-value (car (dom-node-attributes book)))
988 (dom-node-value (car (dom-node-attributes copy))))))
990 (let* ((doc (dom-make-document-from-xml data))
991 (book (dom-document-element doc))
992 (deepcopy (dom-node-clone-node book t)))
993 (assert (not (eq book deepcopy)))
994 (assert (equal (dom-node-attributes book)
995 (dom-node-attributes deepcopy)))
996 (assert (not (eq (dom-node-attributes book)
997 (dom-node-attributes deepcopy))))
999 (mapcar 'dom-node-name
1000 (dom-element-get-elements-by-tag-name book '*))
1001 (mapcar 'dom-node-name
1002 (dom-element-get-elements-by-tag-name deepcopy '*))))
1004 (mapcar 'dom-node-value
1005 (dom-element-get-elements-by-tag-name book '*))
1006 (mapcar 'dom-node-value
1007 (dom-element-get-elements-by-tag-name deepcopy '*))))
1008 (assert (not (eq (car (dom-element-get-elements-by-tag-name
1010 (car (dom-element-get-elements-by-tag-name
1011 deepcopy 'firstname)))))
1012 (assert (not (eq (dom-text-value
1013 (third (dom-element-get-elements-by-tag-name
1016 (third (dom-element-get-elements-by-tag-name
1017 deepcopy '\#text))))))
1018 (assert (string= (dom-text-value
1019 (third (dom-element-get-elements-by-tag-name
1022 (third (dom-element-get-elements-by-tag-name
1023 deepcopy '\#text)))))
1024 (assert (not (eq (dom-text-value
1025 (third (dom-element-get-elements-by-tag-name
1028 (third (dom-element-get-elements-by-tag-name
1029 deepcopy '\#text)))))))
1031 (let* ((doc (dom-make-document-from-xml data))
1032 (book (dom-document-element doc))
1033 (old-chapter (dom-element-last-child book))
1034 (new-chapter (dom-document-create-element doc 'chapter)))
1035 (assert (eq (dom-node-name (dom-element-insert-before book new-chapter))
1037 (assert (equal (mapcar 'dom-element-name
1038 (dom-element-child-nodes book))
1039 '(bookinfo chapter chapter)))
1040 (assert (eq new-chapter (dom-element-insert-before
1042 (dom-element-first-child book))))
1043 (assert (equal (mapcar 'dom-element-name
1044 (dom-element-child-nodes book))
1045 '(chapter bookinfo chapter)))
1046 (let ((new-bookinfo (dom-document-create-element doc 'bookinfo)))
1047 (dom-element-insert-before book new-bookinfo old-chapter))
1048 (assert (equal (mapcar 'dom-element-name
1049 (dom-element-child-nodes book))
1050 '(chapter bookinfo bookinfo chapter))))
1052 ;; FIXME: some more tests for `dom-node-remove-child' and
1053 ;; `dom-node-replace-child' would be nice... :)
1054 (let* ((doc (dom-make-document-from-xml data))
1055 (book (dom-document-element doc))
1056 (old-chapter (dom-element-last-child book))
1057 (new-chapter (dom-document-create-element doc 'chapter)))
1058 (dom-node-remove-child book old-chapter)
1059 (assert (equal (mapcar 'dom-node-name (dom-node-child-nodes book))
1061 (dom-node-replace-child book new-chapter
1062 (dom-node-first-child book))
1063 (assert (equal (mapcar 'dom-node-name (dom-node-child-nodes book))
1066 (let* ((doc (make-dom-document))
1067 (par (dom-document-create-element doc 'p))
1068 (part1 (dom-document-create-text-node doc "This is "))
1069 (part2 (dom-document-create-element doc 'b))
1070 (part3 (dom-document-create-text-node doc ".")))
1071 (dom-element-append-child
1072 part2 (dom-document-create-text-node doc "bold"))
1073 (dom-element-append-child par part1)
1074 (dom-element-append-child par part2)
1075 (dom-element-append-child par part3)
1076 (setf (dom-document-owner-document doc) doc
1077 (dom-document-element doc) par)
1078 (assert (eq (dom-document-element doc) par))
1079 (assert (string= (dom-node-text-content par)
1081 (dom-node-set-text-content par "This is plain.")
1082 (assert (string= (dom-node-text-content par)
1084 (assert (equal (mapcar 'dom-node-name (dom-node-child-nodes par))
1086 (setf (dom-node-text-content par) "New text.")
1087 (assert (string= (dom-node-text-content par)
1089 (setf (dom-element-text-content par) "Different text.")
1090 (assert (string= (dom-element-text-content par)
1092 (let ((at (dom-document-create-attribute doc 'foo)))
1093 (setf (dom-attr-value at) "domino"
1094 (dom-element-attributes par) (list at))
1095 (assert (string= "domino"
1098 (dom-element-attributes par)
1100 (assert (string= "domino"
1101 (dom-node-text-content
1103 (dom-element-attributes par)
1106 (let* ((doc (dom-make-document-from-xml data))
1107 (title (car (dom-document-get-elements-by-tag-name doc "title"))))
1108 (assert (equal (dom-element-text-content title)
1109 "My own book!"))))))
1113 ;;; dom.el ends here.