From 6470eaf3d53d2596a7cc7bbe43ec7a47f6ea70ed Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 4 Dec 2017 15:21:41 -0800 Subject: [PATCH] Fix an argument process problem with bind-key Fixes https://github.com/jwiegley/use-package/issues/334 --- lisp/use-package/bind-key.el | 55 ++++++++++------ test/lisp/use-package/use-package-tests.el | 77 +++++++++++++++++++++- 2 files changed, 110 insertions(+), 22 deletions(-) diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el index e5e06c7cd2a..1b11e6c8322 100644 --- a/lisp/use-package/bind-key.el +++ b/lisp/use-package/bind-key.el @@ -197,7 +197,7 @@ See `bind-key' for more details." "Similar to `bind-key', but overrides any mode-specific bindings." `(bind-key ,key-name ,command override-global-map ,predicate)) -(defun bind-keys-form (args) +(defun bind-keys-form (args keymap) "Bind multiple keys at once. Accepts keyword arguments: @@ -217,25 +217,37 @@ function symbol (unquoted)." (if (and (eq (car args) :package) (not (eq (car (cdr (cdr args))) :map))) (setq args (cons :map (cons 'global-map args)))) - (let* ((map (plist-get args :map)) - (doc (plist-get args :prefix-docstring)) - (prefix-map (plist-get args :prefix-map)) - (prefix (plist-get args :prefix)) - (filter (plist-get args :filter)) - (menu-name (plist-get args :menu-name)) - (pkg (plist-get args :package)) - (key-bindings (progn - (while (keywordp (car args)) - (pop args) - (pop args)) - args))) + (let ((map keymap) + doc + prefix-map + prefix + filter + menu-name + pkg) + + ;; Process any initial keyword arguments + (let ((cont t)) + (while (and cont args) + (if (pcase (car args) + (`:map (setq map (cadr args))) + (`:prefix-docstring (setq doc (cadr args))) + (`:prefix-map (setq prefix-map (cadr args))) + (`:prefix (setq prefix (cadr args))) + (`:filter (setq filter (cadr args)) t) + (`:menu-name (setq menu-name (cadr args))) + (`:package (setq pkg (cadr args)))) + (setq args (cddr args)) + (setq cont nil)))) + (when (or (and prefix-map (not prefix)) (and prefix (not prefix-map))) (error "Both :prefix-map and :prefix must be supplied")) + (when (and menu-name (not prefix)) (error "If :menu-name is supplied, :prefix must be too")) - (let ((args key-bindings) - saw-map first next) + + ;; Process key binding arguments + (let (first next) (while args (if (keywordp (car args)) (progn @@ -245,6 +257,7 @@ function symbol (unquoted)." (nconc first (list (car args))) (setq first (list (car args)))) (setq args (cdr args)))) + (cl-flet ((wrap (map bindings) (if (and map pkg (not (eq map 'global-map))) @@ -254,6 +267,7 @@ function symbol (unquoted)." ,(if (symbolp pkg) `',pkg pkg) '(progn ,@bindings)))) bindings))) + (append (when prefix-map `((defvar ,prefix-map) @@ -275,10 +289,9 @@ function symbol (unquoted)." `((bind-key ,(car form) ,fun nil ,filter)))))) first)) (when next - (bind-keys-form - (if pkg - (cons :package (cons pkg next)) - next)))))))) + (bind-keys-form (if pkg + (cons :package (cons pkg next)) + next) map))))))) ;;;###autoload (defmacro bind-keys (&rest args) @@ -296,12 +309,12 @@ Accepts keyword arguments: The rest of the arguments are conses of keybinding string and a function symbol (unquoted)." - (macroexp-progn (bind-keys-form args))) + (macroexp-progn (bind-keys-form args nil))) ;;;###autoload (defmacro bind-keys* (&rest args) (macroexp-progn - (bind-keys-form `(:map override-global-map ,@args)))) + (bind-keys-form args 'override-global-map))) (defun get-binding-description (elem) (cond diff --git a/test/lisp/use-package/use-package-tests.el b/test/lisp/use-package/use-package-tests.el index ef6c52c583e..80bbb728675 100644 --- a/test/lisp/use-package/use-package-tests.el +++ b/test/lisp/use-package/use-package-tests.el @@ -77,7 +77,7 @@ (unless (looking-at "(match-expansion") (backward-up-list)) (when (looking-at "(match-expansion") - (search-forward "(use-package") + (re-search-forward "(\\(use-package\\|bind-key\\)") (goto-char (match-beginning 0)) (let ((decl (read (current-buffer)))) (kill-sexp) @@ -1356,6 +1356,81 @@ (if (fboundp 'delight) (delight '((foo "bar" foo))))))) +(ert-deftest use-package-test/334-1 () + (let (foo1-map foo2-map + bar1-func1 + bar1-func2 + bar2-func1 + bar2-func2 + bar3-func1 + bar3-func2 + bar4-func1 + bar4-func2) + (match-expansion + (bind-keys :map foo1-map + ("Y" . foo1) + :prefix "y" + :prefix-map bar1-prefix-map + ("y" . bar1-func1) + ("f" . bar1-func2) + :prefix "y" + :prefix-map bar2-prefix-map + ("y" . bar2-func1) + ("f" . bar2-func2) + :map foo2-map + ("Y" . foo2) + :prefix "y" + :prefix-map bar3-prefix-map + ("y" . bar3-func1) + ("f" . bar3-func2) + :prefix "y" + :prefix-map bar4-prefix-map + ("y" . bar4-func1) + ("f" . bar4-func2)) + `(progn + (bind-key "Y" #'foo1 foo1-map nil) + (defvar bar1-prefix-map) + (define-prefix-command 'bar1-prefix-map) + (bind-key "y" 'bar1-prefix-map foo1-map nil) + (bind-key "y" #'bar1-func1 bar1-prefix-map nil) + (bind-key "f" #'bar1-func2 bar1-prefix-map nil) + (defvar bar2-prefix-map) + (define-prefix-command 'bar2-prefix-map) + (bind-key "y" 'bar2-prefix-map foo1-map nil) + (bind-key "y" #'bar2-func1 bar2-prefix-map nil) + (bind-key "f" #'bar2-func2 bar2-prefix-map nil) + (bind-key "Y" #'foo2 foo2-map nil) + (defvar bar3-prefix-map) + (define-prefix-command 'bar3-prefix-map) + (bind-key "y" 'bar3-prefix-map foo2-map nil) + (bind-key "y" #'bar3-func1 bar3-prefix-map nil) + (bind-key "f" #'bar3-func2 bar3-prefix-map nil) + (defvar bar4-prefix-map) + (define-prefix-command 'bar4-prefix-map) + (bind-key "y" 'bar4-prefix-map foo2-map nil) + (bind-key "y" #'bar4-func1 bar4-prefix-map nil) + (bind-key "f" #'bar4-func2 bar4-prefix-map nil))))) + +(ert-deftest use-package-test/334-2 () + (let (w3m-lnum-mode-map + w3m-print-current-url + w3m-lnum-print-this-url + w3m-print-this-url) + (match-expansion + (bind-keys :map w3m-lnum-mode-map + :prefix "y" + :prefix-map w3m-y-prefix-map + ("y" . w3m-print-current-url) + ("f" . w3m-lnum-print-this-url) + ("t" . w3m-print-this-url)) + `(progn + (defvar w3m-y-prefix-map) + (define-prefix-command 'w3m-y-prefix-map) + (bind-key "y" 'w3m-y-prefix-map w3m-lnum-mode-map nil) + (bind-key "y" #'w3m-print-current-url w3m-y-prefix-map nil) + (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/506 () (match-expansion (use-package ess-site -- 2.39.2