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