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
   4 ;;   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 2, or (at your option)
  14 ;; 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; 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.
  25
  26 ;;; Commentary:
  27
  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.
  32
  33 ;;; Code:
  34
  35 (require 'lisp-mode)                    ;for `doc-string-elt' properties.
  36 (require 'help-fns)                     ;for help-add-fundoc-usage.
  37
  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.")
  43
  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).
  48
  49 This string is used:
  50
  51 ;;;###autoload
  52 \(defun function-to-be-autoloaded () ...)
  53
  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'.")
  57
  58 (defconst generate-autoload-section-header "\f\n;;;### "
  59   "String that marks the form at the start of a new file's autoload section.")
  60
  61 (defconst generate-autoload-section-trailer "\n;;;***\n"
  62   "String which indicates the end of the section of autoloads for a file.")
  63
  64 (defconst generate-autoload-section-continuation ";;;;;; "
  65   "String to add on each continuation of the section header form.")
  66
  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)))))
  85
  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))))
 110
 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)))))
 117             )
 118         `(progn
 119            (defvar ,varname ,init ,doc)
 120            (custom-autoload ',varname ,file))))
 121
 122      ;; nil here indicates that this is not a special autoload form.
 123      (t nil))))
 124
 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.
 129
 130
 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)))
 140
 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))))))
 161
 162 (defvar autoload-print-form-outbuf)
 163
 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)
 173    (t
 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)))))))
 210
 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)
 228
 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))))))
 248
 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)
 268
 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))))
 284
 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)))
 321
 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))
 336                    (t
 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)))
 355 \f
 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)
 453                                  nil
 454                                (if (interactive-p)
 455                                    (message "%s has no autoloads" file))
 456                                (setq no-autoloads t)
 457                                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))
 464
 465       (if no-autoloads file))))
 466
 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)))))
 471
 472 (defun autoload-remove-section (begin)
 473   (goto-char begin)
 474   (search-forward generate-autoload-section-trailer)
 475   (delete-region begin (point)))
 476
 477 ;;;###autoload
 478 (defun update-autoloads-from-directories (&rest dirs)
 479   "\
 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   (interactive "DUpdate autoloads from directory: ")
 483   (let* ((files-re (let ((tmp nil))
 484                      (dolist (suf load-suffixes
 485                                   (concat "^[^=.].*" (regexp-opt tmp t) "\\'"))
 486                        (unless (string-match "\\.elc" suf) (push suf tmp)))))
 487          (files (apply 'nconc
 488                        (mapcar (lambda (dir)
 489                                  (directory-files (expand-file-name dir)
 490                                                   t files-re))
 491                                dirs)))
 492          (this-time (current-time))
 493          (no-autoloads nil)             ;files with no autoload cookies.
 494          (autoloads-file
 495           (expand-file-name generated-autoload-file
 496                             (expand-file-name "lisp" source-directory)))
 497          (top-dir (file-name-directory autoloads-file)))
 498
 499     (with-current-buffer
 500         (find-file-noselect (autoload-ensure-default-file autoloads-file))
 501       (save-excursion
 502
 503         ;; Canonicalize file names and remove the autoload file itself.
 504         (setq files (delete (autoload-trim-file-name buffer-file-name)
 505                             (mapcar 'autoload-trim-file-name files)))
 506
 507         (goto-char (point-min))
 508         (while (search-forward generate-autoload-section-header nil t)
 509           (let* ((form (autoload-read-section-header))
 510                  (file (nth 3 form)))
 511             (cond ((and (consp file) (stringp (car file)))
 512                    ;; This is a list of files that have no autoload cookies.
 513                    ;; There shouldn't be more than one such entry.
 514                    ;; Remove the obsolete section.
 515                    (autoload-remove-section (match-beginning 0))
 516                    (let ((last-time (nth 4 form)))
 517                      (dolist (file file)
 518                        (let ((file-time (nth 5 (file-attributes file))))
 519                          (when (and file-time
 520                                     (not (autoload-before-p last-time
 521                                                             file-time)))
 522                            ;; file unchanged
 523                            (push file no-autoloads)
 524                            (setq files (delete file files)))))))
 525                   ((not (stringp file)))
 526                   ((not (file-exists-p (expand-file-name file top-dir)))
 527                    ;; Remove the obsolete section.
 528                    (autoload-remove-section (match-beginning 0)))
 529                   ((equal (nth 4 form) (nth 5 (file-attributes file)))
 530                    ;; File hasn't changed.
 531                    nil)
 532                   (t
 533                    (update-file-autoloads file)))
 534             (setq files (delete file files)))))
 535       ;; Elements remaining in FILES have no existing autoload sections yet.
 536       (setq no-autoloads
 537             (append no-autoloads
 538                     (delq nil (mapcar 'update-file-autoloads files))))
 539       (when no-autoloads
 540         ;; Sort them for better readability.
 541         (setq no-autoloads (sort no-autoloads 'string<))
 542         ;; Add the `no-autoloads' section.
 543         (goto-char (point-max))
 544         (search-backward "\f" nil t)
 545         (autoload-insert-section-header
 546          (current-buffer) nil nil no-autoloads this-time)
 547         (insert generate-autoload-section-trailer))
 548
 549       (save-buffer))))
 550
 551 ;;;###autoload
 552 (defun batch-update-autoloads ()
 553   "Update loaddefs.el autoloads in batch mode.
 554 Calls `update-autoloads-from-directories' on the command line arguments."
 555   (apply 'update-autoloads-from-directories command-line-args-left)
 556   (setq command-line-args-left nil))
 557
 558 (provide 'autoload)
 559
 560 ;;; autoload.el ends here