summaryrefslogtreecommitdiff
path: root/src/fns.c
diff options
context:
space:
mode:
authorNicolas Petton <nicolas@petton.fr>2017-07-07 21:21:55 +0200
committerNicolas Petton <nicolas@petton.fr>2017-07-11 10:07:16 +0200
commit0bece6c6815cc59e181817a2765a4ea752f34f56 (patch)
tree856363b2defed20c97a25c29a7739bce9a6bd9cb /src/fns.c
parent689c5c20d1174e95be50e674d05632545eb4b9c5 (diff)
downloademacs-0bece6c6815cc59e181817a2765a4ea752f34f56.tar.gz
emacs-0bece6c6815cc59e181817a2765a4ea752f34f56.tar.bz2
emacs-0bece6c6815cc59e181817a2765a4ea752f34f56.zip
Add an optional testfn parameter to assoc
* src/fns.c (assoc): New optional testfn parameter used for comparison when provided. * test/src/fns-tests.el (test-assoc-testfn): Add tests for the new 'testfn' parameter. * src/buffer.c: * src/coding.c: * src/dbusbind.c: * src/font.c: * src/fontset.c: * src/gfilenotify.c: * src/image.c: * src/keymap.c: * src/process.c: * src/w32fns.c: * src/w32font.c: * src/w32notify.c: * src/w32term.c: * src/xdisp.c: * src/xfont.c: Add a third argument to Fassoc calls. * etc/NEWS: * doc/lispref/lists.texi: Document the new 'testfn' parameter.
Diffstat (limited to 'src/fns.c')
-rw-r--r--src/fns.c15
1 files changed, 10 insertions, 5 deletions
diff --git a/src/fns.c b/src/fns.c
index 6610d2a6d0e..f0e10e311f5 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -1417,17 +1417,22 @@ assq_no_quit (Lisp_Object key, Lisp_Object list)
return Qnil;
}
-DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
- doc: /* Return non-nil if KEY is `equal' to the car of an element of LIST.
-The value is actually the first element of LIST whose car equals KEY. */)
- (Lisp_Object key, Lisp_Object list)
+DEFUN ("assoc", Fassoc, Sassoc, 2, 3, 0,
+ doc: /* Return non-nil if KEY is equal to the car of an element of LIST.
+The value is actually the first element of LIST whose car equals KEY.
+
+Equality is defined by TESTFN if 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 (XCAR (car), key) || !NILP (Fequal (XCAR (car), key))))
+ && (NILP (testfn)
+ ? (EQ (XCAR (car), key) || !NILP (Fequal
+ (XCAR (car), key)))
+ : !NILP (call2 (testfn, XCAR (car), key))))
return car;
}
CHECK_LIST_END (tail, list);