branch: externals/compat
commit c4bde3f108f5531ab20aa07415cb838d92fcfa4e
Author: Philip Kaludercic <[email protected]>
Commit: Philip Kaludercic <[email protected]>
Add generalised variable handling for compat-alist-get
---
MANUAL | 3 ++-
compat-26.el | 31 +++++++++++++++++++++++++++++++
compat-tests.el | 16 ++++++++++++++++
3 files changed, 49 insertions(+), 1 deletion(-)
diff --git a/MANUAL b/MANUAL
index 373e220bd9..8115234d63 100644
--- a/MANUAL
+++ b/MANUAL
@@ -244,7 +244,8 @@ when ~compat-26~ is required:
Handle the optional argument ABSOLUTE.
- Function: compat-alist-get :: See [[info:elisp#Association Lists][(elisp)
Association Lists]].
- Handle the optional argument TESTFN.
+ Handle the optional argument TESTFN. Can also be used as a
+ generalised variable.
Compat does not provide support for the following Lisp features
implemented in 26.1:
diff --git a/compat-26.el b/compat-26.el
index d3c8b5c6c4..4b8114fb69 100644
--- a/compat-26.el
+++ b/compat-26.el
@@ -153,6 +153,37 @@ from the absolute start of the buffer, disregarding the
narrowing."
(compat--alist-get-full-elisp key alist default remove testfn)
(alist-get key alist default remove)))
+(gv-define-expander compat-alist-get
+ (lambda (do key alist &optional default remove testfn)
+ (macroexp-let2 macroexp-copyable-p k key
+ (gv-letplace (getter setter) alist
+ (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)
+ (macroexp-let2 nil v v
+ (let ((set-exp
+ `(if ,p (setcdr ,p ,v)
+ ,(funcall setter
+ `(cons (setq ,p (cons ,k ,v))
+ ,getter)))))
+ `(progn
+ ,(cond
+ ((null remove) set-exp)
+ ((or (eql v default)
+ (and (eq (car-safe v) 'quote)
+ (eq (car-safe default) 'quote)
+ (eql (cadr v) (cadr default))))
+ `(if ,p ,(funcall setter `(delq ,p ,getter))))
+ (t
+ `(cond
+ ((not (eql ,default ,v)) ,set-exp)
+ (,p ,(funcall setter
+ `(delq ,p ,getter))))))
+ ,v))))))))))
+
(compat-defun string-trim-left (string &optional regexp)
"Trim STRING of leading string matching REGEXP.
diff --git a/compat-tests.el b/compat-tests.el
index c4089831bd..6da09815c5 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -609,6 +609,22 @@ being compared against."
(ought 'd 0 '((1 . a) (2 . b) (3 . c)) 'd) ;default value
(ought 'd 2 '((1 . a) (2 . b) (3 . c)) 'd nil #'ignore))
+(ert-deftest compat-alist-get-gv ()
+ "Test if the `compat-alist-get' can be used as a generalised variable."
+ (let ((alist-1 (list (cons 1 "one")
+ (cons 2 "two")
+ (cons 3 "three")))
+ (alist-2 (list (cons "one" 1)
+ (cons "two" 2)
+ (cons "three" 3))))
+ (setf (compat-alist-get 1 alist-1) "eins")
+ (should (equal (compat-alist-get 1 alist-1) "eins"))
+ (setf (compat-alist-get 2 alist-1 nil 'remove) nil)
+ (should (equal alist-1 '((1 . "eins") (3 . "three"))))
+ (setf (compat-alist-get "one" alist-2 nil nil #'string=) "eins")
+ (should (equal (compat-alist-get "one" alist-2 nil nil #'string=)
+ "eins"))))
+
(compat-deftest string-trim-left'
(ought "" "") ;empty string
(ought "a" "a") ;"full" string
