commit 7ac578c57ce14a6f5e4568712ec16ebcbc9cc9ba (HEAD, refs/remotes/origin/master) Author: Yuan Fu Date: Thu Feb 13 21:49:55 2025 -0800 Use a heuristic to support method chaining in c-ts-common Test for "." at the beginning of a line to detect chained method. * lisp/progmodes/c-ts-common.el: (c-ts-common--standalone-predicate): New function. (c-ts-common--standalone-parent): (c-ts-common--prev-standalone-sibling): Use the new heuristic. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 7d3ea76cb1b..c3a965b8e94 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -554,6 +554,32 @@ const a = [ 4, 5, 6, ];") +(defun c-ts-common--standalone-predicate (node) + "Return an anchor if NODE is on the start of a line. + +Return nil if not. Handles method chaining. Caller needs to cal +`save-excursion'." + (goto-char (treesit-node-start node)) + (or (and (looking-back (rx bol (* whitespace) (? ".")) + (line-beginning-position)) + (point)) + ;; The above check is not enough, because often in a method + ;; chaining, the method name is part of a node, and the arg list + ;; is another node: + ;; + ;; func ---> func.method is one node. + ;; .method({ + ;; return 1; ({ return 1; }) is another node + ;; }) + ;; + ;; So when we go up the parse tree, we go through the block + ;; ({...}), then the next parent is already the whole call + ;; expression, and we never stops at the beginning of "method". + ;; Therefore we need this heuristic. + (and (progn (back-to-indentation) + (eq (char-after) ?.)) + (point)))) + (defun c-ts-common--standalone-parent (parent) "Find the first parent that starts on a new line. Start searching from PARENT, so if PARENT satisfies the condition, it'll @@ -574,12 +600,11 @@ for determining standlone line." (catch 'term (while parent (goto-char (treesit-node-start parent)) - (when (if treesit-simple-indent-standalone-predicate - (setq anchor + (when (setq anchor + (if treesit-simple-indent-standalone-predicate (funcall treesit-simple-indent-standalone-predicate - parent)) - (looking-back (rx bol (* whitespace) (? ".")) - (line-beginning-position))) + parent) + (c-ts-common--standalone-predicate parent))) (throw 'term (if (numberp anchor) anchor (point)))) (setq parent (treesit-node-parent parent))))))) @@ -602,13 +627,12 @@ for determining standlone line." (let (anchor) (while (and node (goto-char (treesit-node-start node)) - (not (if treesit-simple-indent-standalone-predicate - (setq anchor + (not (setq anchor + (if treesit-simple-indent-standalone-predicate (funcall treesit-simple-indent-standalone-predicate - node)) - (looking-back (rx bol (* whitespace) (? ".")) - (pos-bol))))) + parent) + (c-ts-common--standalone-predicate parent))))) (setq node (treesit-node-prev-sibling node 'named)))) (if (numberp anchor) anchor (treesit-node-start node)))) commit 34f90bf2cab7c1711136dc055b665e46f714c3e1 Author: Yuan Fu Date: Thu Feb 13 20:47:23 2025 -0800 Allow treesit-simple-indent-standalone-predicate to return anchor * lisp/treesit.el: (treesit-simple-indent-standalone-predicate): Allow it to return an anchor instead of t. (treesit-simple-indent-presets): Supports number. * lisp/progmodes/c-ts-common.el: (c-ts-common--standalone-parent): (c-ts-common--prev-standalone-sibling): Supports number. diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index 404d767cb3a..7d3ea76cb1b 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -569,20 +569,22 @@ chaining like But ff `treesit-simple-indent-standalone-predicate' is non-nil, use that for determining standlone line." - (save-excursion - (catch 'term - (while parent - (goto-char (treesit-node-start parent)) - (when (if treesit-simple-indent-standalone-predicate - (funcall treesit-simple-indent-standalone-predicate - parent) - (looking-back (rx bol (* whitespace) (? ".")) - (line-beginning-position))) - (throw 'term (point))) - (setq parent (treesit-node-parent parent)))))) + (let (anchor) + (save-excursion + (catch 'term + (while parent + (goto-char (treesit-node-start parent)) + (when (if treesit-simple-indent-standalone-predicate + (setq anchor + (funcall treesit-simple-indent-standalone-predicate + parent)) + (looking-back (rx bol (* whitespace) (? ".")) + (line-beginning-position))) + (throw 'term (if (numberp anchor) anchor (point)))) + (setq parent (treesit-node-parent parent))))))) (defun c-ts-common--prev-standalone-sibling (node) - "Return the previous sibling of NODE that starts on a new line. + "Return the start of the previous sibling of NODE that starts on a new line. Return nil if no sibling satisfies the condition. Unlike simple-indent's standalone preset, this function handles method @@ -597,15 +599,18 @@ for determining standlone line." (save-excursion (setq node (treesit-node-prev-sibling node 'named)) (goto-char (treesit-node-start node)) - (while (and node - (goto-char (treesit-node-start node)) - (not (if treesit-simple-indent-standalone-predicate - (funcall treesit-simple-indent-standalone-predicate - node) - (looking-back (rx bol (* whitespace) (? ".")) - (pos-bol))))) - (setq node (treesit-node-prev-sibling node 'named))) - node)) + (let (anchor) + (while (and node + (goto-char (treesit-node-start node)) + (not (if treesit-simple-indent-standalone-predicate + (setq anchor + (funcall + treesit-simple-indent-standalone-predicate + node)) + (looking-back (rx bol (* whitespace) (? ".")) + (pos-bol))))) + (setq node (treesit-node-prev-sibling node 'named)))) + (if (numberp anchor) anchor (treesit-node-start node)))) (defun c-ts-common-parent-ignore-preproc (node) "Return the parent of NODE, skipping preproc nodes." @@ -696,9 +701,8 @@ The rule also handles method chaining like (cons (c-ts-common--standalone-parent parent) offset))) ;; Not first sibling - (t (cons (treesit-node-start - (or (c-ts-common--prev-standalone-sibling node) - first-sibling)) + (t (cons (or (c-ts-common--prev-standalone-sibling node) + (treesit-node-start first-sibling)) 0))))) ;; Condition 2 for initializer list, only apply to ;; second line. Eg, diff --git a/lisp/treesit.el b/lisp/treesit.el index e35efd9b0db..b923545d50c 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1821,7 +1821,8 @@ to be standalone too: }); The value should be a function that takes a node, and return t if it's -standalone.") +standalone. If the function returns a position, that position is used +as the anchor.") (defvar treesit-simple-indent-presets (list (cons 'match @@ -1956,20 +1957,23 @@ standalone.") (goto-char (treesit-node-start parent)) (back-to-indentation) (point)))) - (cons 'standalone-parent - (lambda (_n parent &rest _) - (save-excursion - (catch 'term - (while parent - (goto-char (treesit-node-start parent)) - (when - (if (null treesit-simple-indent-standalone-predicate) - (looking-back (rx bol (* whitespace)) - (line-beginning-position)) - (funcall treesit-simple-indent-standalone-predicate - parent)) - (throw 'term (point))) - (setq parent (treesit-node-parent parent))))))) + (cons + 'standalone-parent + (lambda (_n parent &rest _) + (save-excursion + (let (anchor) + (catch 'term + (while parent + (goto-char (treesit-node-start parent)) + (when (if (null treesit-simple-indent-standalone-predicate) + (looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (setq anchor + (funcall + treesit-simple-indent-standalone-predicate + parent))) + (throw 'term (if (numberp anchor) anchor (point)))) + (setq parent (treesit-node-parent parent)))))))) (cons 'prev-sibling (lambda (node parent bol &rest _) (treesit-node-start (or (treesit-node-prev-sibling node t) commit adabee88730017e81bbb0ee761b6720fd579535d Author: Yuan Fu Date: Thu Feb 13 20:30:09 2025 -0800 ; Fix standalone-parent preset for tree-sitter * lisp/treesit.el (treesit-simple-indent-presets): Fix typo. diff --git a/lisp/treesit.el b/lisp/treesit.el index 39a92f55ebc..e35efd9b0db 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1962,10 +1962,12 @@ standalone.") (catch 'term (while parent (goto-char (treesit-node-start parent)) - (when (if (null treesit-simple-indent-standalone-predicate) - (looking-back (rx bol (* whitespace)) - (line-beginning-position)) - (funcall parent)) + (when + (if (null treesit-simple-indent-standalone-predicate) + (looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (funcall treesit-simple-indent-standalone-predicate + parent)) (throw 'term (point))) (setq parent (treesit-node-parent parent))))))) (cons 'prev-sibling (lambda (node parent bol &rest _) commit 4b020b936c5adf472319d1ea253c85c5ee54135f Author: Yuan Fu Date: Sun Dec 1 18:26:40 2024 -0800 Add treesit-simple-indent-standalone-predicate (bug#74386) * lisp/treesit.el: (treesit-simple-indent-standalone-predicate): New variable. (treesit-simple-indent-presets): Use the predicate. (treesit-simple-indent-presets): Update docstring. * lisp/progmodes/c-ts-common.el: (c-ts-common--standalone-parent): (c-ts-common--prev-standalone-sibling): Use the predicate if non-nil. Also, handle method chaining by default. * doc/lispref/modes.texi (Parser-based Indentation): Add documentation. diff --git a/doc/lispref/modes.texi b/doc/lispref/modes.texi index 1210b3a57c0..6e2a9d8221e 100644 --- a/doc/lispref/modes.texi +++ b/doc/lispref/modes.texi @@ -5416,11 +5416,14 @@ on the line which @var{parent}'s start is on. @item standalone-parent This anchor is a function that is called with 3 arguments: @var{node}, -@var{parent}, and @var{bol}. It finds the first ancestor node -(parent, grandparent, etc.@:) of @var{node} that starts on its own -line, and return the start of that node. ``Starting on its own line'' -means there is only whitespace character before the node on the line -which the node's start is on. +@var{parent}, and @var{bol}. It finds the first ancestor node (parent, +grandparent, etc.@:) of @var{node} that starts on its own line, and +return the start of that node. ``Starting on its own line'' means there +is only whitespace character before the node on the line which the +node's start is on. The exact definition of ``Starting on its own +line'' can be relaxed by setting +@code{treesit-simple-indent-standalone-predicate}, some major mode might +want to do that for easier indentation for method chaining. @item prev-sibling This anchor is a function that is called with 3 arguments: @var{node}, diff --git a/lisp/progmodes/c-ts-common.el b/lisp/progmodes/c-ts-common.el index c9761e8ab1d..404d767cb3a 100644 --- a/lisp/progmodes/c-ts-common.el +++ b/lisp/progmodes/c-ts-common.el @@ -558,26 +558,52 @@ const a = [ "Find the first parent that starts on a new line. Start searching from PARENT, so if PARENT satisfies the condition, it'll be returned. Return the starting position of the parent, return nil if -no parent satisfies the condition." +no parent satisfies the condition. + +Unlike simple-indent's standalone preset, this function handles method +chaining like + + func + .method() <-- Considered standalone even if there's a \".\" in + .method() front of the node. + +But ff `treesit-simple-indent-standalone-predicate' is non-nil, use that +for determining standlone line." (save-excursion (catch 'term (while parent (goto-char (treesit-node-start parent)) - (when (looking-back (rx bol (* whitespace)) - (line-beginning-position)) + (when (if treesit-simple-indent-standalone-predicate + (funcall treesit-simple-indent-standalone-predicate + parent) + (looking-back (rx bol (* whitespace) (? ".")) + (line-beginning-position))) (throw 'term (point))) (setq parent (treesit-node-parent parent)))))) (defun c-ts-common--prev-standalone-sibling (node) "Return the previous sibling of NODE that starts on a new line. -Return nil if no sibling satisfies the condition." +Return nil if no sibling satisfies the condition. + +Unlike simple-indent's standalone preset, this function handles method +chaining like + + func + .method() <-- Considered standalone even if there's a \".\" in + .method() front of the node. + +But ff `treesit-simple-indent-standalone-predicate' is non-nil, use that +for determining standlone line." (save-excursion (setq node (treesit-node-prev-sibling node 'named)) (goto-char (treesit-node-start node)) (while (and node (goto-char (treesit-node-start node)) - (not (looking-back (rx bol (* whitespace)) - (pos-bol)))) + (not (if treesit-simple-indent-standalone-predicate + (funcall treesit-simple-indent-standalone-predicate + node) + (looking-back (rx bol (* whitespace) (? ".")) + (pos-bol))))) (setq node (treesit-node-prev-sibling node 'named))) node)) @@ -629,7 +655,13 @@ This rule tries to be smart and ignore proprocessor node in some situations. By default, any node that has \"proproc\" in its type are considered a preprocessor node. If that heuristic is inaccurate, define a `preproc' thing in `treesit-thing-settings', and this rule will use -the thing definition instead." +the thing definition instead. + +The rule also handles method chaining like + + func + .method() <-- Considered \"starts at a newline\" even if there's + .method() a \".\" in front of the node." (let ((prev-line-node (treesit--indent-prev-line-node bol)) (offset (symbol-value c-ts-common-indent-offset))) (cond diff --git a/lisp/treesit.el b/lisp/treesit.el index e67e2cc43f6..39a92f55ebc 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -1792,6 +1792,37 @@ over `treesit-simple-indent-rules'.") (back-to-indentation) (treesit--indent-largest-node-at (point))))) +(defvar treesit-simple-indent-standalone-predicate nil + "Function used to determine if a node is \"standalone\". + +\"Standalone\" means the node starts on a new line. For example, if we +look at the opening bracket, then it's standalone in this case: + + { <-- Standalone. + return 1; + } + +but not in this case: + + if (true) { <-- Not standalone. + return 1; + } + +The value of this variable affects the `standalone-parent' indent preset +for treesit-simple-indent. If the value is nil, the standlone condition +is as described. Some major mode might want to relax the condition a +little bit, so that it ignores some punctuation like \".\". For +example, a Javascript mode might want to consider the method call below +to be standalone too: + + obj + .method(() => { <-- Consider \".method\" to be standalone, + return 1; <-- so this line anchors on \".method\". + }); + +The value should be a function that takes a node, and return t if it's +standalone.") + (defvar treesit-simple-indent-presets (list (cons 'match (lambda @@ -1931,8 +1962,10 @@ over `treesit-simple-indent-rules'.") (catch 'term (while parent (goto-char (treesit-node-start parent)) - (when (looking-back (rx bol (* whitespace)) - (line-beginning-position)) + (when (if (null treesit-simple-indent-standalone-predicate) + (looking-back (rx bol (* whitespace)) + (line-beginning-position)) + (funcall parent)) (throw 'term (point))) (setq parent (treesit-node-parent parent))))))) (cons 'prev-sibling (lambda (node parent bol &rest _) @@ -2065,7 +2098,10 @@ parent-bol standalone-parent Finds the first ancestor node (parent, grandparent, etc.) that - starts on its own line, and returns the start of that node. + starts on its own line, and returns the start of that node. The + definition of \"standalone\" can be customized by setting + `treesit-simple-indent-standalone-predicate'. Some major mode might + want to do that for easier indentation for method chaining. prev-sibling commit b8c8ae92dba223960b54b5b6e18cce4a11bbf870 Author: Basil L. Contovounesios Date: Sun Feb 2 17:24:14 2025 +0100 Fix uncaught cl-nreconc on constant list * test/lisp/emacs-lisp/cl-extra-tests.el (cl-extra-test-isqrt): Expect most specific error type. (cl-extra-test-nreconc): Pass fresh list as first argument to cl-nreconc. The usual mutates-arguments warning was not emitted, possibly in relation to bug#74920 and cl-nreconc being proclaimed inline. (cl-extra-test-list-length): Simplify using nconc. diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el index e2a0276ae0a..bec4e373201 100644 --- a/test/lisp/emacs-lisp/cl-extra-tests.el +++ b/test/lisp/emacs-lisp/cl-extra-tests.el @@ -220,8 +220,8 @@ (should (equal (cl-isqrt 0) 0)) (should (equal (cl-isqrt 3) 1)) (should (equal (cl-isqrt 10) 3)) - (should-error (cl-isqrt -4)) - (should-error (cl-isqrt 2.5))) + (should-error (cl-isqrt -4) :type 'arith-error) + (should-error (cl-isqrt 2.5) :type 'arith-error)) (ert-deftest cl-extra-test-floor () (should (equal (cl-floor 4.5) '(4 0.5))) @@ -282,13 +282,13 @@ (should (equal (cl-revappend '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) (ert-deftest cl-extra-test-nreconc () - (should (equal (cl-nreconc '(1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) + (should (equal (cl-nreconc (list 1 2 3) '(4 5 6)) '(3 2 1 4 5 6)))) (ert-deftest cl-extra-test-list-length () (should (equal (cl-list-length '(1 2 3)) 3)) (should (equal (cl-list-length '()) 0)) (let ((xl (number-sequence 1 100))) - (setcdr (nthcdr 99 xl) xl) + (nconc xl xl) (should (equal (cl-list-length xl) nil)))) (ert-deftest cl-extra-test-tailp () commit 52034675a2e774fb0f819603f3d3f293fdeb448b Author: Basil L. Contovounesios Date: Sat Jan 25 16:48:19 2025 +0100 Fix cl-seq-tests.el None of the tests using the macro cl-seq--with-side-effects were being evaluated (since bug#24264), and other tests were not robust against destructive operations or optimizations (since bug#24264 and bug#75633). For further discussion, see: https://lists.gnu.org/r/emacs-devel/2025-02/msg00053.html * test/lisp/emacs-lisp/cl-seq-tests.el: Fit first line within 80 columns. Remove empty Commentary section. (cl-union-test-00): Use bug#N reference in place of URL. (cl-seq-test-bug24264): Ditto. Use nconc in place of append. (cl-seq--test-list, cl-seq--test-list2, cl-seq--with-side-effects): Remove. (cl-seq-tests--relet*): New convenience macro replacing the need for cl-seq--with-side-effects. (cl-seq-fill-test, cl-seq-replace-test, cl-seq-delete-test): Use cl-seq-tests--relet* to actually evaluate tests. Avoid mutating quoted literals. (cl-seq-nsubstitute-test): Ditto. Actually call cl-nsubstitute, not cl-substitute. Avoid comparing mutated argument to itself; compare to its original copy instead. Avoid calling cl-position on list that is being mutated in :if predicate; use original copy instead. (cl-seq-remove-test, cl-remove-if-not-test, cl-delete-if-not-test) (cl-delete-duplicates-test, cl-seq-remove-duplicates-test) (cl-seq-substitute-test, cl-seq-substitute-if-test) (cl-seq-position-test, cl-count-if-test, cl-count-if-not-test) (cl-member-if-test, cl-member-if-not-test, cl-assoc-if-test) (cl-assoc-if-not-test, cl-rassoc-if-test, cl-subsetp-test): Simplify. (cl-remove-if-test, cl-seq-substitute-if-not-test, cl-find-if-test) (cl-find-if-not-test, cl-position-if-test, cl-member-test) (cl-assoc-test, cl-rassoc-test): Quote function symbols, not lambdas. (cl-delete-if-test): Use cl-seq-tests--relet*. Check result of cl-delete-if to avoid relying on its side effects, and to pacify byte-compiler warning. (cl-seq-mismatch-test): Avoid 'easy to misread' hidden argument. (cl-seq-search-test): Break long line. (cl-sort-test, cl-stable-sort-test, cl-merge-test): Avoid mutating quoted literals. (cl-intersection-test): Avoid comparing eql-ity of string literals. (cl-nintersection-test, cl-nset-difference-test) (cl-nset-exclusive-or-test): Avoid mutating quoted literals. Don't compare initial and final values of arguments, since they may have been mutated. (cl-set-difference-test, cl-set-exclusive-or-test): Use fresh arguments to check for absence of mutation. diff --git a/test/lisp/emacs-lisp/cl-seq-tests.el b/test/lisp/emacs-lisp/cl-seq-tests.el index 3541a989d34..97276be3870 100644 --- a/test/lisp/emacs-lisp/cl-seq-tests.el +++ b/test/lisp/emacs-lisp/cl-seq-tests.el @@ -1,4 +1,4 @@ -;;; cl-seq-tests.el --- Tests for cl-seq.el functionality -*- lexical-binding: t; -*- +;;; cl-seq-tests.el --- Tests for cl-seq.el -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2025 Free Software Foundation, Inc. @@ -19,15 +19,13 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . -;;; Commentary: - ;;; Code: (require 'ert) (require 'cl-seq) (ert-deftest cl-union-test-00 () - "Test for https://debbugs.gnu.org/22729 ." + "Test for bug#22729." (let ((str1 "foo") (str2 (make-string 3 ?o))) ;; Emacs may make two string literals eql when reading. @@ -36,28 +34,23 @@ (should (equal str1 str2)) (should (equal (cl-union (list str1) (list str2)) (list str2))) - (should (equal (cl-union (list str1) (list str2) :test 'eql) + (should (equal (cl-union (list str1) (list str2) :test #'eql) (list str1 str2))))) -(defvar cl-seq--test-list nil - "List used on `cl-seq' tests with side effects.") -(defvar cl-seq--test-list2 nil - "List used on `cl-seq' tests with side effects.") - -(defmacro cl-seq--with-side-effects (list list2 &rest body) - "Run a test with side effects on lists; after the test restore the lists. -LIST is the value of `cl-seq--test-list' before the test. -LIST2, if non-nil, is the value of `cl-seq--test-list2' before the test. -Body are forms defining the test." - (declare (indent 2) (debug t)) - (let ((orig (make-symbol "orig")) - (orig2 (make-symbol "orig2"))) - `(let ((,orig (copy-sequence ,list)) - (,orig2 (copy-sequence ,list2))) - (unwind-protect (progn ,@body) - (setq cl-seq--test-list ,orig) - (when ,list2 - (setq cl-seq--test-list2 ,orig2)))))) +(defmacro cl-seq-tests--relet* (binders &rest body) + "Like `let*', but reevaluate BINDERS before each form in BODY. +Additionally register an `ert-info' to help identify test failures." + (declare (debug let) (indent 1)) + (let ((syms (mapcar (lambda (binder) + (if (consp binder) (car binder) binder)) + binders))) + (macroexp-progn + (mapcar (lambda (form) + `(ert-info (,(lambda () (pp-to-string form)) :prefix "form: ") + (let* ,binders + ,@(and syms `((ignore ,@syms))) + ,form))) + body)))) (ert-deftest cl-seq-endp-test () (should (cl-endp '())) @@ -77,51 +70,39 @@ Body are forms defining the test." ;; keywords supported: :start :end (ert-deftest cl-seq-fill-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal '(b b b b b b b) (cl-fill _list 'b))) - (should (equal '(1 2 3 4 b b b) (cl-fill _list 'b :start 4))) - (should (equal '(b b b b 5 2 6) (cl-fill _list 'b :end 4))) - (should (equal '(1 2 b b 5 2 6) (cl-fill _list 'b :start 2 :end 4))) - (should (equal orig (cl-fill _list 'b :end 0)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal '(b b b b b b b) (cl-fill l 'b))) + (should (equal '(1 2 3 4 b b b) (cl-fill l 'b :start 4))) + (should (equal '(b b b b 5 2 6) (cl-fill l 'b :end 4))) + (should (equal '(1 2 b b 5 2 6) (cl-fill l 'b :start 2 :end 4))) + (should (equal orig (cl-fill l 'b :end 0))))) ;; keywords supported: :start1 :end1 :start2 :end2 (ert-deftest cl-seq-replace-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (cl-seq--test-list2 (make-list 6 'a)) - (orig (copy-sequence cl-seq--test-list)) - (orig2 (copy-sequence cl-seq--test-list2)) - (tests '((should (equal '(a a a a a a 6) (cl-replace _list _list2))) - (should (equal '(a a a a a a 6) (cl-replace _list _list2 :start1 0))) - (should (equal '(a a a a a a 6) (cl-replace _list _list2 :start2 0))) - (should (equal orig (cl-replace _list _list2 :start1 (length _list)))) - (should (equal orig (cl-replace _list _list2 :start2 (length _list2)))) - (should (equal orig (cl-replace _list _list2 :end1 0))) - (should (equal orig (cl-replace _list _list2 :end2 0))) - (should (equal '(1 2 3 4 a a a) (cl-replace _list _list2 :start1 4))) - (should (equal '(a a a a 5 2 6) (cl-replace _list _list2 :end1 4))) - (should (equal '(a a 3 4 5 2 6) (cl-replace _list _list2 :start2 4))) - (should (equal '(a a a a 5 2 6) (cl-replace _list _list2 :end2 4))) - (should (equal '(1 2 a a 5 2 6) (cl-replace _list _list2 :start1 2 :end1 4))) - (should (equal '(a a 3 4 5 2 6) (cl-replace _list _list2 :start2 2 :end2 4)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list) - (_list2 cl-seq--test-list2)) - (cl-seq--with-side-effects orig orig2 - test))))) + (cl-seq-tests--relet* ((l1 (list 1 2 3 4 5 2 6)) + (l2 (make-list 6 'a)) + (orig1 (copy-sequence l1))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2 :start1 0))) + (should (equal '(a a a a a a 6) (cl-replace l1 l2 :start2 0))) + (should (equal orig1 (cl-replace l1 l2 :start1 (length l1)))) + (should (equal orig1 (cl-replace l1 l2 :start2 (length l2)))) + (should (equal orig1 (cl-replace l1 l2 :end1 0))) + (should (equal orig1 (cl-replace l1 l2 :end2 0))) + (should (equal '(1 2 3 4 a a a) (cl-replace l1 l2 :start1 4))) + (should (equal '(a a a a 5 2 6) (cl-replace l1 l2 :end1 4))) + (should (equal '(a a 3 4 5 2 6) (cl-replace l1 l2 :start2 4))) + (should (equal '(a a a a 5 2 6) (cl-replace l1 l2 :end2 4))) + (should (equal '(1 2 a a 5 2 6) (cl-replace l1 l2 :start1 2 :end1 4))) + (should (equal '(a a 3 4 5 2 6) (cl-replace l1 l2 :start2 2 :end2 4))))) ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-remove-test () (let ((list '(1 2 3 4 5 2 6))) (should (equal list (cl-remove 'foo list))) - (should (equal '(1 3 4 5 6) (cl-remove 2 list))) - (should (equal '(1 3 4 5 6) (cl-remove 2 list - :key #'identity - :test (lambda (a b) (eql a b))))) + (should (equal '(1 3 4 5 6) (cl-remove 2 list))) + (should (equal '(1 3 4 5 6) (cl-remove 2 list :key #'identity :test #'eql))) (should (equal '(1 2 3 4 2) (cl-remove 4 list :test (lambda (a b) (> b a))))) (should (equal '(5 6) (cl-remove 4 list :test-not (lambda (a b) (> b a))))) (should (equal '(1 3 5) (cl-remove 'foo list :if #'cl-evenp))) @@ -133,67 +114,58 @@ Body are forms defining the test." (should (equal '(1 2 3 4 5 6) (cl-remove 2 list :from-end t :count 1))))) (ert-deftest cl-remove-if-test () - (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4)))) - (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4) :count 2))) - (should (equal '(1 3 4) (cl-remove-if 'cl-evenp '(1 2 3 4) :start 1 :end 3))) - (should (equal '(1 3) (cl-remove-if 'cl-evenp '(1 2 3 4) :from-end t))) - (should (equal '(2 4) (cl-remove-if 'cl-oddp '(1 2 3 4)))) - (should (equal '() (cl-remove-if 'cl-evenp '()))) - (should (equal '() (cl-remove-if 'cl-evenp '(2))))) + (should (equal '(1 3) (cl-remove-if #'cl-evenp '(1 2 3 4)))) + (should (equal '(1 3) (cl-remove-if #'cl-evenp '(1 2 3 4) :count 2))) + (should (equal '(1 3 4) (cl-remove-if #'cl-evenp '(1 2 3 4) :start 1 :end 3))) + (should (equal '(1 3) (cl-remove-if #'cl-evenp '(1 2 3 4) :from-end t))) + (should (equal '(2 4) (cl-remove-if #'cl-oddp '(1 2 3 4)))) + (should (equal '() (cl-remove-if #'cl-evenp '()))) + (should (equal '() (cl-remove-if #'cl-evenp '(2))))) (ert-deftest cl-remove-if-not-test () - (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4)))) - (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :count 2))) - (should (equal '(1 2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :start 1 :end 3))) - (should (equal '(2 4) (cl-remove-if-not 'cl-evenp '(1 2 3 4) :from-end t))) - (should (equal '(1 3) (cl-remove-if-not 'cl-oddp '(1 2 3 4)))) - (should (equal '() (cl-remove-if-not 'cl-evenp '()))) - (should (equal '(2) (cl-remove-if-not 'cl-evenp '(2)))) - (should (equal '(2) (cl-remove-if-not 'cl-evenp '(2) :key #'(lambda (x) (- x)))))) + (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4)))) + (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4) :count 2))) + (should (equal '(1 2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4) :start 1 :end 3))) + (should (equal '(2 4) (cl-remove-if-not #'cl-evenp '(1 2 3 4) :from-end t))) + (should (equal '(1 3) (cl-remove-if-not #'cl-oddp '(1 2 3 4)))) + (should (equal '() (cl-remove-if-not #'cl-evenp '()))) + (should (equal '(2) (cl-remove-if-not #'cl-evenp '(2)))) + (should (equal '(2) (cl-remove-if-not #'cl-evenp '(2) :key #'-)))) ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-delete-test () - (let* ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal orig (cl-delete 'foo _list))) - (should (equal '(1 3 4 5 6) (cl-delete 2 _list))) - (should (equal '(1 3 4 5 6) (cl-delete 2 _list - :key #'identity - :test (lambda (a b) (eql a b))))) - (should (equal '(1 2 3 4 2) (cl-delete 4 _list :test (lambda (a b) (> b a))))) - (should (equal '(5 6) (cl-delete 4 _list :test-not (lambda (a b) (> b a))))) - (should (equal '(1 3 5) (cl-delete 'foo _list :if #'cl-evenp))) - (should (equal '(2 4 2 6) (cl-delete 'foo _list :if-not #'cl-evenp))) - (should (equal '(1 2 3 4 5) (cl-delete 'foo _list :if #'cl-evenp :start 4))) - (should (equal '(1 2 3 4 5 6) (cl-delete 2 _list :start 5 :end 6))) - (should (equal '(1 3 4 5 2 6) (cl-delete 2 _list :count 1))) - (should (equal '(1 3 4 5 2 6) (cl-delete 2 _list :from-end nil :count 1))) - (should (equal '(1 2 3 4 5 6) (cl-delete 2 _list :from-end t :count 1)))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal orig (cl-delete 'foo l))) + (should (equal '(1 3 4 5 6) (cl-delete 2 l))) + (should (equal '(1 3 4 5 6) (cl-delete 2 l :key #'identity :test #'eql))) + (should (equal '(1 2 3 4 2) (cl-delete 4 l :test (lambda (a b) (> b a))))) + (should (equal '(5 6) (cl-delete 4 l :test-not (lambda (a b) (> b a))))) + (should (equal '(1 3 5) (cl-delete 'foo l :if #'cl-evenp))) + (should (equal '(2 4 2 6) (cl-delete 'foo l :if-not #'cl-evenp))) + (should (equal '(1 2 3 4 5) (cl-delete 'foo l :if #'cl-evenp :start 4))) + (should (equal '(1 2 3 4 5 6) (cl-delete 2 l :start 5 :end 6))) + (should (equal '(1 3 4 5 2 6) (cl-delete 2 l :count 1))) + (should (equal '(1 3 4 5 2 6) (cl-delete 2 l :from-end nil :count 1))) + (should (equal '(1 2 3 4 5 6) (cl-delete 2 l :from-end t :count 1))))) (ert-deftest cl-delete-if-test () - (let ((list (list 1 2 3 4 5))) - (cl-delete-if 'cl-evenp list) - (should (equal '(1 3 5) list)) - (should (equal '(1 3 5) (cl-delete-if 'cl-evenp (list 1 2 3 4 5) :start 0 :end 4))) - (should (equal '(1 3 5) (cl-delete-if 'cl-evenp (list 1 2 3 4 5) :from-end t))) - (should (equal '(2 4) (cl-delete-if 'cl-oddp (list 1 2 3 4 5)))) - (should (equal '() (cl-delete-if 'cl-evenp '()))) - (should (equal '() (cl-delete-if 'cl-evenp (list 2)))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5))) + (should (equal '(1 3 5) (cl-delete-if #'cl-evenp l))) + (should (equal '(1 3 5) (cl-delete-if #'cl-evenp l :start 0 :end 4))) + (should (equal '(1 3 5) (cl-delete-if #'cl-evenp l :from-end t))) + (should (equal '(2 4) (cl-delete-if #'cl-oddp l)))) + (should (equal '() (cl-delete-if #'cl-evenp '()))) + (should (equal '() (cl-delete-if #'cl-evenp (list 2))))) (ert-deftest cl-delete-if-not-test () - (let ((list (list 1 2 3 4 5))) - (should (equal '(2 4) (cl-delete-if-not 'cl-evenp list))) - (should (equal '() (cl-delete-if-not 'cl-evenp '()))) - (should (equal '() (cl-delete-if-not 'cl-evenp (list 1)))))) + (should (equal '(2 4) (cl-delete-if-not #'cl-evenp (list 1 2 3 4 5)))) + (should (equal '() (cl-delete-if-not #'cl-evenp '()))) + (should (equal '() (cl-delete-if-not #'cl-evenp (list 1))))) (ert-deftest cl-delete-duplicates-test () - (let ((list (list 1 2 3 2 1))) - (should (equal '(3 2 1) (cl-delete-duplicates list))) - (should (equal '() (cl-delete-duplicates '()))))) + (should (equal '(3 2 1) (cl-delete-duplicates (list 1 2 3 2 1)))) + (should (equal '() (cl-delete-duplicates '())))) ;; keywords supported: :test :test-not :key :start :end :from-end (ert-deftest cl-seq-remove-duplicates-test () @@ -203,10 +175,10 @@ Body are forms defining the test." (should (equal list (cl-remove-duplicates list :start 2))) (should (equal list (cl-remove-duplicates list :start 2 :from-end t))) (should (equal list (cl-remove-duplicates list :end 4))) - (should (equal '(6) (cl-remove-duplicates list :test (lambda (a b) (< a b))))) - (should (equal '(1 2 6) (cl-remove-duplicates list :test (lambda (a b) (>= a b))))) - (should (equal (cl-remove-duplicates list :test (lambda (a b) (>= a b))) - (cl-remove-duplicates list :test-not (lambda (a b) (< a b))))) + (should (equal '(6) (cl-remove-duplicates list :test #'<))) + (should (equal '(1 2 6) (cl-remove-duplicates list :test #'>=))) + (should (equal (cl-remove-duplicates list :test #'>=) + (cl-remove-duplicates list :test-not #'<))) (should (equal (cl-remove-duplicates list) (cl-remove-duplicates list :key #'number-to-string :test #'string=))) (should (equal list @@ -224,35 +196,38 @@ Body are forms defining the test." (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 list :count 1))) (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 list :count 1 :from-end t))) (should (equal list (cl-substitute 'b 2 list :count -1))) - (should (equal '(1 b 3 4 5 b 6) (cl-substitute 'b "2" list :key #'number-to-string + (should (equal '(1 b 3 4 5 b 6) (cl-substitute 'b "2" list + :key #'number-to-string :test #'string=))) (should (equal (cl-substitute 'b 2 list) (cl-substitute 'b 2 list :test #'eq))) - (should (equal '(1 2 b b b 2 b) (cl-substitute 'b 2 list :test (lambda (a b) (< a b))))) - (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b 2 list :test (lambda (a b) (>= a b))))) - (should (equal list (cl-substitute 'b 99 list :test (lambda (a b) (< a b))))) - (should (equal (cl-substitute 'b 2 list :test (lambda (a b) (>= a b))) - (cl-substitute 'b 2 list :test-not (lambda (a b) (< a b))))) - (should (equal '(1 2 b b b 2 b) (cl-substitute 'b nil list :if (lambda (x) (> (cl-position x list) 1))))) - (should (equal '(1 b b b b b b) (cl-substitute 'b nil list :if (lambda (x) (> (cl-position x list :from-end t) 1))))) - - (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b nil list - :if-not (lambda (x) (> (cl-position x list) 1))))) - (should (equal '(b 2 3 4 5 2 6) (cl-substitute 'b nil list - :if-not (lambda (x) (> (cl-position x list :from-end t) 1))))))) + (should (equal '(1 2 b b b 2 b) (cl-substitute 'b 2 list :test #'<))) + (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b 2 list :test #'>=))) + (should (equal list (cl-substitute 'b 99 list :test #'<))) + (should (equal (cl-substitute 'b 2 list :test #'>=) + (cl-substitute 'b 2 list :test-not #'<))) + (let ((pred (lambda (x) (> (cl-position x list) 1)))) + (should (equal '(1 2 b b b 2 b) (cl-substitute 'b nil list :if pred)))) + (let ((pred (lambda (x) (> (cl-position x list :from-end t) 1)))) + (should (equal '(1 b b b b b b) (cl-substitute 'b nil list :if pred)))) + (let ((pred (lambda (x) (> (cl-position x list) 1)))) + (should (equal '(b b 3 4 5 b 6) (cl-substitute 'b nil list :if-not pred)))) + (let ((pred (lambda (x) (> (cl-position x list :from-end t) 1)))) + (should (equal '(b 2 3 4 5 2 6) (cl-substitute 'b nil list :if-not pred)))))) (ert-deftest cl-seq-substitute-if-test () (let ((result (cl-substitute-if 'x #'cl-evenp '(1 2 3 4 5)))) (should (equal result '(1 x 3 x 5)))) (let ((result (cl-substitute-if 'x #'cl-evenp '(1 3 5)))) (should (equal result '(1 3 5)))) - (let ((result (cl-substitute-if 'x #'(lambda (n) t) '(1 2 3 4 5)))) + (let ((result (cl-substitute-if 'x #'always '(1 2 3 4 5)))) (should (equal result '(x x x x x)))) (let ((result (cl-substitute-if 'x #'cl-evenp '(1 2 3 4 5) :start 1 :end 4))) (should (equal result '(1 x 3 x 5)))) (let ((result (cl-substitute-if 'x #'cl-oddp '(1 2 3 4 5) :from-end t))) (should (equal result '(x 2 x 4 x)))) - (let ((result (cl-substitute-if 'x (lambda (n) (= n 3)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-substitute-if 'x (lambda (n) (= n 3)) '(1 2 3 4 5) + :key #'identity))) (should (equal result '(1 2 x 4 5))))) (ert-deftest cl-seq-substitute-if-not-test () @@ -260,21 +235,22 @@ Body are forms defining the test." (should (equal result '(x 2 x 4 x)))) (let ((result (cl-substitute-if-not 'x #'cl-evenp '(2 4 6)))) (should (equal result '(2 4 6)))) - (let ((result (cl-substitute-if-not 'x #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (let ((result (cl-substitute-if-not 'x (lambda (n) (> n 5)) '(1 2 3 4 5)))) (should (equal result '(x x x x x)))) (let ((result (cl-substitute-if-not 'x #'cl-evenp '(1 2 3 4 5) :start 0 :end 4))) (should (equal result '(x 2 x 4 5)))) (let ((result (cl-substitute-if-not 'x #'cl-oddp '(1 2 3 4 5) :from-end t))) (should (equal result '(1 x 3 x 5)))) - (let ((result (cl-substitute-if-not 'x (lambda (n) (= n 3)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-substitute-if-not 'x (lambda (n) (= n 3)) '(1 2 3 4 5) + :key #'identity))) (should (equal result '(x x 3 x x))))) (ert-deftest cl-find-if-test () (let ((result (cl-find-if #'cl-evenp '(1 2 3 4 5)))) (should (equal result 2))) - (let ((result (cl-find-if #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (let ((result (cl-find-if (lambda (n) (> n 5)) '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-find-if #'(lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) + (let ((result (cl-find-if (lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) (should (equal result 4))) (let ((result (cl-find-if #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 4))) @@ -282,7 +258,7 @@ Body are forms defining the test." (should (equal result nil))) (let ((result (cl-find-if #'cl-oddp '(2 4 5 6 7) :from-end t))) (should (equal result 7))) - (let ((result (cl-find-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-find-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) (should (equal result 4)))) (ert-deftest cl-find-if-not-test () @@ -290,7 +266,7 @@ Body are forms defining the test." (should (equal result 1))) (let ((result (cl-find-if-not #'cl-oddp '(1 3 5)))) (should (equal result nil))) - (let ((result (cl-find-if-not #'(lambda (n) (< n 4)) '(1 2 3 4 5 6 7)))) + (let ((result (cl-find-if-not (lambda (n) (< n 4)) '(1 2 3 4 5 6 7)))) (should (equal result 4))) (let ((result (cl-find-if-not #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 3))) @@ -298,45 +274,40 @@ Body are forms defining the test." (should (equal result 1))) (let ((result (cl-find-if-not #'cl-oddp '(2 4 6 7 8) :from-end t))) (should (equal result 8))) - (let ((result (cl-find-if-not (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-find-if-not (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) (should (equal result 1)))) ;; keywords supported: :test :test-not :key :count :start :end :from-end (ert-deftest cl-seq-nsubstitute-test () - (let ((cl-seq--test-list '(1 2 3 4 5 2 6)) - (orig (copy-sequence cl-seq--test-list)) - (tests '((should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b 2 _list))) - (should (equal _list (cl-substitute 'b 2 _list :start (length _list)))) - (should (equal _list (cl-substitute 'b 2 _list :end 0))) - (should (equal '(1 2 3 4 5 b 6) (cl-substitute 'b 2 _list :start 2))) - (should (equal '(1 b 3 4 5 2 6) (cl-substitute 'b 2 _list :end 2))) - (should (equal _list (cl-substitute 'b 2 _list :start 2 :end 4))) - (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 _list :count 1))) - (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 _list :count 1 :from-end t))) - (should (equal _list (cl-nsubstitute 'b 2 _list :count -1))) - (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b "2" _list :key #'number-to-string - :test #'string=))) - (should (equal (cl-nsubstitute 'b 2 _list) - (cl-nsubstitute 'b 2 _list :test #'eq))) - (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b 2 _list :test (lambda (a b) (< a b))))) - (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b 2 _list :test (lambda (a b) (>= a b))))) - (should (equal _list (cl-nsubstitute 'b 99 _list :test (lambda (a b) (< a b))))) - (should (equal (cl-nsubstitute 'b 2 _list :test (lambda (a b) (>= a b))) - (cl-nsubstitute 'b 2 _list :test-not (lambda (a b) (< a b))))) - (should (equal '(1 2 b b b 2 b) - (cl-nsubstitute 'b nil _list :if (lambda (x) (> (cl-position x _list) 1))))) - (should (equal '(1 b b b b b b) - (cl-nsubstitute 'b nil _list :if (lambda (x) (> (cl-position x _list :from-end t) 1))))) - (should (equal '(b b 3 4 5 b 6) - (cl-nsubstitute 'b nil _list - :if-not (lambda (x) (> (cl-position x _list) 1))))) - (should (equal '(b 2 3 4 5 2 6) - (cl-nsubstitute 'b nil _list - :if-not (lambda (x) (> (cl-position x _list :from-end t) 1)))))))) - (dolist (test tests) - (let ((_list cl-seq--test-list)) - (cl-seq--with-side-effects orig nil - test))))) + (cl-seq-tests--relet* ((l (list 1 2 3 4 5 2 6)) + (orig (copy-sequence l))) + (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b 2 l))) + (should (equal orig (cl-nsubstitute 'b 2 l :start (length l)))) + (should (equal orig (cl-nsubstitute 'b 2 l :end 0))) + (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 l :start 2))) + (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 l :end 2))) + (should (equal orig (cl-nsubstitute 'b 2 l :start 2 :end 4))) + (should (equal '(1 b 3 4 5 2 6) (cl-nsubstitute 'b 2 l :count 1))) + (should (equal '(1 2 3 4 5 b 6) (cl-nsubstitute 'b 2 l :count 1 :from-end t))) + (should (equal orig (cl-nsubstitute 'b 2 l :count -1))) + (should (equal '(1 b 3 4 5 b 6) (cl-nsubstitute 'b "2" l + :key #'number-to-string + :test #'string=))) + (should (equal (cl-nsubstitute 'b 2 orig) + (cl-nsubstitute 'b 2 l :test #'eq))) + (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b 2 l :test #'<))) + (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b 2 l :test #'>=))) + (should (equal orig (cl-nsubstitute 'b 99 l :test #'<))) + (should (equal (cl-nsubstitute 'b 2 orig :test #'>=) + (cl-nsubstitute 'b 2 l :test-not #'<))) + (let ((pred (lambda (x) (> (cl-position x orig) 1)))) + (should (equal '(1 2 b b b 2 b) (cl-nsubstitute 'b nil l :if pred)))) + (let ((pred (lambda (x) (> (cl-position x orig :from-end t) 1)))) + (should (equal '(1 b b b b b b) (cl-nsubstitute 'b nil l :if pred)))) + (let ((pred (lambda (x) (> (cl-position x orig) 1)))) + (should (equal '(b b 3 4 5 b 6) (cl-nsubstitute 'b nil l :if-not pred)))) + (let ((pred (lambda (x) (> (cl-position x orig :from-end t) 1)))) + (should (equal '(b 2 3 4 5 2 6) (cl-nsubstitute 'b nil l :if-not pred)))))) ;; keywords supported: :test :test-not :key :start :end :from-end (ert-deftest cl-seq-position-test () @@ -346,10 +317,10 @@ Body are forms defining the test." (should (= 5 (cl-position 2 list :start 5 :end 6))) (should (= 1 (cl-position 2 list :from-end nil))) (should (= 5 (cl-position 2 list :from-end t))) - (should (cl-position 2 list :key #'identity - :test (lambda (a b) (eql a b)))) + (should (cl-position 2 list :key #'identity :test #'eql)) (should (= 1 (cl-position "2" list :key #'number-to-string :test #'string=))) - (should (= 5 (cl-position "2" list :key #'number-to-string :test #'string= :from-end t))) + (should (= 5 (cl-position "2" list :key #'number-to-string + :test #'string= :from-end t))) (should-not (cl-position "2" list :key #'number-to-string)) (should (cl-position 5 list :key (lambda (x) (1+ (* 1.0 x x))) :test #'=)) (should-not (cl-position 5 list :key (lambda (x) (1+ (* 1.0 x x))))) @@ -359,9 +330,9 @@ Body are forms defining the test." (ert-deftest cl-position-if-test () (let ((result (cl-position-if #'cl-evenp '(1 2 3 4 5)))) (should (equal result 1))) - (let ((result (cl-position-if #'(lambda (n) (> n 5)) '(1 2 3 4 5)))) + (let ((result (cl-position-if (lambda (n) (> n 5)) '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-position-if #'(lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) + (let ((result (cl-position-if (lambda (n) (> n 3)) '(1 2 3 4 5 6 7)))) (should (equal result 3))) (let ((result (cl-position-if #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 3))) @@ -369,7 +340,7 @@ Body are forms defining the test." (should (equal result nil))) (let ((result (cl-position-if #'cl-oddp '(2 4 5 6 7) :from-end t))) (should (equal result 4))) - (let ((result (cl-position-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-position-if (lambda (n) (= n 4)) '(1 2 3 4 5) :key #'identity))) (should (equal result 3)))) ;; keywords supported: :test :test-not :key :start :end @@ -390,11 +361,11 @@ Body are forms defining the test." (should (equal result 2))) (let ((result (cl-count-if #'cl-oddp '(2 4 6 8)))) (should (equal result 0))) - (let ((result (cl-count-if (lambda (x) t) '(1 2 3 4)))) + (let ((result (cl-count-if #'always '(1 2 3 4)))) (should (equal result 4))) - (let ((result (cl-count-if (lambda (x) nil) '(1 2 3 4)))) + (let ((result (cl-count-if #'ignore '(1 2 3 4)))) (should (equal result 0))) - (let ((result (cl-count-if #'(lambda (x) (> x 2)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-count-if (lambda (x) (> x 2)) '(1 2 3 4 5) :key #'identity))) (should (equal result 3))) (let ((result (cl-count-if #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 1))) @@ -402,7 +373,7 @@ Body are forms defining the test." (should (equal result 1))) (let ((result (cl-count-if #'cl-evenp '()))) (should (equal result 0))) - (let ((result (cl-count-if #'(lambda (x) (numberp x)) '(1 "two" 3 4 "five" 6)))) + (let ((result (cl-count-if #'numberp '(1 "two" 3 4 "five" 6)))) (should (equal result 4))) (let ((result (cl-count-if (lambda (x) (and (numberp x) (> x 2))) '(1 2 3 4 5 6)))) (should (equal result 4)))) @@ -412,11 +383,11 @@ Body are forms defining the test." (should (equal result 3))) (let ((result (cl-count-if-not #'cl-oddp '(1 3 5)))) (should (equal result 0))) - (let ((result (cl-count-if-not (lambda (x) t) '(1 2 3 4)))) + (let ((result (cl-count-if-not #'always '(1 2 3 4)))) (should (equal result 0))) - (let ((result (cl-count-if-not (lambda (x) nil) '(1 2 3 4)))) + (let ((result (cl-count-if-not #'ignore '(1 2 3 4)))) (should (equal result 4))) - (let ((result (cl-count-if-not #'(lambda (x) (> x 3)) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-count-if-not (lambda (x) (> x 3)) '(1 2 3 4 5) :key #'identity))) (should (equal result 3))) (let ((result (cl-count-if-not #'cl-evenp '(1 2 3 4 5) :start 2))) (should (equal result 2))) @@ -424,9 +395,10 @@ Body are forms defining the test." (should (equal result 2))) (let ((result (cl-count-if-not #'cl-evenp '()))) (should (equal result 0))) - (let ((result (cl-count-if-not #'(lambda (x) (numberp x)) '(1 "two" 3 4 "five" 6)))) + (let ((result (cl-count-if-not #'numberp '(1 "two" 3 4 "five" 6)))) (should (equal result 2))) - (let ((result (cl-count-if-not (lambda (x) (and (numberp x) (> x 2))) '(1 2 3 4 5 6)))) + (let ((result (cl-count-if-not (lambda (x) (and (numberp x) (> x 2))) + '(1 2 3 4 5 6)))) (should (equal result 2)))) ;; keywords supported: :test :test-not :key :start1 :end1 :start2 :end2 :from-end @@ -443,9 +415,9 @@ Body are forms defining the test." (should-not (cl-mismatch list list2 :end1 1 :end2 1)) (should-not (cl-mismatch list list2 :start1 1 :start2 2)) (should (= 1 (cl-mismatch list list2 :start1 1 :end1 2 :start2 4 :end2 4))) - (should (= -1 (cl-mismatch list list2 :key #'number-to-string + (should (= -1 (cl-mismatch list list2 :from-end t :key #'number-to-string :test (lambda (a b) - (and (stringp a) (stringp b))) :from-end t))) + (and (stringp a) (stringp b)))))) (should (= 7 (cl-mismatch list list2 :key #'number-to-string :test (lambda (a b) (and (stringp a) (stringp b)))))))) @@ -461,16 +433,17 @@ Body are forms defining the test." (should (= 0 (cl-search list list2 :end1 1))) (should (= 0 (cl-search nil list2))) (should (= 2 (cl-search list list2 :start1 1 :end1 2 :end2 3))) - (should (= 0 (cl-search list list2 :test (lambda (a b) (and (numberp a) (numberp b)))))) + (should (= 0 (cl-search list list2 :test (lambda (a b) + (and (numberp a) (numberp b)))))) (should (= 0 (cl-search list list2 :key (lambda (x) (and (numberp x) 'foo)) :test (lambda (a b) (and (eq a 'foo) (eq b 'foo)))))) (should (= 1 (cl-search (nthcdr 2 list) (nthcdr 2 list2)))) (should (= 3 (cl-search (nthcdr 2 list) list2))))) (ert-deftest cl-seq-test-bug24264 () - "Test for https://debbugs.gnu.org/24264 ." + "Test for bug#24264." :tags '(:expensive-test) - (let ((list (append (make-list 8000005 1) '(8))) + (let ((list (nconc (make-list 8000005 1) '(8))) (list2 (make-list 8000005 2))) (should (cl-position 8 list)) (should-not (equal '(8) (last (cl-remove 8 list)))) @@ -488,75 +461,82 @@ Body are forms defining the test." (should (eq (cl-rassoc x a) (cadr a)))))) (ert-deftest cl-sort-test () - (let ((result (cl-sort '(3 1 4 1 5 9 2 6 5 3 5) '<))) + (let ((result (cl-sort (list 3 1 4 1 5 9 2 6 5 3 5) #'<))) (should (equal result '(1 1 2 3 3 4 5 5 5 6 9)))) - (let ((result (cl-sort '(5 3 2 8 1 4) '>))) + (let ((result (cl-sort (list 5 3 2 8 1 4) #'>))) (should (equal result '(8 5 4 3 2 1)))) - (let ((result (cl-sort '("banana" "apple" "cherry") 'string<))) + (let ((result (cl-sort (list "banana" "apple" "cherry") #'string<))) (should (equal result '("apple" "banana" "cherry")))) - (let ((result (cl-sort '("banana" "fig" "apple" "kiwi") (lambda (x y) (< (length x) (length y))) :key 'identity))) + (let ((result (cl-sort (list "banana" "fig" "apple" "kiwi") + (lambda (x y) (length< x (length y))) + :key #'identity))) (should (equal result '("fig" "kiwi" "apple" "banana")))) - (let ((result (cl-sort (vector 3 1 4 1 5) '<))) - (should (equal result (vector 1 1 3 4 5)))) - (let ((result (cl-sort '(1 2 3 4 5) '<))) + (let ((result (cl-sort (vector 3 1 4 1 5) #'<))) + (should (equal result [1 1 3 4 5]))) + (let ((result (cl-sort (list 1 2 3 4 5) #'<))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-sort '(-3 1 4 -1 -5 9) '<))) + (let ((result (cl-sort (list -3 1 4 -1 -5 9) #'<))) (should (equal result '(-5 -3 -1 1 4 9)))) - (let ((result (cl-sort '(1 2 3 4 5) (lambda (x y) (> x y))))) + (let ((result (cl-sort (list 1 2 3 4 5) #'>))) (should (equal result '(5 4 3 2 1)))) - (let ((result (cl-sort '() '<))) + (let ((result (cl-sort '() #'<))) (should (equal result '()))) - (let ((result (cl-sort '("Banana" "apple" "cherry") 'string< :key 'downcase))) + (let ((result (cl-sort (list "Banana" "apple" "cherry") + #'string< :key #'downcase))) (should (equal result '("apple" "Banana" "cherry")))) ) (ert-deftest cl-stable-sort-test () - (let ((result (cl-stable-sort '(3 1 4 1 5 9 2 6 5 3 5) '<))) + (let ((result (cl-stable-sort (list 3 1 4 1 5 9 2 6 5 3 5) #'<))) (should (equal result '(1 1 2 3 3 4 5 5 5 6 9)))) - (let ((result (cl-stable-sort '(5 3 2 8 1 4) '>))) + (let ((result (cl-stable-sort (list 5 3 2 8 1 4) #'>))) (should (equal result '(8 5 4 3 2 1)))) - (let ((result (cl-stable-sort '("banana" "apple" "cherry") 'string<))) + (let ((result (cl-stable-sort (list "banana" "apple" "cherry") #'string<))) (should (equal result '("apple" "banana" "cherry")))) - (let ((result (cl-stable-sort '("banana" "fig" "apple" "kiwi") (lambda (x y) (< (length x) (length y))) :key 'identity))) + (let ((result (cl-stable-sort (list "banana" "fig" "apple" "kiwi") + (lambda (x y) (length< x (length y))) + :key #'identity))) (should (equal result '("fig" "kiwi" "apple" "banana")))) - (let ((result (cl-stable-sort (vector 3 1 4 1 5) '<))) - (should (equal result (vector 1 1 3 4 5)))) - (let ((result (cl-stable-sort '(1 2 3 4 5) '<))) + (let ((result (cl-stable-sort (vector 3 1 4 1 5) #'<))) + (should (equal result [1 1 3 4 5]))) + (let ((result (cl-stable-sort (list 1 2 3 4 5) #'<))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-stable-sort '(-3 1 4 -1 -5 9) '<))) + (let ((result (cl-stable-sort (list -3 1 4 -1 -5 9) #'<))) (should (equal result '(-5 -3 -1 1 4 9)))) - (let ((result (cl-stable-sort '(1 2 3 4 5) (lambda (x y) (> x y))))) + (let ((result (cl-stable-sort (list 1 2 3 4 5) #'>))) (should (equal result '(5 4 3 2 1)))) - (let ((result (cl-stable-sort '() '<))) + (let ((result (cl-stable-sort '() #'<))) (should (equal result '()))) - (let ((result (cl-stable-sort '("Banana" "apple" "cherry") 'string< :key 'downcase))) + (let ((result (cl-stable-sort (list "Banana" "apple" "cherry") + #'string< :key #'downcase))) (should (equal result '("apple" "Banana" "cherry")))) ) (ert-deftest cl-merge-test () - (let ((result (cl-merge 'list '(1 3 5) '(2 4 6) '<))) + (let ((result (cl-merge 'list (list 1 3 5) (list 2 4 6) #'<))) (should (equal result '(1 2 3 4 5 6)))) - (let ((result (cl-merge 'list '(1 3 3 5) '(2 3 4 6) '<))) + (let ((result (cl-merge 'list (list 1 3 3 5) (list 2 3 4 6) #'<))) (should (equal result '(1 2 3 3 3 4 5 6)))) - (let ((result (cl-merge 'list '() '(2 4 6) '<))) + (let ((result (cl-merge 'list '() (list 2 4 6) #'<))) (should (equal result '(2 4 6)))) - (let ((result (cl-merge 'list '(1 3 5) '() '<))) + (let ((result (cl-merge 'list (list 1 3 5) '() #'<))) (should (equal result '(1 3 5)))) - (let ((result (cl-merge 'list '() '() '<))) + (let ((result (cl-merge 'list '() '() #'<))) (should (equal result '()))) - (let ((result (cl-merge 'list '(1 4 6) '(2 3 5) '< :key (lambda (x) x)))) + (let ((result (cl-merge 'list (list 1 4 6) (list 2 3 5) #'< :key #'identity))) (should (equal result '(1 2 3 4 5 6)))) - (let ((result (cl-merge 'vector (vector 1 3 5) (vector 2 4 6) '<))) - (should (equal result (vector 1 2 3 4 5 6)))) - (let ((result (cl-merge 'list '(5 3 1) '(6 4 2) '>))) + (let ((result (cl-merge 'vector (vector 1 3 5) (vector 2 4 6) #'<))) + (should (equal result [1 2 3 4 5 6]))) + (let ((result (cl-merge 'list (list 5 3 1) (list 6 4 2) #'>))) (should (equal result '(6 5 4 3 2 1)))) - (let ((result (cl-merge 'list '(1 2 3) '(1 2 3) '>))) + (let ((result (cl-merge 'list (list 1 2 3) (list 1 2 3) #'>))) (should (equal result '(1 2 3 1 2 3)))) - (let ((result (cl-merge 'list '(1 2) '(3 4 5) '<))) + (let ((result (cl-merge 'list (list 1 2) (list 3 4 5) #'<))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-merge 'list '(4 5 6) '(1 2 3) '<))) + (let ((result (cl-merge 'list (list 4 5 6) (list 1 2 3) #'<))) (should (equal result '(1 2 3 4 5 6)))) - (let ((result (cl-merge 'list '(1 2 3) '(1.5 2.5 3.5) '<))) + (let ((result (cl-merge 'list (list 1 2 3) (list 1.5 2.5 3.5) #'<))) (should (equal result '(1 1.5 2 2.5 3 3.5)))) - (let ((result (cl-merge 'list '(1 2 3) '(10 20 30) '< :key (lambda (x) (* x 10))))) + (let ((result (cl-merge 'list (list 1 2 3) (list 10 20 30) + #'< :key (lambda (x) (* x 10))))) (should (equal result '(1 2 3 10 20 30))))) (ert-deftest cl-member-test () @@ -566,45 +546,49 @@ Body are forms defining the test." (should (equal result nil))) (let ((result (cl-member 'a '(a b a c d)))) (should (equal result '(a b a c d)))) - (let ((result (cl-member "test" '("test" "not-test" "test2") :test 'string=))) + (let ((result (cl-member "test" '("test" "not-test" "test2") :test #'string=))) (should (equal result '("test" "not-test" "test2")))) - (let ((result (cl-member 'x '(a b c d) :test-not 'eq))) + (let ((result (cl-member 'x '(a b c d) :test-not #'eq))) (should (equal result '(a b c d)))) - (let ((result (cl-member 3 '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-member 3 '(1 2 3 4 5) :key #'identity))) (should (equal result '(3 4 5)))) - (let ((result (cl-member 2.5 '(1 2 2.5 3) :test 'equal))) + (let ((result (cl-member 2.5 '(1 2 2.5 3) :test #'equal))) (should (equal result '(2.5 3)))) - (let ((result (cl-member 'a '(a a a a) :test 'eq))) + (let ((result (cl-member 'a '(a a a a) :test #'eq))) (should (equal result '(a a a a)))) (let ((result (cl-member 'a '()))) (should (equal result nil))) - (let ((result (cl-member 'b '(a c d) :test-not 'eq))) + (let ((result (cl-member 'b '(a c d) :test-not #'eq))) (should (equal result '(a c d)))) - (let ((result (cl-member 3 '(1 2 3 4 5) :key '1+))) + (let ((result (cl-member 3 '(1 2 3 4 5) :key #'1+))) (should (equal result '(2 3 4 5))))) (ert-deftest cl-member-if-test () (let ((result (cl-member-if #'cl-evenp '(1 2 3 4 5)))) (should (equal result '(2 3 4 5)))) - (let ((result (cl-member-if #'(lambda (x) nil) '(1 2 3 4 5)))) + (let ((result (cl-member-if #'ignore '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-member-if #'(lambda (x) t) '(1 2 3 4 5)))) + (let ((result (cl-member-if #'always '(1 2 3 4 5)))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-member-if #'(lambda (x) (= x 1)) '(1 2 3 4 5)))) + (let ((result (cl-member-if (lambda (x) (= x 1)) '(1 2 3 4 5)))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-member-if #'(lambda (x) (and (numberp x) (cl-evenp x))) '(1 3 5 4 2)))) + (let ((result (cl-member-if (lambda (x) (and (numberp x) (cl-evenp x))) + '(1 3 5 4 2)))) (should (equal result '(4 2)))) - (let ((result (cl-member-if (lambda (x) (string= (number-to-string x) "3")) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-member-if (lambda (x) (string= (number-to-string x) "3")) + '(1 2 3 4 5) :key #'identity))) (should (equal result '(3 4 5)))) - (let ((result (cl-member-if #'(lambda (x) (eq x 'a)) '(a a a a)))) + (let ((result (cl-member-if (lambda (x) (eq x 'a)) '(a a a a)))) (should (equal result '(a a a a)))) (let ((result (cl-member-if #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-member-if #'(lambda (x) (< x 0)) '(1 2 3 4 5)))) + (let ((result (cl-member-if #'cl-minusp '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-member-if (lambda (x) (and (numberp x) (<= x 2))) '(1 "two" 3 0)))) + (let ((result (cl-member-if (lambda (x) (and (numberp x) (<= x 2))) + '(1 "two" 3 0)))) (should (equal result '(1 "two" 3 0)))) - (let ((result (cl-member-if (lambda (x) (> x 5)) '(1 2 3 6 7 8) :key 'identity))) + (let ((result (cl-member-if (lambda (x) (> x 5)) '(1 2 3 6 7 8) + :key #'identity))) (should (equal result '(6 7 8))))) (ert-deftest cl-member-if-not-test () @@ -612,23 +596,27 @@ Body are forms defining the test." (should (equal result '(1 2 3 4 5)))) (let ((result (cl-member-if-not #'cl-evenp '(2 4 6 8 10 11)))) (should (equal result '(11)))) - (let ((result (cl-member-if-not #'(lambda (x) (> x 5)) '(1 2 3 4 5)))) + (let ((result (cl-member-if-not (lambda (x) (> x 5)) '(1 2 3 4 5)))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-member-if-not #'(lambda (x) t) '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'always '(1 2 3 4 5)))) (should (equal result nil))) - (let ((result (cl-member-if-not #'(lambda (x) (= x 1)) '(1 2 3 4 5)))) + (let ((result (cl-member-if-not (lambda (x) (= x 1)) '(1 2 3 4 5)))) (should (equal result '(2 3 4 5)))) - (let ((result (cl-member-if-not (lambda (x) (string= (number-to-string x) "2")) '(1 2 3 4 5) :key 'identity))) + (let ((result (cl-member-if-not (lambda (x) (string= (number-to-string x) "2")) + '(1 2 3 4 5) :key #'identity))) (should (equal result '(1 2 3 4 5)))) (let ((result (cl-member-if-not #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-member-if-not #'(lambda (x) (eq x 'a)) '(a a a a)))) + (let ((result (cl-member-if-not (lambda (x) (eq x 'a)) '(a a a a)))) (should (equal result nil))) - (let ((result (cl-member-if-not #'(lambda (x) (< x 0)) '(1 2 3 4 5)))) + (let ((result (cl-member-if-not #'cl-minusp '(1 2 3 4 5)))) (should (equal result '(1 2 3 4 5)))) - (let ((result (cl-member-if-not #'(lambda (x) (or (numberp x) (stringp x) (eq x 'b))) '(a "b" 3 nil)))) + (let ((result (cl-member-if-not + (lambda (x) (or (numberp x) (stringp x) (eq x 'b))) + '(a "b" 3 nil)))) (should (equal result '(a "b" 3 nil)))) - (let ((result (cl-member-if-not (lambda (x) (numberp x)) '(1 "two" 3 "four" 5) :key 'identity))) + (let ((result (cl-member-if-not #'numberp '(1 "two" 3 "four" 5) + :key #'identity))) (should (equal result '("two" 3 "four" 5))))) (ert-deftest cl-assoc-test () @@ -636,13 +624,13 @@ Body are forms defining the test." (should (equal result '(b . 2)))) (let ((result (cl-assoc 'x '((a . 1) (b . 2) (c . 3))))) (should (equal result nil))) - (let ((result (cl-assoc "key" '(("key" . 1) ("not-key" . 2)) :test 'string=))) + (let ((result (cl-assoc "key" '(("key" . 1) ("not-key" . 2)) :test #'string=))) (should (equal result '("key" . 1)))) - (let ((result (cl-assoc 'a '((a . 1) (b . 2) (c . 3)) :test-not 'eq))) + (let ((result (cl-assoc 'a '((a . 1) (b . 2) (c . 3)) :test-not #'eq))) (should (equal result '(b . 2)))) - (let ((result (cl-assoc '2 '((1 . 'a) (2 . 'b) (3 . 'c)) :key 'identity))) + (let ((result (cl-assoc '2 '((1 . 'a) (2 . 'b) (3 . 'c)) :key #'identity))) (should (equal result '(2 . 'b)))) - (let ((result (cl-assoc 'a '((a . 1) (a . 2) (a . 3)) :test 'eq))) + (let ((result (cl-assoc 'a '((a . 1) (a . 2) (a . 3)) :test #'eq))) (should (equal result '(a . 1)))) (let ((result (cl-assoc 'a '()))) (should (equal result nil))) @@ -650,105 +638,142 @@ Body are forms defining the test." (should (equal result '(b . 2))))) (ert-deftest cl-assoc-if-test () - (let ((result (cl-assoc-if #'cl-evenp '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) + (let ((result (cl-assoc-if #'cl-evenp + '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) (should (equal result '(2 . "even")))) - (let ((result (cl-assoc-if #'(lambda (x) (= x 5)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if (lambda (x) (= x 5)) + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result nil))) - (let ((result (cl-assoc-if #'(lambda (x) (= x 1)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if (lambda (x) (= x 1)) + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result '(1 . "one")))) - (let ((result (cl-assoc-if #'(lambda (x) (string= x "baz")) '((foo . 1) (bar . 2) (baz . 3))))) + (let ((result (cl-assoc-if (lambda (x) (string= x "baz")) + '((foo . 1) (bar . 2) (baz . 3))))) (should (equal result '(baz . 3)))) - (let ((result (cl-assoc-if (lambda (x) (and (numberp x) (> x 2))) '((1 . "one") (3 . "three") (4 . "four"))))) + (let ((result (cl-assoc-if (lambda (x) (and (numberp x) (> x 2))) + '((1 . "one") (3 . "three") (4 . "four"))))) (should (equal result '(3 . "three")))) - (let ((result (cl-assoc-if #'(lambda (x) (> x 1)) '((0 . "zero") (1 . "one") (2 . "two"))))) + (let ((result (cl-assoc-if (lambda (x) (> x 1)) + '((0 . "zero") (1 . "one") (2 . "two"))))) (should (equal result '(2 . "two")))) (let ((result (cl-assoc-if #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-assoc-if #'(lambda (x) (eq x 'a)) '((a . "first") (a . "second") (b . "third"))))) + (let ((result (cl-assoc-if (lambda (x) (eq x 'a)) + '((a . "first") (a . "second") (b . "third"))))) (should (equal result '(a . "first")))) - (let ((result (cl-assoc-if #'(lambda (x) (and (symbolp x) (not (eq x 'b)))) '((b . "b") (c . "c") (d . "d"))))) + (let ((result (cl-assoc-if (lambda (x) (and (symbolp x) (not (eq x 'b)))) + '((b . "b") (c . "c") (d . "d"))))) (should (equal result '(c . "c")))) - (let ((result (cl-assoc-if (lambda (x) (and (listp x) (> (length x) 1))) '(((1 2) . "pair 1") ((1) . "pair 2"))))) + (let ((result (cl-assoc-if #'cdr '(((1 2) . "pair 1") ((1) . "pair 2"))))) (should (equal result '((1 2) . "pair 1"))))) (ert-deftest cl-assoc-if-not-test () - (let ((result (cl-assoc-if-not #'cl-evenp '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))))) + (let* ((alist '((1 . "odd") (2 . "even") (3 . "odd") (4 . "even"))) + (result (cl-assoc-if-not #'cl-evenp alist))) (should (equal result '(1 . "odd")))) - (let ((result (cl-assoc-if-not #'(lambda (x) (> x 0)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if-not #'cl-plusp + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result nil))) - (let ((result (cl-assoc-if-not #'(lambda (x) (< x 5)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if-not (lambda (x) (< x 5)) + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result nil))) - (let ((result (cl-assoc-if-not #'(lambda (x) (= x 1)) '((1 . "one") (2 . "two") (3 . "three"))))) + (let ((result (cl-assoc-if-not (lambda (x) (= x 1)) + '((1 . "one") (2 . "two") (3 . "three"))))) (should (equal result '(2 . "two")))) - (let ((result (cl-assoc-if-not #'(lambda (x) (string= x "baz")) '((foo . "first") (bar . "second") (baz . "third"))))) + (let ((result (cl-assoc-if-not + (lambda (x) (string= x "baz")) + '((foo . "first") (bar . "second") (baz . "third"))))) (should (equal result '(foo . "first")))) - (let ((result (cl-assoc-if-not (lambda (x) (and (numberp x) (> x 2))) '((1 . "one") (3 . "three") (4 . "four"))))) + (let ((result (cl-assoc-if-not (lambda (x) (and (numberp x) (> x 2))) + '((1 . "one") (3 . "three") (4 . "four"))))) (should (equal result '(1 . "one")))) - (let ((result (cl-assoc-if-not #'(lambda (x) (symbolp x)) '((1 . "one") (b . "bee") (2 . "two"))))) + (let ((result (cl-assoc-if-not #'symbolp + '((1 . "one") (b . "bee") (2 . "two"))))) (should (equal result '(1 . "one")))) (let ((result (cl-assoc-if-not #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-assoc-if-not #'(lambda (x) (eq x 'a)) '((a . "first") (a . "second") (b . "third"))))) + (let ((result (cl-assoc-if-not (lambda (x) (eq x 'a)) + '((a . "first") (a . "second") (b . "third"))))) (should (equal result '(b . "third"))))) (ert-deftest cl-rassoc-test () - (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("three" . 3))))) - (should (equal result (cons "two" 2)))) - (let ((result (cl-rassoc 4 '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc 4 '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil))) - (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("baz" . 2)) :test 'equal))) - (should (equal result (cons "two" 2)))) - (let ((result (cl-rassoc 2 '(( "one" . 1) ("two" . 2) ("three" . 3)) :test-not 'equal))) - (should (equal result (cons "one" 1)))) + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("baz" . 2)) + :test #'equal))) + (should (equal result '("two" . 2)))) + (let ((result (cl-rassoc 2 '(("one" . 1) ("two" . 2) ("three" . 3)) + :test-not #'equal))) + (should (equal result '("one" . 1)))) (let ((result (cl-rassoc 1 '()))) (should (equal result nil))) - (let ((result (cl-rassoc 1 '(( "first" . 1) ("second" . 1) ("third" . 1))))) - (should (equal result (cons "first" 1)))) - (let ((result (cl-rassoc 3 '(( "one" . 1) ("two" . 2) ("three" . 3))))) - (should (equal result (cons "three" 3)))) - (let ((result (cl-rassoc 'found '((( "pair 1") . 1) ( "pair 2" . 2) ( "pair 3" . 3))))) + (let ((result (cl-rassoc 1 '(("first" . 1) ("second" . 1) ("third" . 1))))) + (should (equal result '("first" . 1)))) + (let ((result (cl-rassoc 3 '(("one" . 1) ("two" . 2) ("three" . 3))))) + (should (equal result '("three" . 3)))) + (let ((result (cl-rassoc 'found + '((("pair 1") . 1) ("pair 2" . 2) ("pair 3" . 3))))) (should (equal result nil)))) (ert-deftest cl-rassoc-if-test () - (let ((result (cl-rassoc-if #'cl-evenp '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if #'cl-evenp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("two" . 2)))) - (let ((result (cl-rassoc-if #'cl-evenp '(( "one" . 1) ("three" . 3) ("five" . 5))))) + (let ((result (cl-rassoc-if #'cl-evenp + '(("one" . 1) ("three" . 3) ("five" . 5))))) (should (equal result nil))) - (let ((result (cl-rassoc-if #'(lambda (x) (= x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if (lambda (x) (= x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("one" . 1)))) - (let ((result (cl-rassoc-if (lambda (x) (> x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if (lambda (x) (> x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("two" . 2)))) - (let ((result (cl-rassoc-if #'(lambda (x) (and (numberp x) (< x 3))) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if (lambda (x) (and (numberp x) (< x 3))) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("one" . 1)))) (let ((result (cl-rassoc-if #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-rassoc-if #'(lambda (x) (> x 0)) '(( "first" . 1) ("second" . 2) ("third" . 3))))) + (let ((result (cl-rassoc-if #'cl-plusp + '(("first" . 1) ("second" . 2) ("third" . 3))))) (should (equal result '("first" . 1)))) - (let ((result (cl-rassoc-if #'(lambda (x) (string= (number-to-string x) "two")) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if (lambda (x) (string= (number-to-string x) "two")) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil))) - (let ((result (cl-rassoc-if #'(lambda (x) (stringp x)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if #'stringp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil)))) (ert-deftest cl-rassoc-if-not-test () - (let ((result (cl-rassoc-if-not #'cl-evenp '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not #'cl-evenp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("one" . 1)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (> x 0)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not #'cl-plusp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (< x 5)) '(( "one" . 1) ("two" . 2) ("six" . 6))))) - (should (equal result '( "six" . 6)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (= x 1)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not (lambda (x) (< x 5)) + '(("one" . 1) ("two" . 2) ("six" . 6))))) + (should (equal result '("six" . 6)))) + (let ((result (cl-rassoc-if-not (lambda (x) (= x 1)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("two" . 2)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (> x 2)) '(( "one" . 1) ("two" . 1) ("three" . 3))))) + (let ((result (cl-rassoc-if-not (lambda (x) (> x 2)) + '(("one" . 1) ("two" . 1) ("three" . 3))))) (should (equal result '("one" . 1)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (and (numberp x) (< x 3))) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not (lambda (x) (and (numberp x) (< x 3))) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("three" . 3)))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (equal x 2)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not (lambda (x) (equal x 2)) + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result '("one" . 1)))) (let ((result (cl-rassoc-if-not #'cl-evenp '()))) (should (equal result nil))) - (let ((result (cl-rassoc-if-not #'(lambda (x) (numberp x)) '(( "one" . 1) ("two" . 2) ("three" . 3))))) + (let ((result (cl-rassoc-if-not #'numberp + '(("one" . 1) ("two" . 2) ("three" . 3))))) (should (equal result nil))) - (let ((result (cl-rassoc-if-not (lambda (x) (and (listp x) (= (length x) 1))) '(((1 2) . 1) ((3 4) . 2) ((5) . 2))))) + (let ((result (cl-rassoc-if-not (lambda (x) (eql (proper-list-p x) 1)) + '(((1 2) . 1) ((3 4) . 2) ((5) . 2))))) (should (equal result '((1 2) . 1))))) (ert-deftest cl-intersection-test () @@ -760,9 +785,9 @@ Body are forms defining the test." (should (equal result '(1 2 3)))) (let ((result (cl-intersection '(1 1 2 3) '(1 2 2 3 4)))) (should (equal result '(3 2 1 1)))) - (let ((result (cl-intersection '(1 "two" 3) '(3 "two" 4)))) + (let ((result (cl-intersection `(1 ,(copy-sequence "two") 3) '(3 "two" 4)))) (should (equal result '(3)))) - (let ((result (cl-intersection '(1 2 3) '(3 2 1) :test 'equal))) + (let ((result (cl-intersection '(1 2 3) '(3 2 1) :test #'equal))) (should (equal result '(1 2 3)))) (let ((result (cl-intersection '(1 2 3) '(3 4 5) :key #'identity))) (should (equal result '(3)))) @@ -774,52 +799,20 @@ Body are forms defining the test." (should (equal result '(5 4 3))))) (ert-deftest cl-nintersection-test () - (let ((list1 '(1 2 3 4)) - (list2 '(3 4 5 6))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '(4 3))) - (should (equal list1 '(1 2 3 4))) - (should (equal list2 '(3 4 5 6))))) - (let ((list1 '(1 2)) - (list2 '(3 4))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '())) - (should (equal list1 '(1 2))) - (should (equal list2 '(3 4))))) - (let ((list1 '(1 2 3)) - (list2 '(1 2 3))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '(1 2 3))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(1 2 3))))) - (let ((list1 '(1 1 2 2 3)) - (list2 '(2 2 3 4))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '(3 2 2))) - (should (equal list1 '(1 1 2 2 3))) - (should (equal list2 '(2 2 3 4))))) - (let ((list1 '(1 "two" 3)) - (list2 '(3 "two" 4))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '(3))) - (should (equal list1 '(1 "two" 3))) - (should (equal list2 '(3 "two" 4))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 1))) - (let ((result (cl-nintersection list1 list2 :test 'equal))) - (should (equal result '(1 2 3))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 1))))) - (let ((list1 '()) - (list2 '(1 2 3))) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '())) - (should (equal list1 '())) - (should (equal list2 '(1 2 3))))) - (let ((list1 '()) - (list2 '())) - (let ((result (cl-nintersection list1 list2))) - (should (equal result '()))))) + (should-not (cl-nintersection () ())) + (should-not (cl-nintersection () (list 1 2 3))) + (should-not (cl-nintersection (list 1 2) (list 3 4))) + (should (equal (cl-nintersection (list 1 2 3 4) (list 3 4 5 6)) + '(4 3))) + (should (equal (cl-nintersection (list 1 2 3) (list 1 2 3)) + '(1 2 3))) + (should (equal (cl-nintersection (list 1 1 2 2 3) (list 2 2 3 4)) + '(3 2 2))) + (should (equal (cl-nintersection (list 1 (copy-sequence "two") 3) + (list 3 "two" 4)) + '(3))) + (should (equal (cl-nintersection (list 1 2 3) (list 3 2 1) :test #'equal) + '(1 2 3)))) (ert-deftest cl-set-difference-test () (let ((result (cl-set-difference '(1 2 3 4) '(3 4 5 6)))) @@ -832,11 +825,11 @@ Body are forms defining the test." (should (equal result '(1 1 2)))) (let ((result (cl-set-difference '(1 2 3) '(3 2 4)))) (should (equal result '(1)))) - (let ((result (cl-set-difference '(1 2 3) '(3 2 1) :test 'equal))) + (let ((result (cl-set-difference '(1 2 3) '(3 2 1) :test #'equal))) (should (equal result '()))) (let ((result (cl-set-difference '((1 . "one") (2 . "two") (3 . "three")) - '((1 . "uno") (2 . "dos")) - :key 'car))) + '((1 . "uno") (2 . "dos")) + :key #'car))) (should (equal result '((3 . "three"))))) (let ((result (cl-set-difference '() '(1 2 3)))) (should (equal result '()))) @@ -844,65 +837,29 @@ Body are forms defining the test." (should (equal result '(1 2 3)))) (let ((result (cl-set-difference '(1 2 3 4 5) '(3 4 5 6 7)))) (should (equal result '(1 2)))) - (let ((list1 '(1 2 3)) - (list2 '(2 3 4))) - (cl-set-difference list1 list2) + (let ((list1 (list 1 2 3)) + (list2 (list 2 3 4))) + (should (equal (cl-set-difference list1 list2) '(1))) (should (equal list1 '(1 2 3))) (should (equal list2 '(2 3 4))))) (ert-deftest cl-nset-difference-test () - (let ((list1 '(1 2 3 4)) - (list2 '(3 4 5 6))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1 2))) - (should (equal list1 '(1 2 3 4))) - (should (equal list2 '(3 4 5 6))))) - (let ((list1 '(1 2 3)) - (list2 '())) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1 2 3))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '())))) - (let ((list1 '(1 2 3)) - (list2 '(1 2 3))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '())) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(1 2 3))))) - (let ((list1 '(1 1 2 2 3)) - (list2 '(3 4 5))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1 1 2 2))) - (should (equal list1 '(1 1 2 2 3))) - (should (equal list2 '(3 4 5))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 4))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 4))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 1))) - (let ((result (cl-nset-difference list1 list2 :test 'equal))) - (should (equal result '())) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 1))))) - (let ((list1 '()) - (list2 '(1 2 3))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '())) - (should (equal list1 '())) - (should (equal list2 '(1 2 3))))) - (let ((list1 '()) - (list2 '())) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '())))) - (let ((list1 '(1 2 3 4 5)) - (list2 '(3 4 5 6 7))) - (let ((result (cl-nset-difference list1 list2))) - (should (equal result '(1 2))) - (should (equal list1 '(1 2 3 4 5))) - (should (equal list2 '(3 4 5 6 7)))))) + (should-not (cl-nset-difference () ())) + (should-not (cl-nset-difference () (list 1 2 3))) + (should-not (cl-nset-difference (list 1 2 3) (list 1 2 3))) + (should-not (cl-nset-difference (list 1 2 3) (list 3 2 1) :test #'equal)) + (should (equal (cl-nset-difference (list 1 2 3) ()) + '(1 2 3))) + (should (equal (cl-nset-difference (list 1 2 3 4) (list 3 4 5 6)) + '(1 2))) + (should (equal (cl-nset-difference (list 1 1 2 2 3) (list 3 4 5)) + '(1 1 2 2))) + (should (equal (cl-nset-difference (list 1 2 3) (list 3 2 4)) + '(1))) + (should (equal (cl-nset-difference (list 1 2 3 4 5) (list 3 4 5 6 7)) + '(1 2))) + (should (equal (cl-nset-difference (list 1 (copy-sequence "a")) (list 1 "a")) + '("a")))) (ert-deftest cl-set-exclusive-or-test () (let ((result (cl-set-exclusive-or '(1 2 3) '(3 4 5)))) @@ -919,104 +876,51 @@ Body are forms defining the test." (should (equal result '(1 2 4 5)))) (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 4)))) (should (equal result '(1 4)))) - (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 1) :test 'equal))) + (let ((result (cl-set-exclusive-or '(1 2 3) '(3 2 1) :test #'equal))) (should (equal result '()))) (let ((result (cl-set-exclusive-or '() '()))) (should (equal result '()))) - (let ((result (cl-set-exclusive-or '(1 2 3 4 5) '(3 4 5 6 7))) - (list1 '(1 2 3 4 5)) - (list2 '(3 4 5 6 7))) - (should (equal result '(1 2 6 7))) + (let ((list1 (list 1 2 3 4 5)) + (list2 (list 3 4 5 6 7))) + (should (equal (cl-set-exclusive-or list1 list2) '(1 2 6 7))) (should (equal list1 '(1 2 3 4 5))) (should (equal list2 '(3 4 5 6 7))))) (ert-deftest cl-nset-exclusive-or-test () - (let ((list1 '(1 2 3)) - (list2 '(3 4 5))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 4 5))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 4 5))))) - (let ((list1 '(1 2 3)) - (list2 '())) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 3))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '())))) - (let ((list1 '(1 2 3)) - (list2 '(1 2 3))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result nil))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(1 2 3)))) - (let ((list1 '(1 1 2 2 3)) - (list2 '(3 4 5))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 1 2 2 4 5))) - (should (equal list1 '(1 1 2 2 3))) - (should (equal list2 '(3 4 5))))) - (let ((list1 '(1 2 3)) - (list2 '(3 3 4 5))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 4 5))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 3 4 5))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 4))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 4))) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 4))))) - (let ((list1 '(1 2 3)) - (list2 '(3 2 1))) - (let ((result (cl-nset-exclusive-or list1 list2 :test 'equal))) - (should (equal result '())) - (should (equal list1 '(1 2 3))) - (should (equal list2 '(3 2 1))))) - (let ((list1 '()) - (list2 '(1 2 3))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 3))) - (should (equal list1 '())) - (should (equal list2 '(1 2 3))))) - (let ((list1 '()) - (list2 '())) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '())))) - (let ((list1 '(1 2 3 4 5)) - (list2 '(3 4 5 6 7))) - (let ((result (cl-nset-exclusive-or list1 list2))) - (should (equal result '(1 2 6 7))) - (should (equal list1 '(1 2 3 4 5))) - (should (equal list2 '(3 4 5 6 7)))))) + (should-not (cl-nset-exclusive-or () ())) + (should-not (cl-nset-exclusive-or (list 1 2 3) (list 1 2 3))) + (should-not (cl-nset-exclusive-or (list 1 2 3) (list 3 2 1) :test #'equal)) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 4 5)) + '(1 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) ()) + '(1 2 3))) + (should (equal (cl-nset-exclusive-or (list 1 1 2 2 3) (list 3 4 5)) + '(1 1 2 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 3 4 5)) + '(1 2 4 5))) + (should (equal (cl-nset-exclusive-or (list 1 2 3) (list 3 2 4)) + '(1 4))) + (should (equal (cl-nset-exclusive-or () (list 1 2 3)) + '(1 2 3))) + (should (equal (cl-nset-exclusive-or (list 1 2 3 4 5) (list 3 4 5 6 7)) + '(1 2 6 7)))) (ert-deftest cl-subsetp-test () - (let ((result (cl-subsetp '(1 2) '(1 2 3 4)))) - (should (equal result t))) - (let ((result (cl-subsetp '() '(1 2 3 4)))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 2) '()))) - (should (equal result nil))) - (let ((result (cl-subsetp '(1 2 3) '(1 2 3)))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 1 2) '(1 2 3)))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 2) '(1 1 2 3 4)))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 "two" 3) '(3 "two" 1)))) - (should (equal result nil))) - (let ((result (cl-subsetp '(1 2) '(2 1) :test 'equal))) - (should (equal result t))) - (let ((result (cl-subsetp '((1 . "one") (2 . "two")) '((1 . "uno") (2 . "dos")) :key 'car))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 2) '(3 4 2 1) :test 'eq))) - (should (equal result t))) - (let ((result (cl-subsetp '((1 2) (3)) '((1 2 . "found") (3 . "found")) :key 'car))) - (should (equal result t))) - (let ((result (cl-subsetp '(1 2) '(1 2 3 2)))) - (should (equal result t))) - (let ((result (cl-subsetp '() '()))) - (should (equal result t)))) + (should (cl-subsetp '(1 2) '(1 2 3 4))) + (should (cl-subsetp () '(1 2 3 4))) + (should-not (cl-subsetp '(1 2) ())) + (should (cl-subsetp '(1 2 3) '(1 2 3))) + (should (cl-subsetp '(1 1 2) '(1 2 3))) + (should (cl-subsetp '(1 2) '(1 1 2 3 4))) + (should-not (cl-subsetp '(1 "two" 3) '(3 "two" 1))) + (should (cl-subsetp '(1 2) '(2 1) :test #'equal)) + (should (cl-subsetp '((1 . "one") (2 . "two")) + '((1 . "uno") (2 . "dos")) + :key #'car)) + (should (cl-subsetp '(1 2) '(3 4 2 1) :test #'eq)) + (should (cl-subsetp '((1 2) (3)) '((1 2 . "found") (3 . "found")) :key #'car)) + (should (cl-subsetp '(1 2) '(1 2 3 2))) + (should (cl-subsetp () ()))) (provide 'cl-seq-tests) ;;; cl-seq-tests.el ends here commit 9746fbc26415b5bff883b2134f316b2678528295 Author: Basil L. Contovounesios Date: Thu Feb 13 18:40:07 2025 +0100 ; Fix last change to cl-extra.el. diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index c9aa9a58cab..7732a848d3b 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -561,8 +561,8 @@ If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. Signal an error if START or END are outside of the sequence (i.e too large if positive or too small if negative)." - (declare (side-effect-free t)) - (declare (gv-setter + (declare (side-effect-free t) + (gv-setter (lambda (new) (macroexp-let2 nil new new `(progn (cl-replace ,seq ,new :start1 ,start :end1 ,end) commit 7d9e67be13f72b7c7c8815f651c8fa5f74a79c54 Author: Stefan Kangas Date: Thu Feb 13 04:24:05 2025 +0100 Inline side-effect-free declarations in cl-lib.el * lisp/emacs-lisp/cl-macs.el: Move side-effect-free declarations from here... * lisp/emacs-lisp/cl-extra.el (cl-gcd, cl-lcm, cl-isqrt, cl-floor) (cl-ceiling, cl-truncate, cl-round, cl-mod, cl-rem, cl-signum) (cl-subseq, cl-list-length, cl-get, cl-getf): * lisp/emacs-lisp/cl-lib.el (cl-plusp, cl-minusp, cl-oddp, cl-evenp) (cl-fifth, cl-sixth, cl-seventh, cl-eighth, cl-ninth, cl-tenth) (cl-ldiff, cl-pairlis): * lisp/emacs-lisp/cl-seq.el (cl-endp): ...to have them inline here. * lisp/emacs-lisp/cl-macs.el: Move side-effect-and-error-free declarations from here... * lisp/emacs-lisp/cl-extra.el (cl-equalp, cl-random-state-p): * lisp/emacs-lisp/cl-lib.el (cl-list*, cl-acons): ...to have them inline here. (Bug#76247) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 96260c3aff8..c9aa9a58cab 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -69,6 +69,7 @@ TYPE is a Common Lisp type specifier. This is like `equal', except that it accepts numerically equal numbers of different types (float vs. integer), and also compares strings case-insensitively." + (declare (side-effect-free error-free)) (cond ((eq x y) t) ((stringp x) (and (stringp y) (string-equal-ignore-case x y))) @@ -317,6 +318,7 @@ non-nil value. ;;;###autoload (defun cl-gcd (&rest args) "Return the greatest common divisor of the arguments." + (declare (side-effect-free t)) (let ((a (or (pop args) 0))) (dolist (b args) (while (/= b 0) @@ -326,6 +328,7 @@ non-nil value. ;;;###autoload (defun cl-lcm (&rest args) "Return the least common multiple of the arguments." + (declare (side-effect-free t)) (if (memq 0 args) 0 (let ((a (or (pop args) 1))) @@ -336,6 +339,7 @@ non-nil value. ;;;###autoload (defun cl-isqrt (x) "Return the integer square root of the (integer) argument X." + (declare (side-effect-free t)) (if (and (integerp x) (> x 0)) (let ((g (ash 2 (/ (logb x) 2))) g2) @@ -348,6 +352,7 @@ non-nil value. (defun cl-floor (x &optional y) "Return a list of the floor of X and the fractional part of X. With two arguments, return floor and remainder of their quotient." + (declare (side-effect-free t)) (let ((q (floor x y))) (list q (- x (if y (* y q) q))))) @@ -355,6 +360,7 @@ With two arguments, return floor and remainder of their quotient." (defun cl-ceiling (x &optional y) "Return a list of the ceiling of X and the fractional part of X. With two arguments, return ceiling and remainder of their quotient." + (declare (side-effect-free t)) (let ((res (cl-floor x y))) (if (= (car (cdr res)) 0) res (list (1+ (car res)) (- (car (cdr res)) (or y 1)))))) @@ -363,6 +369,7 @@ With two arguments, return ceiling and remainder of their quotient." (defun cl-truncate (x &optional y) "Return a list of the integer part of X and the fractional part of X. With two arguments, return truncation and remainder of their quotient." + (declare (side-effect-free t)) (if (eq (>= x 0) (or (null y) (>= y 0))) (cl-floor x y) (cl-ceiling x y))) @@ -370,6 +377,7 @@ With two arguments, return truncation and remainder of their quotient." (defun cl-round (x &optional y) "Return a list of X rounded to the nearest integer and the remainder. With two arguments, return rounding and remainder of their quotient." + (declare (side-effect-free t)) (if y (if (and (integerp x) (integerp y)) (let* ((hy (/ y 2)) @@ -388,16 +396,19 @@ With two arguments, return rounding and remainder of their quotient." ;;;###autoload (defun cl-mod (x y) "The remainder of X divided by Y, with the same sign as Y." + (declare (side-effect-free t)) (nth 1 (cl-floor x y))) ;;;###autoload (defun cl-rem (x y) "The remainder of X divided by Y, with the same sign as X." + (declare (side-effect-free t)) (nth 1 (cl-truncate x y))) ;;;###autoload (defun cl-signum (x) "Return 1 if X is positive, -1 if negative, 0 if zero." + (declare (side-effect-free t)) (cond ((> x 0) 1) ((< x 0) -1) (t 0))) ;;;###autoload @@ -441,12 +452,13 @@ as an integer unless JUNK-ALLOWED is non-nil." ;; Random numbers. (defun cl--random-time () - "Return high-precision timestamp from `time-convert'. + "Return high-precision timestamp from `time-convert'. For example, suitable for use as seed by `cl-make-random-state'." - (car (time-convert nil t))) + (car (time-convert nil t))) ;;;###autoload (autoload 'cl-random-state-p "cl-extra") +;;;###autoload (function-put 'cl-random-state-p 'side-effect-free 'error-free) (cl-defstruct (cl--random-state (:copier nil) (:predicate cl-random-state-p) @@ -549,6 +561,7 @@ If END is omitted, it defaults to the length of the sequence. If START or END is negative, it counts from the end. Signal an error if START or END are outside of the sequence (i.e too large if positive or too small if negative)." + (declare (side-effect-free t)) (declare (gv-setter (lambda (new) (macroexp-let2 nil new new @@ -581,6 +594,7 @@ too large if positive or too small if negative)." ;;;###autoload (defun cl-list-length (x) "Return the length of list X. Return nil if list is circular." + (declare (side-effect-free t)) (cl-check-type x list) (condition-case nil (length x) @@ -599,7 +613,8 @@ too large if positive or too small if negative)." (defun cl-get (sym tag &optional def) "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none. \n(fn SYMBOL PROPNAME &optional DEFAULT)" - (declare (compiler-macro cl--compiler-macro-get) + (declare (side-effect-free t) + (compiler-macro cl--compiler-macro-get) (gv-setter (lambda (store) (ignore def) `(put ,sym ,tag ,store)))) (cl-getf (symbol-plist sym) tag def)) (autoload 'cl--compiler-macro-get "cl-macs") @@ -609,7 +624,8 @@ too large if positive or too small if negative)." "Search PROPLIST for property PROPNAME; return its value or DEFAULT. PROPLIST is a list of the sort returned by `symbol-plist'. \n(fn PROPLIST PROPNAME &optional DEFAULT)" - (declare (gv-expander + (declare (side-effect-free t) + (gv-expander (lambda (do) (gv-letplace (getter setter) plist (macroexp-let2* nil ((k tag) (d def)) diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 20d2c8d6a68..1ec850cf0e8 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -272,20 +272,24 @@ so that they are registered at compile-time as well as run-time." (defsubst cl-plusp (number) "Return t if NUMBER is positive." + (declare (side-effect-free t)) (> number 0)) (defsubst cl-minusp (number) "Return t if NUMBER is negative." + (declare (side-effect-free t)) (< number 0)) (defun cl-oddp (integer) "Return t if INTEGER is odd." - (declare (compiler-macro (lambda (_) `(eq (logand ,integer 1) 1)))) + (declare (side-effect-free t) + (compiler-macro (lambda (_) `(eq (logand ,integer 1) 1)))) (eq (logand integer 1) 1)) (defun cl-evenp (integer) "Return t if INTEGER is even." - (declare (compiler-macro (lambda (_) `(eq (logand ,integer 1) 0)))) + (declare (side-effect-free t) + (compiler-macro (lambda (_) `(eq (logand ,integer 1) 0)))) (eq (logand integer 1) 0)) (defconst cl-digit-char-table @@ -387,32 +391,38 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp (defsubst cl-fifth (x) "Return the fifth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 4 ,x) ,store)))) (nth 4 x)) (defsubst cl-sixth (x) "Return the sixth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 5 ,x) ,store)))) (nth 5 x)) (defsubst cl-seventh (x) "Return the seventh element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 6 ,x) ,store)))) (nth 6 x)) (defsubst cl-eighth (x) "Return the eighth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 7 ,x) ,store)))) (nth 7 x)) (defsubst cl-ninth (x) "Return the ninth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 8 ,x) ,store)))) (nth 8 x)) (defsubst cl-tenth (x) "Return the tenth element of the list X." - (declare (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) + (declare (side-effect-free t) + (gv-setter (lambda (store) `(setcar (nthcdr 9 ,x) ,store)))) (nth 9 x)) (defalias 'cl-caaar #'caaar) @@ -456,7 +466,8 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to `(cons A (cons B (cons C D)))'. \n(fn ARG...)" - (declare (compiler-macro cl--compiler-macro-list*)) + (declare (side-effect-free error-free) + (compiler-macro cl--compiler-macro-list*)) (cond ((not rest) arg) ((not (cdr rest)) (cons arg (car rest))) (t (let* ((n (length rest)) @@ -467,6 +478,7 @@ Thus, `(cl-list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to (defun cl-ldiff (list sublist) "Return a copy of LIST with the tail SUBLIST removed." + (declare (side-effect-free t)) (let ((res nil)) (while (and (consp list) (not (eq list sublist))) (push (pop list) res)) @@ -523,6 +535,7 @@ Return a copy of TREE with all elements `eql' to OLD replaced by NEW. (defun cl-acons (key value alist) "Add KEY and VALUE to ALIST. Return a new list with (cons KEY VALUE) as car and ALIST as cdr." + (declare (side-effect-free error-free)) (cons (cons key value) alist)) (defun cl-pairlis (keys values &optional alist) @@ -530,6 +543,7 @@ Return a new list with (cons KEY VALUE) as car and ALIST as cdr." Return a new alist composed by associating KEYS to corresponding VALUES; the process stops as soon as KEYS or VALUES run out. If ALIST is non-nil, the new pairs are prepended to it." + (declare (side-effect-free t)) (nconc (cl-mapcar 'cons keys values) alist)) ;;; Miscellaneous. diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 9b76c8c80a0..1da218934ab 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -3729,20 +3729,6 @@ macro that returns its `&whole' argument." (cl-proclaim '(inline cl-acons cl-map cl-notany cl-notevery cl-revappend cl-nreconc)) -;;; Things that are side-effect-free. -(mapc (lambda (x) (function-put x 'side-effect-free t)) - '(cl-first cl-second cl-third cl-fourth - cl-fifth cl-sixth cl-seventh - cl-eighth cl-ninth cl-tenth - cl-rest cl-endp cl-plusp cl-minusp - cl-oddp cl-evenp cl-signum cl-ldiff cl-pairlis cl-gcd - cl-lcm cl-isqrt cl-floor cl-ceiling cl-truncate cl-round cl-mod cl-rem - cl-subseq cl-list-length cl-get cl-getf)) - -;;; Things that are side-effect-and-error-free. -(mapc (lambda (x) (function-put x 'side-effect-free 'error-free)) - '(cl-list* cl-acons cl-equalp - cl-random-state-p copy-tree)) ;;; Things whose return value should probably be used. (mapc (lambda (x) (function-put x 'important-return-value t)) diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el index 7a79488f1f5..1878153f811 100644 --- a/lisp/emacs-lisp/cl-seq.el +++ b/lisp/emacs-lisp/cl-seq.el @@ -115,6 +115,7 @@ (defun cl-endp (x) "Return true if X is the empty list; false if it is a cons. Signal an error if X is not a list." + (declare (side-effect-free t)) (cl-check-type x list) (null x)) commit 745847ba8eca27e981a50ad91b628bbce35bb0f3 Author: Robert Pluim Date: Fri Jan 17 16:44:08 2025 +0100 Support non-ascii SMTP user and password strings The user and more importantly the password used when authenticating SMTP connections MUST be encoded in utf-8, and 'base64-encode-string' requires unibyte strings, so call 'encode-coding-string' on them before base64 encoding them in case they are multibyte strings. This applies to the CRAM-MD5, LOGIN, and PLAIN auth methods. XOAUTH2 access tokens are specified to contain only characters in the range #x20-#x7E (SPC through ~), so utf-8 encoding is not necessary. See RFC 4616 and RFC 4954 (or their later updates). * lisp/mail/smtpmail.el (smtpmail-try-auth-method): Encode user and password using utf-8 before base64 encoding. (Bug#75628) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 43291a3028b..db0510c7e84 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -599,6 +599,8 @@ USER and PASSWORD should be non-nil." (when (eq (car ret) 334) (let* ((challenge (substring (cadr ret) 4)) (decoded (base64-decode-string challenge)) + (password (encode-coding-string password 'utf-8)) + (user (encode-coding-string user 'utf-8)) (hash (rfc2104-hash 'md5 64 16 password decoded)) (response (concat user " " hash)) ;; Osamu Yamane : @@ -618,8 +620,10 @@ USER and PASSWORD should be non-nil." (cl-defmethod smtpmail-try-auth-method (process (_mech (eql 'login)) user password) (smtpmail-command-or-throw process "AUTH LOGIN") - (smtpmail-command-or-throw process (base64-encode-string user t)) - (smtpmail-command-or-throw process (base64-encode-string password t))) + (let ((password (encode-coding-string password 'utf-8)) + (user (encode-coding-string user 'utf-8))) + (smtpmail-command-or-throw process (base64-encode-string user t)) + (smtpmail-command-or-throw process (base64-encode-string password t)))) (cl-defmethod smtpmail-try-auth-method (process (_mech (eql 'plain)) user password) @@ -628,11 +632,13 @@ USER and PASSWORD should be non-nil." ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this ;; is not sent if the server did not advertise AUTH PLAIN in ;; the EHLO response. See RFC 2554 for more info. - (smtpmail-command-or-throw - process - (concat "AUTH PLAIN " - (base64-encode-string (concat "\0" user "\0" password) t)) - 235)) + (let ((password (encode-coding-string password 'utf-8)) + (user (encode-coding-string user 'utf-8))) + (smtpmail-command-or-throw + process + (concat "AUTH PLAIN " + (base64-encode-string (concat "\0" user "\0" password) t)) + 235))) (cl-defmethod smtpmail-try-auth-method (process (_mech (eql 'xoauth2)) user password) commit 315519fa7c8e5e142b6abca7b78a47ad3c0cbe37 Author: Robert Pluim Date: Thu Aug 22 18:49:12 2024 +0200 Teach gnus/message about international Re: variants * lisp/mail/mail-utils.el (mail-re-regexps): New defcustom, contains the components used to construct 'rmail-re-abbrevs' and 'message-subject-re-regexp'. * lisp/gnus/message.el (message-subject-re-regexp): Derive from 'mail-re-regexps'. (message-strip-subject-re): Make the match case-insensitive. * lisp/mail/rmail.el (rmail-re-abbrevs): Derive from 'mail-re-regexps'. Update 'rmail-reply-regexp' when it changes. (rmail-reply-regexp): Set to nil, 'rmail-re-abbrevs' will set it. * doc/emacs/rmail.texi (Rmail Reply): Describe 'mail-re-regexps'. * doc/misc/message.texi (Message Headers): Describe 'mail-re-regexps'. (Bug#72442) diff --git a/doc/emacs/rmail.texi b/doc/emacs/rmail.texi index 402386684ae..7a2ef9be16e 100644 --- a/doc/emacs/rmail.texi +++ b/doc/emacs/rmail.texi @@ -776,6 +776,14 @@ to. The @samp{To} field starts out as the address of the person who sent the message you received, and the @samp{CC} field starts out with all the other recipients of that message. +@vindex rmail-re-abbrevs +@vindex rmail-reply-prefix +@vindex mail-re-regexps +The @samp{Subject} header field may contain one or more instances of +@samp{Re:} or localized variants thereof. These are removed if they +match @code{rmail-re-abbrevs} (which is initialized from +@code{mail-re-regexps}), and @code{rmail-reply-prefix} is prepended. + @vindex mail-dont-reply-to-names You can exclude certain recipients from being included automatically in replies, using the variable @code{mail-dont-reply-to-names}. Its diff --git a/doc/misc/message.texi b/doc/misc/message.texi index 48ac487088e..418eb14e042 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -1688,13 +1688,14 @@ result is inserted. @item message-subject-re-regexp @vindex message-subject-re-regexp +@vindex mail-re-regexps @cindex Aw @cindex Sv @cindex Re Responses to messages have subjects that start with @samp{Re: }. This is @emph{not} an abbreviation of the English word ``response'', but it comes from the Latin ``res'', and means ``in the matter of''. Some -illiterate nincompoops have failed to grasp this fact, and have +standards-challenged companies have failed to grasp this fact, and have ``internationalized'' their software to use abominations like @samp{Aw: } (``antwort'') or @samp{Sv: } (``svar'') instead, which is meaningless and evil. However, you may have to deal with users that @@ -1726,6 +1727,16 @@ responding to a message: )) @end lisp +You shouldn't need to do this, since the default value of +@code{message-subject-re-regexp} is initialized based on +@code{mail-re-regexps}, which covers most known cases of such +internationalization, and is a lot easier to customize. Customizing +@code{mail-re-regexps} updates @code{message-subject-re-regexp} to +match. + +Note that the regexp is matched case-insensitively against the +@samp{Subject} header contents. + @item message-subject-trailing-was-query @vindex message-subject-trailing-was-query @vindex message-subject-trailing-was-ask-regexp diff --git a/etc/NEWS b/etc/NEWS index 419c9bd8d20..31109f0857c 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -660,6 +660,32 @@ only search in input history. If you customize it to the symbol 'dwim', those commands search in input history only when the point is after the last prompt. ++++ +** Mail-util + +*** New user option 'mail-re-regexps'. +This contains the list of regular expressions used to match "Re:" and +international variants of it when modifying the Subject field in +replies. + ++++ +** Rmail + +*** 'rmail-re-abbrevs' default value is now derived from 'mail-re-regexps'. +'mail-re-regexps' is a new user option that is easier to customize than +'rmail-re-abbrevs'. 'rmail-re-abbrevs' is still honored if it was +already set. + ++++ +** Message + +*** 'message-subject-re-regexp' default value is now derived from 'mail-re-regexps'. +'mail-re-regexps' is a new user option that is easier to customize than +'message-subject-re-regexp'. 'message-subject-re-regexp' is still +honored if it was already set. + +*** 'message-strip-subject-re' now matches case-insensitively. + ** SHR +++ diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 1d035220bba..dede5520d66 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -312,11 +312,20 @@ any confusion." regexp)) (defcustom message-subject-re-regexp - "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)* ?:[ \t]*\\)*[ \t]*" - "Regexp matching \"Re: \" in the subject line." + (mail--wrap-re-regexp + (concat + "\\(" + (string-join mail-re-regexps "\\|") + "\\)")) + "Regexp matching \"Re: \" in the subject line. +Matching is done case-insensitively. +Initialized from the value of `mail-re-regexps', which is easier to +customize." :group 'message-various :link '(custom-manual "(message)Message Headers") - :type 'regexp) + :type 'regexp + :set-after '(mail-re-regexps) + :version "31.1") (defcustom message-screenshot-command '("import" "png:-") "Command to take a screenshot. @@ -2264,10 +2273,12 @@ see `message-narrow-to-headers-or-head'." subject))) (defun message-strip-subject-re (subject) - "Remove \"Re:\" from subject lines in string SUBJECT." - (if (string-match message-subject-re-regexp subject) - (substring subject (match-end 0)) - subject)) + "Remove \"Re:\" from subject lines in string SUBJECT. +This uses `mail-re-regexps', matching is done case-insensitively." + (let ((case-fold-search t)) + (if (string-match message-subject-re-regexp subject) + (substring subject (match-end 0)) + subject))) (defcustom message-replacement-char "." "Replacement character used instead of unprintable or not decodable chars." diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index f8474da8f6d..5ddcb4b7686 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -46,6 +46,37 @@ also the To field, unless this would leave an empty To field." :type '(choice regexp (const :tag "Your Name" nil)) :group 'mail) +(defun mail--wrap-re-regexp (re) + (concat "\\`[ \t]*" + "\\(" + re + ; Re(1) or Re[1] or Re^1 + "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?" + ; SPC/NBSP followed by colon and TAB/SPC + " ?\u00a0*[::][ \t]*" + ; Handle repetition, eg "Re[1]: Re[2]:" + "\\)*" + "[ \t]*")) + +;;;###autoload +(defcustom mail-re-regexps + '("RE" "R\u00c9\\.?" "FWD?" "رد" "回复" "回覆" "SV" "Antw\\.?" + "VS" "REF" "AW" "ΑΠ" "ΣΧΕΤ" "השב" "Vá" "R" "RIF" "BLS" "RES" + "Odp" "YNT" "ATB") + "List of localized \"Re:\" abbreviations in various languages. +Each component can be a regular expression or a simple string. Matching +is done case-insensitively. Used to initialize the legacy +`rmail-re-abbrevs' and `message-subject-re-regexp' user options." + :type '(repeat regexp) + :set (lambda (sym val) + (custom-set-default sym val) + (dolist (sym '(rmail-re-abbrevs + message-subject-re-regexp)) + (when (get sym 'standard-value) + (custom-reevaluate-setting sym)))) + :group 'mail + :version "31.1") + (defvar epa-inhibit) ;; Returns t if file FILE is an Rmail file. ;;;###autoload diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 44b49293d08..4b93f379c72 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -525,22 +525,27 @@ Examples: (defvar rmail-reply-prefix "Re: " "String to prepend to Subject line when replying to a message.") -;; Note: this is matched with case-fold-search bound to t. -(defcustom rmail-re-abbrevs - "\\(RE\\|رد\\|回复\\|回覆\\|SV\\|Antw\\|VS\\|REF\\|AW\\|ΑΠ\\|ΣΧΕΤ\\|השב\\|Vá\\|R\\|RIF\\|BLS\\|RES\\|Odp\\|YNT\\|ATB\\)" - "Regexp with localized \"Re:\" abbreviations in various languages." - :version "28.1" - :type 'regexp) +(defvar rmail-reply-regexp nil ;; set by `rmail-re-abbrevs + "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.") ;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]:". ;; This pattern should catch all the common variants. ;; rms: I deleted the change to delete tags in square brackets ;; because they mess up RT tags. -(defvar rmail-reply-regexp - (concat "\\`\\(" - rmail-re-abbrevs - "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?\u00a0*[::] *\\)*") - "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.") +;; Note: this is matched with case-fold-search bound to t. +(defcustom rmail-re-abbrevs + (concat "\\(" + (string-join mail-re-regexps "\\|") + "\\)") + "Regexp with localized \"Re:\" abbreviations in various languages. +Matching is done case-insensitively. +Initialized from `mail-re-regexps', which is easier to customize." + :set-after '(mail-re-regexps) + :set (lambda (sym val) + (custom-set-default sym val) + (setq rmail-reply-regexp (mail--wrap-re-regexp val))) + :type 'regexp + :version "31.1") (defcustom rmail-display-summary nil "If non-nil, Rmail always displays the summary buffer." commit 2f8c2e64e03d85e2093b47e15aa35497054f922f Author: Robert Pluim Date: Wed Feb 12 11:34:16 2025 +0100 Use 'const' instead of 'symbol' in 'c-ts-mode-indent-style The 'symbol' widget is for when the user is expected to enter a symbol; when using a definite symbol, 'const' is preferred. * lisp/progmodes/c-ts-mode.el (c-ts-mode-indent-style): Use 'const' to define the options for a 'choice' widget. diff --git a/lisp/progmodes/c-ts-mode.el b/lisp/progmodes/c-ts-mode.el index 0396ddc2c8c..499c2ad66d4 100644 --- a/lisp/progmodes/c-ts-mode.el +++ b/lisp/progmodes/c-ts-mode.el @@ -147,10 +147,10 @@ This function takes no arguments and is expected to return a list of indent RULEs as described in `treesit-simple-indent-rules'. Note that the list of RULEs doesn't need to contain the language symbol." :version "29.1" - :type '(choice (symbol :tag "Gnu" gnu) - (symbol :tag "K&R" k&r) - (symbol :tag "Linux" linux) - (symbol :tag "BSD" bsd) + :type '(choice (const :tag "Gnu" gnu) + (const :tag "K&R" k&r) + (const :tag "Linux" linux) + (const :tag "BSD" bsd) (function :tag "A function for user customized style" ignore)) :set #'c-ts-mode--indent-style-setter :safe 'c-ts-indent-style-safep commit 167157fc210ae078e683c80dc650e6a2bb5a6050 Author: Michael Albinus Date: Thu Feb 13 11:21:30 2025 +0100 * lisp/net/tramp-archive.el (tramp-archive-all-gvfs-methods): Use `cdadr'. diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 03b1c001d0f..9df2b657e91 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -209,7 +209,7 @@ It must be supported by libarchive(3).") (defconst tramp-archive-all-gvfs-methods (cons tramp-archive-method - (let ((values (cdr (cadr (get 'tramp-gvfs-methods 'custom-type))))) + (let ((values (cdadr (get 'tramp-gvfs-methods 'custom-type)))) (setq values (mapcar #'last values) values (mapcar #'car values)))) "List of all methods `tramp-gvfs-methods' offers.") commit 6967587daef027b0f4fd917b5181b43e45c7cb56 Author: Björn Bidar Date: Fri Jan 31 03:24:44 2025 +0200 Bind sieve-refresh-scriptlist to 'g' in sieve-mode * lisp/net/sieve.el (sieve-manage-mode-map): Bind `sieve-refersh-scriptlist' to 'g' to refresh buffer. (sieve-refresh-scriptlist): Highlight in docstring that the function updates the current sieve buffer. (Bug#75956) * doc/misc/sieve.texi (Managing Sieve): Document new keybinding and the existing `sieve-refresh-scriptlist` function. diff --git a/doc/misc/sieve.texi b/doc/misc/sieve.texi index 5d4b3b369d7..deadc991173 100644 --- a/doc/misc/sieve.texi +++ b/doc/misc/sieve.texi @@ -213,6 +213,12 @@ Bury the Manage Sieve buffer without closing the connection. @findex sieve-help Displays help in the minibuffer. +@item g +@kindex g +@findex sieve-refresh-scriptlist +Refresh list of scripts found on the currently opened server. +Update contents of the current sieve buffer. + @item Q @kindex Q @findex sieve-manage-quit diff --git a/etc/NEWS b/etc/NEWS index 9b2558d14d7..419c9bd8d20 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -545,6 +545,13 @@ When called with a prefix argument, accepting, declining, or tentatively accepting an icalendar event will prompt for a comment to add to the response. +** Sieve + ++++ +*** New keybinding to refresh buffer in 'sieve-manage-mode'. +'sieve-refresh-scriptlist' is now bound to 'g' to refresh the contents +of the current sieve buffer. + ** Button +++ diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index 6bb17000919..9511bc30b0d 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -111,6 +111,7 @@ require \"fileinto\"; ;; various "?" #'sieve-help "h" #'sieve-help + "g" #'sieve-refresh-scriptlist ;; activating "m" #'sieve-activate "u" #'sieve-deactivate @@ -314,7 +315,8 @@ Used to bracket operations which move point in the sieve-buffer." (sieve-manage-authenticate))) (defun sieve-refresh-scriptlist () - "Refresh list of scripts found the currently opened server." + "Refresh list of scripts found on the currently opened server. +Update contents of the current sieve buffer." (interactive) (with-current-buffer sieve-buffer (setq buffer-read-only nil) commit c5bfaf1ae3ebc258b9d1597ea93df57a55272dcc Author: Björn Bidar Date: Fri Jan 31 02:53:34 2025 +0200 Add missing documentation strings in sieve.el * lisp/net/sieve.el (sieve-activate, sieve-deactivate-all) (sieve-remove, sieve-edit-script, sieve-refersh-scriptlist) (sieve-upload, sieve-upload-and-burry, sieve-upload-and-kill): Add documentation strings. (Bug#75956) diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index 1315cc23fa2..6bb17000919 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -161,6 +161,7 @@ require \"fileinto\"; (bury-buffer)) (defun sieve-activate (&optional _pos) + "Activate script at point." (interactive) (let ((name (sieve-script-at-point)) err) (when (or (null name) (string-equal name sieve-new-script)) @@ -173,6 +174,7 @@ require \"fileinto\"; (message "Activating script %s...failed: %s" name (nth 2 err))))) (defun sieve-deactivate-all (&optional _pos) + "Deactivate all currently active scripts." (interactive) (message "Deactivating scripts...") (let (;; (name (sieve-script-at-point)) @@ -185,6 +187,7 @@ require \"fileinto\"; (defalias 'sieve-deactivate #'sieve-deactivate-all) (defun sieve-remove (&optional _pos) + "Remove script at point." (interactive) (let ((name (sieve-script-at-point)) err) (when (or (null name) (string-equal name sieve-new-script)) @@ -197,6 +200,7 @@ require \"fileinto\"; (message "Removing sieve script %s...done" name))) (defun sieve-edit-script (&optional _pos) + "Edit script at point." (interactive) (let ((name (sieve-script-at-point))) (unless name @@ -310,6 +314,7 @@ Used to bracket operations which move point in the sieve-buffer." (sieve-manage-authenticate))) (defun sieve-refresh-scriptlist () + "Refresh list of scripts found the currently opened server." (interactive) (with-current-buffer sieve-buffer (setq buffer-read-only nil) @@ -357,6 +362,9 @@ specified, fall back to `sieve-manage-default-port'." ;;;###autoload (defun sieve-upload (&optional name) + "Upload script NAME to currently opened server. +If NAME is nil, detect it from script buffer name. +If no open sieve buffer exists, call `sieve-manage' first." (interactive) (when (or (get-buffer sieve-buffer) (save-current-buffer (call-interactively 'sieve-manage))) @@ -375,12 +383,14 @@ specified, fall back to `sieve-manage-default-port'." ;;;###autoload (defun sieve-upload-and-bury (&optional name) + "Upload script NAME and bury the current buffer." (interactive) (sieve-upload name) (bury-buffer)) ;;;###autoload (defun sieve-upload-and-kill (&optional name) + "Upload script NAME and kill the current buffer." (interactive) (sieve-upload name) (kill-buffer)) commit 07d1fdb1ea259e1832e0b0c03b2d2fc9a052037f Author: Björn Bidar Date: Fri Jan 31 02:34:19 2025 +0200 Make sieve-manage prompt also for port number (sieve-manage): Optionally read port number when called interactively. Add documentation string. (Bug#75956) diff --git a/lisp/net/sieve.el b/lisp/net/sieve.el index f9f036e1589..1315cc23fa2 100644 --- a/lisp/net/sieve.el +++ b/lisp/net/sieve.el @@ -338,7 +338,16 @@ Used to bracket operations which move point in the sieve-buffer." ;;;###autoload (defun sieve-manage (server &optional port) - (interactive "sServer: ") + "Open ManageSieve SERVER. +Optional argument PORT, if non-nil, specifies which port use; +otherwise it defaults to `sieve-manage-default-port'. + +When called interactively, prompt for SERVER and PORT. If PORT is not +specified, fall back to `sieve-manage-default-port'." + (interactive + (split-string (read-string + "Server and port (SERVER[:PORT]): ") + ":")) (switch-to-buffer (get-buffer-create sieve-buffer)) (sieve-manage-mode) (sieve-setup-buffer server port) commit d06606ff42b14d725c487ddc57005bc7a2eec1ba Author: Stefan Kangas Date: Thu Feb 13 07:48:07 2025 +0100 Avoid cl-caaar etc. compatibility aliases in Tramp * lisp/net/tramp-gvfs.el (tramp-gvfs-handler-askquestion): (tramp-gvfs-handler-mounted-unmounted): (tramp-gvfs-connection-mounted-p): * lisp/net/tramp-sh.el (tramp-sh-gio-monitor-process-filter): (tramp-sh-inotifywait-process-filter): Don't use cl-caaar etc. compatibility aliases. (Bug#76249) diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index 53a6ffc48aa..2f0593b0a93 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -1891,7 +1891,7 @@ a downcased host name only." ;; When the choice is "no", we set a dummy fuse-mountpoint in ;; order to leave the timeout. - (unless (zerop (cl-caddr result)) + (unless (zerop (caddr result)) (tramp-set-file-property v "/" "fuse-mountpoint" "/")) result)))) @@ -1908,10 +1908,10 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and ;; elements. (while (stringp (car elt)) (setq elt (cdr elt))) (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string (cadr elt))) - (mount-spec (cl-caddr elt)) + (mount-spec (caddr elt)) (prefix (tramp-gvfs-dbus-byte-array-to-string (car mount-spec))) (default-location (tramp-gvfs-dbus-byte-array-to-string - (cl-cadddr elt))) + (cadddr elt))) (method (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "type" (cadr mount-spec))))) (user (tramp-gvfs-dbus-byte-array-to-string @@ -2004,10 +2004,10 @@ Their full names are \"org.gtk.vfs.MountTracker.mounted\" and (while (stringp (car elt)) (setq elt (cdr elt))) (let* ((fuse-mountpoint (tramp-gvfs-dbus-byte-array-to-string (cadr elt))) - (mount-spec (cl-caddr elt)) + (mount-spec (caddr elt)) (prefix (tramp-gvfs-dbus-byte-array-to-string (car mount-spec))) (default-location (tramp-gvfs-dbus-byte-array-to-string - (cl-cadddr elt))) + (cadddr elt))) (method (tramp-gvfs-dbus-byte-array-to-string (cadr (assoc "type" (cadr mount-spec))))) (user (tramp-gvfs-dbus-byte-array-to-string diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index e268489b7c8..a21af990e0e 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3900,7 +3900,7 @@ Fall back to normal file name handler if no Tramp handler exists." (setq string (replace-match "" nil nil string)) ;; Add an Emacs event now. ;; `insert-special-event' exists since Emacs 31. - (when (member (cl-caadr object) events) + (when (member (caadr object) events) (tramp-compat-funcall (if (fboundp 'insert-special-event) 'insert-special-event @@ -3937,7 +3937,7 @@ Fall back to normal file name handler if no Tramp handler exists." (process-get proc 'tramp-watch-name)))))) ;; Add an Emacs event now. ;; `insert-special-event' exists since Emacs 31. - (when (member (cl-caadr object) events) + (when (member (caadr object) events) (tramp-compat-funcall (if (fboundp 'insert-special-event) 'insert-special-event commit 2dad63cac31cfb9dc1dbb003f93fd4768c15082b Author: Stefan Kangas Date: Thu Feb 13 09:25:12 2025 +0100 Fix defcustom :type of gnus-logo-colors * lisp/gnus/gnus.el (gnus-logo-colors): Fix defcustom :type. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index bd967563aac..756e28ebda5 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -760,7 +760,8 @@ be used directly.") (defcustom gnus-logo-colors nil "Colors used for the Gnus logo." :set-after '(gnus-logo-color-style) - :type '(list color color) + :type '(choice (const :tag "Use default" nil) + (list color color)) :group 'gnus-xmas) (defcustom gnus-logo-color-style 'ma