Add a DOM pretty-printing function

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

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

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 37f16a132c3ec3256f6a7bb539ede157eec9d57d..74966431a45d99b325d7bddc7adfe20d93ccf204 100644 (file)
--- 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 3d9451a708ff7ed0febc74e62ab9b1e0c7ae0992..9c878a00c94deb456521c6641bff951cd2ee9b6f 100644 (file)
--- 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 92b50d98880d26a2537366c2a0bccdc82c21c407..85748e602089e9e791cb1129280f19debb030e15 100644 (file)
--- 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 04d6c219ec001c23ab0acca60ab832cc11347d23..6b24e4ffa91c79fc30dd0ab2fc0d4e8bc5b5ae2f 100644 (file)
--- 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