]> git.eshelyaron.com Git - emacs.git/commitdiff
New function flatten-tree
authorAlex Branham <alex.branham@gmail.com>
Mon, 17 Dec 2018 11:15:09 +0000 (12:15 +0100)
committerMichael Albinus <michael.albinus@gmx.de>
Mon, 17 Dec 2018 11:15:09 +0000 (12:15 +0100)
Co-authored-by: Basil L. Contovounesios <contovob@tcd.ie>
* doc/lispref/lists.texi: Document `flatten-tree'.

* lisp/progmodes/js.el (js--maybe-join):
* lisp/printing.el (pr-switches):
* lisp/lpr.el (lpr-print-region):
* lisp/gnus/nnimap.el (nnimap-find-wanted-parts):
* lisp/gnus/message.el (message-talkative-question):
* lisp/gnus/gnus-sum.el (gnus-remove-thread)
(gnus-thread-highest-number, gnus-thread-latest-date):
* lisp/eshell/esh-util.el (eshell-flatten-and-stringify):
* lisp/eshell/esh-opt.el (eshell-eval-using-options):
* lisp/eshell/esh-ext.el (eshell-external-command):
* lisp/eshell/em-xtra.el (eshell/expr):
* lisp/eshell/em-unix.el (eshell/rm, eshell-mvcpln-template)
(eshell/cat, eshell/make, eshell-poor-mans-grep, eshell-grep)
(eshell/du, eshell/time, eshell/diff, eshell/locate):
* lisp/eshell/em-tramp.el (eshell/su, eshell/sudo):
* lisp/eshell/em-term.el (eshell-exec-visual):
* lisp/eshell/em-dirs.el (eshell-dirs-substitute-cd, eshell/cd):
* lisp/eshell/em-basic.el (eshell/printnl):
Use new flatten-tree.

* lisp/progmodes/js.el (js--flatten-list):
* lisp/lpr.el (lpr-flatten-list):
* lisp/gnus/message.el (message-flatten-list):
* lisp/eshell/esh-util.el (eshell-flatten-list):
Obsolete in favor of Emacs-wide `flatten-tree'.

* lisp/subr.el (flatten-list): Alias to `flatten-tree' for
discoverability.

* lisp/subr.el (flatten-tree): New defun.

* test/lisp/subr-tests.el (subr-tests-flatten-tree): New test.

19 files changed:
doc/lispref/lists.texi
etc/NEWS
lisp/eshell/em-basic.el
lisp/eshell/em-dirs.el
lisp/eshell/em-term.el
lisp/eshell/em-tramp.el
lisp/eshell/em-unix.el
lisp/eshell/em-xtra.el
lisp/eshell/esh-ext.el
lisp/eshell/esh-opt.el
lisp/eshell/esh-util.el
lisp/gnus/gnus-sum.el
lisp/gnus/message.el
lisp/gnus/nnimap.el
lisp/lpr.el
lisp/printing.el
lisp/progmodes/js.el
lisp/subr.el
test/lisp/subr-tests.el

index 69f9300952092d15cb3ed11b8999f242ca088de3..31cc3190854d68dc10afac55e34bfcb629ef4302 100644 (file)
@@ -667,6 +667,18 @@ non-@code{nil}, it copies vectors too (and operates recursively on
 their elements).
 @end defun
 
+@defun flatten-tree tree
+Take @var{tree} and "flatten" it.
+This always returns a list containing all the terminal nodes, or
+leaves, of @var{tree}.  Dotted pairs are flattened as well, and nil
+elements are removed.
+@end defun
+
+@example
+(flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7))
+    @result{}(1 2 3 4 5 6 7)
+@end example
+
 @defun number-sequence from &optional to separation
 This returns a list of numbers starting with @var{from} and
 incrementing by @var{separation}, and ending at or just before
index c88f6ef5ca4d2e54af5087d010b920baeb7a2a8e..327276eef9bb08cf352b3d8ca1135a32e0ea6b91 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1359,6 +1359,12 @@ are implemented in C using the Jansson library.
 ** New function 'ring-resize'.
 'ring-resize' can be used to grow or shrink a ring.
 
++++
+** New function 'flatten-tree'.
+'flatten-list' is provided as an alias. These functions take a tree
+and 'flatten' it such that the result is a list of all the terminal
+nodes.
+
 ** Mailcap
 
 ---
index 5201076f4853a9960808780fa22250fea4169ad6..4a99d838579989637e83aa1d96b18b47c20bf0e5 100644 (file)
@@ -118,7 +118,7 @@ or `eshell-printn' for display."
 
 (defun eshell/printnl (&rest args)
   "Print out each of the arguments, separated by newlines."
-  (let ((elems (eshell-flatten-list args)))
+  (let ((elems (flatten-tree args)))
     (while elems
       (eshell-printn (eshell-echo (list (car elems))))
       (setq elems (cdr elems)))))
index 853382888c90249ce35af5c4847d4ab5e682a215..b47f76fbfb23392eac112f01bc9ca02738564482 100644 (file)
@@ -259,7 +259,7 @@ Thus, this does not include the current directory.")
   (if (> (length args) 1)
       (error "%s: command not found" (car args))
     (throw 'eshell-replace-command
-          (eshell-parse-command "cd" (eshell-flatten-list args)))))
+          (eshell-parse-command "cd" (flatten-tree args)))))
 
 (defun eshell-parse-user-reference ()
   "An argument beginning with ~ is a filename to be expanded."
@@ -353,7 +353,7 @@ in the minibuffer:
 
 (defun eshell/cd (&rest args)           ; all but first ignored
   "Alias to extend the behavior of `cd'."
-  (setq args (eshell-flatten-list args))
+  (setq args (flatten-tree args))
   (let ((path (car args))
        (subpath (car (cdr args)))
        (case-fold-search (eshell-under-windows-p))
index ddde47f73d668a51416f8010b31fa8bab712d1fd..fdf40cae85dc6f253ba54246767e1bcd90464f59 100644 (file)
@@ -175,7 +175,7 @@ allowed."
   (let* (eshell-interpreter-alist
         (interp (eshell-find-interpreter (car args) (cdr args)))
         (program (car interp))
-        (args (eshell-flatten-list
+        (args (flatten-tree
                (eshell-stringify-list (append (cdr interp)
                                               (cdr args)))))
         (term-buf
index 9475f4ed949248d4ce962e39bbceb3d11bc26101..f77b84d851b328b2d7f9877fe25ef084cc654586 100644 (file)
@@ -62,7 +62,7 @@
   "Alias \"su\" to call TRAMP.
 
 Uses the system su through TRAMP's su method."
-  (setq args (eshell-stringify-list (eshell-flatten-list args)))
+  (setq args (eshell-stringify-list (flatten-tree args)))
   (let ((orig-args (copy-tree args)))
     (eshell-eval-using-options
      "su" args
@@ -100,7 +100,7 @@ Become another USER during a login session.")
   "Alias \"sudo\" to call Tramp.
 
 Uses the system sudo through TRAMP's sudo method."
-  (setq args (eshell-stringify-list (eshell-flatten-list args)))
+  (setq args (eshell-stringify-list (flatten-tree args)))
   (let ((orig-args (copy-tree args)))
     (eshell-eval-using-options
      "sudo" args
index 3aecebc2ebf5f0765a5ba34bbee0fff74895089e..e46e1c417d4e49a6cd0ab124139d5b0adf1ed86a 100644 (file)
@@ -231,7 +231,7 @@ Otherwise, Emacs will attempt to use rsh to invoke du on the remote machine."
 This is implemented to call either `delete-file', `kill-buffer',
 `kill-process', or `unintern', depending on the nature of the
 argument."
-  (setq args (eshell-flatten-list args))
+  (setq args (flatten-tree args))
   (eshell-eval-using-options
    "rm" args
    '((?h "help" nil nil "show this usage screen")
@@ -481,7 +481,7 @@ Remove the DIRECTORY(ies), if they are empty.")
         (error "%s: missing destination file or directory" ,command))
      (if (= len 1)
         (nconc args '(".")))
-     (setq args (eshell-stringify-list (eshell-flatten-list args)))
+     (setq args (eshell-stringify-list (flatten-tree args)))
      (if (and ,(not (equal command "ln"))
              (string-match eshell-tar-regexp (car (last args)))
              (or (> (length args) 2)
@@ -606,7 +606,7 @@ with `--symbolic'.  When creating hard links, each TARGET must exist.")
   "Implementation of cat in Lisp.
 If in a pipeline, or the file is not a regular file, directory or
 symlink, then revert to the system's definition of cat."
-  (setq args (eshell-stringify-list (eshell-flatten-list args)))
+  (setq args (eshell-stringify-list (flatten-tree args)))
   (if (or eshell-in-pipeline-p
          (catch 'special
            (dolist (arg args)
@@ -670,7 +670,7 @@ Fallback to standard make when called synchronously."
        (compile (concat "make " (eshell-flatten-and-stringify args))))
     (throw 'eshell-replace-command
           (eshell-parse-command "*make" (eshell-stringify-list
-                                         (eshell-flatten-list args))))))
+                                         (flatten-tree args))))))
 
 (put 'eshell/make 'eshell-no-numeric-conversions t)
 
@@ -705,7 +705,7 @@ available..."
          (erase-buffer)
          (occur-mode)
          (let ((files (eshell-stringify-list
-                       (eshell-flatten-list (cdr args))))
+                       (flatten-tree (cdr args))))
                (inhibit-redisplay t)
                string)
            (when (car args)
@@ -750,11 +750,11 @@ external command."
        (throw 'eshell-replace-command
               (eshell-parse-command (concat "*" command)
                                     (eshell-stringify-list
-                                     (eshell-flatten-list args))))
+                                     (flatten-tree args))))
       (let* ((args (mapconcat 'identity
                              (mapcar 'shell-quote-argument
                                      (eshell-stringify-list
-                                      (eshell-flatten-list args)))
+                                      (flatten-tree args)))
                              " "))
             (cmd (progn
                    (set-text-properties 0 (length args)
@@ -876,7 +876,7 @@ external command."
 (defun eshell/du (&rest args)
   "Implementation of \"du\" in Lisp, passing ARGS."
   (setq args (if args
-                (eshell-stringify-list (eshell-flatten-list args))
+                (eshell-stringify-list (flatten-tree args))
               '(".")))
   (let ((ext-du (eshell-search-path "du")))
     (if (and ext-du
@@ -976,7 +976,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
            (eshell-parse-command (car time-args)
 ;;; https://lists.gnu.org/r/bug-gnu-emacs/2007-08/msg00205.html
                                  (eshell-stringify-list
-                                  (eshell-flatten-list (cdr time-args))))))))
+                                  (flatten-tree (cdr time-args))))))))
 
 (defun eshell/whoami (&rest _args)
   "Make \"whoami\" Tramp aware."
@@ -1000,7 +1000,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
 
 (defun eshell/diff (&rest args)
   "Alias \"diff\" to call Emacs `diff' function."
-  (let ((orig-args (eshell-stringify-list (eshell-flatten-list args))))
+  (let ((orig-args (eshell-stringify-list (flatten-tree args))))
     (if (or eshell-plain-diff-behavior
            (not (and (eshell-interactive-output-p)
                      (not eshell-in-pipeline-p)
@@ -1056,7 +1056,7 @@ Show wall-clock time elapsed during execution of COMMAND.")
               (string-match "^-" (car args))))
       (throw 'eshell-replace-command
             (eshell-parse-command "*locate" (eshell-stringify-list
-                                             (eshell-flatten-list args))))
+                                             (flatten-tree args))))
     (save-selected-window
       (let ((locate-history-list (list (car args))))
        (locate-with-filter (car args) (cadr args))))))
index cc84d1985442a13bcb961ecdbbaa92c20b58667e..eb9847c60c328e27e3a58f21391ff57663707251 100644 (file)
@@ -51,7 +51,7 @@ naturally accessible within Emacs."
   "Implementation of expr, using the calc package."
   (if (not (fboundp 'calc-eval))
       (throw 'eshell-replace-command
-            (eshell-parse-command "*expr" (eshell-flatten-list args)))
+            (eshell-parse-command "*expr" (flatten-tree args)))
     ;; to fool the byte-compiler...
     (let ((func 'calc-eval))
       (funcall func (eshell-flatten-and-stringify args)))))
index 244cc7ff1f32caaa8abc67ddf0abe63f76263bf2..9e7d8bb608e3b3cb7c4a2adffc55acd150784232 100644 (file)
@@ -222,7 +222,7 @@ causing the user to wonder if anything's really going on..."
 
 (defun eshell-external-command (command args)
   "Insert output from an external COMMAND, using ARGS."
-  (setq args (eshell-stringify-list (eshell-flatten-list args)))
+  (setq args (eshell-stringify-list (flatten-tree args)))
   (let ((interp (eshell-find-interpreter
                 command
                 args
index d7a449450f99d77c8cefcae6cda443d3aab23c69..69d10b4ccfc8e054f39c83d28ebca44d42c0783c 100644 (file)
@@ -77,7 +77,7 @@ arguments, some do not.  The recognized :KEYWORDS are:
   arguments.
 
 :preserve-args
-  If present, do not pass MACRO-ARGS through `eshell-flatten-list'
+  If present, do not pass MACRO-ARGS through `flatten-tree'
 and `eshell-stringify-list'.
 
 :parse-leading-options-only
@@ -106,7 +106,7 @@ let-bound variable `args'."
            ,(if (memq ':preserve-args (cadr options))
                 macro-args
               (list 'eshell-stringify-list
-                    (list 'eshell-flatten-list macro-args))))
+                    (list 'flatten-tree macro-args))))
           (processed-args (eshell--do-opts ,name ,options temp-args))
           ,@(delete-dups
              (delq nil (mapcar (lambda (opt)
index 8fe8c461fdb4a852cb7f381ab06ac1c3c3cd2af2..b55f8733802d5a4f551ba69f233d13f39d0c48dd 100644 (file)
@@ -285,15 +285,7 @@ Prepend remote identification of `default-directory', if any."
         ,@forms)
        (setq list-iter (cdr list-iter)))))
 
-(defun eshell-flatten-list (args)
-  "Flatten any lists within ARGS, so that there are no sublists."
-  (let ((new-list (list t)))
-    (dolist (a args)
-      (if (and (listp a)
-              (listp (cdr a)))
-         (nconc new-list (eshell-flatten-list a))
-       (nconc new-list (list a))))
-    (cdr new-list)))
+(define-obsolete-function-alias 'eshell-flatten-list #'flatten-tree "27.1")
 
 (defun eshell-uniquify-list (l)
   "Remove occurring multiples in L.  You probably want to sort first."
@@ -330,7 +322,7 @@ Prepend remote identification of `default-directory', if any."
 
 (defsubst eshell-flatten-and-stringify (&rest args)
   "Flatten and stringify all of the ARGS into a single string."
-  (mapconcat 'eshell-stringify (eshell-flatten-list args) " "))
+  (mapconcat 'eshell-stringify (flatten-tree args) " "))
 
 (defsubst eshell-directory-files (regexp &optional directory)
   "Return a list of files in the given DIRECTORY matching REGEXP."
index 4baf4bc826355fb71548f2a82e9b16407c011962..3f5362ba17af1aa7754dbdcd8fe322e8431f1781 100644 (file)
@@ -4773,7 +4773,7 @@ If LINE, insert the rebuilt thread starting on line LINE."
   (let (headers thread last-id)
     ;; First go up in this thread until we find the root.
     (setq last-id (gnus-root-id id)
-         headers (message-flatten-list (gnus-id-to-thread last-id)))
+         headers (flatten-tree (gnus-id-to-thread last-id)))
     ;; We have now found the real root of this thread.  It might have
     ;; been gathered into some loose thread, so we have to search
     ;; through the threads to find the thread we wanted.
@@ -5069,7 +5069,7 @@ Unscored articles will be counted as having a score of zero."
   "Return the highest article number in THREAD."
   (apply 'max (mapcar (lambda (header)
                        (mail-header-number header))
-                     (message-flatten-list thread))))
+                     (flatten-tree thread))))
 
 (defun gnus-article-sort-by-most-recent-date (h1 h2)
   "Sort articles by number."
@@ -5087,9 +5087,9 @@ Unscored articles will be counted as having a score of zero."
   "Return the highest article date in THREAD."
   (apply 'max
         (mapcar (lambda (header) (float-time
-                                  (gnus-date-get-time
-                                   (mail-header-date header))))
-                (message-flatten-list thread))))
+                             (gnus-date-get-time
+                              (mail-header-date header))))
+                (flatten-tree thread))))
 
 (defun gnus-thread-total-score-1 (root)
   ;; This function find the total score of the thread below ROOT.
index fdaa4e82727d9f53ff51cfe2d56021fc4deb6802..03f80616d9e8bce4e96f912ede7fa9f4ff2c41d9 100644 (file)
@@ -8051,7 +8051,7 @@ regular text mode tabbing command."
 If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer.
 The following arguments may contain lists of values."
   (if (and show
-          (setq text (message-flatten-list text)))
+          (setq text (flatten-tree text)))
       (save-window-excursion
         (with-output-to-temp-buffer " *MESSAGE information message*"
           (with-current-buffer " *MESSAGE information message*"
@@ -8061,15 +8061,7 @@ The following arguments may contain lists of values."
        (funcall ask question))
     (funcall ask question)))
 
-(defun message-flatten-list (list)
-  "Return a new, flat list that contains all elements of LIST.
-
-\(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7))
-=> (1 2 3 4 5 6 7)"
-  (cond ((consp list)
-        (apply 'append (mapcar 'message-flatten-list list)))
-       (list
-        (list list))))
+(define-obsolete-function-alias 'message-flatten-list #'flatten-tree "27.1")
 
 (defun message-generate-new-buffer-clone-locals (name &optional varstr)
   "Create and return a buffer with name based on NAME using `generate-new-buffer'.
index 1a3b05ddb37a3e0c390cb62eeaffbcc4d773d10c..adbce25530d5012c12d2bf5d18b705df8bb6ed60 100644 (file)
@@ -804,7 +804,7 @@ textual parts.")
     (insert "\n--" boundary "--\n")))
 
 (defun nnimap-find-wanted-parts (structure)
-  (message-flatten-list (nnimap-find-wanted-parts-1 structure "")))
+  (flatten-tree (nnimap-find-wanted-parts-1 structure "")))
 
 (defun nnimap-find-wanted-parts-1 (structure prefix)
   (let ((num 1)
index 33b8da8d7605f09d43273bd661bb71d7bebc6fd8..969b57d6444d7585628cc3c2a1bb7483a099b1e3 100644 (file)
@@ -258,7 +258,7 @@ for further customization of the printer command."
 
 (defun lpr-print-region (start end switches name)
   (let ((buf (current-buffer))
-        (nswitches (lpr-flatten-list
+        (nswitches (flatten-tree
                     (mapcar #'lpr-eval-switch ; Dynamic evaluation
                             switches)))
         (switch-string (if switches
@@ -336,23 +336,7 @@ The characters tab, linefeed, space, return and formfeed are not affected."
        ((consp arg) (apply (car arg) (cdr arg)))
        (t nil)))
 
-;; `lpr-flatten-list' is defined here (copied from "message.el" and
-;; enhanced to handle dotted pairs as well) until we can get some
-;; sensible autoloads, or `flatten-list' gets put somewhere decent.
-
-;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j))
-;; => (a b c d e f g h i j)
-
-(defun lpr-flatten-list (&rest list)
-  (lpr-flatten-list-1 list))
-
-(defun lpr-flatten-list-1 (list)
-  (cond
-   ((null list) nil)
-   ((consp list)
-    (append (lpr-flatten-list-1 (car list))
-           (lpr-flatten-list-1 (cdr list))))
-   (t (list list))))
+(define-obsolete-function-alias 'lpr-flatten-list #'flatten-tree "27.1")
 
 (provide 'lpr)
 
index 2fc2323028f01833c1dcfb8ed7e64f0e3d966002..c1a73df14c15214de35568e53ae9e51a2f863670 100644 (file)
@@ -5672,7 +5672,7 @@ If menu binding was not done, calls `pr-menu-bind'."
 (defun pr-switches (switches mess)
   (or (listp switches)
       (error "%S should have a list of strings" mess))
-  (lpr-flatten-list                    ; dynamic evaluation
+  (flatten-tree                        ; dynamic evaluation
    (mapcar #'lpr-eval-switch switches)))
 
 
index cec48a82a20f88317acf44c2f9ec1a26124ebc61..ddba7636b4a94e6c0f5238952b873dab12d95a58 100644 (file)
@@ -623,11 +623,7 @@ then the \".\"s will be lined up:
   "Parse state at `js--last-parse-pos'.")
 (make-variable-buffer-local 'js--state-at-last-parse-pos)
 
-(defun js--flatten-list (list)
-  (cl-loop for item in list
-           nconc (cond ((consp item)
-                        (js--flatten-list item))
-                       (item (list item)))))
+(define-obsolete-function-alias 'js--flatten-list #'flatten-tree "27.1")
 
 (defun js--maybe-join (prefix separator suffix &rest list)
   "Helper function for `js--update-quick-match-re'.
@@ -636,7 +632,7 @@ elements, separated by SEPARATOR, prefixed by PREFIX, and ended
 with SUFFIX as with `concat'.  Otherwise, if LIST is empty, return
 nil.  If any element in LIST is itself a list, flatten that
 element."
-  (setq list (js--flatten-list list))
+  (setq list (flatten-tree list))
   (when list
     (concat prefix (mapconcat #'identity list separator) suffix)))
 
index d3bc007293bdf9d487864cecc4ed7e3358c2dd80..7a7c175db4a3220c56809c22b232ceb912bb6108 100644 (file)
@@ -5448,5 +5448,30 @@ This function is called from lisp/Makefile and leim/Makefile."
     (setq file (concat (substring file 1 2) ":" (substring file 2))))
   file)
 
+(defun flatten-tree (tree)
+  "Take TREE and \"flatten\" it.
+This always returns a list containing all the terminal nodes, or
+\"leaves\", of TREE.  Dotted pairs are flattened as well, and nil
+elements are removed.
+
+\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7))
+=> (1 2 3 4 5 6 7)
+
+TREE can be anything that can be made into a list.  For each
+element in TREE, if it is a cons cell return its car
+recursively.  Otherwise return the element."
+    (let (elems)
+    (setq tree (list tree))
+    (while (let ((elem (pop tree)))
+             (cond ((consp elem)
+                    (setq tree (cons (car elem) (cons (cdr elem) tree))))
+                   (elem
+                    (push elem elems)))
+             tree))
+    (nreverse elems)))
+
+;; Technically, `flatten-list' is a misnomer, but we provide it here
+;; for discoverability:
+(defalias 'flatten-list 'flatten-tree)
 
 ;;; subr.el ends here
index f218a7663e0aaf61a9f2e2deadbfdf0e125d2a1b..08f9a697a3cae377707cd8c026d8327ce1d1e822 100644 (file)
@@ -372,5 +372,22 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
                             (shell-quote-argument "%ca%")))
                    "without-caret %ca%"))))
 
+(ert-deftest subr-tests-flatten-tree ()
+  "Test `flatten-tree' behavior."
+  (should (equal (flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7))
+                 '(1 2 3 4 5 6 7)))
+  (should (equal (flatten-tree '((1 . 2)))
+                 '(1 2)))
+  (should (equal (flatten-tree '(1 nil 2))
+                 '(1 2)))
+  (should (equal (flatten-tree 42)
+                 '(42)))
+  (should (equal (flatten-tree t)
+               '(t)))
+  (should (equal (flatten-tree nil)
+               nil))
+  (should (equal (flatten-tree '(1 ("foo" "bar") 2))
+                 '(1 "foo" "bar" 2))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here