* bug#33309: Add flatten-list? @ 2018-11-07 19:46 Alex Branham 2018-11-07 20:36 ` Drew Adams 2018-12-11 17:36 ` bug#33309: [PATCH] flatten-list Alex Branham 0 siblings, 2 replies; 19+ messages in thread From: Alex Branham @ 2018-11-07 19:46 UTC (permalink / raw) To: 33309 [-- Attachment #1: Type: text/plain, Size: 1038 bytes --] Could we add a new function `flatten-list'? There seems to be a need for it. Inside Emacs itself, I see at least four implementations of the same basic thing: - eshell-flatten-list - message-flatten-list - lpr-flatten-list - js--flatten-list And there are many more in the various 3rd-party packages. I was thinking of putting it in subr.el. What do you think? Thanks, Alex diff --git a/lisp/subr.el b/lisp/subr.el index 41dc9aa45f..3ea75ddf56 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5447,5 +5447,14 @@ This function is called from lisp/Makefile and leim/Makefile." (setq file (concat (substring file 1 2) ":" (substring file 2)))) file) +(defun flatten-list (list) + "Take LIST and \"flatten\" it. +The result will be a list containing all the elements of LIST. +\(flatten-list \\='(1 (2 3 (4 5 (6))) 7)) +=> (1 2 3 4 5 6 7)" + (cond ((null list) nil) + ((consp list) (append (flatten-list (car list)) + (flatten-list (cdr list)))) + (t (list list)))) ;;; subr.el ends here [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 487 bytes --] ^ permalink raw reply related [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-11-07 19:46 bug#33309: Add flatten-list? Alex Branham @ 2018-11-07 20:36 ` Drew Adams 2018-11-07 21:19 ` Alex Branham 2018-12-11 17:36 ` bug#33309: [PATCH] flatten-list Alex Branham 1 sibling, 1 reply; 19+ messages in thread From: Drew Adams @ 2018-11-07 20:36 UTC (permalink / raw) To: Alex Branham, 33309 FWIW, I don't think Emacs Lisp needs a flatten function. 1. Even Common Lisp doesn't bother with one. (And there are lots of Common Lisp functions I'd sooner see added to Emacs.) 2. It's trivial to define when needed, and there are not a lot of existing uses of it. 3. The functions you mention do not all behave the same. Even their arg lists are not the same. (But sure, they could all be made to use a common version, if that were important.) 4. (flatten-list 42) => (42) The doc string says nothing about the case where the argument LIST (a bad name here) is not a list. And if the arg need not be a list then "-list" in the function name is not good. ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-11-07 20:36 ` Drew Adams @ 2018-11-07 21:19 ` Alex Branham 2018-12-10 8:44 ` Michael Albinus 0 siblings, 1 reply; 19+ messages in thread From: Alex Branham @ 2018-11-07 21:19 UTC (permalink / raw) To: Drew Adams; +Cc: 33309 [-- Attachment #1: Type: text/plain, Size: 1348 bytes --] On Wed 07 Nov 2018 at 14:36, Drew Adams <drew.adams@oracle.com> wrote: > FWIW, I don't think Emacs Lisp needs a flatten > function. > > 1. Even Common Lisp doesn't bother with one. > (And there are lots of Common Lisp > functions I'd sooner see added to Emacs.) > > 2. It's trivial to define when needed, and > there are not a lot of existing uses of it. Like I said, there's at least four implementations in Emacs of the same thing, and who knows how many in 3rd-party packages in ELPA or elsewhere. I'm not sure what you consider "a lot," but DRY kicks in around three times for me. > 3. The functions you mention do not all behave > the same. Even their arg lists are not the > same. (But sure, they could all be made to > use a common version, if that were important.) > > 4. (flatten-list 42) => (42) > > The doc string says nothing about the case > where the argument LIST (a bad name here) > is not a list. And if the arg need not be > a list then "-list" in the function name > is not good. Right, I didn't mean to imply that the one I sent be added in its current state. I just meant to kick off discussion. I basically copy/pasted it from somewhere (lpr, I think?). If added it'll need to be properly documented and perhaps message-flatten-list and the others made obsolete aliases. Thanks, Alex [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 487 bytes --] ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-11-07 21:19 ` Alex Branham @ 2018-12-10 8:44 ` Michael Albinus 2018-12-10 17:49 ` Stefan Monnier 0 siblings, 1 reply; 19+ messages in thread From: Michael Albinus @ 2018-12-10 8:44 UTC (permalink / raw) To: Alex Branham; +Cc: 33309 Alex Branham <alex.branham@gmail.com> writes: Hi Alex, >> 1. Even Common Lisp doesn't bother with one. >> (And there are lots of Common Lisp >> functions I'd sooner see added to Emacs.) >> >> 2. It's trivial to define when needed, and >> there are not a lot of existing uses of it. > > Like I said, there's at least four implementations in Emacs of the same > thing, and who knows how many in 3rd-party packages in ELPA or > elsewhere. I'm not sure what you consider "a lot," but DRY kicks in > around three times for me. For the records, in Tramp I need also this function. I'm just going to define it myself (derived from eshell-flatten-list), but I'll happily switch to a common flatten-list. >> 3. The functions you mention do not all behave >> the same. Even their arg lists are not the >> same. (But sure, they could all be made to >> use a common version, if that were important.) >> >> 4. (flatten-list 42) => (42) >> >> The doc string says nothing about the case >> where the argument LIST (a bad name here) >> is not a list. And if the arg need not be >> a list then "-list" in the function name >> is not good. > > Right, I didn't mean to imply that the one I sent be added in its > current state. I just meant to kick off discussion. I basically > copy/pasted it from somewhere (lpr, I think?). If added it'll need to be > properly documented and perhaps message-flatten-list and the others made > obsolete aliases. Unless nobody else objects, I'd like to encourage you to prepare a patch to be added to the master branch. This could include the replacement of the existing implementations. > Thanks, > Alex Thanks, and best regards, Michael. ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 8:44 ` Michael Albinus @ 2018-12-10 17:49 ` Stefan Monnier 2018-12-10 20:12 ` Alex Branham 0 siblings, 1 reply; 19+ messages in thread From: Stefan Monnier @ 2018-12-10 17:49 UTC (permalink / raw) To: Michael Albinus; +Cc: Alex Branham, 33309 > For the records, in Tramp I need also this function. I'm just going to > define it myself (derived from eshell-flatten-list), but I'll happily > switch to a common flatten-list. If you do, please use an appropriate name: if it recurses arbitrarily, it means it's flattening a *tree* not a *list*. IOW if we want to provide `list-flatten` (or `seq-flatten`) it would have to look a bit like (apply #'append list) without the recursion. > Unless nobody else objects, I'd like to encourage you to prepare a patch > to be added to the master branch. This could include the replacement of > the existing implementations. Agreed. Just make sure the name clarifies it's working on a tree (e.g. depending on how you define the function, it can be considered as a function that returns all the leaves of a given tree). Stefan ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 17:49 ` Stefan Monnier @ 2018-12-10 20:12 ` Alex Branham 2018-12-10 21:36 ` Stefan Monnier 2018-12-10 22:42 ` Basil L. Contovounesios 0 siblings, 2 replies; 19+ messages in thread From: Alex Branham @ 2018-12-10 20:12 UTC (permalink / raw) To: Stefan Monnier; +Cc: 33309, Michael Albinus [-- Attachment #1: Type: text/plain, Size: 856 bytes --] Thanks for the feedback, everyone. Here's a patch that implements `flatten-tree' which always returns a list and recurses into conses. It also replaces all the existing *-flatten-list functions with obsolete aliases and replaces usages of them with `flatten-list'. I added a few very simple tests for this too. CONTRIBUTE doesn't say whether I should include that change in the git commit message. I left it out but it's easy to add, just let me know if I should. > If you do, please use an appropriate name: if it recurses arbitrarily, > it means it's flattening a *tree* not a *list*. I aliased `flatten-tree' to `flatten-list' because I think (given the names of the existing implementations) this is the name people expect, even if it's not technically right. I wasn't able to run the tests because some gpg encryption stuff failed. Thanks, Alex [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-New-function-flatten-tree.patch --] [-- Type: text/x-patch, Size: 19934 bytes --] From 5a988023e16bba42a5a0fe69773105a535f8cb5a Mon Sep 17 00:00:00 2001 From: Alex Branham <alex.branham@gmail.com> 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/net/tramp-compat.el (tramp-compat-flatten-list): * lisp/lpr.el (lpr-flatten-list): * lisp/gnus/message.el: * 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 Bug #33309 --- 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/net/tramp-compat.el | 13 +------------ lisp/printing.el | 2 +- lisp/progmodes/js.el | 8 ++------ lisp/subr.el | 13 +++++++++++++ test/lisp/subr-tests.el | 9 +++++++++ 18 files changed, 59 insertions(+), 84 deletions(-) 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/net/tramp-compat.el b/lisp/net/tramp-compat.el index 046966e019..4f99a31e54 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -270,18 +270,7 @@ tramp-compat-use-url-tramp-p (unload-feature 'tramp-loaddefs 'force) (unload-feature 'tramp-compat 'force))) -;; There does not exist a common `flatten-list' yet, this is discussed -;; in Bug#33309. For the time being we implement our own version, -;; derived from `eshell-flatten-list'. -(defun tramp-compat-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 (tramp-compat-flatten-list a)) - (nconc new-list (list a)))) - (cdr new-list))) +(define-obsolete-function-alias 'tramp-compat-flatten-list #'flatten-tree "27.1") (provide 'tramp-compat) 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..f7eac75305 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5448,5 +5448,18 @@ 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 elements of TREE. +\(flatten-tree \\='(1 (2 3 (4 5 (6))) 7)) +=> (1 2 3 4 5 6 7)" + (cond ((null tree) nil) + ((consp tree) (append (flatten-tree (car tree)) + (flatten-tree (cdr tree)))) + (t (list tree)))) + +;; 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..a712bb1a85 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -372,5 +372,14 @@ 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 (4 5 (6))) 7)) + '(1 2 3 4 5 6 7))) + (should (equal (flatten-tree 42) + '(42))) + (should (equal (flatten-tree '(1 ("foo" "bar") 2)) + '(1 "foo" "bar" 2)))) + (provide 'subr-tests) ;;; subr-tests.el ends here -- 2.19.1 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 20:12 ` Alex Branham @ 2018-12-10 21:36 ` Stefan Monnier 2018-12-10 23:06 ` Alex Branham 2018-12-10 22:42 ` Basil L. Contovounesios 1 sibling, 1 reply; 19+ messages in thread From: Stefan Monnier @ 2018-12-10 21:36 UTC (permalink / raw) To: Alex Branham; +Cc: 33309, Michael Albinus > -(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))) So this one leaves (1 . 2) alone: (5 nil (1 . 2)) ==> (5 (1 . 2)) but burps on (1 2 . 3) message-flatten-list would likely signal an error on (1 . 2). > -;; `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)))) This one treats car and cdr symetrically: (5 nil (1 . 2)) ==> (5 1 2) > -(defun tramp-compat-flatten-list (args) Copied from eshell-flatten-list, apparently. > -(defun js--flatten-list (list) > - (cl-loop for item in list > - nconc (cond ((consp item) > - (js--flatten-list item)) > - (item (list item))))) This one just drops the non-nil cdr: (5 nil (1 . 2)) ==> (5 1) > +(defun flatten-tree (tree) > + "Take TREE and \"flatten\" it. > +This always returns a list containing all the elements of TREE. > +\(flatten-tree \\='(1 (2 3 (4 5 (6))) 7)) > +=> (1 2 3 4 5 6 7)" I think we should document clearly what should happen with nil and with dotted pairs. > + (cond ((null tree) nil) > + ((consp tree) (append (flatten-tree (car tree)) > + (flatten-tree (cdr tree)))) > + (t (list tree)))) I think testing `null` after (rather than before) `consp` will be marginally more efficient. Stefan ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 21:36 ` Stefan Monnier @ 2018-12-10 23:06 ` Alex Branham 2018-12-11 12:36 ` Stefan Monnier 0 siblings, 1 reply; 19+ messages in thread From: Alex Branham @ 2018-12-10 23:06 UTC (permalink / raw) To: Stefan Monnier; +Cc: 33309, Michael Albinus On Mon 10 Dec 2018 at 15:36, Stefan Monnier <monnier@IRO.UMontreal.CA> wrote: > I think we should document clearly what should happen with nil and with > dotted pairs. Thanks for checking those others. I think it makes sense to completely "flatten" the tree. In other words, combine all dotted pairs. I'm less sure about what to do with nil entries. It looks like most of the existing implementations drop nil elements, so I guess we'll do that? Alex ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 23:06 ` Alex Branham @ 2018-12-11 12:36 ` Stefan Monnier 0 siblings, 0 replies; 19+ messages in thread From: Stefan Monnier @ 2018-12-11 12:36 UTC (permalink / raw) To: Alex Branham; +Cc: 33309, Michael Albinus >> I think we should document clearly what should happen with nil and with >> dotted pairs. > Thanks for checking those others. I think it makes sense to completely > "flatten" the tree. In other words, combine all dotted pairs. I'm less > sure about what to do with nil entries. It looks like most of the > existing implementations drop nil elements, so I guess we'll do that? I don't know: I've never needed to "flatten a tree" (nor know when one might want to do that) and haven't looked at the existing uses either. Stefan ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 20:12 ` Alex Branham 2018-12-10 21:36 ` Stefan Monnier @ 2018-12-10 22:42 ` Basil L. Contovounesios 2018-12-10 23:17 ` Alex Branham 1 sibling, 1 reply; 19+ messages in thread From: Basil L. Contovounesios @ 2018-12-10 22:42 UTC (permalink / raw) To: Alex Branham; +Cc: 33309, Michael Albinus, Stefan Monnier [-- Attachment #1: Type: text/plain, Size: 575 bytes --] [Sorry, Alex, for sending this to you twice - I accidentally made my last message a narrow, rather than wide, reply.] Alex Branham <alex.branham@gmail.com> writes: > Thanks for the feedback, everyone. Thanks for working on this. > Here's a patch that implements `flatten-tree' which always returns a > list and recurses into conses. Given Emacs' recursive limitations, wouldn't an iterative implementation be better? For instance, the following currently blows max-specpdl-size: (length (flatten-tree (make-list 800 nil))) How about something like the following? [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: flatten-tree.diff --] [-- Type: text/x-diff, Size: 851 bytes --] diff --git a/lisp/subr.el b/lisp/subr.el index f7eac75305..3fed3bc436 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5453,10 +5453,15 @@ flatten-tree This always returns a list containing all the elements of TREE. \(flatten-tree \\='(1 (2 3 (4 5 (6))) 7)) => (1 2 3 4 5 6 7)" - (cond ((null tree) nil) - ((consp tree) (append (flatten-tree (car tree)) - (flatten-tree (cdr tree)))) - (t (list tree)))) + (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: [-- Attachment #3: Type: text/plain, Size: 11 bytes --] -- Basil ^ permalink raw reply related [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 22:42 ` Basil L. Contovounesios @ 2018-12-10 23:17 ` Alex Branham 2018-12-10 23:26 ` Basil L. Contovounesios ` (3 more replies) 0 siblings, 4 replies; 19+ messages in thread From: Alex Branham @ 2018-12-10 23:17 UTC (permalink / raw) To: Basil L. Contovounesios; +Cc: 33309, Michael Albinus, Stefan Monnier [-- Attachment #1: Type: text/plain, Size: 498 bytes --] On Mon 10 Dec 2018 at 16:42, Basil L. Contovounesios <contovob@tcd.ie> wrote: > Given Emacs' recursive limitations, wouldn't an iterative implementation > be better? For instance, the following currently blows > max-specpdl-size: Yes, that does seem better, updated patch attached. I also updated the docstring to explicitly state how it handles nil values and dotted pairs. Basil, if you want git author credit, feel free to use yourself as the author since you wrote the function :-) Alex [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-New-function-flatten-tree.patch --] [-- Type: text/x-patch, Size: 20361 bytes --] From 069d1c0fdd6826002ff84084b50e94de20f6fa4d Mon Sep 17 00:00:00 2001 From: Alex Branham <alex.branham@gmail.com> 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/net/tramp-compat.el (tramp-compat-flatten-list): * lisp/lpr.el (lpr-flatten-list): * lisp/gnus/message.el: * 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 Co-authored-by: Basil L. Contovounesios <contovob@tcd.ie> Bug #33309 --- 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/net/tramp-compat.el | 13 +------------ lisp/printing.el | 2 +- lisp/progmodes/js.el | 8 ++------ lisp/subr.el | 20 ++++++++++++++++++++ test/lisp/subr-tests.el | 13 +++++++++++++ 18 files changed, 70 insertions(+), 84 deletions(-) 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/net/tramp-compat.el b/lisp/net/tramp-compat.el index 046966e019..4f99a31e54 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -270,18 +270,7 @@ tramp-compat-use-url-tramp-p (unload-feature 'tramp-loaddefs 'force) (unload-feature 'tramp-compat 'force))) -;; There does not exist a common `flatten-list' yet, this is discussed -;; in Bug#33309. For the time being we implement our own version, -;; derived from `eshell-flatten-list'. -(defun tramp-compat-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 (tramp-compat-flatten-list a)) - (nconc new-list (list a)))) - (cdr new-list))) +(define-obsolete-function-alias 'tramp-compat-flatten-list #'flatten-tree "27.1") (provide 'tramp-compat) 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..52ac475cc6 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5448,5 +5448,25 @@ 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 elements 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)" + (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..6b5682baef 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -372,5 +372,18 @@ 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 '(1 ("foo" "bar") 2)) + '(1 "foo" "bar" 2)))) + (provide 'subr-tests) ;;; subr-tests.el ends here -- 2.19.1 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 23:17 ` Alex Branham @ 2018-12-10 23:26 ` Basil L. Contovounesios 2018-12-10 23:34 ` Stephen Berman ` (2 subsequent siblings) 3 siblings, 0 replies; 19+ messages in thread From: Basil L. Contovounesios @ 2018-12-10 23:26 UTC (permalink / raw) To: Alex Branham; +Cc: 33309, Michael Albinus, Stefan Monnier Alex Branham <alex.branham@gmail.com> writes: > Basil, if you want git author credit, feel free to use yourself as the > author since you wrote the function :-) No need, thanks. :) > diff --git a/lisp/subr.el b/lisp/subr.el > index d3bc007293..52ac475cc6 100644 > --- a/lisp/subr.el > +++ b/lisp/subr.el > @@ -5448,5 +5448,25 @@ 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 elements 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)" > + (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)) Is it just me, or is the indentation a bit off here? Thanks, -- Basil ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 23:17 ` Alex Branham 2018-12-10 23:26 ` Basil L. Contovounesios @ 2018-12-10 23:34 ` Stephen Berman 2018-12-11 8:21 ` Michael Albinus 2018-12-11 8:34 ` martin rudalics 3 siblings, 0 replies; 19+ messages in thread From: Stephen Berman @ 2018-12-10 23:34 UTC (permalink / raw) To: Alex Branham Cc: Basil L. Contovounesios, 33309, Michael Albinus, Stefan Monnier On Mon, 10 Dec 2018 17:17:21 -0600 Alex Branham <alex.branham@gmail.com> wrote: > +(defun flatten-tree (tree) > + "Take TREE and \"flatten\" it. > +This always returns a list containing all the elements of TREE. Aren't the elements of a tree all its nodes, both terminal and non-terminal? If so, then the doc string should say flatten-tree returns all terminal nodes, or leaves, of TREE, shouldn't it? Steve Berman ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 23:17 ` Alex Branham 2018-12-10 23:26 ` Basil L. Contovounesios 2018-12-10 23:34 ` Stephen Berman @ 2018-12-11 8:21 ` Michael Albinus 2018-12-11 8:34 ` martin rudalics 3 siblings, 0 replies; 19+ messages in thread From: Michael Albinus @ 2018-12-11 8:21 UTC (permalink / raw) To: Alex Branham; +Cc: Basil L. Contovounesios, 33309, Stefan Monnier Alex Branham <alex.branham@gmail.com> writes: Hi Alex, > Yes, that does seem better, updated patch attached. I also updated the > docstring to explicitly state how it handles nil values and dotted > pairs. The docstring doesn't say what happens if TREE isn't a list. Something like (flatten-tree 42) => (42) I'm wondering also, whether we shall make removing nil elements optional: (defun flatten-tree (tree &optional omit-nil) ... Or, if we expect that removing nil elements shall be default: (defun flatten-tree (tree &optional keep-nil) ... > 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/net/tramp-compat.el | 13 +------------ > lisp/printing.el | 2 +- > lisp/progmodes/js.el | 8 ++------ > lisp/subr.el | 20 ++++++++++++++++++++ > test/lisp/subr-tests.el | 13 +++++++++++++ I suppose we need also an entry in etc/NEWS and doc/lispref/lists.texi. > diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el > index 046966e019..4f99a31e54 100644 > --- a/lisp/net/tramp-compat.el > +++ b/lisp/net/tramp-compat.el > @@ -270,18 +270,7 @@ tramp-compat-use-url-tramp-p > (unload-feature 'tramp-loaddefs 'force) > (unload-feature 'tramp-compat 'force))) > > -;; There does not exist a common `flatten-list' yet, this is discussed > -;; in Bug#33309. For the time being we implement our own version, > -;; derived from `eshell-flatten-list'. > -(defun tramp-compat-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 (tramp-compat-flatten-list a)) > - (nconc new-list (list a)))) > - (cdr new-list))) > +(define-obsolete-function-alias 'tramp-compat-flatten-list #'flatten-tree "27.1") > > (provide 'tramp-compat) Please don't do this. Tramp must support Emacs back to version 24. Once flatten-tree has hit the git repository, I'll modify tramp-compat.el accordingly. > --- a/test/lisp/subr-tests.el > +++ b/test/lisp/subr-tests.el > @@ -372,5 +372,18 @@ 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 '(1 ("foo" "bar") 2)) > + '(1 "foo" "bar" 2)))) > + > (provide 'subr-tests) > ;;; subr-tests.el ends here I would also add (should (equal (flatten-tree t) '(t))) (should (equal (flatten-tree nil) nil)) > Alex Best regards, Michael. ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: Add flatten-list? 2018-12-10 23:17 ` Alex Branham ` (2 preceding siblings ...) 2018-12-11 8:21 ` Michael Albinus @ 2018-12-11 8:34 ` martin rudalics 3 siblings, 0 replies; 19+ messages in thread From: martin rudalics @ 2018-12-11 8:34 UTC (permalink / raw) To: Alex Branham, Basil L. Contovounesios Cc: 33309, Michael Albinus, Stefan Monnier +(defun flatten-tree (tree) + "Take TREE and \"flatten\" it. +This always returns a list containing all the elements of TREE. +Dotted pairs are flattened as well, and nil elements are removed. Could you please sketch here (1) the expected form of TREE, (2) in which order (pre-order I presume) it is traversed and therefore the resulting list constructed and, as Stephen already asked, (3) which elements of TREE will be included in the resulting list. If applicable, please also tell if there are elements that this function cannot flatten and which they are. Thanks for your work on this, martin ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: [PATCH] flatten-list 2018-11-07 19:46 bug#33309: Add flatten-list? Alex Branham 2018-11-07 20:36 ` Drew Adams @ 2018-12-11 17:36 ` Alex Branham 2018-12-11 20:11 ` Michael Albinus 1 sibling, 1 reply; 19+ messages in thread From: Alex Branham @ 2018-12-11 17:36 UTC (permalink / raw) To: 33309 Cc: Basil L. Contovounesios, Stephen Berman, Michael Albinus, Stefan Monnier [-- Attachment #1: Type: text/plain, Size: 263 bytes --] Thanks everyone for the feedback. I think I took everything into account in this latest (hopefully final) patch. I decided not to include "keep-nil" or something as an optional argument since existing implementations don't seem to need/want nils. Thanks, Alex [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-New-function-flatten-tree.patch --] [-- Type: text/x-patch, Size: 21031 bytes --] From bd967569b11e959c04ab97ac279266bfc0a07797 Mon Sep 17 00:00:00 2001 From: Alex Branham <alex.branham@gmail.com> 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 <contovob@tcd.ie> Bug #33309 --- doc/lispref/lists.texi | 13 +++++++++++++ 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, 97 insertions(+), 72 deletions(-) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 1548dd49b2..48f00cb60a 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -667,6 +667,19 @@ Building Lists their elements). @end defun +@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. When non-nil, KEEP-NIL preserves nil +elements. +@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 [-- Attachment #3: Type: text/plain, Size: 20994 bytes --] From bd967569b11e959c04ab97ac279266bfc0a07797 Mon Sep 17 00:00:00 2001 From: Alex Branham <alex.branham@gmail.com> 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 <contovob@tcd.ie> Bug #33309 --- doc/lispref/lists.texi | 13 +++++++++++++ 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, 97 insertions(+), 72 deletions(-) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 1548dd49b2..48f00cb60a 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -667,6 +667,19 @@ Building Lists their elements). @end defun +@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. When non-nil, KEEP-NIL preserves nil +elements. +@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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* bug#33309: [PATCH] flatten-list 2018-12-11 17:36 ` bug#33309: [PATCH] flatten-list Alex Branham @ 2018-12-11 20:11 ` Michael Albinus 2018-12-11 20:16 ` Alex Branham 0 siblings, 1 reply; 19+ messages in thread From: Michael Albinus @ 2018-12-11 20:11 UTC (permalink / raw) To: Alex Branham Cc: Basil L. Contovounesios, 33309, Stefan Monnier, Stephen Berman Alex Branham <alex.branham@gmail.com> writes: Hi Alex, > I decided not to include "keep-nil" or something as an optional argument > since existing implementations don't seem to need/want nils. [...] > diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi > index 1548dd49b2..48f00cb60a 100644 > --- a/doc/lispref/lists.texi > +++ b/doc/lispref/lists.texi > @@ -667,6 +667,19 @@ Building Lists > their elements). > @end defun > > +@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. When non-nil, KEEP-NIL preserves nil > +elements. > +@end defun Then you shouldn't mention it. Furthermore, pls write "TREE" as "@var{tree}". > Thanks, > Alex Best regards, Michael. ^ permalink raw reply [flat|nested] 19+ messages in thread
* bug#33309: [PATCH] flatten-list 2018-12-11 20:11 ` Michael Albinus @ 2018-12-11 20:16 ` Alex Branham 2018-12-17 11:33 ` Michael Albinus 0 siblings, 1 reply; 19+ messages in thread From: Alex Branham @ 2018-12-11 20:16 UTC (permalink / raw) To: Michael Albinus Cc: Basil L. Contovounesios, 33309, Stefan Monnier, Stephen Berman [-- Attachment #1: Type: text/plain, Size: 236 bytes --] On Tue 11 Dec 2018 at 14:11, Michael Albinus <michael.albinus@gmx.de> wrote: > Then you shouldn't mention it. Ugh, missed that. Sorry. > Furthermore, pls write "TREE" as "@var{tree}". Thanks, changed. Updated patch attached. Alex [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-New-function-flatten-tree.patch --] [-- Type: text/x-patch, Size: 20993 bytes --] From 380c05f87fac0fb62ed6732729e865e1ff375583 Mon Sep 17 00:00:00 2001 From: Alex Branham <alex.branham@gmail.com> 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 <contovob@tcd.ie> 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 [-- Attachment #3: Type: text/plain, Size: 20995 bytes --] From 380c05f87fac0fb62ed6732729e865e1ff375583 Mon Sep 17 00:00:00 2001 From: Alex Branham <alex.branham@gmail.com> 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 <contovob@tcd.ie> 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 ^ permalink raw reply related [flat|nested] 19+ messages in thread
* bug#33309: [PATCH] flatten-list 2018-12-11 20:16 ` Alex Branham @ 2018-12-17 11:33 ` Michael Albinus 0 siblings, 0 replies; 19+ messages in thread From: Michael Albinus @ 2018-12-17 11:33 UTC (permalink / raw) To: Alex Branham Cc: Basil L. Contovounesios, Stephen Berman, 33309-done, Stefan Monnier Version: 27.1 Alex Branham <alex.branham@gmail.com> writes: Hi Alex, > Thanks, changed. Updated patch attached. There haven't been further comments, so I have pushed your patch to master. Tramp is also adapted. Closing the bug. > Alex Best regards, Michael. ^ permalink raw reply [flat|nested] 19+ messages in thread
end of thread, other threads:[~2018-12-17 11:33 UTC | newest] Thread overview: 19+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2018-11-07 19:46 bug#33309: Add flatten-list? Alex Branham 2018-11-07 20:36 ` Drew Adams 2018-11-07 21:19 ` Alex Branham 2018-12-10 8:44 ` Michael Albinus 2018-12-10 17:49 ` Stefan Monnier 2018-12-10 20:12 ` Alex Branham 2018-12-10 21:36 ` Stefan Monnier 2018-12-10 23:06 ` Alex Branham 2018-12-11 12:36 ` Stefan Monnier 2018-12-10 22:42 ` Basil L. Contovounesios 2018-12-10 23:17 ` Alex Branham 2018-12-10 23:26 ` Basil L. Contovounesios 2018-12-10 23:34 ` Stephen Berman 2018-12-11 8:21 ` Michael Albinus 2018-12-11 8:34 ` martin rudalics 2018-12-11 17:36 ` bug#33309: [PATCH] flatten-list Alex Branham 2018-12-11 20:11 ` Michael Albinus 2018-12-11 20:16 ` Alex Branham 2018-12-17 11:33 ` Michael Albinus
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/emacs.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).