mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-27 19:31:38 +00:00
Code Issues Releases Activity

Add an optional testfn parameter to assoc

Browse Source 
* 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.
This commit is contained in:
Nicolas Petton 2017-07-07 21:21:55 +02:00
parent 689c5c20d1
commit 0bece6c681
19 changed files with 53 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
doc/lispref/lists.texi
View File

@ -1511,12 +1511,12 @@ respects. A property list behaves like an association list in which
each key can occur only once. @xref{Property Lists}, for a comparison
of property lists and association lists.
@defun assoc key alist
@defun assoc key alist &optional testfn
This function returns the first association for @var{key} in
@var{alist}, comparing @var{key} against the alist elements using
@code{equal} (@pxref{Equality Predicates}). It returns @code{nil} if no
association in @var{alist} has a @sc{car} @code{equal} to @var{key}.
For example:
@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{car} equal to @var{key}. For example:
@smallexample
(setq trees '((pine . cones) (oak . acorns) (maple . seeds)))
@ -1561,11 +1561,11 @@ this as reverse @code{assoc}, finding the key for a given value.
@defun assq key alist
This function is like @code{assoc} in that it returns the first
association for @var{key} in @var{alist}, but it makes the comparison
using @code{eq} instead of @code{equal}. @code{assq} returns @code{nil}
if no association in @var{alist} has a @sc{car} @code{eq} to @var{key}.
This function is used more often than @code{assoc}, since @code{eq} is
faster than @code{equal} and most alists use symbols as keys.
@xref{Equality Predicates}.
using @code{eq}. @code{assq} returns @code{nil} if no association in
@var{alist} has a @sc{car} @code{eq} to @var{key}. This function is
used more often than @code{assoc}, since @code{eq} is faster than
@code{equal} and most alists use symbols as keys. @xref{Equality
Predicates}.
@smallexample
(setq trees '((pine . cones) (oak . acorns) (maple . seeds)))

5
etc/NEWS
View File

@ -100,6 +100,11 @@ required capabilities are found in terminfo. See the FAQ node
* Changes in Emacs 26.1
+++
** The function 'assoc' now takes an optional third argument 'testfn'.
This argument, when non-nil, is used for comparison instead of
'equal'.
** The variable 'emacs-version' no longer includes the build number.
This is now stored separately in a new variable, 'emacs-build-number'.

2
src/buffer.c
View File

@ -1164,7 +1164,7 @@ buffer_local_value (Lisp_Object variable, Lisp_Object buffer)
{ /* Look in local_var_alist. */
struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
XSETSYMBOL (variable, sym); /* Update In case of aliasing. */
result = Fassoc (variable, BVAR (buf, local_var_alist));
result = Fassoc (variable, BVAR (buf, local_var_alist), Qnil);
if (!NILP (result))
{
if (blv->fwd)

6
src/coding.c
View File

@ -10539,7 +10539,7 @@ usage: (define-coding-system-internal ...) */)
ASET (this_spec, 2, this_eol_type);
Fputhash (this_name, this_spec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (this_name, Vcoding_system_list);
val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist);
val = Fassoc (Fsymbol_name (this_name), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist
= Fcons (Fcons (Fsymbol_name (this_name), Qnil),
@ -10554,7 +10554,7 @@ usage: (define-coding-system-internal ...) */)
Fputhash (name, spec_vec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (name, Vcoding_system_list);
val = Fassoc (Fsymbol_name (name), Vcoding_system_alist);
val = Fassoc (Fsymbol_name (name), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (name), Qnil),
Vcoding_system_alist);
@ -10662,7 +10662,7 @@ DEFUN ("define-coding-system-alias", Fdefine_coding_system_alias,
Fputhash (alias, spec, Vcoding_system_hash_table);
Vcoding_system_list = Fcons (alias, Vcoding_system_list);
val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist);
val = Fassoc (Fsymbol_name (alias), Vcoding_system_alist, Qnil);
if (NILP (val))
Vcoding_system_alist = Fcons (Fcons (Fsymbol_name (alias), Qnil),
Vcoding_system_alist);

6
src/dbusbind.c
View File

@ -955,7 +955,7 @@ xd_get_connection_address (Lisp_Object bus)
DBusConnection *connection;
Lisp_Object val;
val = CDR_SAFE (Fassoc (bus, xd_registered_buses));
val = CDR_SAFE (Fassoc (bus, xd_registered_buses, Qnil));
if (NILP (val))
XD_SIGNAL2 (build_string ("No connection to bus"), bus);
else
@ -1057,7 +1057,7 @@ xd_close_bus (Lisp_Object bus)
Lisp_Object busobj;
/* Check whether we are connected. */
val = Fassoc (bus, xd_registered_buses);
val = Fassoc (bus, xd_registered_buses, Qnil);
if (NILP (val))
return;
@ -1127,7 +1127,7 @@ this connection to those buses. */)
xd_close_bus (bus);
/* Check, whether we are still connected. */
val = Fassoc (bus, xd_registered_buses);
val = Fassoc (bus, xd_registered_buses, Qnil);
if (!NILP (val))
{
connection = xd_get_connection_address (bus);

15
src/fns.c
View File

@ -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);

2
src/font.c
View File

@ -1893,7 +1893,7 @@ otf_tag_symbol (OTF_Tag tag)
static OTF *
otf_open (Lisp_Object file)
{
Lisp_Object val = Fassoc (file, otf_list);
Lisp_Object val = Fassoc (file, otf_list, Qnil);
OTF *otf;
if (! NILP (val))

2
src/fontset.c
View File

@ -1186,7 +1186,7 @@ fs_query_fontset (Lisp_Object name, int name_pattern)
{
tem = Frassoc (name, Vfontset_alias_alist);
if (NILP (tem))
tem = Fassoc (name, Vfontset_alias_alist);
tem = Fassoc (name, Vfontset_alias_alist, Qnil);
if (CONSP (tem) && STRINGP (XCAR (tem)))
name = XCAR (tem);
else if (name_pattern == 0)

2
src/gfilenotify.c
View File

@ -266,7 +266,7 @@ reason. Removing the watch by calling `gfile-rm-watch' also makes it
invalid. */)
(Lisp_Object watch_descriptor)
{
Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list);
Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (NILP (watch_object))
return Qnil;
else

2
src/image.c
View File

@ -4231,7 +4231,7 @@ xpm_load_image (struct frame *f,
color_val = Qnil;
if (!NILP (color_symbols) && !NILP (symbol_color))
{
Lisp_Object specified_color = Fassoc (symbol_color, color_symbols);
Lisp_Object specified_color = Fassoc (symbol_color, color_symbols, Qnil);
if (CONSP (specified_color) && STRINGP (XCDR (specified_color)))
{

2
src/keymap.c
View File

@ -1292,7 +1292,7 @@ silly_event_symbol_error (Lisp_Object c)
base = XCAR (parsed);
name = Fsymbol_name (base);
/* This alist includes elements such as ("RET" . "\\r"). */
assoc = Fassoc (name, exclude_keys);
assoc = Fassoc (name, exclude_keys, Qnil);
if (! NILP (assoc))
{

2
src/process.c
View File

@ -951,7 +951,7 @@ DEFUN ("get-process", Fget_process, Sget_process, 1, 1, 0,
if (PROCESSP (name))
return name;
CHECK_STRING (name);
return Fcdr (Fassoc (name, Vprocess_alist));
return Fcdr (Fassoc (name, Vprocess_alist, Qnil));
}
/* This is how commands for the user decode process arguments. It

2
src/w32fns.c
View File

@ -467,7 +467,7 @@ if the entry is new. */)
block_input ();
/* replace existing entry in w32-color-map or add new entry. */
entry = Fassoc (name, Vw32_color_map);
entry = Fassoc (name, Vw32_color_map, Qnil);
if (NILP (entry))
{
entry = Fcons (name, rgb);

2
src/w32font.c
View File

@ -1627,7 +1627,7 @@ x_to_w32_charset (char * lpcs)
Format of each entry is
(CHARSET_NAME . (WINDOWS_CHARSET . CODEPAGE)).
*/
this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist);
this_entry = Fassoc (build_string (charset), Vw32_charset_info_alist, Qnil);
if (NILP (this_entry))
{

4
src/w32notify.c
View File

@ -642,7 +642,7 @@ WATCH-DESCRIPTOR should be an object returned by `w32notify-add-watch'. */)
/* Remove the watch object from watch list. Do this before freeing
the object, do that even if we fail to free it, watch_list is
kept free of junk. */
watch_object = Fassoc (watch_descriptor, watch_list);
watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (!NILP (watch_object))
{
watch_list = Fdelete (watch_object, watch_list);
@ -679,7 +679,7 @@ the watcher thread exits abnormally for any other reason. Removing the
watch by calling `w32notify-rm-watch' also makes it invalid. */)
(Lisp_Object watch_descriptor)
{
Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list);
Lisp_Object watch_object = Fassoc (watch_descriptor, watch_list, Qnil);
if (!NILP (watch_object))
{

2
src/w32term.c
View File

@ -6110,7 +6110,7 @@ x_calc_absolute_position (struct frame *f)
list = CDR(list);
geometry = Fassoc (Qgeometry, attributes);
geometry = Fassoc (Qgeometry, attributes, Qnil);
if (!NILP (geometry))
{
monitor_left = Fnth (make_number (1), geometry);

6
src/xdisp.c
View File

@ -23314,7 +23314,7 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
props = oprops;
}
aelt = Fassoc (elt, mode_line_proptrans_alist);
aelt = Fassoc (elt, mode_line_proptrans_alist, Qnil);
if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt))))
{
/* AELT is what we want. Move it to the front
@ -28788,7 +28788,7 @@ set_frame_cursor_types (struct frame *f, Lisp_Object arg)
/* By default, set up the blink-off state depending on the on-state. */
tem = Fassoc (arg, Vblink_cursor_alist);
tem = Fassoc (arg, Vblink_cursor_alist, Qnil);
if (!NILP (tem))
{
FRAME_BLINK_OFF_CURSOR (f)
@ -28926,7 +28926,7 @@ get_window_cursor_type (struct window *w, struct glyph *glyph, int *width,
/* Cursor is blinked off, so determine how to "toggle" it. */
/* First look for an entry matching the buffer's cursor-type in blink-cursor-alist. */
if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist), !NILP (alt_cursor)))
if ((alt_cursor = Fassoc (BVAR (b, cursor_type), Vblink_cursor_alist, Qnil), !NILP (alt_cursor)))
return get_specified_cursor_type (XCDR (alt_cursor), width);
/* Then see if frame has specified a specific blink off cursor type. */

3
src/xfont.c
View File

@ -505,7 +505,8 @@ xfont_list (struct frame *f, Lisp_Object spec)
Lisp_Object alter;
if ((alter = Fassoc (SYMBOL_NAME (registry),
Vface_alternative_font_registry_alist),
Vface_alternative_font_registry_alist,
Qnil),
CONSP (alter)))
{
/* Pointer to REGISTRY-ENCODING field. */

6
test/src/fns-tests.el
View File

@ -373,6 +373,12 @@
(should-error (assoc 3 d1) :type 'wrong-type-argument)
(should-error (assoc 3 d2) :type 'wrong-type-argument)))
(ert-deftest test-assoc-testfn ()
(let ((alist '(("a" . 1) ("b" . 2))))
(should-not (assoc "a" alist #'ignore))
(should (eq (assoc "b" alist #'string-equal) (cadr alist)))
(should-not (assoc "b" alist #'eq))))
(ert-deftest test-cycle-rassq ()
(let ((c1 (cyc1 '(0 . 1)))
(c2 (cyc2 '(0 . 1) '(0 . 2)))