bind-keys fixes related to

GitHub-reference: https://github.com/jwiegley/use-package/issues/482

diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el
index 223a12c21fb36e11edc7c60c2aeb0966c931ccaf..e5cd73e9ea3852f70c69d3e74605b7e378448ea2 100644 (file)
--- a/lisp/use-package/bind-key.el
+++ b/lisp/use-package/bind-key.el
@@ -219,14 +219,7 @@ Accepts keyword arguments:
 
 The rest of the arguments are conses of keybinding string and a
 function symbol (unquoted)."
-  ;; jww (2016-02-26): This is a hack; this whole function needs to be
-  ;; rewritten to normalize arguments the way that use-package.el does.
-  (if (and (eq (car args) :package)
-           (not (eq (car (cdr (cdr args))) :map))
-           (not keymap))
-      (setq args (cons :map (cons 'global-map args))))
-
-  (let ((map keymap)
+  (let (map
         doc
         prefix-map
         prefix
@@ -237,11 +230,14 @@ function symbol (unquoted)."
     ;; Process any initial keyword arguments
     (let ((cont t))
       (while (and cont args)
-        (if (cond ((eq :map (car args))
+        (if (cond ((and (eq :map (car args))
+                        (not prefix-map))
                    (setq map (cadr args)))
                   ((eq :prefix-docstring (car args))
                    (setq doc (cadr args)))
-                  ((eq :prefix-map (car args))
+                  ((and (eq :prefix-map (car args))
+                        (not (memq map '(global-map
+                                         override-global-map))))
                    (setq prefix-map (cadr args)))
                   ((eq :prefix (car args))
                    (setq prefix (cadr args)))
@@ -261,6 +257,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))
+
     ;; Process key binding arguments
     (let (first next)
       (while args
@@ -275,12 +273,13 @@ function symbol (unquoted)."
 
       (cl-flet
           ((wrap (map bindings)
-                 (if (and map pkg (not (memq map '(global-map override-global-map))))
+                 (if (and map pkg (not (memq map '(global-map
+                                                   override-global-map))))
                      `((if (boundp ',map)
-                           (progn ,@bindings)
+                           ,(macroexp-progn bindings)
                          (eval-after-load
                              ,(if (symbolp pkg) `',pkg pkg)
-                           '(progn ,@bindings))))
+                           ',(macroexp-progn bindings))))
                    bindings)))
 
         (append

diff --git a/test/lisp/use-package/use-package-tests.el b/test/lisp/use-package/use-package-tests.el
index 067661abf89bb0e159c039fb305f0c126ddd22a1..70654daa3edf53033b8d7e20a21254b614b024b7 100644 (file)
--- a/test/lisp/use-package/use-package-tests.el
+++ b/test/lisp/use-package/use-package-tests.el
@@ -1638,7 +1638,7 @@
         (bind-key "f" #'w3m-lnum-print-this-url w3m-y-prefix-map nil)
         (bind-key "t" #'w3m-print-this-url w3m-y-prefix-map nil)))))
 
-(ert-deftest use-package-test/482 ()
+(ert-deftest use-package-test/482-1 ()
   (match-expansion
    (use-package simple
      :bind-keymap ("C-t " . my/transpose-map)
@@ -1654,6 +1654,32 @@
       (bind-keys :package simple :map my/transpose-map
                  ("w" . transpose-words)))))
 
+(ert-deftest use-package-test/482-2 ()
+  (match-expansion
+   (use-package simple
+     :bind (:prefix-map my/transpose-map
+                        :prefix "C-t"
+                        ("w" . transpose-words)))
+   `(progn
+      (unless (fboundp 'transpose-words)
+        (autoload #'transpose-words "simple" nil t))
+      (bind-keys :package simple
+                 :prefix-map my/transpose-map
+                 :prefix "C-t"
+                 ("w" . transpose-words)))))
+
+(ert-deftest use-package-test/482-3 ()
+  (match-expansion
+   (bind-keys :package simple
+              :prefix-map my/transpose-map
+              :prefix "C-t"
+              ("w" . transpose-words))
+   `(progn
+      (defvar my/transpose-map)
+      (define-prefix-command 'my/transpose-map)
+      (bind-key "C-t" 'my/transpose-map nil nil)
+      (bind-key "w" #'transpose-words my/transpose-map nil))))
+
 (ert-deftest use-package-test/538 ()
   (match-expansion
    (use-package mu4e