diff lisp/xml.el @ 89943:4c90ffeb71c5

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-15 Merge from emacs--cvs-trunk--0 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-218 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-220 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-221 Restore deleted tagline in etc/TUTORIAL.ru * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-222 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-228 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-229 Remove TeX output files from the archive * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-230 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-247 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-248 src/lisp.h (CYCLE_CHECK): Macro moved from xfaces.c * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-249 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-256 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-258 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-263 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-264 Update from CVS: lispref/display.texi: emacs -> Emacs. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-265 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-274 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-275 Update from CVS: man/makefile.w32-in: Revert last change * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-276 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-295 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-296 Allow restarting an existing debugger session that's exited * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-297 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-299 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-300 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-327 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-328 Update from CVS: src/.gdbinit (xsymbol): Fix last change. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-329 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-346 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-353 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-361 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-362 Support " [...]" style defaults in minibuffer-electric-default-mode * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-363 (read-number): Use canonical format for default in prompt. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-364 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-367 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-368 Improve display-supports-face-attributes-p on non-ttys * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-369 Rewrite face-differs-from-default-p * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-370 Move `display-supports-face-attributes-p' entirely into C code * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-371 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-372 Simplify face-differs-from-default-p; don't consider :stipple. * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-373 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-374 (tty_supports_face_attributes_p): Ensure attributes differ from default * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-375 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-376 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-377 (Fdisplay_supports_face_attributes_p): Work around bootstrapping problem * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-378 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-380 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-381 Face merging cleanups * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-382 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-384 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-385 src/xfaces.c (push_named_merge_point): Return 0 if a cycle is detected * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-386 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-395 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-396 Tweak arch tagging to make build/install-in-place less annoying * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-397 Work around vc-arch problems when building eshell * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-398 Tweak permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-399 Tweak directory permissions * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-400 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-401 More build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-402 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-403 Yet more build-in-place tweaking of arch tagging * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-404 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-409 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-410 Make sure image types are initialized for lookup too * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-411 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-416 Update from CVS

--- a/lisp/xml.el	Sat May 29 02:17:09 2004 +0000
+++ b/lisp/xml.el	Mon Jun 28 07:56:49 2004 +0000
@@ -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 @@
 
 (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 @@
 	    (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 @@
 	      (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 @@
       (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 @@
 
 ;; 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 @@
 ;;**
 ;;*******************************************************************
 
-(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 @@
       (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"))))
+    (if (null tree)
+	(insert ?/ ?>)
+      (insert ?>)
 
-    (insert ?\n indent-string
-	    ?< ?/ (symbol-name (xml-node-name xml)) ?>)))
+      ;;  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