emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/compat 97a492b424 1/3: compat-29: Add plist-get general


From: ELPA Syncer
Subject: [elpa] externals/compat 97a492b424 1/3: compat-29: Add plist-get generalized variable
Date: Tue, 17 Jan 2023 13:57:26 -0500 (EST)

branch: externals/compat
commit 97a492b4246b9a8ae8c710263e78735e0ae88c99
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    compat-29: Add plist-get generalized variable
---
 NEWS.org        |  1 +
 compat-26.el    |  4 +++-
 compat-27.el    |  8 ++++----
 compat-29.el    | 18 ++++++++++++++++++
 compat-tests.el | 52 ++++++++++++++++++++++++++++++++++++++--------------
 compat.texi     |  4 +++-
 6 files changed, 67 insertions(+), 20 deletions(-)

diff --git a/NEWS.org b/NEWS.org
index e0c03bc240..055ff211a9 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 f1d49d540c..a139251726 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 b891fb2311..07d5fad641 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 adca2179e1..27edaaa0b2 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 26389d4553..e315e2ca90 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 fe1c89c497..1280fe6d8a 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]