bind-keys supports passing a list of keymaps as :map argument

diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el
index 17e161cd72edb8eb69bf045aed0d168607fc9804..5060e16ddf950f7a77ff7ee62e2e445dfb177915 100644 (file)
--- a/lisp/use-package/bind-key.el
+++ b/lisp/use-package/bind-key.el
@@ -248,12 +248,12 @@ 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 &rest keymaps)
   "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
@@ -276,7 +276,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
@@ -293,20 +293,17 @@ function symbol (unquoted)."
       (while (and cont args)
         (if (cond ((and (eq :map (car args))
                         (not prefix-map))
-                   (setq map (cadr args)))
+                   (let ((arg (cadr args)))
+                     (setq maps (if (listp 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))))
+                  ((eq :prefix-map (car args))
                    (setq prefix-map (cadr args)))
                   ((eq :repeat-docstring (car args))
                    (setq repeat-doc (cadr args)))
-                  ((and (eq :repeat-map (car args))
-                        (not (memq map '(global-map
-                                         override-global-map))))
+                  ((eq :repeat-map (car args))
                    (setq repeat-map (cadr args))
-                   (setq map repeat-map))
+                   (setq maps (list repeat-map)))
                   ((eq :continue (car args))
                    (setq repeat-type :continue
                          arg-change-func 'cdr))
@@ -335,7 +332,8 @@ function symbol (unquoted)."
     (when (and menu-name (not prefix))
       (error "If :menu-name is supplied, :prefix must be too"))
 
-    (unless map (setq map keymap))
+    (unless maps (setq maps keymaps))
+    (unless maps (setq maps (list nil)))
 
     ;; Process key binding arguments
     (let (first next)
@@ -349,50 +347,67 @@ function symbol (unquoted)."
             (setq first (list (car args))))
           (setq args (cdr args))))
 
-      (cl-flet
-          ((wrap (map bindings)
-                 (if (and map pkg (not (memq map '(global-map
-                                                   override-global-map))))
-                     `((if (boundp ',map)
+      (cl-labels
+          ((wrap (maps bindings)
+                 (if (and pkg
+                          (cl-every
+                           (lambda (map)
+                             (and map
+                                  (not (memq map '(global-map
+                                                   override-global-map)))))
+                           maps))
+                     `((if (mapcan 'boundp ',maps)
                            ,(macroexp-progn bindings)
                          (eval-after-load
                              ,(if (symbolp pkg) `',pkg pkg)
                            ',(macroexp-progn bindings))))
                    bindings)))
-
         (append
-         (when prefix-map
-           `((defvar ,prefix-map)
-             ,@(when prefix-doc `((put ',prefix-map 'variable-documentation ,prefix-doc)))
-             ,@(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)))))
          (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))
+         (if prefix-map
+             `((defvar ,prefix-map)
+               ,@(when prefix-doc `((put ',prefix-map 'variable-documentation ,prefix-doc)))
+               ,@(if menu-name
+                     `((define-prefix-command ',prefix-map nil ,menu-name))
+                   `((define-prefix-command ',prefix-map)))
+               ,@(cl-mapcan
+                  (lambda (map)
+                    (wrap (list map)
+                          `((bind-key ,prefix ',prefix-map ,map ,filter))))
+                  maps)
+               ,@(wrap maps
+                       (cl-mapcan
+                        (lambda (form)
+                          (let ((fun
+                                 (and (cdr form) (list 'function (cdr form)))))
+                            `((bind-key ,(car form) ,fun ,prefix-map ,filter))))
+                        first)))
+           (cl-mapcan
+            (lambda (map)
+              (wrap (list map)
+                    (cl-mapcan
+                     (lambda (form)
+                       (let ((fun (and (cdr form) (list 'function (cdr form)))))
+                         (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)))
+            maps))
          (when next
-           (bind-keys-form `(,@(when repeat-map `(:repeat-map ,repeat-map))
-                             ,@(if pkg
-                                   (cons :package (cons pkg next))
-                                 next)) map)))))))
+           (apply 'bind-keys-form
+                  `(,@(when repeat-map `(:repeat-map ,repeat-map))
+                    ,@(if pkg
+                          (cons :package (cons pkg next))
+                        next))
+                  maps)))))))
 
 ;;;###autoload
 (defmacro bind-keys (&rest args)
@@ -400,7 +415,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

diff --git a/lisp/use-package/use-package-bind-key.el b/lisp/use-package/use-package-bind-key.el
index 9642f311750df026a3f790a30eb09376a9aaf5c5..7c79f4508311660dc8529ff0072269c4b4ebe170 100644 (file)
--- a/lisp/use-package/use-package-bind-key.el
+++ b/lisp/use-package/use-package-bind-key.el
@@ -86,19 +86,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/test/lisp/use-package/use-package-tests.el b/test/lisp/use-package/use-package-tests.el
index 9510fffb01cbf63f1c27dd2e826388d2a69d4f0a..007d2b07ac88b2f607d37b93f9fb727715b87111 100644 (file)
--- a/test/lisp/use-package/use-package-tests.el
+++ b/test/lisp/use-package/use-package-tests.el
@@ -1951,15 +1951,92 @@
           (autoload #'nonexistent-mode "nonexistent" nil t))
         (add-hook 'lisp-mode-hook #'nonexistent-mode)))))
 
+(ert-deftest bind-key/:map ()
+  (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/: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))))
-
+      (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/: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/: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/: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/845 ()
   (defvar test-map (make-keymap))