]> code.delx.au - gnu-emacs/blobdiff - lisp/dom.el
Teach net-utils more iproute2 and nl80211 tools
[gnu-emacs] / lisp / dom.el
index 3157e0b2f2a63b4a35e8199325f81882c2f75b6b..03fe75975a423e5e9c9d022dd247671888b772ec 100644 (file)
@@ -1,6 +1,6 @@
 ;;; dom.el --- XML/HTML (etc.) DOM manipulation and searching functions
 
-;; Copyright (C) 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
 ;; Keywords: xml, html
@@ -25,6 +25,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(eval-when-compile (require 'subr-x))
 
 (defsubst dom-tag (node)
   "Return the NODE tag."
       (cddr (car node))
     (cddr node)))
 
+(defun dom-non-text-children (node)
+  "Return all non-text-node children of NODE."
+  (cl-loop for child in (dom-children node)
+          unless (stringp child)
+          collect child))
+
 (defun dom-set-attributes (node attributes)
   "Set the attributes of NODE to ATTRIBUTES."
   (setq node (dom-ensure-node node))
@@ -93,10 +100,18 @@ A name is a symbol like `td'."
                                             (dom-by-tag child tag))
                          when matches
                          append matches)))
-    (if (eq (dom-tag dom) tag)
+    (if (equal (dom-tag dom) tag)
        (cons dom matches)
       matches)))
 
+(defun dom-strings (dom)
+  "Return elements in DOM that are strings."
+  (cl-loop for child in (dom-children dom)
+          if (stringp child)
+          collect child
+          else
+          append (dom-strings child)))
+
 (defun dom-by-class (dom match)
   "Return elements in DOM that have a class name that matches regexp MATCH."
   (dom-elements dom 'class match))
@@ -113,7 +128,9 @@ A name is a symbol like `td'."
   "Find elements matching MATCH (a regexp) in ATTRIBUTE.
 ATTRIBUTE would typically be `class', `id' or the like."
   (let ((matches (cl-loop for child in (dom-children dom)
-                         for matches = (dom-elements child attribute match)
+                         for matches = (and (not (stringp child))
+                                            (dom-elements child attribute
+                                                          match))
                          when matches
                          append matches))
        (attr (dom-attr dom attribute)))
@@ -133,6 +150,16 @@ ATTRIBUTE would typically be `class', `id' or the like."
          (setq result (dom-parent elem node))))
       result)))
 
+(defun dom-previous-sibling (dom node)
+  (when-let (parent (dom-parent dom node))
+    (let ((siblings (dom-children parent))
+         (previous nil))
+      (while siblings
+       (when (eq (cadr siblings) node)
+         (setq previous (car siblings)))
+       (pop siblings))
+      previous)))
+
 (defun dom-node (tag &optional attributes &rest children)
   "Return a DOM node with TAG and ATTRIBUTES."
   (if children
@@ -171,6 +198,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