From: Juri Linkov <juri@linkov.net>
Date: Tue, 20 Dec 2022 17:22:15 +0000 (+0200)
Subject: * lisp/repeat.el: Fix repeat-keep-prefix to allow customizing it to non-nil.
X-Git-Tag: emacs-29.0.90~1059
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d3a76db88b4357fe1c92f240796ea9b522b97a8e;p=emacs.git

* 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.
---

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