xemacs-beta: lisp/utils/autoload.el comparison

comparison lisp/utils/autoload.el @ 78:c7528f8e288d r20-0b34

Import from CVS: tag r20-0b34

author	cvs
date	Mon, 13 Aug 2007 09:05:42 +0200
parents	131b0175ea99
children	4be1180a9e89

comparison

equal deleted inserted replaced

-:6cb4f478e7bc
+:c7528f8e288d
 ;;; 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.
 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
 ;; Keywords: maint
-;;; This program is free software; you can redistribute it and/or modify
+;; This file is part of XEmacs.
-;;; it under the terms of the GNU General Public License as published by
-;;; the Free Software Foundation; either version 2, or (at your option)
+;; XEmacs is free software; you can redistribute it and/or modify it
-;;; any later version.
+;; under the terms of the GNU General Public License as published by
-;;;
+;; the Free Software Foundation; either version 2, or (at your option)
-;;; This program is distributed in the hope that it will be useful,
+;; any later version.
-;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; XEmacs is distributed in the hope that it will be useful, but
-;;; GNU General Public License for more details.
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;; A copy of the GNU General Public License can be obtained from this
+;; General Public License for more details.
-;;; program's author (send electronic mail to roland@ai.mit.edu) or from
-;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
+;; You should have received a copy of the GNU General Public License
-;;; 02139, USA.
+;; 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: FSF 19.30.
+;;; Synched up with: Not synched with FSF.
 ;;; Commentary:
 ;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
 ;; date.  It interprets magic cookies of the form ";;;###autoload" in
 		(if macrop (list 'quote 'macro) nil)))
 nil)))
 (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:
 ;;;###autoload
 \(defun function-to-be-autoloaded () ...)
-If this string appears alone on a line, the following form will be read and
+If this string appears alone on a line, the following form will be
-an autoload made for it.  If it is followed by the string \"immediate\",
+read and an autoload made for it.  If it is followed by the string
-then the form on the following will be copied verbatim.  If there is further
+\"immediate\", then the form on the following line will be copied
-text on the line, that text will be copied verbatim to
+verbatim.  If there is further text on the line, that text will be
-`generated-autoload-file'.")
+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.
 ;;; A doc-string-elt property of ELT says that (nth ELT FORM) is
 ;;; the doc-string in FORM.
 (put 'defvar   'doc-string-elt 3)
 (put 'defconst 'doc-string-elt 3)
 (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-relative-name file (file-name-directory
-		      (file-name-directory
+			    (directory-file-name
-		       (directory-file-name
+			     (file-name-directory file)))))
-			(file-name-directory file)))))
 ;;;###autoload
 (defun generate-file-autoloads (file &optional 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."
 (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)))
+	(load-name (replace-in-string (file-name-nondirectory file)
-		     (if (string-match "\\.elc?$" name)
+				      "\\.elc?$"
-			 (substring name 0 (match-beginning 0))
+				      ""))
-		       name)))
+	(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)
 ;; If the autoload section we create here uses an absolute
 ;; pathname for FILE in its header, and then Emacs is installed
 ;; `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))))
-(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")
 		    (goto-char (point-min))
 			(looking-at (regexp-quote generate-autoload-cookie)))
 		    (if dofiles
 			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))
 				       (or (bolp) (forward-line 1))))
 			       (autoload (make-autoload form load-name))
 		   (t
 		    (forward-sexp 1)
 		    (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)
 	(setq output-end (point-marker))))
 (if t ;; done-any
 	;; XEmacs -- always do this so that we cache the information
 	;; that we've processed the file already.
 	(progn
 	  (insert generate-autoload-section-header)
-	  (prin1 (list 'autoloads autoloads-done load-name
+	  (prin1 (list 'autoloads autoloads-done load-name trim-name)
-		       (autoload-trim-file-name file)
-		       (nth 5 (file-attributes file)))
 		 outbuf)
 	  (terpri outbuf)
-	  (insert ";;; Generated autoloads from "
+	  ;;;; (insert ";;; Generated autoloads from "
-		  (autoload-trim-file-name file) "\n")
+	  ;;;;	  (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)
 	      (if (> (- (point) beg) 900)
 		  (progn
 	    (forward-line 1))
 	  (goto-char output-end)
 	  (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"
+(defvar generated-autoload-file
-						    data-directory)
+(expand-file-name "../lisp/prim/auto-autoloads.el" data-directory)
-"*File \\[update-file-autoloads] puts autoloads into.
+"*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))
-(setq file (expand-file-name file default-directory))
+(let ((load-name (replace-in-string (file-name-nondirectory file)
-(let ((load-name (let ((name (file-name-nondirectory file)))
+				      "\\.elc?$"
-		     (if (string-match "\\.elc?$" name)
+				      ""))
-			 (substring name 0 (match-beginning 0))
-		       name)))
 	(trim-name (autoload-trim-file-name file))
-	(found nil)
+	section-begin form)
-	(pass 'first)
-	(existing-buffer (get-file-buffer file)))
 (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
+;; First delete all sections for this file.
-	(save-restriction
+(goto-char (point-min))
-	  (widen)
+(while (search-forward generate-autoload-section-header nil t)
-	  (while pass
+	(setq section-begin (match-beginning 0))
-	    ;; This is done in two passes:
+	(setq form (read (current-buffer)))
-	    ;;   1st pass:  Look for the section for LOAD-NAME anywhere in the file.
+	(when (string= (nth 2 form) load-name)
-	    ;;   2st pass:  Find a place to insert it.  Use alphabetical order.
+	  (search-forward generate-autoload-section-trailer)
-	    (goto-char (point-min))
+	  (delete-region section-begin (point))))
-	    (while (and (not found)
-			(search-forward generate-autoload-section-header nil t))
+;; Now find insertion point for new section
-	      (let ((form (condition-case ()
+(block find-insertion-point
-			      (read (current-buffer))
+	(goto-char (point-min))
-			    (end-of-file nil))))
+	(while (search-forward generate-autoload-section-header nil t)
-		(cond ((and (eq pass 'first)
+	  (setq form (read (current-buffer)))
-			    (string= (nth 2 form) load-name))
+	  (when (string< trim-name (nth 3 form))
-		       ;; We found the section for this file.
+	    ;; Found alphabetically correct insertion point
-		       ;; Check if it is up to date.
+	    (goto-char (match-beginning 0))
-		       (let ((begin (match-beginning 0))
+	    (return-from find-insertion-point))
-			     (last-time (nth 4 form))
+	  (search-forward generate-autoload-section-trailer))
-			     (file-time (nth 5 (file-attributes file))))
+	(when (eq (point) (point-min))	; No existing entries?
-			 (if (and (or (null existing-buffer)
+	  (goto-char (point-max))))	; Append.
-				      (not (buffer-modified-p existing-buffer)))
-				  (listp last-time) (= (length last-time) 2)
+;; Add in new sections for file
-				  (or (> (car last-time) (car file-time))
+(generate-file-autoloads file))
-				      (and (= (car last-time) (car file-time))
-					   (>= (nth 1 last-time)
+(when (interactive-p) (save-buffer))))
-					       (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
 (goto-char (point-min))
 (while (search-forward generate-autoload-section-header nil t)
 			    (if (or (get-file-buffer loc)
 				    (file-exists-p loc))
 				(setq file loc)
 			      nil))))))
 		(t
-		 (setq file (if (y-or-n-p (format "Can't find library `%s'; remove its autoloads? "
+		 (setq file
-						  (nth 2 form) file))
+		       (if (y-or-n-p
-				t
+			    (format
-			      (condition-case ()
+			     "Can't find library `%s'; remove its autoloads? "
-				  (read-file-name
+			     (nth 2 form) file))
-				   (format "Find `%s' load file: "
+			   t
-					   (nth 2 form))
+			 (condition-case ()
-				   nil nil t)
+			     (read-file-name
-				(quit nil))))))
+			      (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)
 		(delete-region begin (point))))
 	  (if (stringp file)
 	      (generate-file-autoloads file)))))))
 ;;;###autoload
-(defun update-directory-autoloads (dir)
+(defun update-autoloads-from-directory (dir)
-"Run \\[update-file-autoloads] on each .el file in 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))
+(setq dir (expand-file-name dir))
-(mapcar 'update-file-autoloads
+(let ((simple-dir (file-name-as-directory
-	    (directory-files dir t "^[^=].*\\.el$")))
+		     (file-name-nondirectory
-(if (interactive-p)
+		     (directory-file-name dir))))
-(save-excursion
+	(enable-local-eval nil))
-	(set-buffer (find-file-noselect generated-autoload-file))
+(save-excursion
-	(save-buffer))))
+(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'."
+For example, invoke `xemacs -batch -f batch-update-autoloads *.el'."
-(if (not noninteractive)
+(unless noninteractive
 (error "batch-update-autoloads is to be used only with -batch"))
-(let ((lost nil)
+(let ((defdir default-directory)
-	(args command-line-args-left)
+	(enable-local-eval nil))	; Don't query in batch mode.
-	(defdir default-directory)
-	(enable-local-eval nil))	;Don't query in batch mode.
 (message "Updating autoloads in %s..." generated-autoload-file)
-(let ((frob (function
+(dolist (arg command-line-args-left)
-		 (lambda (file)
+(setq arg (expand-file-name arg defdir))
-		   (condition-case lossage
+(cond
-		       (let ((default-directory defdir))
+((file-directory-p arg)
-			 (update-file-autoloads file))
+	(message "Updating autoloads for directory %s..." arg)
-		     (error
+	(update-autoloads-from-directory arg))
-		      (princ ">>Error processing ")
+((file-exists-p arg)
-		      (princ file)
+	(update-file-autoloads arg))
-		      (princ ": ")
+(t (error "No such file or directory: %s" arg))))
-		      (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 (if lost 1 0))))
+(kill-emacs 0)))
 (provide 'autoload)
 ;;; autoload.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/utils/autoload.el @ 78:c7528f8e288d r20-0b34