@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}.
-
-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}.
+@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}'s association from @var{alist} if the new
+value is @code{eql} to @var{default}.
@end defun
@defun rassq value alist
\f
* 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.
`(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)
;; Author: Nicolas Petton <nicolas@petton.fr>
;; Keywords: convenience, map, hash-table, alist, array
-;; Version: 1.1
+;; Version: 1.2
;; Package: map
;; Maintainer: emacs-devel@gnu.org
((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
(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.
(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)
(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))
(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))))
projects / emacs.git / commitdiff