andros/emacs-gpu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Report progress during custom-make-dependencies instead of file count

Browse source 
* 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.
This commit is contained in:
Lars Ingebrigtsen 2019-06-18 15:24:10 +02:00
parent 29ea0803d7
commit 6a02ca0b8c
3 changed files with 79 additions and 63 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
etc/NEWS
View file

@ -1701,6 +1701,10 @@ valid event type.
** The new macro `with-suppressed-warnings' can be used to suppress ** The new macro `with-suppressed-warnings' can be used to suppress
specific byte-compile warnings. 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' ** 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, This makes it possible to control the ordering of functions more precisely,

132
lisp/cus-dep.el
View file

@ -27,6 +27,7 @@
(require 'widget) (require 'widget)
(require 'cus-face) (require 'cus-face)
(require 'cl-lib)
(defvar generated-custom-dependencies-file "cus-load.el" (defvar generated-custom-dependencies-file "cus-load.el"
"Output file for `custom-make-dependencies'.") "Output file for `custom-make-dependencies'.")
@ -53,72 +54,79 @@ ldefs-boot\\|cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
(defun custom-make-dependencies () (defun custom-make-dependencies ()
"Batch function to extract custom dependencies from .el files. "Batch function to extract custom dependencies from .el files.
Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS" Usage: emacs -batch -l ./cus-dep.el -f custom-make-dependencies DIRS"
(let ((enable-local-eval nil) (let* ((enable-local-eval nil)
(enable-local-variables :safe) (enable-local-variables :safe)
(file-count 0) (preloaded (concat "\\`\\(\\./+\\)?"
subdir) (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 (with-temp-buffer
;; Use up command-line-args-left else Emacs can try to open (dolist (elem files)
;; the args as directories after we are done. (let* ((subdir (car elem))
(while (setq subdir (pop command-line-args-left)) (file (cdr elem))
(let ((files (directory-files subdir nil "\\`[^=.].*\\.el\\'")) (default-directory
(default-directory (directory-file-name (expand-file-name subdir))))
(file-name-as-directory (expand-file-name subdir))) (progress-reporter-update progress (setq file-count (1+ file-count)))
(preloaded (concat "\\`\\(\\./+\\)?" (unless (or (string-match custom-dependencies-no-scan-regexp file)
(regexp-opt preloaded-file-list t) (string-match preloaded (format "%s/%s" subdir file))
"\\.el\\'"))) (not (file-exists-p file)))
(dolist (file files) (erase-buffer)
(setq file-count (1+ file-count)) (kill-all-local-variables)
(when (zerop (mod file-count 100)) (insert-file-contents file)
(byte-compile-info-message "Scanned %s files for custom" (hack-local-variables)
file-count)) (goto-char (point-min))
(unless (or (string-match custom-dependencies-no-scan-regexp file) (string-match "\\`\\(.*\\)\\.el\\'" file)
(string-match preloaded (format "%s/%s" subdir file)) (let ((name (or generated-autoload-load-name ; see bug#5277
(not (file-exists-p file))) (file-name-nondirectory (match-string 1 file))))
(erase-buffer) (load-file-name file))
(kill-all-local-variables) (if (save-excursion
(insert-file-contents file) (re-search-forward
(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]*" (concat "(\\(cc-\\)?provide[ \t\n]+\\('\\|(quote[ \t\n]\\)[ \t\n]*"
(regexp-quote name) "[ \t\n)]") (regexp-quote name) "[ \t\n)]")
nil t)) nil t))
(setq name (intern name))) (setq name (intern name)))
(condition-case nil (condition-case nil
(while (re-search-forward (while (re-search-forward
"^(def\\(custom\\|face\\|group\\)" nil t) "^(def\\(custom\\|face\\|group\\)" nil t)
(beginning-of-line) (beginning-of-line)
(let ((type (match-string 1)) (let ((type (match-string 1))
(expr (read (current-buffer)))) (expr (read (current-buffer))))
(condition-case nil (condition-case nil
(let ((custom-dont-initialize t)) (let ((custom-dont-initialize t))
;; Eval to get the 'custom-group, -tag, ;; Eval to get the 'custom-group, -tag,
;; -version, group-documentation etc properties. ;; -version, group-documentation etc properties.
(put (nth 1 expr) 'custom-where name) (put (nth 1 expr) 'custom-where name)
(eval expr)) (eval expr))
;; Eval failed for some reason. Eg maybe the ;; Eval failed for some reason. Eg maybe the
;; defcustom uses something defined earlier ;; defcustom uses something defined earlier
;; in the file (we haven't loaded the file). ;; in the file (we haven't loaded the file).
;; In most cases, we can still get the :group. ;; In most cases, we can still get the :group.
(error (error
(ignore-errors (ignore-errors
(let ((group (cadr (memq :group expr)))) (let ((group (cadr (memq :group expr))))
(and group (and group
(eq (car group) 'quote) (eq (car group) 'quote)
(custom-add-to-group (custom-add-to-group
(cadr group) (cadr group)
(nth 1 expr) (nth 1 expr)
(intern (format "custom-%s" (intern (format "custom-%s"
(if (equal type "custom") (if (equal type "custom")
"variable" "variable"
type))))))))))) type)))))))))))
(error nil))))))))) (error nil)))))))
(progress-reporter-done progress))
(byte-compile-info-message "Generating %s..." (byte-compile-info-message "Generating %s..."
generated-custom-dependencies-file) generated-custom-dependencies-file)
(set-buffer (find-file-noselect generated-custom-dependencies-file)) (set-buffer (find-file-noselect generated-custom-dependencies-file))

6
lisp/emacs-lisp/byte-run.el
View file

@ -540,9 +540,13 @@ Otherwise, return nil. For internal use only."
(mapconcat (lambda (char) (format "`?\\%c'" char)) (mapconcat (lambda (char) (format "`?\\%c'" char))
sorted ", "))))) 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) (defun byte-compile-info-message (&rest args)
"Message format ARGS in a way that looks pleasing in the compilation output." "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. ;; I nuked this because it's not a good idea for users to think of using it.