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)