Fix an argument process problem with bind-key

Fixes https://github.com/jwiegley/use-package/issues/334

diff --git a/lisp/use-package/bind-key.el b/lisp/use-package/bind-key.el
index e5e06c7cd2a0003b3cf7456dedeaa4f4de26a535..1b11e6c8322923c47852d5175d805a30b28a7b15 100644 (file)
--- 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 ef6c52c583ee4197e386817e955f2c8d5c94cfbe..80bbb728675e61ceeb551c64260891b119f1bc03 100644 (file)
--- 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