autoload.el 29.2 KB
Newer Older
1
;; autoload.el --- maintain autoloads in loaddefs.el
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
Erik Naggum's avatar
Erik Naggum committed
5

Karl Heuer's avatar
Karl Heuer committed
6
;; Author: Roland McGrath <roland@gnu.org>
Eric S. Raymond's avatar
Eric S. Raymond committed
7
;; Keywords: maint
Eric S. Raymond's avatar
Eric S. Raymond committed
8

Erik Naggum's avatar
Erik Naggum committed
9 10
;; This file is part of GNU Emacs.

11
;; GNU Emacs is free software: you can redistribute it and/or modify
Erik Naggum's avatar
Erik Naggum committed
12
;; it under the terms of the GNU General Public License as published by
13 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Erik Naggum's avatar
Erik Naggum committed
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
Jim Blandy's avatar
Jim Blandy committed
23

Richard M. Stallman's avatar
Richard M. Stallman committed
24
;;; Commentary:
25

Richard M. Stallman's avatar
Richard M. Stallman committed
26
;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
27 28 29 30
;; date.  It interprets magic cookies of the form ";;;###autoload" in
;; lisp source files in various useful ways.  To learn more, read the
;; source; if you're going to use this, you'd better be able to.

Eric S. Raymond's avatar
Eric S. Raymond committed
31 32
;;; Code:

Stefan Monnier's avatar
Stefan Monnier committed
33
(require 'lisp-mode)			;for `doc-string-elt' properties.
34
(require 'help-fns)			;for help-add-fundoc-usage.
35
(eval-when-compile (require 'cl))
Stefan Monnier's avatar
Stefan Monnier committed
36

37 38 39
(defvar generated-autoload-file "loaddefs.el"
   "*File \\[update-file-autoloads] puts autoloads into.
A `.el' file can set this in its local variables section to make its
40 41
autoloads go somewhere else.  The autoload file is assumed to contain a
trailer starting with a FormFeed character.")
42
;;;###autoload
43
(put 'generated-autoload-file 'safe-local-variable 'stringp)
44

45 46 47 48 49 50 51 52 53 54 55 56
(defvar generated-autoload-feature nil
  "Feature for `generated-autoload-file' to provide.
If nil, this defaults to `generated-autoload-file', sans extension.")
;;;###autoload
(put 'generated-autoload-feature 'safe-local-variable 'symbolp)

(defvar generated-autoload-load-name nil
  "Load name for `autoload' statements generated from autoload cookies.
If nil, this defaults to the file name, sans extension.")
;;;###autoload
(put 'generated-autoload-load-name 'safe-local-variable 'stringp)

57 58 59
;; This feels like it should be a defconst, but MH-E sets it to
;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el.
(defvar generate-autoload-cookie ";;;###autoload"
60 61 62 63 64 65
  "Magic comment indicating the following form should be autoloaded.
Used by \\[update-file-autoloads].  This string should be
meaningless to Lisp (e.g., a comment).

This string is used:

66
\;;;###autoload
67 68 69 70 71 72
\(defun function-to-be-autoloaded () ...)

If this string appears alone on a line, the following form will be
read and an autoload made for it.  If there is further text on the line,
that text will be copied verbatim to `generated-autoload-file'.")

73 74 75
(defvar autoload-excludes nil
  "If non-nil, list of absolute file names not to scan for autoloads.")

76
(defconst generate-autoload-section-header "\f\n;;;### "
77
  "String that marks the form at the start of a new file's autoload section.")
78 79 80 81

(defconst generate-autoload-section-trailer "\n;;;***\n"
  "String which indicates the end of the section of autoloads for a file.")

82 83 84
(defconst generate-autoload-section-continuation ";;;;;; "
  "String to add on each continuation of the section header form.")

85 86
(defvar autoload-modified-buffers)      ;Dynamically scoped var.

Jim Blandy's avatar
Jim Blandy committed
87
(defun make-autoload (form file)
88
  "Turn FORM into an autoload or defvar for source file FILE.
Stefan Monnier's avatar
Stefan Monnier committed
89 90 91 92 93
Returns nil if FORM is not a special autoload form (i.e. a function definition
or macro definition or a defcustom)."
  (let ((car (car-safe form)) expand)
    (cond
     ;; For complex cases, try again on the macro-expansion.
94
     ((and (memq car '(easy-mmode-define-global-mode define-global-minor-mode
95
		       define-globalized-minor-mode
Stefan Monnier's avatar
Stefan Monnier committed
96 97 98 99 100 101 102 103 104 105 106 107 108
		       easy-mmode-define-minor-mode define-minor-mode))
	   (setq expand (let ((load-file-name file)) (macroexpand form)))
	   (eq (car expand) 'progn)
	   (memq :autoload-end expand))
      (let ((end (memq :autoload-end expand)))
	;; Cut-off anything after the :autoload-end marker.
	(setcdr end nil)
	(cons 'progn
	      (mapcar (lambda (form) (make-autoload form file))
		      (cdr expand)))))

     ;; For special function-like operators, use the `autoload' function.
     ((memq car '(defun define-skeleton defmacro define-derived-mode
109 110
                   define-compilation-mode define-generic-mode
		   easy-mmode-define-global-mode define-global-minor-mode
111
		   define-globalized-minor-mode
112
		   easy-mmode-define-minor-mode define-minor-mode
113
		   defun* defmacro* define-overloadable-function))
114
      (let* ((macrop (memq car '(defmacro defmacro*)))
Stefan Monnier's avatar
Stefan Monnier committed
115
	     (name (nth 1 form))
116
	     (args (case car
117 118
		    ((defun defmacro defun* defmacro*
		       define-overloadable-function) (nth 2 form))
119
		    ((define-skeleton) '(&optional str arg))
120 121
		    ((define-generic-mode define-derived-mode
                       define-compilation-mode) nil)
122
		    (t)))
Stefan Monnier's avatar
Stefan Monnier committed
123 124
	     (body (nthcdr (get car 'doc-string-elt) form))
	     (doc (if (stringp (car body)) (pop body))))
125 126 127 128
	(when (listp args)
	  ;; Add the usage form at the end where describe-function-1
	  ;; can recover it.
	  (setq doc (help-add-fundoc-usage doc args)))
Stefan Monnier's avatar
Stefan Monnier committed
129 130 131 132 133
	;; `define-generic-mode' quotes the name, so take care of that
	(list 'autoload (if (listp name) name (list 'quote name)) file doc
	      (or (and (memq car '(define-skeleton define-derived-mode
				    define-generic-mode
				    easy-mmode-define-global-mode
134
				    define-global-minor-mode
135
				    define-globalized-minor-mode
Stefan Monnier's avatar
Stefan Monnier committed
136 137 138 139 140
				    easy-mmode-define-minor-mode
				    define-minor-mode)) t)
		  (eq (car-safe (car body)) 'interactive))
	      (if macrop (list 'quote 'macro) nil))))

141 142 143 144 145 146 147 148
     ;; For defclass forms, use `eieio-defclass-autoload'.
     ((eq car 'defclass)
      (let ((name (nth 1 form))
	    (superclasses (nth 2 form))
	    (doc (nth 4 form)))
	(list 'eieio-defclass-autoload (list 'quote name)
	      (list 'quote superclasses) file doc)))

149
     ;; Convert defcustom to less space-consuming data.
Stefan Monnier's avatar
Stefan Monnier committed
150 151 152 153
     ((eq car 'defcustom)
      (let ((varname (car-safe (cdr-safe form)))
	    (init (car-safe (cdr-safe (cdr-safe form))))
	    (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
154 155 156 157
	    ;; (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))
	    )
	`(progn
	   (defvar ,varname ,init ,doc)
Stefan Monnier's avatar
Stefan Monnier committed
158 159 160 161
	   (custom-autoload ',varname ,file
                            ,(condition-case nil
                                 (null (cadr (memq :set form)))
                               (error nil))))))
Stefan Monnier's avatar
Stefan Monnier committed
162

163 164 165 166 167 168 169 170 171
     ((eq car 'defgroup)
      ;; In Emacs this is normally handled separately by cus-dep.el, but for
      ;; third party packages, it can be convenient to explicitly autoload
      ;; a group.
      (let ((groupname (nth 1 form)))
        `(let ((loads (get ',groupname 'custom-loads)))
           (if (member ',file loads) nil
             (put ',groupname 'custom-loads (cons ',file loads))))))

Stefan Monnier's avatar
Stefan Monnier committed
172 173
     ;; nil here indicates that this is not a special autoload form.
     (t nil))))
Jim Blandy's avatar
Jim Blandy committed
174

175 176 177 178
;; Forms which have doc-strings which should be printed specially.
;; A doc-string-elt property of ELT says that (nth ELT FORM) is
;; the doc-string in FORM.
;; Those properties are now set in lisp-mode.el.
179

180 181
(defun autoload-generated-file ()
  (expand-file-name generated-autoload-file
182 183 184 185 186
                    ;; File-local settings of generated-autoload-file should
                    ;; be interpreted relative to the file's location,
                    ;; of course.
                    (if (not (local-variable-p 'generated-autoload-file))
                        (expand-file-name "lisp" source-directory))))
Jim Blandy's avatar
Jim Blandy committed
187

188

189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209
(defun autoload-read-section-header ()
  "Read a section header form.
Since continuation lines have been marked as comments,
we must copy the text of the form and remove those comment
markers before we call `read'."
  (save-match-data
    (let ((beginning (point))
	  string)
      (forward-line 1)
      (while (looking-at generate-autoload-section-continuation)
	(forward-line 1))
      (setq string (buffer-substring beginning (point)))
      (with-current-buffer (get-buffer-create " *autoload*")
	(erase-buffer)
	(insert string)
	(goto-char (point-min))
	(while (search-forward generate-autoload-section-continuation nil t)
	  (replace-match " "))
	(goto-char (point-min))
	(read (current-buffer))))))

210 211
(defvar autoload-print-form-outbuf nil
  "Buffer which gets the output of `autoload-print-form'.")
212

213
(defun autoload-print-form (form)
214 215 216
  "Print FORM such that `make-docfile' will find the docstrings.
The variable `autoload-print-form-outbuf' specifies the buffer to
put the output in."
217 218 219 220 221 222
  (cond
   ;; If the form is a sequence, recurse.
   ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form)))
   ;; Symbols at the toplevel are meaningless.
   ((symbolp form) nil)
   (t
223 224
    (let ((doc-string-elt (get (car-safe form) 'doc-string-elt))
	  (outbuf autoload-print-form-outbuf))
225 226 227 228 229 230 231 232 233
      (if (and doc-string-elt (stringp (nth doc-string-elt form)))
	  ;; We need to hack the printing because the
	  ;; doc-string must be printed specially for
	  ;; make-docfile (sigh).
	  (let* ((p (nthcdr (1- doc-string-elt) form))
		 (elt (cdr p)))
	    (setcdr p nil)
	    (princ "\n(" outbuf)
	    (let ((print-escape-newlines t)
234
                  (print-quoted t)
235
		  (print-escape-nonascii t))
236 237 238
	      (dolist (elt form)
		(prin1 elt outbuf)
		(princ " " outbuf)))
239 240 241 242 243 244 245 246 247
	    (princ "\"\\\n" outbuf)
	    (let ((begin (with-current-buffer outbuf (point))))
	      (princ (substring (prin1-to-string (car elt)) 1)
		     outbuf)
	      ;; Insert a backslash before each ( that
	      ;; appears at the beginning of a line in
	      ;; the doc string.
	      (with-current-buffer outbuf
		(save-excursion
248
		  (while (re-search-backward "\n[[(]" begin t)
249 250 251 252 253 254 255 256 257
		    (forward-char 1)
		    (insert "\\"))))
	      (if (null (cdr elt))
		  (princ ")" outbuf)
		(princ " " outbuf)
		(princ (substring (prin1-to-string (cdr elt)) 1)
		       outbuf))
	      (terpri outbuf)))
	(let ((print-escape-newlines t)
258
              (print-quoted t)
259 260 261
	      (print-escape-nonascii t))
	  (print form outbuf)))))))

262 263 264 265 266 267 268 269 270 271
(defun autoload-rubric (file &optional type)
  "Return a string giving the appropriate autoload rubric for FILE.
TYPE (default \"autoloads\") is a string stating the type of
information contained in FILE."
  (let ((basename (file-name-nondirectory file)))
    (concat ";;; " basename
	    " --- automatically extracted " (or type "autoloads") "\n"
	    ";;\n"
	    ";;; Code:\n\n"
	    "\n"
272 273 274 275 276 277
	    "(provide '"
	    (if (and generated-autoload-feature
		     (symbolp generated-autoload-feature))
		(format "%s" generated-autoload-feature)
	      (file-name-sans-extension basename))
	    ")\n"
278 279 280 281
	    ";; Local Variables:\n"
	    ";; version-control: never\n"
	    ";; no-byte-compile: t\n"
	    ";; no-update-autoloads: t\n"
282
	    ";; coding: utf-8\n"
283 284 285 286
	    ";; End:\n"
	    ";;; " basename
	    " ends here\n")))

287 288 289
(defun autoload-ensure-default-file (file)
  "Make sure that the autoload file FILE exists and if not create it."
  (unless (file-exists-p file)
290
    (write-region (autoload-rubric file) nil file))
291 292 293 294 295 296
  file)

(defun autoload-insert-section-header (outbuf autoloads load-name file time)
  "Insert the section-header line,
which lists the file name and which functions are in it, etc."
  (insert generate-autoload-section-header)
297
  (prin1 (list 'autoloads autoloads load-name file time)
298 299 300 301 302 303 304 305 306 307 308 309 310
	 outbuf)
  (terpri outbuf)
  ;; Break that line at spaces, to avoid very long lines.
  ;; Make each sub-line into a comment.
  (with-current-buffer outbuf
    (save-excursion
      (forward-line -1)
      (while (not (eolp))
	(move-to-column 64)
	(skip-chars-forward "^ \n")
	(or (eolp)
	    (insert "\n" generate-autoload-section-continuation))))))

311 312 313
(defun autoload-find-file (file)
  "Fetch file and put it in a temp buffer.  Return the buffer."
  ;; It is faster to avoid visiting the file.
314
  (setq file (expand-file-name file))
315 316 317 318 319 320
  (with-current-buffer (get-buffer-create " *autoload-file*")
    (kill-all-local-variables)
    (erase-buffer)
    (setq buffer-undo-list t
          buffer-read-only nil)
    (emacs-lisp-mode)
321
    (setq default-directory (file-name-directory file))
322 323 324 325 326
    (insert-file-contents file nil)
    (let ((enable-local-variables :safe))
      (hack-local-variables))
    (current-buffer)))

327 328 329
(defvar no-update-autoloads nil
  "File local variable to prevent scanning this file for autoload cookies.")

330 331 332 333 334 335
(defun autoload-file-load-name (file)
  (let ((name (file-name-nondirectory file)))
    (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
        (substring name 0 (match-beginning 0))
      name)))

Jim Blandy's avatar
Jim Blandy committed
336 337
(defun generate-file-autoloads (file)
  "Insert at point a loaddefs autoload section for FILE.
338
Autoloads are generated for defuns and defmacros in FILE
339
marked by `generate-autoload-cookie' (which see).
Jim Blandy's avatar
Jim Blandy committed
340
If FILE is being visited in a buffer, the contents of the buffer
341 342
are used.
Return non-nil in the case where no autoloads were added at point."
Jim Blandy's avatar
Jim Blandy committed
343
  (interactive "fGenerate autoloads for file: ")
344 345
  (autoload-generate-file-autoloads file (current-buffer)))

346 347 348 349 350 351 352
;; When called from `generate-file-autoloads' we should ignore
;; `generated-autoload-file' altogether.  When called from
;; `update-file-autoloads' we don't know `outbuf'.  And when called from
;; `update-directory-autoloads' it's in between: we know the default
;; `outbuf' but we should obey any file-local setting of
;; `generated-autoload-file'.
(defun autoload-generate-file-autoloads (file &optional outbuf outfile)
353 354 355 356
  "Insert an autoload section for FILE in the appropriate buffer.
Autoloads are generated for defuns and defmacros in FILE
marked by `generate-autoload-cookie' (which see).
If FILE is being visited in a buffer, the contents of the buffer are used.
357
OUTBUF is the buffer in which the autoload statements should be inserted.
358
If OUTBUF is nil, it will be determined by `autoload-generated-file'.
359

360 361 362 363
If provided, OUTFILE is expected to be the file name of OUTBUF.
If OUTFILE is non-nil and FILE specifies a `generated-autoload-file'
different from OUTFILE, then OUTBUF is ignored.

364
Return non-nil if and only if FILE adds no autoloads to OUTFILE
365
\(or OUTBUF if OUTFILE is nil)."
366 367
  (catch 'done
    (let ((autoloads-done '())
368
	  load-name
369
          (print-length nil)
Miles Bader's avatar
Miles Bader committed
370
	  (print-level nil)
371 372 373
          (print-readably t)           ; This does something in Lucid Emacs.
          (float-output-format nil)
          (visited (get-file-buffer file))
374
          (otherbuf nil)
375 376 377 378
          (absfile (expand-file-name file))
          relfile
          ;; nil until we found a cookie.
          output-start)
379 380
      (if (member absfile autoload-excludes)
      	  (message "Generating autoloads for %s...skipped" file)
381 382 383 384 385 386
      (with-current-buffer (or visited
                               ;; It is faster to avoid visiting the file.
                               (autoload-find-file file))
        ;; Obey the no-update-autoloads file local variable.
        (unless no-update-autoloads
          (message "Generating autoloads for %s..." file)
387 388 389 390
	  (setq load-name
		(if (stringp generated-autoload-load-name)
		    generated-autoload-load-name
		  (autoload-file-load-name file)))
391 392 393 394 395 396 397 398 399 400
          (save-excursion
            (save-restriction
              (widen)
              (goto-char (point-min))
              (while (not (eobp))
                (skip-chars-forward " \t\n\f")
                (cond
                 ((looking-at (regexp-quote generate-autoload-cookie))
                  ;; If not done yet, figure out where to insert this text.
                  (unless output-start
401 402 403 404 405 406
                    (when (and outfile
                               (not (equal outfile (autoload-generated-file))))
                      ;; A file-local setting of autoload-generated-file says
                      ;; we should ignore OUTBUF.
                      (setq outbuf nil)
                      (setq otherbuf t))
407 408 409 410
                    (unless outbuf
                      (setq outbuf (autoload-find-destination absfile))
                      (unless outbuf
                        ;; The file has autoload cookies, but they're
411 412 413 414
                        ;; already up-to-date.  If OUTFILE is nil, the
                        ;; entries are in the expected OUTBUF, otherwise
                        ;; they're elsewhere.
                        (throw 'done outfile)))
415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455
                    (with-current-buffer outbuf
                      (setq relfile (file-relative-name absfile))
                      (setq output-start (point)))
                    ;; (message "file=%S, relfile=%S, dest=%S"
                    ;;          file relfile (autoload-generated-file))
                    )
                  (search-forward generate-autoload-cookie)
                  (skip-chars-forward " \t")
                  (if (eolp)
                      (condition-case err
                          ;; Read the next form and make an autoload.
                          (let* ((form (prog1 (read (current-buffer))
                                         (or (bolp) (forward-line 1))))
                                 (autoload (make-autoload form load-name)))
                            (if autoload
                                (push (nth 1 form) autoloads-done)
                              (setq autoload form))
                            (let ((autoload-print-form-outbuf outbuf))
                              (autoload-print-form autoload)))
                        (error
                         (message "Error in %s: %S" file err)))

                    ;; Copy the rest of the line to the output.
                    (princ (buffer-substring
                            (progn
                              ;; Back up over whitespace, to preserve it.
                              (skip-chars-backward " \f\t")
                              (if (= (char-after (1+ (point))) ? )
                                  ;; Eat one space.
                                  (forward-char 1))
                              (point))
                            (progn (forward-line 1) (point)))
                           outbuf)))
                 ((looking-at ";")
                  ;; Don't read the comment.
                  (forward-line 1))
                 (t
                  (forward-sexp 1)
                  (forward-line 1))))))

          (when output-start
456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478
            (let ((secondary-autoloads-file-buf
                   (if (local-variable-p 'generated-autoload-file)
                       (current-buffer))))
              (with-current-buffer outbuf
                (save-excursion
                  ;; Insert the section-header line which lists the file name
                  ;; and which functions are in it, etc.
                  (goto-char output-start)
                  (autoload-insert-section-header
                   outbuf autoloads-done load-name relfile
                   (if secondary-autoloads-file-buf
                       ;; MD5 checksums are much better because they do not
                       ;; change unless the file changes (so they'll be
                       ;; equal on two different systems and will change
                       ;; less often than time-stamps, thus leading to fewer
                       ;; unneeded changes causing spurious conflicts), but
                       ;; using time-stamps is a very useful optimization,
                       ;; so we use time-stamps for the main autoloads file
                       ;; (loaddefs.el) where we have special ways to
                       ;; circumvent the "random change problem", and MD5
                       ;; checksum in secondary autoload files where we do
                       ;; not need the time-stamp optimization because it is
                       ;; already provided by the primary autoloads file.
479 480 481 482
                       (md5 secondary-autoloads-file-buf
                            ;; We'd really want to just use
                            ;; `emacs-internal' instead.
                            nil nil 'emacs-mule-unix)
483 484 485
                     (nth 5 (file-attributes relfile))))
                  (insert ";;; Generated autoloads from " relfile "\n"))
                (insert generate-autoload-section-trailer))))
486 487 488
          (message "Generating autoloads for %s...done" file))
        (or visited
            ;; We created this buffer, so we should kill it.
489
            (kill-buffer (current-buffer)))))
490 491 492
      ;; If the entries were added to some other buffer, then the file
      ;; doesn't add entries to OUTFILE.
      (or (not output-start) otherbuf))))
493

494 495 496 497 498
(defun autoload-save-buffers ()
  (while autoload-modified-buffers
    (with-current-buffer (pop autoload-modified-buffers)
      (save-buffer))))

Jim Blandy's avatar
Jim Blandy committed
499
;;;###autoload
500
(defun update-file-autoloads (file &optional save-after)
Jim Blandy's avatar
Jim Blandy committed
501
  "Update the autoloads for FILE in `generated-autoload-file'
502
\(which FILE might bind in its local variables).
503 504 505 506 507
If SAVE-AFTER is non-nil (which is always, when called interactively),
save the buffer too.

Return FILE if there was no autoload cookie in it, else nil."
  (interactive "fUpdate autoloads for file: \np")
508 509 510
  (let* ((autoload-modified-buffers nil)
         (no-autoloads (autoload-generate-file-autoloads file)))
    (if autoload-modified-buffers
511
        (if save-after (autoload-save-buffers))
512
      (if (called-interactively-p 'interactive)
513
          (message "Autoload section for %s is up to date." file)))
514
    (if no-autoloads file)))
515 516 517 518 519

(defun autoload-find-destination (file)
  "Find the destination point of the current buffer's autoloads.
FILE is the file name of the current buffer.
Returns a buffer whose point is placed at the requested location.
520
Returns nil if the file's autoloads are uptodate, otherwise
521
removes any prior now out-of-date autoload entries."
522
  (catch 'up-to-date
523 524 525 526
    (let* ((load-name (autoload-file-load-name file))
           (buf (current-buffer))
           (existing-buffer (if buffer-file-name buf))
           (found nil))
527
      (with-current-buffer
528 529 530 531
          ;; We used to use `raw-text' to read this file, but this causes
          ;; problems when the file contains non-ASCII characters.
          (find-file-noselect
           (autoload-ensure-default-file (autoload-generated-file)))
532 533
        ;; This is to make generated-autoload-file have Unix EOLs, so
        ;; that it is portable to all platforms.
534 535
        (unless (zerop (coding-system-eol-type buffer-file-coding-system))
          (set-buffer-file-coding-system 'unix))
536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553
        (or (> (buffer-size) 0)
            (error "Autoloads file %s does not exist" buffer-file-name))
        (or (file-writable-p buffer-file-name)
            (error "Autoloads file %s is not writable" buffer-file-name))
        (widen)
        (goto-char (point-min))
        ;; Look for the section for LOAD-NAME.
        (while (and (not found)
                    (search-forward generate-autoload-section-header nil t))
          (let ((form (autoload-read-section-header)))
            (cond ((string= (nth 2 form) load-name)
                   ;; We found the section for this file.
                   ;; Check if it is up to date.
                   (let ((begin (match-beginning 0))
                         (last-time (nth 4 form))
                         (file-time (nth 5 (file-attributes file))))
                     (if (and (or (null existing-buffer)
                                  (not (buffer-modified-p existing-buffer)))
554 555 556 557 558 559 560 561 562 563
                              (or
                               ;; last-time is the time-stamp (specifying
                               ;; the last time we looked at the file) and
                               ;; the file hasn't been changed since.
                               (and (listp last-time) (= (length last-time) 2)
                                    (not (time-less-p last-time file-time)))
                               ;; last-time is an MD5 checksum instead.
                               (and (stringp last-time)
                                    (equal last-time
                                           (md5 buf nil nil 'emacs-mule)))))
564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581
                         (throw 'up-to-date nil)
                       (autoload-remove-section begin)
                       (setq found t))))
                  ((string< load-name (nth 2 form))
                   ;; We've come to a section alphabetically later than
                   ;; LOAD-NAME.  We assume the file is in order and so
                   ;; there must be no section for LOAD-NAME.  We will
                   ;; insert one before the section here.
                   (goto-char (match-beginning 0))
                   (setq found t)))))
        (or found
            (progn
              ;; No later sections in the file.  Put before the last page.
              (goto-char (point-max))
              (search-backward "\f" nil t)))
        (unless (memq (current-buffer) autoload-modified-buffers)
          (push (current-buffer) autoload-modified-buffers))
        (current-buffer)))))
582 583 584 585 586

(defun autoload-remove-section (begin)
  (goto-char begin)
  (search-forward generate-autoload-section-trailer)
  (delete-region begin (point)))
Jim Blandy's avatar
Jim Blandy committed
587 588

;;;###autoload
589
(defun update-directory-autoloads (&rest dirs)
590
  "\
591
Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
592
This uses `update-file-autoloads' (which see) to do its work.
593 594 595 596 597 598
In an interactive call, you must give one argument, the name
of a single directory.  In a call from Lisp, you can supply multiple
directories as separate arguments, but this usage is discouraged.

The function does NOT recursively descend into subdirectories of the
directory or directories specified."
599
  (interactive "DUpdate autoloads from directory: ")
600
  (let* ((files-re (let ((tmp nil))
601
		     (dolist (suf (get-load-suffixes)
602 603 604
				  (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
		       (unless (string-match "\\.elc" suf) (push suf tmp)))))
	 (files (apply 'nconc
605 606
		       (mapcar (lambda (dir)
				 (directory-files (expand-file-name dir)
607
						  t files-re))
608
			       dirs)))
609
         (done ())
610
	 (this-time (current-time))
611 612 613 614
         ;; Files with no autoload cookies or whose autoloads go to other
         ;; files because of file-local autoload-generated-file settings.
	 (no-autoloads nil)
         (autoload-modified-buffers nil))
615 616

    (with-current-buffer
617 618
	(find-file-noselect
         (autoload-ensure-default-file (autoload-generated-file)))
619
      (save-excursion
620 621

	;; Canonicalize file names and remove the autoload file itself.
622 623
	(setq files (delete (file-relative-name buffer-file-name)
			    (mapcar 'file-relative-name files)))
624

625 626
	(goto-char (point-min))
	(while (search-forward generate-autoload-section-header nil t)
627
	  (let* ((form (autoload-read-section-header))
628
		 (file (nth 3 form)))
629 630 631 632 633 634 635 636 637
	    (cond ((and (consp file) (stringp (car file)))
		   ;; This is a list of files that have no autoload cookies.
		   ;; There shouldn't be more than one such entry.
		   ;; Remove the obsolete section.
		   (autoload-remove-section (match-beginning 0))
		   (let ((last-time (nth 4 form)))
		     (dolist (file file)
		       (let ((file-time (nth 5 (file-attributes file))))
			 (when (and file-time
638
				    (not (time-less-p last-time file-time)))
639 640 641 642
			   ;; file unchanged
			   (push file no-autoloads)
			   (setq files (delete file files)))))))
		  ((not (stringp file)))
643 644 645 646
		  ((or (not (file-exists-p file))
                       ;; Remove duplicates as well, just in case.
                       (member file done))
                   ;; Remove the obsolete section.
647
		   (autoload-remove-section (match-beginning 0)))
648 649
		  ((not (time-less-p (nth 4 form)
                                     (nth 5 (file-attributes file))))
650 651
		   ;; File hasn't changed.
		   nil)
652
		  (t
653 654 655 656
                   (autoload-remove-section (match-beginning 0))
                   (if (autoload-generate-file-autoloads
                        file (current-buffer) buffer-file-name)
                       (push file no-autoloads))))
657
            (push file done)
658
	    (setq files (delete file files)))))
659
      ;; Elements remaining in FILES have no existing autoload sections yet.
660 661 662 663
      (dolist (file files)
        (if (autoload-generate-file-autoloads file nil buffer-file-name)
            (push file no-autoloads)))

664
      (when no-autoloads
665 666
	;; Sort them for better readability.
	(setq no-autoloads (sort no-autoloads 'string<))
667 668 669 670 671 672 673
	;; Add the `no-autoloads' section.
	(goto-char (point-max))
	(search-backward "\f" nil t)
	(autoload-insert-section-header
	 (current-buffer) nil nil no-autoloads this-time)
	(insert generate-autoload-section-trailer))

674 675 676 677
      (save-buffer)
      ;; In case autoload entries were added to other files because of
      ;; file-local autoload-generated-file settings.
      (autoload-save-buffers))))
Jim Blandy's avatar
Jim Blandy committed
678

679 680 681
(define-obsolete-function-alias 'update-autoloads-from-directories
    'update-directory-autoloads "22.1")

Jim Blandy's avatar
Jim Blandy committed
682 683
;;;###autoload
(defun batch-update-autoloads ()
684
  "Update loaddefs.el autoloads in batch mode.
685
Calls `update-directory-autoloads' on the command line arguments."
686 687 688 689 690 691 692 693 694 695 696 697 698
  ;; For use during the Emacs build process only.
  (unless autoload-excludes
    (let* ((ldir (file-name-directory generated-autoload-file))
	   (mfile (expand-file-name "../src/Makefile" ldir))
	   lim)
      (when (file-readable-p mfile)
	(with-temp-buffer
	  (insert-file-contents mfile)
	  (when (re-search-forward "^lisp= ")
	    (setq lim (line-end-position))
	    (while (re-search-forward "\\${lispsource}\\([^ ]*\\)\\.elc?" lim t)
	      (push (concat (expand-file-name (match-string 1) ldir) ".el")
		    autoload-excludes)))))))
Miles Bader's avatar
Miles Bader committed
699 700 701
  (let ((args command-line-args-left))
    (setq command-line-args-left nil)
    (apply 'update-directory-autoloads args)))
Jim Blandy's avatar
Jim Blandy committed
702 703

(provide 'autoload)
Jim Blandy's avatar
Jim Blandy committed
704

705
;; arch-tag: 00244766-98f4-4767-bf42-8a22103441c6
Eric S. Raymond's avatar
Eric S. Raymond committed
706
;;; autoload.el ends here