Audit some plist uses with new predicate argument

* doc/lispref/lists.texi (Plist Access): Improve description of
default predicate.
* lisp/emacs-lisp/cl-extra.el (cl-getf, cl--set-getf): Assume
plist-member always returns a cons.
* lisp/emacs-lisp/gv.el (plist-get): Support new optional predicate
argument (bug#47425#91).
* lisp/emacs-lisp/map.el: Bump minor version.
(map--dispatch): Remove now that bug#58563 is fixed.  Break two
remaining uses out into corresponding cl-defmethods.
(map--plist-p): Add docstring.
(map--plist-has-predicate, map--plist-member-1, map--plist-member)
(map--plist-put-1, map--plist-put): New definitions for supporting
predicate argument backward compatibly.
(map-elt): Fix generalized variable getter under a
predicate (bug#58531).  Use predicate when given a plist.
(map-put): Avoid gratuitous warnings when called without the hidden
predicate argument.  Improve obsoletion message.
(map-put!): Use predicate when given a plist.
(map-contains-key): Ditto.  Declare forgotten
advertised-calling-convention (bug#58531#19).
(map--put): Group definition in file together with that of map-put!.
* lisp/files-x.el (connection-local-normalize-criteria): Simplify
using mapcan + plist-get.
* lisp/net/eudc.el (eudc--plist-member): New convenience function.
(eudc-plist-member, eudc-plist-get, eudc-lax-plist-get): Use it
instead of open-coding plist-member.
* src/fns.c (Fplist_get, plist_get, Fplist_put, plist_put): Pass the
plist element as the first argument to the predicate, for
consistency with assoc + alist-get.
(Fplist_member, plist_member): Move from widget to plist section.
Open-code the EQ case in plist_member, and call it from
Fplist_member in that case, rather than the other way around.

* test/lisp/apropos-tests.el (apropos-tests-format-plist): Avoid
polluting obarray.
* test/lisp/emacs-lisp/cl-extra-tests.el (cl-getf): Extend test with
generalized variables, degenerate plists, and improper lists.
* test/lisp/emacs-lisp/gv-tests.el: Byte-compile file; in the
meantime bug#24402 seems to have been fixed or worked around.
(gv-setter-edebug): Inhibit printing messages.
(gv-plist-get): Avoid modifying constant literals.  Also test with a
predicate argument.
* test/lisp/emacs-lisp/map-tests.el (with-maps-do): Simplify
docstring.
(test-map-elt-testfn): Rename...
(test-map-elt-testfn-alist): ...to this.  Also test with a predicate
argument.
(test-map-elt-testfn-plist, test-map-elt-gv, test-map-elt-signature)
(test-map-put!-plist, test-map-put!-signature)
(test-map-contains-key-signature, test-map-plist-member)
(test-map-plist-put): New tests.
(test-map-contains-key-testfn): Also test with a predicate argument.
(test-map-setf-alist-overwrite-key, test-map-setf-plist-insert-key)
(test-map-setf-plist-overwrite-key): Avoid modifying constant
literals.
(test-hash-table-setf-insert-key)
(test-hash-table-setf-overwrite-key): Fix indentation.
(test-setf-map-with-function): Make test more precise.
* test/lisp/net/eudc-tests.el: New file.
* test/lisp/subr-tests.el (test-plistp): Extend test with circular
list.
* test/src/fns-tests.el (test-cycle-equal, test-cycle-nconc): Move
from plist section to circular list section.
(plist-put/odd-number-of-elements): Avoid modifying constant
literals.
(plist-member/improper-list): Simplify.
(test-plist): Move to plist section.  Also test with a predicate
argument.

3 files changed, 109 insertions, 66 deletions

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 7c7f027d777..66b214554ee 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -615,12 +615,12 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
 				  ,(funcall setter
 					    `(cl--set-getf ,getter ,k ,val))
 				  ,val)))))))))
-  (let ((val-tail (cdr-safe (plist-member plist tag))))
+  (let ((val-tail (cdr (plist-member plist tag))))
     (if val-tail (car val-tail) def)))
 
 ;;;###autoload
 (defun cl--set-getf (plist tag val)
-  (let ((val-tail (cdr-safe (plist-member plist tag))))
+  (let ((val-tail (cdr (plist-member plist tag))))
     (if val-tail (progn (setcar val-tail val) plist)
       (cl-list* tag val plist))))
 
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index a96fa19a3ff..11251d7a963 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -445,16 +445,17 @@ The return value is the last VAL in the list.
                             ,v))))))))))
 
 (gv-define-expander plist-get
-  (lambda (do plist prop)
+  (lambda (do plist prop &optional predicate)
     (macroexp-let2 macroexp-copyable-p key prop
       (gv-letplace (getter setter) plist
-        (macroexp-let2 nil p `(cdr (plist-member ,getter ,key))
+        (macroexp-let2 nil p `(cdr (plist-member ,getter ,key ,predicate))
           (funcall do
                    `(car ,p)
                    (lambda (val)
                      `(if ,p
                           (setcar ,p ,val)
-                        ,(funcall setter `(cons ,key (cons ,val ,getter)))))))))))
+                        ,(funcall setter
+                                  `(cons ,key (cons ,val ,getter)))))))))))
 
 ;;; Some occasionally handy extensions.
 
diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 8c67d7c7a25..8e3b698d372 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -5,7 +5,7 @@
 ;; Author: Nicolas Petton <nicolas@petton.fr>
 ;; Maintainer: emacs-devel@gnu.org
 ;; Keywords: extensions, lisp
-;; Version: 3.2.1
+;; Version: 3.3.1
 ;; Package-Requires: ((emacs "26"))
 
 ;; This file is part of GNU Emacs.
@@ -80,48 +80,82 @@ MAP can be an alist, plist, hash-table, or array."
   `(pcase-let ((,(map--make-pcase-patterns keys) ,map))
      ,@body))
 
-(eval-when-compile
-  (defmacro map--dispatch (map-var &rest args)
-    "Evaluate one of the forms specified by ARGS based on the type of MAP-VAR.
-
-The following keyword types are meaningful: `:list',
-`:hash-table' and `:array'.
-
-An error is thrown if MAP-VAR is neither a list, hash-table nor array.
-
-Returns the result of evaluating the form associated with MAP-VAR's type."
-    (declare (debug t) (indent 1))
-    `(cond ((listp ,map-var) ,(plist-get args :list))
-           ((hash-table-p ,map-var) ,(plist-get args :hash-table))
-           ((arrayp ,map-var) ,(plist-get args :array))
-           (t (error "Unsupported map type `%S': %S"
-                     (type-of ,map-var) ,map-var)))))
-
 (define-error 'map-not-inplace "Cannot modify map in-place")
 
 (defsubst map--plist-p (list)
+  "Return non-nil if LIST is the start of a nonempty plist map."
   (and (consp list) (atom (car list))))
 
+(defconst map--plist-has-predicate
+  (condition-case nil
+      (with-no-warnings (plist-get () nil #'eq) t)
+    (wrong-number-of-arguments))
+  "Non-nil means `plist-get' & co. accept a predicate in Emacs 29+.
+Note that support for this predicate in map.el is patchy and
+deprecated.")
+
+(defun map--plist-member-1 (plist prop &optional predicate)
+  "Compatibility shim for the PREDICATE argument of `plist-member'.
+Assumes non-nil PLIST satisfies `map--plist-p'."
+  (if (or (memq predicate '(nil eq)) (null plist))
+      (plist-member plist prop)
+    (let ((tail plist) found)
+      (while (and (not (setq found (funcall predicate (car tail) prop)))
+                  (consp (setq tail (cdr tail)))
+                  (consp (setq tail (cdr tail)))))
+      (and tail (not found)
+           (signal 'wrong-type-argument `(plistp ,plist)))
+      tail)))
+
+(defalias 'map--plist-member
+  (if map--plist-has-predicate #'plist-member #'map--plist-member-1)
+  "Compatibility shim for `plist-member' in Emacs 29+.
+\n(fn PLIST PROP &optional PREDICATE)")
+
+(defun map--plist-put-1 (plist prop val &optional predicate)
+  "Compatibility shim for the PREDICATE argument of `plist-put'.
+Assumes non-nil PLIST satisfies `map--plist-p'."
+  (if (or (memq predicate '(nil eq)) (null plist))
+      (plist-put plist prop val)
+    (let ((tail plist) prev found)
+      (while (and (consp (cdr tail))
+                  (not (setq found (funcall predicate (car tail) prop)))
+                  (consp (setq prev tail tail (cddr tail)))))
+      (cond (found (setcar (cdr tail) val))
+            (tail (signal 'wrong-type-argument `(plistp ,plist)))
+            (prev (setcdr (cdr prev) (cons prop (cons val (cddr prev)))))
+            ((setq plist (cons prop (cons val plist)))))
+      plist)))
+
+(defalias 'map--plist-put
+  (if map--plist-has-predicate #'plist-put #'map--plist-put-1)
+  "Compatibility shim for `plist-put' in Emacs 29+.
+\n(fn PLIST PROP VAL &optional PREDICATE)")
+
 (cl-defgeneric map-elt (map key &optional default testfn)
   "Look up KEY in MAP and return its associated value.
 If KEY is not found, return DEFAULT which defaults to nil.
 
 TESTFN is the function to use for comparing keys.  It is
 deprecated because its default and valid values depend on the MAP
-argument.  Generally, alist keys are compared with `equal', plist
-keys with `eq', and hash-table keys with the hash-table's test
+argument, and it was never consistently supported by the map.el
+API.  Generally, alist keys are compared with `equal', plist keys
+with `eq', and hash-table keys with the hash-table's test
 function.
 
 In the base definition, MAP can be an alist, plist, hash-table,
 or array."
   (declare
+   ;; `testfn' is deprecated.
+   (advertised-calling-convention (map key &optional default) "27.1")
    (gv-expander
     (lambda (do)
       (gv-letplace (mgetter msetter) `(gv-delay-error ,map)
         (macroexp-let2* nil
             ;; Eval them once and for all in the right order.
             ((key key) (default default) (testfn testfn))
-          (funcall do `(map-elt ,mgetter ,key ,default)
+          (funcall do
+                   `(map-elt ,mgetter ,key ,default ,@(and testfn `(,testfn)))
                    (lambda (v)
                      (macroexp-let2 nil v v
                        `(condition-case nil
@@ -132,19 +166,21 @@ or array."
                            ,(funcall msetter
                                      `(map-insert ,mgetter ,key ,v))
                            ;; Always return the value.
-                           ,v)))))))))
-   ;; `testfn' is deprecated.
-   (advertised-calling-convention (map key &optional default) "27.1"))
-  ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
-  (map--dispatch map
-    :list (if (map--plist-p map)
-              (let ((res (plist-member map key)))
-                (if res (cadr res) default))
-            (alist-get key map default nil (or testfn #'equal)))
-    :hash-table (gethash key map default)
-    :array (if (map-contains-key map key)
-               (aref map key)
-             default)))
+                           ,v)))))))))))
+
+(cl-defmethod map-elt ((map list) key &optional default testfn)
+  (if (map--plist-p map)
+      (let ((res (map--plist-member map key testfn)))
+        (if res (cadr res) default))
+    (alist-get key map default nil (or testfn #'equal))))
+
+(cl-defmethod map-elt ((map hash-table) key &optional default _testfn)
+  (gethash key map default))
+
+(cl-defmethod map-elt ((map array) key &optional default _testfn)
+  (if (map-contains-key map key)
+      (aref map key)
+    default))
 
 (defmacro map-put (map key value &optional testfn)
   "Associate KEY with VALUE in MAP and return VALUE.
@@ -154,8 +190,12 @@ When MAP is an alist, test equality with TESTFN if non-nil,
 otherwise use `equal'.
 
 MAP can be an alist, plist, hash-table, or array."
-  (declare (obsolete "use map-put! or (setf (map-elt ...) ...) instead" "27.1"))
-  `(setf (map-elt ,map ,key nil ,testfn) ,value))
+  (declare
+   (obsolete "use `map-put!' or `(setf (map-elt ...) ...)' instead." "27.1"))
+  (if testfn
+      `(with-no-warnings
+         (setf (map-elt ,map ,key nil ,testfn) ,value))
+    `(setf (map-elt ,map ,key) ,value)))
 
 (defun map--plist-delete (map key)
   (let ((tail map) last)
@@ -338,15 +378,16 @@ The default implementation delegates to `map-length'."
   "Return non-nil if and only if MAP contains KEY.
 TESTFN is deprecated.  Its default depends on MAP.
 The default implementation delegates to `map-some'."
+  (declare (advertised-calling-convention (map key) "27.1"))
   (unless testfn (setq testfn #'equal))
   (map-some (lambda (k _v) (funcall testfn key k)) map))
 
 (cl-defmethod map-contains-key ((map list) key &optional testfn)
   "Return non-nil if MAP contains KEY.
 If MAP is an alist, TESTFN defaults to `equal'.
-If MAP is a plist, `plist-member' is used instead."
+If MAP is a plist, TESTFN defaults to `eq'."
   (if (map--plist-p map)
-      (plist-member map key)
+      (map--plist-member map key testfn)
     (let ((v '(nil)))
       (not (eq v (alist-get key map v nil (or testfn #'equal)))))))
 
@@ -459,24 +500,30 @@ This operates by modifying MAP in place.
 If it cannot do that, it signals a `map-not-inplace' error.
 To insert an element without modifying MAP, use `map-insert'."
   ;; `testfn' only exists for backward compatibility with `map-put'!
-  (declare (advertised-calling-convention (map key value) "27.1"))
-  ;; Can't use `cl-defmethod' with `advertised-calling-convention'.
-  (map--dispatch
-   map
-   :list
-   (progn
-     (if (map--plist-p map)
-         (plist-put map key value)
-       (let ((oldmap map))
-         (setf (alist-get key map key nil (or testfn #'equal)) value)
-         (unless (eq oldmap map)
-           (signal 'map-not-inplace (list oldmap)))))
-     ;; Always return the value.
-     value)
-   :hash-table (puthash key value map)
-   ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
-   ;; and let `map-insert' grow the array?
-   :array (aset map key value)))
+  (declare (advertised-calling-convention (map key value) "27.1")))
+
+(cl-defmethod map-put! ((map list) key value &optional testfn)
+  (if (map--plist-p map)
+      (map--plist-put map key value testfn)
+    (let ((oldmap map))
+      (setf (alist-get key map key nil (or testfn #'equal)) value)
+      (unless (eq oldmap map)
+        (signal 'map-not-inplace (list oldmap)))))
+  ;; Always return the value.
+  value)
+
+(cl-defmethod map-put! ((map hash-table) key value &optional _testfn)
+  (puthash key value map))
+
+(cl-defmethod map-put! ((map array) key value &optional _testfn)
+  ;; FIXME: If `key' is too large, should we signal `map-not-inplace'
+  ;; and let `map-insert' grow the array?
+  (aset map key value))
+
+;; There shouldn't be old source code referring to `map--put', yet we do
+;; need to keep it for backward compatibility with .elc files where the
+;; expansion of `setf' may call this function.
+(define-obsolete-function-alias 'map--put #'map-put! "27.1")
 
 (cl-defgeneric map-insert (map key value)
   "Return a new map like MAP except that it associates KEY with VALUE.
@@ -493,11 +540,6 @@ The default implementation defaults to `map-copy' and `map-put!'."
       (cons key (cons value map))
     (cons (cons key value) map)))
 
-;; There shouldn't be old source code referring to `map--put', yet we do
-;; need to keep it for backward compatibility with .elc files where the
-;; expansion of `setf' may call this function.
-(define-obsolete-function-alias 'map--put #'map-put! "27.1")
-
 (cl-defmethod map-apply (function (map list))
   (if (map--plist-p map)
       (cl-call-next-method)