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