1 ;; autoload.el --- maintain autoloads in loaddefs.el
3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
4 ;; 2004, 2005, 2006 Free Software Foundation, Inc.
6 ;; Author: Roland McGrath <roland@gnu.org>
9 ;; This file is part of GNU Emacs.
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 2, or (at your option)
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24 ;; Boston, MA 02110-1301, USA.
28 ;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
29 ;; date. It interprets magic cookies of the form ";;;###autoload" in
30 ;; lisp source files in various useful ways. To learn more, read the
31 ;; source; if you're going to use this, you'd better be able to.
35 (require 'lisp-mode
) ;for `doc-string-elt' properties.
36 (require 'help-fns
) ;for help-add-fundoc-usage.
37 (eval-when-compile (require 'cl
))
39 (defvar generated-autoload-file
"loaddefs.el"
40 "*File \\[update-file-autoloads] puts autoloads into.
41 A `.el' file can set this in its local variables section to make its
42 autoloads go somewhere else. The autoload file is assumed to contain a
43 trailer starting with a FormFeed character.")
45 (defconst generate-autoload-cookie
";;;###autoload"
46 "Magic comment indicating the following form should be autoloaded.
47 Used by \\[update-file-autoloads]. This string should be
48 meaningless to Lisp (e.g., a comment).
53 \(defun function-to-be-autoloaded () ...)
55 If this string appears alone on a line, the following form will be
56 read and an autoload made for it. If there is further text on the line,
57 that text will be copied verbatim to `generated-autoload-file'.")
59 (defconst generate-autoload-section-header
"\f\n;;;### "
60 "String that marks the form at the start of a new file's autoload section.")
62 (defconst generate-autoload-section-trailer
"\n;;;***\n"
63 "String which indicates the end of the section of autoloads for a file.")
65 (defconst generate-autoload-section-continuation
";;;;;; "
66 "String to add on each continuation of the section header form.")
68 (defun make-autoload (form file
)
69 "Turn FORM into an autoload or defvar for source file FILE.
70 Returns nil if FORM is not a special autoload form (i.e. a function definition
71 or macro definition or a defcustom)."
72 (let ((car (car-safe form
)) expand
)
74 ;; For complex cases, try again on the macro-expansion.
75 ((and (memq car
'(easy-mmode-define-global-mode define-global-minor-mode
76 easy-mmode-define-minor-mode define-minor-mode
))
77 (setq expand
(let ((load-file-name file
)) (macroexpand form
)))
78 (eq (car expand
) 'progn
)
79 (memq :autoload-end expand
))
80 (let ((end (memq :autoload-end expand
)))
81 ;; Cut-off anything after the :autoload-end marker.
84 (mapcar (lambda (form) (make-autoload form file
))
87 ;; For special function-like operators, use the `autoload' function.
88 ((memq car
'(defun define-skeleton defmacro define-derived-mode
89 define-compilation-mode define-generic-mode
90 easy-mmode-define-global-mode define-global-minor-mode
91 easy-mmode-define-minor-mode define-minor-mode
93 (let* ((macrop (memq car
'(defmacro defmacro
*)))
96 ((defun defmacro defun
* defmacro
*) (nth 2 form
))
97 ((define-skeleton) '(&optional str arg
))
98 ((define-generic-mode define-derived-mode
99 define-compilation-mode
) nil
)
101 (body (nthcdr (get car
'doc-string-elt
) form
))
102 (doc (if (stringp (car body
)) (pop body
))))
104 ;; Add the usage form at the end where describe-function-1
106 (setq doc
(help-add-fundoc-usage doc args
)))
107 ;; `define-generic-mode' quotes the name, so take care of that
108 (list 'autoload
(if (listp name
) name
(list 'quote name
)) file doc
109 (or (and (memq car
'(define-skeleton define-derived-mode
111 easy-mmode-define-global-mode
112 define-global-minor-mode
113 easy-mmode-define-minor-mode
114 define-minor-mode
)) t
)
115 (eq (car-safe (car body
)) 'interactive
))
116 (if macrop
(list 'quote
'macro
) nil
))))
118 ;; Convert defcustom to less space-consuming data.
120 (let ((varname (car-safe (cdr-safe form
)))
121 (init (car-safe (cdr-safe (cdr-safe form
))))
122 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form
)))))
123 ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
126 (defvar ,varname
,init
,doc
)
127 (custom-autoload ',varname
,file
129 (null (cadr (memq :set form
)))
133 ;; In Emacs this is normally handled separately by cus-dep.el, but for
134 ;; third party packages, it can be convenient to explicitly autoload
136 (let ((groupname (nth 1 form
)))
137 `(let ((loads (get ',groupname
'custom-loads
)))
138 (if (member ',file loads
) nil
139 (put ',groupname
'custom-loads
(cons ',file loads
))))))
141 ;; nil here indicates that this is not a special autoload form.
144 ;; Forms which have doc-strings which should be printed specially.
145 ;; A doc-string-elt property of ELT says that (nth ELT FORM) is
146 ;; the doc-string in FORM.
147 ;; Those properties are now set in lisp-mode.el.
150 (defun autoload-trim-file-name (file)
151 ;; Returns a relative file path for FILE
152 ;; starting from the directory that loaddefs.el is in.
153 ;; That is normally a directory in load-path,
154 ;; which means Emacs will be able to find FILE when it looks.
155 ;; Any extra directory names here would prevent finding the file.
156 (setq file
(expand-file-name file
))
157 (file-relative-name file
158 (file-name-directory generated-autoload-file
)))
160 (defun autoload-read-section-header ()
161 "Read a section header form.
162 Since continuation lines have been marked as comments,
163 we must copy the text of the form and remove those comment
164 markers before we call `read'."
166 (let ((beginning (point))
169 (while (looking-at generate-autoload-section-continuation
)
171 (setq string
(buffer-substring beginning
(point)))
172 (with-current-buffer (get-buffer-create " *autoload*")
175 (goto-char (point-min))
176 (while (search-forward generate-autoload-section-continuation nil t
)
178 (goto-char (point-min))
179 (read (current-buffer))))))
181 (defvar autoload-print-form-outbuf nil
182 "Buffer which gets the output of `autoload-print-form'.")
184 (defun autoload-print-form (form)
185 "Print FORM such that `make-docfile' will find the docstrings.
186 The variable `autoload-print-form-outbuf' specifies the buffer to
189 ;; If the form is a sequence, recurse.
190 ((eq (car form
) 'progn
) (mapcar 'autoload-print-form
(cdr form
)))
191 ;; Symbols at the toplevel are meaningless.
194 (let ((doc-string-elt (get (car-safe form
) 'doc-string-elt
))
195 (outbuf autoload-print-form-outbuf
))
196 (if (and doc-string-elt
(stringp (nth doc-string-elt form
)))
197 ;; We need to hack the printing because the
198 ;; doc-string must be printed specially for
199 ;; make-docfile (sigh).
200 (let* ((p (nthcdr (1- doc-string-elt
) form
))
204 (let ((print-escape-newlines t
)
205 (print-escape-nonascii t
))
209 (princ "\"\\\n" outbuf
)
210 (let ((begin (with-current-buffer outbuf
(point))))
211 (princ (substring (prin1-to-string (car elt
)) 1)
213 ;; Insert a backslash before each ( that
214 ;; appears at the beginning of a line in
216 (with-current-buffer outbuf
218 (while (re-search-backward "\n[[(]" begin t
)
224 (princ (substring (prin1-to-string (cdr elt
)) 1)
227 (let ((print-escape-newlines t
)
228 (print-escape-nonascii t
))
229 (print form outbuf
)))))))
231 (defun autoload-ensure-default-file (file)
232 "Make sure that the autoload file FILE exists and if not create it."
233 (unless (file-exists-p file
)
235 (concat ";;; " (file-name-nondirectory file
)
236 " --- automatically extracted autoloads\n"
239 "\f\n;; Local Variables:\n"
240 ";; version-control: never\n"
241 ";; no-byte-compile: t\n"
242 ";; no-update-autoloads: t\n"
244 ";;; " (file-name-nondirectory file
)
249 (defun autoload-insert-section-header (outbuf autoloads load-name file time
)
250 "Insert the section-header line,
251 which lists the file name and which functions are in it, etc."
252 (insert generate-autoload-section-header
)
253 (prin1 (list 'autoloads autoloads load-name
254 (if (stringp file
) (autoload-trim-file-name file
) file
)
258 ;; Break that line at spaces, to avoid very long lines.
259 ;; Make each sub-line into a comment.
260 (with-current-buffer outbuf
265 (skip-chars-forward "^ \n")
267 (insert "\n" generate-autoload-section-continuation
))))))
269 (defun autoload-find-file (file)
270 "Fetch file and put it in a temp buffer. Return the buffer."
271 ;; It is faster to avoid visiting the file.
272 (with-current-buffer (get-buffer-create " *autoload-file*")
273 (kill-all-local-variables)
275 (setq buffer-undo-list t
276 buffer-read-only nil
)
278 (insert-file-contents file nil
)
279 (let ((enable-local-variables :safe
))
280 (hack-local-variables))
283 (defvar no-update-autoloads nil
284 "File local variable to prevent scanning this file for autoload cookies.")
286 (defun generate-file-autoloads (file)
287 "Insert at point a loaddefs autoload section for FILE.
288 Autoloads are generated for defuns and defmacros in FILE
289 marked by `generate-autoload-cookie' (which see).
290 If FILE is being visited in a buffer, the contents of the buffer
292 Return non-nil in the case where no autoloads were added at point."
293 (interactive "fGenerate autoloads for file: ")
294 (let ((outbuf (current-buffer))
296 (load-name (let ((name (file-name-nondirectory file
)))
297 (if (string-match "\\.elc?\\(\\.\\|$\\)" name
)
298 (substring name
0 (match-beginning 0))
301 (print-readably t
) ; This does something in Lucid Emacs.
302 (float-output-format nil
)
304 (visited (get-file-buffer file
))
307 ;; If the autoload section we create here uses an absolute
308 ;; file name for FILE in its header, and then Emacs is installed
309 ;; under a different path on another system,
310 ;; `update-autoloads-here' won't be able to find the files to be
311 ;; autoloaded. So, if FILE is in the same directory or a
312 ;; subdirectory of the current buffer's directory, we'll make it
313 ;; relative to the current buffer's directory.
314 (setq file
(expand-file-name file
))
315 (let* ((source-truename (file-truename file
))
316 (dir-truename (file-name-as-directory
317 (file-truename default-directory
)))
318 (len (length dir-truename
)))
319 (if (and (< len
(length source-truename
))
320 (string= dir-truename
(substring source-truename
0 len
)))
321 (setq file
(substring source-truename len
))))
323 (with-current-buffer (or visited
324 ;; It is faster to avoid visiting the file.
325 (autoload-find-file file
))
326 ;; Obey the no-update-autoloads file local variable.
327 (unless no-update-autoloads
328 (message "Generating autoloads for %s..." file
)
329 (setq output-start
(with-current-buffer outbuf
(point)))
333 (goto-char (point-min))
335 (skip-chars-forward " \t\n\f")
337 ((looking-at (regexp-quote generate-autoload-cookie
))
338 (search-forward generate-autoload-cookie
)
339 (skip-chars-forward " \t")
342 ;; Read the next form and make an autoload.
343 (let* ((form (prog1 (read (current-buffer))
344 (or (bolp) (forward-line 1))))
345 (autoload (make-autoload form load-name
)))
347 (push (nth 1 form
) autoloads-done
)
348 (setq autoload form
))
349 (let ((autoload-print-form-outbuf outbuf
))
350 (autoload-print-form autoload
)))
352 ;; Copy the rest of the line to the output.
353 (princ (buffer-substring
355 ;; Back up over whitespace, to preserve it.
356 (skip-chars-backward " \f\t")
357 (if (= (char-after (1+ (point))) ?
)
361 (progn (forward-line 1) (point)))
364 ;; Don't read the comment.
368 (forward-line 1))))))
371 (with-current-buffer outbuf
373 ;; Insert the section-header line which lists the file name
374 ;; and which functions are in it, etc.
375 (goto-char output-start
)
376 (autoload-insert-section-header
377 outbuf autoloads-done load-name file
378 (nth 5 (file-attributes file
)))
379 (insert ";;; Generated autoloads from "
380 (autoload-trim-file-name file
) "\n"))
381 (insert generate-autoload-section-trailer
)))
382 (message "Generating autoloads for %s...done" file
))
384 ;; We created this buffer, so we should kill it.
385 (kill-buffer (current-buffer))))
389 (defun update-file-autoloads (file &optional save-after
)
390 "Update the autoloads for FILE in `generated-autoload-file'
391 \(which FILE might bind in its local variables).
392 If SAVE-AFTER is non-nil (which is always, when called interactively),
395 Return FILE if there was no autoload cookie in it, else nil."
396 (interactive "fUpdate autoloads for file: \np")
397 (let ((load-name (let ((name (file-name-nondirectory file
)))
398 (if (string-match "\\.elc?\\(\\.\\|$\\)" name
)
399 (substring name
0 (match-beginning 0))
402 (existing-buffer (get-file-buffer file
))
405 ;; We want to get a value for generated-autoload-file from
406 ;; the local variables section if it's there.
408 (set-buffer existing-buffer
))
409 ;; We must read/write the file without any code conversion,
410 ;; but still decode EOLs.
411 (let ((coding-system-for-read 'raw-text
))
412 (set-buffer (find-file-noselect
413 (autoload-ensure-default-file
414 (expand-file-name generated-autoload-file
415 (expand-file-name "lisp"
416 source-directory
)))))
417 ;; This is to make generated-autoload-file have Unix EOLs, so
418 ;; that it is portable to all platforms.
419 (setq buffer-file-coding-system
'raw-text-unix
))
420 (or (> (buffer-size) 0)
421 (error "Autoloads file %s does not exist" buffer-file-name
))
422 (or (file-writable-p buffer-file-name
)
423 (error "Autoloads file %s is not writable" buffer-file-name
))
427 (goto-char (point-min))
428 ;; Look for the section for LOAD-NAME.
429 (while (and (not found
)
430 (search-forward generate-autoload-section-header nil t
))
431 (let ((form (autoload-read-section-header)))
432 (cond ((string= (nth 2 form
) load-name
)
433 ;; We found the section for this file.
434 ;; Check if it is up to date.
435 (let ((begin (match-beginning 0))
436 (last-time (nth 4 form
))
437 (file-time (nth 5 (file-attributes file
))))
438 (if (and (or (null existing-buffer
)
439 (not (buffer-modified-p existing-buffer
)))
440 (listp last-time
) (= (length last-time
) 2)
441 (not (time-less-p last-time file-time
)))
445 Autoload section for %s is up to date."
447 (setq found
'up-to-date
))
448 (search-forward generate-autoload-section-trailer
)
449 (delete-region begin
(point))
451 ((string< load-name
(nth 2 form
))
452 ;; We've come to a section alphabetically later than
453 ;; LOAD-NAME. We assume the file is in order and so
454 ;; there must be no section for LOAD-NAME. We will
455 ;; insert one before the section here.
456 (goto-char (match-beginning 0))
457 (setq found
'new
)))))
461 ;; No later sections in the file. Put before the last page.
462 (goto-char (point-max))
463 (search-backward "\f" nil t
)))
464 (or (eq found
'up-to-date
)
465 (setq no-autoloads
(generate-file-autoloads file
)))))
470 (if no-autoloads file
))))
472 (defun autoload-remove-section (begin)
474 (search-forward generate-autoload-section-trailer
)
475 (delete-region begin
(point)))
478 (defun update-directory-autoloads (&rest dirs
)
480 Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
481 This uses `update-file-autoloads' (which see) to do its work.
482 In an interactive call, you must give one argument, the name
483 of a single directory. In a call from Lisp, you can supply multiple
484 directories as separate arguments, but this usage is discouraged.
486 The function does NOT recursively descend into subdirectories of the
487 directory or directories specified."
488 (interactive "DUpdate autoloads from directory: ")
489 (let* ((files-re (let ((tmp nil
))
490 (dolist (suf (get-load-suffixes)
491 (concat "^[^=.].*" (regexp-opt tmp t
) "\\'"))
492 (unless (string-match "\\.elc" suf
) (push suf tmp
)))))
494 (mapcar (lambda (dir)
495 (directory-files (expand-file-name dir
)
498 (this-time (current-time))
499 (no-autoloads nil
) ;files with no autoload cookies.
501 (expand-file-name generated-autoload-file
502 (expand-file-name "lisp" source-directory
)))
503 (top-dir (file-name-directory autoloads-file
)))
506 (find-file-noselect (autoload-ensure-default-file autoloads-file
))
509 ;; Canonicalize file names and remove the autoload file itself.
510 (setq files
(delete (autoload-trim-file-name buffer-file-name
)
511 (mapcar 'autoload-trim-file-name files
)))
513 (goto-char (point-min))
514 (while (search-forward generate-autoload-section-header nil t
)
515 (let* ((form (autoload-read-section-header))
517 (cond ((and (consp file
) (stringp (car file
)))
518 ;; This is a list of files that have no autoload cookies.
519 ;; There shouldn't be more than one such entry.
520 ;; Remove the obsolete section.
521 (autoload-remove-section (match-beginning 0))
522 (let ((last-time (nth 4 form
)))
524 (let ((file-time (nth 5 (file-attributes file
))))
526 (not (time-less-p last-time file-time
)))
528 (push file no-autoloads
)
529 (setq files
(delete file files
)))))))
530 ((not (stringp file
)))
531 ((not (file-exists-p (expand-file-name file top-dir
)))
532 ;; Remove the obsolete section.
533 (autoload-remove-section (match-beginning 0)))
534 ((equal (nth 4 form
) (nth 5 (file-attributes file
)))
535 ;; File hasn't changed.
538 (update-file-autoloads file
)))
539 (setq files
(delete file files
)))))
540 ;; Elements remaining in FILES have no existing autoload sections yet.
543 (delq nil
(mapcar 'update-file-autoloads files
))))
545 ;; Sort them for better readability.
546 (setq no-autoloads
(sort no-autoloads
'string
<))
547 ;; Add the `no-autoloads' section.
548 (goto-char (point-max))
549 (search-backward "\f" nil t
)
550 (autoload-insert-section-header
551 (current-buffer) nil nil no-autoloads this-time
)
552 (insert generate-autoload-section-trailer
))
556 (define-obsolete-function-alias 'update-autoloads-from-directories
557 'update-directory-autoloads
"22.1")
560 (defun batch-update-autoloads ()
561 "Update loaddefs.el autoloads in batch mode.
562 Calls `update-directory-autoloads' on the command line arguments."
563 (apply 'update-directory-autoloads command-line-args-left
)
564 (setq command-line-args-left nil
))
568 ;; arch-tag: 00244766-98f4-4767-bf42-8a22103441c6
569 ;;; autoload.el ends here