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