From e63705ab9ba9081bcb4ed97e82019aab5a033d0d Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Mon, 31 Aug 2020 19:12:12 +0200
Subject: [PATCH] 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 0c3813ff1d0..3a4cf6b5723 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 ad63955f7bf..9a044cade1c 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 7ff9e07b729..bf4a56ab9f5 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
-- 
2.39.2