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: Add flatten-list? Date: Mon, 10 Dec 2018 17:17:21 -0600 Message-ID: <87pnu9m0ou.fsf@gmail.com> References: <87r2fw7jsa.fsf@gmail.com> <058f4a0f-7ce4-49c4-ae54-0bc259bd82d1@default> <87pnvg7fgg.fsf@gmail.com> <8736r5ojnc.fsf@gmx.de> <87sgz5m98k.fsf@gmail.com> <87tvjl80mx.fsf@tcd.ie> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1544483805 6383 195.159.176.226 (10 Dec 2018 23:16:45 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Mon, 10 Dec 2018 23:16:45 +0000 (UTC) User-Agent: mu4e 1.1.0; emacs 27.0.50 Cc: 33309@debbugs.gnu.org, Michael Albinus , Stefan Monnier To: "Basil L. Contovounesios" Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Dec 11 00:16:40 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 1gWUn1-0001Yk-SO for geb-bug-gnu-emacs@m.gmane.org; Tue, 11 Dec 2018 00:16:40 +0100 Original-Received: from localhost ([::1]:35114 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gWUp8-00022K-Kh for geb-bug-gnu-emacs@m.gmane.org; Mon, 10 Dec 2018 18:18:50 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:42740) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gWUoV-0001lU-JB for bug-gnu-emacs@gnu.org; Mon, 10 Dec 2018 18:18:14 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gWUoN-0002WH-IJ for bug-gnu-emacs@gnu.org; Mon, 10 Dec 2018 18:18:11 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:37981) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gWUoM-0002NH-1T for bug-gnu-emacs@gnu.org; Mon, 10 Dec 2018 18:18:03 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1gWUoL-0002ei-Js for bug-gnu-emacs@gnu.org; Mon, 10 Dec 2018 18:18:01 -0500 X-Loop: help-debbugs@gnu.org Resent-From: Alex Branham Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 10 Dec 2018 23:18: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.154448385310171 (code B ref 33309); Mon, 10 Dec 2018 23:18:01 +0000 Original-Received: (at 33309) by debbugs.gnu.org; 10 Dec 2018 23:17:33 +0000 Original-Received: from localhost ([127.0.0.1]:42239 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gWUns-0002dy-Fs for submit@debbugs.gnu.org; Mon, 10 Dec 2018 18:17:33 -0500 Original-Received: from mail-ot1-f43.google.com ([209.85.210.43]:32894) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gWUnp-0002dk-Vt for 33309@debbugs.gnu.org; Mon, 10 Dec 2018 18:17:31 -0500 Original-Received: by mail-ot1-f43.google.com with SMTP id i20so12238068otl.0 for <33309@debbugs.gnu.org>; Mon, 10 Dec 2018 15:17:29 -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=C5uAi691D9G8NYT2AbIOcWQ9zZsyWrtbPAz/UTsISFE=; b=M6bZbdeK/lhvHgdJ/xl7a7WcemMbkpasuPn30t0Pv1PUj4XfwxGjvFq1err4dAWh0C D1Eq4fwwspz/N9OZTh/R/XYMZgwNu/B6+b0rUN0/F7PXrN94jLAaP8A0jVS/XRrvR7DA 0HAJLu7PEJDmbWJvB2A3pUfDQSE19f4I1449NZ0QGIY/LCkU2kPjiumMWX0q50J1Zpku Vb0CMoQ1huh9vqKRlrJvrf6AGdp0RmXHyPgcmPNCG6n7NrKHkSHzQLTWf8lLKszoSXD1 TDH+RIxAzTP2PlYQJCOQvWbZia52fqdZefaWXVa+3UiJJVSLghKncyxgZWQGavstzzvm mNuw== 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=C5uAi691D9G8NYT2AbIOcWQ9zZsyWrtbPAz/UTsISFE=; b=OokPf1dOua5+OCLrxKMi046H0DFL1bXu0kI28LrTHkzQs9UWnSgOae5/txGPsz61iw 9k6xhy6IUEG0PjnyzF9sPXFjqbzAYrb4uBrxYzN4ntohqxn5fpNRvM+vVAaOYJH7PfNb HBmnj8UfFZR6ej7zwX7zrc2j/KRMvHdrXEXCdX2DmDNvXHGBIN5FsJCFX8uWU9l0mASX u3MvLcJcWXnoK3j4LyUAcN3HIrC/cRWTswbE//cfQ/+oO+JEmHLY9wgJDe3B9xX6nXZU 60HedB2TSsQ+HYV8ngcsyAk7h8lcykxvUgcXMmGAkxCMUGFj+KPzqeyrrhB3CbultDJd yEwA== X-Gm-Message-State: AA+aEWbok0nYP7k9BjP3zRU+flFtrnUk10oDS/suKPvv+VwDCy6cnqOM WUWfPtVt6LM2IsLVZbLK1qw= X-Google-Smtp-Source: AFSGD/U0sXyg9Clh0NbjbcFEUKCyjV5x06th5xixkMuhQLlGv+U+pkZJvIpwgznurbPn0nrZ9mq9lg== X-Received: by 2002:a05:6830:16c2:: with SMTP id l2mr10280779otr.20.1544483844231; Mon, 10 Dec 2018 15:17:24 -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 m129sm6044327oif.50.2018.12.10.15.17.22 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Mon, 10 Dec 2018 15:17:22 -0800 (PST) In-reply-to: <87tvjl80mx.fsf@tcd.ie> 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:153316 Archived-At: --=-=-= Content-Type: text/plain On Mon 10 Dec 2018 at 16:42, Basil L. Contovounesios 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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-New-function-flatten-tree.patch >From 069d1c0fdd6826002ff84084b50e94de20f6fa4d 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/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 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 --=-=-=--