* 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:
Juri Linkov 2022-12-20 19:22:15 +02:00
parent 8ef3777d54
commit d3a76db88b
2 changed files with 86 additions and 55 deletions

View file

@ -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))))))
(defun repeat-post-hook () (defvar repeat--prev-mb '(0)
"Function run after commands to set transient keymap for repeatable keys." "Previous minibuffer state.")
(let ((was-in-progress repeat-in-progress))
(setq repeat-in-progress nil)
(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)))
(let ((map (copy-keymap rep-map)))
(when (and (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 ;; Detect changes in the minibuffer state to allow repetitions
;; in the same minibuffer, but not when the minibuffer is activated ;; in the same minibuffer, but not when the minibuffer is activated
;; in the middle of repeating sequence (bug#47566). ;; in the middle of repeating sequence (bug#47566).
(or (< (minibuffer-depth) (car repeat--prev-mb)) (or (< (minibuffer-depth) (car repeat--prev-mb))
(eq current-minibuffer-command (cdr repeat--prev-mb))) (eq current-minibuffer-command (cdr repeat--prev-mb)))
(or (not repeat-keep-prefix) prefix-arg) (repeat-check-key last-command-event map)
(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 ()
"Function run after commands to set transient keymap for repeatable keys."
(let ((was-in-progress repeat-in-progress))
(setq repeat-in-progress nil)
(let ((map (repeat-get-map)))
(when (repeat-check-map map)
;; Messaging ;; Messaging
(unless prefix-arg (funcall repeat-echo-function map)
(funcall repeat-echo-function map))
;; Adding an exit key ;; Adding an exit key
(when repeat-exit-key (when repeat-exit-key
(setq map (copy-keymap map))
(define-key map (if (key-valid-p repeat-exit-key) (define-key map (if (key-valid-p repeat-exit-key)
(kbd repeat-exit-key) (kbd repeat-exit-key)
repeat-exit-key) repeat-exit-key)
'ignore)) 'ignore))
(when (and repeat-keep-prefix (not prefix-arg))
(setq prefix-arg current-prefix-arg))
(setq repeat-in-progress t) (setq repeat-in-progress t)
(let ((exitfun (set-transient-map map)))
(repeat--exit) (repeat--exit)
(let ((exitfun (set-transient-map map)))
(setq repeat-exit-function exitfun) (setq repeat-exit-function exitfun)
(let* ((prop (repeat--command-property 'repeat-exit-timeout)) (let* ((prop (repeat--command-property 'repeat-exit-timeout))
(timeout (unless (eq prop 'no) (or prop repeat-exit-timeout)))) (timeout (unless (eq prop 'no) (or prop repeat-exit-timeout))))
(when timeout (when timeout
(setq repeat-exit-timer (setq repeat-exit-timer
(run-with-idle-timer timeout nil #'repeat-exit)))))))))) (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)

View file

@ -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
"C-2 C-x w a b a b c"
'((2 a) (2 b) (2 a) (2 b)) "c")
;; (repeat-tests--check ;; (repeat-tests--check
;; "C-2 C-x w a C-1 C-2 b a C-3 C-4 b c" ;; "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")) ;; '((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