diff lisp/autoload.el @ 428:3ecd8885ac67 r21-2-22

Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 84b14dcb0985
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/autoload.el	Mon Aug 13 11:28:15 2007 +0200
@@ -0,0 +1,566 @@
+;;; autoload.el --- maintain autoloads in loaddefs.el.
+
+;; Copyright (C) 1991, 1992, 1993, 1994, 1997 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.
+
+;; 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.
+
+;; 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:
+
+;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
+;; date.  It interprets magic cookies of the form ";;;###autoload" in
+;; lisp source files in various useful ways.  To learn more, read the
+;; source; if you're going to use this, you'd better be able to.
+
+;; ChangeLog:
+
+;; Sep-26-1997:  slb removed code dealing with customization.
+
+;;; Code:
+
+(defun make-autoload (form file)
+  "Turn FORM, a defun or defmacro, into an autoload for source file FILE.
+Returns nil if FORM is not a defun, define-skeleton or defmacro."
+  (let ((car (car-safe form)))
+    (if (memq car '(defun define-skeleton defmacro))
+	(let ((macrop (eq car 'defmacro))
+	      name doc)
+	  (setq form (cdr form)
+		name (car form)
+		;; Ignore the arguments.
+		form (cdr (if (eq car 'define-skeleton)
+			      form
+			    (cdr form)))
+		doc (car form))
+	  (if (stringp doc)
+	      (setq form (cdr form))
+	    (setq doc nil))
+	  (list 'autoload (list 'quote name) file doc
+		(or (eq car 'define-skeleton)
+		    (eq (car-safe (car form)) 'interactive))
+		(if macrop (list 'quote 'macro) nil)))
+      nil)))
+
+(put 'define-skeleton 'doc-string-elt 3)
+
+(defvar generate-autoload-cookie ";;;###autoload"
+  "Magic comment indicating the following form should be autoloaded.
+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 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'.")
+
+(defvar 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"
+  "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.
+;;;
+;;; There used to be the following note here:
+;;; ;;; Note: defconst and defvar should NOT be marked in this way.
+;;; ;;; We don't want to produce defconsts and defvars that
+;;; ;;; make-docfile can grok, because then it would grok them twice,
+;;; ;;; once in foo.el (where they are given with ;;;###autoload) and
+;;; ;;; once in loaddefs.el.
+;;;
+;;; Counter-note: Yes, they should be marked in this way.
+;;; make-docfile only processes those files that are loaded into the
+;;; dumped Emacs, and those files should never have anything
+;;; autoloaded here.  The above-feared problem only occurs with files
+;;; which have autoloaded entries *and* are processed by make-docfile;
+;;; there should be no such files.
+
+(put 'autoload 'doc-string-elt 3)
+(put 'defun    'doc-string-elt 3)
+(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."
+  (setq file (expand-file-name file))
+  (file-relative-name file (file-name-directory
+			    (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)
+				      "\\.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)
+	(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
+    ;; under a different path on another system,
+    ;; `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))
+
+    (save-excursion
+      (unwind-protect
+	  (progn
+	    (let ((find-file-hooks nil)
+		  (enable-local-variables nil))
+	      (set-buffer (or visited (find-file-noselect file)))
+	      (set-syntax-table lisp-mode-syntax-table))
+	    (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))
+		    (re-search-forward
+		     (concat "(def\\(un\\|var\\|const\\|macro\\) "
+			     (regexp-quote (symbol-name (car funlist)))
+			     "\\s "))
+		    (goto-char (match-beginning 0)))
+		  (cond
+		   ((or dofiles
+			(looking-at (regexp-quote generate-autoload-cookie)))
+		    (if dofiles
+			nil
+		      (search-forward generate-autoload-cookie)
+		      (skip-chars-forward " \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))
+			       (doc-string-elt (get (car-safe form)
+						    'doc-string-elt)))
+			  (if autoload
+			      (setq autoloads-done (cons (nth 1 form)
+							 autoloads-done))
+			    (setq autoload form))
+			  (if (and doc-string-elt
+				   (stringp (nth doc-string-elt autoload)))
+			      ;; We need to hack the printing because the
+			      ;; doc-string must be printed specially for
+			      ;; make-docfile (sigh).
+			      (let* ((p (nthcdr (1- doc-string-elt)
+						autoload))
+				     (elt (cdr p)))
+				(setcdr p nil)
+				(princ "\n(" outbuf)
+				;; XEmacs change: don't let ^^L's get into
+				;; the file or sorting is hard.
+				(let ((print-escape-newlines t)
+				      (p (save-excursion
+					   (set-buffer outbuf)
+					   (point)))
+				      p2)
+				  (mapcar (function (lambda (elt)
+						      (prin1 elt outbuf)
+						      (princ " " outbuf)))
+					  autoload)
+				  (save-excursion
+				    (set-buffer outbuf)
+				    (setq p2 (point-marker))
+				    (goto-char p)
+				    (save-match-data
+				      (while (search-forward "\^L" p2 t)
+					(delete-char -1)
+					(insert "\\^L")))
+				    (goto-char p2)
+				    ))
+				(princ "\"\\\n" outbuf)
+				(let ((begin (save-excursion
+					       (set-buffer outbuf)
+					       (point))))
+				  (princ (substring
+					  (prin1-to-string (car elt)) 1)
+					 outbuf)
+				  ;; Insert a backslash before each ( that
+				  ;; appears at the beginning of a line in
+				  ;; the doc string.
+				  (save-excursion
+				    (set-buffer outbuf)
+				    (save-excursion
+				      (while (search-backward "\n(" begin t)
+					(forward-char 1)
+					(insert "\\"))))
+				  (if (null (cdr elt))
+				      (princ ")" outbuf)
+				    (princ " " outbuf)
+				    (princ (substring
+					    (prin1-to-string (cdr elt))
+					    1)
+					   outbuf))
+				  (terpri outbuf)))
+			    ;; XEmacs change: another fucking ^L hack
+			    (let ((p (save-excursion
+				       (set-buffer outbuf)
+				       (point)))
+				  (print-escape-newlines t)
+				  p2)
+			      (print autoload outbuf)
+			      (save-excursion
+				(set-buffer outbuf)
+				(setq p2 (point-marker))
+				(goto-char p)
+				(save-match-data
+				  (while (search-forward "\^L" p2 t)
+				    (delete-char -1)
+				    (insert "\\^L")))
+				(goto-char p2)
+				))
+			    ))
+		      ;; Copy the rest of the line to the output.
+		      (let ((begin (point)))
+			;; (terpri outbuf)
+			(cond ((looking-at "immediate\\s *$") ; XEmacs
+			       ;; This is here so that you can automatically
+			       ;; have small hook functions copied to
+			       ;; loaddefs.el so that it's not necessary to
+			       ;; load a whole file just to get a two-line
+			       ;; do-nothing find-file-hook... --Stig
+			       (forward-line 1)
+			       (setq begin (point))
+			       (forward-sexp)
+			       (forward-line 1))
+			      (t
+			       (forward-line 1)))
+			(princ (buffer-substring begin (point)) outbuf))))
+		   ((looking-at ";")
+		    ;; Don't read the comment.
+		    (forward-line 1))
+		   (t
+		    (forward-sexp 1)
+		    (forward-line 1)))
+		  (if dofiles
+		      (setq funlist (cdr funlist)))))))
+	(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 trim-name)
+		 outbuf)
+	  (terpri outbuf)
+	  ;;;; (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)
+	      ;; Emacs -- I still haven't figured this one out.
+	      ;; (if (> (- (point) beg) 900)
+		  ;; (progn
+		    ;; (message "A line is too long--over 900 characters")
+		    ;; (sleep-for 2)
+		    ;; (goto-char output-end)))
+	      ;; )
+	    (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 autoload-file-name "auto-autoloads.el"
+  "Generic filename to put autoloads into.
+Unless you are an XEmacs maintainer, it is probably unwise to change this.")
+
+(defvar autoload-target-directory "../lisp/prim/"
+  "Directory to put autoload declaration file into.
+Unless you know what you're doing, don't mess with this.")
+
+(defvar generated-autoload-file
+  (expand-file-name (concat autoload-target-directory
+			    autoload-file-name)
+		    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.")
+
+(defconst cusload-file-name "custom-load.el"
+  "Generic filename ot put custom loads into.
+Unless you are an XEmacs maintainr, it is probably unwise to change this.")
+
+;;;###autoload
+(defun update-file-autoloads (file)
+  "Update the autoloads for FILE in `generated-autoload-file'
+\(which FILE might bind in its local variables).
+This functions refuses to update autoloads files."
+  (interactive "fUpdate autoloads for file: ")
+  (setq file (expand-file-name file))
+  (when (and (file-newer-than-file-p file generated-autoload-file)
+	     (not (member (file-name-nondirectory file)
+			  (list autoload-file-name))))
+
+    (let ((load-name (replace-in-string (file-name-nondirectory file)
+					"\\.elc?$"
+					""))
+	  (trim-name (autoload-trim-file-name file))
+	  section-begin form)
+      (save-excursion
+	(let ((find-file-hooks nil))
+	  (set-buffer (or (get-file-buffer generated-autoload-file)
+			  (find-file-noselect generated-autoload-file))))
+	;; Make sure we can scribble in it.
+	(setq buffer-read-only nil)
+	;; 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'."
+  (interactive)
+  (let ((generated-autoload-file (buffer-file-name)))
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward generate-autoload-section-header nil t)
+	(let* ((form (condition-case ()
+			 (read (current-buffer))
+		       (end-of-file nil)))
+	       (file (nth 3 form)))
+	  ;; XEmacs change: if we can't find the file as specified, look
+	  ;; around a bit more.
+	  (cond ((and (stringp file)
+		      (or (get-file-buffer file)
+			  (file-exists-p file))))
+		((and (stringp file)
+		      (save-match-data
+			(let ((loc (locate-file (file-name-nondirectory file)
+						load-path)))
+			  (if (null loc)
+			      nil
+			    (setq loc (expand-file-name
+				       (autoload-trim-file-name loc)
+				       ".."))
+			    (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? "
+			     (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)
+		(delete-region begin (point))))
+	  (if (stringp file)
+	      (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."
+  (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)))))
+
+;;;###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'
+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'.
+The directory to which the auto-autoloads.el file must be the first parameter
+on the command line."
+  (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)
+    (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))))
+    (fixup-autoload-buffer (concat (if autoload-package-name
+				       autoload-package-name
+				     (file-name-nondirectory defdir))
+				   "-autoloads"))
+    (save-some-buffers t)
+    ;; (message "Done")
+    (kill-emacs 0)))
+
+(defun fixup-autoload-buffer (sym)
+  (save-excursion
+    (set-buffer (find-file-noselect generated-autoload-file))
+    (goto-char (point-min))
+    (if (and (not (= (point-min) (point-max)))
+	     (not (looking-at ";;; DO NOT MODIFY THIS FILE")))
+	(progn
+	  (insert ";;; DO NOT MODIFY THIS FILE\n")
+	  (insert "(if (featurep '" sym ")")
+	  (insert " (error \"Already loaded\"))\n")
+	  (goto-char (point-max))
+	  (insert "\n(provide '" sym ")\n")))))
+
+(defvar autoload-package-name nil)
+
+;;;###autoload
+(defun batch-update-directory ()
+  "Update the autoloads for the directory on the command line.
+Runs `update-file-autoloads' on each file in the given directory, must
+be used only with -batch and kills XEmacs on completion."
+  (unless noninteractive
+    (error "batch-update-directory is to be used only with -batch"))
+  (let ((defdir default-directory)
+	(enable-local-eval nil))	; Don't query in batch mode.
+    (dolist (arg command-line-args-left)
+      (setq arg (expand-file-name arg defdir))
+      (let ((generated-autoload-file (concat arg "/" autoload-file-name)))
+	(cond
+	 ((file-directory-p arg)
+	  (message "Updating autoloads in directory %s..." arg)
+	  (update-autoloads-from-directory arg))
+	 (t (error "No such file or directory: %s" arg)))
+	(fixup-autoload-buffer (concat (if autoload-package-name
+					   autoload-package-name
+					 (file-name-nondirectory arg))
+				"-autoloads"))
+	(save-some-buffers t))
+      ;; (message "Done")
+      ;; (kill-emacs 0)
+      )
+    (setq command-line-args-left nil)))
+
+(provide 'autoload)
+
+;;; autoload.el ends here