[elpa] externals/leaf 34f0f1d 10/13: Merge pull request #485 from conao3/feature#470

[Stefan Monnier]

branch: externals/leaf
commit 34f0f1d3b91a3a51d24810f66f72e7f57c4941fc
Merge: ff2f4ec e99647d
Author: Naoya Yamashita <conao3@gmail.com>
Commit: GitHub <noreply@github.com>

    Merge pull request #485 from conao3/feature#470
    
    Add :setf, :push, :pre-setf, :pre-push keywords
---
 README.md     | 44 ++++++++++++++++++++++++++++++++++++++++++++
 README.org    | 41 +++++++++++++++++++++++++++++++++++++++++
 leaf-tests.el | 32 ++++++++++++++++++++++++++++++++
 leaf.el       | 10 +++++++++-
 4 files changed, 126 insertions(+), 1 deletion(-)

diff --git a/README.md b/README.md
index f6ea083..d743fa9 100644
--- a/README.md
+++ b/README.md
@@ -18,6 +18,7 @@
 - [Configure variables keywords](#configure-variables-keywords)
   - [:custom, :custom*, :custom-face 
keywords](#custom-custom-custom-face-keywords)
   - [:pre-setq, :setq, :setq-default 
keywords](#pre-setq-setq-setq-default-keywords)
+  - [:setf, :push, :pre-setf, :pre-push 
keywords](#sef-push-pre-setf-pre-push-keywords)
 - [Configure list keywords](#configure-list-keywords)
   - [:mode, :interpreter keywords](#mode-interpreter-keywords)
   - [:magic, :magic-fallback keywords](#magic-magic-fallback-keywords)
@@ -1169,6 +1170,49 @@ You can of course configure multiple variables and set 
the evaluation result of
 
 
 
+## :setf, :push, :pre-setf, :pre-push keywords
+
+These keywords provide a front end to ~setf~ and ~push~.
+
+Note that, *unlike :setq*, it always requires a list of cons cell.
+
+
+```emacs-lisp
+(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)))))
+```
+
+
+
 # Configure list keywords
 
 
diff --git a/README.org b/README.org
index 1e265bb..251288f 100644
--- a/README.org
+++ b/README.org
@@ -36,6 +36,7 @@
 - [[Configure variables keywords]]
   - [[:custom, :custom*, :custom-face keywords]]
   - [[:pre-setq, :setq, :setq-default keywords]]
+  - [[:setf, :push, :pre-setf, :pre-push keywords]]
 - [[Configure list keywords]]
   - [[:mode, :interpreter keywords]]
   - [[:magic, :magic-fallback keywords]]
@@ -1280,6 +1281,46 @@ result of some S expression to variable.
          (setq-default garbage-collection-messages t)))))
 #+end_src
 
+** :setf, :push, :pre-setf, :pre-push keywords
+
+These keywords provide a front end to ~setf~ and ~push~.
+
+Note that, *unlike :setq*, it always requires a list of cons cell.
+
+#+begin_src emacs-lisp
+  (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)))))
+#+end_src
+
 * Configure list keywords
 
 ** :mode, :interpreter keywords
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..d0e0c23 100644
--- a/leaf.el
+++ b/leaf.el
@@ -5,7 +5,7 @@
 ;; Author: Naoya Yamashita <conao3@gmail.com>
 ;; Maintainer: Naoya Yamashita <conao3@gmail.com>
 ;; Keywords: lisp settings
-;; Version: 4.4.2
+;; Version: 4.4.3
 ;; URL: https://github.com/conao3/leaf.el
 ;; Package-Requires: ((emacs "24.1"))
 
@@ -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 ...))