aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Mendler <mail@daniel-mendler.de>2023-01-17 18:55:09 +0100
committerDaniel Mendler <mail@daniel-mendler.de>2023-01-17 19:04:06 +0100
commit97a492b4246b9a8ae8c710263e78735e0ae88c99 (patch)
treeb63eb8c5fc63371c13372e5e67db1aad30148c3f
parent66fc73a53519907c6efc332705ed650888952bdb (diff)
compat-29: Add plist-get generalized variable
-rw-r--r--NEWS.org1
-rw-r--r--compat-26.el4
-rw-r--r--compat-27.el8
-rw-r--r--compat-29.el18
-rw-r--r--compat-tests.el52
-rw-r--r--compat.texi4
6 files changed, 67 insertions, 20 deletions
diff --git a/NEWS.org b/NEWS.org
index e0c03bc..055ff21 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -7,6 +7,7 @@
- compat-27: Add ~make-decoded-time~.
- compat-28: Add ~color-dark-p~.
- compat-28: Add ~with-window-non-dedicated~.
+- compat-29: Add ~plist-get~ generalized variable.
* Release of "Compat" Version 29.1.2.0
diff --git a/compat-26.el b/compat-26.el
index f1d49d5..a139251 100644
--- a/compat-26.el
+++ b/compat-26.el
@@ -116,7 +116,9 @@ SEQUENCE may be a list, a vector, a boolean vector, or a string."
((not (eql ,default ,v)) ,set-exp)
(,p ,(funcall setter
`(delq ,p ,getter))))))
- ,v)))))))))))
+ ,v))))))))))
+ (unless (get 'alist-get 'gv-expander)
+ (put 'alist-get 'gv-expander (get 'compat--alist-get 'gv-expander))))
(compat-defun string-trim-left (string &optional regexp) ;; <compat-tests:string-trim-left>
"Handle optional argument REGEXP."
diff --git a/compat-27.el b/compat-27.el
index b891fb2..07d5fad 100644
--- a/compat-27.el
+++ b/compat-27.el
@@ -334,11 +334,11 @@ Internal use only."
(setcdr image (plist-put (cdr image) property value)))
value)
-(compat-guard t
+;; HACK: image--set-property was broken with an off-by-one error on Emacs 26.
+;; The bug was fixed in a4ad7bed187493c1c230f223b52c71f5c34f7c89. Therefore we
+;; override the gv expander until Emacs 27.1.
+(compat-guard (or (= emacs-major-version 26) (not (get 'image-property 'gv-expande)))
:feature image
- ;; HACK: image--set-property was broken with an off-by-one error on Emacs 26.
- ;; The bug was fixed in a4ad7bed187493c1c230f223b52c71f5c34f7c89. Therefore we
- ;; override the gv expander until Emacs 27.1.
(if (eval-when-compile (< emacs-major-version 26))
(gv-define-simple-setter image-property image--set-property) ;; <compat-tests:image-property>
(gv-define-simple-setter image-property compat--image--set-property)))
diff --git a/compat-29.el b/compat-29.el
index adca217..27edaaa 100644
--- a/compat-29.el
+++ b/compat-29.el
@@ -120,6 +120,24 @@ Unibyte strings are converted to multibyte for comparison."
(throw 'found plist))
(setq plist (cddr plist))))))
+;;;; Defined in gv.el
+
+(compat-guard t
+ (gv-define-expander compat--plist-get ;; <compat-tests:plist-get-gv>
+ (lambda (do plist prop &optional predicate)
+ (macroexp-let2 macroexp-copyable-p key prop
+ (gv-letplace (getter setter) plist
+ (macroexp-let2 nil p `(cdr (compat--plist-member ,getter ,key ,predicate))
+ (funcall do
+ `(car ,p)
+ (lambda (val)
+ `(if ,p
+ (setcar ,p ,val)
+ ,(funcall setter
+ `(cons ,key (cons ,val ,getter)))))))))))
+ (unless (get 'plist-get 'gv-expander)
+ (put 'plist-get 'gv-expander (get 'compat--plist-get 'gv-expander))))
+
;;;; Defined in editfns.c
(compat-defun pos-bol (&optional n) ;; <compat-tests:pos-bol>
diff --git a/compat-tests.el b/compat-tests.el
index 26389d4..e315e2c 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -2208,20 +2208,44 @@
(should-equal 'd (compat-call alist-get 2 '((1 . a) (2 . b) (3 . c)) 'd nil #'ignore)))
(ert-deftest alist-get-gv ()
- (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-call alist-get 1 alist-1) "eins")
- (should-equal (compat-call alist-get 1 alist-1) "eins")
- (setf (compat-call alist-get 2 alist-1 nil 'remove) nil)
- (should-equal alist-1 '((1 . "eins") (3 . "three")))
- (setf (compat-call alist-get "one" alist-2 nil nil #'string=) "eins")
- (should-equal (compat-call alist-get "one" alist-2 nil nil #'string=)
- "eins")))
+ (let ((alist (list (cons 1 "one")
+ (cons 2 "two")
+ (cons 3 "three"))))
+ (setf (alist-get 1 alist) "eins")
+ (should-equal (alist-get 1 alist) "eins")
+ (setf (alist-get 2 alist nil 'remove) nil)
+ (should-equal alist '((1 . "eins") (3 . "three"))))
+ (let ((alist (list (cons 1 "one")
+ (cons 2 "two")
+ (cons 3 "three"))))
+ (setf (compat-call alist-get 1 alist) "eins")
+ (should-equal (compat-call alist-get 1 alist) "eins")
+ (setf (compat-call alist-get 2 alist nil 'remove) nil)
+ (should-equal alist '((1 . "eins") (3 . "three"))))
+ (let ((alist (list (cons "one" 1)
+ (cons "two" 2)
+ (cons "three" 3))))
+ (setf (compat-call alist-get "one" alist nil nil #'string=) "eins")
+ (should-equal (compat-call alist-get "one" alist nil nil #'string=) "eins")
+ (should-equal alist '(("one" . "eins") ("two" . 2) ("three" . 3)))
+ (setf (compat-call alist-get "two" alist nil 'remove #'string=) nil)
+ (should-equal alist '(("one" . "eins") ("three" . 3)))))
+
+(ert-deftest plist-get-gv ()
+ (let ((plist '(1 "one" 2 "two" 3 "three")))
+ (setf (plist-get plist 1) "eins")
+ (should-equal (plist-get plist 1) "eins")
+ (setf (plist-get plist 2) nil)
+ (should-equal plist '(1 "eins" 2 nil 3 "three")))
+ (let ((plist '(1 "one" 2 "two" 3 "three")))
+ (setf (compat-call plist-get plist 1) "eins")
+ (should-equal (compat-call plist-get plist 1) "eins")
+ (setf (compat-call plist-get plist 2) nil)
+ (should-equal plist '(1 "eins" 2 nil 3 "three")))
+ (let ((plist '("one" 1 "two" 2 "three" 3)))
+ (setf (compat-call plist-get plist "one" #'string=) "eins")
+ (should-equal (compat-call plist-get plist "one" #'string=) "eins")
+ (should-equal plist '("one" "eins" "two" 2 "three" 3))))
(ert-deftest prop-match ()
(should (prop-match-p (make-prop-match)))
diff --git a/compat.texi b/compat.texi
index fe1c89c..1280fe6 100644
--- a/compat.texi
+++ b/compat.texi
@@ -2623,7 +2623,9 @@ returns @code{nil}.
@xref{Plist Access,,,elisp}.
This compatibility version handles the optional argument
-@var{predicate}.
+@var{predicate}. This is a generalized variable (@pxref{Generalized
+Variables,,,elisp}) that can be used to change a value with
+@code{setf}.
@end defun
@c copied from lispref/lists.texi