[Emacs-diffs] master 2d431af: Add a DOM pretty-printing function

[Lars Ingebrigtsen]

branch: master
commit 2d431afee4061515a593da1f0a29bcd5fb152f07
Author: Lars Magne Ingebrigtsen <address@hidden>
Date:   Thu Nov 27 16:57:22 2014 +0100

    Add a DOM pretty-printing function
    
    * doc/lispref/text.texi (Document Object Model): Mention `dom-pp'.
    
    * lisp/dom.el (dom-pp): New function.
---
 doc/lispref/ChangeLog |    4 ++++
 doc/lispref/text.texi |   34 +++++++++++++++++++++-------------
 lisp/ChangeLog        |    4 ++++
 lisp/dom.el           |   38 ++++++++++++++++++++++++++++++++++++++
 4 files changed, 67 insertions(+), 13 deletions(-)

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 37f16a1..7496643 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,7 @@
+2014-11-27  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * text.texi (Document Object Model): Mention `dom-pp'.
+
 2014-11-26  Lars Magne Ingebrigtsen  <address@hidden>
 
        * text.texi (Document Object Model): New node to document dom.el.
diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi
index 3d9451a..9c878a0 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.
 
address@hidden 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:
+
address@hidden @code
address@hidden 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.
address@hidden table
+
 
 @node Atomic Changes
 @section Atomic Change Groups
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 92b50d9..85748e6 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2014-11-27  Lars Magne Ingebrigtsen  <address@hidden>
+
+       * dom.el (dom-pp): New function.
+
 2014-11-17  Eli Zaretskii  <address@hidden>
 
        * vc/vc-bzr.el (vc-bzr-print-log, vc-bzr-expanded-log-entry):
diff --git a/lisp/dom.el b/lisp/dom.el
index 04d6c21..6b24e4f 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