[PATCH] xml-debug-print-internal needs to quote attributes and text

[sand]

Load xml.el to define `xml-debug-print' and evaluate the following:

  (xml-debug-print
        '((foo ((attr . "<bar> & \"<bar>\"")) "<bar> & \"<bar>\"")))

This will insert text into the current buffer.  With the as-shipped
`xml-debug-print' definition, the buffer gets:

  <foo attr="<bar> & "<bar>""><bar> & "<bar>"</foo>

This is not legal XML.  We have legal XML if we escape greater-than,
less-than and ampersand in the attribute value and in the content, and
escape quote in the attribute value:

  <foo attr="&lt;bar&gt; &amp; &quot;&lt;bar&gt;&quot;">&lt;bar&gt; &amp; 
"&lt;bar&gt;"</foo>

The XML specifiction <http://www.w3.org/TR/REC-xml/#syntax> allows
some leeway in the exact behavior, but the above substitutions are
compliant.  In particular, we do not escape apostrophes in the
attribute value, since the code never quotes attribute values using
apostrophes.

The following redefinition of `xml-debug-print-internal' performs
regexp substitution for each of the quotable characters.  Note that
the replacement lists are different for the two cases.

  (defun xml-debug-print-internal (xml indent-string)
    "Outputs the XML tree in the current buffer.
  The first line is indented with INDENT-STRING."
    (let ((tree xml)
      attlist)
      (insert indent-string ?< (symbol-name (xml-node-name tree)))

      ;;  output the attribute list
      (setq attlist (xml-node-attributes tree))
      (while attlist
        (let ((value (cdar attlist))
              (replacements '(("&" . "&amp;")
                              ("<" . "&lt;")
                              (">" . "&gt;")
                              ("\"" . "&quot;"))))
          (while replacements
            (setq value (replace-regexp-in-string (caar replacements)
                                                  (cdar replacements)
                                                  value))
            (setq replacements (cdr replacements)))
          (insert ?\  (symbol-name (caar attlist)) "=\"" value ?\"))
        (setq attlist (cdr attlist)))

      (setq tree (xml-node-children tree))

      (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)
        (let ((replacements '(("&" . "&amp;")
                              ("<" . "&lt;")
                              (">" . "&gt;"))))
          (while replacements
            (setq node (replace-regexp-in-string (caar replacements)
                                                 (cdar replacements)
                                                 node))
            (setq replacements (cdr replacements)))
          (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)) ?>))))

In GNU Emacs 22.1.1 (i486-pc-linux-gnu, GTK+ Version 2.12.1)
 of 2007-11-03 on pacem, modified by Debian
Windowing system distributor `The X.Org Foundation', version 11.0.10400000
configured using `configure  '--build=i486-linux-gnu' '--host=i486-linux-gnu' 
'--prefix=/usr' '--sharedstatedir=/var/lib' '--libexecdir=/usr/lib' 
'--localstatedir=/var/lib' '--infodir=/usr/share/info' 
'--mandir=/usr/share/man' '--with-pop=yes' 
'--enable-locallisppath=/etc/emacs22:/etc/emacs:/usr/local/share/emacs/22.1/site-lisp:/usr/local/share/emacs/site-lisp:/usr/share/emacs/22.1/site-lisp:/usr/share/emacs/site-lisp:/usr/share/emacs/22.1/leim'
 '--with-x=yes' '--with-x-toolkit=gtk' '--with-toolkit-scroll-bars' 
'build_alias=i486-linux-gnu' 'host_alias=i486-linux-gnu' 'CFLAGS=-DDEBIAN -g 
-O2''

Derek

-- 
Derek Upham
sand@blarg.net

"Ha!  Your Leaping Tiger Kung Fu is no match for my Frightened Piglet style!"