(vc-default-workfile-unchanged-p): Pass nil
[emacs.git] / lisp / emacs-lisp / autoload.el
blob8c228475e4284769392194671927fdce9c3ea354
1 ;; autoload.el --- maintain autoloads in loaddefs.el
3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001
4 ;; Free Software Foundation, Inc.
6 ;; Author: Roland McGrath <roland@gnu.org>
7 ;; Keywords: maint
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)
14 ;; any later version.
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., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
26 ;;; Commentary:
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.
33 ;;; Code:
35 (require 'lisp-mode) ;for `doc-string-elt' properties.
36 (require 'help-fns) ;for help-add-fundoc-usage.
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.")
44 (defconst generate-autoload-cookie ";;;###autoload"
45 "Magic comment indicating the following form should be autoloaded.
46 Used by \\[update-file-autoloads]. This string should be
47 meaningless to Lisp (e.g., a comment).
49 This string is used:
51 ;;;###autoload
52 \(defun function-to-be-autoloaded () ...)
54 If this string appears alone on a line, the following form will be
55 read and an autoload made for it. If there is further text on the line,
56 that text will be copied verbatim to `generated-autoload-file'.")
58 (defconst generate-autoload-section-header "\f\n;;;### "
59 "String that marks the form at the start of a new file's autoload section.")
61 (defconst generate-autoload-section-trailer "\n;;;***\n"
62 "String which indicates the end of the section of autoloads for a file.")
64 (defconst generate-autoload-section-continuation ";;;;;; "
65 "String to add on each continuation of the section header form.")
67 (defun make-autoload (form file)
68 "Turn FORM into an autoload or defvar for source file FILE.
69 Returns nil if FORM is not a special autoload form (i.e. a function definition
70 or macro definition or a defcustom)."
71 (let ((car (car-safe form)) expand)
72 (cond
73 ;; For complex cases, try again on the macro-expansion.
74 ((and (memq car '(easy-mmode-define-global-mode
75 easy-mmode-define-minor-mode define-minor-mode))
76 (setq expand (let ((load-file-name file)) (macroexpand form)))
77 (eq (car expand) 'progn)
78 (memq :autoload-end expand))
79 (let ((end (memq :autoload-end expand)))
80 ;; Cut-off anything after the :autoload-end marker.
81 (setcdr end nil)
82 (cons 'progn
83 (mapcar (lambda (form) (make-autoload form file))
84 (cdr expand)))))
86 ;; For special function-like operators, use the `autoload' function.
87 ((memq car '(defun define-skeleton defmacro define-derived-mode
88 define-generic-mode easy-mmode-define-minor-mode
89 easy-mmode-define-global-mode
90 define-minor-mode defun* defmacro*))
91 (let* ((macrop (memq car '(defmacro defmacro*)))
92 (name (nth 1 form))
93 (args (if (memq car '(defun defmacro defun* defmacro*))
94 (nth 2 form) t))
95 (body (nthcdr (get car 'doc-string-elt) form))
96 (doc (if (stringp (car body)) (pop body))))
97 (when (listp args)
98 ;; Add the usage form at the end where describe-function-1
99 ;; can recover it.
100 (setq doc (help-add-fundoc-usage doc args)))
101 ;; `define-generic-mode' quotes the name, so take care of that
102 (list 'autoload (if (listp name) name (list 'quote name)) file doc
103 (or (and (memq car '(define-skeleton define-derived-mode
104 define-generic-mode
105 easy-mmode-define-global-mode
106 easy-mmode-define-minor-mode
107 define-minor-mode)) t)
108 (eq (car-safe (car body)) 'interactive))
109 (if macrop (list 'quote 'macro) nil))))
111 ;; Convert defcustom to less space-consuming data.
112 ((eq car 'defcustom)
113 (let ((varname (car-safe (cdr-safe form)))
114 (init (car-safe (cdr-safe (cdr-safe form))))
115 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
116 ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
118 `(progn
119 (defvar ,varname ,init ,doc)
120 (custom-autoload ',varname ,file))))
122 ;; nil here indicates that this is not a special autoload form.
123 (t nil))))
125 ;; Forms which have doc-strings which should be printed specially.
126 ;; A doc-string-elt property of ELT says that (nth ELT FORM) is
127 ;; the doc-string in FORM.
128 ;; Those properties are now set in lisp-mode.el.
131 (defun autoload-trim-file-name (file)
132 ;; Returns a relative pathname of FILE
133 ;; starting from the directory that loaddefs.el is in.
134 ;; That is normally a directory in load-path,
135 ;; which means Emacs will be able to find FILE when it looks.
136 ;; Any extra directory names here would prevent finding the file.
137 (setq file (expand-file-name file))
138 (file-relative-name file
139 (file-name-directory generated-autoload-file)))
141 (defun autoload-read-section-header ()
142 "Read a section header form.
143 Since continuation lines have been marked as comments,
144 we must copy the text of the form and remove those comment
145 markers before we call `read'."
146 (save-match-data
147 (let ((beginning (point))
148 string)
149 (forward-line 1)
150 (while (looking-at generate-autoload-section-continuation)
151 (forward-line 1))
152 (setq string (buffer-substring beginning (point)))
153 (with-current-buffer (get-buffer-create " *autoload*")
154 (erase-buffer)
155 (insert string)
156 (goto-char (point-min))
157 (while (search-forward generate-autoload-section-continuation nil t)
158 (replace-match " "))
159 (goto-char (point-min))
160 (read (current-buffer))))))
162 (defvar autoload-print-form-outbuf)
164 (defun autoload-print-form (form)
165 "Print FORM such that `make-docfile' will find the docstrings.
166 The variable `autoload-print-form-outbuf' specifies the buffer to
167 put the output in."
168 (cond
169 ;; If the form is a sequence, recurse.
170 ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form)))
171 ;; Symbols at the toplevel are meaningless.
172 ((symbolp form) nil)
174 (let ((doc-string-elt (get (car-safe form) 'doc-string-elt))
175 (outbuf autoload-print-form-outbuf))
176 (if (and doc-string-elt (stringp (nth doc-string-elt form)))
177 ;; We need to hack the printing because the
178 ;; doc-string must be printed specially for
179 ;; make-docfile (sigh).
180 (let* ((p (nthcdr (1- doc-string-elt) form))
181 (elt (cdr p)))
182 (setcdr p nil)
183 (princ "\n(" outbuf)
184 (let ((print-escape-newlines t)
185 (print-escape-nonascii t))
186 (dolist (elt form)
187 (prin1 elt outbuf)
188 (princ " " outbuf)))
189 (princ "\"\\\n" outbuf)
190 (let ((begin (with-current-buffer outbuf (point))))
191 (princ (substring (prin1-to-string (car elt)) 1)
192 outbuf)
193 ;; Insert a backslash before each ( that
194 ;; appears at the beginning of a line in
195 ;; the doc string.
196 (with-current-buffer outbuf
197 (save-excursion
198 (while (re-search-backward "\n[[(]" begin t)
199 (forward-char 1)
200 (insert "\\"))))
201 (if (null (cdr elt))
202 (princ ")" outbuf)
203 (princ " " outbuf)
204 (princ (substring (prin1-to-string (cdr elt)) 1)
205 outbuf))
206 (terpri outbuf)))
207 (let ((print-escape-newlines t)
208 (print-escape-nonascii t))
209 (print form outbuf)))))))
211 (defun autoload-ensure-default-file (file)
212 "Make sure that the autoload file FILE exists and if not create it."
213 (unless (file-exists-p file)
214 (write-region
215 (concat ";;; " (file-name-nondirectory file)
216 " --- automatically extracted autoloads\n"
217 ";;\n"
218 ";;; Code:\n\n"
219 "\f\n;; Local Variables:\n"
220 ";; version-control: never\n"
221 ";; no-byte-compile: t\n"
222 ";; no-update-autoloads: t\n"
223 ";; End:\n"
224 ";;; " (file-name-nondirectory file)
225 " ends here\n")
226 nil file))
227 file)
229 (defun autoload-insert-section-header (outbuf autoloads load-name file time)
230 "Insert the section-header line,
231 which lists the file name and which functions are in it, etc."
232 (insert generate-autoload-section-header)
233 (prin1 (list 'autoloads autoloads load-name
234 (if (stringp file) (autoload-trim-file-name file) file)
235 time)
236 outbuf)
237 (terpri outbuf)
238 ;; Break that line at spaces, to avoid very long lines.
239 ;; Make each sub-line into a comment.
240 (with-current-buffer outbuf
241 (save-excursion
242 (forward-line -1)
243 (while (not (eolp))
244 (move-to-column 64)
245 (skip-chars-forward "^ \n")
246 (or (eolp)
247 (insert "\n" generate-autoload-section-continuation))))))
249 (defun generate-file-autoloads (file)
250 "Insert at point a loaddefs autoload section for FILE.
251 autoloads are generated for defuns and defmacros in FILE
252 marked by `generate-autoload-cookie' (which see).
253 If FILE is being visited in a buffer, the contents of the buffer
254 are used."
255 (interactive "fGenerate autoloads for file: ")
256 (let ((outbuf (current-buffer))
257 (autoloads-done '())
258 (load-name (let ((name (file-name-nondirectory file)))
259 (if (string-match "\\.elc?\\(\\.\\|$\\)" name)
260 (substring name 0 (match-beginning 0))
261 name)))
262 (print-length nil)
263 (print-readably t) ; This does something in Lucid Emacs.
264 (float-output-format nil)
265 (done-any nil)
266 (visited (get-file-buffer file))
267 output-end)
269 ;; If the autoload section we create here uses an absolute
270 ;; pathname for FILE in its header, and then Emacs is installed
271 ;; under a different path on another system,
272 ;; `update-autoloads-here' won't be able to find the files to be
273 ;; autoloaded. So, if FILE is in the same directory or a
274 ;; subdirectory of the current buffer's directory, we'll make it
275 ;; relative to the current buffer's directory.
276 (setq file (expand-file-name file))
277 (let* ((source-truename (file-truename file))
278 (dir-truename (file-name-as-directory
279 (file-truename default-directory)))
280 (len (length dir-truename)))
281 (if (and (< len (length source-truename))
282 (string= dir-truename (substring source-truename 0 len)))
283 (setq file (substring source-truename len))))
285 (message "Generating autoloads for %s..." file)
286 (save-excursion
287 (unwind-protect
288 (progn
289 (if visited
290 (set-buffer visited)
291 ;; It is faster to avoid visiting the file.
292 (set-buffer (get-buffer-create " *generate-autoload-file*"))
293 (kill-all-local-variables)
294 (erase-buffer)
295 (setq buffer-undo-list t
296 buffer-read-only nil)
297 (emacs-lisp-mode)
298 (insert-file-contents file nil))
299 (save-excursion
300 (save-restriction
301 (widen)
302 (goto-char (point-min))
303 (while (not (eobp))
304 (skip-chars-forward " \t\n\f")
305 (cond
306 ((looking-at (regexp-quote generate-autoload-cookie))
307 (search-forward generate-autoload-cookie)
308 (skip-chars-forward " \t")
309 (setq done-any t)
310 (if (eolp)
311 ;; Read the next form and make an autoload.
312 (let* ((form (prog1 (read (current-buffer))
313 (or (bolp) (forward-line 1))))
314 (autoload (make-autoload form load-name)))
315 (if autoload
316 (setq autoloads-done (cons (nth 1 form)
317 autoloads-done))
318 (setq autoload form))
319 (let ((autoload-print-form-outbuf outbuf))
320 (autoload-print-form autoload)))
322 ;; Copy the rest of the line to the output.
323 (princ (buffer-substring
324 (progn
325 ;; Back up over whitespace, to preserve it.
326 (skip-chars-backward " \f\t")
327 (if (= (char-after (1+ (point))) ? )
328 ;; Eat one space.
329 (forward-char 1))
330 (point))
331 (progn (forward-line 1) (point)))
332 outbuf)))
333 ((looking-at ";")
334 ;; Don't read the comment.
335 (forward-line 1))
337 (forward-sexp 1)
338 (forward-line 1)))))))
339 (or visited
340 ;; We created this buffer, so we should kill it.
341 (kill-buffer (current-buffer)))
342 (set-buffer outbuf)
343 (setq output-end (point-marker))))
344 (if done-any
345 (progn
346 ;; Insert the section-header line
347 ;; which lists the file name and which functions are in it, etc.
348 (autoload-insert-section-header outbuf autoloads-done load-name file
349 (nth 5 (file-attributes file)))
350 (insert ";;; Generated autoloads from "
351 (autoload-trim-file-name file) "\n")
352 (goto-char output-end)
353 (insert generate-autoload-section-trailer)))
354 (message "Generating autoloads for %s...done" file)))
356 ;;;###autoload
357 (defun update-file-autoloads (file)
358 "Update the autoloads for FILE in `generated-autoload-file'
359 \(which FILE might bind in its local variables).
360 Return FILE if there was no autoload cookie in it."
361 (interactive "fUpdate autoloads for file: ")
362 (let ((load-name (let ((name (file-name-nondirectory file)))
363 (if (string-match "\\.elc?\\(\\.\\|$\\)" name)
364 (substring name 0 (match-beginning 0))
365 name)))
366 (found nil)
367 (existing-buffer (get-file-buffer file))
368 (no-autoloads nil))
369 (save-excursion
370 ;; We want to get a value for generated-autoload-file from
371 ;; the local variables section if it's there.
372 (if existing-buffer
373 (set-buffer existing-buffer))
374 ;; We must read/write the file without any code conversion,
375 ;; but still decode EOLs.
376 (let ((coding-system-for-read 'raw-text))
377 (set-buffer (find-file-noselect
378 (autoload-ensure-default-file
379 (expand-file-name generated-autoload-file
380 (expand-file-name "lisp"
381 source-directory)))))
382 ;; This is to make generated-autoload-file have Unix EOLs, so
383 ;; that it is portable to all platforms.
384 (setq buffer-file-coding-system 'raw-text-unix))
385 (or (> (buffer-size) 0)
386 (error "Autoloads file %s does not exist" buffer-file-name))
387 (or (file-writable-p buffer-file-name)
388 (error "Autoloads file %s is not writable" buffer-file-name))
389 (save-excursion
390 (save-restriction
391 (widen)
392 (goto-char (point-min))
393 ;; Look for the section for LOAD-NAME.
394 (while (and (not found)
395 (search-forward generate-autoload-section-header nil t))
396 (let ((form (autoload-read-section-header)))
397 (cond ((string= (nth 2 form) load-name)
398 ;; We found the section for this file.
399 ;; Check if it is up to date.
400 (let ((begin (match-beginning 0))
401 (last-time (nth 4 form))
402 (file-time (nth 5 (file-attributes file))))
403 (if (and (or (null existing-buffer)
404 (not (buffer-modified-p existing-buffer)))
405 (listp last-time) (= (length last-time) 2)
406 (not (autoload-before-p last-time file-time)))
407 (progn
408 (if (interactive-p)
409 (message "\
410 Autoload section for %s is up to date."
411 file))
412 (setq found 'up-to-date))
413 (search-forward generate-autoload-section-trailer)
414 (delete-region begin (point))
415 (setq found t))))
416 ((string< load-name (nth 2 form))
417 ;; We've come to a section alphabetically later than
418 ;; LOAD-NAME. We assume the file is in order and so
419 ;; there must be no section for LOAD-NAME. We will
420 ;; insert one before the section here.
421 (goto-char (match-beginning 0))
422 (setq found 'new)))))
423 (or found
424 (progn
425 (setq found 'new)
426 ;; No later sections in the file. Put before the last page.
427 (goto-char (point-max))
428 (search-backward "\f" nil t)))
429 (or (eq found 'up-to-date)
430 (and (eq found 'new)
431 ;; Check that FILE has any cookies before generating a
432 ;; new section for it.
433 (save-excursion
434 (if existing-buffer
435 (set-buffer existing-buffer)
436 ;; It is faster to avoid visiting the file.
437 (set-buffer (get-buffer-create " *autoload-file*"))
438 (kill-all-local-variables)
439 (erase-buffer)
440 (setq buffer-undo-list t
441 buffer-read-only nil)
442 (emacs-lisp-mode)
443 (insert-file-contents file nil))
444 (save-excursion
445 (save-restriction
446 (widen)
447 (goto-char (point-min))
448 (prog1
449 (if (re-search-forward
450 (concat "^" (regexp-quote
451 generate-autoload-cookie))
452 nil t)
454 (if (interactive-p)
455 (message "%s has no autoloads" file))
456 (setq no-autoloads t)
458 (or existing-buffer
459 (kill-buffer (current-buffer))))))))
460 (generate-file-autoloads file))))
461 (and (interactive-p)
462 (buffer-modified-p)
463 (save-buffer))
465 (if no-autoloads file))))
467 (defun autoload-before-p (time1 time2)
468 (or (< (car time1) (car time2))
469 (and (= (car time1) (car time2))
470 (< (nth 1 time1) (nth 1 time2)))))
472 (defun autoload-remove-section (begin)
473 (goto-char begin)
474 (search-forward generate-autoload-section-trailer)
475 (delete-region begin (point)))
477 ;;;###autoload
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) 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 load-suffixes
491 (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
492 (unless (string-match "\\.elc" suf) (push suf tmp)))))
493 (files (apply 'nconc
494 (mapcar (lambda (dir)
495 (directory-files (expand-file-name dir)
496 t files-re))
497 dirs)))
498 (this-time (current-time))
499 (no-autoloads nil) ;files with no autoload cookies.
500 (autoloads-file
501 (expand-file-name generated-autoload-file
502 (expand-file-name "lisp" source-directory)))
503 (top-dir (file-name-directory autoloads-file)))
505 (with-current-buffer
506 (find-file-noselect (autoload-ensure-default-file autoloads-file))
507 (save-excursion
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))
516 (file (nth 3 form)))
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)))
523 (dolist (file file)
524 (let ((file-time (nth 5 (file-attributes file))))
525 (when (and file-time
526 (not (autoload-before-p last-time
527 file-time)))
528 ;; file unchanged
529 (push file no-autoloads)
530 (setq files (delete file files)))))))
531 ((not (stringp file)))
532 ((not (file-exists-p (expand-file-name file top-dir)))
533 ;; Remove the obsolete section.
534 (autoload-remove-section (match-beginning 0)))
535 ((equal (nth 4 form) (nth 5 (file-attributes file)))
536 ;; File hasn't changed.
537 nil)
539 (update-file-autoloads file)))
540 (setq files (delete file files)))))
541 ;; Elements remaining in FILES have no existing autoload sections yet.
542 (setq no-autoloads
543 (append no-autoloads
544 (delq nil (mapcar 'update-file-autoloads files))))
545 (when no-autoloads
546 ;; Sort them for better readability.
547 (setq no-autoloads (sort no-autoloads 'string<))
548 ;; Add the `no-autoloads' section.
549 (goto-char (point-max))
550 (search-backward "\f" nil t)
551 (autoload-insert-section-header
552 (current-buffer) nil nil no-autoloads this-time)
553 (insert generate-autoload-section-trailer))
555 (save-buffer))))
557 ;;;###autoload
558 (defun batch-update-autoloads ()
559 "Update loaddefs.el autoloads in batch mode.
560 Calls `update-directory-autoloads' on the command line arguments."
561 (apply 'update-directory-autoloads command-line-args-left)
562 (setq command-line-args-left nil))
564 (provide 'autoload)
566 ;;; autoload.el ends here