mirror of
https://github.com/masscollaborationlabs/emacs.git
synced 2025-07-04 19:29:37 +00:00
Fix an argument process problem with bind-key
Fixes https://github.com/jwiegley/use-package/issues/334
This commit is contained in:
John Wiegley
parent
a2ddc18065
commit
6470eaf3d5
2 changed files with 110 additions and 22 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue