[Emacs-diffs] master 0837d9a: Tweak progess reporting in finder-compile-keywords

[Lars Ingebrigtsen]

branch: master
commit 0837d9a4ea035f89426b6be56d5b848636472b1c
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    Tweak progess reporting in finder-compile-keywords
    
    * lisp/finder.el (finder-compile-keywords): Use progress reporter
    to report the processing.
---
 lisp/finder.el | 133 ++++++++++++++++++++++++++++++---------------------------
 1 file changed, 70 insertions(+), 63 deletions(-)

diff --git a/lisp/finder.el b/lisp/finder.el
index 26ff5a1..f95049f 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))