bind-key-form: allow :exit keyword inside repeat map

Keys bound inside the scope of :exit are bound inside the repeat map,
but do not have their repeat-map property set (so they run a function,
but 'exit' the map).
This commit is contained in:
Hugo Heagren 2022-01-17 15:41:35 +00:00
parent 2203246454
commit 5ef327ce9f
2 changed files with 17 additions and 3 deletions

View file

@ -263,6 +263,9 @@ Accepts keyword arguments:
'repeat-map property of each command bound 'repeat-map property of each command bound
(within the scope of the :repeat-map keyword) (within the scope of the :repeat-map keyword)
is set to this map. is set to this map.
:exit BINDINGS - Within the scope of :repeat-map will bind the
key in the repeat map, but will not set the
'repeat-map property of the bound command.
:filter FORM - optional form to determine when bindings apply :filter FORM - optional form to determine when bindings apply
The rest of the arguments are conses of keybinding string and a The rest of the arguments are conses of keybinding string and a
@ -273,12 +276,14 @@ function symbol (unquoted)."
prefix prefix
repeat-map repeat-map
repeat-doc repeat-doc
repeat-type ;; Only used internally
filter filter
menu-name menu-name
pkg) pkg)
;; Process any initial keyword arguments ;; Process any initial keyword arguments
(let ((cont t)) (let ((cont t)
(arg-change-func 'cddr))
(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))
@ -296,6 +301,9 @@ function symbol (unquoted)."
override-global-map)))) override-global-map))))
(setq repeat-map (cadr args)) (setq repeat-map (cadr args))
(setq map repeat-map)) (setq map repeat-map))
((eq :exit (car args))
(setq repeat-type :exit
arg-change-func 'cdr))
((eq :prefix (car args)) ((eq :prefix (car args))
(setq prefix (cadr args))) (setq prefix (cadr args)))
((eq :filter (car args)) ((eq :filter (car args))
@ -304,7 +312,7 @@ function symbol (unquoted)."
(setq menu-name (cadr args))) (setq menu-name (cadr args)))
((eq :package (car args)) ((eq :package (car args))
(setq pkg (cadr args)))) (setq pkg (cadr args))))
(setq args (cddr args)) (setq args (funcall arg-change-func args))
(setq cont nil)))) (setq cont nil))))
(when (or (and prefix-map (not prefix)) (when (or (and prefix-map (not prefix))
@ -362,7 +370,8 @@ function symbol (unquoted)."
;; 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 repeat-map `((put ,fun 'repeat-map ',repeat-map))) `(,@(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 ,map ,filter))
`((bind-key ,(car form) ,fun nil ,filter)))))) `((bind-key ,(car form) ,fun nil ,filter))))))
first)) first))
@ -389,6 +398,9 @@ Accepts keyword arguments:
'repeat-map property of each command bound 'repeat-map property of each command bound
(within the scope of the :repeat-map keyword) (within the scope of the :repeat-map keyword)
is set to this map. is set to this map.
:exit BINDINGS - Within the scope of :repeat-map will bind the
key in the repeat map, but will not set the
'repeat-map property of the bound command.
:filter FORM - optional form to determine when bindings apply :filter FORM - optional form to determine when bindings apply
The rest of the arguments are conses of keybinding string and a The rest of the arguments are conses of keybinding string and a

View file

@ -91,11 +91,13 @@ deferred until the prefix key sequence is pressed."
;; :filter SEXP ;; :filter SEXP
;; :menu-name STRING ;; :menu-name STRING
;; :package SYMBOL ;; :package SYMBOL
;; :exit used within :repeat-map
((or (and (eq x :map) (symbolp (cadr arg))) ((or (and (eq x :map) (symbolp (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)))
(and (eq x :repeat-map) (symbolp (cadr arg))) (and (eq x :repeat-map) (symbolp (cadr arg)))
(eq x :exit)
(and (eq x :repeat-docstring) (stringp (cadr arg))) (and (eq x :repeat-docstring) (stringp (cadr arg)))
(eq x :filter) (eq x :filter)
(and (eq x :menu-name) (stringp (cadr arg))) (and (eq x :menu-name) (stringp (cadr arg)))