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

@@ -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.

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.

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))