[Emacs-diffs] master f81b812: Let untarring (and hence package installation) go faster (Bug#35909)

[Noam Postavsky]

branch: master
commit f81b812d75d33a7d24c8c0f46455bde9a7ee6840
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    Let untarring (and hence package installation) go faster (Bug#35909)
    
    * lisp/subr.el (progress-reporter-update)
    (progress-reporter-force-update, progress-reporter-do-update): Accept
    new optional argument, SUFFIX.
    * doc/lispref/display.texi (Progress): Document it.
    * etc/NEWS: Announce it.
    * lisp/tar-mode.el (tar-untar-buffer): Use a progress reporter instead
    of calling message.  Suppress message from write-region.  Let-bind
    write-region-inhibit-fsync to t.
---
 doc/lispref/display.texi | 11 ++++++++---
 etc/NEWS                 |  4 ++++
 lisp/subr.el             | 49 ++++++++++++++++++++++++++++++------------------
 lisp/tar-mode.el         | 13 ++++++++-----
 4 files changed, 51 insertions(+), 26 deletions(-)

diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi
index a2ed4b3..95985ea 100644
--- a/doc/lispref/display.texi
+++ b/doc/lispref/display.texi
@@ -426,7 +426,7 @@ This function calls @code{progress-reporter-update}, so the 
first
 message is printed immediately.
 @end defun
 
address@hidden progress-reporter-update reporter &optional value
address@hidden progress-reporter-update reporter &optional value suffix
 This function does the main work of reporting progress of your
 operation.  It displays the message of @var{reporter}, followed by
 progress percentage determined by @var{value}.  If percentage is zero,
@@ -440,6 +440,11 @@ state of your operation and must be between 
@var{min-value} and
 @code{make-progress-reporter}.  For instance, if you scan a buffer,
 then @var{value} should be the result of a call to @code{point}.
 
+Optional argument @var{suffix} is a string to be displayed after
address@hidden's main message and progress text.  If @var{reporter} is
+a non-numerical reporter, then @var{value} should be @code{nil}, or a
+string to use instead of @var{suffix}.
+
 This function respects @var{min-change} and @var{min-time} as passed
 to @code{make-progress-reporter} and so does not output new messages
 on every invocation.  It is thus very fast and normally you should not
@@ -447,11 +452,11 @@ try to reduce the number of calls to it: resulting 
overhead will most
 likely negate your effort.
 @end defun
 
address@hidden progress-reporter-force-update reporter &optional value 
new-message
address@hidden progress-reporter-force-update reporter &optional value 
new-message suffix
 This function is similar to @code{progress-reporter-update} except
 that it prints a message in the echo area unconditionally.
 
-The first two arguments have the same meaning as for
address@hidden, @var{value}, and @var{suffix} have the same meaning as for
 @code{progress-reporter-update}.  Optional @var{new-message} allows
 you to change the message of the @var{reporter}.  Since this function
 always updates the echo area, such a change will be immediately
diff --git a/etc/NEWS b/etc/NEWS
index 980f512..d123952 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -370,6 +370,10 @@ in tooltips, as it is not useful there.
 There are 2 new buffer local variables and 1 face to customize this
 mode they are described in the manual "(emacs) Display".
 
++++
+** 'progress-reporter-update' accepts a suffix string to display.
+
+
 
 * Editing Changes in Emacs 27.1
 
diff --git a/lisp/subr.el b/lisp/subr.el
index fd60ec8..73031a2 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -5036,7 +5036,8 @@ to deactivate this transient map, regardless of 
KEEP-PRED."
 ;;                           MAX-VALUE
 ;;                           MESSAGE
 ;;                           MIN-CHANGE
-;;                           MIN-TIME])
+;;                            MIN-TIME
+;;                            MESSAGE-SUFFIX])
 ;;
 ;; This weirdness is for optimization reasons: we want
 ;; `progress-reporter-update' to be as fast as possible, so
@@ -5046,7 +5047,7 @@ to deactivate this transient map, regardless of 
KEEP-PRED."
 ;; digits of precision, it doesn't really matter here.  On the other
 ;; hand, it greatly simplifies the code.
 
-(defsubst progress-reporter-update (reporter &optional value)
+(defsubst progress-reporter-update (reporter &optional value suffix)
   "Report progress of an operation in the echo area.
 REPORTER should be the result of a call to `make-progress-reporter'.
 
@@ -5055,14 +5056,17 @@ If REPORTER is a numerical progress reporter---i.e. if 
it was
  `make-progress-reporter'---then VALUE should be a number between
  MIN-VALUE and MAX-VALUE.
 
-If REPORTER is a non-numerical reporter, VALUE should be nil.
+Optional argument SUFFIX is a string to be displayed after
+REPORTER's main message and progress text.  If REPORTER is a
+non-numerical reporter, then VALUE should be nil, or a string to
+use instead of SUFFIX.
 
 This function is relatively inexpensive.  If the change since
 last update is too small or insufficient time has passed, it does
 nothing."
   (when (or (not (numberp value))      ; For pulsing reporter
            (>= value (car reporter))) ; For numerical reporter
-    (progress-reporter-do-update reporter value)))
+    (progress-reporter-do-update reporter value suffix)))
 
 (defun make-progress-reporter (message &optional min-value max-value
                                       current-value min-change min-time)
@@ -5106,26 +5110,28 @@ effectively rounded up."
                       max-value
                       message
                       (if min-change (max (min min-change 50) 1) 1)
-                      min-time))))
+                       min-time
+                       ;; SUFFIX
+                       nil))))
     (progress-reporter-update reporter (or current-value min-value))
     reporter))
 
-(defun progress-reporter-force-update (reporter &optional value new-message)
+(defun progress-reporter-force-update (reporter &optional value new-message 
suffix)
   "Report progress of an operation in the echo area unconditionally.
 
-The first two arguments are the same as in `progress-reporter-update'.
+REPORTER, VALUE, and SUFFIX are the same as in `progress-reporter-update'.
 NEW-MESSAGE, if non-nil, sets a new message for the reporter."
   (let ((parameters (cdr reporter)))
     (when new-message
       (aset parameters 3 new-message))
     (when (aref parameters 0)
       (aset parameters 0 (float-time)))
-    (progress-reporter-do-update reporter value)))
+    (progress-reporter-do-update reporter value suffix)))
 
 (defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
   "Characters to use for pulsing progress reporters.")
 
-(defun progress-reporter-do-update (reporter value)
+(defun progress-reporter-do-update (reporter value &optional suffix)
   (let* ((parameters   (cdr reporter))
         (update-time  (aref parameters 0))
         (min-value    (aref parameters 1))
@@ -5160,18 +5166,25 @@ NEW-MESSAGE, if non-nil, sets a new message for the 
reporter."
               (setcar reporter (ceiling (car reporter))))
             ;; Only print message if enough time has passed
             (when enough-time-passed
-              (if (> percentage 0)
-                  (message "%s%d%%" text percentage)
-                (message "%s" text)))))
+               (if suffix
+                   (aset parameters 6 suffix)
+                 (setq suffix (or (aref parameters 6) "")))
+               (if (> percentage 0)
+                   (message "%s%d%% %s" text percentage suffix)
+                 (message "%s %s" text suffix)))))
          ;; Pulsing indicator
          (enough-time-passed
-          (let ((index (mod (1+ (car reporter)) 4))
-                (message-log-max nil))
+           (when (and value (not suffix))
+             (setq suffix value))
+           (if suffix
+               (aset parameters 6 suffix)
+             (setq suffix (or (aref parameters 6) "")))
+           (let* ((index (mod (1+ (car reporter)) 4))
+                  (message-log-max nil)
+                  (pulse-char (aref progress-reporter--pulse-characters
+                                    index)))
             (setcar reporter index)
-            (message "%s %s"
-                     text
-                     (aref progress-reporter--pulse-characters
-                           index)))))))
+             (message "%s %s %s" text pulse-char suffix))))))
 
 (defun progress-reporter-done (reporter)
   "Print reporter's message followed by word \"done\" in echo area."
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
index 599da9a..7ff31ff 100644
--- a/lisp/tar-mode.el
+++ b/lisp/tar-mode.el
@@ -523,7 +523,8 @@ MODE should be an integer which is a file mode value."
   "Extract all archive members in the tar-file into the current directory."
   (interactive)
   ;; FIXME: make it work even if we're not in tar-mode.
-  (let ((descriptors tar-parse-info))   ;Read the var in its buffer.
+  (let ((descriptors tar-parse-info)    ;Read the var in its buffer.
+        (reporter (make-progress-reporter "Extracting")))
     (with-current-buffer
         (if (tar-data-swapped-p) tar-data-buffer (current-buffer))
       (set-buffer-multibyte nil)          ;Hopefully, a no-op.
@@ -536,17 +537,19 @@ MODE should be an integer which is a file mode value."
                (start (tar-header-data-start descriptor))
                (end (+ start (tar-header-size descriptor))))
           (unless (file-directory-p name)
-            (message "Extracting %s" name)
+            (progress-reporter-update reporter name)
             (if (and dir (not (file-exists-p dir)))
                 (make-directory dir t))
             (unless (file-directory-p name)
-             (let ((coding-system-for-write 'no-conversion))
+              (let ((coding-system-for-write 'no-conversion)
+                    (write-region-inhibit-fsync t))
                 (when link-desc
                   (lwarn '(tar link) :warning
                          "Extracted `%s', %s, as a normal file"
                          name link-desc))
-               (write-region start end name)))
-            (set-file-modes name (tar-header-mode descriptor))))))))
+                (write-region start end name nil :nomessage)))
+            (set-file-modes name (tar-header-mode descriptor)))))
+      (progress-reporter-done reporter))))
 
 (defun tar-summarize-buffer ()
   "Parse the contents of the tar file in the current buffer."