[Emacs-diffs] master 6a02ca0: Report progress during custom-make-dependencies instead of file count

[Lars Ingebrigtsen]

branch: master
commit 6a02ca0b8c055c863bf53d9b92e8bea27b0e992f
Author: Lars Ingebrigtsen <address@hidden>
Commit: Lars Ingebrigtsen <address@hidden>

    Report progress during custom-make-dependencies instead of file count
    
    * lisp/cus-dep.el (custom-make-dependencies): Rewrite to use
    reporter to report progress instead of how many files we've
    processed.
    
    * lisp/emacs-lisp/byte-run.el (byte-compile-info-string): New function.
    (byte-compile-info-message): Use it.
---
 etc/NEWS                    |   4 ++
 lisp/cus-dep.el             | 132 +++++++++++++++++++++++---------------------
 lisp/emacs-lisp/byte-run.el |   6 +-
 3 files changed, 79 insertions(+), 63 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index b31ab12..65dc095 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1701,6 +1701,10 @@ valid event type.
 ** The new macro `with-suppressed-warnings' can be used to suppress
 specific byte-compile warnings.
 
+---
+** The new function `byte-compile-info-message' can be used to output
+informational messages that look pleasing during the Emacs build.
+
 +++
 ** The 'append' arg of 'add-hook' is generalized to a finer notion of 'depth'
 This makes it possible to control the ordering of functions more precisely,
diff --git a/lisp/cus-dep.el b/lisp/cus-dep.el
index 161c5bb..05a0111 100644
--- a/lisp/cus-dep.el
+++ b/lisp/cus-dep.el
@@ -27,6 +27,7 @@
 
 (require 'widget)
 (require 'cus-face)
+(require 'cl-lib)
 
 (defvar generated-custom-dependencies-file "cus-load.el"
   "Output file for `custom-make-dependencies'.")
@@ -53,72 +54,79 @@ 
ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
 (defun custom-make-dependencies ()
   "Batch function to extract custom dependencies from .el files.
 Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
-  (let ((enable-local-eval nil)
-       (enable-local-variables :safe)
-        (file-count 0)
-       subdir)
+  (let* ((enable-local-eval nil)
+        (enable-local-variables :safe)
+         (preloaded (concat "\\`\\(\\./+\\)?"
+                            (regexp-opt preloaded-file-list t)
+                            "\\.el\\'"))
+         (file-count 0)
+         (files
+          ;; Use up command-line-args-left else Emacs can try to open
+          ;; the args as directories after we are done.
+          (cl-loop for subdir = (pop command-line-args-left)
+                   while subdir
+                   append (mapcar (lambda (f)
+                                    (cons subdir f))
+                                  (directory-files subdir nil
+                                                   "\\`[^=.].*\\.el\\'"))))
+        (progress (make-progress-reporter
+                    (byte-compile-info-string "Scanning files for custom")
+                    0 (length files) nil 10)))
     (with-temp-buffer
-      ;; Use up command-line-args-left else Emacs can try to open
-      ;; the args as directories after we are done.
-      (while (setq subdir (pop command-line-args-left))
-        (let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'"))
-              (default-directory
-                (file-name-as-directory (expand-file-name subdir)))
-              (preloaded (concat "\\`\\(\\./+\\)?"
-                                 (regexp-opt preloaded-file-list t)
-                                 "\\.el\\'")))
-          (dolist (file files)
-            (setq file-count (1+ file-count))
-            (when (zerop (mod file-count 100))
-              (byte-compile-info-message "Scanned %s files for custom"
-                                         file-count))
-            (unless (or (string-match custom-dependencies-no-scan-regexp file)
-                        (string-match preloaded (format "%s/%s" subdir file))
-                        (not (file-exists-p file)))
-              (erase-buffer)
-              (kill-all-local-variables)
-              (insert-file-contents file)
-              (hack-local-variables)
-              (goto-char (point-min))
-              (string-match "\\`\\(.*\\)\\.el\\'" file)
-              (let ((name (or generated-autoload-load-name ; see bug#5277
-                              (file-name-nondirectory (match-string 1 file))))
-                    (load-file-name file))
-                (if (save-excursion
-                      (re-search-forward
+      (dolist (elem files)
+        (let* ((subdir (car elem))
+               (file (cdr elem))
+               (default-directory
+                 (directory-file-name (expand-file-name subdir))))
+          (progress-reporter-update progress (setq file-count (1+ file-count)))
+          (unless (or (string-match custom-dependencies-no-scan-regexp file)
+                      (string-match preloaded (format "%s/%s" subdir file))
+                      (not (file-exists-p file)))
+            (erase-buffer)
+            (kill-all-local-variables)
+            (insert-file-contents file)
+            (hack-local-variables)
+            (goto-char (point-min))
+            (string-match "\\`\\(.*\\)\\.el\\'" file)
+            (let ((name (or generated-autoload-load-name ; see bug#5277
+                            (file-name-nondirectory (match-string 1 file))))
+                  (load-file-name file))
+              (if (save-excursion
+                    (re-search-forward
                     (concat "(\\(cc-\\)?provide[ \t\n]+\\('\\|(quote[ 
\t\n]\\)[ \t\n]*"
                             (regexp-quote name) "[ \t\n)]")
                     nil t))
-                    (setq name (intern name)))
-                (condition-case nil
-                    (while (re-search-forward
-                            "^(def\\(custom\\|face\\|group\\)" nil t)
-                      (beginning-of-line)
-                      (let ((type (match-string 1))
-                           (expr (read (current-buffer))))
-                        (condition-case nil
-                            (let ((custom-dont-initialize t))
-                              ;; Eval to get the 'custom-group, -tag,
-                              ;; -version, group-documentation etc properties.
-                              (put (nth 1 expr) 'custom-where name)
-                              (eval expr))
-                          ;; Eval failed for some reason.  Eg maybe the
-                          ;; defcustom uses something defined earlier
-                          ;; in the file (we haven't loaded the file).
-                          ;; In most cases, we can still get the :group.
-                          (error
-                           (ignore-errors
-                             (let ((group (cadr (memq :group expr))))
-                               (and group
-                                    (eq (car group) 'quote)
-                                    (custom-add-to-group
-                                     (cadr group)
-                                     (nth 1 expr)
-                                     (intern (format "custom-%s"
-                                                     (if (equal type "custom")
-                                                         "variable"
-                                                       type)))))))))))
-                  (error nil)))))))))
+                  (setq name (intern name)))
+              (condition-case nil
+                  (while (re-search-forward
+                          "^(def\\(custom\\|face\\|group\\)" nil t)
+                    (beginning-of-line)
+                    (let ((type (match-string 1))
+                         (expr (read (current-buffer))))
+                      (condition-case nil
+                          (let ((custom-dont-initialize t))
+                            ;; Eval to get the 'custom-group, -tag,
+                            ;; -version, group-documentation etc properties.
+                            (put (nth 1 expr) 'custom-where name)
+                            (eval expr))
+                        ;; Eval failed for some reason.  Eg maybe the
+                        ;; defcustom uses something defined earlier
+                        ;; in the file (we haven't loaded the file).
+                        ;; In most cases, we can still get the :group.
+                        (error
+                         (ignore-errors
+                           (let ((group (cadr (memq :group expr))))
+                             (and group
+                                  (eq (car group) 'quote)
+                                  (custom-add-to-group
+                                   (cadr group)
+                                   (nth 1 expr)
+                                   (intern (format "custom-%s"
+                                                   (if (equal type "custom")
+                                                       "variable"
+                                                     type)))))))))))
+                (error nil)))))))
+    (progress-reporter-done progress))
   (byte-compile-info-message "Generating %s..."
                              generated-custom-dependencies-file)
   (set-buffer (find-file-noselect generated-custom-dependencies-file))
diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 96cff2e..d34d5d8 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -540,9 +540,13 @@ Otherwise, return nil.  For internal use only."
                         (mapconcat (lambda (char) (format "`?\\%c'" char))
                                    sorted ", ")))))
 
+(defun byte-compile-info-string (&rest args)
+  "Format ARGS in a way that looks pleasing in the compilation output."
+  (format "  %-9s%s" "INFO" (apply #'format args)))
+
 (defun byte-compile-info-message (&rest args)
   "Message format ARGS in a way that looks pleasing in the compilation output."
-  (message "  %-9s%s" "INFO" (apply #'format args)))
+  (message "%s" (apply #'byte-compile-info-string args)))
 
 
 ;; I nuked this because it's not a good idea for users to think of using it.