>From 380c05f87fac0fb62ed6732729e865e1ff375583 Mon Sep 17 00:00:00 2001 From: Alex Branham Date: Mon, 10 Dec 2018 13:19:04 -0600 Subject: [PATCH] New function flatten-tree * lisp/subr.el (flatten-tree): New defun * lisp/subr.el (flatten-list): Alias to `flatten-tree' for discoverability * 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/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 * doc/lispref/lists.texi: Document `flatten-tree' Co-authored-by: Basil L. Contovounesios Bug #33309 --- doc/lispref/lists.texi | 12 ++++++++++++ etc/NEWS | 6 ++++++ lisp/eshell/em-basic.el | 2 +- lisp/eshell/em-dirs.el | 4 ++-- lisp/eshell/em-term.el | 2 +- lisp/eshell/em-tramp.el | 4 ++-- lisp/eshell/em-unix.el | 22 +++++++++++----------- lisp/eshell/em-xtra.el | 2 +- lisp/eshell/esh-ext.el | 2 +- lisp/eshell/esh-opt.el | 4 ++-- lisp/eshell/esh-util.el | 12 ++---------- lisp/gnus/gnus-sum.el | 10 +++++----- lisp/gnus/message.el | 12 ++---------- lisp/gnus/nnimap.el | 2 +- lisp/lpr.el | 20 ++------------------ lisp/printing.el | 2 +- lisp/progmodes/js.el | 8 ++------ lisp/subr.el | 25 +++++++++++++++++++++++++ test/lisp/subr-tests.el | 17 +++++++++++++++++ 19 files changed, 96 insertions(+), 72 deletions(-) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 1548dd49b2..52e3c312d9 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -667,6 +667,18 @@ Building Lists 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 diff --git a/etc/NEWS b/etc/NEWS index 6ae994d594..0caf123e2d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1343,6 +1343,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 --- diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 5201076f48..4a99d83857 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -118,7 +118,7 @@ eshell/echo (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))))) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 853382888c..b47f76fbfb 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -259,7 +259,7 @@ eshell-dirs-substitute-cd (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 @@ eshell-find-previous-directory (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)) diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index ddde47f73d..fdf40cae85 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -175,7 +175,7 @@ eshell-exec-visual (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 diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 9475f4ed94..f77b84d851 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -62,7 +62,7 @@ eshell/su "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 @@ eshell/sudo "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 diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 3aecebc2eb..e46e1c417d 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -231,7 +231,7 @@ eshell/rm 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 @@ eshell-mvcpln-template (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 @@ eshell/cat "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 @@ eshell/make (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 @@ eshell-poor-mans-grep (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 @@ eshell-grep (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 @@ eshell-du-sum-directory (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 @@ eshell/time (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 @@ nil-blank-string (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 @@ eshell/locate (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)))))) diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index cc84d19854..eb9847c60c 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -51,7 +51,7 @@ eshell/expr "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))))) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 244cc7ff1f..9e7d8bb608 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -222,7 +222,7 @@ eshell-remote-command (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 diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d7a449450f..69d10b4ccf 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -77,7 +77,7 @@ eshell-eval-using-options 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 @@ eshell-eval-using-options ,(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) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 8fe8c461fd..b55f873380 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -285,15 +285,7 @@ eshell-for ,@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 @@ eshell-stringify-list (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." diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4baf4bc826..3f5362ba17 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4773,7 +4773,7 @@ gnus-remove-thread (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 @@ gnus-thread-highest-number "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 @@ gnus-thread-latest-date "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. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fdaa4e8272..03f80616d9 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8051,7 +8051,7 @@ message-talkative-question 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 @@ message-talkative-question (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'. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 1a3b05ddb3..adbce25530 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -804,7 +804,7 @@ nnimap-insert-partial-structure (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) diff --git a/lisp/lpr.el b/lisp/lpr.el index 33b8da8d76..969b57d644 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -258,7 +258,7 @@ print-region-1 (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 @@ lpr-eval-switch ((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) diff --git a/lisp/printing.el b/lisp/printing.el index 2fc2323028..c1a73df14c 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -5672,7 +5672,7 @@ pr-switches-string (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))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index cec48a82a2..ddba7636b4 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -623,11 +623,7 @@ js--state-at-last-parse-pos "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 @@ js--maybe-join 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))) diff --git a/lisp/subr.el b/lisp/subr.el index d3bc007293..7a7c175db4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5448,5 +5448,30 @@ unmsys--file-name (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 diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index f218a7663e..08f9a697a3 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -372,5 +372,22 @@ subr-test--frames-1 (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 -- 2.19.1