Wrap around error in coreutil's ls

[gnu-emacs] / lisp / dom.el

diff --git a/lisp/dom.el b/lisp/dom.el
index 04d6c219ec001c23ab0acca60ab832cc11347d23..cf3a02a51dbcc1d0963e2a77d673f2422ac677b8 100644 (file)
--- a/lisp/dom.el
+++ b/lisp/dom.el
@@ -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."
@@ -103,6 +104,14 @@ A name is a symbol like `td'."
        (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))
@@ -130,6 +139,16 @@ ATTRIBUTE would typically be `class', `id' or the like."
        (cons dom matches)
       matches)))
 
+(defun dom-remove-node (dom node)
+  "Remove NODE from DOM."
+  ;; If we're removing the top level node, just return nil.
+  (dolist (child (dom-children dom))
+    (cond
+     ((eq node child)
+      (delq node dom))
+     ((not (stringp child))
+      (dom-remove-node child node)))))
+
 (defun dom-parent (dom node)
   "Return the parent of NODE in DOM."
   (if (memq node (dom-children dom))
@@ -141,6 +160,17 @@ ATTRIBUTE would typically be `class', `id' or the like."
          (setq result (dom-parent elem node))))
       result)))
 
+(defun dom-previous-sibling (dom node)
+  "Return the previous sibling of NODE in DOM."
+  (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
@@ -179,6 +209,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