Allow multiple keymaps in :map argument

fishyfriend · fishyfriend · commit 6f992a9ccda1 · 2023-05-10T00:20:27.000-05:00
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.
diff --git 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
@@ -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,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)
@@ -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
@@ -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
@@ -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
@@ -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))
diff --git 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:
 
