summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorTino Calancha <tino.calancha@gmail.com>2017-07-17 21:30:50 +0900
committerTino Calancha <tino.calancha@gmail.com>2017-07-17 21:30:50 +0900
commit76e1f7d00fbff7bf8183ba85db2f67a11aa2d5ce (patch)
treeac3d9fbe5fa46dbad70b527355e2f1ba997f36f8 /lisp/emacs-lisp
parent4968aa685b85840d79258ff6b61ba2bcfb99e2bc (diff)
downloademacs-76e1f7d00fbff7bf8183ba85db2f67a11aa2d5ce.tar.gz
emacs-76e1f7d00fbff7bf8183ba85db2f67a11aa2d5ce.tar.bz2
emacs-76e1f7d00fbff7bf8183ba85db2f67a11aa2d5ce.zip
alist-get: Add optional arg TESTFN
If TESTFN is non-nil, then it is the predicate to lookup the alist. Otherwise, use 'eq' (Bug#27584). * lisp/subr.el (alist-get): Add optional arg FULL. * lisp/emacs-lisp/map.el (map-elt, map-put): Add optional arg TESTFN. * lisp/emacs-lisp/gv.el (alist-get): Update expander. * doc/lispref/lists.texi (Association Lists): Update manual. * etc/NEWS: Announce the changes. * test/lisp/emacs-lisp/map-tests.el (test-map-put-testfn-alist) (test-map-elt-testfn): New tests.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/gv.el6
-rw-r--r--lisp/emacs-lisp/map.el21
2 files changed, 17 insertions, 10 deletions
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 <nicolas@petton.fr>
;; 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.