Allow plist-get/plist-put/plist-member to take a comparison function

* doc/lispref/lists.texi (Plist Access): Document it.

* lisp/filesets.el (filesets-reset-fileset)
(filesets-ingroup-cache-get):
(filesets-ingroup-cache-put):
(filesets-build-menu-now): Don't use lax-plist functions.

* lisp/simple.el (lax-plist-put, lax-plist-get): Moved here from
fns.c and make obsolete.

* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Don't mark
plist functions as side-effect-free or pure.

* lisp/emacs-lisp/comp.el (comp-known-type-specifiers): Adjust type.

* lisp/emacs-lisp/shortdoc.el (list): Don't document deprecated
functions.

* src/xdisp.c (build_desired_tool_bar_string):
(display_mode_element):
(store_mode_line_string):
(display_string):
(produce_stretch_glyph):
(note_mode_line_or_margin_highlight):
(note_mouse_highlight):
* src/w32.c (serial_configure):
* src/sysdep.c (serial_configure):
* src/sound.c (parse_sound):
* src/process.c (Fset_process_buffer):
(Fset_process_sentinel):
(Fprocess_contact):
(Fmake_process):
(Fmake_pipe_process):
(Fset_network_process_option):
(Fserial_process_configure):
(Fmake_serial_process):
(set_network_socket_coding_system):
(finish_after_tls_connection):
(connect_network_socket):
(Fmake_network_process):
(server_accept_connection):
* src/lread.c (ADDPARAM):
(hash_table_from_plist):
* src/keyboard.c (make_lispy_position):
* src/indent.c (check_display_width):
* src/image.c (postprocess_image):
* src/gnutls.c (gnutls_verify_boot):
(Fgnutls_boot):
(gnutls_symmetric):
(Fgnutls_hash_mac):
(Fgnutls_hash_digest):
* src/dired.c (filter):
* src/data.c (add_to_function_history):
* src/coding.c (Fcoding_system_put): Adjust callers from
Fplist_put (etc) to plist_put.

* src/fns.c (plist_get):
(plist_put):
(plist_member): New functions (without optional third parameter)
to be used in C code.

* src/fns.c (Fplist_get, Fplist_put, Fplist_member): Take an
optional predicate parameter (bug#47425).

* src/lisp.h: Declare new plist_put, plist_get and plist_member
functions.

* test/lisp/json-tests.el (test-json-add-to-plist): Use plist-get.

* test/src/fns-tests.el (test-cycle-lax-plist-get):
(test-cycle-lax-plist-put):
(lax-plist-get/odd-number-of-elements):
(test-plist): Remove lax-plist tests, since semantics have changed
(they no longer error out on cycles).

1 files changed, 68 insertions, 63 deletions

diff --git a/src/fns.c b/src/fns.c
index 5ee8482d003..6be6b6d6167 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2276,24 +2276,27 @@ merge_c (Lisp_Object org_l1, Lisp_Object org_l2, bool (*less) (Lisp_Object, Lisp
 
 /* This does not check for quits.  That is safe since it must terminate.  */
 
-DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
+DEFUN ("plist-get", Fplist_get, Splist_get, 2, 3, 0,
        doc: /* Extract a value from a property list.
 PLIST is a property list, which is a list of the form
 \(PROP1 VALUE1 PROP2 VALUE2...).
 
 This function returns the value corresponding to the given PROP, or
 nil if PROP is not one of the properties on the list.  The comparison
-with PROP is done using `eq'.
+with PROP is done using PREDICATE, which defaults to `eq'.
 
-This function never signals an error.  */)
-  (Lisp_Object plist, Lisp_Object prop)
+This function doesn't signal an error if PLIST is invalid.  */)
+  (Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
 {
   Lisp_Object tail = plist;
+  if (NILP (predicate))
+    return plist_get (plist, prop);
+
   FOR_EACH_TAIL_SAFE (tail)
     {
       if (! CONSP (XCDR (tail)))
 	break;
-      if (EQ (prop, XCAR (tail)))
+      if (!NILP (call2 (predicate, prop, XCAR (tail))))
 	return XCAR (XCDR (tail));
       tail = XCDR (tail);
     }
@@ -2301,39 +2304,58 @@ This function never signals an error.  */)
   return Qnil;
 }
 
+/* Faster version of the above that works with EQ only */
+Lisp_Object
+plist_get (Lisp_Object plist, Lisp_Object prop)
+{
+  Lisp_Object tail = plist;
+  FOR_EACH_TAIL_SAFE (tail)
+    {
+      if (! CONSP (XCDR (tail)))
+	break;
+      if (EQ (prop, XCAR (tail)))
+	return XCAR (XCDR (tail));
+      tail = XCDR (tail);
+    }
+  return Qnil;
+}
+
 DEFUN ("get", Fget, Sget, 2, 2, 0,
        doc: /* Return the value of SYMBOL's PROPNAME property.
 This is the last value stored with `(put SYMBOL PROPNAME VALUE)'.  */)
   (Lisp_Object symbol, Lisp_Object propname)
 {
   CHECK_SYMBOL (symbol);
-  Lisp_Object propval = Fplist_get (CDR (Fassq (symbol, Voverriding_plist_environment)),
-                                    propname);
+  Lisp_Object propval = plist_get (CDR (Fassq (symbol,
+					       Voverriding_plist_environment)),
+				   propname);
   if (!NILP (propval))
     return propval;
-  return Fplist_get (XSYMBOL (symbol)->u.s.plist, propname);
+  return plist_get (XSYMBOL (symbol)->u.s.plist, propname);
 }
 
-DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
+DEFUN ("plist-put", Fplist_put, Splist_put, 3, 4, 0,
        doc: /* Change value in PLIST of PROP to VAL.
 PLIST is a property list, which is a list of the form
 \(PROP1 VALUE1 PROP2 VALUE2 ...).
 
-The comparison with PROP is done using `eq'.
+The comparison with PROP is done using PREDICATE, which defaults to `eq'.
 
 If PROP is already a property on the list, its value is set to VAL,
 otherwise the new PROP VAL pair is added.  The new plist is returned;
 use `(setq x (plist-put x prop val))' to be sure to use the new value.
 The PLIST is modified by side effects.  */)
-  (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
+  (Lisp_Object plist, Lisp_Object prop, Lisp_Object val, Lisp_Object predicate)
 {
   Lisp_Object prev = Qnil, tail = plist;
+  if (NILP (predicate))
+    return plist_put (plist, prop, val);
   FOR_EACH_TAIL (tail)
     {
       if (! CONSP (XCDR (tail)))
 	break;
 
-      if (EQ (prop, XCAR (tail)))
+      if (!NILP (call2 (predicate, prop, XCAR (tail))))
 	{
 	  Fsetcar (XCDR (tail), val);
 	  return plist;
@@ -2351,47 +2373,8 @@ The PLIST is modified by side effects.  */)
   return plist;
 }
 
-DEFUN ("put", Fput, Sput, 3, 3, 0,
-       doc: /* Store SYMBOL's PROPNAME property with value VALUE.
-It can be retrieved with `(get SYMBOL PROPNAME)'.  */)
-  (Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
-{
-  CHECK_SYMBOL (symbol);
-  set_symbol_plist
-    (symbol, Fplist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
-  return value;
-}
-
-DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
-       doc: /* Extract a value from a property list, comparing with `equal'.
-This function is otherwise like `plist-get', but may signal an error
-if PLIST isn't a valid plist.  */)
-  (Lisp_Object plist, Lisp_Object prop)
-{
-  Lisp_Object tail = plist;
-  FOR_EACH_TAIL (tail)
-    {
-      if (! CONSP (XCDR (tail)))
-	break;
-      if (! NILP (Fequal (prop, XCAR (tail))))
-	return XCAR (XCDR (tail));
-      tail = XCDR (tail);
-    }
-
-  CHECK_TYPE (NILP (tail), Qplistp, plist);
-
-  return Qnil;
-}
-
-DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
-       doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...).  PROP and VAL are any objects.
-If PROP is already a property on the list, its value is set to VAL,
-otherwise the new PROP VAL pair is added.  The new plist is returned;
-use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
-The PLIST is modified by side effects.  */)
-  (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
+Lisp_Object
+plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
 {
   Lisp_Object prev = Qnil, tail = plist;
   FOR_EACH_TAIL (tail)
@@ -2399,7 +2382,7 @@ The PLIST is modified by side effects.  */)
       if (! CONSP (XCDR (tail)))
 	break;
 
-      if (! NILP (Fequal (prop, XCAR (tail))))
+      if (EQ (prop, XCAR (tail)))
 	{
 	  Fsetcar (XCDR (tail), val);
 	  return plist;
@@ -2409,12 +2392,24 @@ The PLIST is modified by side effects.  */)
       tail = XCDR (tail);
     }
   CHECK_TYPE (NILP (tail), Qplistp, plist);
-  Lisp_Object newcell = list2 (prop, val);
+  Lisp_Object newcell
+    = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
   if (NILP (prev))
     return newcell;
   Fsetcdr (XCDR (prev), newcell);
   return plist;
 }
+
+DEFUN ("put", Fput, Sput, 3, 3, 0,
+       doc: /* Store SYMBOL's PROPNAME property with value VALUE.
+It can be retrieved with `(get SYMBOL PROPNAME)'.  */)
+  (Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
+{
+  CHECK_SYMBOL (symbol);
+  set_symbol_plist
+    (symbol, plist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
+  return value;
+}
 
 DEFUN ("eql", Feql, Seql, 2, 2, 0,
        doc: /* Return t if the two args are `eq' or are indistinguishable numbers.
@@ -3183,22 +3178,25 @@ FILENAME are suppressed.  */)
    bottleneck of Widget operation.  Here is their translation to C,
    for the sole reason of efficiency.  */
 
-DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
+DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0,
        doc: /* Return non-nil if PLIST has the property PROP.
 PLIST is a property list, which is a list of the form
 \(PROP1 VALUE1 PROP2 VALUE2 ...).
 
-The comparison with PROP is done using `eq'.
+The comparison with PROP is done using PREDICATE, which defaults to
+`eq'.
 
 Unlike `plist-get', this allows you to distinguish between a missing
 property and a property with the value nil.
 The value is actually the tail of PLIST whose car is PROP.  */)
-  (Lisp_Object plist, Lisp_Object prop)
+  (Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
 {
   Lisp_Object tail = plist;
+  if (NILP (predicate))
+    predicate = Qeq;
   FOR_EACH_TAIL (tail)
     {
-      if (EQ (XCAR (tail), prop))
+      if (!NILP (call2 (predicate, XCAR (tail), prop)))
 	return tail;
       tail = XCDR (tail);
       if (! CONSP (tail))
@@ -3208,13 +3206,22 @@ The value is actually the tail of PLIST whose car is PROP.  */)
   return Qnil;
 }
 
+/* plist_member isn't used much in the Emacs sources, so just provide
+   a shim so that the function name follows the same pattern as
+   plist_get/plist_put.  */
+Lisp_Object
+plist_member (Lisp_Object plist, Lisp_Object prop)
+{
+  return Fplist_member (plist, prop, Qnil);
+}
+
 DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
        doc: /* In WIDGET, set PROPERTY to VALUE.
 The value can later be retrieved with `widget-get'.  */)
   (Lisp_Object widget, Lisp_Object property, Lisp_Object value)
 {
   CHECK_CONS (widget);
-  XSETCDR (widget, Fplist_put (XCDR (widget), property, value));
+  XSETCDR (widget, plist_put (XCDR (widget), property, value));
   return value;
 }
 
@@ -3231,7 +3238,7 @@ later with `widget-put'.  */)
       if (NILP (widget))
 	return Qnil;
       CHECK_CONS (widget);
-      tmp = Fplist_member (XCDR (widget), property);
+      tmp = plist_member (XCDR (widget), property);
       if (CONSP (tmp))
 	{
 	  tmp = XCDR (tmp);
@@ -6064,8 +6071,6 @@ The same variable also affects the function `read-answer'.  */);
   defsubr (&Sget);
   defsubr (&Splist_put);
   defsubr (&Sput);
-  defsubr (&Slax_plist_get);
-  defsubr (&Slax_plist_put);
   defsubr (&Seql);
   defsubr (&Sequal);
   defsubr (&Sequal_including_properties);