procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Speed up generation of loaddefs files

Browse source 
* doc/lispref/loading.texi (Autoload, Autoload by Prefix): Refer
to loaddefs-generate instead of update-file-autoloads.

* lisp/Makefile.in (LOADDEFS): Remove, because all the loaddefs
files are created in one go now.
(COMPILE_FIRST): Add loaddefs-gen/radix-tree, and drop autoload.
($(lisp)/loaddefs.el): Use loaddefs-gen.
(MH_E_DIR, $(TRAMP_DIR)/tramp-loaddefs.el)
($(MH_E_DIR)/mh-loaddefs.el, $(CAL_DIR)/cal-loaddefs.el)
($(CAL_DIR)/diary-loaddefs.el, $(CAL_DIR)/hol-loaddefs.el): Remove.

* lisp/generic-x.el: Inhibit computing prefixes, because the
namespace here is all wonky.

* lisp/w32-fns.el (w32-batch-update-autoloads): Removed -- unused
function.

* lisp/calendar/holidays.el ("holiday-loaddefs"): Renamed from
hol-loaddefs to have a more regular name.

* lisp/cedet/ede/proj-elisp.el (ede-emacs-cedet-autogen-compiler):
Refer to loaddefs-gen instead of autoload.

* lisp/emacs-lisp/autoload.el (make-autoload, autoload-rubric)
(autoload-insert-section-header): Made into aliases of
loaddefs-gen functions.
(autoload--make-defs-autoload): Ditto.
(autoload-ignored-definitions, autoload-compute-prefixes): Moved
to loaddefs-gen.

* lisp/emacs-lisp/lisp-mode.el (lisp-mode-autoload-regexp): New
constant.
(lisp-fdefs, lisp-mode-variables, lisp-outline-level): Use it to
recognize all ;;;###autoload forms.

* lisp/emacs-lisp/loaddefs-gen.el: New file.

* lisp/emacs-lisp/package.el: Use loaddefs-generate instead of
make-directory-autoloads.

* test/lisp/vc/vc-bzr-tests.el (vc-bzr-test-faulty-bzr-autoloads):
Use loaddefs instead of autoloads.
This commit is contained in:
Lars Ingebrigtsen 2022-05-31 18:08:33 +02:00
parent 41a2def162
commit 1d4e903417
13 changed files with 706 additions and 453 deletions
Download patch file Download diff file Expand all files Collapse all files

349
lisp/emacs-lisp/autoload.el
View file

@ -28,11 +28,15 @@
;; Lisp source files in various useful ways. To learn more, read the
;; source; if you're going to use this, you'd better be able to.
;; The functions in this file have been largely superseded by
;; loaddefs-gen.el.
;;; Code:
(require 'lisp-mode) ;for `doc-string-elt' properties.
(require 'lisp-mnt)
(require 'cl-lib)
(require 'loaddefs-gen)
(defvar generated-autoload-file nil
"File into which to write autoload definitions.
@ -112,165 +116,7 @@ then we use the timestamp of the output file instead. As a result:
(defvar autoload-modified-buffers) ;Dynamically scoped var.
(defun 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)))
;; (message "autoload of %S" (nth 1 form))
`(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
((and expansion (memq car '(progn prog1)))
(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)
(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))
(macrop car)
(setq expand (let ((load-true-file-name file)
(load-file-name file))
(macroexpand form)))
(memq (car expand) '(progn prog1 defalias)))
(make-autoload expand file 'expansion)) ;Recurse on the 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))
(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)
(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
`(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))
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))))))
((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)))
`(let ((loads (get ',groupname 'custom-loads)))
(if (member ',file loads) nil
(put ',groupname 'custom-loads (cons ',file 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))))
(defalias 'make-autoload #'loaddefs-generate--make-autoload)
;; Forms which have doc-strings which should be printed specially.
;; A doc-string-elt property of ELT says that (nth ELT FORM) is
@ -379,41 +225,7 @@ put the output in."
(print-escape-nonascii t))
(print form outbuf)))))))
(defun autoload-rubric (file &optional type feature)
"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."
(let ((basename (file-name-nondirectory file))
(lp (if (equal type "package") (setq type "autoloads"))))
(concat ";;; " basename
" --- automatically extracted " (or type "autoloads")
" -*- lexical-binding: t -*-\n"
(when (string-match "/lisp/loaddefs\\.el\\'" file)
";; This file will be copied to ldefs-boot.el and checked in periodically.\n")
";;\n"
";;; Code:\n\n"
(if lp
"(add-to-list 'load-path (directory-file-name
(or (file-name-directory #$) (car load-path))))\n\n")
" \n"
;; This is used outside of autoload.el, eg cus-dep, finder.
(if feature
(format "(provide '%s)\n"
(if (stringp feature) feature
(file-name-sans-extension basename))))
";; Local Variables:\n"
";; version-control: never\n"
";; no-byte-compile: t\n" ;; #$ is byte-compiled into nil.
";; no-update-autoloads: t\n"
";; coding: utf-8-emacs-unix\n"
";; End:\n"
";;; " basename
" ends here\n")))
(defalias 'autoload-rubric #'loaddefs-generate--rubric)
(defvar autoload-ensure-writable nil
"Non-nil means `autoload-find-generated-file' makes existing file writable.")
@ -480,35 +292,13 @@ if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
(hack-local-variables))
(current-buffer)))
(defalias 'autoload-insert-section-header
#'loaddefs-generate--insert-section-header)
(defvar no-update-autoloads nil
"File local variable to prevent scanning this file for autoload cookies.")
(defun autoload-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' has directory components, only keep the
;; last few that are really needed.
(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)))
(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name)
(defun generate-file-autoloads (file)
"Insert at point a loaddefs autoload section for FILE.
@ -522,13 +312,6 @@ Return non-nil in the case where no autoloads were added at point."
(autoload-generate-file-autoloads file (current-buffer) buffer-file-name)
autoload-modified-buffers))
(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.")
(put 'autoload-compute-prefixes 'safe #'booleanp)
(defconst autoload-def-prefixes-max-entries 5
"Target length of the list of definition prefixes per file.
If set too small, the prefixes will be too generic (i.e. they'll use little
@ -540,102 +323,7 @@ cost more memory use).")
"Target size of definition prefixes.
Don't try to split prefixes that are already longer than that.")
(require 'radix-tree)
(defun autoload--make-defs-autoload (defs file)
;; Remove the defs that obey the rule that file foo.el (or
;; foo-mode.el) uses "foo-" as prefix.
;; FIXME: help--symbol-completion-table still doesn't know how to use
;; the rule that file foo.el (or foo-mode.el) uses "foo-" as prefix.
;;(let ((prefix
;; (concat (substring file 0 (string-match "-mode\\'" file)) "-")))
;; (dolist (def (prog1 defs (setq defs nil)))
;; (unless (string-prefix-p prefix def)
;; (push def defs))))
;; Then compute a small set of prefixes that cover all the
;; remaining definitions.
(let* ((tree (let ((tree radix-tree-empty))
(dolist (def defs)
(setq tree (radix-tree-insert tree def t)))
tree))
(prefixes nil))
;; Get the root prefixes, that we should include in any case.
(radix-tree-iter-subtrees
tree (lambda (prefix subtree)
(push (cons prefix subtree) prefixes)))
;; In some cases, the root prefixes are too short, e.g. if you define
;; "cc-helper" and "c-mode", you'll get "c" in the root prefixes.
(dolist (pair (prog1 prefixes (setq prefixes nil)))
(let ((s (car pair)))
(if (or (and (> (length s) 2) ; Long enough!
;; But don't use "def" from deffoo-pkg-thing.
(not (string= "def" s)))
(string-match ".[[:punct:]]\\'" s) ;A real (tho short) prefix?
(radix-tree-lookup (cdr pair) "")) ;Nothing to expand!
(push pair prefixes) ;Keep it as is.
(radix-tree-iter-subtrees
(cdr pair) (lambda (prefix subtree)
(push (cons (concat s prefix) subtree) prefixes))))))
;; FIXME: The expansions done below are mostly pointless, such as
;; for `yenc', where we replace "yenc-" with an exhaustive list (5
;; elements).
;; (while
;; (let ((newprefixes nil)
;; (changes nil))
;; (dolist (pair prefixes)
;; (let ((prefix (car pair)))
;; (if (or (> (length prefix) autoload-def-prefixes-max-length)
;; (radix-tree-lookup (cdr pair) ""))
;; ;; No point splitting it any further.
;; (push pair newprefixes)
;; (setq changes t)
;; (radix-tree-iter-subtrees
;; (cdr pair) (lambda (sprefix subtree)
;; (push (cons (concat prefix sprefix) subtree)
;; newprefixes))))))
;; (and changes
;; (<= (length newprefixes)
;; autoload-def-prefixes-max-entries)
;; (let ((new nil)
;; (old nil))
;; (dolist (pair prefixes)
;; (unless (memq pair newprefixes) ;Not old
;; (push pair old)))
;; (dolist (pair newprefixes)
;; (unless (memq pair prefixes) ;Not new
;; (push pair new)))
;; (cl-assert new)
;; (message "Expanding %S to %S"
;; (mapcar #'car old) (mapcar #'car new))
;; t)
;; (setq prefixes newprefixes)
;; (< (length prefixes) autoload-def-prefixes-max-entries))))
;; (message "Final prefixes %s : %S" file (mapcar #'car prefixes))
(when prefixes
(let ((strings
(mapcar
(lambda (x)
(let ((prefix (car x)))
(if (or (> (length prefix) 2) ;Long enough!
(and (eq (length prefix) 2)
(string-match "[[:punct:]]" prefix)))
prefix
;; Some packages really don't follow the rules.
;; Drop the most egregious cases such as the
;; one-letter prefixes.
(let ((dropped ()))
(radix-tree-iter-mappings
(cdr x) (lambda (s _)
(push (concat prefix s) dropped)))
(message "%s:0: Warning: Not registering prefix \"%s\". Affects: %S"
file prefix dropped)
nil))))
prefixes)))
`(register-definition-prefixes ,file ',(sort (delq nil strings)
'string<))))))
(defalias 'autoload--make-defs-autoload #'loaddefs-generate--make-prefixes)
(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file)
(let ((outbuf
@ -687,21 +375,6 @@ Don't try to split prefixes that are already longer than that.")
(defvar autoload-builtin-package-versions nil)
(defvar autoload-ignored-definitions
'("define-obsolete-function-alias"
"define-obsolete-variable-alias"
"define-category" "define-key"
"defgroup" "defface" "defadvice"
"def-edebug-spec"
;; Hmm... this is getting ugly:
"define-widget"
"define-erc-module"
"define-erc-response-handler"
"defun-rcirc-command")
"List of strings naming definitions to ignore for prefixes.
More specifically those definitions will not be considered for the
`register-definition-prefixes' call.")
(defun autoload-generate-file-autoloads (file &optional outbuf outfile)
"Insert an autoload section for FILE in the appropriate buffer.
Autoloads are generated for defuns and defmacros in FILE