]> code.delx.au - gnu-emacs/blobdiff - lisp/emacs-lisp/autoload.el
Merge changes from emacs-23 branch.
[gnu-emacs] / lisp / emacs-lisp / autoload.el
index efbe7a569272540530a4abe058425229003f0fbb..30c384aff91791c4cd99fcd628b6e5eff3cc07b3 100644 (file)
@@ -1,17 +1,19 @@
 ;; autoload.el --- maintain autoloads in loaddefs.el
 
 ;; Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010
+;;   Free Software Foundation, Inc.
 
 ;; Author: Roland McGrath <roland@gnu.org>
 ;; Keywords: maint
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -19,9 +21,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -44,6 +44,12 @@ trailer starting with a FormFeed character.")
 ;;;###autoload
 (put 'generated-autoload-file 'safe-local-variable 'stringp)
 
+(defvar generated-autoload-load-name nil
+  "Load name for `autoload' statements generated from autoload cookies.
+If nil, this defaults to the file name, sans extension.")
+;;;###autoload
+(put 'generated-autoload-load-name 'safe-local-variable 'stringp)
+
 ;; This feels like it should be a defconst, but MH-E sets it to
 ;; ";;;###mh-autoload" for the autoloads that are to go into mh-loaddefs.el.
 (defvar generate-autoload-cookie ";;;###autoload"
@@ -60,6 +66,9 @@ If this string appears alone on a line, the following form will be
 read and an autoload made for it.  If there is further text on the line,
 that text will be copied verbatim to `generated-autoload-file'.")
 
+(defvar autoload-excludes nil
+  "If non-nil, list of absolute file names not to scan for autoloads.")
+
 (defconst generate-autoload-section-header "\f\n;;;### "
   "String that marks the form at the start of a new file's autoload section.")
 
@@ -97,32 +106,60 @@ or macro definition or a defcustom)."
                   easy-mmode-define-global-mode define-global-minor-mode
                   define-globalized-minor-mode
                   easy-mmode-define-minor-mode define-minor-mode
-                  defun* defmacro*))
+                  defun* defmacro* define-overloadable-function))
       (let* ((macrop (memq car '(defmacro defmacro*)))
             (name (nth 1 form))
             (args (case car
-                   ((defun defmacro defun* defmacro*) (nth 2 form))
-                   ((define-skeleton) '(&optional str arg))
-                   ((define-generic-mode define-derived-mode
-                       define-compilation-mode) nil)
-                   (t)))
+                     ((defun defmacro defun* defmacro*
+                        define-overloadable-function) (nth 2 form))
+                     ((define-skeleton) '(&optional str arg))
+                     ((define-generic-mode define-derived-mode
+                        define-compilation-mode) nil)
+                     (t)))
             (body (nthcdr (get car 'doc-string-elt) form))
             (doc (if (stringp (car body)) (pop body))))
        (when (listp args)
          ;; Add the usage form at the end where describe-function-1
          ;; can recover it.
          (setq doc (help-add-fundoc-usage doc args)))
-       ;; `define-generic-mode' quotes the name, so take care of that
-       (list 'autoload (if (listp name) name (list 'quote name)) file doc
-             (or (and (memq car '(define-skeleton define-derived-mode
-                                   define-generic-mode
-                                   easy-mmode-define-global-mode
-                                   define-global-minor-mode
-                                   define-globalized-minor-mode
-                                   easy-mmode-define-minor-mode
-                                   define-minor-mode)) t)
-                 (eq (car-safe (car body)) 'interactive))
-             (if macrop (list 'quote 'macro) nil))))
+        (let ((exp
+               ;; `define-generic-mode' quotes the name, so take care of that
+               (list 'autoload (if (listp name) name (list 'quote name))
+                     file doc
+                     (or (and (memq car '(define-skeleton define-derived-mode
+                                           define-generic-mode
+                                           easy-mmode-define-global-mode
+                                           define-global-minor-mode
+                                           define-globalized-minor-mode
+                                           easy-mmode-define-minor-mode
+                                           define-minor-mode)) t)
+                         (eq (car-safe (car body)) 'interactive))
+                     (if macrop (list 'quote 'macro) nil))))
+          (when macrop
+            ;; Special case to autoload some of the macro's declarations.
+            (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form))
+                  (exps '()))
+              (when (eq (car decls) 'declare)
+                ;; FIXME: We'd like to reuse macro-declaration-function,
+                ;; but we can't since it doesn't return anything.
+                (dolist (decl decls)
+                  (case (car-safe decl)
+                    (indent
+                     (push `(put ',name 'lisp-indent-function ',(cadr decl))
+                           exps))
+                    (doc-string
+                     (push `(put ',name 'doc-string-elt ',(cadr decl)) exps))))
+                (when exps
+                  (setq exp `(progn ,exp ,@exps))))))
+          exp)))
+
+     ;; For defclass forms, use `eieio-defclass-autoload'.
+     ((eq car 'defclass)
+      (let ((name (nth 1 form))
+           (superclasses (nth 2 form))
+           (doc (nth 4 form)))
+       (list 'eieio-defclass-autoload (list 'quote name)
+             (list 'quote superclasses) file doc)))
 
      ;; Convert defcustom to less space-consuming data.
      ((eq car 'defcustom)
@@ -237,22 +274,40 @@ put the output in."
              (print-escape-nonascii t))
          (print form outbuf)))))))
 
+(defun autoload-rubric (file &optional type feature)
+  "Return a string giving the appropriate autoload rubric for FILE.
+TYPE (default \"autoloads\") is a string stating the type of
+information contained in FILE.  If FEATURE is non-nil, FILE
+will provide a feature.  FEATURE may be a string naming the
+feature, otherwise it will be based on FILE's name.
+
+At present, a feature is in fact always provided, but this should
+not be relied upon."
+  (let ((basename (file-name-nondirectory file)))
+    (concat ";;; " basename
+           " --- automatically extracted " (or type "autoloads") "\n"
+           ";;\n"
+           ";;; Code:\n\n"
+           "\f\n"
+           ;; This is used outside of autoload.el, eg cus-dep, finder.
+           "(provide '"
+           (if (stringp feature)
+               feature
+             (file-name-sans-extension basename))
+           ")\n"
+           ";; Local Variables:\n"
+           ";; version-control: never\n"
+           ";; no-byte-compile: t\n"
+           ";; no-update-autoloads: t\n"
+           ";; coding: utf-8\n"
+           ";; End:\n"
+           ";;; " basename
+           " ends here\n")))
+
 (defun autoload-ensure-default-file (file)
   "Make sure that the autoload file FILE exists and if not create it."
   (unless (file-exists-p file)
-    (write-region
-     (concat ";;; " (file-name-nondirectory file)
-            " --- automatically extracted autoloads\n"
-            ";;\n"
-            ";;; Code:\n\n"
-            "\f\n;; Local Variables:\n"
-            ";; version-control: never\n"
-            ";; no-byte-compile: t\n"
-            ";; no-update-autoloads: t\n"
-            ";; End:\n"
-            ";;; " (file-name-nondirectory file)
-            " ends here\n")
-     nil file))
+    (write-region (autoload-rubric file) nil file))
   file)
 
 (defun autoload-insert-section-header (outbuf autoloads load-name file time)
@@ -293,7 +348,29 @@ which lists the file name and which functions are in it, etc."
   "File local variable to prevent scanning this file for autoload cookies.")
 
 (defun autoload-file-load-name (file)
-  (let ((name (file-name-nondirectory file)))
+  "Compute the name that will be used to load FILE."
+  ;; OUTFILE should be the name of the global loaddefs.el file, which
+  ;; is expected to be at the root directory of the files we're
+  ;; scanning for autoloads and will be in the `load-path'.
+  (let* ((outfile (default-value 'generated-autoload-file))
+         (name (file-relative-name file (file-name-directory outfile)))
+         (names '())
+         (dir (file-name-directory outfile)))
+    ;; If `name' has directory components, only keep the
+    ;; last few that are really needed.
+    (while name
+      (setq name (directory-file-name name))
+      (push (file-name-nondirectory name) names)
+      (setq name (file-name-directory name)))
+    (while (not name)
+      (cond
+       ((null (cdr names)) (setq name (car names)))
+       ((file-exists-p (expand-file-name "subdirs.el" dir))
+        ;; FIXME: here we only check the existence of subdirs.el,
+        ;; without checking its content.  This makes it generate wrong load
+        ;; names for cases like lisp/term which is not added to load-path.
+        (setq dir (expand-file-name (pop names) dir)))
+       (t (setq name (mapconcat 'identity names "/")))))
     (if (string-match "\\.elc?\\(\\.\\|\\'\\)" name)
         (substring name 0 (match-beginning 0))
       name)))
@@ -308,6 +385,8 @@ Return non-nil in the case where no autoloads were added at point."
   (interactive "fGenerate autoloads for file: ")
   (autoload-generate-file-autoloads file (current-buffer)))
 
+(defvar print-readably)
+
 ;; When called from `generate-file-autoloads' we should ignore
 ;; `generated-autoload-file' altogether.  When called from
 ;; `update-file-autoloads' we don't know `outbuf'.  And when called from
@@ -326,27 +405,33 @@ If provided, OUTFILE is expected to be the file name of OUTBUF.
 If OUTFILE is non-nil and FILE specifies a `generated-autoload-file'
 different from OUTFILE, then OUTBUF is ignored.
 
-Return non-nil iff FILE adds no autoloads to OUTFILE
+Return non-nil if and only if FILE adds no autoloads to OUTFILE
 \(or OUTBUF if OUTFILE is nil)."
   (catch 'done
     (let ((autoloads-done '())
-          (load-name (autoload-file-load-name file))
+         load-name
           (print-length nil)
+         (print-level nil)
           (print-readably t)           ; This does something in Lucid Emacs.
           (float-output-format nil)
           (visited (get-file-buffer file))
           (otherbuf nil)
           (absfile (expand-file-name file))
-          relfile
           ;; nil until we found a cookie.
-          output-start)
-
+          output-start ostart)
       (with-current-buffer (or visited
                                ;; It is faster to avoid visiting the file.
                                (autoload-find-file file))
         ;; Obey the no-update-autoloads file local variable.
         (unless no-update-autoloads
           (message "Generating autoloads for %s..." file)
+         (setq load-name
+               (if (stringp generated-autoload-load-name)
+                   generated-autoload-load-name
+                 (autoload-file-load-name absfile)))
+          (when (and outfile
+                     (not (equal outfile (autoload-generated-file))))
+            (setq otherbuf t))
           (save-excursion
             (save-restriction
               (widen)
@@ -357,26 +442,22 @@ Return non-nil iff FILE adds no autoloads to OUTFILE
                  ((looking-at (regexp-quote generate-autoload-cookie))
                   ;; If not done yet, figure out where to insert this text.
                   (unless output-start
-                    (when (and outfile
-                               (not (equal outfile (autoload-generated-file))))
-                      ;; A file-local setting of autoload-generated-file says
-                      ;; we should ignore OUTBUF.
-                      (setq outbuf nil)
-                      (setq otherbuf t))
-                    (unless outbuf
-                      (setq outbuf (autoload-find-destination absfile))
-                      (unless outbuf
-                        ;; The file has autoload cookies, but they're
-                        ;; already up-to-date.  If OUTFILE is nil, the
-                        ;; entries are in the expected OUTBUF, otherwise
-                        ;; they're elsewhere.
-                        (throw 'done outfile)))
-                    (with-current-buffer outbuf
-                      (setq relfile (file-relative-name absfile))
-                      (setq output-start (point)))
-                    ;; (message "file=%S, relfile=%S, dest=%S"
-                    ;;          file relfile (autoload-generated-file))
-                    )
+                    (let ((outbuf
+                           (or (if otherbuf
+                                   ;; A file-local setting of
+                                   ;; autoload-generated-file says we
+                                   ;; should ignore OUTBUF.
+                                   nil
+                                 outbuf)
+                               (autoload-find-destination absfile load-name)
+                               ;; The file has autoload cookies, but they're
+                               ;; already up-to-date. If OUTFILE is nil, the
+                               ;; entries are in the expected OUTBUF,
+                               ;; otherwise they're elsewhere.
+                               (throw 'done otherbuf))))
+                      (with-current-buffer outbuf
+                        (setq output-start (point-marker)
+                              ostart (point)))))
                   (search-forward generate-autoload-cookie)
                   (skip-chars-forward " \t")
                   (if (eolp)
@@ -388,7 +469,8 @@ Return non-nil iff FILE adds no autoloads to OUTFILE
                             (if autoload
                                 (push (nth 1 form) autoloads-done)
                               (setq autoload form))
-                            (let ((autoload-print-form-outbuf outbuf))
+                            (let ((autoload-print-form-outbuf
+                                   (marker-buffer output-start)))
                               (autoload-print-form autoload)))
                         (error
                          (message "Error in %s: %S" file err)))
@@ -403,7 +485,7 @@ Return non-nil iff FILE adds no autoloads to OUTFILE
                                   (forward-char 1))
                               (point))
                             (progn (forward-line 1) (point)))
-                           outbuf)))
+                           (marker-buffer output-start))))
                  ((looking-at ";")
                   ;; Don't read the comment.
                   (forward-line 1))
@@ -415,40 +497,44 @@ Return non-nil iff FILE adds no autoloads to OUTFILE
             (let ((secondary-autoloads-file-buf
                    (if (local-variable-p 'generated-autoload-file)
                        (current-buffer))))
-              (with-current-buffer outbuf
+              (with-current-buffer (marker-buffer output-start)
                 (save-excursion
                   ;; Insert the section-header line which lists the file name
                   ;; and which functions are in it, etc.
+                  (assert (= ostart output-start))
                   (goto-char output-start)
-                  (autoload-insert-section-header
-                   outbuf autoloads-done load-name relfile
-                   (if secondary-autoloads-file-buf
-                       ;; MD5 checksums are much better because they do not
-                       ;; change unless the file changes (so they'll be
-                       ;; equal on two different systems and will change
-                       ;; less often than time-stamps, thus leading to fewer
-                       ;; unneeded changes causing spurious conflicts), but
-                       ;; using time-stamps is a very useful optimization,
-                       ;; so we use time-stamps for the main autoloads file
-                       ;; (loaddefs.el) where we have special ways to
-                       ;; circumvent the "random change problem", and MD5
-                       ;; checksum in secondary autoload files where we do
-                       ;; not need the time-stamp optimization because it is
-                       ;; already provided by the primary autoloads file.
-                       (md5 secondary-autoloads-file-buf
-                            ;; We'd really want to just use
-                            ;; `emacs-internal' instead.
-                            nil nil 'emacs-mule-unix)
-                     (nth 5 (file-attributes relfile))))
-                  (insert ";;; Generated autoloads from " relfile "\n"))
+                  (let ((relfile (file-relative-name absfile)))
+                    (autoload-insert-section-header
+                     (marker-buffer output-start)
+                     autoloads-done load-name relfile
+                     (if secondary-autoloads-file-buf
+                         ;; MD5 checksums are much better because they do not
+                         ;; change unless the file changes (so they'll be
+                         ;; equal on two different systems and will change
+                         ;; less often than time-stamps, thus leading to fewer
+                         ;; unneeded changes causing spurious conflicts), but
+                         ;; using time-stamps is a very useful optimization,
+                         ;; so we use time-stamps for the main autoloads file
+                         ;; (loaddefs.el) where we have special ways to
+                         ;; circumvent the "random change problem", and MD5
+                         ;; checksum in secondary autoload files where we do
+                         ;; not need the time-stamp optimization because it is
+                         ;; already provided by the primary autoloads file.
+                         (md5 secondary-autoloads-file-buf
+                              ;; We'd really want to just use
+                              ;; `emacs-internal' instead.
+                              nil nil 'emacs-mule-unix)
+                       (nth 5 (file-attributes relfile))))
+                    (insert ";;; Generated autoloads from " relfile "\n")))
                 (insert generate-autoload-section-trailer))))
           (message "Generating autoloads for %s...done" file))
         (or visited
             ;; We created this buffer, so we should kill it.
             (kill-buffer (current-buffer))))
-      ;; If the entries were added to some other buffer, then the file
-      ;; doesn't add entries to OUTFILE.
-      (or (not output-start) otherbuf))))
+      (or (not output-start)
+          ;; If the entries were added to some other buffer, then the file
+          ;; doesn't add entries to OUTFILE.
+          otherbuf))))
 \f
 (defun autoload-save-buffers ()
   (while autoload-modified-buffers
@@ -468,32 +554,31 @@ Return FILE if there was no autoload cookie in it, else nil."
          (no-autoloads (autoload-generate-file-autoloads file)))
     (if autoload-modified-buffers
         (if save-after (autoload-save-buffers))
-      (if (interactive-p)
+      (if (called-interactively-p 'interactive)
           (message "Autoload section for %s is up to date." file)))
     (if no-autoloads file)))
 
-(defun autoload-find-destination (file)
+(defun autoload-find-destination (file load-name)
   "Find the destination point of the current buffer's autoloads.
 FILE is the file name of the current buffer.
 Returns a buffer whose point is placed at the requested location.
 Returns nil if the file's autoloads are uptodate, otherwise
 removes any prior now out-of-date autoload entries."
   (catch 'up-to-date
-    (let* ((load-name (autoload-file-load-name file))
-           (buf (current-buffer))
+    (let* ((buf (current-buffer))
            (existing-buffer (if buffer-file-name buf))
            (found nil))
       (with-current-buffer
-          ;; We must read/write the file without any code conversion,
-          ;; but still decode EOLs.
-          (let ((coding-system-for-read 'raw-text))
-            (find-file-noselect
-             (autoload-ensure-default-file (autoload-generated-file))))
+          ;; We used to use `raw-text' to read this file, but this causes
+          ;; problems when the file contains non-ASCII characters.
+          (find-file-noselect
+           (autoload-ensure-default-file (autoload-generated-file)))
         ;; This is to make generated-autoload-file have Unix EOLs, so
         ;; that it is portable to all platforms.
-        (setq buffer-file-coding-system 'raw-text-unix)
+        (unless (zerop (coding-system-eol-type buffer-file-coding-system))
+          (set-buffer-file-coding-system 'unix))
         (or (> (buffer-size) 0)
-            (error "Autoloads file %s does not exist" buffer-file-name))
+            (error "Autoloads file %s lacks boilerplate" buffer-file-name))
         (or (file-writable-p buffer-file-name)
             (error "Autoloads file %s is not writable" buffer-file-name))
         (widen)
@@ -601,7 +686,9 @@ directory or directories specified."
                  ((not (stringp file)))
                  ((or (not (file-exists-p file))
                        ;; Remove duplicates as well, just in case.
-                       (member file done))
+                       (member file done)
+                       ;; If the file is actually excluded.
+                       (member (expand-file-name file) autoload-excludes))
                    ;; Remove the obsolete section.
                   (autoload-remove-section (match-beginning 0)))
                  ((not (time-less-p (nth 4 form)
@@ -611,14 +698,20 @@ directory or directories specified."
                  (t
                    (autoload-remove-section (match-beginning 0))
                    (if (autoload-generate-file-autoloads
+                        ;; Passing `current-buffer' makes it insert at point.
                         file (current-buffer) buffer-file-name)
                        (push file no-autoloads))))
             (push file done)
            (setq files (delete file files)))))
       ;; Elements remaining in FILES have no existing autoload sections yet.
       (dolist (file files)
-        (if (autoload-generate-file-autoloads file nil buffer-file-name)
-            (push file no-autoloads)))
+        (cond
+         ((member (expand-file-name file) autoload-excludes) nil)
+         ;; Passing nil as second argument forces
+         ;; autoload-generate-file-autoloads to look for the right
+         ;; spot where to insert each autoloads section.
+         ((autoload-generate-file-autoloads file nil buffer-file-name)
+          (push file no-autoloads))))
 
       (when no-autoloads
        ;; Sort them for better readability.
@@ -638,10 +731,58 @@ directory or directories specified."
 (define-obsolete-function-alias 'update-autoloads-from-directories
     'update-directory-autoloads "22.1")
 
+(defvar autoload-make-program (or (getenv "MAKE") "make")
+  "Name of the make program in use during the Emacs build process.")
+
 ;;;###autoload
 (defun batch-update-autoloads ()
   "Update loaddefs.el autoloads in batch mode.
 Calls `update-directory-autoloads' on the command line arguments."
+  ;; For use during the Emacs build process only.
+  (unless autoload-excludes
+    (let* ((ldir (file-name-directory generated-autoload-file))
+          (default-directory
+            (file-name-as-directory
+             (expand-file-name (if (eq system-type 'windows-nt)
+                                   "../lib-src"
+                                 "../src") ldir)))
+          (mfile "Makefile")
+          (tmpfile "echolisp.tmp")
+          lim)
+      ;; Windows uses the 'echolisp' approach because:
+      ;; i) It does not have $lisp as a single simple definition, so
+      ;; it would be harder to parse the Makefile.
+      ;; ii) It can, since it already has $lisp broken up into pieces
+      ;; that the command-line can handle.
+      ;; Non-Windows builds do not use the 'echolisp' approach because
+      ;; no-one knows (?) the maximum safe command-line length on all
+      ;; supported systems.  $lisp is much longer there since it uses
+      ;; absolute paths, and it would seem a shame to split it just for this.
+      (when (file-readable-p mfile)
+       (if (eq system-type 'windows-nt)
+           (when (ignore-errors
+                  (if (file-exists-p tmpfile) (delete-file tmpfile))
+                  ;; FIXME call-process is better, if it works.
+                  (shell-command (format "%s echolisp > %s"
+                                         autoload-make-program tmpfile))
+                  (file-readable-p tmpfile))
+             (with-temp-buffer
+               (insert-file-contents tmpfile)
+               ;; FIXME could be a single while loop.
+               (while (not (eobp))
+                 (setq lim (line-end-position))
+                 (while (re-search-forward "\\([^ ]+\\.el\\)c?\\>" lim t)
+                   (push (expand-file-name (match-string 1))
+                         autoload-excludes))
+                 (forward-line 1))))
+         (with-temp-buffer
+           (insert-file-contents mfile)
+           (when (re-search-forward "^shortlisp= " nil t)
+             (setq lim (line-end-position))
+             (while (re-search-forward "\\.\\./lisp/\\([^ ]+\\.el\\)c?\\>"
+                                       lim t)
+               (push (expand-file-name (match-string 1) ldir)
+                     autoload-excludes))))))))
   (let ((args command-line-args-left))
     (setq command-line-args-left nil)
     (apply 'update-directory-autoloads args)))