From: Nicolas Petton <nicolas@petton.fr>
To: Eli Zaretskii <eliz@gnu.org>
Cc: tino.calancha@gmail.com, 27584@debbugs.gnu.org, monnier@iro.umontreal.ca
Subject: bug#27584: 26.0.50; alist-get: Add optional arg TESTFN
Date: Tue, 01 Aug 2017 18:37:38 +0200 [thread overview]
Message-ID: <87h8xrckh9.fsf@petton.fr> (raw)
In-Reply-To: <8737a3qttj.fsf@strawberry>
[-- Attachment #1: Type: text/plain, Size: 5004 bytes --]
Nicolas Petton <nicolas@petton.fr> writes:
> Eli Zaretskii <eliz@gnu.org> 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 <nicolas@petton.fr>
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
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]
next prev parent reply other threads:[~2017-08-01 16:37 UTC|newest]
Thread overview: 48+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-07-05 3:22 bug#27584: 26.0.50; alist-get: Add optional arg TESTFN Tino Calancha
2017-07-05 8:53 ` Tino Calancha
2017-07-05 9:19 ` Nicolas Petton
2017-07-05 13:18 ` Tino Calancha
2017-07-06 6:05 ` Tino Calancha
2017-07-06 6:13 ` Stefan Monnier
2017-07-06 6:20 ` Tino Calancha
2017-07-06 9:36 ` Nicolas Petton
2017-07-06 10:55 ` Tino Calancha
2017-07-06 11:06 ` Nicolas Petton
2017-07-06 15:07 ` Stefan Monnier
2017-07-07 6:48 ` Tino Calancha
2017-07-07 7:46 ` Eli Zaretskii
2017-07-07 8:09 ` Nicolas Petton
2017-07-07 15:53 ` Stefan Monnier
2017-07-09 14:45 ` Tino Calancha
2017-07-10 12:04 ` Michael Heerdegen
2017-07-10 12:28 ` Tino Calancha
2017-07-10 12:38 ` Michael Heerdegen
2017-07-10 12:47 ` Michael Heerdegen
2017-07-10 13:02 ` Tino Calancha
2017-07-10 13:18 ` Michael Heerdegen
2017-07-10 12:50 ` Michael Heerdegen
2017-07-06 14:56 ` Nicolas Petton
2017-07-07 6:39 ` Tino Calancha
2017-07-07 8:11 ` Nicolas Petton
2017-07-07 8:22 ` Tino Calancha
2017-07-07 8:34 ` Nicolas Petton
2017-07-07 15:49 ` Stefan Monnier
2017-07-07 15:54 ` Nicolas Petton
2017-07-07 19:47 ` Nicolas Petton
2017-07-08 6:30 ` Eli Zaretskii
2017-07-08 7:02 ` Tino Calancha
2017-07-08 7:14 ` Eli Zaretskii
2017-07-08 11:32 ` Nicolas Petton
2017-07-08 11:46 ` Eli Zaretskii
2017-07-09 14:48 ` Tino Calancha
2017-07-09 19:18 ` Nicolas Petton
2017-07-11 8:08 ` Nicolas Petton
2017-07-11 9:19 ` Tino Calancha
2017-07-12 17:36 ` Michael Heerdegen
2017-07-14 5:19 ` Tino Calancha
2017-07-14 11:16 ` Nicolas Petton
2017-07-17 13:38 ` Tino Calancha
2017-08-01 16:37 ` Nicolas Petton [this message]
2017-08-01 16:49 ` Nicolas Petton
2017-08-01 18:53 ` Eli Zaretskii
2017-07-08 11:29 ` Nicolas Petton
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87h8xrckh9.fsf@petton.fr \
--to=nicolas@petton.fr \
--cc=27584@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=monnier@iro.umontreal.ca \
--cc=tino.calancha@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.