Add a DOM pretty-printing function

* doc/lispref/text.texi (Document Object Model): Mention `dom-pp'.

* lisp/dom.el (dom-pp): New function.

4 files changed, 67 insertions, 13 deletions

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 37f16a132c3..74966431a45 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,7 @@
+2014-11-27  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* text.texi (Document Object Model): Mention `dom-pp'.
+
 2014-11-26  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* text.texi (Document Object Model): New node to document dom.el.
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 3d9451a708f..9c878a00c94 100644
--- a/doc/lispref/text.texi
+++ b/doc/lispref/text.texi
@@ -4353,13 +4353,13 @@ A call to @code{libxml-parse-html-region} returns this @acronym{DOM}
 (document object model):
 
 @example
-(html ()
-  (head ())
-  (body ((width . "101"))
-   (div ((class . "thing"))
-    "Foo"
-    (div ()
-      "Yes"))))
+(html nil
+ (head nil)
+ (body ((width . "101"))
+  (div ((class . "thing"))
+   "Foo"
+   (div nil
+    "Yes"))))
 @end example
 @end defun
 
@@ -4396,13 +4396,10 @@ node has a node name (called a @dfn{tag}), and optional key/value
 nodes are either strings or @acronym{DOM} objects.
 
 @example
-(body
- ((width . "101"))
- (div
-  ((class . "thing"))
+(body ((width . "101"))
+ (div ((class . "thing"))
   "Foo"
-  (div
-   nil
+  (div nil
    "Yes")))
 @end example
 
@@ -4434,6 +4431,9 @@ would be:
 @item dom-children @var{node}
 Return all the children of the node.
 
+@item dom-non-text-children @var{node}
+Return all the non-string children of the node.
+
 @item dom-attributes @var{node}
 Return the key/value pair list of attributes of the node.
 
@@ -4494,6 +4494,14 @@ which is a regular expression.
 
 @end table
 
+Utility functions:
+
+@table @code
+@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.
+@end table
+
 
 @node Atomic Changes
 @section Atomic Change Groups
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 92b50d98880..85748e60208 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2014-11-27  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+	* dom.el (dom-pp): New function.
+
 2014-11-17  Eli Zaretskii  <eliz@gnu.org>
 
 	* vc/vc-bzr.el (vc-bzr-print-log, vc-bzr-expanded-log-entry):
diff --git a/lisp/dom.el b/lisp/dom.el
index 04d6c219ec0..6b24e4ffa91 100644
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -179,6 +179,44 @@ If BEFORE is nil, make CHILD NODE's first child."
     (setcdr node (list nil)))
   node)
 
+(defun dom-pp (dom &optional remove-empty)
+  "Pretty-print DOM at point.
+If REMOVE-EMPTY, ignore textual nodes that contain just
+white-space."
+  (let ((column (current-column)))
+    (insert (format "(%S " (dom-tag dom)))
+    (let* ((attr (dom-attributes dom))
+	   (times (length attr))
+	   (column (1+ (current-column))))
+      (if (null attr)
+	  (insert "nil")
+	(insert "(")
+	(dolist (elem attr)
+	  (insert (format "(%S . %S)" (car elem) (cdr elem)))
+	  (if (zerop (cl-decf times))
+	      (insert ")")
+	    (insert "\n" (make-string column ? ))))))
+    (let* ((children (if remove-empty
+			 (cl-remove-if
+			  (lambda (child)
+			    (and (stringp child)
+				 (string-match "\\`[\n\r\t  ]*\\'" child)))
+			  (dom-children dom))
+		       (dom-children dom)))
+	   (times (length children)))
+      (if (null children)
+	  (insert ")")
+	(insert "\n" (make-string (1+ column) ? ))
+	(dolist (child children)
+	  (if (stringp child)
+	      (if (or (not remove-empty)
+		      (not (string-match "\\`[\n\r\t  ]*\\'" child)))
+		  (insert (format "%S" child)))
+	    (dom-pp child remove-empty))
+	  (if (zerop (cl-decf times))
+	      (insert ")")
+	    (insert "\n" (make-string (1+ column) ? ))))))))
+
 (provide 'dom)
 
 ;;; dom.el ends here