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