Tweak progess reporting in finder-compile-keywords

* lisp/finder.el (finder-compile-keywords): Use progress reporter
to report the processing.

1 files changed, 70 insertions, 63 deletions

diff --git a/lisp/finder.el b/lisp/finder.el
index 26ff5a18f1d..f95049f60bd 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -188,71 +188,78 @@ from; the default is `load-path'."
   ;; Allow compressed files also.
   (setq package--builtins nil)
   (setq finder-keywords-hash (make-hash-table :test 'eq))
-  (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
-        (file-count 0)
-	package-override files base-name ; processed
-	summary keywords package version entry desc)
-    (dolist (d (or dirs load-path))
-      (when (file-exists-p (directory-file-name d))
-	(setq package-override
+  (let* ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
+         (file-count 0)
+         (files (cl-loop for d in (or dirs load-path)
+                         when (file-exists-p (directory-file-name d))
+                         append (mapcar
+                                 (lambda (f)
+                                   (cons d f))
+                                 (directory-files d nil el-file-regexp))))
+         (progress (make-progress-reporter
+                    (byte-compile-info-string "Scanning files for finder")
+                    0 (length files)))
+	 package-override base-name ; processed
+	 summary keywords package version entry desc)
+    (dolist (elem files)
+      (let* ((d (car elem))
+             (f (cdr elem))
+             (package-override
 	      (intern-soft
 	       (cdr-safe
-		(assoc (file-name-nondirectory (directory-file-name d))
-		       finder--builtins-alist))))
-	(setq files (directory-files d nil el-file-regexp))
-	(dolist (f files)
-          (setq file-count (1+ file-count))
-          (when (zerop (mod file-count 100))
-            (byte-compile-info-message "Scanned %s files for finder"
-                                       file-count))
-	  (unless (or (string-match finder-no-scan-regexp f)
-		      (null (setq base-name
-				  (and (string-match el-file-regexp f)
-				       (intern (match-string 1 f))))))
-;;		      (memq base-name processed))
-;; There are multiple files in the tree with the same basename.
-;; So skipping files based on basename means you randomly (depending
-;; on which order the files are traversed in) miss some packages.
-;; https://debbugs.gnu.org/14010
-;; You might think this could lead to two files providing the same package,
-;; but it does not, because the duplicates are (at time of writing)
-;; all due to files in cedet, which end up with package-override set.
-;; FIXME this is obviously fragile.
-;; Make the (eq base-name package) case below issue a warning if
-;; package-override is nil?
-;;	    (push base-name processed)
-	    (with-temp-buffer
-	      (insert-file-contents (expand-file-name f d))
-	      (setq keywords (mapcar 'intern (lm-keywords-list))
-		    package  (or package-override
-				 (let ((str (lm-header "package")))
-				   (if str (intern str)))
-				 base-name)
-		    summary  (or (cdr
-				  (assq package finder--builtins-descriptions))
-				 (lm-synopsis))
-		    version  (lm-header "version")))
-	    (when summary
-	      (setq version (ignore-errors (version-to-list version)))
-	      (setq entry (assq package package--builtins))
-	      (cond ((null entry)
-		     (push (cons package
-                                 (package-make-builtin version summary))
-			   package--builtins))
-		    ;; The idea here is that eg calc.el gets to define
-		    ;; the description of the calc package.
-		    ;; This does not work for eg nxml-mode.el.
-		    ((or (eq base-name package) version)
-		     (setq desc (cdr entry))
-		     (aset desc 0 version)
-		     (aset desc 2 summary)))
-	      (dolist (kw keywords)
-		(puthash kw
-			 (cons package
-			       (delq package
-				     (gethash kw finder-keywords-hash)))
-			 finder-keywords-hash))))))))
-
+	        (assoc (file-name-nondirectory
+                        (directory-file-name d))
+		       finder--builtins-alist)))))
+        (progress-reporter-update progress (setq file-count (1+ file-count)))
+        (unless (or (string-match finder-no-scan-regexp f)
+		    (null (setq base-name
+			        (and (string-match el-file-regexp f)
+				     (intern (match-string 1 f))))))
+          ;; (memq base-name processed))
+          ;; There are multiple files in the tree with the same
+          ;; basename.  So skipping files based on basename means you
+          ;; randomly (depending on which order the files are
+          ;; traversed in) miss some packages.
+          ;; https://debbugs.gnu.org/14010
+          ;; You might think this could lead to two files providing
+          ;; the same package, but it does not, because the duplicates
+          ;; are (at time of writing) all due to files in cedet, which
+          ;; end up with package-override set.  FIXME this is
+          ;; obviously fragile.  Make the (eq base-name package) case
+          ;; below issue a warning if package-override is nil?
+          ;;	    (push base-name processed)
+	  (with-temp-buffer
+	    (insert-file-contents (expand-file-name f d))
+	    (setq keywords (mapcar 'intern (lm-keywords-list))
+		  package  (or package-override
+			       (let ((str (lm-header "package")))
+			         (if str (intern str)))
+			       base-name)
+		  summary  (or (cdr
+			        (assq package finder--builtins-descriptions))
+			       (lm-synopsis))
+		  version  (lm-header "version")))
+	  (when summary
+	    (setq version (ignore-errors (version-to-list version)))
+	    (setq entry (assq package package--builtins))
+	    (cond ((null entry)
+		   (push (cons package
+                               (package-make-builtin version summary))
+		         package--builtins))
+		  ;; The idea here is that eg calc.el gets to define
+		  ;; the description of the calc package.
+		  ;; This does not work for eg nxml-mode.el.
+		  ((or (eq base-name package) version)
+		   (setq desc (cdr entry))
+		   (aset desc 0 version)
+		   (aset desc 2 summary)))
+	    (dolist (kw keywords)
+	      (puthash kw
+		       (cons package
+			     (delq package
+				   (gethash kw finder-keywords-hash)))
+		       finder-keywords-hash))))))
+    (progress-reporter-done progress))
   (setq package--builtins
 	(sort package--builtins
 	      (lambda (a b) (string< (symbol-name (car a))