diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 966d8f18b17..0c993806824 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1589,16 +1589,20 @@ keys may not be symbols: @end smallexample @end defun -@defun alist-get key alist &optional default remove -This function is like @code{assq}, but instead of returning the entire -association for @var{key} in @var{alist}, -@w{@code{(@var{key} . @var{value})}}, it returns just the @var{value}. -If @var{key} is not found in @var{alist}, it returns @var{default}. +@defun alist-get key alist &optional default remove testfn +This function is similar to @code{assq}. It finds the first +association @w{@code{(@var{key} . @var{value})}} by comparing +@var{key} with @var{alist} elements, and, if found, returns the +@var{value} of that association. If no association is found, the +function returns @var{default}. Comparison of @var{key} against +@var{alist} elements uses the function specified by @var{testfn}, +defaulting to @code{eq}. -This is a generalized variable (@pxref{Generalized Variables}) that -can be used to change a value with @code{setf}. When using it to set -a value, optional argument @var{remove} non-@code{nil} means to remove -@var{key} from @var{alist} if the new value is @code{eql} to @var{default}. +This is a generalized variable (@pxref{Generalized Variables}) +that can be used to change a value with @code{setf}. When +using it to set a value, optional argument @var{remove} non-@code{nil} +means to remove @var{key}'s association from @var{alist} if the new +value is @code{eql} to @var{default}. @end defun @defun rassq value alist diff --git a/etc/NEWS b/etc/NEWS index edb71118efd..dca562cb3b9 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1119,6 +1119,9 @@ break. * Lisp Changes in Emacs 26.1 ++++ +** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. + ** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of the order. diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index c5c12a6414c..27376fc7f95 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -377,10 +377,12 @@ The return value is the last VAL in the list. `(with-current-buffer ,buf (set (make-local-variable ,var) ,v)))) (gv-define-expander alist-get - (lambda (do key alist &optional default remove) + (lambda (do key alist &optional default remove testfn) (macroexp-let2 macroexp-copyable-p k key (gv-letplace (getter setter) alist - (macroexp-let2 nil p `(assq ,k ,getter) + (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq))) + (assoc ,k ,getter ,testfn) + (assq ,k ,getter)) (funcall do (if (null default) `(cdr ,p) `(if ,p (cdr ,p) ,default)) (lambda (v) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index a89457e877d..31ba075c40f 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: convenience, map, hash-table, alist, array -;; Version: 1.1 +;; Version: 1.2 ;; Package: map ;; Maintainer: emacs-devel@gnu.org @@ -93,11 +93,13 @@ Returns the result of evaluating the form associated with MAP-VAR's type." ((arrayp ,map-var) ,(plist-get args :array)) (t (error "Unsupported map: %s" ,map-var))))) -(defun map-elt (map key &optional default) +(defun map-elt (map key &optional default testfn) "Lookup KEY in MAP and return its associated value. If KEY is not found, return DEFAULT which defaults to nil. -If MAP is a list, `eql' is used to lookup KEY. +If MAP is a list, `eql' is used to lookup KEY. Optional argument +TESTFN, if non-nil, means use its function definition instead of +`eql'. MAP can be a list, hash-table or array." (declare @@ -106,30 +108,33 @@ MAP can be a list, hash-table or array." (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)) + ((key key) (default default) (testfn testfn)) `(if (listp ,mgetter) ;; Special case the alist case, since it can't be handled by the ;; map--put function. ,(gv-get `(alist-get ,key (gv-synthetic-place ,mgetter ,msetter) - ,default) + ,default nil ,testfn) do) ,(funcall do `(map-elt ,mgetter ,key ,default) (lambda (v) `(map--put ,mgetter ,key ,v))))))))) (map--dispatch map - :list (alist-get key map default) + :list (alist-get key map default nil testfn) :hash-table (gethash key map default) :array (if (and (>= key 0) (< key (seq-length map))) (seq-elt map key) default))) -(defmacro map-put (map key value) +(defmacro map-put (map key value &optional testfn) "Associate KEY with VALUE in MAP and return VALUE. If KEY is already present in MAP, replace the associated value with VALUE. +When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'. +TESTFN, if non-nil, means use its function definition instead of +`eql'. MAP can be a list, hash-table or array." - `(setf (map-elt ,map ,key) ,value)) + `(setf (map-elt ,map ,key nil ,testfn) ,value)) (defun map-delete (map key) "Delete KEY from MAP and return MAP. diff --git a/lisp/subr.el b/lisp/subr.el index a9edff6166f..d9d918ed12d 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -725,15 +725,18 @@ Elements of ALIST that are not conses are ignored." (setq tail tail-cdr)))) alist) -(defun alist-get (key alist &optional default remove) - "Return the value associated with KEY in ALIST, using `assq'. +(defun alist-get (key alist &optional default remove testfn) + "Return the value associated with KEY in ALIST. If KEY is not found in ALIST, return DEFAULT. +Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'. This is a generalized variable suitable for use with `setf'. When using it to set a value, optional argument REMOVE non-nil means to remove KEY from ALIST if the new value is `eql' to DEFAULT." (ignore remove) ;;Silence byte-compiler. - (let ((x (assq key alist))) + (let ((x (if (not testfn) + (assq key alist) + (assoc key alist testfn)))) (if x (cdr x) default))) (defun remove (elt seq) diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 07e85cc5391..15b0655040c 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -63,6 +63,11 @@ Evaluate BODY for each created map. (with-maps-do map (should (= 5 (map-elt map 7 5))))) +(ert-deftest test-map-elt-testfn () + (let ((map (list (cons "a" 1) (cons "b" 2)))) + (should-not (map-elt map "a")) + (should (map-elt map "a" nil 'equal)))) + (ert-deftest test-map-elt-with-nil-value () (should (null (map-elt '((a . 1) (b)) @@ -94,6 +99,13 @@ Evaluate BODY for each created map. (should (eq (map-elt alist 2) 'b)))) +(ert-deftest test-map-put-testfn-alist () + (let ((alist (list (cons "a" 1) (cons "b" 2)))) + (map-put alist "a" 3 'equal) + (should-not (cddr alist)) + (map-put alist "a" 9) + (should (cddr alist)))) + (ert-deftest test-map-put-return-value () (let ((ht (make-hash-table))) (should (eq (map-put ht 'a 'hello) 'hello))))