branch: externals/leaf
commit 7d8f768db5077bdb9f595cbf841018fc600ecf77
Merge: 7460e3c5eb 91f7ba756c
Author: Naoya Yamashita <con...@gmail.com>
Commit: GitHub <nore...@github.com>
Merge pull request #515 from meziberry/p/bind
Now :bind can accept lambda form binding. #322
---
README.org | 8 +++++++-
leaf-tests.el | 26 ++++++++++++++++++++++----
leaf.el | 50 +++++++++++++++++---------------------------------
3 files changed, 46 insertions(+), 38 deletions(-)
diff --git a/README.org b/README.org
index 6d4a49bf2c..a22f319563 100644
--- a/README.org
+++ b/README.org
@@ -840,7 +840,13 @@ If you omit ~:package~, use leaf--name as ~:package~ to
lazy load.
(prog1 'files
(unless (fboundp 'find-file) (autoload #'find-file "files" nil t))
(declare-function find-file "files")
- (leaf-keys (([(control ?x) (control ?f)] . find-file)))))))
+ (leaf-keys (([(control ?x) (control ?f)] . find-file)))))
+
+ ;; you can bind the lambda.
+ ((leaf color-moccur
+ :bind ("M-s O" . (lambda () "color-moccur" (interactive)
(color-moccur))))
+ (prog1 'color-moccur
+ (leaf-keys (("M-s O" . (lambda () "color-moccur" (interactive)
(color-moccur)))))))))
(cort-deftest-with-macroexpand leaf/bind*
'(
diff --git a/leaf-tests.el b/leaf-tests.el
index 97b4654742..1edd271e45 100644
--- a/leaf-tests.el
+++ b/leaf-tests.el
@@ -1161,7 +1161,13 @@ Example:
:bind (([(control ?x) (control ?f)] . find-file)))
(prog1 'files
(unless (fboundp 'find-file) (autoload #'find-file "files" nil t))
- (leaf-keys (([(control ?x) (control ?f)] . find-file)))))))
+ (leaf-keys (([(control ?x) (control ?f)] . find-file)))))
+
+ ;; you can bind the lambda.
+ ((leaf color-moccur
+ :bind ("M-s O" . (lambda () "color-moccur" (interactive)
(color-moccur))))
+ (prog1 'color-moccur
+ (leaf-keys (("M-s O" . (lambda () "color-moccur" (interactive)
(color-moccur)))))))))
(cort-deftest-with-macroexpand leaf/bind*
'(
@@ -1606,13 +1612,13 @@ Example:
((leaf hook
:hook (foo-hook . (lambda () (foo))))
(prog1 'hook
- (add-hook 'foo-hook #'(lambda nil (foo)))))
+ (add-hook 'foo-hook #'(lambda () (foo)))))
;; lambda sexp with many sexps
((leaf hook
:hook (foo-hook . (lambda () (foo) (bar) (baz))))
(prog1 'hook
- (add-hook 'foo-hook #'(lambda nil (foo) (bar) (baz)))))))
+ (add-hook 'foo-hook #'(lambda () (foo) (bar) (baz)))))))
(cort-deftest-with-macroexpand leaf/advice
'(
@@ -2442,7 +2448,19 @@ Example:
(let* ((old (lookup-key global-map [(control 120) (control 102)]))
(value `(global-map "C-x C-f" undo ,(and old (not (numberp old))
old) nil)))
(leaf-safe-push value leaf-key-bindlist)
- (define-key global-map [(control 120) (control 102)] 'undo))))))
+ (define-key global-map [(control 120) (control 102)] 'undo)))
+
+ ((leaf-key "M-s O" (lambda () "color-moccur" (interactive)
(color-moccur)))
+ (let* ((old (lookup-key global-map (kbd "M-s O")))
+ (value `(global-map "M-s O" *lambda-function* ,(and old (not
(numberp old)) old) nil)))
+ (leaf-safe-push value leaf-key-bindlist)
+ (define-key global-map (kbd "M-s O") '(lambda () "color-moccur"
(interactive) (color-moccur)))))
+
+ ((leaf-key "M-s O" '(menu-item "" nil :filter (lambda (&optional _)
#'other-window)))
+ (let* ((old (lookup-key global-map (kbd "M-s O")))
+ (value `(global-map "M-s O" *menu-item* ,(and old (not (numberp
old)) old) nil)))
+ (leaf-safe-push value leaf-key-bindlist)
+ (define-key global-map (kbd "M-s O") '(menu-item "" nil :filter
(lambda (&optional _) #'other-window))))))))
(when (version< "24.0" emacs-version)
(cort-deftest-with-macroexpand leaf/leaf-key-bind-keymap
diff --git a/leaf.el b/leaf.el
index 19a5f3246b..f36e76a05c 100644
--- a/leaf.el
+++ b/leaf.el
@@ -5,7 +5,7 @@
;; Author: Naoya Yamashita <con...@gmail.com>
;; Maintainer: Naoya Yamashita <con...@gmail.com>
;; Keywords: lisp settings
-;; Version: 4.5.3
+;; Version: 4.5.4
;; URL: https://github.com/conao3/leaf.el
;; Package-Requires: ((emacs "24.1"))
@@ -834,31 +834,29 @@ KEY-NAME may be a vector, in which case it is passed
straight to
`define-key'. Or it may be a string to be interpreted as spelled-out
keystrokes. See documentation of `edmacro-mode' for details.
-COMMAND must be an interactive function or lambda form.
+COMMAND must be an interactive function. lambda form, menu-item,
+or the form that returned one of them also be accepted.
KEYMAP, if present, should be a keymap and not a quoted symbol.
For example:
(leaf-key \"M-h\" #'some-interactive-function my-mode-map)
-If PREDICATE is non-nil, it is a form evaluated to determine when a
-key should be bound. It must return non-nil in such cases. Emacs can
-evaluate this form at any time that it does redisplay or operates on
-menu data structures, so you should write it so it can safely be
-called at any time.
-
You can also use [remap COMMAND] as KEY.
For example:
(leaf-key [remap backward-sentence] 'sh-beginning-of-command)"
(let* ((key* (eval key))
(command* (eval command))
(keymap* (eval keymap))
+ (bindto (cond ((symbolp command*) command*)
+ ((eq (car-safe command*) 'lambda) '*lambda-function*)
+ ((eq (car-safe command*) 'menu-item) '*menu-item*)))
(mmap (or keymap* 'global-map))
(vecp (vectorp key*))
(path (leaf-this-file))
(_mvec (if (vectorp key*) key* (read-kbd-macro key*)))
(mstr (if (stringp key*) key* (key-description key*))))
`(let* ((old (lookup-key ,mmap ,(if vecp key* `(kbd ,key*))))
- (value ,(list '\` `(,mmap ,mstr ,command* ,',(and old (not
(numberp old)) old) ,path))))
+ (value ,(list '\` `(,mmap ,mstr ,bindto ,',(and old (not (numberp
old)) old) ,path))))
(leaf-safe-push value leaf-key-bindlist)
(define-key ,mmap ,(if vecp key* `(kbd ,key*)) ',command*))))
@@ -869,7 +867,7 @@ Bind COMMAND at KEY."
(defmacro leaf-keys (bind &optional dryrun-name bind-keymap bind-keymap-pkg)
"Bind multiple BIND for KEYMAP defined in PKG.
-BIND is (KEY . COMMAND) or (KEY . nil) to unbind KEY.
+BIND is (KEY . COMMAND), (KEY . (lambda ...)). (KEY . nil) to unbind KEY.
If BIND-KEYMAP is non-nil generate `leaf-key-bind-keymap' instead of
`leaf-key'.
If BIND-KEYMAP-PKG is passed, require it before binding.
@@ -890,8 +888,7 @@ NOTE: BIND can also accept list of these."
(condition-case _err
(and (listp x)
(or (stringp (eval (car x)))
- (vectorp (eval (car x))))
- (atom (cdr x)))
+ (vectorp (eval (car x)))))
(error nil))))
recurfn forms bds fns)
(setq recurfn
@@ -900,23 +897,12 @@ NOTE: BIND can also accept list of these."
((funcall pairp bind)
(push (if bind-keymap
`(leaf-key-bind-keymap ,(car bind) ,(cdr bind) nil
,bind-keymap-pkg)
- `(leaf-key ,(car bind) #',(cdr bind)))
+ (if (atom (cdr bind))
+ `(leaf-key ,(car bind) #',(cdr bind))
+ `(leaf-key ,(car bind) ,(cdr bind))))
forms)
(push bind bds)
(push (cdr bind) fns))
- ((and (listp (car bind))
- (funcall pairp (car bind)))
- (mapcar (lambda (elm)
- (if (funcall pairp elm)
- (progn
- (push (if bind-keymap
- `(leaf-key-bind-keymap ,(car elm)
,(cdr elm) nil ,bind-keymap-pkg)
- `(leaf-key ,(car elm) #',(cdr elm)))
- forms)
- (push elm bds)
- (push (cdr elm) fns))
- (funcall recurfn elm)))
- bind))
((or (keywordp (car bind))
(symbolp (car bind)))
(let* ((map (leaf-sym-from-keyword (car bind)))
@@ -929,19 +915,17 @@ NOTE: BIND can also accept list of these."
(push (cdr elm) fns)
(if bind-keymap
`(leaf-key-bind-keymap ,(car elm) ,(cdr
elm) ',map ,bind-keymap-pkg)
- `(leaf-key ,(car elm) #',(cdr elm)
',map)))
+ (if (atom (cdr elm))
+ `(leaf-key ,(car elm) #',(cdr elm)
',map)
+ `(leaf-key ,(car elm) ,(cdr elm)
',map))))
elmbinds))))
- (push (if pkg
- `(,map :package ,pkg ,@elmbinds)
- `(,map :package ,dryrun-name ,@elmbinds))
- bds)
+ (push `(,map :package ,(or `,pkg `,dryrun-name) ,@elmbinds)
bds)
(when pkg
(dolist (elmpkg (if (atom pkg) `(,pkg) pkg))
(unless bind-keymap
(setq form `(eval-after-load ',elmpkg ',form)))))
(push form forms)))
- (t
- (mapcar (lambda (elm) (funcall recurfn elm)) bind)))))
+ (t (mapcar recurfn bind)))))
(funcall recurfn bind)
(if dryrun-name
`'(,(nreverse bds) ,(nreverse fns))
