summaryrefslogtreecommitdiff
path: root/lisp/xml.el
diff options
context:
space:
mode:
authorMiles Bader <miles@gnu.org>2004-06-28 07:56:49 +0000
committerMiles Bader <miles@gnu.org>2004-06-28 07:56:49 +0000
commit327719ee8a3fcdb36ed6acaf6d8cb5fbdf0bd801 (patch)
tree21de188e13b5e41a79bb50040933072ae0235217 /lisp/xml.el
parent852f73b7fa7b71910282eacb6263b3ecfd4ee783 (diff)
parent376de73927383d6062483db10b8a82448505f52b (diff)
downloademacs-327719ee8a3fcdb36ed6acaf6d8cb5fbdf0bd801.tar.gz
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
Diffstat (limited to 'lisp/xml.el')
-rw-r--r--lisp/xml.el86
1 files changed, 53 insertions, 33 deletions
diff --git a/lisp/xml.el b/lisp/xml.el
index 408c13ab39b..03ef6346c70 100644
--- a/lisp/xml.el
+++ b/lisp/xml.el
@@ -27,13 +27,13 @@
;; This file contains a somewhat incomplete non-validating XML parser. It
;; parses a file, and returns a list that can be used internally by
-;; any other lisp libraries.
+;; any other Lisp libraries.
;;; FILE FORMAT
;; The document type declaration may either be ignored or (optionally)
;; parsed, but currently the parsing will only accept element
-;; declarations. The XML file is assumed to be well-formed. In case
+;; declarations. The XML file is assumed to be well-formed. In case
;; of error, the parsing stops and the XML file is shown where the
;; parsing stopped.
;;
@@ -44,7 +44,7 @@
;; <node2 attr3="name3" attr4="name4">value2</node2>
;; <node3 attr5="name5" attr6="name6">value3</node3>
;; </node1>
-;; Of course, the name of the nodes and attributes can be anything. There can
+;; Of course, the name of the nodes and attributes can be anything. There can
;; be any number of attributes (or none), as well as any number of children
;; below the nodes.
;;
@@ -86,7 +86,18 @@
(defsubst xml-node-name (node)
"Return the tag associated with NODE.
-The tag is a lower-case symbol."
+Without namespace-aware parsing, the tag is a symbol.
+
+With namespace-aware parsing, the tag is a cons of a string
+representing the uri of the namespace with the local name of the
+tag. For example,
+
+ <foo>
+
+would be represented by
+
+ '(\"\" . \"foo\")."
+
(car node))
(defsubst xml-node-attributes (node)
@@ -101,17 +112,17 @@ This is a list of nodes, and it can be nil."
(defun xml-get-children (node child-name)
"Return the children of NODE whose tag is CHILD-NAME.
-CHILD-NAME should be a lower case symbol."
+CHILD-NAME should match the value returned by `xml-node-name'."
(let ((match ()))
(dolist (child (xml-node-children node))
- (if child
- (if (equal (xml-node-name child) child-name)
- (push child match))))
+ (if (and (listp child)
+ (equal (xml-node-name child) child-name))
+ (push child match)))
(nreverse match)))
(defun xml-get-attribute-or-nil (node attribute)
"Get from NODE the value of ATTRIBUTE.
-Return `nil' if the attribute was not found.
+Return nil if the attribute was not found.
See also `xml-get-attribute'."
(cdr (assoc attribute (xml-node-attributes node))))
@@ -236,7 +247,8 @@ If PARSE-NS is non-nil, then QNAMES are expanded."
(nreverse xml)))))))
(defun xml-maybe-do-ns (name default xml-ns)
- "Perform any namespace expansion. NAME is the name to perform the expansion on.
+ "Perform any namespace expansion.
+NAME is the name to perform the expansion on.
DEFAULT is the default namespace. XML-NS is a cons of namespace
names to uris. When namespace-aware parsing is off, then XML-NS
is nil.
@@ -325,10 +337,8 @@ Returns one of:
(push (cons (cdar attr) (intern (concat ":" (cdr attr))))
xml-ns))))
- ;; expand element names
- (setq node-name (list (xml-maybe-do-ns node-name "" xml-ns)))
+ (setq children (list attrs (xml-maybe-do-ns node-name "" xml-ns)))
- (setq children (list attrs node-name))
;; is this an empty element ?
(if (looking-at "/>")
(progn
@@ -383,8 +393,8 @@ Returns one of:
(error "XML: Invalid character")))))
(defun xml-parse-attlist (&optional xml-ns)
- "Return the attribute-list after point. Leave point at the
-first non-blank character after the tag."
+ "Return the attribute-list after point.
+Leave point at the first non-blank character after the tag."
(let ((attlist ())
end-pos name)
(skip-syntax-forward " ")
@@ -575,7 +585,7 @@ This follows the rule [28] in the XML specifications."
;; Fixme: Take declared entities from the DTD when they're available.
(defun xml-substitute-entity (match)
- "Subroutine of xml-substitute-special."
+ "Subroutine of `xml-substitute-special'."
(save-match-data
(let ((match1 (match-string 1 str)))
(cond ((string= match1 "lt") "<")
@@ -612,9 +622,15 @@ This follows the rule [28] in the XML specifications."
;;**
;;*******************************************************************
-(defun xml-debug-print (xml)
+(defun xml-debug-print (xml &optional indent-string)
+ "Outputs the XML in the current buffer.
+XML can be a tree or a list of nodes.
+The first line is indented with the optional INDENT-STRING."
+ (setq indent-string (or indent-string ""))
(dolist (node xml)
- (xml-debug-print-internal node "")))
+ (xml-debug-print-internal node indent-string)))
+
+(defalias 'xml-print 'xml-debug-print)
(defun xml-debug-print-internal (xml indent-string)
"Outputs the XML tree in the current buffer.
@@ -629,24 +645,28 @@ The first line is indented with INDENT-STRING."
(insert ?\ (symbol-name (caar attlist)) "=\"" (cdar attlist) ?\")
(setq attlist (cdr attlist)))
- (insert ?>)
-
(setq tree (xml-node-children tree))
- ;; output the children
- (dolist (node tree)
- (cond
- ((listp node)
- (insert ?\n)
- (xml-debug-print-internal node (concat indent-string " ")))
- ((stringp node) (insert node))
- (t
- (error "Invalid XML tree"))))
-
- (insert ?\n indent-string
- ?< ?/ (symbol-name (xml-node-name xml)) ?>)))
+ (if (null tree)
+ (insert ?/ ?>)
+ (insert ?>)
+
+ ;; output the children
+ (dolist (node tree)
+ (cond
+ ((listp node)
+ (insert ?\n)
+ (xml-debug-print-internal node (concat indent-string " ")))
+ ((stringp node) (insert node))
+ (t
+ (error "Invalid XML tree"))))
+
+ (when (not (and (null (cdr tree))
+ (stringp (car tree))))
+ (insert ?\n indent-string))
+ (insert ?< ?/ (symbol-name (xml-node-name xml)) ?>))))
(provide 'xml)
-;;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b
+;; arch-tag: 5864b283-5a68-4b59-a20d-36a72b353b9b
;;; xml.el ends here