From: Stefan Monnier <monnier@iro.umontreal.ca>
Date: Mon, 18 Dec 2023 06:11:42 +0000 (+0100)
Subject: Fix issue with register commands in kmacro
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=73acd543cb1f88af880445de1e1a7238dd46c9de;p=emacs.git

Fix issue with register commands in kmacro

Using post-command-hook in minibuffer-setup-hook instead of a timer
allow running exit-minibuffer without delay and ensure the serie of
commands used in a kmacro run synchronously.

* lisp/register.el (register-read-with-preview-fancy): Do it.
---

diff --git a/lisp/register.el b/lisp/register.el
index 8f0c6a7105d..19b207960d6 100644
--- a/lisp/register.el
+++ b/lisp/register.el
@@ -478,7 +478,7 @@ display such a window regardless."
                 m))
          (data (register-command-info this-command))
          (enable-recursive-minibuffers t)
-         types msg result timer act win strs smatch noconfirm)
+         types msg result act win strs smatch noconfirm)
     (if data
         (setq types     (register-preview-info-types data)
               msg       (register-preview-info-msg   data)
@@ -511,68 +511,66 @@ display such a window regardless."
          (progn
            (minibuffer-with-setup-hook
                (lambda ()
-                 (setq timer
-                       (run-with-idle-timer
-                        0.01 'repeat
-                        (lambda ()
-                          (with-selected-window (minibuffer-window)
-                            (let ((input (minibuffer-contents)))
-                              (when (> (length input) 1)
-                                (let ((new (substring input 1))
-                                      (old (substring input 0 1)))
-                                  (setq input (if (or (null smatch)
-                                                      (member new strs))
-                                                  new old))
-                                  (delete-minibuffer-contents)
-                                  (insert input)))
-                              (when (and smatch (not (string= input ""))
-                                         (not (member input strs)))
-                                (setq input "")
-                                (delete-minibuffer-contents)
-                                (minibuffer-message "Not matching"))
-                              (when (not (string= input pat))
-                                (setq pat input))))
-                          (if (setq win (get-buffer-window buffer))
-                              (with-selected-window win
-                                (let ((ov (make-overlay
-                                           (point-min) (point-min)))
-                                      ;; Allow upper-case and
-                                      ;; lower-case letters to refer
-                                      ;; to different registers.
-                                      (case-fold-search nil))
-                                  (goto-char (point-min))
-                                  (remove-overlays)
-                                  (unless (string= pat "")
-                                    (if (re-search-forward (concat "^" pat) nil t)
-                                        (progn (move-overlay
-                                                ov
-                                                (match-beginning 0) (pos-eol))
-                                               (overlay-put ov 'face 'match)
-                                               (when msg
-                                                 (with-selected-window (minibuffer-window)
-                                                   (minibuffer-message msg pat))))
-                                      (with-selected-window (minibuffer-window)
-                                        (minibuffer-message
-                                         "Register `%s' is empty" pat))))))
-                            (unless (string= pat "")
-                              (with-selected-window (minibuffer-window)
-                                (if (and (member pat strs)
-                                         (memq act '(set modify))
-                                         (null noconfirm))
-                                    (with-selected-window (minibuffer-window)
-                                      (minibuffer-message msg pat))
-                                  ;; The action is insert or
-                                  ;; jump or noconfirm is specifed
-                                  ;; explicitely, don't ask for
-                                  ;; confirmation and exit immediately (bug#66394).
-                                  (setq result pat)
-                                  (exit-minibuffer)))))))))
+                 (add-hook 'post-command-hook
+                           (lambda ()
+                             (with-selected-window (minibuffer-window)
+                               (let ((input (minibuffer-contents)))
+                                 (when (> (length input) 1)
+                                   (let ((new (substring input 1))
+                                         (old (substring input 0 1)))
+                                     (setq input (if (or (null smatch)
+                                                         (member new strs))
+                                                     new old))
+                                     (delete-minibuffer-contents)
+                                     (insert input)))
+                                 (when (and smatch (not (string= input ""))
+                                            (not (member input strs)))
+                                   (setq input "")
+                                   (delete-minibuffer-contents)
+                                   (minibuffer-message "Not matching"))
+                                 (when (not (string= input pat))
+                                   (setq pat input))))
+                             (if (setq win (get-buffer-window buffer))
+                                 (with-selected-window win
+                                   (let ((ov (make-overlay
+                                              (point-min) (point-min)))
+                                         ;; Allow upper-case and
+                                         ;; lower-case letters to refer
+                                         ;; to different registers.
+                                         (case-fold-search nil))
+                                     (goto-char (point-min))
+                                     (remove-overlays)
+                                     (unless (string= pat "")
+                                       (if (re-search-forward (concat "^" pat) nil t)
+                                           (progn (move-overlay
+                                                   ov
+                                                   (match-beginning 0) (pos-eol))
+                                                  (overlay-put ov 'face 'match)
+                                                  (when msg
+                                                    (with-selected-window (minibuffer-window)
+                                                      (minibuffer-message msg pat))))
+                                         (with-selected-window (minibuffer-window)
+                                           (minibuffer-message
+                                            "Register `%s' is empty" pat))))))
+                               (unless (string= pat "")
+                                 (with-selected-window (minibuffer-window)
+                                   (if (and (member pat strs)
+                                            (memq act '(set modify))
+                                            (null noconfirm))
+                                       (with-selected-window (minibuffer-window)
+                                         (minibuffer-message msg pat))
+                                     ;; The action is insert or
+                                     ;; jump or noconfirm is specifed
+                                     ;; explicitely, don't ask for
+                                     ;; confirmation and exit immediately (bug#66394).
+                                     (setq result pat)
+                                     (exit-minibuffer))))))
+                           nil 'local))
              (setq result (read-from-minibuffer
                            prompt nil map nil nil (register-preview-get-defaults act))))
            (cl-assert (and result (not (string= result "")))
                       nil "No register specified")
            (string-to-char result))
-      (when timer (cancel-timer timer))
       (let ((w (get-buffer-window buf)))
         (and (window-live-p w) (delete-window w)))
       (and (get-buffer buf) (kill-buffer buf)))))