lisp/emacs-lisp/autoload.el

   1 ;;; autoload.el --- maintain autoloads in loaddefs.el.
   2
   3 ;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97 Free Software Foundation, Inc.
   4
   5 ;; Author: Roland McGrath <roland@gnu.org>
   6 ;; Keywords: maint
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
  28 ;; date.  It interprets magic cookies of the form ";;;###autoload" in
  29 ;; lisp source files in various useful ways.  To learn more, read the
  30 ;; source; if you're going to use this, you'd better be able to.
  31
  32 ;;; Code:
  33
  34 (defvar generated-autoload-file "loaddefs.el"
  35    "*File \\[update-file-autoloads] puts autoloads into.
  36 A `.el' file can set this in its local variables section to make its
  37 autoloads go somewhere else.  The autoload file is assumed to contain a
  38 trailer starting with a FormFeed character.")
  39
  40 (defconst generate-autoload-cookie ";;;###autoload"
  41   "Magic comment indicating the following form should be autoloaded.
  42 Used by \\[update-file-autoloads].  This string should be
  43 meaningless to Lisp (e.g., a comment).
  44
  45 This string is used:
  46
  47 ;;;###autoload
  48 \(defun function-to-be-autoloaded () ...)
  49
  50 If this string appears alone on a line, the following form will be
  51 read and an autoload made for it.  If there is further text on the line,
  52 that text will be copied verbatim to `generated-autoload-file'.")
  53
  54 (defconst generate-autoload-section-header "\f\n;;;### "
  55   "String that marks the form at the start of a new file's autoload section.")
  56
  57 (defconst generate-autoload-section-trailer "\n;;;***\n"
  58   "String which indicates the end of the section of autoloads for a file.")
  59
  60 (defconst generate-autoload-section-continuation ";;;;;; "
  61   "String to add on each continuation of the section header form.")
  62
  63 (defun make-autoload (form file)
  64   "Turn FORM into an autoload or defvar for source file FILE.
  65 Returns nil if FORM is not a special autoload form (i.e. a function definition
  66 or macro definition or a defcustom)."
  67   (let ((car (car-safe form)) expand)
  68     (cond
  69      ;; For complex cases, try again on the macro-expansion.
  70      ((and (memq car '(easy-mmode-define-global-mode
  71                        easy-mmode-define-minor-mode define-minor-mode))
  72            (setq expand (let ((load-file-name file)) (macroexpand form)))
  73            (eq (car expand) 'progn)
  74            (memq :autoload-end expand))
  75       (let ((end (memq :autoload-end expand)))
  76         ;; Cut-off anything after the :autoload-end marker.
  77         (setcdr end nil)
  78         (cons 'progn
  79               (mapcar (lambda (form) (make-autoload form file))
  80                       (cdr expand)))))
  81
  82      ;; For special function-like operators, use the `autoload' function.
  83      ((memq car '(defun define-skeleton defmacro define-derived-mode
  84                    define-generic-mode easy-mmode-define-minor-mode
  85                    easy-mmode-define-global-mode
  86                    define-minor-mode defun*))
  87       (let* ((macrop (eq car 'defmacro))
  88              (name (nth 1 form))
  89              (body (nthcdr (get car 'doc-string-elt) form))
  90              (doc (if (stringp (car body)) (pop body))))
  91         ;; `define-generic-mode' quotes the name, so take care of that
  92         (list 'autoload (if (listp name) name (list 'quote name)) file doc
  93               (or (and (memq car '(define-skeleton define-derived-mode
  94                                     define-generic-mode
  95                                     easy-mmode-define-global-mode
  96                                     easy-mmode-define-minor-mode
  97                                     define-minor-mode)) t)
  98                   (eq (car-safe (car body)) 'interactive))
  99               (if macrop (list 'quote 'macro) nil))))
 100
 101      ;; Convert defcustom to a simpler (and less space-consuming) defvar,
 102      ;; but add some extra stuff if it uses :require.
 103      ((eq car 'defcustom)
 104       (let ((varname (car-safe (cdr-safe form)))
 105             (init (car-safe (cdr-safe (cdr-safe form))))
 106             (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
 107             (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))))
 108         (if (not (plist-get rest :require))
 109             `(defvar ,varname ,init ,doc)
 110           `(progn
 111              (defvar ,varname ,init ,doc)
 112              (custom-add-to-group ,(plist-get rest :group)
 113                                   ',varname 'custom-variable)
 114              (custom-add-load ',varname
 115                               ,(plist-get rest :require))))))
 116
 117      ;; nil here indicates that this is not a special autoload form.
 118      (t nil))))
 119
 120 ;;; Forms which have doc-strings which should be printed specially.
 121 ;;; A doc-string-elt property of ELT says that (nth ELT FORM) is
 122 ;;; the doc-string in FORM.
 123 ;;;
 124 ;;; There used to be the following note here:
 125 ;;; ;;; Note: defconst and defvar should NOT be marked in this way.
 126 ;;; ;;; We don't want to produce defconsts and defvars that
 127 ;;; ;;; make-docfile can grok, because then it would grok them twice,
 128 ;;; ;;; once in foo.el (where they are given with ;;;###autoload) and
 129 ;;; ;;; once in loaddefs.el.
 130 ;;;
 131 ;;; Counter-note: Yes, they should be marked in this way.
 132 ;;; make-docfile only processes those files that are loaded into the
 133 ;;; dumped Emacs, and those files should never have anything
 134 ;;; autoloaded here.  The above-feared problem only occurs with files
 135 ;;; which have autoloaded entries *and* are processed by make-docfile;
 136 ;;; there should be no such files.
 137
 138 (put 'autoload 'doc-string-elt 3)
 139 (put 'defun    'doc-string-elt 3)
 140 (put 'defun*    'doc-string-elt 3)
 141 (put 'defvar   'doc-string-elt 3)
 142 (put 'defcustom 'doc-string-elt 3)
 143 (put 'defconst 'doc-string-elt 3)
 144 (put 'defmacro 'doc-string-elt 3)
 145 (put 'defsubst 'doc-string-elt 3)
 146 (put 'define-skeleton 'doc-string-elt 2)
 147 (put 'define-derived-mode 'doc-string-elt 4)
 148 (put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
 149 (put 'define-minor-mode 'doc-string-elt 2)
 150 (put 'define-generic-mode 'doc-string-elt 7)
 151 ;; defin-global-mode has no explicit docstring.
 152 (put 'easy-mmode-define-global-mode 'doc-string-elt 1000)
 153
 154
 155 (defun autoload-trim-file-name (file)
 156   ;; Returns a relative pathname of FILE
 157   ;; starting from the directory that loaddefs.el is in.
 158   ;; That is normally a directory in load-path,
 159   ;; which means Emacs will be able to find FILE when it looks.
 160   ;; Any extra directory names here would prevent finding the file.
 161   (setq file (expand-file-name file))
 162   (file-relative-name file
 163                       (file-name-directory generated-autoload-file)))
 164
 165 (defun autoload-read-section-header ()
 166   "Read a section header form.
 167 Since continuation lines have been marked as comments,
 168 we must copy the text of the form and remove those comment
 169 markers before we call `read'."
 170   (save-match-data
 171     (let ((beginning (point))
 172           string)
 173       (forward-line 1)
 174       (while (looking-at generate-autoload-section-continuation)
 175         (forward-line 1))
 176       (setq string (buffer-substring beginning (point)))
 177       (with-current-buffer (get-buffer-create " *autoload*")
 178         (erase-buffer)
 179         (insert string)
 180         (goto-char (point-min))
 181         (while (search-forward generate-autoload-section-continuation nil t)
 182           (replace-match " "))
 183         (goto-char (point-min))
 184         (read (current-buffer))))))
 185
 186 ;; !! Requires OUTBUF to be bound !!
 187 (defun autoload-print-form (form)
 188   "Print FORM such that make-docfile will find the docstrings."
 189   (cond
 190    ;; If the form is a sequence, recurse.
 191    ((eq (car form) 'progn) (mapcar 'autoload-print-form (cdr form)))
 192    ;; Symbols at the toplevel are meaningless.
 193    ((symbolp form) nil)
 194    (t
 195     (let ((doc-string-elt (get (car-safe form) 'doc-string-elt)))
 196       (if (and doc-string-elt (stringp (nth doc-string-elt form)))
 197           ;; We need to hack the printing because the
 198           ;; doc-string must be printed specially for
 199           ;; make-docfile (sigh).
 200           (let* ((p (nthcdr (1- doc-string-elt) form))
 201                  (elt (cdr p)))
 202             (setcdr p nil)
 203             (princ "\n(" outbuf)
 204             (let ((print-escape-newlines t)
 205                   (print-escape-nonascii t))
 206               (mapcar (lambda (elt)
 207                         (prin1 elt outbuf)
 208                         (princ " " outbuf))
 209                       form))
 210             (princ "\"\\\n" outbuf)
 211             (let ((begin (with-current-buffer outbuf (point))))
 212               (princ (substring (prin1-to-string (car elt)) 1)
 213                      outbuf)
 214               ;; Insert a backslash before each ( that
 215               ;; appears at the beginning of a line in
 216               ;; the doc string.
 217               (with-current-buffer outbuf
 218                 (save-excursion
 219                   (while (search-backward "\n(" begin t)
 220                     (forward-char 1)
 221                     (insert "\\"))))
 222               (if (null (cdr elt))
 223                   (princ ")" outbuf)
 224                 (princ " " outbuf)
 225                 (princ (substring (prin1-to-string (cdr elt)) 1)
 226                        outbuf))
 227               (terpri outbuf)))
 228         (let ((print-escape-newlines t)
 229               (print-escape-nonascii t))
 230           (print form outbuf)))))))
 231
 232 (defun generate-file-autoloads (file)
 233   "Insert at point a loaddefs autoload section for FILE.
 234 autoloads are generated for defuns and defmacros in FILE
 235 marked by `generate-autoload-cookie' (which see).
 236 If FILE is being visited in a buffer, the contents of the buffer
 237 are used."
 238   (interactive "fGenerate autoloads for file: ")
 239   (let ((outbuf (current-buffer))
 240         (autoloads-done '())
 241         (load-name (let ((name (file-name-nondirectory file)))
 242                      (if (string-match "\\.elc?$" name)
 243                          (substring name 0 (match-beginning 0))
 244                        name)))
 245         (print-length nil)
 246         (print-readably t)              ; This does something in Lucid Emacs.
 247         (float-output-format nil)
 248         (done-any nil)
 249         (visited (get-file-buffer file))
 250         output-end)
 251
 252     ;; If the autoload section we create here uses an absolute
 253     ;; pathname for FILE in its header, and then Emacs is installed
 254     ;; under a different path on another system,
 255     ;; `update-autoloads-here' won't be able to find the files to be
 256     ;; autoloaded.  So, if FILE is in the same directory or a
 257     ;; subdirectory of the current buffer's directory, we'll make it
 258     ;; relative to the current buffer's directory.
 259     (setq file (expand-file-name file))
 260     (let* ((source-truename (file-truename file))
 261            (dir-truename (file-name-as-directory
 262                           (file-truename default-directory)))
 263            (len (length dir-truename)))
 264       (if (and (< len (length source-truename))
 265                (string= dir-truename (substring source-truename 0 len)))
 266           (setq file (substring source-truename len))))
 267
 268     (message "Generating autoloads for %s..." file)
 269     (save-excursion
 270       (unwind-protect
 271           (progn
 272             (if visited
 273                 (set-buffer visited)
 274               ;; It is faster to avoid visiting the file.
 275               (set-buffer (get-buffer-create " *generate-autoload-file*"))
 276               (kill-all-local-variables)
 277               (erase-buffer)
 278               (setq buffer-undo-list t
 279                     buffer-read-only nil)
 280               (emacs-lisp-mode)
 281               (insert-file-contents file nil))
 282             (save-excursion
 283               (save-restriction
 284                 (widen)
 285                 (goto-char (point-min))
 286                 (while (not (eobp))
 287                   (skip-chars-forward " \t\n\f")
 288                   (cond
 289                    ((looking-at (regexp-quote generate-autoload-cookie))
 290                     (search-forward generate-autoload-cookie)
 291                     (skip-chars-forward " \t")
 292                     (setq done-any t)
 293                     (if (eolp)
 294                         ;; Read the next form and make an autoload.
 295                         (let* ((form (prog1 (read (current-buffer))
 296                                                (or (bolp) (forward-line 1))))
 297                                (autoload (make-autoload form load-name)))
 298                           (if autoload
 299                               (setq autoloads-done (cons (nth 1 form)
 300                                                          autoloads-done))
 301                             (setq autoload form))
 302                           (autoload-print-form autoload))
 303
 304                       ;; Copy the rest of the line to the output.
 305                       (princ (buffer-substring
 306                               (progn
 307                                 ;; Back up over whitespace, to preserve it.
 308                                 (skip-chars-backward " \f\t")
 309                                 (if (= (char-after (1+ (point))) ? )
 310                                     ;; Eat one space.
 311                                     (forward-char 1))
 312                                 (point))
 313                               (progn (forward-line 1) (point)))
 314                              outbuf)))
 315                    ((looking-at ";")
 316                     ;; Don't read the comment.
 317                     (forward-line 1))
 318                    (t
 319                     (forward-sexp 1)
 320                     (forward-line 1)))))))
 321         (or visited
 322             ;; We created this buffer, so we should kill it.
 323             (kill-buffer (current-buffer)))
 324         (set-buffer outbuf)
 325         (setq output-end (point-marker))))
 326     (if done-any
 327         (progn
 328           ;; Insert the section-header line
 329           ;; which lists the file name and which functions are in it, etc.
 330           (insert generate-autoload-section-header)
 331           (prin1 (list 'autoloads autoloads-done load-name
 332                        (autoload-trim-file-name file)
 333                        (nth 5 (file-attributes file)))
 334                  outbuf)
 335           (terpri outbuf)
 336           ;; Break that line at spaces, to avoid very long lines.
 337           ;; Make each sub-line into a comment.
 338           (with-current-buffer outbuf
 339             (save-excursion
 340               (forward-line -1)
 341               (while (not (eolp))
 342                 (move-to-column 64)
 343                 (skip-chars-forward "^ \n")
 344                 (or (eolp)
 345                     (insert "\n" generate-autoload-section-continuation)))))
 346           (insert ";;; Generated autoloads from "
 347                   (autoload-trim-file-name file) "\n")
 348           ;; Warn if we put a line in loaddefs.el
 349           ;; that is long enough to cause trouble.
 350           (while (< (point) output-end)
 351             (let ((beg (point)))
 352               (end-of-line)
 353               (if (> (- (point) beg) 900)
 354                   (progn
 355                     (message "A line is too long--over 900 characters")
 356                     (sleep-for 2)
 357                     (goto-char output-end))))
 358             (forward-line 1))
 359           (goto-char output-end)
 360           (insert generate-autoload-section-trailer)))
 361     (message "Generating autoloads for %s...done" file)))
 362 \f
 363 ;;;###autoload
 364 (defun update-file-autoloads (file)
 365   "Update the autoloads for FILE in `generated-autoload-file'
 366 \(which FILE might bind in its local variables)."
 367   (interactive "fUpdate autoloads for file: ")
 368   (let ((load-name (let ((name (file-name-nondirectory file)))
 369                      (if (string-match "\\.elc?$" name)
 370                          (substring name 0 (match-beginning 0))
 371                        name)))
 372         (found nil)
 373         (existing-buffer (get-file-buffer file)))
 374     (save-excursion
 375       ;; We want to get a value for generated-autoload-file from
 376       ;; the local variables section if it's there.
 377       (if existing-buffer
 378           (set-buffer existing-buffer))
 379       ;; We must read/write the file without any code conversion,
 380       ;; but still decode EOLs.
 381       (let ((coding-system-for-read 'raw-text))
 382         (set-buffer (find-file-noselect
 383                      (expand-file-name generated-autoload-file
 384                                        (expand-file-name "lisp"
 385                                                          source-directory))))
 386         ;; This is to make generated-autoload-file have Unix EOLs, so
 387         ;; that it is portable to all platforms.
 388         (setq buffer-file-coding-system 'raw-text-unix))
 389       (or (> (buffer-size) 0)
 390           (error "Autoloads file %s does not exist" buffer-file-name))
 391       (or (file-writable-p buffer-file-name)
 392           (error "Autoloads file %s is not writable" buffer-file-name))
 393       (save-excursion
 394         (save-restriction
 395           (widen)
 396           (goto-char (point-min))
 397           ;; Look for the section for LOAD-NAME.
 398           (while (and (not found)
 399                       (search-forward generate-autoload-section-header nil t))
 400             (let ((form (autoload-read-section-header)))
 401               (cond ((string= (nth 2 form) load-name)
 402                      ;; We found the section for this file.
 403                      ;; Check if it is up to date.
 404                      (let ((begin (match-beginning 0))
 405                            (last-time (nth 4 form))
 406                            (file-time (nth 5 (file-attributes file))))
 407                        (if (and (or (null existing-buffer)
 408                                     (not (buffer-modified-p existing-buffer)))
 409                                 (listp last-time) (= (length last-time) 2)
 410                                 (or (> (car last-time) (car file-time))
 411                                     (and (= (car last-time) (car file-time))
 412                                          (>= (nth 1 last-time)
 413                                              (nth 1 file-time)))))
 414                            (progn
 415                              (if (interactive-p)
 416                                  (message "\
 417 Autoload section for %s is up to date."
 418                                           file))
 419                              (setq found 'up-to-date))
 420                          (search-forward generate-autoload-section-trailer)
 421                          (delete-region begin (point))
 422                          (setq found t))))
 423                     ((string< load-name (nth 2 form))
 424                      ;; We've come to a section alphabetically later than
 425                      ;; LOAD-NAME.  We assume the file is in order and so
 426                      ;; there must be no section for LOAD-NAME.  We will
 427                      ;; insert one before the section here.
 428                      (goto-char (match-beginning 0))
 429                      (setq found 'new)))))
 430           (or found
 431               (progn
 432                 (setq found 'new)
 433                 ;; No later sections in the file.  Put before the last page.
 434                 (goto-char (point-max))
 435                 (search-backward "\f" nil t)))
 436           (or (eq found 'up-to-date)
 437               (and (eq found 'new)
 438                    ;; Check that FILE has any cookies before generating a
 439                    ;; new section for it.
 440                    (save-excursion
 441                      (if existing-buffer
 442                          (set-buffer existing-buffer)
 443                        ;; It is faster to avoid visiting the file.
 444                        (set-buffer (get-buffer-create " *autoload-file*"))
 445                        (kill-all-local-variables)
 446                        (erase-buffer)
 447                        (setq buffer-undo-list t
 448                              buffer-read-only nil)
 449                        (emacs-lisp-mode)
 450                        (insert-file-contents file nil))
 451                      (save-excursion
 452                        (save-restriction
 453                          (widen)
 454                          (goto-char (point-min))
 455                          (prog1
 456                              (if (re-search-forward
 457                                   (concat "^" (regexp-quote
 458                                                generate-autoload-cookie))
 459                                   nil t)
 460                                  nil
 461                                (if (interactive-p)
 462                                    (message "%s has no autoloads" file))
 463                                t)
 464                            (or existing-buffer
 465                                (kill-buffer (current-buffer))))))))
 466               (generate-file-autoloads file))))
 467       (and (interactive-p)
 468            (buffer-modified-p)
 469            (save-buffer)))))
 470
 471 ;;;###autoload
 472 (defun update-autoloads-from-directories (&rest dirs)
 473   "\
 474 Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
 475 This uses `update-file-autoloads' (which see) do its work."
 476   (interactive "DUpdate autoloads from directory: ")
 477   (let ((files (apply 'nconc
 478                       (mapcar (function (lambda (dir)
 479                                           (directory-files (expand-file-name dir)
 480                                                            t
 481                                                            "^[^=.].*\\.el$")))
 482                               dirs)))
 483         autoloads-file
 484         top-dir)
 485     (setq autoloads-file
 486           (expand-file-name generated-autoload-file
 487                             (expand-file-name "lisp"
 488                                               source-directory)))
 489     (setq top-dir (file-name-directory autoloads-file))
 490     (save-excursion
 491       (set-buffer (find-file-noselect autoloads-file))
 492       (save-excursion
 493         (goto-char (point-min))
 494         (while (search-forward generate-autoload-section-header nil t)
 495           (let* ((form (autoload-read-section-header))
 496                  (file (nth 3 form)))
 497             (cond ((not (stringp file)))
 498                   ((not (file-exists-p (expand-file-name file top-dir)))
 499                    ;; Remove the obsolete section.
 500                    (let ((begin (match-beginning 0)))
 501                      (search-forward generate-autoload-section-trailer)
 502                      (delete-region begin (point))))
 503                   (t
 504                    (update-file-autoloads file)))
 505             (setq files (delete file files)))))
 506       ;; Elements remaining in FILES have no existing autoload sections.
 507       (mapcar 'update-file-autoloads files)
 508       (save-buffer))))
 509
 510 ;;;###autoload
 511 (defun batch-update-autoloads ()
 512   "Update loaddefs.el autoloads in batch mode.
 513 Calls `update-autoloads-from-directories' on the command line arguments."
 514   (apply 'update-autoloads-from-directories command-line-args-left)
 515   (setq command-line-args-left nil))
 516
 517 (provide 'autoload)
 518
 519 ;;; autoload.el ends here