]> code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/autoload.el
Merge from origin/emacs-25
[gnu-emacs] / lisp / emacs-lisp / autoload.el
1 ;; autoload.el --- maintain autoloads in loaddefs.el -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 1991-1997, 2001-2016 Free Software Foundation, Inc.
4
5 ;; Author: Roland McGrath <roland@gnu.org>
6 ;; Keywords: maint
7 ;; Package: emacs
8
9 ;; This file is part of GNU Emacs.
10
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
27 ;; date. It interprets magic cookies of the form ";;;###autoload" in
28 ;; lisp source files in various useful ways. To learn more, read the
29 ;; source; if you're going to use this, you'd better be able to.
30
31 ;;; Code:
32
33 (require 'lisp-mode) ;for `doc-string-elt' properties.
34 (require 'lisp-mnt)
35 (eval-when-compile (require 'cl-lib))
36
37 (defvar generated-autoload-file nil
38 "File into which to write autoload definitions.
39 A Lisp file can set this in its local variables section to make
40 its autoloads go somewhere else.
41
42 If this is a relative file name, the directory is determined as
43 follows:
44 - If a Lisp file defined `generated-autoload-file' as a
45 file-local variable, use its containing directory.
46 - Otherwise use the \"lisp\" subdirectory of `source-directory'.
47
48 The autoload file is assumed to contain a trailer starting with a
49 FormFeed character.")
50 ;;;###autoload
51 (put 'generated-autoload-file 'safe-local-variable 'stringp)
52
53 (defvar generated-autoload-load-name nil
54 "Load name for `autoload' statements generated from autoload cookies.
55 If nil, this defaults to the file name, sans extension.
56 Typically, you need to set this when the directory containing the file
57 is not in `load-path'.
58 This also affects the generated cus-load.el file.")
59 ;;;###autoload
60 (put 'generated-autoload-load-name 'safe-local-variable 'stringp)
61
62 ;; This feels like it should be a defconst, but MH-E sets it to
63 ;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el.
64 (defvar generate-autoload-cookie ";;;###autoload"
65 "Magic comment indicating the following form should be autoloaded.
66 Used by \\[update-file-autoloads]. This string should be
67 meaningless to Lisp (e.g., a comment).
68
69 This string is used:
70
71 \;;;###autoload
72 \(defun function-to-be-autoloaded () ...)
73
74 If this string appears alone on a line, the following form will be
75 read and an autoload made for it. If there is further text on the line,
76 that text will be copied verbatim to `generated-autoload-file'.")
77
78 (defvar autoload-excludes nil
79 "If non-nil, list of absolute file names not to scan for autoloads.")
80
81 (defconst generate-autoload-section-header "\f\n;;;### "
82 "String that marks the form at the start of a new file's autoload section.")
83
84 (defconst generate-autoload-section-trailer "\n;;;***\n"
85 "String which indicates the end of the section of autoloads for a file.")
86
87 (defconst generate-autoload-section-continuation ";;;;;; "
88 "String to add on each continuation of the section header form.")
89
90 (defvar autoload-timestamps nil ; experimental, see bug#22213
91 "Non-nil means insert a timestamp for each input file into the output.
92 We use these in incremental updates of the output file to decide
93 if we need to rescan an input file. If you set this to nil,
94 then we use the timestamp of the output file instead. As a result:
95 - for fixed inputs, the output will be the same every time
96 - incremental updates of the output file might not be correct if:
97 i) the timestamp of the output file cannot be trusted (at least
98 relative to that of the input files)
99 ii) any of the input files can be modified during the time it takes
100 to create the output
101 iii) only a subset of the input files are scanned
102 These issues are unlikely to happen in practice, and would arguably
103 represent bugs in the build system. Item iii) will happen if you
104 use a command like `update-file-autoloads', though, since it only
105 checks a single input file.")
106
107 (defvar autoload-modified-buffers) ;Dynamically scoped var.
108
109 (defun make-autoload (form file &optional expansion)
110 "Turn FORM into an autoload or defvar for source file FILE.
111 Returns nil if FORM is not a special autoload form (i.e. a function definition
112 or macro definition or a defcustom).
113 If EXPANSION is non-nil, we're processing the macro expansion of an
114 expression, in which case we want to handle forms differently."
115 (let ((car (car-safe form)) expand)
116 (cond
117 ((and expansion (eq car 'defalias))
118 (pcase-let*
119 ((`(,_ ,_ ,arg . ,rest) form)
120 ;; `type' is non-nil if it defines a macro.
121 ;; `fun' is the function part of `arg' (defaults to `arg').
122 ((or (and (or `(cons 'macro ,fun) `'(macro . ,fun)) (let type t))
123 (and (let fun arg) (let type nil)))
124 arg)
125 ;; `lam' is the lambda expression in `fun' (or nil if not
126 ;; recognized).
127 (lam (if (memq (car-safe fun) '(quote function)) (cadr fun)))
128 ;; `args' is the list of arguments (or t if not recognized).
129 ;; `body' is the body of `lam' (or t if not recognized).
130 ((or `(lambda ,args . ,body)
131 (and (let args t) (let body t)))
132 lam)
133 ;; Get the `doc' from `body' or `rest'.
134 (doc (cond ((stringp (car-safe body)) (car body))
135 ((stringp (car-safe rest)) (car rest))))
136 ;; Look for an interactive spec.
137 (interactive (pcase body
138 ((or `((interactive . ,_) . ,_)
139 `(,_ (interactive . ,_) . ,_))
140 t))))
141 ;; Add the usage form at the end where describe-function-1
142 ;; can recover it.
143 (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
144 ;; (message "autoload of %S" (nth 1 form))
145 `(autoload ,(nth 1 form) ,file ,doc ,interactive ,type)))
146
147 ((and expansion (memq car '(progn prog1)))
148 (let ((end (memq :autoload-end form)))
149 (when end ;Cut-off anything after the :autoload-end marker.
150 (setq form (copy-sequence form))
151 (setcdr (memq :autoload-end form) nil))
152 (let ((exps (delq nil (mapcar (lambda (form)
153 (make-autoload form file expansion))
154 (cdr form)))))
155 (when exps (cons 'progn exps)))))
156
157 ;; For complex cases, try again on the macro-expansion.
158 ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
159 define-globalized-minor-mode defun defmacro
160 easy-mmode-define-minor-mode define-minor-mode
161 define-inline cl-defun cl-defmacro))
162 (macrop car)
163 (setq expand (let ((load-file-name file)) (macroexpand form)))
164 (memq (car expand) '(progn prog1 defalias)))
165 (make-autoload expand file 'expansion)) ;Recurse on the expansion.
166
167 ;; For special function-like operators, use the `autoload' function.
168 ((memq car '(define-skeleton define-derived-mode
169 define-compilation-mode define-generic-mode
170 easy-mmode-define-global-mode define-global-minor-mode
171 define-globalized-minor-mode
172 easy-mmode-define-minor-mode define-minor-mode
173 cl-defun defun* cl-defmacro defmacro*
174 define-overloadable-function))
175 (let* ((macrop (memq car '(defmacro cl-defmacro defmacro*)))
176 (name (nth 1 form))
177 (args (pcase car
178 ((or `defun `defmacro
179 `defun* `defmacro* `cl-defun `cl-defmacro
180 `define-overloadable-function) (nth 2 form))
181 (`define-skeleton '(&optional str arg))
182 ((or `define-generic-mode `define-derived-mode
183 `define-compilation-mode) nil)
184 (_ t)))
185 (body (nthcdr (or (function-get car 'doc-string-elt) 3) form))
186 (doc (if (stringp (car body)) (pop body))))
187 ;; Add the usage form at the end where describe-function-1
188 ;; can recover it.
189 (when (listp args) (setq doc (help-add-fundoc-usage doc args)))
190 ;; `define-generic-mode' quotes the name, so take care of that
191 `(autoload ,(if (listp name) name (list 'quote name))
192 ,file ,doc
193 ,(or (and (memq car '(define-skeleton define-derived-mode
194 define-generic-mode
195 easy-mmode-define-global-mode
196 define-global-minor-mode
197 define-globalized-minor-mode
198 easy-mmode-define-minor-mode
199 define-minor-mode)) t)
200 (eq (car-safe (car body)) 'interactive))
201 ,(if macrop ''macro nil))))
202
203 ;; For defclass forms, use `eieio-defclass-autoload'.
204 ((eq car 'defclass)
205 (let ((name (nth 1 form))
206 (superclasses (nth 2 form))
207 (doc (nth 4 form)))
208 (list 'eieio-defclass-autoload (list 'quote name)
209 (list 'quote superclasses) file doc)))
210
211 ;; Convert defcustom to less space-consuming data.
212 ((eq car 'defcustom)
213 (let ((varname (car-safe (cdr-safe form)))
214 (init (car-safe (cdr-safe (cdr-safe form))))
215 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
216 ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
217 )
218 `(progn
219 (defvar ,varname ,init ,doc)
220 (custom-autoload ',varname ,file
221 ,(condition-case nil
222 (null (cadr (memq :set form)))
223 (error nil))))))
224
225 ((eq car 'defgroup)
226 ;; In Emacs this is normally handled separately by cus-dep.el, but for
227 ;; third party packages, it can be convenient to explicitly autoload
228 ;; a group.
229 (let ((groupname (nth 1 form)))
230 `(let ((loads (get ',groupname 'custom-loads)))
231 (if (member ',file loads) nil
232 (put ',groupname 'custom-loads (cons ',file loads))))))
233
234 ;; When processing a macro expansion, any expression
235 ;; before a :autoload-end should be included. These are typically (put
236 ;; 'fun 'prop val) and things like that.
237 ((and expansion (consp form)) form)
238
239 ;; nil here indicates that this is not a special autoload form.
240 (t nil))))
241
242 ;; Forms which have doc-strings which should be printed specially.
243 ;; A doc-string-elt property of ELT says that (nth ELT FORM) is
244 ;; the doc-string in FORM.
245 ;; Those properties are now set in lisp-mode.el.
246
247 (defun autoload-find-generated-file ()
248 "Visit the autoload file for the current buffer, and return its buffer.
249 If a buffer is visiting the desired autoload file, return it."
250 (let ((enable-local-variables :safe)
251 (enable-local-eval nil))
252 ;; We used to use `raw-text' to read this file, but this causes
253 ;; problems when the file contains non-ASCII characters.
254 (let ((delay-mode-hooks t))
255 (find-file-noselect
256 (autoload-ensure-default-file (autoload-generated-file))))))
257
258 (defun autoload-generated-file ()
259 (expand-file-name generated-autoload-file
260 ;; File-local settings of generated-autoload-file should
261 ;; be interpreted relative to the file's location,
262 ;; of course.
263 (if (not (local-variable-p 'generated-autoload-file))
264 (expand-file-name "lisp" source-directory))))
265
266
267 (defun autoload-read-section-header ()
268 "Read a section header form.
269 Since continuation lines have been marked as comments,
270 we must copy the text of the form and remove those comment
271 markers before we call `read'."
272 (save-match-data
273 (let ((beginning (point))
274 string)
275 (forward-line 1)
276 (while (looking-at generate-autoload-section-continuation)
277 (forward-line 1))
278 (setq string (buffer-substring beginning (point)))
279 (with-current-buffer (get-buffer-create " *autoload*")
280 (erase-buffer)
281 (insert string)
282 (goto-char (point-min))
283 (while (search-forward generate-autoload-section-continuation nil t)
284 (replace-match " "))
285 (goto-char (point-min))
286 (read (current-buffer))))))
287
288 (defvar autoload-print-form-outbuf nil
289 "Buffer which gets the output of `autoload-print-form'.")
290
291 (defun autoload-print-form (form)
292 "Print FORM such that `make-docfile' will find the docstrings.
293 The variable `autoload-print-form-outbuf' specifies the buffer to
294 put the output in."
295 (cond
296 ;; If the form is a sequence, recurse.
297 ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form)))
298 ;; Symbols at the toplevel are meaningless.
299 ((symbolp form) nil)
300 (t
301 (let ((doc-string-elt (function-get (car-safe form) 'doc-string-elt))
302 (outbuf autoload-print-form-outbuf))
303 (if (and doc-string-elt (stringp (nth doc-string-elt form)))
304 ;; We need to hack the printing because the
305 ;; doc-string must be printed specially for
306 ;; make-docfile (sigh).
307 (let* ((p (nthcdr (1- doc-string-elt) form))
308 (elt (cdr p)))
309 (setcdr p nil)
310 (princ "\n(" outbuf)
311 (let ((print-escape-newlines t)
312 (print-quoted t)
313 (print-escape-nonascii t))
314 (dolist (elt form)
315 (prin1 elt outbuf)
316 (princ " " outbuf)))
317 (princ "\"\\\n" outbuf)
318 (let ((begin (with-current-buffer outbuf (point))))
319 (princ (substring (prin1-to-string (car elt)) 1)
320 outbuf)
321 ;; Insert a backslash before each ( that
322 ;; appears at the beginning of a line in
323 ;; the doc string.
324 (with-current-buffer outbuf
325 (save-excursion
326 (while (re-search-backward "\n[[(]" begin t)
327 (forward-char 1)
328 (insert "\\"))))
329 (if (null (cdr elt))
330 (princ ")" outbuf)
331 (princ " " outbuf)
332 (princ (substring (prin1-to-string (cdr elt)) 1)
333 outbuf))
334 (terpri outbuf)))
335 (let ((print-escape-newlines t)
336 (print-quoted t)
337 (print-escape-nonascii t))
338 (print form outbuf)))))))
339
340 (defun autoload-rubric (file &optional type feature)
341 "Return a string giving the appropriate autoload rubric for FILE.
342 TYPE (default \"autoloads\") is a string stating the type of
343 information contained in FILE. If FEATURE is non-nil, FILE
344 will provide a feature. FEATURE may be a string naming the
345 feature, otherwise it will be based on FILE's name.
346
347 At present, a feature is in fact always provided, but this should
348 not be relied upon."
349 (let ((basename (file-name-nondirectory file)))
350 (concat ";;; " basename
351 " --- automatically extracted " (or type "autoloads") "\n"
352 ";;\n"
353 ";;; Code:\n\n"
354 "\f\n"
355 ;; This is used outside of autoload.el, eg cus-dep, finder.
356 "(provide '"
357 (if (stringp feature)
358 feature
359 (file-name-sans-extension basename))
360 ")\n"
361 ";; Local Variables:\n"
362 ";; version-control: never\n"
363 ";; no-byte-compile: t\n"
364 ";; no-update-autoloads: t\n"
365 ";; coding: utf-8\n"
366 ";; End:\n"
367 ";;; " basename
368 " ends here\n")))
369
370 (defvar autoload-ensure-writable nil
371 "Non-nil means `autoload-ensure-default-file' makes existing file writable.")
372 ;; Just in case someone tries to get you to overwrite a file that you
373 ;; don't want to.
374 ;;;###autoload
375 (put 'autoload-ensure-writable 'risky-local-variable t)
376
377 (defun autoload-ensure-default-file (file)
378 "Make sure that the autoload file FILE exists, creating it if needed.
379 If the file already exists and `autoload-ensure-writable' is non-nil,
380 make it writable."
381 (if (file-exists-p file)
382 ;; Probably pointless, but replaces the old AUTOGEN_VCS in lisp/Makefile,
383 ;; which was designed to handle CVSREAD=1 and equivalent.
384 (and autoload-ensure-writable
385 (let ((modes (file-modes file)))
386 (if (zerop (logand modes #o0200))
387 ;; Ignore any errors here, and let subsequent attempts
388 ;; to write the file raise any real error.
389 (ignore-errors (set-file-modes file (logior modes #o0200))))))
390 (write-region (autoload-rubric file) nil file))
391 file)
392
393 (defun autoload-insert-section-header (outbuf autoloads load-name file time)
394 "Insert the section-header line,
395 which lists the file name and which functions are in it, etc."
396 (insert generate-autoload-section-header)
397 (prin1 `(autoloads ,autoloads ,load-name ,file ,time)
398 outbuf)
399 (terpri outbuf)
400 ;; Break that line at spaces, to avoid very long lines.
401 ;; Make each sub-line into a comment.
402 (with-current-buffer outbuf
403 (save-excursion
404 (forward-line -1)
405 (while (not (eolp))
406 (move-to-column 64)
407 (skip-chars-forward "^ \n")
408 (or (eolp)
409 (insert "\n" generate-autoload-section-continuation))))))
410
411 (defun autoload-find-file (file)
412 "Fetch file and put it in a temp buffer. Return the buffer."
413 ;; It is faster to avoid visiting the file.
414 (setq file (expand-file-name file))
415 (with-current-buffer (get-buffer-create " *autoload-file*")
416 (kill-all-local-variables)
417 (erase-buffer)
418 (setq buffer-undo-list t
419 buffer-read-only nil)
420 (delay-mode-hooks (emacs-lisp-mode))
421 (setq default-directory (file-name-directory file))
422 (insert-file-contents file nil)
423 (let ((enable-local-variables :safe)
424 (enable-local-eval nil))
425 (hack-local-variables))
426 (current-buffer)))
427
428 (defvar no-update-autoloads nil
429 "File local variable to prevent scanning this file for autoload cookies.")
430
431 (defun autoload-file-load-name (file)
432 "Compute the name that will be used to load FILE."
433 ;; OUTFILE should be the name of the global loaddefs.el file, which
434 ;; is expected to be at the root directory of the files we're
435 ;; scanning for autoloads and will be in the `load-path'.
436 (let* ((outfile (default-value 'generated-autoload-file))
437 (name (file-relative-name file (file-name-directory outfile)))
438 (names '())
439 (dir (file-name-directory outfile)))
440 ;; If `name' has directory components, only keep the
441 ;; last few that are really needed.
442 (while name
443 (setq name (directory-file-name name))
444 (push (file-name-nondirectory name) names)
445 (setq name (file-name-directory name)))
446 (while (not name)
447 (cond
448 ((null (cdr names)) (setq name (car names)))
449 ((file-exists-p (expand-file-name "subdirs.el" dir))
450 ;; FIXME: here we only check the existence of subdirs.el,
451 ;; without checking its content. This makes it generate wrong load
452 ;; names for cases like lisp/term which is not added to load-path.
453 (setq dir (expand-file-name (pop names) dir)))
454 (t (setq name (mapconcat 'identity names "/")))))
455 (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
456 (substring name 0 (match-beginning 0))
457 name)))
458
459 (defun generate-file-autoloads (file)
460 "Insert at point a loaddefs autoload section for FILE.
461 Autoloads are generated for defuns and defmacros in FILE
462 marked by `generate-autoload-cookie' (which see).
463 If FILE is being visited in a buffer, the contents of the buffer
464 are used.
465 Return non-nil in the case where no autoloads were added at point."
466 (interactive "fGenerate autoloads for file: ")
467 (let ((generated-autoload-file buffer-file-name))
468 (autoload-generate-file-autoloads file (current-buffer))))
469
470 (defvar print-readably)
471
472
473 (defun autoload--setup-output (otherbuf outbuf absfile load-name)
474 (let ((outbuf
475 (or (if otherbuf
476 ;; A file-local setting of
477 ;; autoload-generated-file says we
478 ;; should ignore OUTBUF.
479 nil
480 outbuf)
481 (autoload-find-destination absfile load-name)
482 ;; The file has autoload cookies, but they're
483 ;; already up-to-date. If OUTFILE is nil, the
484 ;; entries are in the expected OUTBUF,
485 ;; otherwise they're elsewhere.
486 (throw 'done otherbuf))))
487 (with-current-buffer outbuf
488 (point-marker))))
489
490 (defun autoload--print-cookie-text (output-start load-name file)
491 (let ((standard-output (marker-buffer output-start)))
492 (search-forward generate-autoload-cookie)
493 (skip-chars-forward " \t")
494 (if (eolp)
495 (condition-case-unless-debug err
496 ;; Read the next form and make an autoload.
497 (let* ((form (prog1 (read (current-buffer))
498 (or (bolp) (forward-line 1))))
499 (autoload (make-autoload form load-name)))
500 (if autoload
501 nil
502 (setq autoload form))
503 (let ((autoload-print-form-outbuf
504 standard-output))
505 (autoload-print-form autoload)))
506 (error
507 (message "Autoload cookie error in %s:%s %S"
508 file (count-lines (point-min) (point)) err)))
509
510 ;; Copy the rest of the line to the output.
511 (princ (buffer-substring
512 (progn
513 ;; Back up over whitespace, to preserve it.
514 (skip-chars-backward " \f\t")
515 (if (= (char-after (1+ (point))) ? )
516 ;; Eat one space.
517 (forward-char 1))
518 (point))
519 (progn (forward-line 1) (point)))))))
520
521 (defvar autoload-builtin-package-versions nil)
522
523 ;; When called from `generate-file-autoloads' we should ignore
524 ;; `generated-autoload-file' altogether. When called from
525 ;; `update-file-autoloads' we don't know `outbuf'. And when called from
526 ;; `update-directory-autoloads' it's in between: we know the default
527 ;; `outbuf' but we should obey any file-local setting of
528 ;; `generated-autoload-file'.
529 (defun autoload-generate-file-autoloads (file &optional outbuf outfile)
530 "Insert an autoload section for FILE in the appropriate buffer.
531 Autoloads are generated for defuns and defmacros in FILE
532 marked by `generate-autoload-cookie' (which see).
533 If FILE is being visited in a buffer, the contents of the buffer are used.
534 OUTBUF is the buffer in which the autoload statements should be inserted.
535 If OUTBUF is nil, it will be determined by `autoload-generated-file'.
536
537 If provided, OUTFILE is expected to be the file name of OUTBUF.
538 If OUTFILE is non-nil and FILE specifies a `generated-autoload-file'
539 different from OUTFILE, then OUTBUF is ignored.
540
541 Return non-nil if and only if FILE adds no autoloads to OUTFILE
542 \(or OUTBUF if OUTFILE is nil). The actual return value is
543 FILE's modification time."
544 ;; Include the file name in any error messages
545 (condition-case err
546 (let (load-name
547 (print-length nil)
548 (print-level nil)
549 (print-readably t) ; This does something in Lucid Emacs.
550 (float-output-format nil)
551 (visited (get-file-buffer file))
552 (otherbuf nil)
553 (absfile (expand-file-name file))
554 ;; nil until we found a cookie.
555 output-start)
556 (when
557 (catch 'done
558 (with-current-buffer (or visited
559 ;; It is faster to avoid visiting the file.
560 (autoload-find-file file))
561 ;; Obey the no-update-autoloads file local variable.
562 (unless no-update-autoloads
563 (or noninteractive (message "Generating autoloads for %s..." file))
564 (setq load-name
565 (if (stringp generated-autoload-load-name)
566 generated-autoload-load-name
567 (autoload-file-load-name absfile)))
568 ;; FIXME? Comparing file-names for equality with just equal
569 ;; is fragile, eg if one has an automounter prefix and one
570 ;; does not, but both refer to the same physical file.
571 (when (and outfile
572 (not
573 (if (memq system-type '(ms-dos windows-nt))
574 (equal (downcase outfile)
575 (downcase (autoload-generated-file)))
576 (equal outfile (autoload-generated-file)))))
577 (setq otherbuf t))
578 (save-excursion
579 (save-restriction
580 (widen)
581 (when autoload-builtin-package-versions
582 (let ((version (lm-header "version"))
583 package)
584 (and version
585 (setq version (ignore-errors (version-to-list version)))
586 (setq package (or (lm-header "package")
587 (file-name-sans-extension
588 (file-name-nondirectory file))))
589 (setq output-start (autoload--setup-output
590 otherbuf outbuf absfile load-name))
591 (let ((standard-output (marker-buffer output-start))
592 (print-quoted t))
593 (princ `(push (purecopy
594 ',(cons (intern package) version))
595 package--builtin-versions))
596 (princ "\n")))))
597
598 (goto-char (point-min))
599 (while (not (eobp))
600 (skip-chars-forward " \t\n\f")
601 (cond
602 ((looking-at (regexp-quote generate-autoload-cookie))
603 ;; If not done yet, figure out where to insert this text.
604 (unless output-start
605 (setq output-start (autoload--setup-output
606 otherbuf outbuf absfile load-name)))
607 (autoload--print-cookie-text output-start load-name file))
608 ((looking-at ";")
609 ;; Don't read the comment.
610 (forward-line 1))
611 (t
612 (forward-sexp 1)
613 (forward-line 1))))))
614
615 (when output-start
616 (let ((secondary-autoloads-file-buf
617 (if otherbuf (current-buffer))))
618 (with-current-buffer (marker-buffer output-start)
619 (save-excursion
620 ;; Insert the section-header line which lists the file name
621 ;; and which functions are in it, etc.
622 (goto-char output-start)
623 (let ((relfile (file-relative-name absfile)))
624 (autoload-insert-section-header
625 (marker-buffer output-start)
626 () load-name relfile
627 (if secondary-autoloads-file-buf
628 ;; MD5 checksums are much better because they do not
629 ;; change unless the file changes (so they'll be
630 ;; equal on two different systems and will change
631 ;; less often than time-stamps, thus leading to fewer
632 ;; unneeded changes causing spurious conflicts), but
633 ;; using time-stamps is a very useful optimization,
634 ;; so we use time-stamps for the main autoloads file
635 ;; (loaddefs.el) where we have special ways to
636 ;; circumvent the "random change problem", and MD5
637 ;; checksum in secondary autoload files where we do
638 ;; not need the time-stamp optimization because it is
639 ;; already provided by the primary autoloads file.
640 (md5 secondary-autoloads-file-buf
641 ;; We'd really want to just use
642 ;; `emacs-internal' instead.
643 nil nil 'emacs-mule-unix)
644 (if autoload-timestamps
645 (nth 5 (file-attributes relfile))
646 t)))
647 (insert ";;; Generated autoloads from " relfile "\n")))
648 (insert generate-autoload-section-trailer))))
649 (or noninteractive
650 (message "Generating autoloads for %s...done" file)))
651 (or visited
652 ;; We created this buffer, so we should kill it.
653 (kill-buffer (current-buffer))))
654 (or (not output-start)
655 ;; If the entries were added to some other buffer, then the file
656 ;; doesn't add entries to OUTFILE.
657 otherbuf))
658 (nth 5 (file-attributes absfile))))
659 (error
660 ;; Probably unbalanced parens in forward-sexp. In that case, the
661 ;; condition is scan-error, and the signal data includes point
662 ;; where the error was found; we'd like to convert that to
663 ;; line:col, but line-number-at-pos gets the wrong line in batch
664 ;; mode for some reason.
665 ;;
666 ;; At least this gets the file name in the error message; the
667 ;; developer can use goto-char to get to the error position.
668 (error "%s:0:0: error: %s: %s" file (car err) (cdr err)))
669 ))
670 \f
671 (defun autoload-save-buffers ()
672 (while autoload-modified-buffers
673 (with-current-buffer (pop autoload-modified-buffers)
674 (let ((version-control 'never))
675 (save-buffer)))))
676
677 ;; FIXME This command should be deprecated.
678 ;; See http://debbugs.gnu.org/22213#41
679 ;;;###autoload
680 (defun update-file-autoloads (file &optional save-after outfile)
681 "Update the autoloads for FILE.
682 If prefix arg SAVE-AFTER is non-nil, save the buffer too.
683
684 If FILE binds `generated-autoload-file' as a file-local variable,
685 autoloads are written into that file. Otherwise, the autoloads
686 file is determined by OUTFILE. If called interactively, prompt
687 for OUTFILE; if called from Lisp with OUTFILE nil, use the
688 existing value of `generated-autoload-file'.
689
690 Return FILE if there was no autoload cookie in it, else nil."
691 (interactive (list (read-file-name "Update autoloads for file: ")
692 current-prefix-arg
693 (read-file-name "Write autoload definitions to file: ")))
694 (let* ((generated-autoload-file (or outfile generated-autoload-file))
695 (autoload-modified-buffers nil)
696 ;; We need this only if the output file handles more than one input.
697 ;; See http://debbugs.gnu.org/22213#38 and subsequent.
698 (autoload-timestamps t)
699 (no-autoloads (autoload-generate-file-autoloads file)))
700 (if autoload-modified-buffers
701 (if save-after (autoload-save-buffers))
702 (if (called-interactively-p 'interactive)
703 (message "Autoload section for %s is up to date." file)))
704 (if no-autoloads file)))
705
706 (defun autoload-find-destination (file load-name)
707 "Find the destination point of the current buffer's autoloads.
708 FILE is the file name of the current buffer.
709 LOAD-NAME is the name as it appears in the output.
710 Returns a buffer whose point is placed at the requested location.
711 Returns nil if the file's autoloads are up-to-date, otherwise
712 removes any prior now out-of-date autoload entries."
713 (catch 'up-to-date
714 (let* ((buf (current-buffer))
715 (existing-buffer (if buffer-file-name buf))
716 (output-file (autoload-generated-file))
717 (output-time (if (file-exists-p output-file)
718 (nth 5 (file-attributes output-file))))
719 (found nil))
720 (with-current-buffer (autoload-find-generated-file)
721 ;; This is to make generated-autoload-file have Unix EOLs, so
722 ;; that it is portable to all platforms.
723 (or (eq 0 (coding-system-eol-type buffer-file-coding-system))
724 (set-buffer-file-coding-system 'unix))
725 (or (> (buffer-size) 0)
726 (error "Autoloads file %s lacks boilerplate" buffer-file-name))
727 (or (file-writable-p buffer-file-name)
728 (error "Autoloads file %s is not writable" buffer-file-name))
729 (widen)
730 (goto-char (point-min))
731 ;; Look for the section for LOAD-NAME.
732 (while (and (not found)
733 (search-forward generate-autoload-section-header nil t))
734 (let ((form (autoload-read-section-header)))
735 (cond ((string= (nth 2 form) load-name)
736 ;; We found the section for this file.
737 ;; Check if it is up to date.
738 (let ((begin (match-beginning 0))
739 (last-time (nth 4 form))
740 (file-time (nth 5 (file-attributes file))))
741 (if (and (or (null existing-buffer)
742 (not (buffer-modified-p existing-buffer)))
743 (cond
744 ;; last-time is the time-stamp (specifying
745 ;; the last time we looked at the file) and
746 ;; the file hasn't been changed since.
747 ((listp last-time)
748 (not (time-less-p last-time file-time)))
749 ;; FIXME? Arguably we should throw a
750 ;; user error, or some kind of warning,
751 ;; if we were called from update-file-autoloads,
752 ;; which can update only a single input file.
753 ;; It's not appropriate to use the output
754 ;; file modtime in such a case,
755 ;; if there are multiple input files
756 ;; contributing to the output.
757 ((and output-time (eq t last-time))
758 (not (time-less-p output-time file-time)))
759 ;; last-time is an MD5 checksum instead.
760 ((stringp last-time)
761 (equal last-time
762 (md5 buf nil nil 'emacs-mule)))))
763 (throw 'up-to-date nil)
764 (autoload-remove-section begin)
765 (setq found t))))
766 ((string< load-name (nth 2 form))
767 ;; We've come to a section alphabetically later than
768 ;; LOAD-NAME. We assume the file is in order and so
769 ;; there must be no section for LOAD-NAME. We will
770 ;; insert one before the section here.
771 (goto-char (match-beginning 0))
772 (setq found t)))))
773 (or found
774 (progn
775 ;; No later sections in the file. Put before the last page.
776 (goto-char (point-max))
777 (search-backward "\f" nil t)))
778 (unless (memq (current-buffer) autoload-modified-buffers)
779 (push (current-buffer) autoload-modified-buffers))
780 (current-buffer)))))
781
782 (defun autoload-remove-section (begin)
783 (goto-char begin)
784 (search-forward generate-autoload-section-trailer)
785 (delete-region begin (point)))
786
787 ;;;###autoload
788 (defun update-directory-autoloads (&rest dirs)
789 "Update autoload definitions for Lisp files in the directories DIRS.
790 In an interactive call, you must give one argument, the name of a
791 single directory. In a call from Lisp, you can supply multiple
792 directories as separate arguments, but this usage is discouraged.
793
794 The function does NOT recursively descend into subdirectories of the
795 directory or directories specified.
796
797 In an interactive call, prompt for a default output file for the
798 autoload definitions, and temporarily bind the variable
799 `generated-autoload-file' to this value. When called from Lisp,
800 use the existing value of `generated-autoload-file'. If any Lisp
801 file binds `generated-autoload-file' as a file-local variable,
802 write its autoloads into the specified file instead."
803 (interactive "DUpdate autoloads from directory: ")
804 (let* ((files-re (let ((tmp nil))
805 (dolist (suf (get-load-suffixes))
806 (unless (string-match "\\.elc" suf) (push suf tmp)))
807 (concat "^[^=.].*" (regexp-opt tmp t) "\\'")))
808 (files (apply 'nconc
809 (mapcar (lambda (dir)
810 (directory-files (expand-file-name dir)
811 t files-re))
812 dirs)))
813 (done ())
814 (last-time)
815 ;; Files with no autoload cookies or whose autoloads go to other
816 ;; files because of file-local autoload-generated-file settings.
817 (no-autoloads nil)
818 (autoload-modified-buffers nil)
819 (generated-autoload-file
820 (if (called-interactively-p 'interactive)
821 (read-file-name "Write autoload definitions to file: ")
822 generated-autoload-file))
823 (output-time
824 (if (file-exists-p generated-autoload-file)
825 (nth 5 (file-attributes generated-autoload-file)))))
826
827 (with-current-buffer (autoload-find-generated-file)
828 (save-excursion
829 ;; Canonicalize file names and remove the autoload file itself.
830 (setq files (delete (file-relative-name buffer-file-name)
831 (mapcar 'file-relative-name files)))
832
833 (goto-char (point-min))
834 (while (search-forward generate-autoload-section-header nil t)
835 (let* ((form (autoload-read-section-header))
836 (file (nth 3 form)))
837 (cond ((and (consp file) (stringp (car file)))
838 ;; This is a list of files that have no autoload cookies.
839 ;; There shouldn't be more than one such entry.
840 ;; Remove the obsolete section.
841 (autoload-remove-section (match-beginning 0))
842 (setq last-time (nth 4 form))
843 (if (equal t last-time)
844 (setq last-time output-time))
845 (dolist (file file)
846 (let ((file-time (nth 5 (file-attributes file))))
847 (when (and file-time
848 (not (time-less-p last-time file-time)))
849 ;; file unchanged
850 (push file no-autoloads)
851 (setq files (delete file files))))))
852 ((not (stringp file)))
853 ((or (not (file-exists-p file))
854 ;; Remove duplicates as well, just in case.
855 (member file done)
856 ;; If the file is actually excluded.
857 (member (expand-file-name file) autoload-excludes))
858 ;; Remove the obsolete section.
859 (autoload-remove-section (match-beginning 0)))
860 ((not (time-less-p (let ((oldtime (nth 4 form)))
861 (if (equal t oldtime)
862 output-time
863 oldtime))
864 (nth 5 (file-attributes file))))
865 ;; File hasn't changed.
866 nil)
867 (t
868 (autoload-remove-section (match-beginning 0))
869 (if (autoload-generate-file-autoloads
870 ;; Passing `current-buffer' makes it insert at point.
871 file (current-buffer) buffer-file-name)
872 (push file no-autoloads))))
873 (push file done)
874 (setq files (delete file files)))))
875 ;; Elements remaining in FILES have no existing autoload sections yet.
876 (let ((no-autoloads-time (or last-time '(0 0 0 0))) file-time)
877 (dolist (file files)
878 (cond
879 ((member (expand-file-name file) autoload-excludes) nil)
880 ;; Passing nil as second argument forces
881 ;; autoload-generate-file-autoloads to look for the right
882 ;; spot where to insert each autoloads section.
883 ((setq file-time
884 (autoload-generate-file-autoloads file nil buffer-file-name))
885 (push file no-autoloads)
886 (if (time-less-p no-autoloads-time file-time)
887 (setq no-autoloads-time file-time)))))
888
889 (when no-autoloads
890 ;; Sort them for better readability.
891 (setq no-autoloads (sort no-autoloads 'string<))
892 ;; Add the `no-autoloads' section.
893 (goto-char (point-max))
894 (search-backward "\f" nil t)
895 (autoload-insert-section-header
896 (current-buffer) nil nil no-autoloads (if autoload-timestamps
897 no-autoloads-time
898 t))
899 (insert generate-autoload-section-trailer)))
900
901 (let ((version-control 'never))
902 (save-buffer))
903 ;; In case autoload entries were added to other files because of
904 ;; file-local autoload-generated-file settings.
905 (autoload-save-buffers))))
906
907 (define-obsolete-function-alias 'update-autoloads-from-directories
908 'update-directory-autoloads "22.1")
909
910 ;;;###autoload
911 (defun batch-update-autoloads ()
912 "Update loaddefs.el autoloads in batch mode.
913 Calls `update-directory-autoloads' on the command line arguments.
914 Definitions are written to `generated-autoload-file' (which
915 should be non-nil)."
916 ;; For use during the Emacs build process only.
917 ;; Exclude those files that are preloaded on ALL platforms.
918 ;; These are the ones in loadup.el where "(load" is at the start
919 ;; of the line (crude, but it works).
920 (unless autoload-excludes
921 (let ((default-directory (file-name-directory generated-autoload-file))
922 file)
923 (when (file-readable-p "loadup.el")
924 (with-temp-buffer
925 (insert-file-contents "loadup.el")
926 (while (re-search-forward "^(load \"\\([^\"]+\\)\"" nil t)
927 (setq file (match-string 1))
928 (or (string-match "\\.el\\'" file)
929 (setq file (format "%s.el" file)))
930 (or (string-match "\\`site-" file)
931 (push (expand-file-name file) autoload-excludes)))))))
932 (let ((args command-line-args-left))
933 (setq command-line-args-left nil)
934 (apply 'update-directory-autoloads args)))
935
936 (provide 'autoload)
937
938 ;;; autoload.el ends here