Mercurial > hg > xemacs-beta
diff lisp/utils/autoload.el @ 12:bcdc7deadc19 r19-15b7
Import from CVS: tag r19-15b7
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:48:16 +0200 |
parents | 376386a54a3c |
children | 4103f0995bd7 |
line wrap: on
line diff
--- a/lisp/utils/autoload.el Mon Aug 13 08:47:56 2007 +0200 +++ b/lisp/utils/autoload.el Mon Aug 13 08:48:16 2007 +0200 @@ -1,5 +1,4 @@ ;;; autoload.el --- maintain autoloads in loaddefs.el. - ;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc. ;;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. ;;; Copyright (C) 1996 Ben Wing. @@ -7,23 +6,24 @@ ;; Author: Roland McGrath <roland@gnu.ai.mit.edu> ;; Keywords: maint -;;; This program 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 2, or (at your option) -;;; any later version. -;;; -;;; This program is distributed in the hope that it will be useful, -;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;;; GNU General Public License for more details. -;;; -;;; A copy of the GNU General Public License can be obtained from this -;;; program's author (send electronic mail to roland@ai.mit.edu) or from -;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA -;;; 02139, USA. -;;; +;; This file is part of XEmacs. + +;; XEmacs 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 2, or (at your option) +;; any later version. -;;; Synched up with: FSF 19.30. +;; XEmacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with XEmacs; see the file COPYING. If not, write to the Free +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. + +;;; Synched up with: Not synched with FSF. ;;; Commentary: @@ -59,9 +59,9 @@ (put 'define-skeleton 'doc-string-elt 3) -(defconst generate-autoload-cookie ";;;###autoload" +(defvar generate-autoload-cookie ";;;###autoload" "Magic comment indicating the following form should be autoloaded. -Used by \\[update-file-autoloads]. This string should be +Used by `update-file-autoloads'. This string should be meaningless to Lisp (e.g., a comment). This string is used: @@ -69,17 +69,17 @@ ;;;###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 it is followed by the string \"immediate\", -then the form on the following will be copied verbatim. If there is further -text on the line, that text will be copied verbatim to -`generated-autoload-file'.") +If this string appears alone on a line, the following form will be +read and an autoload made for it. If it is followed by the string +\"immediate\", then the form on the following line will be copied +verbatim. If there is further text on the line, that text will be +copied verbatim to `generated-autoload-file'.") -(defconst generate-autoload-section-header "\f\n;;;### " +(defvar generate-autoload-section-header "\f\n;;;### " "String inserted before the form identifying the section of autoloads for a file.") -(defconst generate-autoload-section-trailer "\n;;;***\n" +(defvar generate-autoload-section-trailer "\n;;;***\n" "String which indicates the end of the section of autoloads for a file.") ;;; Forms which have doc-strings which should be printed specially. @@ -107,12 +107,11 @@ (put 'defmacro 'doc-string-elt 3) (defun autoload-trim-file-name (file) - ;; returns a relative pathname of FILE including the last directory. + "Returns a relative pathname of FILE including the last directory." (setq file (expand-file-name file)) - (file-relative-name file - (file-name-directory - (directory-file-name - (file-name-directory file))))) + (file-relative-name file (file-name-directory + (directory-file-name + (file-name-directory file))))) ;;;###autoload (defun generate-file-autoloads (file &optional funlist) @@ -122,17 +121,25 @@ If FILE is being visited in a buffer, the contents of the buffer are used." (interactive "fGenerate autoloads for file: ") + (generate-file-autoloads-1 file funlist)) + +(defun* generate-file-autoloads-1 (file funlist) + "Insert at point a loaddefs autoload section for FILE. +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." (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))) + (load-name (replace-in-string (file-name-nondirectory file) + "\\.elc?$" + "")) + (trim-name (autoload-trim-file-name file)) (dofiles (not (null funlist))) (print-length nil) (print-readably t) ; XEmacs (float-output-format nil) - (done-any nil) + ;; (done-any nil) (visited (get-file-buffer file)) output-end) @@ -144,23 +151,21 @@ ;; 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)))) - (message "Generating autoloads for %s..." file) (save-excursion (unwind-protect (progn - (set-buffer (find-file-noselect file)) + (set-buffer (or visited (find-file-noselect file))) (save-excursion (save-restriction (widen) (goto-char (point-min)) + (unless (search-forward generate-autoload-cookie nil t) + (message "No autoloads found in %s" trim-name) + (return-from generate-file-autoloads-1)) + + (message "Generating autoloads for %s..." trim-name) + (goto-char (point-min)) (while (if dofiles funlist (not (eobp))) (if (not dofiles) (skip-chars-forward " \t\n\f") @@ -177,7 +182,7 @@ nil (search-forward generate-autoload-cookie) (skip-chars-forward " \t")) - (setq done-any t) + ;; (setq done-any t) (if (or dofiles (eolp)) ;; Read the next form and make an autoload. (let* ((form (prog1 (read (current-buffer)) @@ -286,7 +291,7 @@ (forward-line 1))) (if dofiles (setq funlist (cdr funlist))))))) - (or visited + (unless visited ;; We created this buffer, so we should kill it. (kill-buffer (current-buffer))) (set-buffer outbuf) @@ -296,15 +301,15 @@ ;; that we've processed the file already. (progn (insert generate-autoload-section-header) - (prin1 (list 'autoloads autoloads-done load-name - (autoload-trim-file-name file) - (nth 5 (file-attributes file))) + (prin1 (list 'autoloads autoloads-done load-name trim-name) outbuf) (terpri outbuf) - (insert ";;; Generated autoloads from " - (autoload-trim-file-name file) "\n") + ;;;; (insert ";;; Generated autoloads from " + ;;;; (autoload-trim-file-name file) "\n") ;; Warn if we put a line in loaddefs.el ;; that is long enough to cause trouble. + (when (< output-end (point)) + (setq output-end (point-marker))) (while (< (point) output-end) (let ((beg (point))) (end-of-line) @@ -318,129 +323,58 @@ (insert generate-autoload-section-trailer))) (or noninteractive ; XEmacs: only need one line in -batch mode. (message "Generating autoloads for %s...done" file)))) + -(defconst generated-autoload-file (expand-file-name "../lisp/prim/loaddefs.el" - data-directory) - "*File \\[update-file-autoloads] puts autoloads into. +(defvar generated-autoload-file + (expand-file-name "../lisp/prim/auto-autoloads.el" data-directory) + "*File `update-file-autoloads' puts autoloads into. A .el file can set this in its local variables section to make its autoloads go somewhere else.") -(defvar generate-autoload-dynamic-but-inefficient nil - "If non-nil, `update-file-autoloads' will always read in its files. -This allows you to bind `generated-autoload-file' in your local variables -(do you really want to do that?) but makes it very slow in updating -lots of files.") - ;;;###autoload (defun update-file-autoloads (file) "Update the autoloads for FILE in `generated-autoload-file' \(which FILE might bind in its local variables)." (interactive "fUpdate autoloads for file: ") - ;; avoid horrid horrid problems with relative filenames. - (setq file (expand-file-name file default-directory)) - (let ((load-name (let ((name (file-name-nondirectory file))) - (if (string-match "\\.elc?$" name) - (substring name 0 (match-beginning 0)) - name))) + (setq file (expand-file-name file)) + (let ((load-name (replace-in-string (file-name-nondirectory file) + "\\.elc?$" + "")) (trim-name (autoload-trim-file-name file)) - (found nil) - (pass 'first) - (existing-buffer (get-file-buffer file))) + section-begin form) (save-excursion - ;; We want to get a value for generated-autoload-file from - ;; the local variables section if it's there. - (and generate-autoload-dynamic-but-inefficient - (set-buffer (find-file-noselect file))) (set-buffer (or (get-file-buffer generated-autoload-file) (find-file-noselect generated-autoload-file))) - (save-excursion - (save-restriction - (widen) - (while pass - ;; This is done in two passes: - ;; 1st pass: Look for the section for LOAD-NAME anywhere in the file. - ;; 2st pass: Find a place to insert it. Use alphabetical order. - (goto-char (point-min)) - (while (and (not found) - (search-forward generate-autoload-section-header nil t)) - (let ((form (condition-case () - (read (current-buffer)) - (end-of-file nil)))) - (cond ((and (eq pass 'first) - (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) - (or (> (car last-time) (car file-time)) - (and (= (car last-time) (car file-time)) - (>= (nth 1 last-time) - (nth 1 file-time))))) - (progn - (or noninteractive - ;; jwz: too loud in -batch mode - (message - "Autoload section for %s is up to date." - file)) - (setq found 'up-to-date)) - ;; Okay, we found it and it's not up to date... - (search-forward generate-autoload-section-trailer) - (delete-region begin (point)) - ;; if the file has moved, then act like it hasn't - ;; been found and then reinsert it alphabetically. - (setq found (string= trim-name (nth 3 form))) - ))) - ;; XEmacs change -- we organize by sub-directories - ;; so inserting new autoload entries is a bit tricky... - ((and (eq pass 'last) - (string< trim-name (nth 3 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)) - ))) - (cond (found - (setq pass nil)) ; success -- exit loop - ((eq pass 'first) - (setq pass 'last)) - (t - ;; failure -- exit loop - (setq pass nil)))) - (or (eq found 'up-to-date) - ;; XEmacs -- don't do the following. If we do, then - ;; every time we update autoloads we have to search - ;; the whole file (yuck). -; (and (eq found 'new) -; ;; Check that FILE has any cookies before generating a -; ;; new section for it. -; (save-excursion -; (set-buffer (find-file-noselect file)) -; (save-excursion -; (widen) -; (goto-char (point-min)) -; (if (search-forward (concat "\n" -; generate-autoload-cookie) -; nil t) -; nil -; (if (interactive-p) -; (message file " has no autoloads")) -; t)))) - (generate-file-autoloads file)))) - (if (interactive-p) (save-buffer)) - (if (and (null existing-buffer) - (setq existing-buffer (get-file-buffer file))) - (kill-buffer existing-buffer))))) + ;; First delete all sections for this file. + (goto-char (point-min)) + (while (search-forward generate-autoload-section-header nil t) + (setq section-begin (match-beginning 0)) + (setq form (read (current-buffer))) + (when (string= (nth 2 form) load-name) + (search-forward generate-autoload-section-trailer) + (delete-region section-begin (point)))) + + ;; Now find insertion point for new section + (block find-insertion-point + (goto-char (point-min)) + (while (search-forward generate-autoload-section-header nil t) + (setq form (read (current-buffer))) + (when (string< trim-name (nth 3 form)) + ;; Found alphabetically correct insertion point + (goto-char (match-beginning 0)) + (return-from find-insertion-point)) + (search-forward generate-autoload-section-trailer)) + (when (eq (point) (point-min)) ; No existing entries? + (goto-char (point-max)))) ; Append. + + ;; Add in new sections for file + (generate-file-autoloads file)) + + (when (interactive-p) (save-buffer)))) ;;;###autoload (defun update-autoloads-here () - "\ -Update sections of the current buffer generated by \\[update-file-autoloads]." + "Update sections of the current buffer generated by `update-file-autoloads'." (interactive) (let ((generated-autoload-file (buffer-file-name))) (save-excursion @@ -469,15 +403,18 @@ (setq file loc) nil)))))) (t - (setq file (if (y-or-n-p (format "Can't find library `%s'; remove its autoloads? " - (nth 2 form) file)) - t - (condition-case () - (read-file-name - (format "Find `%s' load file: " - (nth 2 form)) - nil nil t) - (quit nil)))))) + (setq file + (if (y-or-n-p + (format + "Can't find library `%s'; remove its autoloads? " + (nth 2 form) file)) + t + (condition-case () + (read-file-name + (format "Find `%s' load file: " + (nth 2 form)) + nil nil t) + (quit nil)))))) (if file (let ((begin (match-beginning 0))) (search-forward generate-autoload-section-trailer) @@ -486,58 +423,62 @@ (generate-file-autoloads file))))))) ;;;###autoload -(defun update-directory-autoloads (dir) - "Run \\[update-file-autoloads] on each .el file in DIR." +(defun update-autoloads-from-directory (dir) + "Update `generated-autoload-file' with all the current autoloads from DIR. +This runs `update-file-autoloads' on each .el file in DIR. +Obsolete autoload entries for files that no longer exist are deleted." (interactive "DUpdate autoloads for directory: ") - (let ((enable-local-eval nil)) - (mapcar 'update-file-autoloads - (directory-files dir t "^[^=].*\\.el$"))) - (if (interactive-p) - (save-excursion - (set-buffer (find-file-noselect generated-autoload-file)) - (save-buffer)))) + (setq dir (expand-file-name dir)) + (let ((simple-dir (file-name-as-directory + (file-name-nondirectory + (directory-file-name dir)))) + (enable-local-eval nil)) + (save-excursion + (set-buffer (find-file-noselect generated-autoload-file)) + (goto-char (point-min)) + (while (search-forward generate-autoload-section-header nil t) + (let* ((begin (match-beginning 0)) + (form (condition-case () + (read (current-buffer)) + (end-of-file nil))) + (file (nth 3 form))) + (when (and (stringp file) + (string= (file-name-directory file) simple-dir) + (not (file-exists-p + (expand-file-name + (file-name-nondirectory file) dir)))) + ;; Remove the obsolete section. + (search-forward generate-autoload-section-trailer) + (delete-region begin (point))))) + ;; Update or create autoload sections for existing files. + (mapcar 'update-file-autoloads (directory-files dir t "^[^=].*\\.el$")) + (unless noninteractive + (save-buffer))))) ;;;###autoload (defun batch-update-autoloads () "Update the autoloads for the files or directories on the command line. -Runs \\[update-file-autoloads] on files and \\[update-directory-autoloads] +Runs `update-file-autoloads' on files and `update-directory-autoloads' on directories. Must be used only with -batch, and kills Emacs on completion. Each file will be processed even if an error occurred previously. -For example, invoke `emacs -batch -f batch-update-autoloads *.el'." - (if (not noninteractive) - (error "batch-update-autoloads is to be used only with -batch")) - (let ((lost nil) - (args command-line-args-left) - (defdir default-directory) - (enable-local-eval nil)) ;Don't query in batch mode. +For example, invoke `xemacs -batch -f batch-update-autoloads *.el'." + (unless noninteractive + (error "batch-update-autoloads is to be used only with -batch")) + (let ((defdir default-directory) + (enable-local-eval nil)) ; Don't query in batch mode. (message "Updating autoloads in %s..." generated-autoload-file) - (let ((frob (function - (lambda (file) - (condition-case lossage - (let ((default-directory defdir)) - (update-file-autoloads file)) - (error - (princ ">>Error processing ") - (princ file) - (princ ": ") - (if (fboundp 'display-error) - (display-error lossage nil) - (prin1 lossage)) - (princ "\n") - (setq lost t))))))) - (while args - (if (file-directory-p (expand-file-name (car args))) - (let ((rest (directory-files (car args) t "\\.el$"))) - (if noninteractive - (message "Processing directory %s..." (car args))) - (while rest - (funcall frob (car rest)) - (setq rest (cdr rest)))) - (funcall frob (car args))) - (setq args (cdr args)))) + (dolist (arg command-line-args-left) + (setq arg (expand-file-name arg defdir)) + (cond + ((file-directory-p arg) + (message "Updating autoloads for directory %s..." arg) + (update-autoloads-from-directory arg)) + ((file-exists-p arg) + (update-file-autoloads arg)) + (t (error "No such file or directory: %s" arg)))) (save-some-buffers t) (message "Done") - (kill-emacs (if lost 1 0)))) + (kill-emacs 0))) (provide 'autoload)