bug#38457: 27.0.50; dabbrev-expand regression due to message change

[Juri Linkov]

>> >>   (if (and
>> >>        ;; When `inhibit-message' is non-nil, the intention was to just
>> >>        ;; log the message to the *Messages* buffer using `message'.
>> >>        (null inhibit-message)
>> >>        (window-live-p (active-minibuffer-window))
>> >>        (window-live-p (old-selected-window))
>> >>        (bufferp (window-buffer (old-selected-window)))
>> >>        (minibufferp (window-buffer (old-selected-window))))
>> >
>> > Btw, can you explain why every part of this condition is needed?  IOW,
>> > why isn't just the below enough?
>> >
>> >    (window-live-p (active-minibuffer-window))
>> >
>> > (I do understand the reason for the test of inhibit-message).
>> >
>> > Maybe the other conditions need a comment to explain them?
>> 
>> Unfortunately, I forgot why they were added, i.e. during testing
>> I added them one by one when noticed that some cases don't work.
>> Now I'll try to reproduce these cases by removing conditions
>> and checking which part doesn't work.

Now I recall why just (window-live-p (active-minibuffer-window))
is not enough.  Because it returns non-nil even when the
current buffer is not the minibuffer, but the minibuffer was
activated earlier.  Test case:

0. emacs -Q
1. M-x   ;; activate the minibuffer
2. C-x o ;; switch back to *scratch*
3. Eval in *scratch* buffer:

   (window-live-p (active-minibuffer-window))
   => t

A message overlay should not be added to the *scratch* buffer, so it's
important to check if old-selected-window is a minibuffer window
(i.e. the current buffer is the minibuffer).

>> But if implementation would be straightforward and if you see no problems
>> then why not.
>
> The implementation looks straightforward to me, since you already
> implemented almost all of it in that ELPA package.  What's left is
> minor details.

Let's iron out the details.  A new patch attached works well
in all cases I tested (dabbrev, icomplete, etc.)  But I'm sure
it could be improved further because I might have made wrong
assumptions on the C side, or something.

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 76d8ca4475..331b2a44ed 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -746,6 +746,78 @@ minibuffer-message
             (sit-for (or minibuffer-message-timeout 1000000)))
         (delete-overlay ol)))))
 
+(defcustom minibuffer-message-wait 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."
+  :type '(choice (const :tag "Never time out" nil)
+                 (integer :tag "Wait for the number of seconds" 2)))
+
+(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-wait' seconds,
+or until the next input event arrives, whichever comes first.
+Enclose MESSAGE in [...] if this is not yet the case."
+  (when (and (not noninteractive)
+             (window-live-p (active-minibuffer-window))
+             (window-live-p (old-selected-window))
+             (bufferp (window-buffer (old-selected-window)))
+             (minibufferp (window-buffer (old-selected-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)))
+
+    (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 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-wait)
+      (setq minibuffer-message-timer
+            (run-with-timer minibuffer-message-wait nil
+                            (lambda ()
+                              (when (overlayp minibuffer-message-overlay)
+                                (delete-overlay minibuffer-message-overlay)
+                                (setq minibuffer-message-overlay nil))))))
+
+    t))
+
+(setq set-message-function 'set-minibuffer-message)
+
+(defun clear-minibuffer-message ()
+  "Clear minibuffer message."
+  (when (not noninteractive)
+    ;; When this option is a number, the message
+    ;; should be cleared only by timer.
+    (unless (numberp minibuffer-message-wait)
+      (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.
diff --git a/src/keyboard.c b/src/keyboard.c
index 5135fd0bc8..d9c9213098 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2990,6 +2990,8 @@ read_char (int commandflag, Lisp_Object map,
          safe_run_hooks (Qecho_area_clear_hook);
          clear_message (1, 0);
        }
+      else if (!NILP (Vclear_message_function))
+        message1 (0);
     }
 
  reread_for_input_method:
diff --git a/src/xdisp.c b/src/xdisp.c
index 08c6927052..a31a90c7e2 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -11706,13 +11706,33 @@ truncate_message_1 (ptrdiff_t nchars, Lisp_Object a2)
 static void
 set_message (Lisp_Object string)
 {
+  Lisp_Object message = Qnil;
+
   eassert (STRINGP (string));
 
-  message_enable_multibyte = STRING_MULTIBYTE (string);
+  if (!NILP (Vset_message_function))
+    {
+      ptrdiff_t count = SPECPDL_INDEX ();
+      specbind (Qinhibit_quit, Qt);
+      message = call1 (Vset_message_function, string);
+      unbind_to (count, Qnil);
 
-  with_echo_area_buffer (0, -1, set_message_1, 0, string);
-  message_buf_print = false;
-  help_echo_showing_p = false;
+      if (STRINGP (message))
+        {
+          eassert (STRINGP (message));
+          string = message;
+          message = Qnil;
+        }
+    }
+
+  if (NILP (message))
+    {
+      message_enable_multibyte = STRING_MULTIBYTE (string);
+
+      with_echo_area_buffer (0, -1, set_message_1, 0, string);
+      message_buf_print = false;
+      help_echo_showing_p = false;
+    }
 
   if (STRINGP (Vdebug_on_message)
       && STRINGP (string)
@@ -11768,6 +11788,14 @@ clear_message (bool current_p, bool last_displayed_p)
     {
       echo_area_buffer[0] = Qnil;
       message_cleared_p = true;
+
+      if (!NILP (Vclear_message_function))
+        {
+          ptrdiff_t count = SPECPDL_INDEX ();
+          specbind (Qinhibit_quit, Qt);
+          call0 (Vclear_message_function);
+          unbind_to (count, Qnil);
+        }
     }
 
   if (last_displayed_p)
@@ -34940,6 +34968,14 @@ syms_of_xdisp (void)
               doc: /* If non-nil, debug if a message matching this regexp is 
displayed.  */);
   Vdebug_on_message = Qnil;
 
+  DEFVAR_LISP ("set-message-function", Vset_message_function,
+              doc: /* If non-nil, function to set message.  */);
+  Vset_message_function = Qnil;
+
+  DEFVAR_LISP ("clear-message-function", Vclear_message_function,
+              doc: /* If non-nil, function to clear message.  */);
+  Vclear_message_function = Qnil;
+
   DEFVAR_LISP ("redisplay--all-windows-cause", Vredisplay__all_windows_cause,
               doc: /*  */);
   Vredisplay__all_windows_cause = Fmake_hash_table (0, NULL);