[elpa] externals/compat c4bde3f108 4/7: Add generalised variable handling for compat-alist-get

[ELPA Syncer]

branch: externals/compat
commit c4bde3f108f5531ab20aa07415cb838d92fcfa4e
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@posteo.net>

    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