From a4d2e779610d12303b86f3b7506eb38fbf6141f4 Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Sun, 10 Dec 2017 21:25:37 -0800 Subject: [PATCH] bind-keys fixes related to GitHub-reference: https://github.com/jwiegley/use-package/issues/482 --- lisp/use-package/bind-key.el | 25 ++++++++++--------- test/lisp/use-package/use-package-tests.el | 28 +++++++++++++++++++++- 2 files changed, 39 insertions(+), 14 deletions(-) diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el index 223a12c21fb..e5cd73e9ea3 100644 --- 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 067661abf89..70654daa3ed 100644 --- 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 -- 2.39.2