mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-27 07:37:33 +00:00
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.
This commit is contained in:
Lars Ingebrigtsen
parent
29ea0803d7
commit
6a02ca0b8c
4
etc/NEWS
4
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,
|
||||
|
||||
132
lisp/cus-dep.el
132
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))
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user