Mercurial > emacs

comparison lisp/xml.el @ 89943:4c90ffeb71c5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-15 Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-218 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-220 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-221 Restore deleted tagline in etc/TUTORIAL.ru * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-222 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-228 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-229 Remove TeX output files from the archive * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-230 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-247 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-248 src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-249 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-256 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-258 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-265 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-276 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-295 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-296 Allow restarting an existing debugger session that's exited * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-297 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-299 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-300 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-327 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-328 Update from CVS: src/.gdbinit (xsymbol): Fix last change. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-329 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-346 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-353 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-361 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-362 Support " [...]" style defaults in minibuffer-electric-default-mode * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363 (read-number): Use canonical format for default in prompt. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-364 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-375 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-376 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-377 (Fdisplay_supports_face_attributes_p): Work around bootstrapping problem * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-378 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-380 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-381 Face merging cleanups * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-382 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-384 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-385 src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-386 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-395 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-396 Tweak arch tagging to make build/install-in-place less annoying * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-397 Work around vc-arch problems when building eshell * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-398 Tweak permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-399 Tweak directory permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-400 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-401 More build-in-place tweaking of arch tagging * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-402 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-403 Yet more build-in-place tweaking of arch tagging * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-404 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-409 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-410 Make sure image types are initialized for lookup too * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-411 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-416 Update from CVS
author Miles Bader <miles@gnu.org>
date Mon, 28 Jun 2004 07:56:49 +0000
parents 68c22ea6027c 7ac80356d84c
children 029a652ac817
comparison
equal deleted inserted replaced
89942:9cb747ae49af 89943:4c90ffeb71c5
25 25
26 ;;; Commentary: 26 ;;; Commentary:
27 27
28 ;; This file contains a somewhat incomplete non-validating XML parser. It 28 ;; This file contains a somewhat incomplete non-validating XML parser. It
29 ;; parses a file, and returns a list that can be used internally by 29 ;; parses a file, and returns a list that can be used internally by
30 ;; any other lisp libraries. 30 ;; any other Lisp libraries.
31 31
32 ;;; FILE FORMAT 32 ;;; FILE FORMAT
33 33
34 ;; The document type declaration may either be ignored or (optionally) 34 ;; The document type declaration may either be ignored or (optionally)
35 ;; parsed, but currently the parsing will only accept element 35 ;; parsed, but currently the parsing will only accept element
36 ;; declarations. The XML file is assumed to be well-formed. In case 36 ;; declarations. The XML file is assumed to be well-formed. In case
37 ;; of error, the parsing stops and the XML file is shown where the 37 ;; of error, the parsing stops and the XML file is shown where the
38 ;; parsing stopped. 38 ;; parsing stopped.
39 ;; 39 ;;
40 ;; It also knows how to ignore comments and processing instructions. 40 ;; It also knows how to ignore comments and processing instructions.
41 ;; 41 ;;
42 ;; The XML file should have the following format: 42 ;; The XML file should have the following format:
43 ;; <node1 attr1="name1" attr2="name2" ...>value 43 ;; <node1 attr1="name1" attr2="name2" ...>value
44 ;; <node2 attr3="name3" attr4="name4">value2</node2> 44 ;; <node2 attr3="name3" attr4="name4">value2</node2>
45 ;; <node3 attr5="name5" attr6="name6">value3</node3> 45 ;; <node3 attr5="name5" attr6="name6">value3</node3>
46 ;; </node1> 46 ;; </node1>
47 ;; Of course, the name of the nodes and attributes can be anything. There can 47 ;; Of course, the name of the nodes and attributes can be anything. There can
48 ;; be any number of attributes (or none), as well as any number of children 48 ;; be any number of attributes (or none), as well as any number of children
49 ;; below the nodes. 49 ;; below the nodes.
50 ;; 50 ;;
51 ;; There can be only top level node, but with any number of children below. 51 ;; There can be only top level node, but with any number of children below.
52 52
84 ;;** 84 ;;**
85 ;;******************************************************************* 85 ;;*******************************************************************
86 86
87 (defsubst xml-node-name (node) 87 (defsubst xml-node-name (node)
88 "Return the tag associated with NODE. 88 "Return the tag associated with NODE.
89 The tag is a lower-case symbol." 89 Without namespace-aware parsing, the tag is a symbol.
90
91 With namespace-aware parsing, the tag is a cons of a string
92 representing the uri of the namespace with the local name of the
93 tag. For example,
94
95 <foo>
96
97 would be represented by
98
99 '(\"\" . \"foo\")."
100
90 (car node)) 101 (car node))
91 102
92 (defsubst xml-node-attributes (node) 103 (defsubst xml-node-attributes (node)
93 "Return the list of attributes of NODE. 104 "Return the list of attributes of NODE.
94 The list can be nil." 105 The list can be nil."
99 This is a list of nodes, and it can be nil." 110 This is a list of nodes, and it can be nil."
100 (cddr node)) 111 (cddr node))
101 112
102 (defun xml-get-children (node child-name) 113 (defun xml-get-children (node child-name)
103 "Return the children of NODE whose tag is CHILD-NAME. 114 "Return the children of NODE whose tag is CHILD-NAME.
104 CHILD-NAME should be a lower case symbol." 115 CHILD-NAME should match the value returned by `xml-node-name'."
105 (let ((match ())) 116 (let ((match ()))
106 (dolist (child (xml-node-children node)) 117 (dolist (child (xml-node-children node))
107 (if child 118 (if (and (listp child)
108 (if (equal (xml-node-name child) child-name) 119 (equal (xml-node-name child) child-name))
109 (push child match)))) 120 (push child match)))
110 (nreverse match))) 121 (nreverse match)))
111 122
112 (defun xml-get-attribute-or-nil (node attribute) 123 (defun xml-get-attribute-or-nil (node attribute)
113 "Get from NODE the value of ATTRIBUTE. 124 "Get from NODE the value of ATTRIBUTE.
114 Return `nil' if the attribute was not found. 125 Return nil if the attribute was not found.
115 126
116 See also `xml-get-attribute'." 127 See also `xml-get-attribute'."
117 (cdr (assoc attribute (xml-node-attributes node)))) 128 (cdr (assoc attribute (xml-node-attributes node))))
118 129
119 (defsubst xml-get-attribute (node attribute) 130 (defsubst xml-get-attribute (node attribute)
234 (if parse-dtd 245 (if parse-dtd
235 (cons dtd (nreverse xml)) 246 (cons dtd (nreverse xml))
236 (nreverse xml))))))) 247 (nreverse xml)))))))
237 248
238 (defun xml-maybe-do-ns (name default xml-ns) 249 (defun xml-maybe-do-ns (name default xml-ns)
239 "Perform any namespace expansion. NAME is the name to perform the expansion on. 250 "Perform any namespace expansion.
251 NAME is the name to perform the expansion on.
240 DEFAULT is the default namespace. XML-NS is a cons of namespace 252 DEFAULT is the default namespace. XML-NS is a cons of namespace
241 names to uris. When namespace-aware parsing is off, then XML-NS 253 names to uris. When namespace-aware parsing is off, then XML-NS
242 is nil. 254 is nil.
243 255
244 During namespace-aware parsing, any name without a namespace is 256 During namespace-aware parsing, any name without a namespace is
323 (eq :http://www.w3.org/2000/xmlns/ 335 (eq :http://www.w3.org/2000/xmlns/
324 (caar attr))) 336 (caar attr)))
325 (push (cons (cdar attr) (intern (concat ":" (cdr attr)))) 337 (push (cons (cdar attr) (intern (concat ":" (cdr attr))))
326 xml-ns)))) 338 xml-ns))))
327 339
328 ;; expand element names 340 (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns)))
329 (setq node-name (list (xml-maybe-do-ns node-name "" xml-ns))) 341
330
331 (setq children (list attrs node-name))
332 ;; is this an empty element ? 342 ;; is this an empty element ?
333 (if (looking-at "/>") 343 (if (looking-at "/>")
334 (progn 344 (progn
335 (forward-char 2) 345 (forward-char 2)
336 (nreverse children)) 346 (nreverse children))
381 (error "XML: Invalid attribute list"))))) 391 (error "XML: Invalid attribute list")))))
382 (t ;; This is not a tag. 392 (t ;; This is not a tag.
383 (error "XML: Invalid character"))))) 393 (error "XML: Invalid character")))))
384 394
385 (defun xml-parse-attlist (&optional xml-ns) 395 (defun xml-parse-attlist (&optional xml-ns)
386 "Return the attribute-list after point. Leave point at the 396 "Return the attribute-list after point.
387 first non-blank character after the tag." 397 Leave point at the first non-blank character after the tag."
388 (let ((attlist ()) 398 (let ((attlist ())
389 end-pos name) 399 end-pos name)
390 (skip-syntax-forward " ") 400 (skip-syntax-forward " ")
391 (while (looking-at (eval-when-compile 401 (while (looking-at (eval-when-compile
392 (concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*"))) 402 (concat "\\(" xml-name-regexp "\\)\\s-*=\\s-*")))
573 (eval-when-compile 583 (eval-when-compile
574 (defvar str)) ; dynamic from replace-regexp-in-string 584 (defvar str)) ; dynamic from replace-regexp-in-string
575 585
576 ;; Fixme: Take declared entities from the DTD when they're available. 586 ;; Fixme: Take declared entities from the DTD when they're available.
577 (defun xml-substitute-entity (match) 587 (defun xml-substitute-entity (match)
578 "Subroutine of xml-substitute-special." 588 "Subroutine of `xml-substitute-special'."
579 (save-match-data 589 (save-match-data
580 (let ((match1 (match-string 1 str))) 590 (let ((match1 (match-string 1 str)))
581 (cond ((string= match1 "lt") "<") 591 (cond ((string= match1 "lt") "<")
582 ((string= match1 "gt") ">") 592 ((string= match1 "gt") ">")
583 ((string= match1 "apos") "'") 593 ((string= match1 "apos") "'")
610 ;;** Printing a tree. 620 ;;** Printing a tree.
611 ;;** This function is intended mainly for debugging purposes. 621 ;;** This function is intended mainly for debugging purposes.
612 ;;** 622 ;;**
613 ;;******************************************************************* 623 ;;*******************************************************************
614 624
615 (defun xml-debug-print (xml) 625 (defun xml-debug-print (xml &optional indent-string)
626 "Outputs the XML in the current buffer.
627 XML can be a tree or a list of nodes.
628 The first line is indented with the optional INDENT-STRING."
629 (setq indent-string (or indent-string ""))
616 (dolist (node xml) 630 (dolist (node xml)
617 (xml-debug-print-internal node ""))) 631 (xml-debug-print-internal node indent-string)))
632
633 (defalias 'xml-print 'xml-debug-print)
618 634
619 (defun xml-debug-print-internal (xml indent-string) 635 (defun xml-debug-print-internal (xml indent-string)
620 "Outputs the XML tree in the current buffer. 636 "Outputs the XML tree in the current buffer.
621 The first line is indented with INDENT-STRING." 637 The first line is indented with INDENT-STRING."
622 (let ((tree xml) 638 (let ((tree xml)
627 (setq attlist (xml-node-attributes tree)) 643 (setq attlist (xml-node-attributes tree))
628 (while attlist 644 (while attlist
629 (insert ?\ (symbol-name (caar attlist)) "=\"" (cdar attlist) ?\") 645 (insert ?\ (symbol-name (caar attlist)) "=\"" (cdar attlist) ?\")
630 (setq attlist (cdr attlist))) 646 (setq attlist (cdr attlist)))
631 647
632 (insert ?>)
633
634 (setq tree (xml-node-children tree)) 648 (setq tree (xml-node-children tree))
635 649
636 ;; output the children 650 (if (null tree)
637 (dolist (node tree) 651 (insert ?/ ?>)
638 (cond 652 (insert ?>)
639 ((listp node) 653
640 (insert ?\n) 654 ;; output the children
641 (xml-debug-print-internal node (concat indent-string " "))) 655 (dolist (node tree)
642 ((stringp node) (insert node)) 656 (cond
643 (t 657 ((listp node)
644 (error "Invalid XML tree")))) 658 (insert ?\n)
645 659 (xml-debug-print-internal node (concat indent-string " ")))
646 (insert ?\n indent-string 660 ((stringp node) (insert node))
647 ?< ?/ (symbol-name (xml-node-name xml)) ?>))) 661 (t
662 (error "Invalid XML tree"))))
663
664 (when (not (and (null (cdr tree))
665 (stringp (car tree))))
666 (insert ?\n indent-string))
667 (insert ?< ?/ (symbol-name (xml-node-name xml)) ?>))))
648 668
649 (provide 'xml) 669 (provide 'xml)
650 670
651 ;;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b 671 ;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b
652 ;;; xml.el ends here 672 ;;; xml.el ends here