summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuri Linkov <juri@linkov.net>2022-12-20 19:22:15 +0200
committerJuri Linkov <juri@linkov.net>2022-12-20 19:22:15 +0200
commitd3a76db88b4357fe1c92f240796ea9b522b97a8e (patch)
tree5317ccdb0c641609c5a442893e8fe125d2396f90
parent8ef3777d54429744dc941145c25067d6964374aa (diff)
downloademacs-d3a76db88b4357fe1c92f240796ea9b522b97a8e.tar.gz
* 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.
-rw-r--r--lisp/repeat.el117
-rw-r--r--test/lisp/repeat-tests.el30
2 files changed, 89 insertions, 58 deletions
diff --git a/lisp/repeat.el b/lisp/repeat.el
index 33e8d98ce33..3b3a444ee24 100644
--- a/lisp/repeat.el
+++ b/lisp/repeat.el
@@ -368,6 +368,13 @@ This property can override the value of this variable."
(defcustom repeat-keep-prefix nil
"Whether to keep the prefix arg of the previous command when repeating."
: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
: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."
:global t :group 'repeat
(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)
(let* ((keymaps nil)
(commands (all-completions
@@ -431,15 +442,21 @@ See `describe-repeat-maps' for a list of all repeatable commands."
(length commands)
(length (delete-dups keymaps))))))
-(defvar repeat--prev-mb '(0)
- "Previous minibuffer state.")
-
(defun repeat--command-property (property)
(or (and (symbolp this-command)
(get this-command property))
(and (symbolp real-this-command)
(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)
"Check if the last key is suitable to activate the repeating MAP."
(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:
(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 ()
"Function run after commands to set transient keymap for repeatable keys."
(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
- ;; 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)))
- (or (not repeat-keep-prefix) prefix-arg)
- (repeat-check-key last-command-event map))
-
- ;; Messaging
- (unless prefix-arg
- (funcall repeat-echo-function map))
-
- ;; Adding an exit key
- (when repeat-exit-key
- (define-key map (if (key-valid-p repeat-exit-key)
- (kbd repeat-exit-key)
- repeat-exit-key)
- '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))))))))))
+ (let ((map (repeat-get-map)))
+ (when (repeat-check-map map)
+ ;; Messaging
+ (funcall repeat-echo-function map)
+
+ ;; Adding an exit key
+ (when repeat-exit-key
+ (setq map (copy-keymap map))
+ (define-key map (if (key-valid-p repeat-exit-key)
+ (kbd repeat-exit-key)
+ repeat-exit-key)
+ 'ignore))
+
+ (setq repeat-in-progress t)
+ (repeat--exit)
+ (let ((exitfun (set-transient-map map)))
+ (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--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)))))
(with-help-window (help-buffer)
(with-current-buffer standard-output
+ (setq-local outline-regexp "[*]+")
(insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n")
(dolist (keymap (sort keymaps (lambda (a b)
diff --git a/test/lisp/repeat-tests.el b/test/lisp/repeat-tests.el
index 1382d003599..06c6f748a2a 100644
--- a/test/lisp/repeat-tests.el
+++ b/test/lisp/repeat-tests.el
@@ -76,27 +76,27 @@
"C-x w a b a c"
'((1 a) (1 b) (1 a)) "c")
(repeat-tests--check
- "M-C-a b a c"
+ "C-M-a b a c"
'((1 a) (1 b) (1 a)) "c")
(repeat-tests--check
- "M-C-z b a c"
+ "C-M-z b a c"
'((1 a)) "bac")
(unwind-protect
(progn
(put 'repeat-tests-call-a 'repeat-check-key 'no)
(repeat-tests--check
- "M-C-z b a c"
+ "C-M-z b a c"
'((1 a) (1 b) (1 a)) "c"))
(put 'repeat-tests-call-a 'repeat-check-key nil)))
(let ((repeat-check-key nil))
(repeat-tests--check
- "M-C-z b a c"
+ "C-M-z b a c"
'((1 a) (1 b) (1 a)) "c")
(unwind-protect
(progn
(put 'repeat-tests-call-a 'repeat-check-key t)
(repeat-tests--check
- "M-C-z b a c"
+ "C-M-z b a c"
'((1 a)) "bac"))
(put 'repeat-tests-call-a 'repeat-check-key nil))))))
@@ -125,15 +125,17 @@
(repeat-tests--check
"C-2 C-x w a C-3 c"
'((2 a)) "ccc"))
- ;; TODO: fix and uncomment
- ;; (let ((repeat-keep-prefix t))
- ;; (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
- ;; "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"))
- )))
+ ;; Fixed in bug#51281 and bug#55986
+ (let ((repeat-keep-prefix t))
+ ;; Re-enable to take effect.
+ (repeat-mode -1) (repeat-mode +1)
+ (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
+ ;; "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