code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/autoload.el

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