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