From 1867b7d6eef01620e484ce6a32e519737d8385a9 Mon Sep 17 00:00:00 2001 From: Jacob First Date: Tue, 9 May 2023 22:23:05 -0500 Subject: [PATCH 1/2] Fix bind-chord docs: :map argument may be a list of keymaps --- bind-chord.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/bind-chord.el b/bind-chord.el index ed736a4..bc0d416 100644 --- a/bind-chord.el +++ b/bind-chord.el @@ -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)." From 6f992a9ccda1d0f14a73543e7b472eb727d2c170 Mon Sep 17 00:00:00 2001 From: Jacob First Date: Tue, 9 May 2023 22:25:33 -0500 Subject: [PATCH 2/2] Allow multiple keymaps in :map argument This updates the bind-keys functions to accept either a symbol or a list as argument for the `:map' keyword, with additional related fixes: (1) Handle the keymap name `nil' as a synonym for `global-map'; (2) Fail if an invalid argument is specified for `:prefix-map' or `:repeat-map' keywords. --- README.md | 8 +++ bind-key.el | 77 ++++++++++++----------- use-package-bind-key.el | 13 ++-- use-package-tests.el | 136 +++++++++++++++++++++++++++++++++++++--- use-package.texi | 8 +++ 5 files changed, 193 insertions(+), 49 deletions(-) diff --git a/README.md b/README.md index bfd34cd..c0ccfc2 100644 --- a/README.md +++ b/README.md @@ -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: diff --git a/bind-key.el b/bind-key.el index fcef1ab..95fa31c 100644 --- a/bind-key.el +++ b/bind-key.el @@ -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 @@ -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 @@ -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)) @@ -342,6 +341,12 @@ 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"))) @@ -349,7 +354,7 @@ function symbol (unquoted)." (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) @@ -381,32 +386,32 @@ 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) @@ -414,7 +419,7 @@ function symbol (unquoted)." 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 @@ -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 diff --git a/use-package-bind-key.el b/use-package-bind-key.el index 9cc5529..049e166 100644 --- a/use-package-bind-key.el +++ b/use-package-bind-key.el @@ -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))) diff --git a/use-package-tests.el b/use-package-tests.el index c5fc9fb..0a6961d 100644 --- a/use-package-tests.el +++ b/use-package-tests.el @@ -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 "" - :prefix-map my/map) + (bind-keys ("C-1" . command-1) + :prefix "" + :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 "" 'my/map nil nil)))) - - -(ert-deftest bind-key/845 () + (bind-key "" '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 "" 'ignore 'test-map) (should (eq (lookup-key test-map (kbd "")) 'ignore)) diff --git a/use-package.texi b/use-package.texi index b1d7b10..1a7c946 100644 --- a/use-package.texi +++ b/use-package.texi @@ -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: