;; 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
;; 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:
A `.el' file can set this in its local variables section to make its
autoloads go somewhere else. The autoload file is assumed to contain a
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)
-(defconst generate-autoload-cookie ";;;###autoload"
+;; 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"
"Magic comment indicating the following form should be autoloaded.
Used by \\[update-file-autoloads]. This string should be
meaningless to Lisp (e.g., a comment).
This string is used:
-;;;###autoload
+\;;;###autoload
\(defun function-to-be-autoloaded () ...)
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.")
(defconst generate-autoload-section-continuation ";;;;;; "
"String to add on each continuation of the section header form.")
+(defvar autoload-modified-buffers) ;Dynamically scoped var.
+
(defun make-autoload (form file)
"Turn FORM into an autoload or defvar for source file FILE.
Returns nil if FORM is not a special autoload form (i.e. a function definition
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)
;; the doc-string in FORM.
;; Those properties are now set in lisp-mode.el.
+(defun autoload-generated-file ()
+ (expand-file-name generated-autoload-file
+ ;; File-local settings of generated-autoload-file should
+ ;; be interpreted relative to the file's location,
+ ;; of course.
+ (if (not (local-variable-p 'generated-autoload-file))
+ (expand-file-name "lisp" source-directory))))
-(defun autoload-trim-file-name (file)
- ;; Returns a relative file path for FILE
- ;; starting from the directory that loaddefs.el is in.
- ;; That is normally a directory in load-path,
- ;; which means Emacs will be able to find FILE when it looks.
- ;; Any extra directory names here would prevent finding the file.
- (setq file (expand-file-name file))
- (file-relative-name file
- (file-name-directory generated-autoload-file)))
(defun autoload-read-section-header ()
"Read a section header form.
(setcdr p nil)
(princ "\n(" outbuf)
(let ((print-escape-newlines t)
+ (print-quoted t)
(print-escape-nonascii t))
(dolist (elt form)
(prin1 elt outbuf)
outbuf))
(terpri outbuf)))
(let ((print-escape-newlines t)
+ (print-quoted t)
(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)
"Insert the section-header line,
which lists the file name and which functions are in it, etc."
(insert generate-autoload-section-header)
- (prin1 (list 'autoloads autoloads load-name
- (if (stringp file) (autoload-trim-file-name file) file)
- time)
+ (prin1 (list 'autoloads autoloads load-name file time)
outbuf)
(terpri outbuf)
;; Break that line at spaces, to avoid very long lines.
(defun autoload-find-file (file)
"Fetch file and put it in a temp buffer. Return the buffer."
;; It is faster to avoid visiting the file.
+ (setq file (expand-file-name file))
(with-current-buffer (get-buffer-create " *autoload-file*")
(kill-all-local-variables)
(erase-buffer)
(setq buffer-undo-list t
buffer-read-only nil)
(emacs-lisp-mode)
+ (setq default-directory (file-name-directory file))
(insert-file-contents file nil)
(let ((enable-local-variables :safe))
(hack-local-variables))
(defvar no-update-autoloads nil
"File local variable to prevent scanning this file for autoload cookies.")
+(defun autoload-file-load-name (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)))
+
(defun generate-file-autoloads (file)
"Insert at point a loaddefs autoload section for FILE.
Autoloads are generated for defuns and defmacros in FILE
are used.
Return non-nil in the case where no autoloads were added at point."
(interactive "fGenerate autoloads for file: ")
- (let ((outbuf (current-buffer))
- (autoloads-done '())
- (load-name (let ((name (file-name-nondirectory file)))
- (if (string-match "\\.elc?\\(\\.\\|$\\)" name)
- (substring name 0 (match-beginning 0))
- name)))
- (print-length nil)
- (print-level nil)
- (print-readably t) ; This does something in Lucid Emacs.
- (float-output-format nil)
- (done-any nil)
- (visited (get-file-buffer file))
- output-start)
-
- ;; If the autoload section we create here uses an absolute
- ;; file name for FILE in its header, and then Emacs is installed
- ;; under a different path on another system,
- ;; `update-autoloads-here' won't be able to find the files to be
- ;; autoloaded. So, if FILE is in the same directory or a
- ;; subdirectory of the current buffer's directory, we'll make it
- ;; relative to the current buffer's directory.
- (setq file (expand-file-name file))
- (let* ((source-truename (file-truename file))
- (dir-truename (file-name-as-directory
- (file-truename default-directory)))
- (len (length dir-truename)))
- (if (and (< len (length source-truename))
- (string= dir-truename (substring source-truename 0 len)))
- (setq file (substring source-truename len))))
-
- (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 output-start (with-current-buffer outbuf (point)))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n\f")
- (cond
- ((looking-at (regexp-quote generate-autoload-cookie))
- (search-forward generate-autoload-cookie)
- (skip-chars-forward " \t")
- (setq done-any t)
- (if (eolp)
- ;; Read the next form and make an autoload.
- (let* ((form (prog1 (read (current-buffer))
- (or (bolp) (forward-line 1))))
- (autoload (make-autoload form load-name)))
- (if autoload
- (push (nth 1 form) autoloads-done)
- (setq autoload form))
- (let ((autoload-print-form-outbuf outbuf))
- (autoload-print-form autoload)))
-
- ;; Copy the rest of the line to the output.
- (princ (buffer-substring
- (progn
- ;; Back up over whitespace, to preserve it.
- (skip-chars-backward " \f\t")
- (if (= (char-after (1+ (point))) ? )
- ;; Eat one space.
- (forward-char 1))
- (point))
- (progn (forward-line 1) (point)))
- outbuf)))
- ((looking-at ";")
- ;; Don't read the comment.
- (forward-line 1))
- (t
- (forward-sexp 1)
- (forward-line 1))))))
-
- (when done-any
- (with-current-buffer outbuf
- (save-excursion
- ;; Insert the section-header line which lists the file name
- ;; and which functions are in it, etc.
- (goto-char output-start)
- (autoload-insert-section-header
- outbuf autoloads-done load-name file
- (nth 5 (file-attributes file)))
- (insert ";;; Generated autoloads from "
- (autoload-trim-file-name file) "\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))))
- (not done-any)))
+ (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
+;; `update-directory-autoloads' it's in between: we know the default
+;; `outbuf' but we should obey any file-local setting of
+;; `generated-autoload-file'.
+(defun autoload-generate-file-autoloads (file &optional outbuf outfile)
+ "Insert an autoload section for FILE in the appropriate buffer.
+Autoloads are generated for defuns and defmacros in FILE
+marked by `generate-autoload-cookie' (which see).
+If FILE is being visited in a buffer, the contents of the buffer are used.
+OUTBUF is the buffer in which the autoload statements should be inserted.
+If OUTBUF is nil, it will be determined by `autoload-generated-file'.
+
+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 if and only if FILE adds no autoloads to OUTFILE
+\(or OUTBUF if OUTFILE is nil)."
+ (catch 'done
+ (let ((autoloads-done '())
+ 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))
+ ;; nil until we found a cookie.
+ 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)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (skip-chars-forward " \t\n\f")
+ (cond
+ ((looking-at (regexp-quote generate-autoload-cookie))
+ ;; If not done yet, figure out where to insert this text.
+ (unless output-start
+ (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)
+ (condition-case err
+ ;; Read the next form and make an autoload.
+ (let* ((form (prog1 (read (current-buffer))
+ (or (bolp) (forward-line 1))))
+ (autoload (make-autoload form load-name)))
+ (if autoload
+ (push (nth 1 form) autoloads-done)
+ (setq autoload form))
+ (let ((autoload-print-form-outbuf
+ (marker-buffer output-start)))
+ (autoload-print-form autoload)))
+ (error
+ (message "Error in %s: %S" file err)))
+
+ ;; Copy the rest of the line to the output.
+ (princ (buffer-substring
+ (progn
+ ;; Back up over whitespace, to preserve it.
+ (skip-chars-backward " \f\t")
+ (if (= (char-after (1+ (point))) ? )
+ ;; Eat one space.
+ (forward-char 1))
+ (point))
+ (progn (forward-line 1) (point)))
+ (marker-buffer output-start))))
+ ((looking-at ";")
+ ;; Don't read the comment.
+ (forward-line 1))
+ (t
+ (forward-sexp 1)
+ (forward-line 1))))))
+
+ (when output-start
+ (let ((secondary-autoloads-file-buf
+ (if (local-variable-p 'generated-autoload-file)
+ (current-buffer))))
+ (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)
+ (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))))
+ (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
+ (with-current-buffer (pop autoload-modified-buffers)
+ (save-buffer))))
+
;;;###autoload
(defun update-file-autoloads (file &optional save-after)
"Update the autoloads for FILE in `generated-autoload-file'
Return FILE if there was no autoload cookie in it, else nil."
(interactive "fUpdate autoloads for file: \np")
- (let ((load-name (let ((name (file-name-nondirectory file)))
- (if (string-match "\\.elc?\\(\\.\\|$\\)" name)
- (substring name 0 (match-beginning 0))
- name)))
- (found nil)
- (existing-buffer (get-file-buffer file))
- (no-autoloads nil))
- (save-excursion
- ;; We want to get a value for generated-autoload-file from
- ;; the local variables section if it's there.
- (if existing-buffer
- (set-buffer existing-buffer))
- ;; We must read/write the file without any code conversion,
- ;; but still decode EOLs.
- (let ((coding-system-for-read 'raw-text))
- (set-buffer (find-file-noselect
- (autoload-ensure-default-file
- (expand-file-name generated-autoload-file
- (expand-file-name "lisp"
- source-directory)))))
- ;; 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))
- (or (> (buffer-size) 0)
- (error "Autoloads file %s does not exist" buffer-file-name))
- (or (file-writable-p buffer-file-name)
- (error "Autoloads file %s is not writable" buffer-file-name))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- ;; Look for the section for LOAD-NAME.
- (while (and (not found)
- (search-forward generate-autoload-section-header nil t))
- (let ((form (autoload-read-section-header)))
- (cond ((string= (nth 2 form) load-name)
- ;; We found the section for this file.
- ;; Check if it is up to date.
- (let ((begin (match-beginning 0))
- (last-time (nth 4 form))
- (file-time (nth 5 (file-attributes file))))
- (if (and (or (null existing-buffer)
- (not (buffer-modified-p existing-buffer)))
- (listp last-time) (= (length last-time) 2)
- (not (time-less-p last-time file-time)))
- (progn
- (if (interactive-p)
- (message "\
-Autoload section for %s is up to date."
- file))
- (setq found 'up-to-date))
- (search-forward generate-autoload-section-trailer)
- (delete-region begin (point))
- (setq found t))))
- ((string< load-name (nth 2 form))
- ;; We've come to a section alphabetically later than
- ;; LOAD-NAME. We assume the file is in order and so
- ;; there must be no section for LOAD-NAME. We will
- ;; insert one before the section here.
- (goto-char (match-beginning 0))
- (setq found 'new)))))
- (or found
- (progn
- (setq found 'new)
- ;; No later sections in the file. Put before the last page.
- (goto-char (point-max))
- (search-backward "\f" nil t)))
- (or (eq found 'up-to-date)
- (setq no-autoloads (generate-file-autoloads file)))))
- (and save-after
- (buffer-modified-p)
- (save-buffer))
-
- (if no-autoloads file))))
+ (let* ((autoload-modified-buffers nil)
+ (no-autoloads (autoload-generate-file-autoloads file)))
+ (if autoload-modified-buffers
+ (if save-after (autoload-save-buffers))
+ (if (called-interactively-p 'interactive)
+ (message "Autoload section for %s is up to date." file)))
+ (if no-autoloads 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* ((buf (current-buffer))
+ (existing-buffer (if buffer-file-name buf))
+ (found nil))
+ (with-current-buffer
+ ;; 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.
+ (unless (zerop (coding-system-eol-type buffer-file-coding-system))
+ (set-buffer-file-coding-system 'unix))
+ (or (> (buffer-size) 0)
+ (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)
+ (goto-char (point-min))
+ ;; Look for the section for LOAD-NAME.
+ (while (and (not found)
+ (search-forward generate-autoload-section-header nil t))
+ (let ((form (autoload-read-section-header)))
+ (cond ((string= (nth 2 form) load-name)
+ ;; We found the section for this file.
+ ;; Check if it is up to date.
+ (let ((begin (match-beginning 0))
+ (last-time (nth 4 form))
+ (file-time (nth 5 (file-attributes file))))
+ (if (and (or (null existing-buffer)
+ (not (buffer-modified-p existing-buffer)))
+ (or
+ ;; last-time is the time-stamp (specifying
+ ;; the last time we looked at the file) and
+ ;; the file hasn't been changed since.
+ (and (listp last-time) (= (length last-time) 2)
+ (not (time-less-p last-time file-time)))
+ ;; last-time is an MD5 checksum instead.
+ (and (stringp last-time)
+ (equal last-time
+ (md5 buf nil nil 'emacs-mule)))))
+ (throw 'up-to-date nil)
+ (autoload-remove-section begin)
+ (setq found t))))
+ ((string< load-name (nth 2 form))
+ ;; We've come to a section alphabetically later than
+ ;; LOAD-NAME. We assume the file is in order and so
+ ;; there must be no section for LOAD-NAME. We will
+ ;; insert one before the section here.
+ (goto-char (match-beginning 0))
+ (setq found t)))))
+ (or found
+ (progn
+ ;; No later sections in the file. Put before the last page.
+ (goto-char (point-max))
+ (search-backward "\f" nil t)))
+ (unless (memq (current-buffer) autoload-modified-buffers)
+ (push (current-buffer) autoload-modified-buffers))
+ (current-buffer)))))
(defun autoload-remove-section (begin)
(goto-char begin)
(directory-files (expand-file-name dir)
t files-re))
dirs)))
+ (done ())
(this-time (current-time))
- (no-autoloads nil) ;files with no autoload cookies.
- (autoloads-file
- (expand-file-name generated-autoload-file
- (expand-file-name "lisp" source-directory)))
- (top-dir (file-name-directory autoloads-file)))
+ ;; Files with no autoload cookies or whose autoloads go to other
+ ;; files because of file-local autoload-generated-file settings.
+ (no-autoloads nil)
+ (autoload-modified-buffers nil))
(with-current-buffer
- (find-file-noselect (autoload-ensure-default-file autoloads-file))
+ (find-file-noselect
+ (autoload-ensure-default-file (autoload-generated-file)))
(save-excursion
;; Canonicalize file names and remove the autoload file itself.
- (setq files (delete (autoload-trim-file-name buffer-file-name)
- (mapcar 'autoload-trim-file-name files)))
+ (setq files (delete (file-relative-name buffer-file-name)
+ (mapcar 'file-relative-name files)))
(goto-char (point-min))
(while (search-forward generate-autoload-section-header nil t)
(push file no-autoloads)
(setq files (delete file files)))))))
((not (stringp file)))
- ((not (file-exists-p (expand-file-name file top-dir)))
- ;; Remove the obsolete section.
+ ((or (not (file-exists-p file))
+ ;; Remove duplicates as well, just in case.
+ (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)))
- ((equal (nth 4 form) (nth 5 (file-attributes file)))
+ ((not (time-less-p (nth 4 form)
+ (nth 5 (file-attributes file))))
;; File hasn't changed.
nil)
(t
- (update-file-autoloads file)))
+ (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.
- (setq no-autoloads
- (append no-autoloads
- (delq nil (mapcar 'update-file-autoloads files))))
+ (dolist (file files)
+ (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.
(setq no-autoloads (sort no-autoloads 'string<))
(current-buffer) nil nil no-autoloads this-time)
(insert generate-autoload-section-trailer))
- (save-buffer))))
+ (save-buffer)
+ ;; In case autoload entries were added to other files because of
+ ;; file-local autoload-generated-file settings.
+ (autoload-save-buffers))))
(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."
- (apply 'update-directory-autoloads command-line-args-left)
- (setq command-line-args-left nil))
+ ;; 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)))
(provide 'autoload)