From 9c1da99a850065bc5740ee9ae3466844dc47ab11 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phane=20Marks?= Date: Mon, 12 Jan 2026 13:36:21 -0500 Subject: [PATCH] Optionally inhibit echo area progress reporting (bug#80198) Add an optional 'context' argument to 'make-progress-reporter' which 'progress-reporter-echo-area' consults to inhibit updates if the context is 'async' and the echo area is busy. * lisp/subr.el (make-progress-reporter): Add the optional 'context' argument. (progress-reporter-context): New defun accessor. (progress-reporter-echo-area): Consult 'progress-reporter-context'. * doc/lispref/display.texi: Document context. * etc/NEWS: Announce context. --- doc/lispref/display.texi | 20 +++++++++------- etc/NEWS | 8 +++++++ lisp/subr.el | 49 +++++++++++++++++++++++++++------------- 3 files changed, 53 insertions(+), 24 deletions(-) diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 892ed241cfe..bb9268c7efd 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -486,7 +486,7 @@ A convenient way to do this is to use a @dfn{progress reporter}. (progress-reporter-done progress-reporter)) @end smallexample -@defun make-progress-reporter message &optional min-value max-value current-value min-change min-time +@defun make-progress-reporter message &optional min-value max-value current-value min-change min-time context This function creates and returns a progress reporter object, which you will use as an argument for the other functions listed below. The idea is to precompute as much data as possible to make progress @@ -513,13 +513,17 @@ If @var{min-value} and @var{max-value} are numbers, you can give the argument @var{current-value} a numerical value specifying the initial progress; if omitted, this defaults to @var{min-value}. -The remaining arguments control the rate of echo area updates. The -progress reporter will wait for at least @var{min-change} more -percents of the operation to be completed before printing next -message; the default is one percent. @var{min-time} specifies the -minimum time in seconds to pass between successive prints; the default -is 0.2 seconds. (On some operating systems, the progress reporter may -handle fractions of seconds with varying precision). +The arguments @var{min-change} and @var{min-time} control the rate of +echo area updates. The progress reporter will wait for at least +@var{min-change} more percents of the operation to be completed before +printing next message; the default is one percent. @var{min-time} +specifies the minimum time in seconds to pass between successive prints; +the default is 0.2 seconds. (On some operating systems, the progress +reporter may handle fractions of seconds with varying precision). + +If @var{context} is the symbol @code{async}, updates in the echo area +are inhibited when it is busy, i.e., if the function 'current-message' +returns non-nil. This function calls @code{progress-reporter-update}, so the first message is printed immediately. diff --git a/etc/NEWS b/etc/NEWS index cc853c0c1e3..d9904b7de7b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -3912,6 +3912,14 @@ called on progress steps, and DONE-CALLBACK, called when the progress reporter is done. See the 'make-progress-reporter' docstring for a full specification of these new optional arguments. ++++ +** Progress reporter context. +'make-progress-reporter' now accepts the optional argument CONTEXT, +which if it is the symbol 'async', inhibits updates in the echo area +when it is busy, i.e., if the function 'current-message' returns +non-nil. This is useful, for example, if you want to monitor progress +of an inherently asynchronous command such as 'compile'. + ** Binary format specifications '%b' and '%B' added. These produce the binary representation of a number. '%#b' and '%#B' prefix the bits with '0b' and '0B', respectively. diff --git a/lisp/subr.el b/lisp/subr.el index 63c3e8b8684..4c8518ec68c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -7007,7 +7007,8 @@ nothing." (progress-reporter-do-update reporter value suffix))) (defun make-progress-reporter (message &optional min-value max-value - current-value min-change min-time) + current-value min-change min-time + context) "Return progress reporter object for use with `progress-reporter-update'. MESSAGE is shown in the echo area, with a status indicator @@ -7034,7 +7035,11 @@ and/or MAX-VALUE are nil. Optional MIN-TIME specifies the minimum interval time between echo area updates (default is 0.2 seconds.) If the OS is not capable of measuring fractions of seconds, this parameter is -effectively rounded up." +effectively rounded up. + +Optional CONTEXT is consulted by back ends before showing progress +updates. If the symbol `async', echo area progress reports may be +inhibited if the echo area is busy." (when (string-match "[[:alnum:]]\\'" message) (setq message (concat message "..."))) (unless min-time @@ -7049,7 +7054,9 @@ effectively rounded up." (if min-change (max (min min-change 50) 1) 1) min-time ;; SUFFIX - nil)))) + nil + ;; + context)))) ;; Force a call to `message' now. (progress-reporter-update reporter (or current-value min-value)) reporter)) @@ -7060,6 +7067,10 @@ effectively rounded up." "Return REPORTER's text." (aref (cdr reporter) 3)) +(defun progress-reporter-context (reporter) + "Return REPORTER's context." + (aref (cdr reporter) 7)) + (defun progress-reporter-force-update (reporter &optional value new-message suffix) "Report progress of an operation in the echo area unconditionally. @@ -7078,20 +7089,26 @@ NEW-MESSAGE, if non-nil, sets a new message for the reporter." (defun progress-reporter-echo-area (reporter state) "Progress reporter echo area update function. REPORTER and STATE are the same as in -`progress-reporter-update-functions'." +`progress-reporter-update-functions'. + +Do not emit a message if the reporter context is `async' and the echo +area is busy with something else." (let ((text (progress-reporter-text reporter))) - (pcase state - ((pred floatp) - (if (plusp state) - (message "%s%d%%" text (* state 100.0)) - (message "%s" text))) - ((pred integerp) - (let ((message-log-max nil) - (pulse-char (aref progress-reporter--pulse-characters - state))) - (message "%s %s" text pulse-char))) - ('done - (message "%sdone" text))))) + (unless (and (eq (progress-reporter-context reporter) 'async) + (current-message) + (not (string-prefix-p text (current-message)))) + (pcase state + ((pred floatp) + (if (plusp state) + (message "%s%d%%" text (* state 100.0)) + (message "%s" text))) + ((pred integerp) + (let ((message-log-max nil) + (pulse-char (aref progress-reporter--pulse-characters + state))) + (message "%s %s" text pulse-char))) + ('done + (message "%sdone" text)))))) (defun progress-reporter-do-update (reporter value &optional suffix) (let* ((parameters (cdr reporter))