Re: simple patch for `etags.el'

[Paul Pogonyshev <pogonyshev@gmx.net>]

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