master c2055d4 1/2: Add new macro `with-delayed-message'

[Lars Ingebrigtsen]

branch: master
commit c2055d41b4b145aa940ce940adc1a3fabfe87a6b
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add new macro `with-delayed-message'
    
    * doc/lispref/display.texi (Progress): Document it.
    * lisp/subr.el (with-delayed-message): New macro.
    
    * src/eval.c (with_delayed_message_display)
    (with_delayed_message_cancel): Helper functions.
    (Ffuncall_with_delayed_message): New function (bug#19776).
---
 doc/lispref/display.texi | 20 ++++++++++++++++++++
 etc/NEWS                 | 10 ++++++++++
 lisp/subr.el             | 10 ++++++++++
 src/eval.c               | 45 +++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 85 insertions(+)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index 9c378a3..6f95728 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -561,6 +561,26 @@ You can rewrite the previous example with this macro as 
follows:
 @end example
 @end defmac
 
+@defmac with-delayed-message timeout message body@dots{}
+Sometimes it's unclear whether an operation will take a long time to
+execute or not, or it can be inconvenient to implement a progress
+reporter.  This macro can be used in those situations.
+
+@lisp
+(with-delayed-message 2 (format "Gathering data for %s" entry)
+  (setq data (gather-data entry)))
+@end lisp
+
+In this example, if the body takes more than two seconds to execute,
+the message will be displayed.  If it takes a shorter time than that,
+the message won't be displayed.  In either case, the body is evaluated
+as normally, and the return value of the final element in the body is
+the return value of the macro.
+
+The @var{message} element is evaluated before @var{body}, and is
+always evaluated, whether the message is displayed or not.
+@end defmac
+
 @node Logging Messages
 @subsection Logging Messages in @file{*Messages*}
 @cindex logging echo-area messages
diff --git a/etc/NEWS b/etc/NEWS
index 0714a4d..d47a91c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -284,6 +284,16 @@ Use 'exif-parse-file' and 'exif-field' instead.
 
 * Lisp Changes in Emacs 29.1
 
++++
+** New macro 'with-delayed-message'.
+This macro is like 'progn', but will output the specified message if
+the body takes longer to execute than the specified timeout.
+
+---
+** New function 'funcall-with-delayed-message'.
+This function is like 'funcall', but will output the specified message
+is the function take longer to execute that the specified timeout.
+
 ** Locale
 
 ---
diff --git a/lisp/subr.el b/lisp/subr.el
index 9118978..9acc799 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6723,4 +6723,14 @@ as the variable documentation string.
        (define-keymap--define (list ,@(nreverse opts) ,@defs))
        ,@(and doc (list doc)))))
 
+(defmacro with-delayed-message (timeout message &rest body)
+  "Like `progn', but display MESSAGE if BODY takes longer than TIMEOUT seconds.
+The MESSAGE form will be evaluated immediately, but the resulting
+string will be displayed only if BODY takes longer than TIMEOUT seconds."
+  (declare (indent 2))
+  `(funcall-with-delayed-message ,timeout ,message
+                                 (lambda ()
+                                   ,@body)))
+
+
 ;;; subr.el ends here
diff --git a/src/eval.c b/src/eval.c
index 0f792b4..cd451ec 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -29,6 +29,7 @@ along with GNU Emacs.  If not, see 
<https://www.gnu.org/licenses/>.  */
 #include "dispextern.h"
 #include "buffer.h"
 #include "pdumper.h"
+#include "atimer.h"
 
 /* CACHEABLE is ordinarily nothing, except it is 'volatile' if
    necessary to cajole GCC into not warning incorrectly that a
@@ -1078,6 +1079,49 @@ usage: (while TEST BODY...)  */)
   return Qnil;
 }
 
+static void
+with_delayed_message_display (struct atimer *timer)
+{
+  printf("Here: %s\n", SDATA (timer->client_data));
+  message3 (timer->client_data);
+}
+
+static void
+with_delayed_message_cancel (void *timer)
+{
+  cancel_atimer (timer);
+}
+
+DEFUN ("funcall-with-delayed-message",
+       Ffuncall_with_delayed_message, Sfuncall_with_delayed_message,
+       3, 3, 0,
+       doc: /* Like `funcall', but display MESSAGE if FUNCTION takes longer 
than TIMEOUT.
+TIMEOUT is a number of seconds, and can be an integer or a floating
+point number.
+
+If FUNCTION takes less time to execute than TIMEOUT seconds, MESSAGE
+is not displayed.  */)
+  (Lisp_Object timeout, Lisp_Object message, Lisp_Object function)
+{
+  ptrdiff_t count = SPECPDL_INDEX ();
+
+  CHECK_NUMBER (timeout);
+  CHECK_STRING (message);
+
+  /* Set up the atimer.  */
+  struct timespec interval = dtotimespec (XFLOATINT (timeout));
+  struct atimer *timer = start_atimer (ATIMER_RELATIVE, interval,
+                                      with_delayed_message_display,
+                                      message);
+  record_unwind_protect_ptr (with_delayed_message_cancel, timer);
+
+  Lisp_Object result = CALLN (Ffuncall, function);
+
+  cancel_atimer (timer);
+
+  return unbind_to (count, result);
+}
+
 DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
        doc: /* Return result of expanding macros at top level of FORM.
 If FORM is not a macro call, it is returned unchanged.
@@ -4511,6 +4555,7 @@ alist of active lexical bindings.  */);
   defsubr (&Slet);
   defsubr (&SletX);
   defsubr (&Swhile);
+  defsubr (&Sfuncall_with_delayed_message);
   defsubr (&Smacroexpand);
   defsubr (&Scatch);
   defsubr (&Sthrow);