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

comparison 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

comparison

equal deleted inserted replaced

-:804d1389bcd6
+:131b0175ea99
 ;;; 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 file is part of XEmacs.
+;;; 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
-;; XEmacs is free software; you can redistribute it and/or modify it
+;;; the Free Software Foundation; either version 2, or (at your option)
-;; under the terms of the GNU General Public License as published by
+;;; any later version.
-;; 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
-;; XEmacs is distributed in the hope that it will be useful, but
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; GNU General Public License for more details.
-;; 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
-;; You should have received a copy of the GNU General Public License
+;;; the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA
-;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;;; 02139, USA.
-;; 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)
-(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:
 ;;;###autoload
 \(defun function-to-be-autoloaded () ...)
-If this string appears alone on a line, the following form will be
+If this string appears alone on a line, the following form will be read and
-read and an autoload made for it.  If it is followed by the string
+an autoload made for it.  If it is followed by the string \"immediate\",
-\"immediate\", then the form on the following line will be copied
+then the form on the following will be copied verbatim.  If there is further
-verbatim.  If there is further text on the line, that text will be
+text on the line, that text will be copied verbatim to
-copied verbatim to `generated-autoload-file'.")
+`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.
 ;;; 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-name-directory
+(file-relative-name file
-			    (directory-file-name
+		      (file-name-directory
-			     (file-name-directory file)))))
+		       (directory-file-name
+			(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 (replace-in-string (file-name-nondirectory file)
+	(load-name (let ((name (file-name-nondirectory file)))
-				      "\\.elc?$"
+		     (if (string-match "\\.elc?$" name)
-				      ""))
+			 (substring name 0 (match-beginning 0))
-	(trim-name (autoload-trim-file-name file))
+		       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)
 ;; 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
-	    (let ((find-file-hooks nil))
+	    (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)))))))
-	;;(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
+	    (kill-buffer (current-buffer)))
-	    ;; in twice.
-	    ;;(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 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 "
+	  (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))))
-(defvar generated-autoload-file
+(defconst generated-autoload-file (expand-file-name "../lisp/prim/loaddefs.el"
-(expand-file-name "../lisp/prim/auto-autoloads.el" data-directory)
+						    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 generated-custom-file
+(defvar generate-autoload-dynamic-but-inefficient nil
-(expand-file-name "../lisp/prim/custom-load.el" data-directory)
+"If non-nil, `update-file-autoloads' will always read in its files.
-"*File `update-file-autoloads' puts customization into.")
+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
-;; Written by Per Abrahamsen
+lots of files.")
-(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))))))
 ;;;###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))
+;; avoid horrid horrid problems with relative filenames.
-(let ((load-name (replace-in-string (file-name-nondirectory file)
+(setq file (expand-file-name file default-directory))
-				      "\\.elc?$"
+(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))
+;; We want to get a value for generated-autoload-file from
-	(set-buffer (or (get-file-buffer generated-autoload-file)
+;; the local variables section if it's there.
-			(find-file-noselect generated-autoload-file))))
+(and generate-autoload-dynamic-but-inefficient
-;; First delete all sections for this file.
+	   (set-buffer (find-file-noselect file)))
-(goto-char (point-min))
+(set-buffer (or (get-file-buffer generated-autoload-file)
-(while (search-forward generate-autoload-section-header nil t)
+		      (find-file-noselect generated-autoload-file)))
-	(setq section-begin (match-beginning 0))
+(save-excursion
-	(setq form (read (current-buffer)))
+	(save-restriction
-	(when (string= (nth 2 form) load-name)
+	  (widen)
-	  (search-forward generate-autoload-section-trailer)
+	  (while pass
-	  (delete-region section-begin (point))))
+	    ;; This is done in two passes:
+	    ;;   1st pass:  Look for the section for LOAD-NAME anywhere in the file.
-;; Now find insertion point for new section
+	    ;;   2st pass:  Find a place to insert it.  Use alphabetical order.
-(block find-insertion-point
+	    (goto-char (point-min))
-	(goto-char (point-min))
+	    (while (and (not found)
-	(while (search-forward generate-autoload-section-header nil t)
+			(search-forward generate-autoload-section-header nil t))
-	  (setq form (read (current-buffer)))
+	      (let ((form (condition-case ()
-	  (when (string< trim-name (nth 3 form))
+			      (read (current-buffer))
-	    ;; Found alphabetically correct insertion point
+			    (end-of-file nil))))
-	    (goto-char (match-beginning 0))
+		(cond ((and (eq pass 'first)
-	    (return-from find-insertion-point))
+			    (string= (nth 2 form) load-name))
-	  (search-forward generate-autoload-section-trailer))
+		       ;; We found the section for this file.
-	(when (eq (point) (point-min))	; No existing entries?
+		       ;; Check if it is up to date.
-	  (goto-char (point-max))))	; Append.
+		       (let ((begin (match-beginning 0))
+			     (last-time (nth 4 form))
-;; Add in new sections for file
+			     (file-time (nth 5 (file-attributes file))))
-(generate-file-autoloads file)
+			 (if (and (or (null existing-buffer)
-(autoload-snarf-defcustom file))
+				      (not (buffer-modified-p existing-buffer)))
+				  (listp last-time) (= (length last-time) 2)
-(when (interactive-p) (save-buffer))))
+				  (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
 (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
+		 (setq file (if (y-or-n-p (format "Can't find library `%s'; remove its autoloads? "
-		       (if (y-or-n-p
+						  (nth 2 form) file))
-			    (format
+				t
-			     "Can't find library `%s'; remove its autoloads? "
+			      (condition-case ()
-			     (nth 2 form) file))
+				  (read-file-name
-			   t
+				   (format "Find `%s' load file: "
-			 (condition-case ()
+					   (nth 2 form))
-			     (read-file-name
+				   nil nil t)
-			      (format "Find `%s' load file: "
+				(quit nil))))))
-				      (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-autoloads-from-directory (dir)
+(defun update-directory-autoloads (dir)
-"Update `generated-autoload-file' with all the current autoloads from DIR.
+"Run \\[update-file-autoloads] on each .el file in 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: ")
-(setq dir (expand-file-name dir))
+(let ((enable-local-eval nil))
-(let ((simple-dir (file-name-as-directory
+(mapcar 'update-file-autoloads
-		     (file-name-nondirectory
+	    (directory-files dir t "^[^=].*\\.el$")))
-		     (directory-file-name dir))))
+(if (interactive-p)
-	(enable-local-eval nil))
+(save-excursion
-(save-excursion
+	(set-buffer (find-file-noselect generated-autoload-file))
-(let ((find-file-hooks nil))
+	(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)))))
-;; 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")))))))))
 ;;;###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'."
+For example, invoke `emacs -batch -f batch-update-autoloads *.el'."
-(unless noninteractive
+(if (not noninteractive)
 (error "batch-update-autoloads is to be used only with -batch"))
-(let ((defdir default-directory)
+(let ((lost nil)
-	(enable-local-eval nil))	; Don't query in batch mode.
+	(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)
+(let ((frob (function
-(setq arg (expand-file-name arg defdir))
+		 (lambda (file)
-(cond
+		   (condition-case lossage
-((file-directory-p arg)
+		       (let ((default-directory defdir))
-	(message "Updating autoloads for directory %s..." arg)
+			 (update-file-autoloads file))
-	(update-autoloads-from-directory arg))
+		     (error
-((file-exists-p arg)
+		      (princ ">>Error processing ")
-	(update-file-autoloads arg))
+		      (princ file)
-(t (error "No such file or directory: %s" arg))))
+		      (princ ": ")
-(autoload-save-customization)
+		      (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)
 ;;; autoload.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/utils/autoload.el @ 70:131b0175ea99 r20-0b30