From 6a02ca0b8c055c863bf53d9b92e8bea27b0e992f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Tue, 18 Jun 2019 15:24:10 +0200 Subject: [PATCH] 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 b31ab12d0ea..65dc0950528 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 161c5bbec69..05a01115957 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 96cff2ebeb2..d34d5d8a7e4 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. -- 2.39.2