From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Alex Branham Newsgroups: gmane.emacs.bugs Subject: bug#33309: [PATCH] flatten-list Date: Tue, 11 Dec 2018 14:16:32 -0600 Message-ID: <87imzzn7j3.fsf@gmail.com> References: <87k1kgm0cl.fsf@gmail.com> <87d0q7esc1.fsf@gmx.de> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1544559320 5507 195.159.176.226 (11 Dec 2018 20:15:20 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 11 Dec 2018 20:15:20 +0000 (UTC) User-Agent: mu4e 1.1.0; emacs 27.0.50 Cc: "Basil L. Contovounesios" , 33309@debbugs.gnu.org, Stefan Monnier , Stephen Berman To: Michael Albinus Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Dec 11 21:15:15 2018 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gWoQy-0001FD-4Q for geb-bug-gnu-emacs@m.gmane.org; Tue, 11 Dec 2018 21:15:13 +0100 Original-Received: from localhost ([::1]:41288 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gWoT4-0005ym-Q4 for geb-bug-gnu-emacs@m.gmane.org; Tue, 11 Dec 2018 15:17:22 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:58378) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gWoSp-0005yK-Sq for bug-gnu-emacs@gnu.org; Tue, 11 Dec 2018 15:17:13 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gWoSk-0008Nh-TL for bug-gnu-emacs@gnu.org; Tue, 11 Dec 2018 15:17:07 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:39960) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gWoSk-0008NQ-GR for bug-gnu-emacs@gnu.org; Tue, 11 Dec 2018 15:17:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1gWoSk-0006hB-0o for bug-gnu-emacs@gnu.org; Tue, 11 Dec 2018 15:17:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Alex Branham Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 11 Dec 2018 20:17:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 33309 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 33309-submit@debbugs.gnu.org id=B33309.154455940825709 (code B ref 33309); Tue, 11 Dec 2018 20:17:01 +0000 Original-Received: (at 33309) by debbugs.gnu.org; 11 Dec 2018 20:16:48 +0000 Original-Received: from localhost ([127.0.0.1]:44218 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gWoSU-0006gY-RH for submit@debbugs.gnu.org; Tue, 11 Dec 2018 15:16:48 -0500 Original-Received: from mail-oi1-f180.google.com ([209.85.167.180]:43469) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gWoSP-0006gC-Aq for 33309@debbugs.gnu.org; Tue, 11 Dec 2018 15:16:44 -0500 Original-Received: by mail-oi1-f180.google.com with SMTP id u18so13099714oie.10 for <33309@debbugs.gnu.org>; Tue, 11 Dec 2018 12:16:41 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=references:user-agent:from:to:cc:subject:in-reply-to:date :message-id:mime-version; bh=Re2xx+uFxxQFhwhPcasolY/QEfKuEdMNzolUotdVUu4=; b=SMl7FpH9V0PpEgqYUIF7ia6A31T4q5b89VAMhHAxb3Vr0brRzg+oOaTkA8XtbAm1YN rxOT3NFUffwB6ubuGahYTip4r6CmAF7ZMWOxyBeXD9c9ozV/tH/6eN8f1r8/SNt/k0qj EgFop0G32ItpB8720Tl6/qGvDHdd08F43fqHKgiD0sPTInrdcdDcqNnq9iT90QOlBhEB WhakeuPGENqE3XrJfYdDm39gzAnNGdgHcNIzywNd4ulcxlfIR//F5R9Apr6gOHyjgXw7 7gvbJ9PFBLniP4IoBT1PesYFniZpCP6vXKjJdRnauvnbSS90onBqvfNL0L4VqYSuIgg1 Nd4g== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:references:user-agent:from:to:cc:subject :in-reply-to:date:message-id:mime-version; bh=Re2xx+uFxxQFhwhPcasolY/QEfKuEdMNzolUotdVUu4=; b=tL7o6WONAb4HTfdTI91Zz7yyHEqwssTIeWtlGu62/y+tCWODlF/Wo5MhQ3sUBrDE0l m9mgbVs/Ei7Q6lKMjNhha3twOpCa3MipkyJ20Xz2q8c6xznGMUsZsgdh69nYQabcMeoX 3IKnX1TdCtuprZFWcjxHKdzbDOWpOORt9U6J+SDgicui/eXyCrsQVMeC/d/ljlGcVS9b 1QjJq9JfyGOxc00yqYINMc8MQIgQJeDIsbRjZukKVmHcAUvADjezxbxIftEnYPrkCb/X lQuDs1xXO26KGxRhD4wxmIv8v4AXjqZA54aRcXQa/bbnKeivVxMFQBtns9VA8MtPvOE4 mm7Q== X-Gm-Message-State: AA+aEWbHpsSzHT0sdXygsUk3RKUTHhPdeA5W68gA4qcFqiHV4P5Qd6sZ c7ecCbtJyzZnVDmFMqxzgpE= X-Google-Smtp-Source: AFSGD/U+nrgk+BCJd43hg5TbNd3nQNCxIW4dwRDg53hGvLi0+vI+OEQcGP7xImn4HMkOVgQ1yjdSfA== X-Received: by 2002:aca:5e85:: with SMTP id s127mr2172701oib.181.1544559395505; Tue, 11 Dec 2018 12:16:35 -0800 (PST) Original-Received: from earth (cpe-70-114-192-208.austin.res.rr.com. [70.114.192.208]) by smtp.gmail.com with ESMTPSA id g138sm10392046oib.26.2018.12.11.12.16.34 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 11 Dec 2018 12:16:34 -0800 (PST) In-reply-to: <87d0q7esc1.fsf@gmx.de> X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:153368 Archived-At: --=-=-= Content-Type: text/plain On Tue 11 Dec 2018 at 14:11, Michael Albinus wrote: > Then you shouldn't mention it. Ugh, missed that. Sorry. > Furthermore, pls write "TREE" as "@var{tree}". Thanks, changed. Updated patch attached. Alex --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-New-function-flatten-tree.patch >From 380c05f87fac0fb62ed6732729e865e1ff375583 Mon Sep 17 00:00:00 2001 From: Alex Branham Date: Mon, 10 Dec 2018 13:19:04 -0600 Subject: [PATCH] New function flatten-tree * lisp/subr.el (flatten-tree): New defun * lisp/subr.el (flatten-list): Alias to `flatten-tree' for discoverability * lisp/progmodes/js.el (js--flatten-list): * lisp/lpr.el (lpr-flatten-list): * lisp/gnus/message.el (message-flatten-list): * lisp/eshell/esh-util.el (eshell-flatten-list): Obsolete in favor of Emacs-wide `flatten-tree' * lisp/progmodes/js.el (js--maybe-join): * lisp/printing.el (pr-switches): * lisp/lpr.el (lpr-print-region): * lisp/gnus/nnimap.el (nnimap-find-wanted-parts): * lisp/gnus/message.el (message-talkative-question): * lisp/gnus/gnus-sum.el (gnus-remove-thread) (gnus-thread-highest-number, gnus-thread-latest-date): * lisp/eshell/esh-util.el (eshell-flatten-and-stringify): * lisp/eshell/esh-opt.el (eshell-eval-using-options): * lisp/eshell/esh-ext.el (eshell-external-command): * lisp/eshell/em-xtra.el (eshell/expr): * lisp/eshell/em-unix.el (eshell/rm, eshell-mvcpln-template) (eshell/cat, eshell/make, eshell-poor-mans-grep, eshell-grep) (eshell/du, eshell/time, eshell/diff, eshell/locate): * lisp/eshell/em-tramp.el (eshell/su, eshell/sudo): * lisp/eshell/em-term.el (eshell-exec-visual): * lisp/eshell/em-dirs.el (eshell-dirs-substitute-cd, eshell/cd): * lisp/eshell/em-basic.el (eshell/printnl): Use new flatten-tree * doc/lispref/lists.texi: Document `flatten-tree' Co-authored-by: Basil L. Contovounesios Bug #33309 --- doc/lispref/lists.texi | 12 ++++++++++++ etc/NEWS | 6 ++++++ lisp/eshell/em-basic.el | 2 +- lisp/eshell/em-dirs.el | 4 ++-- lisp/eshell/em-term.el | 2 +- lisp/eshell/em-tramp.el | 4 ++-- lisp/eshell/em-unix.el | 22 +++++++++++----------- lisp/eshell/em-xtra.el | 2 +- lisp/eshell/esh-ext.el | 2 +- lisp/eshell/esh-opt.el | 4 ++-- lisp/eshell/esh-util.el | 12 ++---------- lisp/gnus/gnus-sum.el | 10 +++++----- lisp/gnus/message.el | 12 ++---------- lisp/gnus/nnimap.el | 2 +- lisp/lpr.el | 20 ++------------------ lisp/printing.el | 2 +- lisp/progmodes/js.el | 8 ++------ lisp/subr.el | 25 +++++++++++++++++++++++++ test/lisp/subr-tests.el | 17 +++++++++++++++++ 19 files changed, 96 insertions(+), 72 deletions(-) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 1548dd49b2..52e3c312d9 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -667,6 +667,18 @@ Building Lists their elements). @end defun +@defun flatten-tree tree +Take @var{tree} and "flatten" it. +This always returns a list containing all the terminal nodes, or +leaves, of @var{tree}. Dotted pairs are flattened as well, and nil +elements are removed. +@end defun + +@example +(flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) + @result{}(1 2 3 4 5 6 7) +@end example + @defun number-sequence from &optional to separation This returns a list of numbers starting with @var{from} and incrementing by @var{separation}, and ending at or just before diff --git a/etc/NEWS b/etc/NEWS index 6ae994d594..0caf123e2d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1343,6 +1343,12 @@ are implemented in C using the Jansson library. ** New function 'ring-resize'. 'ring-resize' can be used to grow or shrink a ring. ++++ +** New function 'flatten-tree'. +'flatten-list' is provided as an alias. These functions take a tree +and 'flatten' it such that the result is a list of all the terminal +nodes. + ** Mailcap --- diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 5201076f48..4a99d83857 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -118,7 +118,7 @@ eshell/echo (defun eshell/printnl (&rest args) "Print out each of the arguments, separated by newlines." - (let ((elems (eshell-flatten-list args))) + (let ((elems (flatten-tree args))) (while elems (eshell-printn (eshell-echo (list (car elems)))) (setq elems (cdr elems))))) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 853382888c..b47f76fbfb 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -259,7 +259,7 @@ eshell-dirs-substitute-cd (if (> (length args) 1) (error "%s: command not found" (car args)) (throw 'eshell-replace-command - (eshell-parse-command "cd" (eshell-flatten-list args))))) + (eshell-parse-command "cd" (flatten-tree args))))) (defun eshell-parse-user-reference () "An argument beginning with ~ is a filename to be expanded." @@ -353,7 +353,7 @@ eshell-find-previous-directory (defun eshell/cd (&rest args) ; all but first ignored "Alias to extend the behavior of `cd'." - (setq args (eshell-flatten-list args)) + (setq args (flatten-tree args)) (let ((path (car args)) (subpath (car (cdr args))) (case-fold-search (eshell-under-windows-p)) diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index ddde47f73d..fdf40cae85 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -175,7 +175,7 @@ eshell-exec-visual (let* (eshell-interpreter-alist (interp (eshell-find-interpreter (car args) (cdr args))) (program (car interp)) - (args (eshell-flatten-list + (args (flatten-tree (eshell-stringify-list (append (cdr interp) (cdr args))))) (term-buf diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 9475f4ed94..f77b84d851 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -62,7 +62,7 @@ eshell/su "Alias \"su\" to call TRAMP. Uses the system su through TRAMP's su method." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((orig-args (copy-tree args))) (eshell-eval-using-options "su" args @@ -100,7 +100,7 @@ eshell/sudo "Alias \"sudo\" to call Tramp. Uses the system sudo through TRAMP's sudo method." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((orig-args (copy-tree args))) (eshell-eval-using-options "sudo" args diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 3aecebc2eb..e46e1c417d 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -231,7 +231,7 @@ eshell/rm This is implemented to call either `delete-file', `kill-buffer', `kill-process', or `unintern', depending on the nature of the argument." - (setq args (eshell-flatten-list args)) + (setq args (flatten-tree args)) (eshell-eval-using-options "rm" args '((?h "help" nil nil "show this usage screen") @@ -481,7 +481,7 @@ eshell-mvcpln-template (error "%s: missing destination file or directory" ,command)) (if (= len 1) (nconc args '("."))) - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (if (and ,(not (equal command "ln")) (string-match eshell-tar-regexp (car (last args))) (or (> (length args) 2) @@ -606,7 +606,7 @@ eshell/cat "Implementation of cat in Lisp. If in a pipeline, or the file is not a regular file, directory or symlink, then revert to the system's definition of cat." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (if (or eshell-in-pipeline-p (catch 'special (dolist (arg args) @@ -670,7 +670,7 @@ eshell/make (compile (concat "make " (eshell-flatten-and-stringify args)))) (throw 'eshell-replace-command (eshell-parse-command "*make" (eshell-stringify-list - (eshell-flatten-list args)))))) + (flatten-tree args)))))) (put 'eshell/make 'eshell-no-numeric-conversions t) @@ -705,7 +705,7 @@ eshell-poor-mans-grep (erase-buffer) (occur-mode) (let ((files (eshell-stringify-list - (eshell-flatten-list (cdr args)))) + (flatten-tree (cdr args)))) (inhibit-redisplay t) string) (when (car args) @@ -750,11 +750,11 @@ eshell-grep (throw 'eshell-replace-command (eshell-parse-command (concat "*" command) (eshell-stringify-list - (eshell-flatten-list args)))) + (flatten-tree args)))) (let* ((args (mapconcat 'identity (mapcar 'shell-quote-argument (eshell-stringify-list - (eshell-flatten-list args))) + (flatten-tree args))) " ")) (cmd (progn (set-text-properties 0 (length args) @@ -876,7 +876,7 @@ eshell-du-sum-directory (defun eshell/du (&rest args) "Implementation of \"du\" in Lisp, passing ARGS." (setq args (if args - (eshell-stringify-list (eshell-flatten-list args)) + (eshell-stringify-list (flatten-tree args)) '("."))) (let ((ext-du (eshell-search-path "du"))) (if (and ext-du @@ -976,7 +976,7 @@ eshell/time (eshell-parse-command (car time-args) ;;; https://lists.gnu.org/r/bug-gnu-emacs/2007-08/msg00205.html (eshell-stringify-list - (eshell-flatten-list (cdr time-args)))))))) + (flatten-tree (cdr time-args)))))))) (defun eshell/whoami (&rest _args) "Make \"whoami\" Tramp aware." @@ -1000,7 +1000,7 @@ nil-blank-string (defun eshell/diff (&rest args) "Alias \"diff\" to call Emacs `diff' function." - (let ((orig-args (eshell-stringify-list (eshell-flatten-list args)))) + (let ((orig-args (eshell-stringify-list (flatten-tree args)))) (if (or eshell-plain-diff-behavior (not (and (eshell-interactive-output-p) (not eshell-in-pipeline-p) @@ -1056,7 +1056,7 @@ eshell/locate (string-match "^-" (car args)))) (throw 'eshell-replace-command (eshell-parse-command "*locate" (eshell-stringify-list - (eshell-flatten-list args)))) + (flatten-tree args)))) (save-selected-window (let ((locate-history-list (list (car args)))) (locate-with-filter (car args) (cadr args)))))) diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index cc84d19854..eb9847c60c 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -51,7 +51,7 @@ eshell/expr "Implementation of expr, using the calc package." (if (not (fboundp 'calc-eval)) (throw 'eshell-replace-command - (eshell-parse-command "*expr" (eshell-flatten-list args))) + (eshell-parse-command "*expr" (flatten-tree args))) ;; to fool the byte-compiler... (let ((func 'calc-eval)) (funcall func (eshell-flatten-and-stringify args))))) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 244cc7ff1f..9e7d8bb608 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -222,7 +222,7 @@ eshell-remote-command (defun eshell-external-command (command args) "Insert output from an external COMMAND, using ARGS." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((interp (eshell-find-interpreter command args diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d7a449450f..69d10b4ccf 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -77,7 +77,7 @@ eshell-eval-using-options arguments. :preserve-args - If present, do not pass MACRO-ARGS through `eshell-flatten-list' + If present, do not pass MACRO-ARGS through `flatten-tree' and `eshell-stringify-list'. :parse-leading-options-only @@ -106,7 +106,7 @@ eshell-eval-using-options ,(if (memq ':preserve-args (cadr options)) macro-args (list 'eshell-stringify-list - (list 'eshell-flatten-list macro-args)))) + (list 'flatten-tree macro-args)))) (processed-args (eshell--do-opts ,name ,options temp-args)) ,@(delete-dups (delq nil (mapcar (lambda (opt) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 8fe8c461fd..b55f873380 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -285,15 +285,7 @@ eshell-for ,@forms) (setq list-iter (cdr list-iter))))) -(defun eshell-flatten-list (args) - "Flatten any lists within ARGS, so that there are no sublists." - (let ((new-list (list t))) - (dolist (a args) - (if (and (listp a) - (listp (cdr a))) - (nconc new-list (eshell-flatten-list a)) - (nconc new-list (list a)))) - (cdr new-list))) +(define-obsolete-function-alias 'eshell-flatten-list #'flatten-tree "27.1") (defun eshell-uniquify-list (l) "Remove occurring multiples in L. You probably want to sort first." @@ -330,7 +322,7 @@ eshell-stringify-list (defsubst eshell-flatten-and-stringify (&rest args) "Flatten and stringify all of the ARGS into a single string." - (mapconcat 'eshell-stringify (eshell-flatten-list args) " ")) + (mapconcat 'eshell-stringify (flatten-tree args) " ")) (defsubst eshell-directory-files (regexp &optional directory) "Return a list of files in the given DIRECTORY matching REGEXP." diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4baf4bc826..3f5362ba17 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4773,7 +4773,7 @@ gnus-remove-thread (let (headers thread last-id) ;; First go up in this thread until we find the root. (setq last-id (gnus-root-id id) - headers (message-flatten-list (gnus-id-to-thread last-id))) + headers (flatten-tree (gnus-id-to-thread last-id))) ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. @@ -5069,7 +5069,7 @@ gnus-thread-highest-number "Return the highest article number in THREAD." (apply 'max (mapcar (lambda (header) (mail-header-number header)) - (message-flatten-list thread)))) + (flatten-tree thread)))) (defun gnus-article-sort-by-most-recent-date (h1 h2) "Sort articles by number." @@ -5087,9 +5087,9 @@ gnus-thread-latest-date "Return the highest article date in THREAD." (apply 'max (mapcar (lambda (header) (float-time - (gnus-date-get-time - (mail-header-date header)))) - (message-flatten-list thread)))) + (gnus-date-get-time + (mail-header-date header)))) + (flatten-tree thread)))) (defun gnus-thread-total-score-1 (root) ;; This function find the total score of the thread below ROOT. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fdaa4e8272..03f80616d9 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8051,7 +8051,7 @@ message-talkative-question If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer. The following arguments may contain lists of values." (if (and show - (setq text (message-flatten-list text))) + (setq text (flatten-tree text))) (save-window-excursion (with-output-to-temp-buffer " *MESSAGE information message*" (with-current-buffer " *MESSAGE information message*" @@ -8061,15 +8061,7 @@ message-talkative-question (funcall ask question)) (funcall ask question))) -(defun message-flatten-list (list) - "Return a new, flat list that contains all elements of LIST. - -\(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7)) -=> (1 2 3 4 5 6 7)" - (cond ((consp list) - (apply 'append (mapcar 'message-flatten-list list))) - (list - (list list)))) +(define-obsolete-function-alias 'message-flatten-list #'flatten-tree "27.1") (defun message-generate-new-buffer-clone-locals (name &optional varstr) "Create and return a buffer with name based on NAME using `generate-new-buffer'. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 1a3b05ddb3..adbce25530 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -804,7 +804,7 @@ nnimap-insert-partial-structure (insert "\n--" boundary "--\n"))) (defun nnimap-find-wanted-parts (structure) - (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) + (flatten-tree (nnimap-find-wanted-parts-1 structure ""))) (defun nnimap-find-wanted-parts-1 (structure prefix) (let ((num 1) diff --git a/lisp/lpr.el b/lisp/lpr.el index 33b8da8d76..969b57d644 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -258,7 +258,7 @@ print-region-1 (defun lpr-print-region (start end switches name) (let ((buf (current-buffer)) - (nswitches (lpr-flatten-list + (nswitches (flatten-tree (mapcar #'lpr-eval-switch ; Dynamic evaluation switches))) (switch-string (if switches @@ -336,23 +336,7 @@ lpr-eval-switch ((consp arg) (apply (car arg) (cdr arg))) (t nil))) -;; `lpr-flatten-list' is defined here (copied from "message.el" and -;; enhanced to handle dotted pairs as well) until we can get some -;; sensible autoloads, or `flatten-list' gets put somewhere decent. - -;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j)) -;; => (a b c d e f g h i j) - -(defun lpr-flatten-list (&rest list) - (lpr-flatten-list-1 list)) - -(defun lpr-flatten-list-1 (list) - (cond - ((null list) nil) - ((consp list) - (append (lpr-flatten-list-1 (car list)) - (lpr-flatten-list-1 (cdr list)))) - (t (list list)))) +(define-obsolete-function-alias 'lpr-flatten-list #'flatten-tree "27.1") (provide 'lpr) diff --git a/lisp/printing.el b/lisp/printing.el index 2fc2323028..c1a73df14c 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -5672,7 +5672,7 @@ pr-switches-string (defun pr-switches (switches mess) (or (listp switches) (error "%S should have a list of strings" mess)) - (lpr-flatten-list ; dynamic evaluation + (flatten-tree ; dynamic evaluation (mapcar #'lpr-eval-switch switches))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index cec48a82a2..ddba7636b4 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -623,11 +623,7 @@ js--state-at-last-parse-pos "Parse state at `js--last-parse-pos'.") (make-variable-buffer-local 'js--state-at-last-parse-pos) -(defun js--flatten-list (list) - (cl-loop for item in list - nconc (cond ((consp item) - (js--flatten-list item)) - (item (list item))))) +(define-obsolete-function-alias 'js--flatten-list #'flatten-tree "27.1") (defun js--maybe-join (prefix separator suffix &rest list) "Helper function for `js--update-quick-match-re'. @@ -636,7 +632,7 @@ js--maybe-join with SUFFIX as with `concat'. Otherwise, if LIST is empty, return nil. If any element in LIST is itself a list, flatten that element." - (setq list (js--flatten-list list)) + (setq list (flatten-tree list)) (when list (concat prefix (mapconcat #'identity list separator) suffix))) diff --git a/lisp/subr.el b/lisp/subr.el index d3bc007293..7a7c175db4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5448,5 +5448,30 @@ unmsys--file-name (setq file (concat (substring file 1 2) ":" (substring file 2)))) file) +(defun flatten-tree (tree) + "Take TREE and \"flatten\" it. +This always returns a list containing all the terminal nodes, or +\"leaves\", of TREE. Dotted pairs are flattened as well, and nil +elements are removed. + +\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7)) +=> (1 2 3 4 5 6 7) + +TREE can be anything that can be made into a list. For each +element in TREE, if it is a cons cell return its car +recursively. Otherwise return the element." + (let (elems) + (setq tree (list tree)) + (while (let ((elem (pop tree))) + (cond ((consp elem) + (setq tree (cons (car elem) (cons (cdr elem) tree)))) + (elem + (push elem elems))) + tree)) + (nreverse elems))) + +;; Technically, `flatten-list' is a misnomer, but we provide it here +;; for discoverability: +(defalias 'flatten-list 'flatten-tree) ;;; subr.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index f218a7663e..08f9a697a3 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -372,5 +372,22 @@ subr-test--frames-1 (shell-quote-argument "%ca%"))) "without-caret %ca%")))) +(ert-deftest subr-tests-flatten-tree () + "Test `flatten-tree' behavior." + (should (equal (flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) + '(1 2 3 4 5 6 7))) + (should (equal (flatten-tree '((1 . 2))) + '(1 2))) + (should (equal (flatten-tree '(1 nil 2)) + '(1 2))) + (should (equal (flatten-tree 42) + '(42))) + (should (equal (flatten-tree t) + '(t))) + (should (equal (flatten-tree nil) + nil)) + (should (equal (flatten-tree '(1 ("foo" "bar") 2)) + '(1 "foo" "bar" 2)))) + (provide 'subr-tests) ;;; subr-tests.el ends here -- 2.19.1 --=-=-= Content-Type: text/plain >From 380c05f87fac0fb62ed6732729e865e1ff375583 Mon Sep 17 00:00:00 2001 From: Alex Branham Date: Mon, 10 Dec 2018 13:19:04 -0600 Subject: [PATCH] New function flatten-tree * lisp/subr.el (flatten-tree): New defun * lisp/subr.el (flatten-list): Alias to `flatten-tree' for discoverability * lisp/progmodes/js.el (js--flatten-list): * lisp/lpr.el (lpr-flatten-list): * lisp/gnus/message.el (message-flatten-list): * lisp/eshell/esh-util.el (eshell-flatten-list): Obsolete in favor of Emacs-wide `flatten-tree' * lisp/progmodes/js.el (js--maybe-join): * lisp/printing.el (pr-switches): * lisp/lpr.el (lpr-print-region): * lisp/gnus/nnimap.el (nnimap-find-wanted-parts): * lisp/gnus/message.el (message-talkative-question): * lisp/gnus/gnus-sum.el (gnus-remove-thread) (gnus-thread-highest-number, gnus-thread-latest-date): * lisp/eshell/esh-util.el (eshell-flatten-and-stringify): * lisp/eshell/esh-opt.el (eshell-eval-using-options): * lisp/eshell/esh-ext.el (eshell-external-command): * lisp/eshell/em-xtra.el (eshell/expr): * lisp/eshell/em-unix.el (eshell/rm, eshell-mvcpln-template) (eshell/cat, eshell/make, eshell-poor-mans-grep, eshell-grep) (eshell/du, eshell/time, eshell/diff, eshell/locate): * lisp/eshell/em-tramp.el (eshell/su, eshell/sudo): * lisp/eshell/em-term.el (eshell-exec-visual): * lisp/eshell/em-dirs.el (eshell-dirs-substitute-cd, eshell/cd): * lisp/eshell/em-basic.el (eshell/printnl): Use new flatten-tree * doc/lispref/lists.texi: Document `flatten-tree' Co-authored-by: Basil L. Contovounesios Bug #33309 --- doc/lispref/lists.texi | 12 ++++++++++++ etc/NEWS | 6 ++++++ lisp/eshell/em-basic.el | 2 +- lisp/eshell/em-dirs.el | 4 ++-- lisp/eshell/em-term.el | 2 +- lisp/eshell/em-tramp.el | 4 ++-- lisp/eshell/em-unix.el | 22 +++++++++++----------- lisp/eshell/em-xtra.el | 2 +- lisp/eshell/esh-ext.el | 2 +- lisp/eshell/esh-opt.el | 4 ++-- lisp/eshell/esh-util.el | 12 ++---------- lisp/gnus/gnus-sum.el | 10 +++++----- lisp/gnus/message.el | 12 ++---------- lisp/gnus/nnimap.el | 2 +- lisp/lpr.el | 20 ++------------------ lisp/printing.el | 2 +- lisp/progmodes/js.el | 8 ++------ lisp/subr.el | 25 +++++++++++++++++++++++++ test/lisp/subr-tests.el | 17 +++++++++++++++++ 19 files changed, 96 insertions(+), 72 deletions(-) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 1548dd49b2..52e3c312d9 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -667,6 +667,18 @@ Building Lists their elements). @end defun +@defun flatten-tree tree +Take @var{tree} and "flatten" it. +This always returns a list containing all the terminal nodes, or +leaves, of @var{tree}. Dotted pairs are flattened as well, and nil +elements are removed. +@end defun + +@example +(flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) + @result{}(1 2 3 4 5 6 7) +@end example + @defun number-sequence from &optional to separation This returns a list of numbers starting with @var{from} and incrementing by @var{separation}, and ending at or just before diff --git a/etc/NEWS b/etc/NEWS index 6ae994d594..0caf123e2d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1343,6 +1343,12 @@ are implemented in C using the Jansson library. ** New function 'ring-resize'. 'ring-resize' can be used to grow or shrink a ring. ++++ +** New function 'flatten-tree'. +'flatten-list' is provided as an alias. These functions take a tree +and 'flatten' it such that the result is a list of all the terminal +nodes. + ** Mailcap --- diff --git a/lisp/eshell/em-basic.el b/lisp/eshell/em-basic.el index 5201076f48..4a99d83857 100644 --- a/lisp/eshell/em-basic.el +++ b/lisp/eshell/em-basic.el @@ -118,7 +118,7 @@ eshell/echo (defun eshell/printnl (&rest args) "Print out each of the arguments, separated by newlines." - (let ((elems (eshell-flatten-list args))) + (let ((elems (flatten-tree args))) (while elems (eshell-printn (eshell-echo (list (car elems)))) (setq elems (cdr elems))))) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 853382888c..b47f76fbfb 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -259,7 +259,7 @@ eshell-dirs-substitute-cd (if (> (length args) 1) (error "%s: command not found" (car args)) (throw 'eshell-replace-command - (eshell-parse-command "cd" (eshell-flatten-list args))))) + (eshell-parse-command "cd" (flatten-tree args))))) (defun eshell-parse-user-reference () "An argument beginning with ~ is a filename to be expanded." @@ -353,7 +353,7 @@ eshell-find-previous-directory (defun eshell/cd (&rest args) ; all but first ignored "Alias to extend the behavior of `cd'." - (setq args (eshell-flatten-list args)) + (setq args (flatten-tree args)) (let ((path (car args)) (subpath (car (cdr args))) (case-fold-search (eshell-under-windows-p)) diff --git a/lisp/eshell/em-term.el b/lisp/eshell/em-term.el index ddde47f73d..fdf40cae85 100644 --- a/lisp/eshell/em-term.el +++ b/lisp/eshell/em-term.el @@ -175,7 +175,7 @@ eshell-exec-visual (let* (eshell-interpreter-alist (interp (eshell-find-interpreter (car args) (cdr args))) (program (car interp)) - (args (eshell-flatten-list + (args (flatten-tree (eshell-stringify-list (append (cdr interp) (cdr args))))) (term-buf diff --git a/lisp/eshell/em-tramp.el b/lisp/eshell/em-tramp.el index 9475f4ed94..f77b84d851 100644 --- a/lisp/eshell/em-tramp.el +++ b/lisp/eshell/em-tramp.el @@ -62,7 +62,7 @@ eshell/su "Alias \"su\" to call TRAMP. Uses the system su through TRAMP's su method." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((orig-args (copy-tree args))) (eshell-eval-using-options "su" args @@ -100,7 +100,7 @@ eshell/sudo "Alias \"sudo\" to call Tramp. Uses the system sudo through TRAMP's sudo method." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((orig-args (copy-tree args))) (eshell-eval-using-options "sudo" args diff --git a/lisp/eshell/em-unix.el b/lisp/eshell/em-unix.el index 3aecebc2eb..e46e1c417d 100644 --- a/lisp/eshell/em-unix.el +++ b/lisp/eshell/em-unix.el @@ -231,7 +231,7 @@ eshell/rm This is implemented to call either `delete-file', `kill-buffer', `kill-process', or `unintern', depending on the nature of the argument." - (setq args (eshell-flatten-list args)) + (setq args (flatten-tree args)) (eshell-eval-using-options "rm" args '((?h "help" nil nil "show this usage screen") @@ -481,7 +481,7 @@ eshell-mvcpln-template (error "%s: missing destination file or directory" ,command)) (if (= len 1) (nconc args '("."))) - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (if (and ,(not (equal command "ln")) (string-match eshell-tar-regexp (car (last args))) (or (> (length args) 2) @@ -606,7 +606,7 @@ eshell/cat "Implementation of cat in Lisp. If in a pipeline, or the file is not a regular file, directory or symlink, then revert to the system's definition of cat." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (if (or eshell-in-pipeline-p (catch 'special (dolist (arg args) @@ -670,7 +670,7 @@ eshell/make (compile (concat "make " (eshell-flatten-and-stringify args)))) (throw 'eshell-replace-command (eshell-parse-command "*make" (eshell-stringify-list - (eshell-flatten-list args)))))) + (flatten-tree args)))))) (put 'eshell/make 'eshell-no-numeric-conversions t) @@ -705,7 +705,7 @@ eshell-poor-mans-grep (erase-buffer) (occur-mode) (let ((files (eshell-stringify-list - (eshell-flatten-list (cdr args)))) + (flatten-tree (cdr args)))) (inhibit-redisplay t) string) (when (car args) @@ -750,11 +750,11 @@ eshell-grep (throw 'eshell-replace-command (eshell-parse-command (concat "*" command) (eshell-stringify-list - (eshell-flatten-list args)))) + (flatten-tree args)))) (let* ((args (mapconcat 'identity (mapcar 'shell-quote-argument (eshell-stringify-list - (eshell-flatten-list args))) + (flatten-tree args))) " ")) (cmd (progn (set-text-properties 0 (length args) @@ -876,7 +876,7 @@ eshell-du-sum-directory (defun eshell/du (&rest args) "Implementation of \"du\" in Lisp, passing ARGS." (setq args (if args - (eshell-stringify-list (eshell-flatten-list args)) + (eshell-stringify-list (flatten-tree args)) '("."))) (let ((ext-du (eshell-search-path "du"))) (if (and ext-du @@ -976,7 +976,7 @@ eshell/time (eshell-parse-command (car time-args) ;;; https://lists.gnu.org/r/bug-gnu-emacs/2007-08/msg00205.html (eshell-stringify-list - (eshell-flatten-list (cdr time-args)))))))) + (flatten-tree (cdr time-args)))))))) (defun eshell/whoami (&rest _args) "Make \"whoami\" Tramp aware." @@ -1000,7 +1000,7 @@ nil-blank-string (defun eshell/diff (&rest args) "Alias \"diff\" to call Emacs `diff' function." - (let ((orig-args (eshell-stringify-list (eshell-flatten-list args)))) + (let ((orig-args (eshell-stringify-list (flatten-tree args)))) (if (or eshell-plain-diff-behavior (not (and (eshell-interactive-output-p) (not eshell-in-pipeline-p) @@ -1056,7 +1056,7 @@ eshell/locate (string-match "^-" (car args)))) (throw 'eshell-replace-command (eshell-parse-command "*locate" (eshell-stringify-list - (eshell-flatten-list args)))) + (flatten-tree args)))) (save-selected-window (let ((locate-history-list (list (car args)))) (locate-with-filter (car args) (cadr args)))))) diff --git a/lisp/eshell/em-xtra.el b/lisp/eshell/em-xtra.el index cc84d19854..eb9847c60c 100644 --- a/lisp/eshell/em-xtra.el +++ b/lisp/eshell/em-xtra.el @@ -51,7 +51,7 @@ eshell/expr "Implementation of expr, using the calc package." (if (not (fboundp 'calc-eval)) (throw 'eshell-replace-command - (eshell-parse-command "*expr" (eshell-flatten-list args))) + (eshell-parse-command "*expr" (flatten-tree args))) ;; to fool the byte-compiler... (let ((func 'calc-eval)) (funcall func (eshell-flatten-and-stringify args))))) diff --git a/lisp/eshell/esh-ext.el b/lisp/eshell/esh-ext.el index 244cc7ff1f..9e7d8bb608 100644 --- a/lisp/eshell/esh-ext.el +++ b/lisp/eshell/esh-ext.el @@ -222,7 +222,7 @@ eshell-remote-command (defun eshell-external-command (command args) "Insert output from an external COMMAND, using ARGS." - (setq args (eshell-stringify-list (eshell-flatten-list args))) + (setq args (eshell-stringify-list (flatten-tree args))) (let ((interp (eshell-find-interpreter command args diff --git a/lisp/eshell/esh-opt.el b/lisp/eshell/esh-opt.el index d7a449450f..69d10b4ccf 100644 --- a/lisp/eshell/esh-opt.el +++ b/lisp/eshell/esh-opt.el @@ -77,7 +77,7 @@ eshell-eval-using-options arguments. :preserve-args - If present, do not pass MACRO-ARGS through `eshell-flatten-list' + If present, do not pass MACRO-ARGS through `flatten-tree' and `eshell-stringify-list'. :parse-leading-options-only @@ -106,7 +106,7 @@ eshell-eval-using-options ,(if (memq ':preserve-args (cadr options)) macro-args (list 'eshell-stringify-list - (list 'eshell-flatten-list macro-args)))) + (list 'flatten-tree macro-args)))) (processed-args (eshell--do-opts ,name ,options temp-args)) ,@(delete-dups (delq nil (mapcar (lambda (opt) diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 8fe8c461fd..b55f873380 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -285,15 +285,7 @@ eshell-for ,@forms) (setq list-iter (cdr list-iter))))) -(defun eshell-flatten-list (args) - "Flatten any lists within ARGS, so that there are no sublists." - (let ((new-list (list t))) - (dolist (a args) - (if (and (listp a) - (listp (cdr a))) - (nconc new-list (eshell-flatten-list a)) - (nconc new-list (list a)))) - (cdr new-list))) +(define-obsolete-function-alias 'eshell-flatten-list #'flatten-tree "27.1") (defun eshell-uniquify-list (l) "Remove occurring multiples in L. You probably want to sort first." @@ -330,7 +322,7 @@ eshell-stringify-list (defsubst eshell-flatten-and-stringify (&rest args) "Flatten and stringify all of the ARGS into a single string." - (mapconcat 'eshell-stringify (eshell-flatten-list args) " ")) + (mapconcat 'eshell-stringify (flatten-tree args) " ")) (defsubst eshell-directory-files (regexp &optional directory) "Return a list of files in the given DIRECTORY matching REGEXP." diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 4baf4bc826..3f5362ba17 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -4773,7 +4773,7 @@ gnus-remove-thread (let (headers thread last-id) ;; First go up in this thread until we find the root. (setq last-id (gnus-root-id id) - headers (message-flatten-list (gnus-id-to-thread last-id))) + headers (flatten-tree (gnus-id-to-thread last-id))) ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. @@ -5069,7 +5069,7 @@ gnus-thread-highest-number "Return the highest article number in THREAD." (apply 'max (mapcar (lambda (header) (mail-header-number header)) - (message-flatten-list thread)))) + (flatten-tree thread)))) (defun gnus-article-sort-by-most-recent-date (h1 h2) "Sort articles by number." @@ -5087,9 +5087,9 @@ gnus-thread-latest-date "Return the highest article date in THREAD." (apply 'max (mapcar (lambda (header) (float-time - (gnus-date-get-time - (mail-header-date header)))) - (message-flatten-list thread)))) + (gnus-date-get-time + (mail-header-date header)))) + (flatten-tree thread)))) (defun gnus-thread-total-score-1 (root) ;; This function find the total score of the thread below ROOT. diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index fdaa4e8272..03f80616d9 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8051,7 +8051,7 @@ message-talkative-question If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer. The following arguments may contain lists of values." (if (and show - (setq text (message-flatten-list text))) + (setq text (flatten-tree text))) (save-window-excursion (with-output-to-temp-buffer " *MESSAGE information message*" (with-current-buffer " *MESSAGE information message*" @@ -8061,15 +8061,7 @@ message-talkative-question (funcall ask question)) (funcall ask question))) -(defun message-flatten-list (list) - "Return a new, flat list that contains all elements of LIST. - -\(message-flatten-list \\='(1 (2 3 (4 5 (6))) 7)) -=> (1 2 3 4 5 6 7)" - (cond ((consp list) - (apply 'append (mapcar 'message-flatten-list list))) - (list - (list list)))) +(define-obsolete-function-alias 'message-flatten-list #'flatten-tree "27.1") (defun message-generate-new-buffer-clone-locals (name &optional varstr) "Create and return a buffer with name based on NAME using `generate-new-buffer'. diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 1a3b05ddb3..adbce25530 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -804,7 +804,7 @@ nnimap-insert-partial-structure (insert "\n--" boundary "--\n"))) (defun nnimap-find-wanted-parts (structure) - (message-flatten-list (nnimap-find-wanted-parts-1 structure ""))) + (flatten-tree (nnimap-find-wanted-parts-1 structure ""))) (defun nnimap-find-wanted-parts-1 (structure prefix) (let ((num 1) diff --git a/lisp/lpr.el b/lisp/lpr.el index 33b8da8d76..969b57d644 100644 --- a/lisp/lpr.el +++ b/lisp/lpr.el @@ -258,7 +258,7 @@ print-region-1 (defun lpr-print-region (start end switches name) (let ((buf (current-buffer)) - (nswitches (lpr-flatten-list + (nswitches (flatten-tree (mapcar #'lpr-eval-switch ; Dynamic evaluation switches))) (switch-string (if switches @@ -336,23 +336,7 @@ lpr-eval-switch ((consp arg) (apply (car arg) (cdr arg))) (t nil))) -;; `lpr-flatten-list' is defined here (copied from "message.el" and -;; enhanced to handle dotted pairs as well) until we can get some -;; sensible autoloads, or `flatten-list' gets put somewhere decent. - -;; (lpr-flatten-list '((a . b) c (d . e) (f g h) i . j)) -;; => (a b c d e f g h i j) - -(defun lpr-flatten-list (&rest list) - (lpr-flatten-list-1 list)) - -(defun lpr-flatten-list-1 (list) - (cond - ((null list) nil) - ((consp list) - (append (lpr-flatten-list-1 (car list)) - (lpr-flatten-list-1 (cdr list)))) - (t (list list)))) +(define-obsolete-function-alias 'lpr-flatten-list #'flatten-tree "27.1") (provide 'lpr) diff --git a/lisp/printing.el b/lisp/printing.el index 2fc2323028..c1a73df14c 100644 --- a/lisp/printing.el +++ b/lisp/printing.el @@ -5672,7 +5672,7 @@ pr-switches-string (defun pr-switches (switches mess) (or (listp switches) (error "%S should have a list of strings" mess)) - (lpr-flatten-list ; dynamic evaluation + (flatten-tree ; dynamic evaluation (mapcar #'lpr-eval-switch switches))) diff --git a/lisp/progmodes/js.el b/lisp/progmodes/js.el index cec48a82a2..ddba7636b4 100644 --- a/lisp/progmodes/js.el +++ b/lisp/progmodes/js.el @@ -623,11 +623,7 @@ js--state-at-last-parse-pos "Parse state at `js--last-parse-pos'.") (make-variable-buffer-local 'js--state-at-last-parse-pos) -(defun js--flatten-list (list) - (cl-loop for item in list - nconc (cond ((consp item) - (js--flatten-list item)) - (item (list item))))) +(define-obsolete-function-alias 'js--flatten-list #'flatten-tree "27.1") (defun js--maybe-join (prefix separator suffix &rest list) "Helper function for `js--update-quick-match-re'. @@ -636,7 +632,7 @@ js--maybe-join with SUFFIX as with `concat'. Otherwise, if LIST is empty, return nil. If any element in LIST is itself a list, flatten that element." - (setq list (js--flatten-list list)) + (setq list (flatten-tree list)) (when list (concat prefix (mapconcat #'identity list separator) suffix))) diff --git a/lisp/subr.el b/lisp/subr.el index d3bc007293..7a7c175db4 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -5448,5 +5448,30 @@ unmsys--file-name (setq file (concat (substring file 1 2) ":" (substring file 2)))) file) +(defun flatten-tree (tree) + "Take TREE and \"flatten\" it. +This always returns a list containing all the terminal nodes, or +\"leaves\", of TREE. Dotted pairs are flattened as well, and nil +elements are removed. + +\(flatten-tree \\='(1 (2 . 3) nil (4 5 (6)) 7)) +=> (1 2 3 4 5 6 7) + +TREE can be anything that can be made into a list. For each +element in TREE, if it is a cons cell return its car +recursively. Otherwise return the element." + (let (elems) + (setq tree (list tree)) + (while (let ((elem (pop tree))) + (cond ((consp elem) + (setq tree (cons (car elem) (cons (cdr elem) tree)))) + (elem + (push elem elems))) + tree)) + (nreverse elems))) + +;; Technically, `flatten-list' is a misnomer, but we provide it here +;; for discoverability: +(defalias 'flatten-list 'flatten-tree) ;;; subr.el ends here diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index f218a7663e..08f9a697a3 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -372,5 +372,22 @@ subr-test--frames-1 (shell-quote-argument "%ca%"))) "without-caret %ca%")))) +(ert-deftest subr-tests-flatten-tree () + "Test `flatten-tree' behavior." + (should (equal (flatten-tree '(1 (2 . 3) nil (4 5 (6)) 7)) + '(1 2 3 4 5 6 7))) + (should (equal (flatten-tree '((1 . 2))) + '(1 2))) + (should (equal (flatten-tree '(1 nil 2)) + '(1 2))) + (should (equal (flatten-tree 42) + '(42))) + (should (equal (flatten-tree t) + '(t))) + (should (equal (flatten-tree nil) + nil)) + (should (equal (flatten-tree '(1 ("foo" "bar") 2)) + '(1 "foo" "bar" 2)))) + (provide 'subr-tests) ;;; subr-tests.el ends here -- 2.19.1 --=-=-=--