From 20e31526ddb9844e772826bbf355c5190a35ba3a Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 12 Jul 2024 20:43:50 +0200 Subject: [PATCH] * lisp/minibuffer.el (minibuffer-message): Be async. --- lisp/minibuffer.el | 64 +++++++++++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 27 deletions(-) diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 0a9bddd8103..4365c0badfb 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -749,6 +749,19 @@ METADATA takes precedence over any metadata that TABLE provides." (defvar minibuffer-message-properties nil "Text properties added to the text shown by `minibuffer-message'.") +(defvar minibuffer--message-overlay nil) + +(defvar minibuffer--message-timer nil) + +(defun minibuffer--delete-message-overlay () + (when (overlayp minibuffer--message-overlay) + (delete-overlay minibuffer--message-overlay) + (setq minibuffer--message-overlay nil)) + (when (timerp minibuffer--message-timer) + (cancel-timer minibuffer--message-timer) + (setq minibuffer--message-timer nil)) + (remove-hook 'pre-command-hook #'minibuffer--delete-message-overlay)) + (defun minibuffer-message (message &rest args) "Temporarily display MESSAGE at the end of minibuffer text. This function is designed to be called from the minibuffer, i.e., @@ -773,6 +786,7 @@ property, MESSAGE is shown at that position instead of EOB." (prog1 (sit-for (or minibuffer-message-timeout 1000000)) (message nil))) ;; Clear out any old echo-area message to make way for our new thing. + (minibuffer--delete-message-overlay) (message nil) (setq message (if (and (null args) (string-match-p "\\` *\\[.+\\]\\'" message)) @@ -786,30 +800,24 @@ property, MESSAGE is shown at that position instead of EOB." (setq message (apply #'propertize message minibuffer-message-properties))) ;; Put overlay either on `minibuffer-message' property, or at EOB. (let* ((ovpos (minibuffer--message-overlay-pos)) - (ol (make-overlay ovpos ovpos nil t t)) - ;; A quit during sit-for normally only interrupts the sit-for, - ;; but since minibuffer-message is used at the end of a command, - ;; at a time when the command has virtually finished already, a C-g - ;; should really cause an abort-recursive-edit instead (i.e. as if - ;; the C-g had been typed at top-level). Binding inhibit-quit here - ;; is an attempt to get that behavior. - (inhibit-quit t)) - (unwind-protect - (progn - (unless (zerop (length message)) - ;; The current C cursor code doesn't know to use the overlay's - ;; marker's stickiness to figure out whether to place the cursor - ;; before or after the string, so let's spoon-feed it the pos. - (put-text-property 0 1 'cursor t message)) - (overlay-put ol 'after-string message) - ;; Make sure the overlay with the message is displayed before - ;; any other overlays in that position, in case they have - ;; resize-mini-windows set to nil and the other overlay strings - ;; are too long for the mini-window width. This makes sure the - ;; temporary message will always be visible. - (overlay-put ol 'priority 1100) - (sit-for (or minibuffer-message-timeout 1000000))) - (delete-overlay ol))))) + (ol (make-overlay ovpos ovpos nil t t))) + (unless (zerop (length message)) + ;; The current C cursor code doesn't know to use the overlay's + ;; marker's stickiness to figure out whether to place the cursor + ;; before or after the string, so let's spoon-feed it the pos. + (put-text-property 0 1 'cursor t message)) + (overlay-put ol 'after-string message) + ;; Make sure the overlay with the message is displayed before + ;; any other overlays in that position, in case they have + ;; resize-mini-windows set to nil and the other overlay strings + ;; are too long for the mini-window width. This makes sure the + ;; temporary message will always be visible. + (overlay-put ol 'priority 1100) + (setq minibuffer--message-overlay ol + minibuffer--message-timer + (run-at-time (or minibuffer-message-timeout 1000000) nil + #'minibuffer--delete-message-overlay)) + (add-hook 'pre-command-hook #'minibuffer--delete-message-overlay)))) (defcustom minibuffer-message-clear-timeout nil "How long to display an echo-area message when the minibuffer is active. @@ -2036,7 +2044,9 @@ Interactively, ARG is the prefix argument, and it defaults to 1." minibuffer-apply-and-cycle-completion minibuffer-apply-alt-and-cycle-completion minibuffer-cycle-completion-and-apply - minibuffer-cycle-completion-and-apply-alt))) + minibuffer-cycle-completion-and-apply-alt + minibuffer-apply + minibuffer-apply-alt))) (lambda () (setq completion-all-sorted-completions nil)))))))) @@ -3533,8 +3543,8 @@ The completion method is determined by `completion-at-point-functions'." "C-o" #'minibuffer-cycle-completion "C-M-o" #'minibuffer-apply-and-cycle-completion "C-M-S-o" #'minibuffer-apply-alt-and-cycle-completion - ;; "..." #'minibuffer-cycle-completion-and-apply - ;; "..." #'minibuffer-cycle-completion-and-apply-alt + "M-o" #'minibuffer-cycle-completion-and-apply + "M-S-o" #'minibuffer-cycle-completion-and-apply-alt "C-l" #'minibuffer-restore-completion-input "C-S-a" #'minibuffer-toggle-completion-ignore-case "?" #'minibuffer-completion-help -- 2.39.2