Mercurial > hg > xemacs-beta
diff lisp/utils/autoload.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | d620409f5eb8 |
children | c7528f8e288d |
line wrap: on
line diff
--- a/lisp/utils/autoload.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/utils/autoload.el Mon Aug 13 09:02:59 2007 +0200 @@ -1,4 +1,5 @@ ;;; 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. @@ -6,24 +7,23 @@ ;; Author: Roland McGrath <roland@gnu.ai.mit.edu> ;; Keywords: maint -;; 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. +;;; 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. +;;; -;; 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. +;;; Synched up with: FSF 19.30. ;;; Commentary: @@ -59,9 +59,9 @@ (put 'define-skeleton 'doc-string-elt 3) -(defvar generate-autoload-cookie ";;;###autoload" +(defconst 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 line 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 will be copied verbatim. If there is further +text on the line, that text will be copied verbatim to +`generated-autoload-file'.") -(defvar generate-autoload-section-header "\f\n;;;### " +(defconst generate-autoload-section-header "\f\n;;;### " "String inserted before the form identifying the section of autoloads for a file.") -(defvar generate-autoload-section-trailer "\n;;;***\n" +(defconst 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,11 +107,12 @@ (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) @@ -121,25 +122,17 @@ 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 (replace-in-string (file-name-nondirectory file) - "\\.elc?$" - "")) - (trim-name (autoload-trim-file-name file)) + (load-name (let ((name (file-name-nondirectory file))) + (if (string-match "\\.elc?$" name) + (substring name 0 (match-beginning 0)) + name))) (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) @@ -151,22 +144,23 @@ ;; 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 - (let ((find-file-hooks nil)) - (set-buffer (or visited (find-file-noselect file)))) + (set-buffer (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") @@ -183,7 +177,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)) @@ -292,11 +286,9 @@ (forward-line 1))) (if dofiles (setq funlist (cdr funlist))))))) - ;;(unless visited + (or visited ;; We created this buffer, so we should kill it. - ;; Customize needs it later, we don't want to read the file - ;; in twice. - ;;(kill-buffer (current-buffer))) + (kill-buffer (current-buffer))) (set-buffer outbuf) (setq output-end (point-marker)))) (if t ;; done-any @@ -304,15 +296,15 @@ ;; that we've processed the file already. (progn (insert generate-autoload-section-header) - (prin1 (list 'autoloads autoloads-done load-name trim-name) + (prin1 (list 'autoloads autoloads-done load-name + (autoload-trim-file-name file) + (nth 5 (file-attributes file))) 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) @@ -326,86 +318,129 @@ (insert generate-autoload-section-trailer))) (or noninteractive ; XEmacs: only need one line in -batch mode. (message "Generating autoloads for %s...done" file)))) - -(defvar generated-autoload-file - (expand-file-name "../lisp/prim/auto-autoloads.el" data-directory) - "*File `update-file-autoloads' puts autoloads into. +(defconst generated-autoload-file (expand-file-name "../lisp/prim/loaddefs.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 generated-custom-file - (expand-file-name "../lisp/prim/custom-load.el" data-directory) - "*File `update-file-autoloads' puts customization into.") - -;; Written by Per Abrahamsen -(defun autoload-snarf-defcustom (file) - "Snarf all customizations in the current buffer." - (let ((visited (get-file-buffer file))) - (save-excursion - (set-buffer (or visited (find-file-noselect file))) - (when (and file - (string-match "\\`\\(.*\\)\\.el\\'" file) - (not (buffer-modified-p))) - (goto-char (point-min)) - (condition-case nil - (let ((name (file-name-nondirectory (match-string 1 file)))) - (while t - (let ((expr (read (current-buffer)))) - (when (and (listp expr) - (memq (car expr) '(defcustom defface defgroup))) - (eval expr) - (put (nth 1 expr) 'custom-where name))))) - (error nil))) - (unless (buffer-modified-p) - (kill-buffer (current-buffer)))))) +(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: ") - (setq file (expand-file-name file)) - (let ((load-name (replace-in-string (file-name-nondirectory file) - "\\.elc?$" - "")) + ;; 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))) (trim-name (autoload-trim-file-name file)) - section-begin form) + (found nil) + (pass 'first) + (existing-buffer (get-file-buffer file))) (save-excursion - (let ((find-file-hooks nil)) - (set-buffer (or (get-file-buffer generated-autoload-file) - (find-file-noselect generated-autoload-file)))) - ;; 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) - (autoload-snarf-defcustom file)) - - (when (interactive-p) (save-buffer)))) + ;; 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))))) ;;;###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 @@ -434,18 +469,15 @@ (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) @@ -454,90 +486,58 @@ (generate-file-autoloads file))))))) ;;;###autoload -(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." +(defun update-directory-autoloads (dir) + "Run \\[update-file-autoloads] on each .el file in DIR." (interactive "DUpdate autoloads for directory: ") - (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 - (let ((find-file-hooks nil)) - (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))))) - -;; Based on code from Per Abrahamsen -(defun autoload-save-customization () - (save-excursion - (set-buffer (find-file-noselect generated-custom-file)) - (erase-buffer) - (insert - (with-output-to-string - (mapatoms (lambda (symbol) - (let ((members (get symbol 'custom-group)) - item where found) - (when members - (princ "(put '") - (princ symbol) - (princ " 'custom-loads '(") - (while members - (setq item (car (car members)) - members (cdr members) - where (get item 'custom-where)) - (unless (or (null where) - (member where found)) - (when found - (princ " ")) - (prin1 where) - (push where found))) - (princ "))\n"))))))))) + (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)))) ;;;###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 `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. +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. (message "Updating autoloads in %s..." generated-autoload-file) - (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)))) - (autoload-save-customization) + (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)))) (save-some-buffers t) (message "Done") - (kill-emacs 0))) + (kill-emacs (if lost 1 0)))) (provide 'autoload)