mirror of
https://github.com/masscollaborationlabs/emacs.git
synced 2025-07-06 12:19: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:
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."
|
"Similar to `bind-key', but overrides any mode-specific bindings."
|
||||||
`(bind-key ,key-name ,command override-global-map ,predicate))
|
`(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.
|
"Bind multiple keys at once.
|
||||||
|
|
||||||
Accepts keyword arguments:
|
Accepts keyword arguments:
|
||||||
|
@ -217,25 +217,37 @@ function symbol (unquoted)."
|
||||||
(if (and (eq (car args) :package)
|
(if (and (eq (car args) :package)
|
||||||
(not (eq (car (cdr (cdr args))) :map)))
|
(not (eq (car (cdr (cdr args))) :map)))
|
||||||
(setq args (cons :map (cons 'global-map args))))
|
(setq args (cons :map (cons 'global-map args))))
|
||||||
(let* ((map (plist-get args :map))
|
(let ((map keymap)
|
||||||
(doc (plist-get args :prefix-docstring))
|
doc
|
||||||
(prefix-map (plist-get args :prefix-map))
|
prefix-map
|
||||||
(prefix (plist-get args :prefix))
|
prefix
|
||||||
(filter (plist-get args :filter))
|
filter
|
||||||
(menu-name (plist-get args :menu-name))
|
menu-name
|
||||||
(pkg (plist-get args :package))
|
pkg)
|
||||||
(key-bindings (progn
|
|
||||||
(while (keywordp (car args))
|
;; Process any initial keyword arguments
|
||||||
(pop args)
|
(let ((cont t))
|
||||||
(pop args))
|
(while (and cont args)
|
||||||
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))
|
(when (or (and prefix-map (not prefix))
|
||||||
(and prefix (not prefix-map)))
|
(and prefix (not prefix-map)))
|
||||||
(error "Both :prefix-map and :prefix must be supplied"))
|
(error "Both :prefix-map and :prefix must be supplied"))
|
||||||
|
|
||||||
(when (and menu-name (not prefix))
|
(when (and menu-name (not prefix))
|
||||||
(error "If :menu-name is supplied, :prefix must be too"))
|
(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
|
(while args
|
||||||
(if (keywordp (car args))
|
(if (keywordp (car args))
|
||||||
(progn
|
(progn
|
||||||
|
@ -245,6 +257,7 @@ function symbol (unquoted)."
|
||||||
(nconc first (list (car args)))
|
(nconc first (list (car args)))
|
||||||
(setq first (list (car args))))
|
(setq first (list (car args))))
|
||||||
(setq args (cdr args))))
|
(setq args (cdr args))))
|
||||||
|
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((wrap (map bindings)
|
((wrap (map bindings)
|
||||||
(if (and map pkg (not (eq map 'global-map)))
|
(if (and map pkg (not (eq map 'global-map)))
|
||||||
|
@ -254,6 +267,7 @@ function symbol (unquoted)."
|
||||||
,(if (symbolp pkg) `',pkg pkg)
|
,(if (symbolp pkg) `',pkg pkg)
|
||||||
'(progn ,@bindings))))
|
'(progn ,@bindings))))
|
||||||
bindings)))
|
bindings)))
|
||||||
|
|
||||||
(append
|
(append
|
||||||
(when prefix-map
|
(when prefix-map
|
||||||
`((defvar ,prefix-map)
|
`((defvar ,prefix-map)
|
||||||
|
@ -275,10 +289,9 @@ function symbol (unquoted)."
|
||||||
`((bind-key ,(car form) ,fun nil ,filter))))))
|
`((bind-key ,(car form) ,fun nil ,filter))))))
|
||||||
first))
|
first))
|
||||||
(when next
|
(when next
|
||||||
(bind-keys-form
|
(bind-keys-form (if pkg
|
||||||
(if pkg
|
|
||||||
(cons :package (cons pkg next))
|
(cons :package (cons pkg next))
|
||||||
next))))))))
|
next) map)))))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defmacro bind-keys (&rest args)
|
(defmacro bind-keys (&rest args)
|
||||||
|
@ -296,12 +309,12 @@ Accepts keyword arguments:
|
||||||
|
|
||||||
The rest of the arguments are conses of keybinding string and a
|
The rest of the arguments are conses of keybinding string and a
|
||||||
function symbol (unquoted)."
|
function symbol (unquoted)."
|
||||||
(macroexp-progn (bind-keys-form args)))
|
(macroexp-progn (bind-keys-form args nil)))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defmacro bind-keys* (&rest args)
|
(defmacro bind-keys* (&rest args)
|
||||||
(macroexp-progn
|
(macroexp-progn
|
||||||
(bind-keys-form `(:map override-global-map ,@args))))
|
(bind-keys-form args 'override-global-map)))
|
||||||
|
|
||||||
(defun get-binding-description (elem)
|
(defun get-binding-description (elem)
|
||||||
(cond
|
(cond
|
||||||
|
|
|
@ -77,7 +77,7 @@
|
||||||
(unless (looking-at "(match-expansion")
|
(unless (looking-at "(match-expansion")
|
||||||
(backward-up-list))
|
(backward-up-list))
|
||||||
(when (looking-at "(match-expansion")
|
(when (looking-at "(match-expansion")
|
||||||
(search-forward "(use-package")
|
(re-search-forward "(\\(use-package\\|bind-key\\)")
|
||||||
(goto-char (match-beginning 0))
|
(goto-char (match-beginning 0))
|
||||||
(let ((decl (read (current-buffer))))
|
(let ((decl (read (current-buffer))))
|
||||||
(kill-sexp)
|
(kill-sexp)
|
||||||
|
@ -1356,6 +1356,81 @@
|
||||||
(if (fboundp 'delight)
|
(if (fboundp 'delight)
|
||||||
(delight '((foo "bar" foo)))))))
|
(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 ()
|
(ert-deftest use-package-test/506 ()
|
||||||
(match-expansion
|
(match-expansion
|
||||||
(use-package ess-site
|
(use-package ess-site
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue