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)