;;; loaddefs-gen.el --- generate loaddefs.el files -*- lexical-binding: t -*-
;; Copyright (C) 2022-2024 Free Software Foundation, Inc.
;; Keywords: maint
;; Package: emacs
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see .
;;; Commentary:
;; This package generates the main lisp/loaddefs.el file, as well as
;; all the other loaddefs files, like calendar/diary-loaddefs.el, etc.
;; The main entry point is `loaddefs-generate' (normally called
;; from loaddefs-generate-batch via lisp/Makefile).
;;
;; The "other" loaddefs files are specified either via a file-local
;; setting of `generated-autoload-file', or by specifying
;;
;; ;;;###foo-autoload
;;
;; This makes the autoload go to foo-loaddefs.el in the current directory.
;; Normal ;;;###autoload specs go to the main loaddefs file.
;;; Code:
(require 'radix-tree)
(require 'lisp-mnt)
(require 'generate-lisp-file)
(defvar autoload-compute-prefixes t
"If non-nil, autoload will add code to register the prefixes used in a file.
Standard prefixes won't be registered anyway. I.e. if a file
\"foo.el\" defines variables or functions that use \"foo-\" as
prefix, that will not be registered. But all other prefixes will
be included.")
;;;###autoload
(put 'autoload-compute-prefixes 'safe-local-variable #'booleanp)
(defvar no-update-autoloads nil
"File local variable to prevent scanning this file for autoload cookies.")
(defvar autoload-ignored-definitions
'("define-obsolete-function-alias"
"define-obsolete-variable-alias"
"define-category"
"define-key" "define-key-after" "define-keymap"
"defgroup" "defface" "defadvice"
"def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
"define-erc-module"
"define-erc-response-handler"
"defun-rcirc-command"
"define-short-documentation-group"
"def-edebug-elem-spec"
"defvar-mode-local"
"defcustom-mode-local-semantic-dependency-system-include-path"
"define-ibuffer-column"
"define-ibuffer-sorter")
"List of strings naming definitions to ignore for prefixes.
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")
(defvar generated-autoload-file nil
"File into which to write autoload definitions.
A Lisp file can set this in its local variables section to make
its autoloads go somewhere else.
If this is a relative file name, the directory is determined as
follows:
- If a Lisp file defined `generated-autoload-file' as a
file-local variable, use its containing directory.
- Otherwise use the \"lisp\" subdirectory of `source-directory'.
The autoload file is assumed to contain a trailer starting with a
FormFeed character.")
;;;###autoload
(put 'generated-autoload-file 'safe-local-variable #'stringp)
(defvar generated-autoload-load-name nil
"Load name for `autoload' statements generated from autoload cookies.
If nil, this defaults to the file name, sans extension.
Typically, you need to set this when the directory containing the file
is not in `load-path'.
This also affects the generated cus-load.el file.")
;;;###autoload
(put 'generated-autoload-load-name 'safe-local-variable #'stringp)
(defun loaddefs-generate--file-load-name (file outfile)
"Compute the name that will be used to load FILE.
OUTFILE should be the name of the global loaddefs.el file, which
is expected to be at the root directory of the files we are
scanning for autoloads and will be in the `load-path'."
(let* ((name (file-relative-name file (file-name-directory outfile)))
(names '())
(dir (file-name-directory outfile)))
;; If `name' lives inside an ancestor directory of OUTFILE, only
;; keep the last few leading directories that are really needed.
;; (It will always live in an ancestor directory of OUTFILE on
;; Posix systems, but on DOS/Windows it could not be, if FILE and
;; OUTFILE are on different drives.)
(when (not (file-name-absolute-p name))
(while name
(setq name (directory-file-name name))
(push (file-name-nondirectory name) names)
(setq name (file-name-directory name)))
(while (not name)
(cond
((null (cdr names)) (setq name (car names)))
((file-exists-p (expand-file-name "subdirs.el" dir))
;; FIXME: here we only check the existence of subdirs.el,
;; without checking its content. This makes it generate
;; wrong load names for cases like lisp/term which is not
;; added to load-path.
(setq dir (expand-file-name (pop names) dir)))
(t (setq name (mapconcat #'identity names "/"))))))
(if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
(substring name 0 (match-beginning 0))
name)))
(defun loaddefs-generate--shorten-autoload (form)
"Remove optional nil elements from an `autoload' form."
(take (max (- (length form)
(seq-position (reverse form) nil
(lambda (e1 e2)
(not (eq e1 e2)))))
3)
form))
(defun loaddefs-generate--make-autoload (form file &optional expansion)
"Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
or macro definition or a defcustom).
If EXPANSION is non-nil, we're processing the macro expansion of an
expression, in which case we want to handle forms differently."
(let ((car (car-safe form)) expand)
(cond
((and expansion (eq car 'defalias))
(pcase-let*
((`(,_ ,_ ,arg . ,rest) form)
;; `type' is non-nil if it defines a macro.
;; `fun' is the function part of `arg' (defaults to `arg').
((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
(and (let fun arg) (let type nil)))
arg)
;; `lam' is the lambda expression in `fun' (or nil if not
;; recognized).
(lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
;; `args' is the list of arguments (or t if not recognized).
;; `body' is the body of `lam' (or t if not recognized).
((or `(lambda ,args . ,body)
(and (let args t) (let body t)))
lam)
;; Get the `doc' from `body' or `rest'.
(doc (cond ((stringp (car-safe body)) (car body))
((stringp (car-safe rest)) (car rest))))
;; Look for an interactive spec.
(interactive (pcase body
((or `((interactive . ,iargs) . ,_)
`(,_ (interactive . ,iargs) . ,_))
;; List of modes or just t.
(if (nthcdr 1 iargs)
(list 'quote (nthcdr 1 iargs))
t)))))
;; Add the usage form at the end where describe-function-1
;; can recover it.
(when (consp args) (setq doc (help-add-fundoc-usage doc args)))
(loaddefs-generate--shorten-autoload
`(autoload ,(nth 1 form) ,file ,doc ,interactive ,type))))
;; Look inside `progn', and `eval-and-compile', since these
;; are often used in the expansion of things like `pcase-defmacro'.
((and expansion (memq car '(progn prog1 eval-and-compile)))
(let ((end (memq :autoload-end form)))
(when end ;Cut-off anything after the :autoload-end marker.
(setq form (copy-sequence form))
(setcdr (memq :autoload-end form) nil))
(let ((exps (delq nil (mapcar (lambda (form)
(loaddefs-generate--make-autoload
form file expansion))
(cdr form)))))
(when exps (cons 'progn exps)))))
;; For complex cases, try again on the macro-expansion.
((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
define-globalized-minor-mode defun defmacro
easy-mmode-define-minor-mode define-minor-mode
define-inline cl-defun cl-defmacro cl-defgeneric
cl-defstruct pcase-defmacro iter-defun cl-iter-defun))
(macrop car)
(setq expand (let ((load-true-file-name file)
(load-file-name file))
(macroexpand form)))
(memq (car expand) '(progn prog1 defalias)))
;; Recurse on the expansion.
(loaddefs-generate--make-autoload expand file 'expansion))
;; For special function-like operators, use the `autoload' function.
((memq car '(define-skeleton define-derived-mode
define-compilation-mode define-generic-mode
easy-mmode-define-global-mode define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode define-minor-mode
cl-defun defun* cl-defmacro defmacro*
define-overloadable-function
transient-define-prefix transient-define-suffix
transient-define-infix transient-define-argument))
(let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
(name (nth 1 form))
(args (pcase car
((or 'defun 'defmacro
'defun* 'defmacro* 'cl-defun 'cl-defmacro
'define-overloadable-function
'transient-define-prefix 'transient-define-suffix
'transient-define-infix 'transient-define-argument)
(nth 2 form))
('define-skeleton '(&optional str arg))
((or 'define-generic-mode 'define-derived-mode
'define-compilation-mode)
nil)
(_ t)))
(body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
(doc (if (stringp (car body)) (pop body))))
;; Add the usage form at the end where describe-function-1
;; can recover it.
(when (listp args) (setq doc (help-add-fundoc-usage doc args)))
;; `define-generic-mode' quotes the name, so take care of that
(loaddefs-generate--shorten-autoload
`(autoload ,(if (listp name) name (list 'quote name))
,file ,doc
,(or (and (memq car '(define-skeleton define-derived-mode
define-generic-mode
easy-mmode-define-global-mode
define-global-minor-mode
define-globalized-minor-mode
easy-mmode-define-minor-mode
define-minor-mode
transient-define-prefix
transient-define-suffix
transient-define-infix
transient-define-argument))
t)
(and (eq (car-safe (car body)) 'interactive)
;; List of modes or just t.
(or (if (nthcdr 1 (car body))
(list 'quote (nthcdr 1 (car body)))
t))))
,(if macrop ''macro nil)))))
;; For defclass forms, use `eieio-defclass-autoload'.
((eq car 'defclass)
(let ((name (nth 1 form))
(superclasses (nth 2 form))
(doc (nth 4 form)))
(list 'eieio-defclass-autoload (list 'quote name)
(list 'quote superclasses) file doc)))
;; Convert defcustom to less space-consuming data.
((eq car 'defcustom)
(let* ((varname (car-safe (cdr-safe form)))
(props (nthcdr 4 form))
(initializer (plist-get props :initialize))
(init (car-safe (cdr-safe (cdr-safe form))))
(doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
)
`(progn
,(if (not (member initializer '(nil 'custom-initialize-default
#'custom-initialize-default
'custom-initialize-reset
#'custom-initialize-reset)))
form
`(defvar ,varname ,init ,doc))
;; When we include the complete `form', this `custom-autoload'
;; is not indispensable, but it still helps in case the `defcustom'
;; doesn't specify its group explicitly, and probably in a few other
;; corner cases.
(custom-autoload ',varname ,file
,(condition-case nil
(null (plist-get props :set))
(error nil)))
;; Propagate the :safe property to the loaddefs file.
,@(when-let ((safe (plist-get props :safe)))
`((put ',varname 'safe-local-variable ,safe))))))
;; Extract theme properties.
((eq car 'deftheme)
(let* ((name (car-safe (cdr-safe form)))
(props (nthcdr 3 form)))
`(put ',name 'theme-properties (list ,@props))))
((eq car 'defgroup)
;; In Emacs this is normally handled separately by cus-dep.el, but for
;; third party packages, it can be convenient to explicitly autoload
;; a group.
(let ((groupname (nth 1 form))
(parent (eval (plist-get form :group) t)))
`(let ((loads (get ',groupname 'custom-loads)))
(if (member ',file loads) nil
(put ',groupname 'custom-loads (cons ',file loads))
,@(when parent
`((put ',parent 'custom-loads
(cons ',groupname (get ',parent 'custom-loads)))))))))
;; When processing a macro expansion, any expression
;; before a :autoload-end should be included. These are typically (put
;; 'fun 'prop val) and things like that.
((and expansion (consp form)) form)
;; nil here indicates that this is not a special autoload form.
(t nil))))
(defvar loaddefs-generate-prefixes-limit 8
"Max number of prefixes registered per file.")
(defvar loaddefs-generate-prefixes-generic
'("find-" "make-" "copy-" "define-" "global-" "batch-")
"Prefixes which are not specific enough.")
(defvar loaddefs-generate-prefixes-ignore ()
"List of prefixes that are not worth registering.
Meant to be used as a file-local variable.")
(defun loaddefs-generate--make-prefixes (defs file)
;; FIXME: We should take advantage of (and encourage) the convention
;; of using the same namespace prefix as the file name.
;; (message "loaddefs-generate-prefixes-ignore in %S = %S"
;; file loaddefs-generate-prefixes-ignore)
(letrec
;; First, convert the list of DEFS into a radix tree.
((tree (let ((tree radix-tree-empty))
(dolist (def defs)
(setq tree (radix-tree-insert tree def t)))
tree))
(valid-prefix-p ;; Avoid prefixes that are excessively generic.
(lambda (s)
(and (or (> (length s) 2) ;Long enough!
;; A real (tho short) prefix?
(string-match ".[[:punct:]]\\'" s))
;; But avoid generic prefixes.
(let ((x (try-completion s loaddefs-generate-prefixes-generic)))
(not (or (equal x s) (equal x t)))))))
(ignore-p
(lambda (s)
(or (not (listp loaddefs-generate-prefixes-ignore))
(let ((ignore nil))
(dolist (ignored-prefix loaddefs-generate-prefixes-ignore)
(when (string-prefix-p ignored-prefix s)
(setq ignore t)))
ignore))))
(ids ;; Convert a radix (sub)tree back into a list of identifiers.
(lambda (prefix tree)
(let ((ids '()))
(radix-tree-iter-mappings
tree (lambda (s _) (push (concat prefix s) ids)))
ids)))
(dropped '()) ;; List of prefixes that are rejected.
(valid-prefixes ;; Return possible valid prefixes of a (sub)tree.
(lambda (prefix tree)
(let ((prefixes '()))
(radix-tree-iter-subtrees
tree
(lambda (s subtree)
(setq s (concat prefix s))
(cond
((funcall ignore-p s)) ;; Drop silently.
((funcall valid-prefix-p s) (push (cons s subtree) prefixes))
((radix-tree-lookup tree "") ;Nothing to expand!
(push (cons s (funcall ids prefix subtree)) dropped))
(t
(setq prefixes (nconc (funcall valid-prefixes s subtree)
prefixes))))))
prefixes)))
;; Initial list of possible valid prefixes.
(prefixes (funcall valid-prefixes "" tree)))
(when (> (length prefixes) loaddefs-generate-prefixes-limit)
;; The list is too long. Throw out the prefixes that cover fewer
;; identifiers: they're less useful (and they tend to be longer).
(let* ((sorted
(sort
(mapcar (lambda (x)
(let ((prefix (car x)) (tree (cdr x)))
(cons prefix (funcall ids prefix tree))))
prefixes)
(lambda (x y) (> (length (cdr x)) (length (cdr y)))))))
(setq dropped (nconc (nthcdr loaddefs-generate-prefixes-limit sorted) dropped))
(setq prefixes (nreverse (take loaddefs-generate-prefixes-limit sorted)))
;; Don't keep prefixes that contain no-more elements than dropped ones,
;; so we're not affected by arbitrary ordering between subtrees.
(while (= (length (cdar prefixes)) (length (cdar dropped)))
(push (pop prefixes) dropped))))
(when dropped
(let ((ids (mapcan #'cdr dropped)))
(message "%s:0: Warning: Not registering %d prefixes (%d (%d%%) identifiers).
Affected prefixes: %S"
file (length dropped) (length ids)
(/ (* (length ids) 100)
(+ (length ids) (length (mapcan #'cdr prefixes))))
(mapcar #'car dropped)))) ;;ids
(let ((expd (when dropped
`(ignore "dropped-prefixes" ',(mapcar #'car dropped))))
(expr
(when prefixes
(let ((strings (mapcar #'car prefixes)))
`(register-definition-prefixes
,file ',(sort strings #'string<))))))
(if (and expd expr)
`(progn ,expr ,expd)
(or expd expr)))))
(defun loaddefs-generate--parse-file (file main-outfile &optional package-data)
"Examining FILE for ;;;###autoload statements.
MAIN-OUTFILE is the main loaddefs file these statements are
destined for, but this can be overridden by the buffer-local
setting of `generated-autoload-file' in FILE, and
by ;;;###foo-autoload statements.
If PACKAGE-DATA is `only', return only the package data. If t,
include the package data with the rest of the data. Otherwise,
don't include."
(let ((defs nil)
(load-name (loaddefs-generate--file-load-name file main-outfile))
read-symbol-shorthands
local-outfile)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-max))
;; We "open-code" this version of `hack-local-variables',
;; because it's really slow in bootstrap-emacs.
;; FIXME: That fails to obey `dir-locals.el'!
(when (search-backward ";; Local Variables:" (- (point-max) 1000) t)
(while (re-search-forward
(concat (regexp-opt
'("generated-autoload-file"
"generated-autoload-load-name"
"no-update-autoloads"
"autoload-compute-prefixes"
"read-symbol-shorthands"
"loaddefs-generate-prefixes-ignore")
t)
": *")
nil t)
(condition-case err
(set (make-local-variable (intern (match-string 1)))
(read (current-buffer)))
(error
(message "Error while reading local var %S: %S"
(match-string 1) err))))
(when (local-variable-p 'generated-autoload-file)
;; Buffer-local file that should be interpreted relative to
;; the .el file.
(setq local-outfile (expand-file-name generated-autoload-file
(file-name-directory file))))
(when (local-variable-p 'generated-autoload-load-name)
(setq load-name generated-autoload-load-name))
(when (local-variable-p 'read-symbol-shorthands)
;; Duplicate the logic in `hack-local-variables--find-variables'.
(setq read-symbol-shorthands
(sort read-symbol-shorthands
(lambda (sh1 sh2)
(> (length (car sh1)) (length (car sh2))))))))
;; We always return the package version (even for pre-dumped
;; files).
(if (not package-data)
;; We have to switch `emacs-lisp-mode' when scanning
;; loaddefs for packages so that `syntax-ppss' later gives
;; correct results.
(emacs-lisp-mode)
(let ((version (lm-header "version"))
package)
(when (and version
(setq version (ignore-errors (version-to-list version)))
(setq package (or (lm-header "package")
(file-name-sans-extension
(file-name-nondirectory file)))))
(push (list (or local-outfile main-outfile) file
`(push (purecopy ',(cons (intern package) version))
package--builtin-versions))
defs))))
;; Obey the `no-update-autoloads' file local variable.
(when (and (not no-update-autoloads)
(not (eq package-data 'only)))
(goto-char (point-min))
;; The cookie might be like ;;;###tramp-autoload...
(while (re-search-forward lisp-mode-autoload-regexp nil t)
(when (or package-data
;; Outside of the main Emacs build (`package-data'
;; is set in the Emacs build), check that we don't
;; have an autoload cookie on the first column of a
;; doc string or the like. (The Emacs tree
;; shouldn't contain any such instances.)
(not (ppss-string-terminator
(save-match-data (syntax-ppss)))))
;; ... and if we have one of these names, then alter outfile.
(let* ((aname (match-string 2))
(to-file (if aname
(expand-file-name
(concat aname "-loaddefs.el")
(file-name-directory file))
(or local-outfile main-outfile))))
(if (eolp)
;; We have a form following.
(let* ((form (prog1
(read (current-buffer))
(unless (bolp)
(forward-line 1))))
(autoload (or (loaddefs-generate--make-autoload
form load-name)
form)))
;; We get back either an autoload form, or a tree
;; structure of `(progn ...)' things, so unravel that.
(let ((forms (if (eq (car autoload) 'progn)
(cdr autoload)
(list autoload))))
(while forms
(let ((elem (pop forms)))
(if (eq (car elem) 'progn)
;; More recursion; add it to the start.
(setq forms (nconc (cdr elem) forms))
;; We have something to add to the defs; do it.
(push (list to-file file elem) defs))))))
;; Just put the rest of the line into the loaddefs.
;; FIXME: We skip the first space if there's more
;; whitespace after.
(when (looking-at-p " [\t ]")
(forward-char 1))
(push (list to-file file
(buffer-substring (point) (line-end-position)))
defs)))))
(when autoload-compute-prefixes
(with-demoted-errors "%S"
(when-let
((form (loaddefs-generate--compute-prefixes load-name)))
;; This output needs to always go in the main loaddefs.el,
;; regardless of `generated-autoload-file'.
(push (list main-outfile file form) defs))))))
defs))
(defun loaddefs-generate--compute-prefixes (load-name)
(goto-char (point-min))
(let ((prefs nil)
(temp-obarray (obarray-make)))
;; Avoid (defvar ) by requiring a trailing space.
(while (re-search-forward
"^(\\(def[^ \t\n]+\\)[ \t\n]+['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
(unless (member (match-string 1) autoload-ignored-definitions)
(let* ((name (match-string-no-properties 2))
;; Consider `read-symbol-shorthands'.
(probe (let ((obarray temp-obarray))
(car (read-from-string name)))))
(when (symbolp probe)
(setq name (symbol-name probe))
(when (save-excursion
(goto-char (match-beginning 0))
(or (bobp)
(progn
(forward-line -1)
(not (looking-at ";;;###autoload")))))
(push name prefs))))))
(loaddefs-generate--make-prefixes prefs load-name)))
(defun loaddefs-generate--rubric (file &optional type feature compile)
"Return a string giving the appropriate autoload rubric for FILE.
TYPE (default \"autoloads\") is a string stating the type of
information contained in FILE. TYPE \"package\" acts like the default,
but adds an extra line to the output to modify `load-path'.
If FEATURE is non-nil, FILE will provide a feature. FEATURE may
be a string naming the feature, otherwise it will be based on
FILE's name.
If COMPILE, don't include a \"don't compile\" cookie."
(let ((lp (and (equal type "package") (setq type "autoloads"))))
(with-temp-buffer
(generate-lisp-file-heading
file 'loaddefs-generate
:title (concat "automatically extracted " (or type "autoloads"))
:commentary (and (string-match "/lisp/loaddefs\\.el\\'" file)
"This file will be copied to ldefs-boot.el and checked in periodically."))
(when lp
(insert "(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))\n\n"))
(insert " \n;;; End of scraped data\n\n")
(generate-lisp-file-trailer
file :provide (and (stringp feature) feature)
:compile compile
:inhibit-native-compile t
:inhibit-provide (not feature))
(buffer-string))))
;;;###autoload
(defun loaddefs-generate (dir output-file &optional excluded-files
extra-data include-package-version
generate-full)
"Generate loaddefs files for Lisp files in one or more directories given by DIR.
DIR can be either a single directory or a list of directories.
The autoloads will be written to OUTPUT-FILE. If any Lisp file
binds `generated-autoload-file' as a file-local variable, write
its autoloads into the specified file instead.
The function does NOT recursively descend into subdirectories of the
directories specified by DIR.
Optional argument EXCLUDED-FILES, if non-nil, should be a list of
files, such as preloaded files, whose autoloads should not be written
to OUTPUT-FILE.
If EXTRA-DATA is non-nil, it should be a string; include that string
at the beginning of the generated file. This will also force the
generation of OUTPUT-FILE even if there are no autoloads to put into
that file.
If INCLUDE-PACKAGE-VERSION is non-nil, include package version data.
If GENERATE-FULL is non-nil, regenerate all the loaddefs files anew,
instead of just updating them with the new/changed autoloads."
(let* ((files-re (let ((tmp nil))
(dolist (suf (get-load-suffixes))
;; We don't use module-file-suffix below because
;; we don't want to depend on whether Emacs was
;; built with or without modules support, nor
;; what is the suffix for the underlying OS.
(unless (string-match "\\.\\(elc\\|so\\|dll\\)" suf)
(push suf tmp)))
(concat "\\`[^=.].*" (regexp-opt tmp t) "\\'")))
(files (apply #'nconc
(mapcar (lambda (d)
(directory-files (expand-file-name d)
t files-re))
(if (consp dir) dir (list dir)))))
(updating (and (file-exists-p output-file) (not generate-full)))
(defs nil))
;; Allow the excluded files to be relative.
(setq excluded-files
(mapcar (lambda (file) (expand-file-name file dir))
excluded-files))
;; Collect all the autoload data.
(let ((progress (make-progress-reporter
(byte-compile-info
(format "Scraping %s files for loaddefs"
(length files)))
0 (length files) nil 10))
(output-time
(file-attribute-modification-time (file-attributes output-file)))
(file-count 0))
(dolist (file files)
(progress-reporter-update progress (setq file-count (1+ file-count)))
(when (or (not updating)
(time-less-p output-time
(file-attribute-modification-time
(file-attributes file))))
;; If we're scanning for package versions, we want to look
;; at the file even if it's excluded.
(let* ((excluded (member (expand-file-name file dir) excluded-files))
(package-data
(and include-package-version (if excluded 'only t))))
(when (or package-data (not excluded))
(setq defs (nconc (loaddefs-generate--parse-file
file output-file package-data)
defs))))))
(progress-reporter-done progress))
;; First group per output file.
(dolist (fdefs (seq-group-by (lambda (x) (expand-file-name (car x)))
defs))
(let ((loaddefs-file (car fdefs))
hash)
(with-temp-buffer
(if (and updating (file-exists-p loaddefs-file))
(insert-file-contents loaddefs-file)
(insert (loaddefs-generate--rubric
loaddefs-file nil t include-package-version))
(search-backward "\f")
(when extra-data
(insert extra-data)
(ensure-empty-lines 1)))
(setq hash (buffer-hash))
;; Then group by source file (and sort alphabetically).
(dolist (section (sort (seq-group-by #'cadr (cdr fdefs))
(lambda (e1 e2)
(string<
(file-name-sans-extension
(file-name-nondirectory (car e1)))
(file-name-sans-extension
(file-name-nondirectory (car e2)))))))
(pop section)
(let* ((relfile (file-relative-name
(cadar section)
(file-name-directory loaddefs-file)))
(head (concat "\n\f\n;;; Generated autoloads from "
relfile "\n\n")))
(when (file-exists-p loaddefs-file)
;; If we're updating an old loaddefs file, then see if
;; there's a section here for this file already.
(goto-char (point-min))
(if (not (search-forward head nil t))
;; It's a new file; put the data at the end.
(progn
(goto-char (point-max))
(search-backward "\f\n" nil t))
;; Delete the old version of the section. Strictly
;; speaking this should search for "\n\f\n;;;", but
;; there are loaddefs files in the wild that only
;; have two ';;'. (Bug#63236)
(delete-region (match-beginning 0)
(and (search-forward "\n\f\n;;")
(match-beginning 0)))
(forward-line -2)))
(insert head)
(dolist (def (reverse section))
(setq def (caddr def))
(if (stringp def)
(princ def (current-buffer))
(loaddefs-generate--print-form def))
(unless (bolp)
(insert "\n")))))
;; Only write the file if we actually made a change.
(unless (equal (buffer-hash) hash)
(write-region (point-min) (point-max) loaddefs-file nil 'silent)
(byte-compile-info
(file-relative-name loaddefs-file (car (ensure-list dir)))
t "GEN")))))
;; If processing files without any autoloads, the above loop will
;; not generate any files. If the function was invoked with
;; EXTRA-DATA, we want to ensure that even if no autoloads were
;; found, that at least a file will have been generated containing
;; the contents of EXTRA-DATA:
(when (and extra-data (not (file-exists-p output-file)))
(with-temp-buffer
(insert (loaddefs-generate--rubric output-file nil t))
(search-backward "\f")
(insert extra-data)
(ensure-empty-lines 1)
(write-region (point-min) (point-max) output-file nil 'silent)))))
(defun loaddefs-generate--print-form (def)
"Print DEF in a format that makes sense for version control."
(if (or (not (consp def))
(not (symbolp (car def)))
(memq (car def) '( make-obsolete
define-obsolete-function-alias))
(not (stringp (nth 3 def))))
(prin1 def (current-buffer) t)
;; We want to print, for instance, `defvar' values while escaping
;; control characters (so that we don't end up with lines with
;; trailing tab characters and the like), but we don't want to do
;; this for doc strings, because then the doc strings would be on
;; one single line, which would lead to more VC churn. So --
;; typically (defvar foo 'value "\ Doc string" ...).
(insert "(")
(dotimes (_ 3)
(prin1 (pop def) (current-buffer)
'(t (escape-newlines . t)
(escape-control-characters . t)))
(insert " "))
(let ((start (point)))
(prin1 (pop def) (current-buffer) t)
(save-excursion
(goto-char (1+ start))
(insert "\\\n")))
(while def
(insert " ")
(prin1 (pop def) (current-buffer)
'(t (escape-newlines . t)
(escape-control-characters . t))))
(insert ")")))
(defun loaddefs-generate--excluded-files ()
;; Exclude those files that are preloaded on ALL platforms.
;; These are the ones in loadup.el where "(load" is at the start
;; of the line (crude, but it works).
(let ((default-directory (file-name-directory lisp-directory))
(excludes nil)
file)
(with-temp-buffer
(insert-file-contents "loadup.el")
(while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t)
(setq file (match-string 1))
(or (string-match "\\.el\\'" file)
(setq file (format "%s.el" file)))
(or (string-match "\\`site-" file)
(push (expand-file-name file) excludes))))
;; Don't scan ldefs-boot.el, either.
(cons (expand-file-name "ldefs-boot.el") excludes)))
;;;###autoload
(defun loaddefs-generate-batch ()
"Generate loaddefs.el files in batch mode.
This scans for ;;;###autoload forms and related things.
The first element on the command line should be the (main)
loaddefs.el output file, and the rest are the directories to
use."
(let ((args command-line-args-left))
(setq command-line-args-left nil)
(loaddefs-generate (cdr args) (expand-file-name (car args)))))
(defun loaddefs-generate--emacs-batch ()
"Generate the loaddefs for the Emacs build.
This is like `loaddefs-generate-batch', but has some specific
rules for built-in packages and excluded files."
(let ((args command-line-args-left)
(output-file (expand-file-name "loaddefs.el" lisp-directory)))
(setq command-line-args-left nil)
(loaddefs-generate
args output-file
(loaddefs-generate--excluded-files)
nil t
;; Always do a complete update if loaddefs-gen.el has been
;; updated.
(file-newer-than-file-p
(expand-file-name "emacs-lisp/loaddefs-gen.el" lisp-directory)
output-file)))
(let ((lisp-mode-autoload-regexp
"^;;;###\\(\\(noexist\\)-\\)?\\(theme-autoload\\)"))
(loaddefs-generate
(expand-file-name "../etc/themes/" lisp-directory)
(expand-file-name "theme-loaddefs.el" lisp-directory))))
;;;###autoload (load "theme-loaddefs.el" t)
(provide 'loaddefs-gen)
;;; loaddefs-gen.el ends here