Revert "Allow multiple keymaps in :map argument"

This commit is contained in:
John Wiegley 2022-11-15 15:24:12 -08:00 committed by GitHub
parent f4ee1c3839
commit 3e81af80a2
5 changed files with 92 additions and 186 deletions

View file

@ -92,8 +92,7 @@ function symbol (unquoted)."
"Bind multiple chords at once. "Bind multiple chords at once.
Accepts keyword argument: Accepts keyword argument:
:map - a keymap or list of keymaps into which the keybindings should be :map - a keymap into which the keybindings should be added
added
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)."

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

View file

@ -92,8 +92,7 @@ deferred until the prefix key sequence is pressed."
;; :menu-name STRING ;; :menu-name STRING
;; :package SYMBOL ;; :package SYMBOL
;; :continue and :exit are used within :repeat-map ;; :continue and :exit are used within :repeat-map
((or (and (eq x :map) (or (symbolp (cadr arg)) ((or (and (eq x :map) (symbolp (cadr arg)))
(listp (cadr arg))))
(and (eq x :prefix) (stringp (cadr arg))) (and (eq x :prefix) (stringp (cadr arg)))
(and (eq x :prefix-map) (symbolp (cadr arg))) (and (eq x :prefix-map) (symbolp (cadr arg)))
(and (eq x :prefix-docstring) (stringp (cadr arg))) (and (eq x :prefix-docstring) (stringp (cadr arg)))

View file

@ -1964,92 +1964,15 @@
(autoload #'nonexistent-mode "nonexistent" nil t)) (autoload #'nonexistent-mode "nonexistent" nil t))
(add-hook 'lisp-mode-hook #'nonexistent-mode))))) (add-hook 'lisp-mode-hook #'nonexistent-mode)))))
(ert-deftest bind-key/:map ()
(match-expansion
(bind-keys
("C-1" . command-1)
("C-2" . command-2)
:map keymap-1
("C-3" . command-3)
("C-4" . command-4)
:map (keymap-2 keymap-3)
("C-5" . command-5)
("C-6" . command-6))
`(progn (bind-key "C-1" #'command-1 nil nil)
(bind-key "C-2" #'command-2 nil nil)
(bind-key "C-3" #'command-3 keymap-1 nil)
(bind-key "C-4" #'command-4 keymap-1 nil)
(bind-key "C-5" #'command-5 keymap-2 nil)
(bind-key "C-6" #'command-6 keymap-2 nil)
(bind-key "C-5" #'command-5 keymap-3 nil)
(bind-key "C-6" #'command-6 keymap-3 nil))))
(ert-deftest bind-key/:prefix-map () (ert-deftest bind-key/:prefix-map ()
(match-expansion (match-expansion
(bind-keys ("C-1" . command-1) (bind-keys :prefix "<f1>"
:prefix "<f1>" :prefix-map my/map)
:prefix-map my/map
("C-2" . command-2)
("C-3" . command-3))
`(progn `(progn
(bind-key "C-1" #'command-1 nil nil)
(defvar my/map) (defvar my/map)
(define-prefix-command 'my/map) (define-prefix-command 'my/map)
(bind-key "<f1>" 'my/map nil nil) (bind-key "<f1>" 'my/map nil nil))))
(bind-key "C-2" #'command-2 my/map nil)
(bind-key "C-3" #'command-3 my/map nil))))
(ert-deftest bind-key/:repeat-map-1 ()
;; NOTE: This test is pulled from the discussion in issue #964,
;; adjusting for the final syntax that was implemented.
(match-expansion
(bind-keys
("C-c n" . git-gutter+-next-hunk)
("C-c p" . git-gutter+-previous-hunk)
("C-c s" . git-gutter+-stage-hunks)
("C-c r" . git-gutter+-revert-hunk)
:repeat-map my/git-gutter+-repeat-map
("n" . git-gutter+-next-hunk)
("p" . git-gutter+-previous-hunk)
("s" . git-gutter+-stage-hunks)
("r" . git-gutter+-revert-hunk)
:repeat-docstring
"Keymap to repeat git-gutter+-* commands.")
`(progn
(bind-key "C-c n" #'git-gutter+-next-hunk nil nil)
(bind-key "C-c p" #'git-gutter+-previous-hunk nil nil)
(bind-key "C-c s" #'git-gutter+-stage-hunks nil nil)
(bind-key "C-c r" #'git-gutter+-revert-hunk nil nil)
(defvar my/git-gutter+-repeat-map (make-sparse-keymap))
(put #'git-gutter+-next-hunk 'repeat-map 'my/git-gutter+-repeat-map)
(bind-key "n" #'git-gutter+-next-hunk my/git-gutter+-repeat-map nil)
(put #'git-gutter+-previous-hunk 'repeat-map 'my/git-gutter+-repeat-map)
(bind-key "p" #'git-gutter+-previous-hunk my/git-gutter+-repeat-map nil)
(put #'git-gutter+-stage-hunks 'repeat-map 'my/git-gutter+-repeat-map)
(bind-key "s" #'git-gutter+-stage-hunks my/git-gutter+-repeat-map nil)
(put #'git-gutter+-revert-hunk 'repeat-map 'my/git-gutter+-repeat-map)
(bind-key "r" #'git-gutter+-revert-hunk my/git-gutter+-repeat-map nil)
(defvar my/git-gutter+-repeat-map (make-sparse-keymap) "Keymap to repeat git-gutter+-* commands."))))
(ert-deftest bind-key/:repeat-map-2 ()
(match-expansion
(bind-keys :map m ("x" . cmd1) :repeat-map rm ("y" . cmd2))
`(progn
(bind-key "x" #'cmd1 m nil)
(defvar rm (make-sparse-keymap))
(put #'cmd2 'repeat-map 'rm)
(bind-key "y" #'cmd2 rm nil))))
(ert-deftest bind-key/:repeat-map-3 ()
(match-expansion
(bind-keys :repeat-map rm ("y" . cmd2) :map m ("x" . cmd1))
`(progn
(defvar rm (make-sparse-keymap))
(put #'cmd2 'repeat-map 'rm)
(bind-key "y" #'cmd2 rm nil)
(defvar rm (make-sparse-keymap))
(put #'cmd1 'repeat-map 'rm)
(bind-key "x" #'cmd1 m nil))))
(ert-deftest bind-key/845 () (ert-deftest bind-key/845 ()
(defvar test-map (make-keymap)) (defvar test-map (make-keymap))