Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Allow multiple keymaps in :map argument #1051

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 8 additions & 0 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -246,6 +246,14 @@ The effect of this statement is to wait until `helm` has loaded, and then to
bind the key `C-c h` to `helm-execute-persistent-action` within Helm's local
keymap, `helm-command-map`.

Multiple keymaps can be specified as a list:

``` elisp
(use-package helm
:bind (:map (lisp-mode-map emacs-lisp-mode-map)
("C-c x" . eval-print-last-sexp)))
```

Multiple uses of `:map` may be specified. Any binding occurring before the
first use of `:map` are applied to the global keymap:

Expand Down
3 changes: 2 additions & 1 deletion bind-chord.el
Original file line number Diff line number Diff line change
Expand Up @@ -102,7 +102,8 @@ function symbol (unquoted)."
"Bind multiple chords at once.

Accepts keyword argument:
:map - a keymap into which the keybindings should be added
:map - a keymap or list of keymaps into which the keybindings should be
added

The rest of the arguments are conses of keybinding string and a
function symbol (unquoted)."
Expand Down
77 changes: 41 additions & 36 deletions bind-key.el
Original file line number Diff line number Diff line change
Expand Up @@ -262,12 +262,13 @@ In contrast to `define-key', this function removes the binding from the keymap."
"Similar to `bind-key', but overrides any mode-specific bindings."
`(bind-key ,key-name ,command override-global-map ,predicate))

(defun bind-keys-form (args keymap)
(defun bind-keys-form (args keymaps)
"Bind multiple keys at once.

Accepts keyword arguments:
:map MAP - a keymap into which the keybindings should be
added
:map MAPS - a keymap into which the keybindings should be
added, or a list of such keymaps, where `nil'
stands for `global-map'
:prefix KEY - prefix key for these bindings
:prefix-map MAP - name of the prefix map that should be created
for these bindings
Expand All @@ -290,7 +291,7 @@ Accepts keyword arguments:

The rest of the arguments are conses of keybinding string and a
function symbol (unquoted)."
(let (map
(let (maps
prefix-doc
prefix-map
prefix
Expand All @@ -307,20 +308,18 @@ function symbol (unquoted)."
(while (and cont args)
(if (cond ((and (eq :map (car args))
(not prefix-map))
(setq map (cadr args)))
(setq maps
(let ((arg (cadr args)))
(if (consp arg) arg (list arg)))))
((eq :prefix-docstring (car args))
(setq prefix-doc (cadr args)))
((and (eq :prefix-map (car args))
(not (memq map '(global-map
override-global-map))))
(setq prefix-map (cadr args)))
((eq :prefix-map (car args))
(setq prefix-map (or (cadr args) 'global-map)))
((eq :repeat-docstring (car args))
(setq repeat-doc (cadr args)))
((and (eq :repeat-map (car args))
(not (memq map '(global-map
override-global-map))))
(setq repeat-map (cadr args))
(setq map repeat-map))
((eq :repeat-map (car args))
(setq repeat-map (or (cadr args) 'global-map))
(setq maps (list repeat-map)))
((eq :continue (car args))
(setq repeat-type :continue
arg-change-func 'cdr))
Expand All @@ -342,14 +341,20 @@ function symbol (unquoted)."
(and prefix (not prefix-map)))
(error "Both :prefix-map and :prefix must be supplied"))

(when (memq prefix-map '(global-map override-global-map))
(error "Invalid :prefix-map"))

(when (memq repeat-map '(global-map override-global-map))
(error "Invalid :repeat-map"))

(when repeat-type
(unless repeat-map
(error ":continue and :exit require specifying :repeat-map")))

(when (and menu-name (not prefix))
(error "If :menu-name is supplied, :prefix must be too"))

(unless map (setq map keymap))
(setq maps (or maps keymaps (list nil)))

;; Process key binding arguments
(let (first next)
Expand Down Expand Up @@ -381,40 +386,40 @@ function symbol (unquoted)."
,@(if menu-name
`((define-prefix-command ',prefix-map nil ,menu-name))
`((define-prefix-command ',prefix-map)))
,@(if (and map (not (eq map 'global-map)))
(wrap map `((bind-key ,prefix ',prefix-map ,map ,filter)))
`((bind-key ,prefix ',prefix-map nil ,filter)))))
,@(cl-mapcan
(lambda (map)
(wrap map `((bind-key ,prefix ',prefix-map ,map ,filter))))
maps)))
(when repeat-map
`((defvar ,repeat-map (make-sparse-keymap)
,@(when repeat-doc `(,repeat-doc)))))
(wrap map
(cl-mapcan
(lambda (form)
(let ((fun (and (cdr form) (list 'function (cdr form)))))
(if prefix-map
`((bind-key ,(car form) ,fun ,prefix-map ,filter))
(if (and map (not (eq map 'global-map)))
;; Only needed in this branch, since when
;; repeat-map is non-nil, map is always
;; non-nil
`(,@(when (and repeat-map (not (eq repeat-type :exit)))
`((put ,fun 'repeat-map ',repeat-map)))
(bind-key ,(car form) ,fun ,map ,filter))
`((bind-key ,(car form) ,fun nil ,filter))))))
first))
(cl-mapcan
(lambda (map)
(wrap map
(cl-mapcan
(lambda (form)
(let ((fun (and (cdr form) (list 'function (cdr form)))))
(if prefix-map
`((bind-key ,(car form) ,fun ,prefix-map ,filter))
`(,@(when (and repeat-map (not (eq repeat-type :exit)))
`((put ,fun 'repeat-map ',repeat-map)))
(bind-key ,(car form) ,fun ,map ,filter)))))
first)))
maps)
(when next
(bind-keys-form `(,@(when repeat-map `(:repeat-map ,repeat-map))
,@(if pkg
(cons :package (cons pkg next))
next)) map)))))))
next))
maps)))))))

;;;###autoload
(defmacro bind-keys (&rest args)
"Bind multiple keys at once.

Accepts keyword arguments:
:map MAP - a keymap into which the keybindings should be
added
added, or a list of such keymaps
:prefix KEY - prefix key for these bindings
:prefix-map MAP - name of the prefix map that should be created
for these bindings
Expand Down Expand Up @@ -446,7 +451,7 @@ Accepts the same keyword arguments as `bind-keys' (which see).

This binds keys in such a way that bindings are not overridden by
other modes. See `override-global-mode'."
(macroexp-progn (bind-keys-form args 'override-global-map)))
(macroexp-progn (bind-keys-form args '(override-global-map))))

(defun get-binding-description (elem)
(cond
Expand Down
13 changes: 7 additions & 6 deletions use-package-bind-key.el
Original file line number Diff line number Diff line change
Expand Up @@ -92,19 +92,20 @@ deferred until the prefix key sequence is pressed."
;; :prefix-docstring STRING
;; :prefix-map SYMBOL
;; :prefix STRING
;; :repeat-docstring STRING
;; :repeat-docstring STRING
;; :repeat-map SYMBOL
;; :filter SEXP
;; :menu-name STRING
;; :package SYMBOL
;; :continue and :exit are used within :repeat-map
((or (and (eq x :map) (symbolp (cadr arg)))
;; :continue and :exit are used within :repeat-map
((or (and (eq x :map) (or (symbolp (cadr arg))
(listp (cadr arg))))
(and (eq x :prefix) (stringp (cadr arg)))
(and (eq x :prefix-map) (symbolp (cadr arg)))
(and (eq x :prefix-docstring) (stringp (cadr arg)))
(and (eq x :repeat-map) (symbolp (cadr arg)))
(eq x :continue)
(eq x :exit)
(and (eq x :repeat-map) (symbolp (cadr arg)))
(eq x :continue)
(eq x :exit)
(and (eq x :repeat-docstring) (stringp (cadr arg)))
(eq x :filter)
(and (eq x :menu-name) (stringp (cadr arg)))
Expand Down
136 changes: 129 additions & 7 deletions use-package-tests.el
Original file line number Diff line number Diff line change
Expand Up @@ -1930,17 +1930,139 @@
(autoload #'nonexistent "nonexistent" nil t))
(add-hook 'lisp-mode-hook #'nonexistent)))))

(ert-deftest bind-key/:prefix-map ()
(ert-deftest bind-key-test/:map-1 ()
(match-expansion
(bind-keys
("C-1" . command-1)
("C-2" . command-2)
:map keymap-1
("C-3" . command-3)
("C-4" . command-4)
:map (keymap-2 keymap-3)
("C-5" . command-5)
("C-6" . command-6))
`(progn (bind-key "C-1" #'command-1 nil nil)
(bind-key "C-2" #'command-2 nil nil)
(bind-key "C-3" #'command-3 keymap-1 nil)
(bind-key "C-4" #'command-4 keymap-1 nil)
(bind-key "C-5" #'command-5 keymap-2 nil)
(bind-key "C-6" #'command-6 keymap-2 nil)
(bind-key "C-5" #'command-5 keymap-3 nil)
(bind-key "C-6" #'command-6 keymap-3 nil))))

(ert-deftest bind-key-test/:map-2 ()
(match-expansion
(bind-keys :package p
("C-1" . c1)
:map m1 ("C-2" . c2)
:map (m2 m3) ("C-3" . c3)
:map (nil m4) ("C-4" . c4)
:map (global-map m5) ("C-5" . c5))
`(progn (bind-key "C-1" #'c1 nil nil)
(if (boundp 'm1)
(bind-key "C-2" #'c2 m1 nil)
(eval-after-load 'p '(bind-key "C-2" #'c2 m1 nil)))
(if (boundp 'm2)
(bind-key "C-3" #'c3 m2 nil)
(eval-after-load 'p '(bind-key "C-3" #'c3 m2 nil)))
(if (boundp 'm3)
(bind-key "C-3" #'c3 m3 nil)
(eval-after-load 'p '(bind-key "C-3" #'c3 m3 nil)))
(bind-key "C-4" #'c4 nil nil)
(if (boundp 'm4)
(bind-key "C-4" #'c4 m4 nil)
(eval-after-load 'p '(bind-key "C-4" #'c4 m4 nil)))
(bind-key "C-5" #'c5 global-map nil)
(if (boundp 'm5)
(bind-key "C-5" #'c5 m5 nil)
(eval-after-load 'p '(bind-key "C-5" #'c5 m5 nil))))))

(ert-deftest bind-key-test/:map-3 ()
(should-error
(expand-minimally
(bind-keys :prefix "x" :prefix-map nil ("y" . x))))
(should-error
(expand-minimally
(bind-keys :prefix "x" :prefix-map global-map ("y" . x))))
(should-error
(expand-minimally
(bind-keys :prefix "x" :prefix-map override-global-map ("y" . x))))
(should-error
(expand-minimally (bind-keys :repeat-map nil ("y" . x))))
(should-error
(expand-minimally (bind-keys :repeat-map global-map ("y" . x))))
(should-error
(expand-minimally
(bind-keys :repeat-map override-global-map ("y" . x)))))

(ert-deftest bind-key-test/:prefix-map ()
(match-expansion
(bind-keys :prefix "<f1>"
:prefix-map my/map)
(bind-keys ("C-1" . command-1)
:prefix "<f1>"
:prefix-map my/map
("C-2" . command-2)
("C-3" . command-3))
`(progn
(bind-key "C-1" #'command-1 nil nil)
(defvar my/map)
(define-prefix-command 'my/map)
(bind-key "<f1>" 'my/map nil nil))))


(ert-deftest bind-key/845 ()
(bind-key "<f1>" 'my/map nil nil)
(bind-key "C-2" #'command-2 my/map nil)
(bind-key "C-3" #'command-3 my/map nil))))

(ert-deftest bind-key-test/:repeat-map-1 ()
;; NOTE: This test is pulled from the discussion in issue #964,
;; adjusting for the final syntax that was implemented.
(match-expansion
(bind-keys
("C-c n" . git-gutter+-next-hunk)
("C-c p" . git-gutter+-previous-hunk)
("C-c s" . git-gutter+-stage-hunks)
("C-c r" . git-gutter+-revert-hunk)
:repeat-map my/git-gutter+-repeat-map
("n" . git-gutter+-next-hunk)
("p" . git-gutter+-previous-hunk)
("s" . git-gutter+-stage-hunks)
("r" . git-gutter+-revert-hunk)
:repeat-docstring
"Keymap to repeat git-gutter+-* commands.")
`(progn
(bind-key "C-c n" #'git-gutter+-next-hunk nil nil)
(bind-key "C-c p" #'git-gutter+-previous-hunk nil nil)
(bind-key "C-c s" #'git-gutter+-stage-hunks nil nil)
(bind-key "C-c r" #'git-gutter+-revert-hunk nil nil)
(defvar my/git-gutter+-repeat-map (make-sparse-keymap))
(put #'git-gutter+-next-hunk 'repeat-map 'my/git-gutter+-repeat-map)
(bind-key "n" #'git-gutter+-next-hunk my/git-gutter+-repeat-map nil)
(put #'git-gutter+-previous-hunk 'repeat-map 'my/git-gutter+-repeat-map)
(bind-key "p" #'git-gutter+-previous-hunk my/git-gutter+-repeat-map nil)
(put #'git-gutter+-stage-hunks 'repeat-map 'my/git-gutter+-repeat-map)
(bind-key "s" #'git-gutter+-stage-hunks my/git-gutter+-repeat-map nil)
(put #'git-gutter+-revert-hunk 'repeat-map 'my/git-gutter+-repeat-map)
(bind-key "r" #'git-gutter+-revert-hunk my/git-gutter+-repeat-map nil)
(defvar my/git-gutter+-repeat-map (make-sparse-keymap) "Keymap to repeat git-gutter+-* commands."))))

(ert-deftest bind-key-test/:repeat-map-2 ()
(match-expansion
(bind-keys :map m ("x" . cmd1) :repeat-map rm ("y" . cmd2))
`(progn
(bind-key "x" #'cmd1 m nil)
(defvar rm (make-sparse-keymap))
(put #'cmd2 'repeat-map 'rm)
(bind-key "y" #'cmd2 rm nil))))

(ert-deftest bind-key-test/:repeat-map-3 ()
(match-expansion
(bind-keys :repeat-map rm ("y" . cmd2) :map m ("x" . cmd1))
`(progn
(defvar rm (make-sparse-keymap))
(put #'cmd2 'repeat-map 'rm)
(bind-key "y" #'cmd2 rm nil)
(defvar rm (make-sparse-keymap))
(put #'cmd1 'repeat-map 'rm)
(bind-key "x" #'cmd1 m nil))))

(ert-deftest bind-key-test/845 ()
(defvar test-map (make-keymap))
(bind-key "<f1>" 'ignore 'test-map)
(should (eq (lookup-key test-map (kbd "<f1>")) 'ignore))
Expand Down
8 changes: 8 additions & 0 deletions use-package.texi
Original file line number Diff line number Diff line change
Expand Up @@ -906,6 +906,14 @@ and then to bind the key @code{C-c h} to
@code{helm-execute-persistent-action} within Helm's local keymap,
@code{helm-command-map}.

Multiple keymaps can be specified as a list:

@lisp
(use-package helm
:bind (:map (lisp-mode-map emacs-lisp-mode-map)
("C-c x" . eval-print-last-sexp)))
@end lisp

Multiple uses of @code{:map} may be specified. Any binding occurring
before the first use of @code{:map} are applied to the global keymap:

Expand Down