diff options
author | Nicolas Petton <nicolas@petton.fr> | 2017-07-07 21:21:55 +0200 |
---|---|---|
committer | Nicolas Petton <nicolas@petton.fr> | 2017-07-11 10:07:16 +0200 |
commit | 0bece6c6815cc59e181817a2765a4ea752f34f56 (patch) | |
tree | 856363b2defed20c97a25c29a7739bce9a6bd9cb /src | |
parent | 689c5c20d1174e95be50e674d05632545eb4b9c5 (diff) | |
download | emacs-0bece6c6815cc59e181817a2765a4ea752f34f56.tar.gz |
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')
-rw-r--r-- | src/buffer.c | 2 | ||||
-rw-r--r-- | src/coding.c | 6 | ||||
-rw-r--r-- | src/dbusbind.c | 6 | ||||
-rw-r--r-- | src/fns.c | 15 | ||||
-rw-r--r-- | src/font.c | 2 | ||||
-rw-r--r-- | src/fontset.c | 2 | ||||
-rw-r--r-- | src/gfilenotify.c | 2 | ||||
-rw-r--r-- | src/image.c | 2 | ||||
-rw-r--r-- | src/keymap.c | 2 | ||||
-rw-r--r-- | src/process.c | 2 | ||||
-rw-r--r-- | src/w32fns.c | 2 | ||||
-rw-r--r-- | src/w32font.c | 2 | ||||
-rw-r--r-- | src/w32notify.c | 4 | ||||
-rw-r--r-- | src/w32term.c | 2 | ||||
-rw-r--r-- | src/xdisp.c | 6 | ||||
-rw-r--r-- | src/xfont.c | 3 |
16 files changed, 33 insertions, 27 deletions
diff --git a/src/buffer.c b/src/buffer.c index 780e4d7a7d6..e0972aac33c 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -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) diff --git a/src/coding.c b/src/coding.c index 5682fc015ad..50ad206be69 100644 --- a/src/coding.c +++ b/src/coding.c @@ -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); diff --git a/src/dbusbind.c b/src/dbusbind.c index d2460fd886e..0d9d3e514fd 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -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); 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); diff --git a/src/font.c b/src/font.c index 5a3f271ef85..a5e5b6a5b9d 100644 --- a/src/font.c +++ b/src/font.c @@ -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)) diff --git a/src/fontset.c b/src/fontset.c index 850558b08a0..74018060b85 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -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) diff --git a/src/gfilenotify.c b/src/gfilenotify.c index 285a253733d..fa4854c664d 100644 --- a/src/gfilenotify.c +++ b/src/gfilenotify.c @@ -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 diff --git a/src/image.c b/src/image.c index 91749fb8733..1426e309445 100644 --- a/src/image.c +++ b/src/image.c @@ -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))) { diff --git a/src/keymap.c b/src/keymap.c index b568f47cba7..db9aa7cbf38 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -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)) { diff --git a/src/process.c b/src/process.c index abd017bb907..19009515336 100644 --- a/src/process.c +++ b/src/process.c @@ -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 diff --git a/src/w32fns.c b/src/w32fns.c index b0842b5ee6c..457599fce0e 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -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); diff --git a/src/w32font.c b/src/w32font.c index 67d2f6d666d..314d7acdcc6 100644 --- a/src/w32font.c +++ b/src/w32font.c @@ -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)) { diff --git a/src/w32notify.c b/src/w32notify.c index 25205816bae..e8bdef8bdd3 100644 --- a/src/w32notify.c +++ b/src/w32notify.c @@ -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)) { diff --git a/src/w32term.c b/src/w32term.c index c37805cb6ca..0f7bb9337f6 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -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); diff --git a/src/xdisp.c b/src/xdisp.c index 28ed7685236..abca6a8137a 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -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. */ diff --git a/src/xfont.c b/src/xfont.c index b73596ce7ce..85fccf0dafd 100644 --- a/src/xfont.c +++ b/src/xfont.c @@ -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. */ |