mirror of
git://git.sv.gnu.org/emacs.git
synced 2025-12-15 18:40:39 -08:00
Speed up generation of loaddefs files
* 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
parent
41a2def162
commit
1d4e903417
13 changed files with 706 additions and 453 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -165,6 +165,12 @@
|
|||
|
||||
"Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
|
||||
|
||||
(defconst lisp-mode-autoload-regexp
|
||||
"^;;;###\\(\\([-[:alnum:]]+?\\)-\\)?\\(autoload\\)"
|
||||
"Regexp to match autoload cookies.
|
||||
The second group matches package names used to redirect autoloads
|
||||
to a package-local <package>-loaddefs.el file.")
|
||||
|
||||
;; This was originally in autoload.el and is still used there.
|
||||
(put 'autoload 'doc-string-elt 3)
|
||||
(put 'defmethod 'doc-string-elt 3)
|
||||
|
|
@ -430,7 +436,8 @@ This will generate compile-time constants from BINDINGS."
|
|||
nil t))
|
||||
;; Emacs Lisp autoload cookies. Supports the slightly different
|
||||
;; forms used by mh-e, calendar, etc.
|
||||
("^;;;###\\([-a-z]*autoload\\)" 1 font-lock-warning-face prepend))
|
||||
(,lisp-mode-autoload-regexp (3 font-lock-warning-face prepend)
|
||||
(2 font-lock-function-name-face prepend)))
|
||||
"Subdued level highlighting for Emacs Lisp mode.")
|
||||
|
||||
(defconst lisp-cl-font-lock-keywords-1
|
||||
|
|
@ -660,7 +667,9 @@ font-lock keywords will not be case sensitive."
|
|||
(setq-local indent-line-function 'lisp-indent-line)
|
||||
(setq-local indent-region-function 'lisp-indent-region)
|
||||
(setq-local comment-indent-function #'lisp-comment-indent)
|
||||
(setq-local outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
|
||||
(setq-local outline-regexp (concat ";;;;* [^ \t\n]\\|(\\|\\("
|
||||
lisp-mode-autoload-regexp
|
||||
"\\)"))
|
||||
(setq-local outline-level 'lisp-outline-level)
|
||||
(setq-local add-log-current-defun-function #'lisp-current-defun-name)
|
||||
(setq-local comment-start ";")
|
||||
|
|
@ -700,7 +709,8 @@ font-lock keywords will not be case sensitive."
|
|||
;; Expects outline-regexp is ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|("
|
||||
;; and point is at the beginning of a matching line.
|
||||
(let ((len (- (match-end 0) (match-beginning 0))))
|
||||
(cond ((looking-at "(\\|;;;###autoload")
|
||||
(cond ((or (looking-at-p "(")
|
||||
(looking-at-p lisp-mode-autoload-regexp))
|
||||
1000)
|
||||
((looking-at ";;\\(;+\\) ")
|
||||
(- (match-end 1) (match-beginning 1)))
|
||||
|
|
|
|||
633
lisp/emacs-lisp/loaddefs-gen.el
Normal file
633
lisp/emacs-lisp/loaddefs-gen.el
Normal file
|
|
@ -0,0 +1,633 @@
|
|||
;;; loaddefs-gen.el --- generate loaddefs.el files -*- lexical-binding: t -*-
|
||||
|
||||
;; Copyright (C) 2022 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 <https://www.gnu.org/licenses/>.
|
||||
|
||||
;;; 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)
|
||||
|
||||
(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-local-variable #'booleanp)
|
||||
|
||||
(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 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' 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)))
|
||||
|
||||
(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)))
|
||||
;; (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)
|
||||
(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))
|
||||
(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))
|
||||
(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))))
|
||||
|
||||
(defun loaddefs-generate--make-prefixes (defs file)
|
||||
;; Remove the defs that obey the rule that file foo.el (or
|
||||
;; foo-mode.el) uses "foo-" as prefix. 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))))))
|
||||
(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<))))))
|
||||
|
||||
(defun loaddefs-generate--parse-file (file main-outfile &optional package-data)
|
||||
"Examing FILE for ;;;###autoload statements.
|
||||
MAIN-OUTFILE is the main loaddefs file these statements are
|
||||
destined for, but this can be overriden 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))
|
||||
(compute-prefixes t)
|
||||
local-outfile inhibit-autoloads)
|
||||
(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.
|
||||
(when (search-backward ";; Local Variables:" (- (point-max) 1000) t)
|
||||
(save-excursion
|
||||
(when (re-search-forward "generated-autoload-file: *" nil t)
|
||||
;; Buffer-local file that should be interpreted relative to
|
||||
;; the .el file.
|
||||
(setq local-outfile (expand-file-name (read (current-buffer))
|
||||
(file-name-directory file)))))
|
||||
(save-excursion
|
||||
(when (re-search-forward "generated-autoload-load-name: *" nil t)
|
||||
(setq load-name (read (current-buffer)))))
|
||||
(save-excursion
|
||||
(when (re-search-forward "no-update-autoloads: *" nil t)
|
||||
(setq inhibit-autoloads (read (current-buffer)))))
|
||||
(save-excursion
|
||||
(when (re-search-forward "autoload-compute-prefixes: *" nil t)
|
||||
(setq compute-prefixes (read (current-buffer))))))
|
||||
|
||||
;; We always return the package version (even for pre-dumped
|
||||
;; files).
|
||||
(when package-data
|
||||
(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 inhibit-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)
|
||||
;; ... 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 (and autoload-compute-prefixes
|
||||
compute-prefixes)
|
||||
(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))
|
||||
;; Avoid (defvar <foo>) by requiring a trailing space.
|
||||
(while (re-search-forward
|
||||
"^(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]" nil t)
|
||||
(unless (member (match-string 1) autoload-ignored-definitions)
|
||||
(let ((name (match-string-no-properties 2)))
|
||||
(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)
|
||||
"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")))
|
||||
|
||||
(defun loaddefs-generate--insert-section-header (outbuf autoloads
|
||||
load-name file time)
|
||||
"Insert into buffer OUTBUF the section-header line for FILE.
|
||||
The header line lists the file name, its \"load name\", its autoloads,
|
||||
and the time the FILE was last updated (the time is inserted only
|
||||
if `autoload-timestamps' is non-nil, otherwise a fixed fake time is inserted)."
|
||||
(insert "\f\n;;;### ")
|
||||
(prin1 `(autoloads ,autoloads ,load-name ,file ,time)
|
||||
outbuf)
|
||||
(terpri outbuf)
|
||||
;; Break that line at spaces, to avoid very long lines.
|
||||
;; Make each sub-line into a comment.
|
||||
(with-current-buffer outbuf
|
||||
(save-excursion
|
||||
(forward-line -1)
|
||||
(while (not (eolp))
|
||||
(move-to-column 64)
|
||||
(skip-chars-forward "^ \n")
|
||||
(or (eolp)
|
||||
(insert "\n" ";;;;;; "))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun loaddefs-generate (dir output-file &optional excluded-files
|
||||
extra-data include-package-version)
|
||||
"Generate loaddefs files for Lisp files in the directories DIRS.
|
||||
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
|
||||
directory or directories specified.
|
||||
|
||||
If EXTRA-DATA, include this string at the start of the generated file.
|
||||
|
||||
If INCLUDE-PACKAGE-VERSION, include package version data."
|
||||
(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)))))
|
||||
(defs nil))
|
||||
|
||||
;; Collect all the autoload data.
|
||||
(let ((progress (make-progress-reporter
|
||||
(byte-compile-info
|
||||
(concat "Scraping files for loaddefs"))
|
||||
0 (length files) nil 10))
|
||||
(file-count 0))
|
||||
(dolist (file files)
|
||||
(progress-reporter-update progress (setq file-count (1+ file-count)))
|
||||
;; Do not insert autoload entries for excluded files.
|
||||
(setq defs (nconc
|
||||
(loaddefs-generate--parse-file
|
||||
file output-file
|
||||
;; We only want the package name from the
|
||||
;; excluded files.
|
||||
(and include-package-version
|
||||
(if (member (expand-file-name file) excluded-files)
|
||||
'only
|
||||
t)))
|
||||
defs)))
|
||||
(progress-reporter-done progress))
|
||||
|
||||
;; Generate the loaddef files. First group per output file.
|
||||
(dolist (fdefs (seq-group-by #'car defs))
|
||||
(with-temp-buffer
|
||||
(insert (loaddefs-generate--rubric (car fdefs) nil t))
|
||||
(search-backward "\f")
|
||||
(when extra-data
|
||||
(insert extra-data)
|
||||
(ensure-empty-lines 1))
|
||||
;; The 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 (car fdefs)))))
|
||||
(insert "\f\n;;; Generated autoloads from " relfile "\n\n")
|
||||
(dolist (def (reverse section))
|
||||
(setq def (caddr def))
|
||||
(if (stringp def)
|
||||
(princ def (current-buffer))
|
||||
(loaddefs-generate--print-form def))
|
||||
(unless (bolp)
|
||||
(insert "\n")))
|
||||
(insert "\n")))
|
||||
(write-region (point-min) (point-max) (car fdefs) nil 'silent)
|
||||
(byte-compile-info (file-relative-name (car fdefs) lisp-directory)
|
||||
t "GEN")))))
|
||||
|
||||
(defun loaddefs-generate--print-form (def)
|
||||
"Print DEF in the way make-docfile.c expects it."
|
||||
(if (or (not (consp def))
|
||||
(not (symbolp (car def)))
|
||||
(not (stringp (nth 3 def))))
|
||||
(prin1 def (current-buffer) t)
|
||||
;; The salient point here is that we have to have the doc string
|
||||
;; that starts with a backslash and a newline, and there mustn't
|
||||
;; be any newlines before that. 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))
|
||||
(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)
|
||||
(output-file (expand-file-name (car args) lisp-directory)))
|
||||
(setq command-line-args-left nil)
|
||||
(loaddefs-generate
|
||||
(cdr args) output-file
|
||||
(loaddefs-generate--excluded-files)
|
||||
nil
|
||||
;; When generating the top-level Emacs loaddefs file, we want to
|
||||
;; include the `package--builtin-versions' things.
|
||||
(equal (file-name-directory output-file) lisp-directory))))
|
||||
|
||||
(provide 'loaddefs-gen)
|
||||
|
||||
;;; loaddefs-gen.el ends here
|
||||
|
|
@ -1003,6 +1003,7 @@ untar into a directory named DIR; otherwise, signal an error."
|
|||
|
||||
(defun package-autoload-ensure-default-file (file)
|
||||
"Make sure that the autoload file FILE exists and if not create it."
|
||||
(declare (obsolete nil "29.1"))
|
||||
(unless (file-exists-p file)
|
||||
(require 'autoload)
|
||||
(let ((coding-system-for-write 'utf-8-emacs-unix))
|
||||
|
|
@ -1021,8 +1022,11 @@ untar into a directory named DIR; otherwise, signal an error."
|
|||
(autoload-timestamps nil)
|
||||
(backup-inhibited t)
|
||||
(version-control 'never))
|
||||
(package-autoload-ensure-default-file output-file)
|
||||
(make-directory-autoloads pkg-dir output-file)
|
||||
(loaddefs-generate
|
||||
pkg-dir output-file
|
||||
nil
|
||||
"(add-to-list 'load-path (directory-file-name
|
||||
(or (file-name-directory #$) (car load-path))))")
|
||||
(let ((buf (find-buffer-visiting output-file)))
|
||||
(when buf (kill-buffer buf)))
|
||||
auto-name))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue