mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 02:31:03 -08:00
Code Issues Projects Releases Wiki Activity

bind-keys supports passing a list of keymaps as :map argument

Browse source
This commit is contained in:
Jacob First 2022-09-29 02:36:43 -04:00
parent daa124e1cc
commit ec96b47664
3 changed files with 149 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

109
lisp/use-package/bind-key.el
View file

@ -248,12 +248,12 @@ In contrast to `define-key', this function removes the binding from the keymap."
"Similar to `bind-key', but overrides any mode-specific bindings."
`(bind-key ,key-name ,command override-global-map ,predicate))
(defun bind-keys-form (args keymap)
(defun bind-keys-form (args &rest keymaps)
"Bind multiple keys at once.
Accepts keyword arguments:
:map MAP - a keymap into which the keybindings should be
added
added, or a list of such keymaps
:prefix KEY - prefix key for these bindings
:prefix-map MAP - name of the prefix map that should be created
for these bindings
@ -276,7 +276,7 @@ Accepts keyword arguments:
The rest of the arguments are conses of keybinding string and a
function symbol (unquoted)."
(let (map
(let (maps
prefix-doc
prefix-map
prefix
@ -293,20 +293,17 @@ function symbol (unquoted)."
(while (and cont args)
(if (cond ((and (eq :map (car args))
(not prefix-map))
(setq map (cadr args)))
(let ((arg (cadr args)))
(setq maps (if (listp arg) arg (list arg)))))
((eq :prefix-docstring (car args))
(setq prefix-doc (cadr args)))
((and (eq :prefix-map (car args))
(not (memq map '(global-map
override-global-map))))
((eq :prefix-map (car args))
(setq prefix-map (cadr args)))
((eq :repeat-docstring (car args))
(setq repeat-doc (cadr args)))
((and (eq :repeat-map (car args))
(not (memq map '(global-map
override-global-map))))
((eq :repeat-map (car args))
(setq repeat-map (cadr args))
(setq map repeat-map))
(setq maps (list repeat-map)))
((eq :continue (car args))
(setq repeat-type :continue
arg-change-func 'cdr))
@ -335,7 +332,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))
(unless maps (setq maps keymaps))
(unless maps (setq maps (list nil)))
;; Process key binding arguments
(let (first next)
@ -349,50 +347,67 @@ function symbol (unquoted)."
(setq first (list (car args))))
(setq args (cdr args))))
(cl-flet
((wrap (map bindings)
(if (and map pkg (not (memq map '(global-map
override-global-map))))
`((if (boundp ',map)
(cl-labels
((wrap (maps bindings)
(if (and pkg
(cl-every
(lambda (map)
(and map
(not (memq map '(global-map
override-global-map)))))
maps))
`((if (mapcan 'boundp ',maps)
,(macroexp-progn bindings)
(eval-after-load
,(if (symbolp pkg) `',pkg pkg)
',(macroexp-progn bindings))))
bindings)))
(append
(when prefix-map
`((defvar ,prefix-map)
,@(when prefix-doc `((put ',prefix-map 'variable-documentation ,prefix-doc)))
,@(if menu-name
`((define-prefix-command ',prefix-map nil ,menu-name))
`((define-prefix-command ',prefix-map)))
,@(if (and map (not (eq map 'global-map)))
(wrap map `((bind-key ,prefix ',prefix-map ,map ,filter)))
`((bind-key ,prefix ',prefix-map nil ,filter)))))
(when repeat-map
`((defvar ,repeat-map (make-sparse-keymap)
,@(when repeat-doc `(,repeat-doc)))))
(wrap map
(cl-mapcan
(lambda (form)
(let ((fun (and (cdr form) (list 'function (cdr form)))))
(if prefix-map
`((bind-key ,(car form) ,fun ,prefix-map ,filter))
(if (and map (not (eq map 'global-map)))
;; Only needed in this branch, since when
;; repeat-map is non-nil, map is always
;; non-nil
`(,@(when (and repeat-map (not (eq repeat-type :exit)))
`((put ,fun 'repeat-map ',repeat-map)))
(bind-key ,(car form) ,fun ,map ,filter))
`((bind-key ,(car form) ,fun nil ,filter))))))
first))
(if prefix-map
`((defvar ,prefix-map)
,@(when prefix-doc `((put ',prefix-map 'variable-documentation ,prefix-doc)))
,@(if menu-name
`((define-prefix-command ',prefix-map nil ,menu-name))
`((define-prefix-command ',prefix-map)))
,@(cl-mapcan
(lambda (map)
(wrap (list map)
`((bind-key ,prefix ',prefix-map ,map ,filter))))
maps)
,@(wrap maps
(cl-mapcan
(lambda (form)
(let ((fun
(and (cdr form) (list 'function (cdr form)))))
`((bind-key ,(car form) ,fun ,prefix-map ,filter))))
first)))
(cl-mapcan
(lambda (map)
(wrap (list map)
(cl-mapcan
(lambda (form)
(let ((fun (and (cdr form) (list 'function (cdr form)))))
(if (and map (not (eq map 'global-map)))
;; Only needed in this branch, since when
;; repeat-map is non-nil, map is always
;; non-nil
`(,@(when (and repeat-map
(not (eq repeat-type :exit)))
`((put ,fun 'repeat-map ',repeat-map)))
(bind-key ,(car form) ,fun ,map ,filter))
`((bind-key ,(car form) ,fun nil ,filter)))))
first)))
maps))
(when next
(bind-keys-form `(,@(when repeat-map `(:repeat-map ,repeat-map))
,@(if pkg
(cons :package (cons pkg next))
next)) map)))))))
(apply 'bind-keys-form
`(,@(when repeat-map `(:repeat-map ,repeat-map))
,@(if pkg
(cons :package (cons pkg next))
next))
maps)))))))
;;;###autoload
(defmacro bind-keys (&rest args)
@ -400,7 +415,7 @@ function symbol (unquoted)."
Accepts keyword arguments:
:map MAP - a keymap into which the keybindings should be
added
added, or a list of such keymaps
:prefix KEY - prefix key for these bindings
:prefix-map MAP - name of the prefix map that should be created
for these bindings