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 `defun', `define-skeleton',
  66 `define-derived-mode', `define-generic-mode', `defmacro', `defcustom',
  67 `define-minor-mode' or `easy-mmode-define-minor-mode'."
  68   (let ((car (car-safe form)))
  69     (if (memq car '(defun define-skeleton defmacro define-derived-mode
  70                      define-generic-mode easy-mmode-define-minor-mode
  71                      define-minor-mode defun*))
  72         (let ((macrop (eq car 'defmacro))
  73               name doc)
  74           (setq form (cdr form)
  75                 name (car form)
  76                 ;; Ignore the arguments.
  77                 form (cdr (cond
  78                            ((memq car '(define-skeleton define-minor-mode
  79                                          easy-mmode-define-minor-mode)) form)
  80                            ((eq car 'define-derived-mode) (cdr (cdr form)))
  81                            ((eq car 'define-generic-mode)
  82                             (cdr (cdr (cdr (cdr (cdr form))))))
  83                            (t (cdr form))))
  84                 doc (car form))
  85           (if (stringp doc)
  86               (setq form (cdr form))
  87             (setq doc nil))
  88           ;; `define-generic-mode' quotes the name, so take care of that
  89           (list 'autoload (if (listp name) name (list 'quote name)) file doc
  90                 (or (eq car 'define-skeleton) (eq car 'define-derived-mode)
  91                     (eq car 'define-generic-mode)
  92                     (eq car 'easy-mmode-define-minor-mode)
  93                     (eq car 'define-minor-mode)
  94                     (eq (car-safe (car form)) 'interactive))
  95                 (if macrop (list 'quote 'macro) nil)))
  96       ;; Convert defcustom to a simpler (and less space-consuming) defvar,
  97       ;; but add some extra stuff if it uses :require.
  98       (if (eq car 'defcustom)
  99           (let ((varname (car-safe (cdr-safe form)))
 100                 (init (car-safe (cdr-safe (cdr-safe form))))
 101                 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
 102                 (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))))
 103             (if (not (plist-get rest :require))
 104                 `(defvar ,varname ,init ,doc)
 105               `(progn
 106                  (defvar ,varname ,init ,doc)
 107                  (custom-add-to-group ,(plist-get rest :group)
 108                                       ',varname 'custom-variable)
 109                  (custom-add-load ',varname
 110                                   ,(plist-get rest :require)))))
 111         nil))))
 112
 113 ;;; Forms which have doc-strings which should be printed specially.
 114 ;;; A doc-string-elt property of ELT says that (nth ELT FORM) is
 115 ;;; the doc-string in FORM.
 116 ;;;
 117 ;;; There used to be the following note here:
 118 ;;; ;;; Note: defconst and defvar should NOT be marked in this way.
 119 ;;; ;;; We don't want to produce defconsts and defvars that
 120 ;;; ;;; make-docfile can grok, because then it would grok them twice,
 121 ;;; ;;; once in foo.el (where they are given with ;;;###autoload) and
 122 ;;; ;;; once in loaddefs.el.
 123 ;;;
 124 ;;; Counter-note: Yes, they should be marked in this way.
 125 ;;; make-docfile only processes those files that are loaded into the
 126 ;;; dumped Emacs, and those files should never have anything
 127 ;;; autoloaded here.  The above-feared problem only occurs with files
 128 ;;; which have autoloaded entries *and* are processed by make-docfile;
 129 ;;; there should be no such files.
 130
 131 (put 'autoload 'doc-string-elt 3)
 132 (put 'defun    'doc-string-elt 3)
 133 (put 'defvar   'doc-string-elt 3)
 134 (put 'defcustom 'doc-string-elt 3)
 135 (put 'defconst 'doc-string-elt 3)
 136 (put 'defmacro 'doc-string-elt 3)
 137 (put 'defsubst 'doc-string-elt 3)
 138 (put 'define-skeleton 'doc-string-elt 3)
 139 (put 'define-derived-mode 'doc-string-elt 3)
 140 (put 'easy-mmode-define-minor-mode 'doc-string-elt 3)
 141 (put 'define-minor-mode 'doc-string-elt 3)
 142 (put 'define-generic-mode 'doc-string-elt 3)
 143
 144
 145 (defun autoload-trim-file-name (file)
 146   ;; Returns a relative pathname of FILE
 147   ;; starting from the directory that loaddefs.el is in.
 148   ;; That is normally a directory in load-path,
 149   ;; which means Emacs will be able to find FILE when it looks.
 150   ;; Any extra directory names here would prevent finding the file.
 151   (setq file (expand-file-name file))
 152   (file-relative-name file
 153                       (file-name-directory generated-autoload-file)))
 154
 155 (defun autoload-read-section-header ()
 156   "Read a section header form.
 157 Since continuation lines have been marked as comments,
 158 we must copy the text of the form and remove those comment
 159 markers before we call `read'."
 160   (save-match-data
 161     (let ((beginning (point))
 162           string)
 163       (forward-line 1)
 164       (while (looking-at generate-autoload-section-continuation)
 165         (forward-line 1))
 166       (setq string (buffer-substring beginning (point)))
 167       (with-current-buffer (get-buffer-create " *autoload*")
 168         (erase-buffer)
 169         (insert string)
 170         (goto-char (point-min))
 171         (while (search-forward generate-autoload-section-continuation nil t)
 172           (replace-match " "))
 173         (goto-char (point-min))
 174         (read (current-buffer))))))
 175
 176 (defun generate-file-autoloads (file)
 177   "Insert at point a loaddefs autoload section for FILE.
 178 autoloads are generated for defuns and defmacros in FILE
 179 marked by `generate-autoload-cookie' (which see).
 180 If FILE is being visited in a buffer, the contents of the buffer
 181 are used."
 182   (interactive "fGenerate autoloads for file: ")
 183   (let ((outbuf (current-buffer))
 184         (autoloads-done '())
 185         (load-name (let ((name (file-name-nondirectory file)))
 186                      (if (string-match "\\.elc?$" name)
 187                          (substring name 0 (match-beginning 0))
 188                        name)))
 189         (print-length nil)
 190         (print-readably t)              ; This does something in Lucid Emacs.
 191         (float-output-format nil)
 192         (done-any nil)
 193         (visited (get-file-buffer file))
 194         output-end)
 195
 196     ;; If the autoload section we create here uses an absolute
 197     ;; pathname for FILE in its header, and then Emacs is installed
 198     ;; under a different path on another system,
 199     ;; `update-autoloads-here' won't be able to find the files to be
 200     ;; autoloaded.  So, if FILE is in the same directory or a
 201     ;; subdirectory of the current buffer's directory, we'll make it
 202     ;; relative to the current buffer's directory.
 203     (setq file (expand-file-name file))
 204     (let* ((source-truename (file-truename file))
 205            (dir-truename (file-name-as-directory
 206                           (file-truename default-directory)))
 207            (len (length dir-truename)))
 208       (if (and (< len (length source-truename))
 209                (string= dir-truename (substring source-truename 0 len)))
 210           (setq file (substring source-truename len))))
 211
 212     (message "Generating autoloads for %s..." file)
 213     (save-excursion
 214       (unwind-protect
 215           (progn
 216             (if visited
 217                 (set-buffer visited)
 218               ;; It is faster to avoid visiting the file.
 219               (set-buffer (get-buffer-create " *generate-autoload-file*"))
 220               (kill-all-local-variables)
 221               (erase-buffer)
 222               (setq buffer-undo-list t
 223                     buffer-read-only nil)
 224               (emacs-lisp-mode)
 225               (insert-file-contents file nil))
 226             (save-excursion
 227               (save-restriction
 228                 (widen)
 229                 (goto-char (point-min))
 230                 (while (not (eobp))
 231                   (skip-chars-forward " \t\n\f")
 232                   (cond
 233                    ((looking-at (regexp-quote generate-autoload-cookie))
 234                     (search-forward generate-autoload-cookie)
 235                     (skip-chars-forward " \t")
 236                     (setq done-any t)
 237                     (if (eolp)
 238                         ;; Read the next form and make an autoload.
 239                         (let* ((form (prog1 (read (current-buffer))
 240                                        (or (bolp) (forward-line 1))))
 241                                (autoload-1 (make-autoload form load-name))
 242                                (autoload (if (eq (car autoload-1) 'progn)
 243                                              (cadr autoload-1)
 244                                            autoload-1))
 245                                (doc-string-elt (get (car-safe form)
 246                                                     'doc-string-elt)))
 247                           (if autoload
 248                               (setq autoloads-done (cons (nth 1 form)
 249                                                          autoloads-done))
 250                             (setq autoload form))
 251                           (if (and doc-string-elt
 252                                    (stringp (nth doc-string-elt autoload)))
 253                               ;; We need to hack the printing because the
 254                               ;; doc-string must be printed specially for
 255                               ;; make-docfile (sigh).
 256                               (let* ((p (nthcdr (1- doc-string-elt)
 257                                                 autoload))
 258                                      (elt (cdr p)))
 259                                 (setcdr p nil)
 260                                 (princ "\n(" outbuf)
 261                                 (let ((print-escape-newlines t)
 262                                       (print-escape-nonascii t))
 263                                   (mapcar (function (lambda (elt)
 264                                                       (prin1 elt outbuf)
 265                                                       (princ " " outbuf)))
 266                                           autoload))
 267                                 (princ "\"\\\n" outbuf)
 268                                 (let ((begin (save-excursion
 269                                                (set-buffer outbuf)
 270                                                (point))))
 271                                   (princ (substring
 272                                           (prin1-to-string (car elt)) 1)
 273                                          outbuf)
 274                                   ;; Insert a backslash before each ( that
 275                                   ;; appears at the beginning of a line in
 276                                   ;; the doc string.
 277                                   (save-excursion
 278                                     (set-buffer outbuf)
 279                                     (save-excursion
 280                                       (while (search-backward "\n(" begin t)
 281                                         (forward-char 1)
 282                                         (insert "\\"))))
 283                                   (if (null (cdr elt))
 284                                       (princ ")" outbuf)
 285                                     (princ " " outbuf)
 286                                     (princ (substring
 287                                             (prin1-to-string (cdr elt))
 288                                             1)
 289                                            outbuf))
 290                                   (terpri outbuf)))
 291                             (let ((print-escape-newlines t)
 292                                   (print-escape-nonascii t))
 293                               (print autoload outbuf)))
 294                           (if (eq (car autoload-1) 'progn)
 295                               ;; Print the rest of the form
 296                               (let ((print-escape-newlines t)
 297                                     (print-escape-nonascii t))
 298                                 (mapcar (function (lambda (elt)
 299                                                     (print elt outbuf)))
 300                                         (cddr autoload-1)))))
 301                           ;; Copy the rest of the line to the output.
 302                       (princ (buffer-substring
 303                               (progn
 304                                 ;; Back up over whitespace, to preserve it.
 305                                 (skip-chars-backward " \f\t")
 306                                 (if (= (char-after (1+ (point))) ? )
 307                                     ;; Eat one space.
 308                                     (forward-char 1))
 309                                 (point))
 310                               (progn (forward-line 1) (point)))
 311                              outbuf)))
 312                    ((looking-at ";")
 313                     ;; Don't read the comment.
 314                     (forward-line 1))
 315                    (t
 316                     (forward-sexp 1)
 317                     (forward-line 1)))))))
 318         (or visited
 319             ;; We created this buffer, so we should kill it.
 320             (kill-buffer (current-buffer)))
 321         (set-buffer outbuf)
 322         (setq output-end (point-marker))))
 323     (if done-any
 324         (progn
 325           ;; Insert the section-header line
 326           ;; which lists the file name and which functions are in it, etc.
 327           (insert generate-autoload-section-header)
 328           (prin1 (list 'autoloads autoloads-done load-name
 329                        (autoload-trim-file-name file)
 330                        (nth 5 (file-attributes file)))
 331                  outbuf)
 332           (terpri outbuf)
 333           ;; Break that line at spaces, to avoid very long lines.
 334           ;; Make each sub-line into a comment.
 335           (with-current-buffer outbuf
 336             (save-excursion
 337               (forward-line -1)
 338               (while (not (eolp))
 339                 (move-to-column 64)
 340                 (skip-chars-forward "^ \n")
 341                 (or (eolp)
 342                     (insert "\n" generate-autoload-section-continuation)))))
 343           (insert ";;; Generated autoloads from "
 344                   (autoload-trim-file-name file) "\n")
 345           ;; Warn if we put a line in loaddefs.el
 346           ;; that is long enough to cause trouble.
 347           (while (< (point) output-end)
 348             (let ((beg (point)))
 349               (end-of-line)
 350               (if (> (- (point) beg) 900)
 351                   (progn
 352                     (message "A line is too long--over 900 characters")
 353                     (sleep-for 2)
 354                     (goto-char output-end))))
 355             (forward-line 1))
 356           (goto-char output-end)
 357           (insert generate-autoload-section-trailer)))
 358     (message "Generating autoloads for %s...done" file)))
 359 \f
 360 ;;;###autoload
 361 (defun update-file-autoloads (file)
 362   "Update the autoloads for FILE in `generated-autoload-file'
 363 \(which FILE might bind in its local variables)."
 364   (interactive "fUpdate autoloads for file: ")
 365   (let ((load-name (let ((name (file-name-nondirectory file)))
 366                      (if (string-match "\\.elc?$" name)
 367                          (substring name 0 (match-beginning 0))
 368                        name)))
 369         (found nil)
 370         (existing-buffer (get-file-buffer file)))
 371     (save-excursion
 372       ;; We want to get a value for generated-autoload-file from
 373       ;; the local variables section if it's there.
 374       (if existing-buffer
 375           (set-buffer existing-buffer))
 376       ;; We must read/write the file without any code conversion.
 377       (let ((coding-system-for-read 'no-conversion))
 378         (set-buffer (find-file-noselect
 379                      (expand-file-name generated-autoload-file
 380                                        (expand-file-name "lisp"
 381                                                          source-directory)))))
 382       (or (> (buffer-size) 0)
 383           (error "Autoloads file %s does not exist" buffer-file-name))
 384       (or (file-writable-p buffer-file-name)
 385           (error "Autoloads file %s is not writable" buffer-file-name))
 386       (save-excursion
 387         (save-restriction
 388           (widen)
 389           (goto-char (point-min))
 390           ;; Look for the section for LOAD-NAME.
 391           (while (and (not found)
 392                       (search-forward generate-autoload-section-header nil t))
 393             (let ((form (autoload-read-section-header)))
 394               (cond ((string= (nth 2 form) load-name)
 395                      ;; We found the section for this file.
 396                      ;; Check if it is up to date.
 397                      (let ((begin (match-beginning 0))
 398                            (last-time (nth 4 form))
 399                            (file-time (nth 5 (file-attributes file))))
 400                        (if (and (or (null existing-buffer)
 401                                     (not (buffer-modified-p existing-buffer)))
 402                                 (listp last-time) (= (length last-time) 2)
 403                                 (or (> (car last-time) (car file-time))
 404                                     (and (= (car last-time) (car file-time))
 405                                          (>= (nth 1 last-time)
 406                                              (nth 1 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                                t)
 457                            (or existing-buffer
 458                                (kill-buffer (current-buffer))))))))
 459               (generate-file-autoloads file))))
 460       (and (interactive-p)
 461            (buffer-modified-p)
 462            (save-buffer)))))
 463
 464 ;;;###autoload
 465 (defun update-autoloads-from-directories (&rest dirs)
 466   "\
 467 Update loaddefs.el with all the current autoloads from DIRS, and no old ones.
 468 This uses `update-file-autoloads' (which see) do its work."
 469   (interactive "DUpdate autoloads from directory: ")
 470   (let ((files (apply 'nconc
 471                       (mapcar (function (lambda (dir)
 472                                           (directory-files (expand-file-name dir)
 473                                                            t
 474                                                            "^[^=.].*\\.el$")))
 475                               dirs)))
 476         autoloads-file
 477         top-dir)
 478     (setq autoloads-file
 479           (expand-file-name generated-autoload-file
 480                             (expand-file-name "lisp"
 481                                               source-directory)))
 482     (setq top-dir (file-name-directory autoloads-file))
 483     (save-excursion
 484       (set-buffer (find-file-noselect autoloads-file))
 485       (save-excursion
 486         (goto-char (point-min))
 487         (while (search-forward generate-autoload-section-header nil t)
 488           (let* ((form (autoload-read-section-header))
 489                  (file (nth 3 form)))
 490             (cond ((not (stringp file)))
 491                   ((not (file-exists-p (expand-file-name file top-dir)))
 492                    ;; Remove the obsolete section.
 493                    (let ((begin (match-beginning 0)))
 494                      (search-forward generate-autoload-section-trailer)
 495                      (delete-region begin (point))))
 496                   (t
 497                    (update-file-autoloads file)))
 498             (setq files (delete file files)))))
 499       ;; Elements remaining in FILES have no existing autoload sections.
 500       (mapcar 'update-file-autoloads files)
 501       (save-buffer))))
 502
 503 ;;;###autoload
 504 (defun batch-update-autoloads ()
 505   "Update loaddefs.el autoloads in batch mode.
 506 Calls `update-autoloads-from-directories' on the command line arguments."
 507   (apply 'update-autoloads-from-directories command-line-args-left)
 508   (setq command-line-args-left nil))
 509
 510 (provide 'autoload)
 511
 512 ;;; autoload.el ends here