[elpa] externals/leaf 2378904 08/13: implement :pre-setf, :pre-push, :setf, :push keywords

[Stefan Monnier]

branch: externals/leaf
commit 2378904477558288033b6b1a7d76302a0fde097b
Author: Naoya Yamashita <conao3@gmail.com>
Commit: Naoya Yamashita <conao3@gmail.com>

    implement :pre-setf, :pre-push, :setf, :push keywords
---
 leaf-tests.el | 32 ++++++++++++++++++++++++++++++++
 leaf.el       |  8 ++++++++
 2 files changed, 40 insertions(+)

diff --git a/leaf-tests.el b/leaf-tests.el
index 6d089aa..f786db0 100644
--- a/leaf-tests.el
+++ b/leaf-tests.el
@@ -1998,6 +1998,38 @@ Example:
        (setq leaf-backend-bind 'bind-key)
        (setq leaf-backend-bind* 'bind-key)))))
 
+(cort-deftest-with-macroexpand leaf/setf
+  '(
+    ;; :setf require cons-cell list ONLY.
+    ((leaf alloc
+       :setf ((gc-cons-threshold . 536870912)
+              (garbage-collection-messages . t))
+       :require t)
+     (prog1 'alloc
+       (require 'alloc)
+       (setf gc-cons-threshold 536870912)
+       (setf garbage-collection-messages t)))
+
+    ;; left value could generalized variable (alist-get, plist-get...)
+    ;; note that it is specified as the car of the cons list.
+    ((leaf emacs
+       :setf
+       (((alist-get "gnu" package-archives) . "http://elpa.gnu.org/packages/";)
+        ((alist-get 'vertical-scroll-bars default-frame-alist) . nil)))
+     (prog1 'emacs
+       (setf (alist-get "gnu" package-archives) 
"http://elpa.gnu.org/packages/";)
+       (setf (alist-get 'vertical-scroll-bars default-frame-alist) nil)))))
+
+(cort-deftest-with-macroexpand leaf/push
+  '(
+    ;; :setf require cons-cell list ONLY.
+    ((leaf emacs
+       :push ((package-archives . '("melpa" . "https://melpa.org/packages/";))
+              (auto-mode-alist . '("\\.jpe?g\\'" . image-mode))))
+     (prog1 'emacs
+       (push '("melpa" . "https://melpa.org/packages/";) package-archives)
+       (push '("\\.jpe?g\\'" . image-mode) auto-mode-alist)))))
+
 (cort-deftest-with-macroexpand leaf/pl-setq
   '(
     ;; Emulate setting `sql-connection-alist' with value taken from 
`some-plstore'.
diff --git a/leaf.el b/leaf.el
index e61961f..807ffca 100644
--- a/leaf.el
+++ b/leaf.el
@@ -135,6 +135,8 @@ Same as `list' but this macro does not evaluate any 
arguments."
                         `(,@(mapcar (lambda (elm) `(advice-remove ,@elm)) (car 
leaf--value)) ,@leaf--body))
 
    :pre-setq          `(,@(mapcar (lambda (elm) `(setq ,(car elm) ,(cdr elm))) 
leaf--value) ,@leaf--body)
+   :pre-setf          `(,@(mapcar (lambda (elm) `(setf ,(car elm) ,(cdr elm))) 
leaf--value) ,@leaf--body)
+   :pre-push          `(,@(mapcar (lambda (elm) `(push ,(cdr elm) ,(car elm))) 
leaf--value) ,@leaf--body)
    :pl-pre-setq       `(,@(mapcar (lambda (elm) `(setq ,(car elm) 
(leaf-handler-auth ,leaf--name ,(car elm) ,(cdr elm)))) leaf--value) 
,@leaf--body)
    :auth-pre-setq     `(,@(mapcar (lambda (elm) `(setq ,(car elm) 
(leaf-handler-auth ,leaf--name ,(car elm) ,(cdr elm)))) leaf--value) 
,@leaf--body)
 
@@ -155,6 +157,8 @@ Same as `list' but this macro does not evaluate any 
arguments."
 
    :setq              `(,@(mapcar (lambda (elm) `(setq ,(car elm) ,(cdr elm))) 
leaf--value) ,@leaf--body)
    :setq-default      `(,@(mapcar (lambda (elm) `(setq-default ,(car elm) 
,(cdr elm))) leaf--value) ,@leaf--body)
+   :setf              `(,@(mapcar (lambda (elm) `(setf ,(car elm) ,(cdr elm))) 
leaf--value) ,@leaf--body)
+   :push              `(,@(mapcar (lambda (elm) `(push ,(cdr elm) ,(car elm))) 
leaf--value) ,@leaf--body)
    :pl-setq           `(,@(mapcar (lambda (elm) `(setq ,(car elm) 
(leaf-handler-auth ,leaf--name ,(car elm) ,(cdr elm)))) leaf--value) 
,@leaf--body)
    :auth-setq         `(,@(mapcar (lambda (elm) `(setq ,(car elm) 
(leaf-handler-auth ,leaf--name ,(car elm) ,(cdr elm)))) leaf--value) 
,@leaf--body)
    :pl-setq-default   `(,@(mapcar (lambda (elm) `(setq-default ,(car elm) 
(leaf-handler-auth ,leaf--name ,(car elm) ,(cdr elm)))) leaf--value) 
,@leaf--body)
@@ -249,6 +253,10 @@ Sort by `leaf-sort-leaf--values-plist' in this order.")
                (cons (car elm) (cadr elm)))
              (mapcan 'identity leaf--value)))
 
+    ((memq leaf--key '(:setf :push :pre-setf :pre-push))
+     ;; Just merge leaf--value normalizer.
+     (apply #'append leaf--value))
+
     ((memq leaf--key '(:bind :bind* :bind-keymap :bind-keymap*))
      ;; Accept: `leaf-keys' accept form
      ;; Return: a pair like (leaf--value . (fn fn ...))