New variable set-message-function to show message at the end of the minibuffer

* doc/lispref/display.texi (Displaying Messages): Document
set-message-function and clear-message-function.

* lisp/minibuffer.el (minibuffer-message-clear-timeout): New defcustom.
(minibuffer-message-timer, minibuffer-message-overlay): New variables.
(set-minibuffer-message, clear-minibuffer-message): New functions.
(set-message-function, clear-message-function): Set variables to
set-minibuffer-message and clear-minibuffer-message respectively.

* src/keyboard.c (read_char): Call clear_message when
Vclear_message_function is a function.

* src/xdisp.c (set_message): Call Vset_message_function when it's a function.
(clear_message): Call Vclear_message_function when it's a function.
(syms_of_xdisp): New variables set-message-function and clear-message-function
(bug#38457).

1 files changed, 70 insertions, 0 deletions

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 76d8ca44757..5dc753ffd5c 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -746,6 +746,76 @@ If ARGS are provided, then pass MESSAGE through `format-message'."
             (sit-for (or minibuffer-message-timeout 1000000)))
         (delete-overlay ol)))))
 
+(defcustom minibuffer-message-clear-timeout nil
+  "How long to display an echo-area message when the minibuffer is active.
+If the value is a number, it should be specified in seconds.
+If the value is not a number, such messages never time out,
+and the text is displayed until the next input event arrives.
+Unlike `minibuffer-message-timeout' used by `minibuffer-message',
+this option affects the pair of functions `set-minibuffer-message'
+and `clear-minibuffer-message' called automatically via
+`set-message-function' and `clear-message-function'."
+  :type '(choice (const :tag "Never time out" nil)
+                 (integer :tag "Wait for the number of seconds" 2))
+  :version "27.1")
+
+(defvar minibuffer-message-timer nil)
+(defvar minibuffer-message-overlay nil)
+
+(defun set-minibuffer-message (message)
+  "Temporarily display MESSAGE at the end of the minibuffer.
+The text is displayed for `minibuffer-message-clear-timeout' seconds
+(if the value is a number), or until the next input event arrives,
+whichever comes first.
+Unlike `minibuffer-message', this function is called automatically
+via `set-message-function'."
+  (when (and (not noninteractive)
+             (window-live-p (active-minibuffer-window)))
+    (with-current-buffer (window-buffer (active-minibuffer-window))
+      (setq message (if (string-match-p "\\` *\\[.+\\]\\'" message)
+                        ;; Make sure we can put-text-property.
+                        (copy-sequence message)
+                      (concat " [" message "]")))
+      (unless (or (null minibuffer-message-properties)
+                  ;; Don't overwrite the face properties the caller has set
+                  (text-properties-at 0 message))
+        (setq message (apply #'propertize message minibuffer-message-properties)))
+
+      (clear-minibuffer-message)
+
+      (setq minibuffer-message-overlay
+            (make-overlay (point-max) (point-max) 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 minibuffer-message-overlay 'after-string message)
+
+      (when (numberp minibuffer-message-clear-timeout)
+        (setq minibuffer-message-timer
+              (run-with-timer minibuffer-message-clear-timeout nil
+                              #'clear-minibuffer-message)))
+
+      ;; Return `t' telling the caller that the message
+      ;; was handled specially by this function.
+      t)))
+
+(setq set-message-function 'set-minibuffer-message)
+
+(defun clear-minibuffer-message ()
+  "Clear minibuffer message.
+Intended to be called via `clear-message-function'."
+  (when (not noninteractive)
+    (when (timerp minibuffer-message-timer)
+      (cancel-timer minibuffer-message-timer)
+      (setq minibuffer-message-timer nil))
+    (when (overlayp minibuffer-message-overlay)
+      (delete-overlay minibuffer-message-overlay)
+      (setq minibuffer-message-overlay nil))))
+
+(setq clear-message-function 'clear-minibuffer-message)
+
 (defun minibuffer-completion-contents ()
   "Return the user input in a minibuffer before point as a string.
 In Emacs 22, that was what completion commands operated on.