master e63705a 1/2: Add a new function dom-print

[Lars Ingebrigtsen]

branch: master
commit e63705ab9ba9081bcb4ed97e82019aab5a033d0d
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add a new function dom-print
    
    * doc/lispref/text.texi (Document Object Model): Document it.
    
    * lisp/dom.el (dom-print): New function.
---
 doc/lispref/text.texi |  5 +++++
 etc/NEWS              |  3 +++
 lisp/dom.el           | 44 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 52 insertions(+)

diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 0c3813f..3a4cf6b 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -5154,6 +5154,11 @@ Utility functions:
 @item dom-pp @var{dom} &optional @var{remove-empty}
 Pretty-print @var{dom} at point.  If @var{remove-empty}, don't print
 textual nodes that just contain white-space.
+
+@item dom-print @var{dom} &optional @var{pretty} @var{xml}
+Print @var{dom} at point.  If @var{xml} is non-@code{nil}, print as
+@acronym{XML}; otherwise, print as @acronym{HTML}.  If @var{pretty} is
+non-@code{nil}, indent the @acronym{HTML}/@acronym{XML} logically.
 @end table
 
 
diff --git a/etc/NEWS b/etc/NEWS
index ad63955..9a044ca 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1215,6 +1215,9 @@ equivalent period in seconds.
 +++
 ** The new function 'dom-remove-attribute' has been added.
 
++++
+** The new function 'dom-print' has been added.
+
 ---
 ** 'make-network-process', 'make-serial-process' ':coding' behavior change.
 Previously, passing ':coding nil' to either of these functions would
diff --git a/lisp/dom.el b/lisp/dom.el
index 7ff9e07..bf4a56a 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -269,6 +269,50 @@ white-space."
              (insert ")")
            (insert "\n" (make-string (1+ column) ? ))))))))
 
+(defun dom-print (dom &optional pretty xml)
+  "Print DOM at point as HTML/XML.
+If PRETTY, indent the HTML/XML logically.
+If XML, generate XML instead of HTML."
+  (let ((column (current-column)))
+    (insert (format "<%s" (dom-tag dom)))
+    (let ((attr (dom-attributes dom)))
+      (dolist (elem attr)
+       ;; In HTML, these are boolean attributes that should not have
+       ;; an = value.
+       (if (and (memq (car elem)
+                      '(async autofocus autoplay checked
+                              contenteditable controls default
+                              defer disabled formNoValidate frameborder
+                              hidden ismap itemscope loop
+                              multiple muted nomodule novalidate open
+                              readonly required reversed
+                              scoped selected typemustmatch))
+                (cdr elem)
+                (not xml))
+           (insert (format " %s" (car elem)))
+         (insert (format " %s=%S" (car elem) (cdr elem))))))
+    (let* ((children (dom-children dom))
+          (non-text nil))
+      (if (null children)
+         (insert " />")
+       (insert ">")
+        (dolist (child children)
+         (if (stringp child)
+             (insert child)
+           (setq non-text t)
+           (when pretty
+              (insert "\n" (make-string (+ column 2) ? )))
+           (dom-print child pretty xml)))
+       ;; If we inserted non-text child nodes, or a text node that
+       ;; ends with a newline, then we indent the end tag.
+        (when (and pretty
+                  (or (bolp)
+                      non-text))
+         (unless (bolp)
+            (insert "\n"))
+         (insert (make-string column ? )))
+        (insert (format "</%s>" (dom-tag dom)))))))
+
 (provide 'dom)
 
 ;;; dom.el ends here