simple patch for `etags.el'

simple patch for `etags.el'

[Paul Pogonyshev]

This patch speeds building of tags table completion up several
times.

The best way to check: `M-x tags-reset-tags-tables', then kill
all `TAGS' buffers, then type `M-. TAB'.  Repeat for original
and patched versions.  If you test on a large tags table (e.g.
`emacs/src/TAGS'), the difference in speed will be obvious.

Paul

P.S. I assigned copyright to FSF.


2004-09-20  Paul Pogonyshev  <pogonyshev@gmx.net>

	* progmodes/etags.el (etags-tags-completion-table): Report
	progress percentage only when it changes (speedup).


--- etags.el	28 Aug 2004 13:30:31 -0200	1.181
+++ etags.el	20 Sep 2004 16:44:09 -0200	
@@ -1230,6 +1230,7 @@ where they were found."
 (defun etags-tags-completion-table ()
   (let ((table (make-vector 511 0))
 	(point-max (/ (float (point-max)) 100.0))
+	(next-notch 0)
 	(msg-fmt (format 
 		  "Making tags completion table for %s...%%d%%%%"
 		  buffer-file-name)))
@@ -1253,7 +1254,14 @@ where they were found."
 			   (buffer-substring (match-beginning 5) (match-end 5))
 			 ;; No explicit tag name.  Best guess.
 			 (buffer-substring (match-beginning 3) (match-end 3)))
-		  (message msg-fmt (/ (point) point-max)))
+		  ;; Only report progress percentage when it changes.
+		  ;; Otherwise, this function spends most of the time
+		  ;; somewhere in `(message ...)' form.
+		  (when (>= (point) next-notch)
+		    (let ((percentage (truncate (/ (point) point-max))))
+		      (message msg-fmt percentage)
+		      (setq next-notch (ceiling (* (1+ percentage)
+						   point-max))))))
 		table)))
     table))
 

Re: simple patch for `etags.el'

[Paul Pogonyshev]

I wrote:

> This patch speeds building of tags table completion up several
> times.

Better yet, how about generalizing progress reporting
between modules?  For instance, it could look like this...


(defun make-progress-reporter (format-string
			       min-value max-value &optional current-value)
  "Return a list suitable for reporting operation progress with `progress-reporter-update'.

FORMAT-STRING must contain a single %-sequence, `%d', which will
be substituted with the progress percentage.  If, for some
reason, you need to change this string, simply create a new
reporter.

MIN-VALUE and MAX-VALUE designate starting (0% complete) and
final (100% complete) states of operation.  Optional
CURRENT-VALUE specifies the progress by the moment you call this
function.  You should omit it in most cases."
  (let ((reporter (list min-value
			(if (fboundp 'current-time) (list 0 0 0) nil)
			min-value
			(/ (float (- max-value min-value)) 100.0)
			format-string)))
    (progress-reporter-update reporter (or current-value min-value))
    reporter))

(defun progress-reporter-update (reporter value)
  "Report progress of an operation in the minibuffer.

First parameter, REPORTER, should be the result of a call to
`make-progress-reporter'.  Second, VALUE, determines the actual
progress of operation; it must be between MIN-VALUE and MAX-VALUE
as passed to `make-progress-reporter'.

This function tries to be very inexpensive.  If Emacs has
`current-time' function, then it will update minibuffer at most 5
times a second.  In any case, it never prints same percentage
more than once."
  (when (and (>= value (car reporter))
	     ;; Update time is nil if we don't have `current-time'
	     ;; function anyway.
	     (or (null (cadr reporter))
		 (let ((update-time  (cadr reporter))
		       (current-time (current-time)))
		   (when (and (>= (nth 1 current-time) (nth 1 update-time))
			      (>= (nth 2 current-time) (nth 2 update-time))
			      (>= (nth 0 current-time) (nth 0 update-time)))
		     ;; Compute the time of next update as now + 1/5
		     ;; of a second.
		     (setcar (cddr current-time)
			     (if (< (nth 2 current-time) 800000)
				 (+ (nth 2 current-time) 200000)
			       (when (= (setcar (cdr current-time)
						(1+ (nth 1 current-time)))
					0)
				 (setcar current-time (1+ (car current-time))))
			       (- (nth 2 current-time) 800000)))
		     (setcar (cdr reporter) current-time)))))
    (let* ((min-value   (nth 2 reporter))
	   (one-percent (nth 3 reporter))
	   (percentage  (truncate (/ (- value min-value) one-percent))))
      (message (nth 4 reporter) percentage)
      ;; Make sure we return as soon as possible from this function
      ;; anything until progress percentage changes.
      (setcar reporter (+ min-value (* (1+ percentage) one-percent)))
      (when (integerp value)
	(setcar reporter (ceiling (car reporter)))))))
		     

--- etags.el	28 Aug 2004 13:30:31 -0200	1.181
+++ etags.el	20 Sep 2004 23:25:01 -0200	
@@ -1229,10 +1229,11 @@ where they were found."
 
 (defun etags-tags-completion-table ()
   (let ((table (make-vector 511 0))
-	(point-max (/ (float (point-max)) 100.0))
-	(msg-fmt (format 
-		  "Making tags completion table for %s...%%d%%%%"
-		  buffer-file-name)))
+	(progress-reporter
+	 (make-progress-reporter
+	  (format "Making tags completion table for %s...%%d%%%%"
+		  buffer-file-name)
+	  (point-min) (point-max))))
     (save-excursion
       (goto-char (point-min))
       ;; This monster regexp matches an etags tag line.
@@ -1253,7 +1254,7 @@ where they were found."
 			   (buffer-substring (match-beginning 5) (match-end 5))
 			 ;; No explicit tag name.  Best guess.
 			 (buffer-substring (match-beginning 3) (match-end 3)))
-		  (message msg-fmt (/ (point) point-max)))
+		  (progress-reporter-update progress-reporter (point)))
 		table)))
     table))
 

Re: simple patch for `etags.el'

[Paul Pogonyshev]

> I wrote:
> > I wrote:
> > > This patch speeds building of tags table completion up several
> > > times.
> >
> > Better yet, how about generalizing progress reporting
> > between modules?  For instance, it could look like this...
>
> Or even better, like this.  Timing showed that it is cheaper
> to not use `current-time'.  Also simpler a lot.
>
> Paul
>
>
> (defun make-progress-reporter (format-string
>                                min-value max-value &optional current-value)
>   "Return a list suitable for reporting operation progress with
> `progress-reporter-update'.
>
> FORMAT-STRING must contain a single %-sequence, `%d', which will
> be substituted with the progress percentage.  If, for some
> reason, you need to change this string, simply create a new
> reporter.
>
> MIN-VALUE and MAX-VALUE designate starting (0% complete) and
> final (100% complete) states of operation.  Optional
> CURRENT-VALUE specifies the progress by the moment you call this
> function.  You should omit it in most cases."
>   (let ((reporter (list min-value ;; Force a call to `message' now.
>                         min-value
>                         (/ (float (- max-value min-value)) 100.0)
>                         format-string)))
>     (progress-reporter-update reporter (or current-value min-value))
>     reporter))
>
> (defsubst progress-reporter-update (reporter value)
>   "Report progress of an operation in the minibuffer.
>
> First parameter, REPORTER, should be the result of a call to
> `make-progress-reporter'.  Second, VALUE, determines the actual
> progress of operation; it must be between MIN-VALUE and MAX-VALUE
> as passed to `make-progress-reporter'.
>
> This function is inexpensive.  It never prints same percentage
> more than once, so it will not call `message' more than 101 times
> in total during whole operation."
>   (when (>= value (car reporter))
>     (progress-reporter-do-update reporter value)))
>
> (defun progress-reporter-do-update (reporter value)
>   (let* ((min-value   (nth 1 reporter))
> 	 (one-percent (nth 2 reporter))
> 	 (percentage  (truncate (/ (- value min-value) one-percent))))
>     (message (nth 3 reporter) percentage)
>     (setcar reporter (+ min-value (* (1+ percentage) one-percent)))
>     (when (integerp value)
>       (setcar reporter (ceiling (car reporter)))))))

Re: simple patch for `etags.el'

[Richard Stallman]

    (defun make-progress-reporter (format-string
				   min-value max-value &optional current-value)

This could be a useful feature.  I think there should be arguments
MIN-CHANGE and MIN-TIME to specify how often to redisplay the
percentage--for instance, I could specify 5 for MIN-CHANGE meaning "no
less than 5% change", or 1.0 for MIN-TIME meaning no more than once
per second.

Aside from that, it looks clear, but there needs to be an explanation
of the detailed format of the format of the `reporter' data structure.


These functions would go in subr.el.

Re: simple patch for `etags.el'

[Paul Pogonyshev]

> These functions would go in subr.el.

Here is the patch.  I rewrote it almost from scratch.

* Very fast.

* Used time handling as suggested by Kim F. Storm (i.e. cheap time
  handling).  I also used `float-time' instead of `current-time' to
  simplify code.

* Added MIN-CHANGE and MIN-TIME as suggested by RMS.

* New functions `progress-reporter-force-update' and
  `progress-reporter-done'.  Now you don't need to duplicate
  strings: all needed messages can be printed with progress
  reporter.

* Reporter structure is documented (in comments).

I'd like to move progress reporting in `cc-cmds.el' to new
functions, but it is very complicated.  Maybe someone who
is familiar with the code can do it.

Also, is it common in English not to put a space after ellipsis?
I.e. in Russian I'd write ``Parsing tar file... done'' instead of
``Parsing tar file...done''.


2004-09-22  Paul Pogonyshev  <pogonyshev@gmx.net>

	* tar-mode.el (tar-summarize-buffer): Use progress reporter.

	* progmodes/etags.el (etags-tags-completion-table): Use progress
	reporter.
	(etags-tags-apropos): Likewise.

	* subr.el (make-progress-reporter, progress-reporter-update)
	(progress-reporter-force-update, progress-reporter-do-update)
	(progress-reporter-done): New functions.


Unfortunately, I'm experiencing severe problems with my internet
connections over certain ports.  In particular, I cannot use CVS
lately.  So here are patches to the three files as generated by
`C-x v ='.  I hope it's not much of a problem to combine them.


--- subr.el	08 Sep 2004 10:24:29 -0200	1.407
+++ subr.el	22 Sep 2004 21:52:47 -0200	
@@ -2644,5 +2644,134 @@ The properties used on SYMBOL are `compo
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
 
+ 
+;; Standardized progress reporting
+
+;; Progress reporter has the following structure:
+;;
+;;	(NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
+;;			      MIN-VALUE
+;;			      MAX-VALUE
+;;			      MESSAGE
+;;			      MIN-CHANGE
+;;			      MIN-TIME])
+;;
+;; This weirdeness is for optimization reasons: we want
+;; `progress-reporter-update' to be as fast as possible, so
+;; `(car reporter)' is better than `(aref reporter 0)'.
+;;
+;; NEXT-UPDATE-TIME is a float.  While `float-time' loses a couple
+;; digits of precision, it doesn't really matter here.  On the other
+;; hand, it greatly simplifies the code.
+
+(defun make-progress-reporter (message min-value max-value
+				       &optional current-value
+				       min-change min-time)
+  "Return an object suitable for reporting operation progress with `progress-reporter-update'.
+
+MESSAGE is shown in the minibuffer.  When at least 1% of
+operation is complete, the exact percentage will be appended to
+the MESSAGE.  When you call `progress-reporter-done', word
+\"done\" is printed after the MESSAGE.  You can change MESSAGE of
+an existing progress reporter with
+`progress-reporter-force-update'.
+
+MIN-VALUE and MAX-VALUE designate starting (0% complete) and
+final (100% complete) states of operation.  The latter should be
+larger; if this is not the case, then simply negate all values.
+Optional CURRENT-VALUE specifies the progress by the moment you
+call this function.  You should omit it or set it to nil in most
+cases since it defaults to MIN-VALUE.
+
+Optional MIN-CHANGE determines the minimal change in percents to
+report (default is 1%.)  Optional MIN-TIME specifies the minimal
+time before minibuffer updates (default is 0.2 seconds.)  If
+`current-time' function is not present, then time is not tracked
+at all.  If OS is not capable of measuring fractions of seconds,
+then this parameter is effectively rounded up."
+
+  (unless min-time
+    (setq min-time 0.2))
+  (let ((reporter
+	 (cons min-value ;; Force a call to `message' now
+	       (vector (if (and (fboundp 'float-time)
+				(>= min-time 0.02))
+			   (float-time) nil)
+		       min-value
+		       max-value
+		       message
+		       (if min-change (max (min min-change 50) 1) 1)
+		       min-time))))
+    (progress-reporter-update reporter (or current-value min-value))
+    reporter))
+
+(defsubst progress-reporter-update (reporter value)
+  "Report progress of an operation in the minibuffer.
+However, if the change since last minibuffer update is too small
+or not enough time has passed, then do nothing (see
+`make-progress-reporter' for details).
+
+First parameter, REPORTER, should be the result of a call to
+`make-progress-reporter'.  Second, VALUE, determines the actual
+progress of operation; it must be between MIN-VALUE and MAX-VALUE
+as passed to `make-progress-reporter'.
+
+This function is very inexpensive, you may not bother how often
+you call it."
+  (when (>= value (car reporter))
+    (progress-reporter-do-update reporter value)))
+
+(defun progress-reporter-force-update (reporter value &optional new-message)
+  "Report progress of an operation in the minibuffer unconditionally.
+
+First two parameters are the same as for
+`progress-reporter-update'.  Optional NEW-MESSAGE allows you to
+change the displayed message."
+  (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)))
+
+(defun progress-reporter-do-update (reporter value)
+  (let* ((parameters   (cdr reporter))
+	 (min-value    (aref parameters 1))
+	 (max-value    (aref parameters 2))
+	 (one-percent  (/ (- max-value min-value) 100.0))
+	 (percentage   (truncate (/ (- value min-value) one-percent)))
+	 (update-time  (aref parameters 0))
+	 (current-time (float-time))
+	 (enough-time-passed
+	  ;; See if enough time has passed since the last update.
+	  (or (not update-time)
+	      (when (>= current-time update-time)
+		;; Calculate time for the next update
+		(aset parameters 0 (+ update-time (aref parameters 5)))))))
+    ;;
+    ;; Calculate NEXT-UPDATE-VALUE.  If we are not going to print
+    ;; message this time because not enough time has passed, then use
+    ;; 1 instead of MIN-CHANGE.  This makes delays between minibuffer
+    ;; updates closer to MIN-TIME.
+    (setcar reporter
+	    (min (+ min-value (* (+ percentage
+				    (if enough-time-passed
+					(aref parameters 4) ;; MIN-CHANGE
+				      1))
+				 one-percent))
+		 max-value))
+    (when (integerp value)
+      (setcar reporter (ceiling (car reporter))))
+    ;;
+    ;; Only print message if enough time has passed
+    (when enough-time-passed
+      (if (> percentage 0)
+	  (message "%s%d%%" (aref parameters 3) percentage)
+	(message "%s" (aref parameters 3))))))
+
+(defun progress-reporter-done (reporter)
+  "Print reporter's message followed by word \"done\" in minibuffer."
+  (message "%sdone" (aref (cdr reporter) 3)))
+
 ;;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
 ;;; subr.el ends here



--- etags.el	28 Aug 2004 13:30:31 -0200	1.181
+++ etags.el	22 Sep 2004 21:30:55 -0200	
@@ -1229,10 +1229,10 @@ where they were found."
 
 (defun etags-tags-completion-table ()
   (let ((table (make-vector 511 0))
-	(point-max (/ (float (point-max)) 100.0))
-	(msg-fmt (format 
-		  "Making tags completion table for %s...%%d%%%%"
-		  buffer-file-name)))
+	(progress-reporter
+	 (make-progress-reporter
+	  (format "Making tags completion table for %s..." buffer-file-name)
+	  (point-min) (point-max))))
     (save-excursion
       (goto-char (point-min))
       ;; This monster regexp matches an etags tag line.
@@ -1253,7 +1253,7 @@ where they were found."
 			   (buffer-substring (match-beginning 5) (match-end 5))
 			 ;; No explicit tag name.  Best guess.
 			 (buffer-substring (match-beginning 3) (match-end 3)))
-		  (message msg-fmt (/ (point) point-max)))
+		  (progress-reporter-update progress-reporter (point)))
 		table)))
     table))
 
@@ -1433,11 +1433,12 @@ where they were found."
     (tags-with-face 'highlight (princ buffer-file-name))
     (princ "':\n\n"))
   (goto-char (point-min))
-  (let ((point-max (/ (float (point-max)) 100.0)))
+  (let ((progress-reporter (make-progress-reporter
+			    (format "Making tags apropos buffer for `%s'..."
+				    string)
+			    (point-min) (point-max))))
     (while (re-search-forward string nil t)
-      (message "Making tags apropos buffer for `%s'...%d%%"
-	       string
-	       (/ (point) point-max))
+      (progress-reporter-update progress-reporter (point))
       (beginning-of-line)
 
       (let* ( ;; Get the local value in the tags table



--- tar-mode.el	09 Feb 2004 03:47:32 -0200	1.95
+++ tar-mode.el	22 Sep 2004 21:42:29 -0200	
@@ -404,11 +404,10 @@ Place a dired-like listing on the front;
 then narrow to it, so that only that listing
 is visible (and the real data of the buffer is hidden)."
   (set-buffer-multibyte nil)
-  (message "Parsing tar file...")
   (let* ((result '())
 	 (pos (point-min))
-	 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
-	 (bs100 (max 1 (/ bs 100)))
+	 (progress-reporter "Parsing tar file..."
+			    (point-min) (max 1 (- (buffer-size) 1024)))
 	 tokens)
     (while (and (<= (+ pos 512) (point-max))
 		(not (eq 'empty-tar-block
@@ -416,10 +415,7 @@ is visible (and the real data of the buf
 			       (tar-header-block-tokenize
 				(buffer-substring pos (+ pos 512)))))))
       (setq pos (+ pos 512))
-      (message "Parsing tar file...%d%%"
-	       ;(/ (* pos 100) bs)   ; this gets round-off lossage
-	       (/ pos bs100)         ; this doesn't
-	       )
+      (progress-reporter-update progress-reporter pos)
       (if (eq (tar-header-link-type tokens) 20)
 	  ;; Foo.  There's an extra empty block after these.
 	  (setq pos (+ pos 512)))
@@ -446,7 +442,7 @@ is visible (and the real data of the buf
     ;; A tar file should end with a block or two of nulls,
     ;; but let's not get a fatal error if it doesn't.
     (if (eq tokens 'empty-tar-block)
-	(message "Parsing tar file...done")
+	(progress-reporter-done progress-reporter)
       (message "Warning: premature EOF parsing tar file")))
   (save-excursion
     (goto-char (point-min))

Re: simple patch for `etags.el'

[Richard Stallman]

It looks good.

To install it, we need the text for etc/NEWS and for the manual.

Re: simple patch for `etags.el'

[Paul Pogonyshev]

RMS wrote:

> It looks good.
>
> To install it, we need the text for etc/NEWS and for the manual.

Here is the patch rediffed together with new manual node.  I also
tweaked comments in `subr.el' as I have suddenly discovered that
minibuffer is not the same as echo area.

My problems with CVS are still present, so the patch is made ``by
hands.''

A news entry could look like this (to go to ``Lisp Changes''):

+++
** New functions `make-progress-reporter', `progress-reporter-update',
`progress-reporter-force-update' and `progress-reporter-done' provide
a simple and efficient way of printing progress messages to the user.

Change log entry for `lisp/ChangeLog':

2004-09-24  Paul Pogonyshev  <pogonyshev@gmx.net>

	* tar-mode.el (tar-summarize-buffer): Use progress reporter.

	* progmodes/etags.el (etags-tags-completion-table): Use progress
	reporter.
	(etags-tags-apropos): Likewise.

	* subr.el (make-progress-reporter, progress-reporter-update)
 	(progress-reporter-force-update, progress-reporter-do-update)
 	(progress-reporter-done): New functions.

Change log entry for `lispref/ChangeLog':

2004-09-24  Paul Pogonyshev  <pogonyshev@gmx.net>

	* display.texi (Progress): New node.




--- lispref/display.texi.~1.124.~	2004-07-17 12:40:22.000000000 -0200
+++ lispref/display.texi	2004-09-24 00:58:48.000000000 -0200
@@ -16,6 +16,7 @@ that Emacs presents to the user.
 * Truncation::          Folding or wrapping long text lines.
 * The Echo Area::       Where messages are displayed.
 * Warnings::            Displaying warning messages for the user.
+* Progress::            Informing user about progress of a long operation.
 * Invisible Text::      Hiding part of the buffer text.
 * Selective Display::   Hiding part of the buffer text (the old way).
 * Overlay Arrow::       Display of an arrow to indicate position.
@@ -530,7 +531,105 @@ symbols.  If it matches the first few el
 that warning is not logged.
 @end defopt
 
+@node Progress
+@section Operation Progress
+@cindex progress
+
+When an operation can take a while to finish, you should inform the
+user about the progress it makes.  This way the user can estimate
+remaining time and clearly see that Emacs is busy working, not hung.
+
+Functions listed in this section provide simple and efficient way of
+reporting operation progress.  Here is a working example that does
+nothing useful:
+
+@example
+(let ((progress-reporter
+       (make-progress-reporter "Collecting some mana for Emacs..."
+                               0  500)))
+  (dotimes (k 500)
+    (sit-for 0.01)
+    (progress-reporter-update progress-reporter k))
+  (progress-reporter-done progress-reporter))
+@end example
+
+@defun make-progress-reporter message min-value max-value &optional current-value min-change min-time
+This function creates a progress reporter---the object you will use as
+an argument for all other functions listed here.  The idea is to
+precompute as much data as possible to make progress reporting very
+fast.
+
+The @var{message} will be displayed in the echo area, followed by
+progress percentage.  @var{message} is treated as a simple string.  If
+you need it to depend on a filename, for instance, use @code{format}
+before calling this function.
+
+@var{min-value} and @var{max-value} arguments stand for starting and
+final states of your operation.  For instance, if you scan a buffer,
+they should be the results of @code{point-min} and @code{point-max}
+correspondingly.  It is required that @var{max-value} is greater than
+@var{min-value}.  If you create progress reporter when some part of
+the operation has already been completed, then specify
+@var{current-value} argument.  But normally you should omit it or set
+it to @code{nil}---it will default to @var{min-value} then.
+
+Remaining arguments control the rate of echo area updates.  Progress
+reporter will wait for at least @var{min-change} more percents of the
+operation to be completed before printing next message.
+@var{min-time} specifies the minimum time in seconds to pass between
+successive prints.  It can be fractional.  Depending on Emacs and
+system capabilities, progress reporter may or may not respect this
+last argument or do it with varying precision.  Default value for
+@var{min-change} is 1 (one percent), for @var{min-time}---0.2
+(seconds.)
+
+This function calls @code{progress-reporter-update}, so the first
+message is printed immediately.
+@end defun
+
+@defun progress-reporter-update reporter value
+This function does the main work of reporting progress of your
+operation.  It print the message of @var{reporter} followed by
+progress percentage determined by @var{value}.  If percentage is zero,
+then it is not printed at all.
+
+@var{reporter} must be the result of a call to
+@code{make-progress-reporter}.  @var{value} specifies the current
+state of your operation and must be between @var{min-value} and
+@var{max-value} (inclusive) as passed to
+@code{make-progress-reporter}.  For instance, if you scan a buffer,
+then @var{value} should be the result of a call to @code{point}.
+
+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
+try to reduce the number of calls to it: resulting overhead will most
+likely negate your effort.
+@end defun
+
+@defun progress-reporter-force-update reporter value &optional new-message
+This function is similar to @code{progress-reporter-update} except
+that it prints a message in the echo area unconditionally.
+
+First two arguments has 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 functions
+always updates the echo area, such a change will be immediately
+presented to the user.
+@end defun
+
+@defun progress-reporter-done reporter
+This function should be called when the operation is finished.  It
+prints the message of @var{reporter} followed by word ``done'' in the
+echo area.
+
+You should always call this function and not hope for
+@code{progress-reporter-update} to print ``100%.''  Firstly, it may
+never print it, there are many good reasons for this not to happen.
+Secondly, ``done'' is more explicit.
+@end defun
+
 @node Invisible Text
 @section Invisible Text
 
--- lisp/subr.el.~1.407.~	2004-09-08 10:24:29.000000000 -0200
+++ lisp/subr.el	2004-09-24 00:45:07.000000000 -0200
@@ -2644,5 +2644,133 @@ The properties used on SYMBOL are `compo
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
 
+ 
+;; Standardized progress reporting
+
+;; Progress reporter has the following structure:
+;;
+;;	(NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
+;;			      MIN-VALUE
+;;			      MAX-VALUE
+;;			      MESSAGE
+;;			      MIN-CHANGE
+;;			      MIN-TIME])
+;;
+;; This weirdeness is for optimization reasons: we want
+;; `progress-reporter-update' to be as fast as possible, so
+;; `(car reporter)' is better than `(aref reporter 0)'.
+;;
+;; NEXT-UPDATE-TIME is a float.  While `float-time' loses a couple
+;; digits of precision, it doesn't really matter here.  On the other
+;; hand, it greatly simplifies the code.
+
+(defun make-progress-reporter (message min-value max-value
+				       &optional current-value
+				       min-change min-time)
+  "Return an object suitable for reporting operation progress with `progress-reporter-update'.
+
+MESSAGE is shown in the echo area.  When at least 1% of operation
+is complete, the exact percentage will be appended to the
+MESSAGE.  When you call `progress-reporter-done', word \"done\"
+is printed after the MESSAGE.  You can change MESSAGE of an
+existing progress reporter with `progress-reporter-force-update'.
+
+MIN-VALUE and MAX-VALUE designate starting (0% complete) and
+final (100% complete) states of operation.  The latter should be
+larger; if this is not the case, then simply negate all values.
+Optional CURRENT-VALUE specifies the progress by the moment you
+call this function.  You should omit it or set it to nil in most
+cases since it defaults to MIN-VALUE.
+
+Optional MIN-CHANGE determines the minimal change in percents to
+report (default is 1%.)  Optional MIN-TIME specifies the minimal
+time before echo area updates (default is 0.2 seconds.)  If
+`float-time' function is not present, then time is not tracked
+at all.  If OS is not capable of measuring fractions of seconds,
+then this parameter is effectively rounded up."
+
+  (unless min-time
+    (setq min-time 0.2))
+  (let ((reporter
+	 (cons min-value ;; Force a call to `message' now
+	       (vector (if (and (fboundp 'float-time)
+				(>= min-time 0.02))
+			   (float-time) nil)
+		       min-value
+		       max-value
+		       message
+		       (if min-change (max (min min-change 50) 1) 1)
+		       min-time))))
+    (progress-reporter-update reporter (or current-value min-value))
+    reporter))
+
+(defsubst progress-reporter-update (reporter value)
+  "Report progress of an operation in the echo area.
+However, if the change since last echo area update is too small
+or not enough time has passed, then do nothing (see
+`make-progress-reporter' for details).
+
+First parameter, REPORTER, should be the result of a call to
+`make-progress-reporter'.  Second, VALUE, determines the actual
+progress of operation; it must be between MIN-VALUE and MAX-VALUE
+as passed to `make-progress-reporter'.
+
+This function is very inexpensive, you may not bother how often
+you call it."
+  (when (>= value (car reporter))
+    (progress-reporter-do-update reporter value)))
+
+(defun progress-reporter-force-update (reporter value &optional new-message)
+  "Report progress of an operation in the echo area unconditionally.
+
+First two parameters are the same as for
+`progress-reporter-update'.  Optional NEW-MESSAGE allows you to
+change the displayed message."
+  (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)))
+
+(defun progress-reporter-do-update (reporter value)
+  (let* ((parameters   (cdr reporter))
+	 (min-value    (aref parameters 1))
+	 (max-value    (aref parameters 2))
+	 (one-percent  (/ (- max-value min-value) 100.0))
+	 (percentage   (truncate (/ (- value min-value) one-percent)))
+	 (update-time  (aref parameters 0))
+	 (current-time (float-time))
+	 (enough-time-passed
+	  ;; See if enough time has passed since the last update.
+	  (or (not update-time)
+	      (when (>= current-time update-time)
+		;; Calculate time for the next update
+		(aset parameters 0 (+ update-time (aref parameters 5)))))))
+    ;;
+    ;; Calculate NEXT-UPDATE-VALUE.  If we are not going to print
+    ;; message this time because not enough time has passed, then use
+    ;; 1 instead of MIN-CHANGE.  This makes delays between echo area
+    ;; updates closer to MIN-TIME.
+    (setcar reporter
+	    (min (+ min-value (* (+ percentage
+				    (if enough-time-passed
+					(aref parameters 4) ;; MIN-CHANGE
+				      1))
+				 one-percent))
+		 max-value))
+    (when (integerp value)
+      (setcar reporter (ceiling (car reporter))))
+    ;;
+    ;; Only print message if enough time has passed
+    (when enough-time-passed
+      (if (> percentage 0)
+	  (message "%s%d%%" (aref parameters 3) percentage)
+	(message "%s" (aref parameters 3))))))
+
+(defun progress-reporter-done (reporter)
+  "Print reporter's message followed by word \"done\" in echo area."
+  (message "%s%d%%" (aref (cdr reporter) 3) 20))
+
 ;;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
 ;;; subr.el ends here
--- lisp/tar-mode.el.~1.95.~	2004-02-09 03:47:32.000000000 -0200
+++ lisp/tar-mode.el	2004-09-22 21:42:29.000000000 -0200
@@ -404,11 +404,10 @@ Place a dired-like listing on the front;
 then narrow to it, so that only that listing
 is visible (and the real data of the buffer is hidden)."
   (set-buffer-multibyte nil)
-  (message "Parsing tar file...")
   (let* ((result '())
 	 (pos (point-min))
-	 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
-	 (bs100 (max 1 (/ bs 100)))
+	 (progress-reporter "Parsing tar file..."
+			    (point-min) (max 1 (- (buffer-size) 1024)))
 	 tokens)
     (while (and (<= (+ pos 512) (point-max))
 		(not (eq 'empty-tar-block
@@ -416,10 +415,7 @@ is visible (and the real data of the buf
 			       (tar-header-block-tokenize
 				(buffer-substring pos (+ pos 512)))))))
       (setq pos (+ pos 512))
-      (message "Parsing tar file...%d%%"
-	       ;(/ (* pos 100) bs)   ; this gets round-off lossage
-	       (/ pos bs100)         ; this doesn't
-	       )
+      (progress-reporter-update progress-reporter pos)
       (if (eq (tar-header-link-type tokens) 20)
 	  ;; Foo.  There's an extra empty block after these.
 	  (setq pos (+ pos 512)))
@@ -446,7 +442,7 @@ is visible (and the real data of the buf
     ;; A tar file should end with a block or two of nulls,
     ;; but let's not get a fatal error if it doesn't.
     (if (eq tokens 'empty-tar-block)
-	(message "Parsing tar file...done")
+	(progress-reporter-done progress-reporter)
       (message "Warning: premature EOF parsing tar file")))
   (save-excursion
     (goto-char (point-min))
--- lisp/progmodes/etags.el.~1.181.~	2004-08-28 13:30:31.000000000 -0200
+++ lisp/progmodes/etags.el	2004-09-22 21:30:55.000000000 -0200
@@ -1229,10 +1229,10 @@ where they were found."
 
 (defun etags-tags-completion-table ()
   (let ((table (make-vector 511 0))
-	(point-max (/ (float (point-max)) 100.0))
-	(msg-fmt (format 
-		  "Making tags completion table for %s...%%d%%%%"
-		  buffer-file-name)))
+	(progress-reporter
+	 (make-progress-reporter
+	  (format "Making tags completion table for %s..." buffer-file-name)
+	  (point-min) (point-max))))
     (save-excursion
       (goto-char (point-min))
       ;; This monster regexp matches an etags tag line.
@@ -1253,7 +1253,7 @@ where they were found."
 			   (buffer-substring (match-beginning 5) (match-end 5))
 			 ;; No explicit tag name.  Best guess.
 			 (buffer-substring (match-beginning 3) (match-end 3)))
-		  (message msg-fmt (/ (point) point-max)))
+		  (progress-reporter-update progress-reporter (point)))
 		table)))
     table))
 
@@ -1433,11 +1433,12 @@ where they were found."
     (tags-with-face 'highlight (princ buffer-file-name))
     (princ "':\n\n"))
   (goto-char (point-min))
-  (let ((point-max (/ (float (point-max)) 100.0)))
+  (let ((progress-reporter (make-progress-reporter
+			    (format "Making tags apropos buffer for `%s'..."
+				    string)
+			    (point-min) (point-max))))
     (while (re-search-forward string nil t)
-      (message "Making tags apropos buffer for `%s'...%d%%"
-	       string
-	       (/ (point) point-max))
+      (progress-reporter-update progress-reporter (point))
       (beginning-of-line)
 
       (let* ( ;; Get the local value in the tags table

Re: simple patch for `etags.el'

[Richard Stallman]

Even better, how about not updating the percentage more than once
per second?

Re: simple patch for `etags.el'

[Paul Pogonyshev]

Richard Stallman wrote:

> Even better, how about not updating the percentage more than once
> per second?

This turned out not to be better.  Overhead caused by time
fetching and comparisons is not worth the gain.  When
percentage is printed whenever it changes, `message' is
called at most 101 times and that is cheap.  Note that 101
is a constant, while the number of constraint evaluations
is practically not limited.

So I suggest not bothering with time.  It is faster, gives
much simpler code and, finally, once per second is still to 
rarely, at least to my tastes.

Can you give a suggestion of where to place the new
functions?  Then I can produce a complete patch.

Paul

Re: simple patch for `etags.el'

[Kim F. Storm]

Paul Pogonyshev <pogonyshev@gmx.net> writes:

> Richard Stallman wrote:
>
>> Even better, how about not updating the percentage more than once
>> per second?
>
> This turned out not to be better.  Overhead caused by time
> fetching and comparisons is not worth the gain.  When
> percentage is printed whenever it changes, `message' is
> called at most 101 times and that is cheap.  Note that 101
> is a constant, while the number of constraint evaluations
> is practically not limited.

You could do the time check only when you are about to call message,
ie. a max of 101 times.

>
> So I suggest not bothering with time.  It is faster, gives
> much simpler code and, finally, once per second is still to 
> rarely, at least to my tastes.

Probably -- but a default period of 0.2 seconds would be ok.

-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: simple patch for `etags.el'

[Paul Pogonyshev]

> Paul Pogonyshev <pogonyshev@gmx.net> writes:
> > Richard Stallman wrote:
> >> Even better, how about not updating the percentage more than once
> >> per second?
> >
> > This turned out not to be better.  Overhead caused by time
> > fetching and comparisons is not worth the gain.  When
> > percentage is printed whenever it changes, `message' is
> > called at most 101 times and that is cheap.  Note that 101
> > is a constant, while the number of constraint evaluations
> > is practically not limited.
>
> You could do the time check only when you are about to call message,
> ie. a max of 101 times.

No, it is not a max of 101 times.  Consider this:

TIME	PERCENTAGE	SHOWING?	COMMENT
0.00	0%		YES		now delaying till at least 1% and 0.20 seconds
0.01	0%		NO
0.02	1%		NO		but evaluating time constraint
0.03	1%		NO		--"--
0.04	1%		NO		--"--
...

In other words it is max of 101 times that time constraint
will be evaluated and passed.  Number of evaluations that
yield nil is virtually no limited.

Actually, my patch did just this:

	(when (and (reached-next-percentage)
		   (enough-time-has-passed))

but it is slower than just

	(when (reached-next-percentage)

> > So I suggest not bothering with time.  It is faster, gives
> > much simpler code and, finally, once per second is still to
> > rarely, at least to my tastes.
>
> Probably -- but a default period of 0.2 seconds would be ok.

It is OK, but slower.  I posted two versions of `progress-reporter',
first with additional time constraint, the second without.  You
can try both and see that the second is indeed faster.  On tags
completion I had something like 2.1 sec with time constraint
and 1.5 sec without.  Unpatched code runs for at least 5 seconds
here (not measured, but it seems so).

Paul

Re: simple patch for `etags.el'

[Kim F. Storm]

Paul Pogonyshev <pogonyshev@gmx.net> writes:

> Actually, my patch did just this:
>
> 	(when (and (reached-next-percentage)
> 		   (enough-time-has-passed))
>

I was thinking about

  (when (reached-next-percentage)
    (setq next-percentage (1+ next-percentage))  ; or similar
    (when (enougn-time-has-passed)
      (message ...)))


-- 
Kim F. Storm <storm@cua.dk> http://www.cua.dk

Re: simple patch for `etags.el'

[David Kastrup]

storm@cua.dk (Kim F. Storm) writes:

> Paul Pogonyshev <pogonyshev@gmx.net> writes:
>
>> Actually, my patch did just this:
>>
>> 	(when (and (reached-next-percentage)
>> 		   (enough-time-has-passed))
>>
>
> I was thinking about
>
>   (when (reached-next-percentage)
>     (setq next-percentage (1+ next-percentage))  ; or similar
>     (when (enougn-time-has-passed)
>       (message ...)))

I don't see the difference.  In either case, enough-time-has-passed is
only examined once the next percentage value has been reached (which
can be more than just (1+ next-percentage) anyway).

-- 
David Kastrup, Kriemhildstr. 15, 44793 Bochum

Re: simple patch for `etags.el'

[Paul Pogonyshev]

Kim F. Storm wrote:

> Paul Pogonyshev <pogonyshev@gmx.net> writes:
> > Actually, my patch did just this:
> >
> > 	(when (and (reached-next-percentage)
> > 		   (enough-time-has-passed))
>
> I was thinking about
>
>   (when (reached-next-percentage)
>     (setq next-percentage (1+ next-percentage))  ; or similar
>     (when (enougn-time-has-passed)
>       (message ...)))

Yes, this does make a difference.  This also complicates the
code quite a lot.  So, do we want time constraint as an
addition?

Paul

Re: simple patch for `etags.el'

[Richard Stallman]

    Yes, this does make a difference.  This also complicates the
    code quite a lot.  So, do we want time constraint as an
    addition?

If something takes 30 seconds and the number changes 3 times a second,
it could look ugly.  Does it look better with a minimum time such as 1
second or .5 second?  It might be better to have that as a default
minimum time.