* lisp/repeat.el: Fix repeat-keep-prefix to allow customizing it to non-nil.
* lisp/repeat.el (repeat-keep-prefix): Add or remove 'repeat-pre-hook' depending on the customized value. (repeat-mode): Add or remove 'repeat-pre-hook' to/from 'pre-command-hook' when 'repeat-keep-prefix' is non-nil. (repeat-pre-hook): New function. (repeat-get-map, repeat-check-map): New function refactored from 'repeat-post-hook'. (repeat-post-hook): Move some code to smaller functions. (describe-repeat-maps): Set outline-regexp without ^L. * test/lisp/repeat-tests.el (repeat-tests-keep-prefix): Uncomment test case that is fixed now in bug#51281 and bug#55986.
This commit is contained in:
parent
8ef3777d54
commit
d3a76db88b
2 changed files with 86 additions and 55 deletions
111
lisp/repeat.el
111
lisp/repeat.el
|
@ -368,6 +368,13 @@ This property can override the value of this variable."
|
||||||
(defcustom repeat-keep-prefix nil
|
(defcustom repeat-keep-prefix nil
|
||||||
"Whether to keep the prefix arg of the previous command when repeating."
|
"Whether to keep the prefix arg of the previous command when repeating."
|
||||||
:type 'boolean
|
:type 'boolean
|
||||||
|
:initialize #'custom-initialize-default
|
||||||
|
:set (lambda (sym val)
|
||||||
|
(set-default sym val)
|
||||||
|
(when repeat-mode
|
||||||
|
(if repeat-keep-prefix
|
||||||
|
(add-hook 'pre-command-hook 'repeat-pre-hook)
|
||||||
|
(remove-hook 'pre-command-hook 'repeat-pre-hook))))
|
||||||
:group 'repeat
|
:group 'repeat
|
||||||
:version "28.1")
|
:version "28.1")
|
||||||
|
|
||||||
|
@ -419,7 +426,11 @@ When Repeat mode is enabled, and the command symbol has the property named
|
||||||
See `describe-repeat-maps' for a list of all repeatable commands."
|
See `describe-repeat-maps' for a list of all repeatable commands."
|
||||||
:global t :group 'repeat
|
:global t :group 'repeat
|
||||||
(if (not repeat-mode)
|
(if (not repeat-mode)
|
||||||
(remove-hook 'post-command-hook 'repeat-post-hook)
|
(progn
|
||||||
|
(remove-hook 'pre-command-hook 'repeat-pre-hook)
|
||||||
|
(remove-hook 'post-command-hook 'repeat-post-hook))
|
||||||
|
(when repeat-keep-prefix
|
||||||
|
(add-hook 'pre-command-hook 'repeat-pre-hook))
|
||||||
(add-hook 'post-command-hook 'repeat-post-hook)
|
(add-hook 'post-command-hook 'repeat-post-hook)
|
||||||
(let* ((keymaps nil)
|
(let* ((keymaps nil)
|
||||||
(commands (all-completions
|
(commands (all-completions
|
||||||
|
@ -431,15 +442,21 @@ See `describe-repeat-maps' for a list of all repeatable commands."
|
||||||
(length commands)
|
(length commands)
|
||||||
(length (delete-dups keymaps))))))
|
(length (delete-dups keymaps))))))
|
||||||
|
|
||||||
(defvar repeat--prev-mb '(0)
|
|
||||||
"Previous minibuffer state.")
|
|
||||||
|
|
||||||
(defun repeat--command-property (property)
|
(defun repeat--command-property (property)
|
||||||
(or (and (symbolp this-command)
|
(or (and (symbolp this-command)
|
||||||
(get this-command property))
|
(get this-command property))
|
||||||
(and (symbolp real-this-command)
|
(and (symbolp real-this-command)
|
||||||
(get real-this-command property))))
|
(get real-this-command property))))
|
||||||
|
|
||||||
|
(defun repeat-get-map ()
|
||||||
|
"Return a transient map for keys repeatable after the current command."
|
||||||
|
(when repeat-mode
|
||||||
|
(let ((rep-map (or repeat-map (repeat--command-property 'repeat-map))))
|
||||||
|
(when rep-map
|
||||||
|
(when (and (symbolp rep-map) (boundp rep-map))
|
||||||
|
(setq rep-map (symbol-value rep-map)))
|
||||||
|
rep-map))))
|
||||||
|
|
||||||
(defun repeat-check-key (key map)
|
(defun repeat-check-key (key map)
|
||||||
"Check if the last key is suitable to activate the repeating MAP."
|
"Check if the last key is suitable to activate the repeating MAP."
|
||||||
(let* ((prop (repeat--command-property 'repeat-check-key))
|
(let* ((prop (repeat--command-property 'repeat-check-key))
|
||||||
|
@ -449,50 +466,61 @@ See `describe-repeat-maps' for a list of all repeatable commands."
|
||||||
;; Try without modifiers:
|
;; Try without modifiers:
|
||||||
(lookup-key map (vector (event-basic-type key))))))
|
(lookup-key map (vector (event-basic-type key))))))
|
||||||
|
|
||||||
|
(defvar repeat--prev-mb '(0)
|
||||||
|
"Previous minibuffer state.")
|
||||||
|
|
||||||
|
(defun repeat-check-map (map)
|
||||||
|
"Decides whether MAP can be used for the next command."
|
||||||
|
(and map
|
||||||
|
;; Detect changes in the minibuffer state to allow repetitions
|
||||||
|
;; in the same minibuffer, but not when the minibuffer is activated
|
||||||
|
;; in the middle of repeating sequence (bug#47566).
|
||||||
|
(or (< (minibuffer-depth) (car repeat--prev-mb))
|
||||||
|
(eq current-minibuffer-command (cdr repeat--prev-mb)))
|
||||||
|
(repeat-check-key last-command-event map)
|
||||||
|
t))
|
||||||
|
|
||||||
|
(defun repeat-pre-hook ()
|
||||||
|
"Function run before commands to handle repeatable keys."
|
||||||
|
(when (and repeat-mode repeat-keep-prefix repeat-in-progress
|
||||||
|
(not prefix-arg) current-prefix-arg)
|
||||||
|
(let ((map (repeat-get-map)))
|
||||||
|
;; Only when repeat-post-hook will activate the same map
|
||||||
|
(when (repeat-check-map map)
|
||||||
|
;; Optimize to use less logic in the function `repeat-get-map'
|
||||||
|
;; for the next call: when called again from `repeat-post-hook'
|
||||||
|
;; it will use the variable `repeat-map'.
|
||||||
|
(setq repeat-map map)
|
||||||
|
;; Preserve universal argument
|
||||||
|
(setq prefix-arg current-prefix-arg)))))
|
||||||
|
|
||||||
(defun repeat-post-hook ()
|
(defun repeat-post-hook ()
|
||||||
"Function run after commands to set transient keymap for repeatable keys."
|
"Function run after commands to set transient keymap for repeatable keys."
|
||||||
(let ((was-in-progress repeat-in-progress))
|
(let ((was-in-progress repeat-in-progress))
|
||||||
(setq repeat-in-progress nil)
|
(setq repeat-in-progress nil)
|
||||||
(when repeat-mode
|
(let ((map (repeat-get-map)))
|
||||||
(let ((rep-map (or repeat-map (repeat--command-property 'repeat-map))))
|
(when (repeat-check-map map)
|
||||||
(when rep-map
|
;; Messaging
|
||||||
(when (and (symbolp rep-map) (boundp rep-map))
|
(funcall repeat-echo-function map)
|
||||||
(setq rep-map (symbol-value rep-map)))
|
|
||||||
(let ((map (copy-keymap rep-map)))
|
|
||||||
|
|
||||||
(when (and
|
;; Adding an exit key
|
||||||
;; Detect changes in the minibuffer state to allow repetitions
|
(when repeat-exit-key
|
||||||
;; in the same minibuffer, but not when the minibuffer is activated
|
(setq map (copy-keymap map))
|
||||||
;; in the middle of repeating sequence (bug#47566).
|
(define-key map (if (key-valid-p repeat-exit-key)
|
||||||
(or (< (minibuffer-depth) (car repeat--prev-mb))
|
(kbd repeat-exit-key)
|
||||||
(eq current-minibuffer-command (cdr repeat--prev-mb)))
|
repeat-exit-key)
|
||||||
(or (not repeat-keep-prefix) prefix-arg)
|
'ignore))
|
||||||
(repeat-check-key last-command-event map))
|
|
||||||
|
|
||||||
;; Messaging
|
(setq repeat-in-progress t)
|
||||||
(unless prefix-arg
|
(repeat--exit)
|
||||||
(funcall repeat-echo-function map))
|
(let ((exitfun (set-transient-map map)))
|
||||||
|
(setq repeat-exit-function exitfun)
|
||||||
|
|
||||||
;; Adding an exit key
|
(let* ((prop (repeat--command-property 'repeat-exit-timeout))
|
||||||
(when repeat-exit-key
|
(timeout (unless (eq prop 'no) (or prop repeat-exit-timeout))))
|
||||||
(define-key map (if (key-valid-p repeat-exit-key)
|
(when timeout
|
||||||
(kbd repeat-exit-key)
|
(setq repeat-exit-timer
|
||||||
repeat-exit-key)
|
(run-with-idle-timer timeout nil #'repeat-exit)))))))
|
||||||
'ignore))
|
|
||||||
|
|
||||||
(when (and repeat-keep-prefix (not prefix-arg))
|
|
||||||
(setq prefix-arg current-prefix-arg))
|
|
||||||
|
|
||||||
(setq repeat-in-progress t)
|
|
||||||
(let ((exitfun (set-transient-map map)))
|
|
||||||
(repeat--exit)
|
|
||||||
(setq repeat-exit-function exitfun)
|
|
||||||
|
|
||||||
(let* ((prop (repeat--command-property 'repeat-exit-timeout))
|
|
||||||
(timeout (unless (eq prop 'no) (or prop repeat-exit-timeout))))
|
|
||||||
(when timeout
|
|
||||||
(setq repeat-exit-timer
|
|
||||||
(run-with-idle-timer timeout nil #'repeat-exit))))))))))
|
|
||||||
|
|
||||||
(setq repeat-map nil)
|
(setq repeat-map nil)
|
||||||
(setq repeat--prev-mb (cons (minibuffer-depth) current-minibuffer-command))
|
(setq repeat--prev-mb (cons (minibuffer-depth) current-minibuffer-command))
|
||||||
|
@ -582,6 +610,7 @@ Used in `repeat-mode'."
|
||||||
(push s (alist-get (get s 'repeat-map) keymaps)))))
|
(push s (alist-get (get s 'repeat-map) keymaps)))))
|
||||||
(with-help-window (help-buffer)
|
(with-help-window (help-buffer)
|
||||||
(with-current-buffer standard-output
|
(with-current-buffer standard-output
|
||||||
|
(setq-local outline-regexp "[*]+")
|
||||||
(insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n")
|
(insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n")
|
||||||
|
|
||||||
(dolist (keymap (sort keymaps (lambda (a b)
|
(dolist (keymap (sort keymaps (lambda (a b)
|
||||||
|
|
|
@ -76,27 +76,27 @@
|
||||||
"C-x w a b a c"
|
"C-x w a b a c"
|
||||||
'((1 a) (1 b) (1 a)) "c")
|
'((1 a) (1 b) (1 a)) "c")
|
||||||
(repeat-tests--check
|
(repeat-tests--check
|
||||||
"M-C-a b a c"
|
"C-M-a b a c"
|
||||||
'((1 a) (1 b) (1 a)) "c")
|
'((1 a) (1 b) (1 a)) "c")
|
||||||
(repeat-tests--check
|
(repeat-tests--check
|
||||||
"M-C-z b a c"
|
"C-M-z b a c"
|
||||||
'((1 a)) "bac")
|
'((1 a)) "bac")
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(put 'repeat-tests-call-a 'repeat-check-key 'no)
|
(put 'repeat-tests-call-a 'repeat-check-key 'no)
|
||||||
(repeat-tests--check
|
(repeat-tests--check
|
||||||
"M-C-z b a c"
|
"C-M-z b a c"
|
||||||
'((1 a) (1 b) (1 a)) "c"))
|
'((1 a) (1 b) (1 a)) "c"))
|
||||||
(put 'repeat-tests-call-a 'repeat-check-key nil)))
|
(put 'repeat-tests-call-a 'repeat-check-key nil)))
|
||||||
(let ((repeat-check-key nil))
|
(let ((repeat-check-key nil))
|
||||||
(repeat-tests--check
|
(repeat-tests--check
|
||||||
"M-C-z b a c"
|
"C-M-z b a c"
|
||||||
'((1 a) (1 b) (1 a)) "c")
|
'((1 a) (1 b) (1 a)) "c")
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(put 'repeat-tests-call-a 'repeat-check-key t)
|
(put 'repeat-tests-call-a 'repeat-check-key t)
|
||||||
(repeat-tests--check
|
(repeat-tests--check
|
||||||
"M-C-z b a c"
|
"C-M-z b a c"
|
||||||
'((1 a)) "bac"))
|
'((1 a)) "bac"))
|
||||||
(put 'repeat-tests-call-a 'repeat-check-key nil))))))
|
(put 'repeat-tests-call-a 'repeat-check-key nil))))))
|
||||||
|
|
||||||
|
@ -125,15 +125,17 @@
|
||||||
(repeat-tests--check
|
(repeat-tests--check
|
||||||
"C-2 C-x w a C-3 c"
|
"C-2 C-x w a C-3 c"
|
||||||
'((2 a)) "ccc"))
|
'((2 a)) "ccc"))
|
||||||
;; TODO: fix and uncomment
|
;; Fixed in bug#51281 and bug#55986
|
||||||
;; (let ((repeat-keep-prefix t))
|
(let ((repeat-keep-prefix t))
|
||||||
;; (repeat-tests--check
|
;; Re-enable to take effect.
|
||||||
;; "C-2 C-x w a b a b c"
|
(repeat-mode -1) (repeat-mode +1)
|
||||||
;; '((2 a) (2 b) (2 a) (2 b)) "c")
|
(repeat-tests--check
|
||||||
;; (repeat-tests--check
|
"C-2 C-x w a b a b c"
|
||||||
;; "C-2 C-x w a C-1 C-2 b a C-3 C-4 b c"
|
'((2 a) (2 b) (2 a) (2 b)) "c")
|
||||||
;; '((2 a) (12 b) (12 a) (34 b)) "c"))
|
;; (repeat-tests--check
|
||||||
)))
|
;; "C-2 C-x w a C-1 C-2 b a C-3 C-4 b c"
|
||||||
|
;; '((2 a) (12 b) (12 a) (34 b)) "c")
|
||||||
|
))))
|
||||||
|
|
||||||
;; TODO: :tags '(:expensive-test) for repeat-exit-timeout
|
;; TODO: :tags '(:expensive-test) for repeat-exit-timeout
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue