mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-21 06:55:39 +00:00
Code Issues Releases Activity
master
emacs/lisp/obsolete/autoload.el
Po Lu 8e1c56ae46 ; Add 2024 to copyright years
2024-01-02 09:47:10 +08:00

916 lines
41 KiB
EmacsLisp
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
;; Copyright (C) 1991-1997, 2001-2024 Free Software Foundation, Inc.
;; Author: Roland McGrath <roland@gnu.org>
;; Keywords: maint
;; Package: emacs
;; Obsolete-since: 29.1
;; 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 code helps GNU Emacs maintainers keep the loaddefs.el file up to
;; date. It interprets magic cookies of the form ";;;###autoload" in
;; 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 superseded by loaddefs-gen.el.
;; Note: When removing this file, also remove the references to
;; `make-directory-autoloads' and `update-directory-autoloads' in
;; subr.el.
;;; Code:
(require 'lisp-mode) ;for `doc-string-elt' properties.
(require 'lisp-mnt)
(require 'cl-lib)
(require 'loaddefs-gen)
;; This feels like it should be a defconst, but MH-E sets it to
;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el.
(defvar generate-autoload-cookie ";;;###autoload"
"Magic comment indicating the following form should be autoloaded.
Used by \\[update-file-autoloads]. This string should be
meaningless to Lisp (e.g., a comment).
This string is used:
\;;;###autoload
\(defun function-to-be-autoloaded () ...)
If this string appears alone on a line, the following form will be
read and an autoload made for it. If there is further text on the line,
that text will be copied verbatim to `generated-autoload-file'.")
(defvar autoload-excludes nil
"If non-nil, list of absolute file names not to scan for autoloads.")
(defconst generate-autoload-section-header "\f\n;;;### "
"String that marks the form at the start of a new file's autoload section.")
(defconst generate-autoload-section-trailer "\n;;;***\n"
"String which indicates the end of the section of autoloads for a file.")
(defconst generate-autoload-section-continuation ";;;;;; "
"String to add on each continuation of the section header form.")
;; In some ways it would be nicer to use a value that is recognizably
;; not a time-value, eg t, but that can cause issues if an older Emacs
;; that does not expect non-time-values loads the file.
(defconst autoload--non-timestamp '(0 0 0 0)
"Value to insert when `autoload-timestamps' is nil.")
(defvar autoload-timestamps nil ; experimental, see bug#22213
"Non-nil means insert a timestamp for each input file into the output.
We use these in incremental updates of the output file to decide
if we need to rescan an input file. If you set this to nil,
then we use the timestamp of the output file instead. As a result:
- for fixed inputs, the output will be the same every time
- incremental updates of the output file might not be correct if:
i) the timestamp of the output file cannot be trusted (at least
relative to that of the input files)
ii) any of the input files can be modified during the time it takes
to create the output
iii) only a subset of the input files are scanned
These issues are unlikely to happen in practice, and would arguably
represent bugs in the build system. Item iii) will happen if you
use a command like `update-file-autoloads', though, since it only
checks a single input file.")
(defvar autoload-modified-buffers) ;Dynamically scoped var.
(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
;; the doc-string in FORM.
;; Those properties are now set in lisp-mode.el.
(defun autoload-find-generated-file (file)
"Visit the autoload file for the current buffer, and return its buffer."
(let ((enable-local-variables :safe)
(enable-local-eval nil)
(find-file-hook nil)
(delay-mode-hooks t))
;; We used to use `raw-text' to read this file, but this causes
;; problems when the file contains non-ASCII characters.
(with-current-buffer (find-file-noselect
(autoload-ensure-file-writeable file))
(if (zerop (buffer-size)) (insert (autoload-rubric file nil t)))
(current-buffer))))
(defun autoload-generated-file (outfile)
"Return OUTFILE as an absolute name.
If `generated-autoload-file' is bound locally in the current
buffer, that is used instead, and it is expanded using the
default directory; otherwise, `source-directory'/lisp is used."
(expand-file-name (if (local-variable-p 'generated-autoload-file)
generated-autoload-file
outfile)
;; File-local settings of generated-autoload-file should
;; be interpreted relative to the file's location,
;; of course.
(if (not (local-variable-p 'generated-autoload-file))
(expand-file-name "lisp" source-directory))))
(defun autoload-read-section-header ()
"Read a section header form.
Since continuation lines have been marked as comments,
we must copy the text of the form and remove those comment
markers before we call `read'."
(save-match-data
(let ((beginning (point))
string)
(forward-line 1)
(while (looking-at generate-autoload-section-continuation)
(forward-line 1))
(setq string (buffer-substring beginning (point)))
(with-current-buffer (get-buffer-create " *autoload*")
(erase-buffer)
(insert string)
(goto-char (point-min))
(while (search-forward generate-autoload-section-continuation nil t)
(replace-match " "))
(goto-char (point-min))
(read (current-buffer))))))
(defvar autoload-print-form-outbuf nil
"Buffer which gets the output of `autoload-print-form'.")
(defun autoload-print-form (form)
"Print FORM such that `make-docfile' will find the docstrings.
The variable `autoload-print-form-outbuf' specifies the buffer to
put the output in."
(cond
;; If the form is a sequence, recurse.
((eq (car form) 'progn) (mapcar #'autoload-print-form (cdr form)))
;; Symbols at the toplevel are meaningless.
((symbolp form) nil)
(t
(let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
(outbuf autoload-print-form-outbuf))
(if (and (numberp doc-string-elt) (stringp (nth doc-string-elt form)))
;; We need to hack the printing because the
;; doc-string must be printed specially for
;; make-docfile (sigh).
(let* ((p (nthcdr (1- doc-string-elt) form))
(elt (cdr p)))
(setcdr p nil)
(princ "\n(" outbuf)
(let ((print-escape-newlines t)
(print-escape-control-characters t)
(print-quoted t)
(print-escape-nonascii t))
(dolist (elt form)
(prin1 elt outbuf)
(princ " " outbuf)))
(princ "\"\\\n" outbuf)
(let ((begin (with-current-buffer outbuf (point))))
(princ (substring (prin1-to-string (car elt)) 1)
outbuf)
;; Insert a backslash before each ( that
;; appears at the beginning of a line in
;; the doc string.
(with-current-buffer outbuf
(save-excursion
(while (re-search-backward "\n[[(]" begin t)
(forward-char 1)
(insert "\\"))))
(if (null (cdr elt))
(princ ")" outbuf)
(princ " " outbuf)
(princ (substring (prin1-to-string (cdr elt)) 1)
outbuf))
(terpri outbuf)))
(let ((print-escape-newlines t)
(print-escape-control-characters t)
(print-quoted t)
(print-escape-nonascii t))
(print form outbuf)))))))
(defalias 'autoload-rubric #'loaddefs-generate--rubric)
(defvar autoload-ensure-writable nil
"Non-nil means `autoload-find-generated-file' makes existing file writable.")
;; Just in case someone tries to get you to overwrite a file that you
;; don't want to.
;;;###autoload
(put 'autoload-ensure-writable 'risky-local-variable t)
(defun autoload-ensure-file-writeable (file)
;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
;; which was designed to handle CVSREAD=1 and equivalent.
(and autoload-ensure-writable
(let ((modes (file-modes file)))
(if (and modes (zerop (logand modes #o0200)))
;; Ignore any errors here, and let subsequent attempts
;; to write the file raise any real error.
(ignore-errors (set-file-modes file (logior modes #o0200))))))
file)
(defun autoload-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)."
;; (cl-assert ;Make sure we don't insert it in the middle of another section.
;; (save-excursion
;; (or (not (re-search-backward
;; (concat "\\("
;; (regexp-quote generate-autoload-section-header)
;; "\\)\\|\\("
;; (regexp-quote generate-autoload-section-trailer)
;; "\\)")
;; nil t))
;; (match-end 2))))
(insert generate-autoload-section-header)
(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" generate-autoload-section-continuation))))))
(defun autoload-find-file (file)
"Fetch FILE and put it in a temp buffer. Return the buffer."
;; It is faster to avoid visiting the file.
(setq file (expand-file-name file))
(with-current-buffer (get-buffer-create " *autoload-file*")
(kill-all-local-variables)
(erase-buffer)
(setq buffer-undo-list t
buffer-read-only nil)
(delay-mode-hooks (emacs-lisp-mode))
(setq default-directory (file-name-directory file))
(insert-file-contents file nil)
(let ((enable-local-variables :safe)
(enable-local-eval nil))
(hack-local-variables))
(current-buffer)))
(defalias 'autoload-file-load-name #'loaddefs-generate--file-load-name)
(defun generate-file-autoloads (file)
"Insert at point a loaddefs autoload section for FILE.
Autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
If FILE is being visited in a buffer, the contents of the buffer
are used.
Return non-nil in the case where no autoloads were added at point."
(interactive "fGenerate autoloads for file: ")
(let ((autoload-modified-buffers nil))
(autoload-generate-file-autoloads file (current-buffer) buffer-file-name)
autoload-modified-buffers))
(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
memory, we'll end up looking in too many files when we need a particular
prefix), and if set too large, they will be too specific (i.e. they will
cost more memory use).")
(defconst autoload-def-prefixes-max-length 12
"Target size of definition prefixes.
Don't try to split prefixes that are already longer than that.")
(defalias 'autoload--make-defs-autoload #'loaddefs-generate--make-prefixes)
(defun autoload--setup-output (otherbuf outbuf absfile load-name output-file)
(let ((outbuf
(or (if otherbuf
;; A file-local setting of
;; autoload-generated-file says we
;; should ignore OUTBUF.
nil
outbuf)
(autoload-find-destination absfile load-name output-file)
;; The file has autoload cookies, but they're
;; already up-to-date. If OUTFILE is nil, the
;; entries are in the expected OUTBUF,
;; otherwise they're elsewhere.
(throw 'done otherbuf))))
(with-current-buffer outbuf
(point-marker))))
(defun autoload--print-cookie-text (output-start load-name file)
(let ((standard-output (marker-buffer output-start)))
(search-forward generate-autoload-cookie)
(skip-chars-forward " \t")
(if (eolp)
(condition-case-unless-debug err
;; Read the next form and make an autoload.
(let* ((form (prog1 (read (current-buffer))
(or (bolp) (forward-line 1))))
(autoload (make-autoload form load-name)))
(if autoload
nil
(setq autoload form))
(let ((autoload-print-form-outbuf
standard-output))
(autoload-print-form autoload)))
(error
(message "Autoload cookie error in %s:%s %S"
file (count-lines (point-min) (point)) err)))
;; Copy the rest of the line to the output.
(princ (buffer-substring
(progn
;; Back up over whitespace, to preserve it.
(skip-chars-backward " \f\t")
(if (= (char-after (1+ (point))) ? )
;; Eat one space.
(forward-char 1))
(point))
(progn (forward-line 1) (point)))))))
(defvar autoload-builtin-package-versions nil)
(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
marked by `generate-autoload-cookie' (which see).
If FILE is being visited in a buffer, the contents of the buffer are used.
OUTBUF is the buffer in which the autoload statements should be inserted.
If OUTBUF is nil, the output will go to OUTFILE, unless there's a
buffer-local setting of `generated-autoload-file' in FILE.
Return non-nil if and only if FILE adds no autoloads to OUTFILE
\(or OUTBUF if OUTFILE is nil). The actual return value is
FILE's modification time."
;; Include the file name in any error messages
(condition-case err
(let (load-name
(print-length nil)
(print-level nil)
(float-output-format nil)
(visited (get-file-buffer file))
(otherbuf nil)
(absfile (expand-file-name file))
(defs '())
;; nil until we found a cookie.
output-start)
(when
(catch 'done
(with-current-buffer (or visited
;; It is faster to avoid visiting the file.
(autoload-find-file file))
;; Obey the no-update-autoloads file local variable.
(unless no-update-autoloads
(or noninteractive (message "Generating autoloads for %s..." file))
(setq load-name
(if (stringp generated-autoload-load-name)
generated-autoload-load-name
(autoload-file-load-name absfile outfile)))
;; FIXME? Comparing file-names for equality with just equal
;; is fragile, eg if one has an automounter prefix and one
;; does not, but both refer to the same physical file.
(when (and outfile
(not outbuf)
(not
(if (memq system-type '(ms-dos windows-nt))
(equal (downcase outfile)
(downcase (autoload-generated-file
outfile)))
(equal outfile (autoload-generated-file
outfile)))))
(setq otherbuf t))
(save-excursion
(save-restriction
(widen)
(when autoload-builtin-package-versions
(let ((version (lm-header "version"))
package)
(and version
(setq version (ignore-errors (version-to-list version)))
(setq package (or (lm-header "package")
(file-name-sans-extension
(file-name-nondirectory file))))
(setq output-start (autoload--setup-output
otherbuf outbuf absfile
load-name outfile))
(let ((standard-output (marker-buffer output-start))
(print-quoted t))
(princ `(push (purecopy
',(cons (intern package) version))
package--builtin-versions))
(princ "\n")))))
;; Do not insert autoload entries for excluded files.
(unless (member absfile autoload-excludes)
(goto-char (point-min))
(while (not (eobp))
(skip-chars-forward " \t\n\f")
(cond
((looking-at (regexp-quote generate-autoload-cookie))
;; If not done yet, figure out where to insert this text.
(unless output-start
(setq output-start (autoload--setup-output
otherbuf outbuf absfile
load-name outfile)))
(autoload--print-cookie-text output-start load-name file))
((= (following-char) ?\;)
;; Don't read the comment.
(forward-line 1))
(t
;; Avoid (defvar <foo>) by requiring a trailing space.
;; Also, ignore this prefix business
;; for ;;;###tramp-autoload and friends.
(when (and (equal generate-autoload-cookie ";;;###autoload")
(looking-at "(\\(def[^ ]+\\) ['(]*\\([^' ()\"\n]+\\)[\n \t]")
(not (member
(match-string 1)
autoload-ignored-definitions)))
(push (match-string-no-properties 2) defs))
(forward-sexp 1)
(forward-line 1)))))))
(when (and autoload-compute-prefixes defs)
;; This output needs to always go in the main loaddefs.el,
;; regardless of generated-autoload-file.
;; FIXME: the files that don't have autoload cookies but
;; do have definitions end up listed twice in loaddefs.el:
;; once for their register-definition-prefixes and once in
;; the list of "files without any autoloads".
(let ((form (autoload--make-defs-autoload defs load-name)))
(cond
((null form)) ;All defs obey the default rule, yay!
((not otherbuf)
(unless output-start
(setq output-start (autoload--setup-output
nil outbuf absfile load-name outfile)))
(let ((autoload-print-form-outbuf
(marker-buffer output-start)))
(autoload-print-form form)))
(t
(let* ((other-output-start
;; To force the output to go to the main loaddefs.el
;; rather than to generated-autoload-file,
;; there are two cases: if outbuf is non-nil,
;; then passing otherbuf=nil is enough, but if
;; outbuf is nil, that won't cut it, so we
;; locally bind generated-autoload-file.
(autoload--setup-output nil outbuf absfile load-name
outfile))
(autoload-print-form-outbuf
(marker-buffer other-output-start)))
(autoload-print-form form)
(with-current-buffer (marker-buffer other-output-start)
(save-excursion
;; Insert the section-header line which lists
;; the file name and which functions are in it, etc.
(goto-char other-output-start)
(let ((relfile (file-relative-name absfile)))
(autoload-insert-section-header
(marker-buffer other-output-start)
"actual autoloads are elsewhere" load-name relfile
(if autoload-timestamps
(file-attribute-modification-time
(file-attributes absfile))
autoload--non-timestamp))
(insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer)))))))
(when output-start
(let ((secondary-autoloads-file-buf
(if otherbuf (current-buffer))))
(with-current-buffer (marker-buffer output-start)
(cl-assert (> (point) output-start))
(save-excursion
;; Insert the section-header line which lists the file name
;; and which functions are in it, etc.
(goto-char output-start)
(let ((relfile (file-relative-name absfile)))
(autoload-insert-section-header
(marker-buffer output-start)
() load-name relfile
(if secondary-autoloads-file-buf
;; MD5 checksums are much better because they do not
;; change unless the file changes (so they'll be
;; equal on two different systems and will change
;; less often than time-stamps, thus leading to fewer
;; unneeded changes causing spurious conflicts), but
;; using time-stamps is a very useful optimization,
;; so we use time-stamps for the main autoloads file
;; (loaddefs.el) where we have special ways to
;; circumvent the "random change problem", and MD5
;; checksum in secondary autoload files where we do
;; not need the time-stamp optimization because it is
;; already provided by the primary autoloads file.
(md5 secondary-autoloads-file-buf
;; We'd really want to just use
;; `emacs-internal' instead.
nil nil 'emacs-mule-unix)
(if autoload-timestamps
(file-attribute-modification-time
(file-attributes relfile))
autoload--non-timestamp)))
(insert ";;; Generated autoloads from " relfile "\n")))
(insert generate-autoload-section-trailer))))
(or noninteractive
(message "Generating autoloads for %s...done" file)))
(or visited
;; We created this buffer, so we should kill it.
(kill-buffer (current-buffer))))
(or (not output-start)
;; If the entries were added to some other buffer, then the file
;; doesn't add entries to OUTFILE.
otherbuf))
(file-attribute-modification-time (file-attributes absfile))))
(error
;; Probably unbalanced parens in forward-sexp. In that case, the
;; condition is scan-error, and the signal data includes point
;; where the error was found; we'd like to convert that to
;; line:col, but line-number-at-pos gets the wrong line in batch
;; mode for some reason.
;;
;; At least this gets the file name in the error message; the
;; developer can use goto-char to get to the error position.
(error "%s:0:0: error: %s: %s" file (car err) (cdr err)))
))
;; For parallel builds, to stop another process reading a half-written file.
(defun autoload--save-buffer ()
"Save current buffer to its file, atomically."
;; Similar to byte-compile-file.
(let* ((version-control 'never)
(tempfile (make-temp-file buffer-file-name))
(default-modes (default-file-modes))
(temp-modes (logand default-modes #o600))
(desired-modes (logand default-modes
(or (file-modes buffer-file-name) #o666)))
(kill-emacs-hook
(cons (lambda () (ignore-errors (delete-file tempfile)))
kill-emacs-hook)))
(unless (= temp-modes desired-modes)
(set-file-modes tempfile desired-modes 'nofollow))
(write-region (point-min) (point-max) tempfile nil 1)
(backup-buffer)
(rename-file tempfile buffer-file-name t))
(set-buffer-modified-p nil)
(set-visited-file-modtime)
(or noninteractive (message "Wrote %s" buffer-file-name)))
(defun autoload-save-buffers ()
(while autoload-modified-buffers
(with-current-buffer (pop autoload-modified-buffers)
(autoload--save-buffer))))
;; FIXME This command should be deprecated.
;; See https://debbugs.gnu.org/22213#41
;;;###autoload
(defun update-file-autoloads (file &optional save-after outfile)
"Update the autoloads for FILE.
If prefix arg SAVE-AFTER is non-nil, save the buffer too.
If FILE binds `generated-autoload-file' as a file-local variable,
autoloads are written into that file. Otherwise, the autoloads
file is determined by OUTFILE. If called interactively, prompt
for OUTFILE; if called from Lisp with OUTFILE nil, use the
existing value of `generated-autoload-file'.
Return FILE if there was no autoload cookie in it, else nil."
(interactive (list (read-file-name "Update autoloads for file: ")
current-prefix-arg
(read-file-name "Write autoload definitions to file: ")))
(setq outfile (or outfile generated-autoload-file))
(let* ((autoload-modified-buffers nil)
;; We need this only if the output file handles more than one input.
;; See https://debbugs.gnu.org/22213#38 and subsequent.
(autoload-timestamps t)
(no-autoloads (autoload-generate-file-autoloads
file nil
(if (local-variable-p 'generated-autoload-file)
generated-autoload-file
outfile))))
(if autoload-modified-buffers
(if save-after (autoload-save-buffers))
(if (called-interactively-p 'interactive)
(message "Autoload section for %s is up to date." file)))
(if no-autoloads file)))
(defun autoload-find-destination (file load-name output-file)
"Find the destination point of the current buffer's autoloads.
FILE is the file name of the current buffer.
LOAD-NAME is the name as it appears in the output.
Returns a buffer whose point is placed at the requested location.
Returns nil if the file's autoloads are up-to-date, otherwise
removes any prior now out-of-date autoload entries."
(catch 'up-to-date
(let* ((buf (current-buffer))
(existing-buffer (if buffer-file-name buf))
(output-file (autoload-generated-file output-file))
(output-time (if (file-exists-p output-file)
(file-attribute-modification-time
(file-attributes output-file))))
(found nil))
(with-current-buffer (autoload-find-generated-file output-file)
;; This is to make generated-autoload-file have Unix EOLs, so
;; that it is portable to all platforms.
(or (eq 0 (coding-system-eol-type buffer-file-coding-system))
(set-buffer-file-coding-system 'unix))
(or (> (buffer-size) 0)
(error "Autoloads file %s lacks boilerplate" buffer-file-name))
(or (file-writable-p buffer-file-name)
(error "Autoloads file %s is not writable" buffer-file-name))
(widen)
(goto-char (point-min))
;; Look for the section for LOAD-NAME.
(while (and (not found)
(search-forward generate-autoload-section-header nil t))
(let ((form (autoload-read-section-header)))
(cond ((string= (nth 2 form) load-name)
;; We found the section for this file.
;; Check if it is up to date.
(let ((begin (match-beginning 0))
(last-time (nth 4 form))
(file-time (file-attribute-modification-time
(file-attributes file))))
(if (and (or (null existing-buffer)
(not (buffer-modified-p existing-buffer)))
(cond
;; FIXME? Arguably we should throw a
;; user error, or some kind of warning,
;; if we were called from update-file-autoloads,
;; which can update only a single input file.
;; It's not appropriate to use the output
;; file modtime in such a case,
;; if there are multiple input files
;; contributing to the output.
((and output-time
(member last-time
(list t autoload--non-timestamp)))
(not (time-less-p output-time file-time)))
;; last-time is the time-stamp (specifying
;; the last time we looked at the file) and
;; the file hasn't been changed since.
((listp last-time)
(not (time-less-p last-time file-time)))
;; last-time is an MD5 checksum instead.
((stringp last-time)
(equal last-time
(md5 buf nil nil 'emacs-mule)))))
(throw 'up-to-date nil)
(autoload-remove-section begin)
(setq found t))))
((string< load-name (nth 2 form))
;; We've come to a section alphabetically later than
;; LOAD-NAME. We assume the file is in order and so
;; there must be no section for LOAD-NAME. We will
;; insert one before the section here.
(goto-char (match-beginning 0))
(setq found t)))))
(or found
(progn
;; No later sections in the file. Put before the last page.
(goto-char (point-max))
(search-backward "\f" nil t)))
(unless (memq (current-buffer) autoload-modified-buffers)
(push (current-buffer) autoload-modified-buffers))
(current-buffer)))))
(defun autoload-remove-section (begin)
(goto-char begin)
(search-forward generate-autoload-section-trailer)
(delete-region begin (point)))
;;;###autoload
(defun update-directory-autoloads (&rest dirs)
"Update autoload definitions for Lisp files in the directories DIRS.
In an interactive call, you must give one argument, the name of a
single directory. In a call from Lisp, you can supply multiple
directories as separate arguments, but this usage is discouraged.
The function does NOT recursively descend into subdirectories of the
directory or directories specified.
In an interactive call, prompt for a default output file for the
autoload definitions. When called from Lisp, use the existing
value of `generated-autoload-file'. If any Lisp file binds
`generated-autoload-file' as a file-local variable, write its
autoloads into the specified file instead."
(declare (obsolete loaddefs-generate "29.1"))
(interactive "DUpdate autoloads from directory: ")
(make-directory-autoloads
dirs
(if (called-interactively-p 'interactive)
(read-file-name "Write autoload definitions to file: ")
generated-autoload-file)))
;;;###autoload
(defun make-directory-autoloads (dir output-file)
"Update autoload definitions for Lisp files in the directories DIR.
DIR can be either a single directory or a list of
directories. (The latter usage is discouraged.)
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."
(declare (obsolete loaddefs-generate "29.1"))
(interactive "DUpdate autoloads from directory: \nFWrite to file: ")
(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)))))
(done ()) ;Files processed; to remove duplicates.
(changed nil) ;Non-nil if some change occurred.
(last-time)
;; Files with no autoload cookies or whose autoloads go to other
;; files because of file-local autoload-generated-file settings.
(no-autoloads nil)
;; Ensure that we don't do odd things when putting the doc
;; strings into the autoloads file.
(left-margin 0)
(autoload-modified-buffers nil)
(output-time
(and (file-exists-p output-file)
(file-attribute-modification-time
(file-attributes output-file)))))
(with-current-buffer (autoload-find-generated-file output-file)
(save-excursion
;; Canonicalize file names and remove the autoload file itself.
(setq files (delete (file-relative-name buffer-file-name)
(mapcar #'file-relative-name files)))
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
(let* ((form (autoload-read-section-header))
(file (nth 3 form)))
(cond ((and (consp file) (stringp (car file)))
;; This is a list of files that have no autoload cookies.
;; There shouldn't be more than one such entry.
;; Remove the obsolete section.
(autoload-remove-section (match-beginning 0))
(setq last-time (nth 4 form))
(if (member last-time (list t autoload--non-timestamp))
(setq last-time output-time))
(dolist (file file)
(let ((file-time (file-attribute-modification-time
(file-attributes file))))
(when (and file-time
(not (time-less-p last-time file-time)))
;; file unchanged
(push file no-autoloads)
(setq files (delete file files))))))
((not (stringp file)))
((or (not (file-exists-p file))
;; Remove duplicates as well, just in case.
(member file done))
;; Remove the obsolete section.
(setq changed t)
(autoload-remove-section (match-beginning 0)))
((not (time-less-p (let ((oldtime (nth 4 form)))
(if (member oldtime
(list
t autoload--non-timestamp))
output-time
oldtime))
(file-attribute-modification-time
(file-attributes file))))
;; File hasn't changed.
nil)
(t
(setq changed t)
(autoload-remove-section (match-beginning 0))
(if (autoload-generate-file-autoloads
;; Passing `current-buffer' makes it insert at point.
file (current-buffer) buffer-file-name)
(push file no-autoloads))))
(push file done)
(setq files (delete file files)))))
;; Elements remaining in FILES have no existing autoload sections yet.
(let ((no-autoloads-time (or last-time '(0 0 0 0)))
(progress (make-progress-reporter
(byte-compile-info
(concat "Scraping files for "
(file-relative-name output-file)))
0 (length files) nil 10))
(file-count 0)
file-time)
(dolist (file files)
(progress-reporter-update progress (setq file-count (1+ file-count)))
(cond
;; Passing nil as second argument forces
;; autoload-generate-file-autoloads to look for the right
;; spot where to insert each autoloads section.
((setq file-time
(autoload-generate-file-autoloads file nil buffer-file-name))
(push file no-autoloads)
(if (time-less-p no-autoloads-time file-time)
(setq no-autoloads-time file-time)))
(t (setq changed t))))
(progress-reporter-done progress)
(when no-autoloads
;; Sort them for better readability.
(setq no-autoloads (sort no-autoloads 'string<))
;; Add the `no-autoloads' section.
(goto-char (point-max))
(search-backward "\f" nil t)
(autoload-insert-section-header
(current-buffer) nil nil
;; Filter out the other loaddefs files, because it makes
;; the list unstable (and leads to spurious changes in
;; ldefs-boot.el) since the loaddef files can be created in
;; any order.
(seq-filter (lambda (file)
(not (string-match-p "[/-]loaddefs.el" file)))
no-autoloads)
(if autoload-timestamps
no-autoloads-time
autoload--non-timestamp))
(insert generate-autoload-section-trailer)))
;; Don't modify the file if its content has not been changed, so `make'
;; dependencies don't trigger unnecessarily.
(if (not changed)
(set-buffer-modified-p nil)
(autoload--save-buffer))
;; In case autoload entries were added to other files because of
;; file-local autoload-generated-file settings.
(autoload-save-buffers))))
(defun batch-update-autoloads--summary (strings)
(let ((message ""))
(while strings
(when (> (length (concat message " " (car strings))) 64)
(byte-compile-info (concat message " ...") t "SCRAPE")
(setq message ""))
(setq message (if (zerop (length message))
(car strings)
(concat message " " (car strings))))
(setq strings (cdr strings)))
(when (> (length message) 0)
(byte-compile-info message t "SCRAPE"))))
;;;###autoload
(defun batch-update-autoloads ()
"Update loaddefs.el autoloads in batch mode.
Calls `update-directory-autoloads' on the command line arguments.
Definitions are written to `generated-autoload-file' (which
should be non-nil)."
;; For use during the Emacs build process only.
;; 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).
(unless autoload-excludes
(let ((default-directory (file-name-directory generated-autoload-file))
file)
(when (file-readable-p "loadup.el")
(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) autoload-excludes)))))))
(let ((args command-line-args-left))
(batch-update-autoloads--summary args)
(setq command-line-args-left nil)
(with-suppressed-warnings ((obsolete make-directory-autoloads))
(make-directory-autoloads args generated-autoload-file))))
(provide 'autoload)
;;; autoload.el ends here
Reference in New Issue View Git Blame Copy Permalink