Mercurial > hg > xemacs-beta
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