Nicolas Petton writes: > Eli Zaretskii writes: > >> Something like this: >> >> FOR_EACH_TAIL (tail) >> { >> Lisp_Object car = XCAR (tail); >> if (CONSP (car) >> && (NILP (testfn) >> ? (EQ (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))) >> : !NILP (call2 (testfn, XCAR (car), key)))) >> return car; >> } > > I installed your version in master. Here's another patch that adds a similar `testfn' parameter to `rassoc': From 103f7a5cdd80961e654fca879aba1b9a67d4eb22 Mon Sep 17 00:00:00 2001 From: Nicolas Petton Date: Tue, 1 Aug 2017 18:29:34 +0200 Subject: [PATCH] Add an optional testfn parameter to rassoc * src/fns.c (rassoc): Add an optional testfn parameter. When non-nil, use this parameter for comparison instead of equal. * src/fontset.c (fs_query_fontset): Update usage of Frassoc. * test/src/fns-tests.el (test-rassoc-tesfn): Add unit tests for the new testfn parameter. * etc/NEWS: * doc/lispref/lists.texi: Document the change. --- doc/lispref/lists.texi | 6 ++++-- etc/NEWS | 3 ++- src/fns.c | 15 ++++++++++----- src/fontset.c | 2 +- test/src/fns-tests.el | 6 ++++++ 5 files changed, 23 insertions(+), 9 deletions(-) diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 0c99380682..321246de12 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1550,8 +1550,10 @@ Association Lists @defun rassoc value alist This function returns the first association with value @var{value} in -@var{alist}. It returns @code{nil} if no association in @var{alist} has -a @sc{cdr} @code{equal} to @var{value}. +@var{alist}, comparing @var{key} against the alist elements using +@var{testfn} if non-nil, or @code{equal} if nil (@pxref{Equality +Predicates}). It returns @code{nil} if no association in @var{alist} +has a @sc{cdr} @code{equal} to @var{value}. @code{rassoc} is like @code{assoc} except that it compares the @sc{cdr} of each @var{alist} association instead of the @sc{car}. You can think of diff --git a/etc/NEWS b/etc/NEWS index 44f5ff5bde..50734b846f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -105,7 +105,8 @@ The effect is similar to that of "toolBar" resource on the tool bar. * Changes in Emacs 26.1 +++ -** The function 'assoc' now takes an optional third argument 'testfn'. +** The functions 'assoc' and 'rassoc ' now take an optional third +argument 'testfn'. This argument, when non-nil, is used for comparison instead of 'equal'. diff --git a/src/fns.c b/src/fns.c index d849618f2b..9e7d47253f 100644 --- a/src/fns.c +++ b/src/fns.c @@ -1474,17 +1474,22 @@ The value is actually the first element of LIST whose cdr is KEY. */) return Qnil; } -DEFUN ("rassoc", Frassoc, Srassoc, 2, 2, 0, - doc: /* Return non-nil if KEY is `equal' to the cdr of an element of LIST. -The value is actually the first element of LIST whose cdr equals KEY. */) - (Lisp_Object key, Lisp_Object list) +DEFUN ("rassoc", Frassoc, Srassoc, 2, 3, 0, + doc: /* Return non-nil if KEY is equal to the cdr of an element of LIST. +The value is actually the first element of LIST whose cdr equals KEY. + +Equality is defined by TESTFN is non-nil or by `equal' if nil. */) + (Lisp_Object key, Lisp_Object list, Lisp_Object testfn) { Lisp_Object tail = list; FOR_EACH_TAIL (tail) { Lisp_Object car = XCAR (tail); if (CONSP (car) - && (EQ (XCDR (car), key) || !NILP (Fequal (XCDR (car), key)))) + && (NILP (testfn) + ? (EQ (XCDR (car), key) || !NILP (Fequal + (XCDR (car), key))) + : !NILP (call2 (testfn, XCDR (car), key)))) return car; } CHECK_LIST_END (tail, list); diff --git a/src/fontset.c b/src/fontset.c index 74018060b8..4666b607ba 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1184,7 +1184,7 @@ fs_query_fontset (Lisp_Object name, int name_pattern) name = Fdowncase (name); if (name_pattern != 1) { - tem = Frassoc (name, Vfontset_alias_alist); + tem = Frassoc (name, Vfontset_alias_alist, Qnil); if (NILP (tem)) tem = Fassoc (name, Vfontset_alias_alist, Qnil); if (CONSP (tem) && STRINGP (XCAR (tem))) diff --git a/test/src/fns-tests.el b/test/src/fns-tests.el index e294859226..83d7935a41 100644 --- a/test/src/fns-tests.el +++ b/test/src/fns-tests.el @@ -379,6 +379,12 @@ dot2 (should (eq (assoc "b" alist #'string-equal) (cadr alist))) (should-not (assoc "b" alist #'eq)))) +(ert-deftest test-rassoc-testfn () + (let ((alist '((a . "1") (b . "2")))) + (should-not (rassoc "1" alist #'ignore)) + (should (eq (rassoc "2" alist #'string-equal) (cadr alist))) + (should-not (rassoc "2" alist #'eq)))) + (ert-deftest test-cycle-rassq () (let ((c1 (cyc1 '(0 . 1))) (c2 (cyc2 '(0 . 1) '(0 . 2))) -- 2.13.3 Cheers, Nico