1 ;;; autoload.el --- maintain autoloads in loaddefs.el.
3 ;; Copyright (C) 1991, 1992, 1993, 1994, 1997 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
5 ;; Copyright (C) 1996, 2000 Ben Wing.
7 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
10 ;; This file is part of XEmacs.
12 ;; XEmacs is free software; you can redistribute it and/or modify it
13 ;; under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; XEmacs is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
27 ;;; Synched up with: Not synched with FSF.
31 ;; This code helps GNU Emacs maintainers keep the loaddefs.el file up to
32 ;; date. It interprets magic cookies of the form ";;;###autoload" in
33 ;; lisp source files in various useful ways. To learn more, read the
34 ;; source; if you're going to use this, you'd better be able to.
38 ;; Sep-26-1997: slb removed code dealing with customization.
42 ;; Need to load easy-mmode because we expand macro calls to easy-mmode
43 ;; macros in make-autoloads below.
46 ; Add operator definitions to autoload-operators.el in the xemacs-base
48 (eval-when-compile (load "cl-macs"))
49 (ignore-errors (require 'autoload-operators))
51 ; As autoload-operators is new, provide stopgap measure for a while.
52 (if (not (boundp 'autoload-make-autoload-operators))
54 (defvar autoload-make-autoload-operators
55 '(defun define-skeleton defmacro define-derived-mode define-generic-mode
56 easy-mmode-define-minor-mode easy-mmode-define-global-mode
57 define-minor-mode defun* defmacro*)
58 "`defun'-like operators that use `autoload' to load the library.")
60 (defvar autoload-make-autoload-complex-operators
61 '(easy-mmode-define-minor-mode easy-mmode-define-global-mode
63 "`defun'-like operators to macroexpand before using `autoload'.")
65 (put 'autoload 'doc-string-elt 3)
66 (put 'defun 'doc-string-elt 3)
67 (put 'defun* 'doc-string-elt 3)
68 (put 'defvar 'doc-string-elt 3)
69 (put 'defcustom 'doc-string-elt 3)
70 (put 'defconst 'doc-string-elt 3)
71 (put 'defmacro 'doc-string-elt 3)
72 (put 'defmacro* 'doc-string-elt 3)
73 (put 'defsubst 'doc-string-elt 3)
74 (put 'define-skeleton 'doc-string-elt 2)
75 (put 'define-derived-mode 'doc-string-elt 4)
76 (put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
77 (put 'define-minor-mode 'doc-string-elt 2)
78 (put 'define-generic-mode 'doc-string-elt 7)
79 ;; defin-global-mode has no explicit docstring.
80 (put 'easy-mmode-define-global-mode 'doc-string-elt 1000)))
82 (defun make-autoload (form file)
83 "Turn FORM into an autoload or defvar for source file FILE.
84 Returns nil if FORM is not a special autoload form (i.e. a function definition
85 or macro definition or a defcustom)."
86 (let ((car (car-safe form)) expand)
88 ;; For complex cases, try again on the macro-expansion.
89 ((and (memq car autoload-make-autoload-complex-operators)
90 (setq expand (let ((load-file-name file)) (macroexpand form)))
91 (eq (car expand) 'progn)
92 (memq :autoload-end expand))
93 (let ((end (memq :autoload-end expand)))
94 ;; Cut-off anything after the :autoload-end marker.
97 (mapcar (lambda (form) (make-autoload form file))
100 ;; For special function-like operators, use the `autoload' function.
101 ((memq car autoload-make-autoload-operators)
102 (let* ((macrop (memq car '(defmacro defmacro*)))
104 (body (nthcdr (get car 'doc-string-elt) form))
105 (doc (if (stringp (car body)) (pop body))))
106 ;; `define-generic-mode' quotes the name, so take care of that
107 (list 'autoload (if (listp name) name (list 'quote name)) file doc
108 (or (and (memq car '(define-skeleton define-derived-mode
110 easy-mmode-define-global-mode
111 easy-mmode-define-minor-mode
112 define-minor-mode)) t)
113 (eq (car-safe (car body)) 'interactive))
114 (if macrop (list 'quote 'macro) nil))))
116 ;; Convert defcustom to a simpler (and less space-consuming) defvar,
117 ;; but add some extra stuff if it uses :require.
119 (let ((varname (car-safe (cdr-safe form)))
120 (init (car-safe (cdr-safe (cdr-safe form))))
121 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form)))))
122 (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form))))))
123 (if (not (plist-get rest :require))
124 `(defvar ,varname ,init ,doc)
126 (defvar ,varname ,init ,doc)
127 (custom-add-to-group ,(plist-get rest :group)
128 ',varname 'custom-variable)
129 (custom-add-load ',varname
130 ,(plist-get rest :require))))))
131 ;; Coding systems. #### Would be nice to handle the docstring here too.
132 ((memq car '(make-coding-system make-8-bit-coding-system))
133 `(autoload-coding-system ,(nth 1 form) '(load ,file)))
134 ;; nil here indicates that this is not a special autoload form.
137 (defvar generate-autoload-cookie ";;;###autoload"
138 "Magic comment indicating the following form should be autoloaded.
139 Used by `update-file-autoloads'. This string should be
140 meaningless to Lisp (e.g., a comment).
145 \(defun function-to-be-autoloaded () ...)
147 If this string appears alone on a line, the following form will be
148 read and an autoload made for it. If it is followed by the string
149 \"immediate\", then the form on the following line will be copied
150 verbatim. If there is further text on the line, that text will be
151 copied verbatim to `generated-autoload-file'.")
153 (defvar generate-autoload-section-header "\f\n;;;### "
154 "String inserted before the form identifying
155 the section of autoloads for a file.")
157 (defvar generate-autoload-section-trailer "\n;;;***\n"
158 "String which indicates the end of the section of autoloads for a file.")
160 (defvar autoload-package-name nil)
162 (defun autoload-trim-file-name (file)
163 "Returns a relative pathname of FILE including the last directory."
164 (setq file (expand-file-name file))
166 (file-relative-name file (file-name-directory
168 (file-name-directory file))))
172 (defun generate-file-autoloads (file &optional funlist)
173 "Insert at point a loaddefs autoload section for FILE.
174 autoloads are generated for defuns and defmacros in FILE
175 marked by `generate-autoload-cookie' (which see).
176 If FILE is being visited in a buffer, the contents of the buffer
178 (interactive "fGenerate autoloads for file: ")
179 (generate-file-autoloads-1 file funlist))
181 (defun* generate-file-autoloads-1 (file funlist)
182 "Insert at point a loaddefs autoload section for FILE.
183 autoloads are generated for defuns and defmacros in FILE
184 marked by `generate-autoload-cookie' (which see).
185 If FILE is being visited in a buffer, the contents of the buffer
187 (let ((outbuf (current-buffer))
189 (load-name (replace-in-string (file-name-nondirectory file)
192 (trim-name (autoload-trim-file-name file))
193 (dofiles (not (null funlist)))
195 (print-readably t) ; XEmacs
196 (float-output-format nil)
198 (visited (get-file-buffer file))
201 ;; If the autoload section we create here uses an absolute
202 ;; pathname for FILE in its header, and then Emacs is installed
203 ;; under a different path on another system,
204 ;; `update-autoloads-here' won't be able to find the files to be
205 ;; autoloaded. So, if FILE is in the same directory or a
206 ;; subdirectory of the current buffer's directory, we'll make it
207 ;; relative to the current buffer's directory.
208 (setq file (expand-file-name file))
213 (let ((find-file-hooks nil)
214 (enable-local-variables nil))
215 (set-buffer (or visited (find-file-noselect file)))
216 (set-syntax-table emacs-lisp-mode-syntax-table))
220 (goto-char (point-min))
221 (unless (search-forward generate-autoload-cookie nil t)
222 (message "No autoloads found in %s" trim-name)
223 (return-from generate-file-autoloads-1))
225 (message "Generating autoloads for %s..." trim-name)
226 (goto-char (point-min))
227 (while (if dofiles funlist (not (eobp)))
229 (skip-chars-forward " \t\n\f")
230 (goto-char (point-min))
232 (concat "(def\\(un\\|var\\|const\\|macro\\) "
233 (regexp-quote (symbol-name (car funlist)))
235 (goto-char (match-beginning 0)))
238 (looking-at (regexp-quote generate-autoload-cookie)))
241 (search-forward generate-autoload-cookie)
242 (skip-chars-forward " \t"))
244 (if (or dofiles (eolp))
245 ;; Read the next form and make an autoload.
246 (let* ((form (prog1 (read (current-buffer))
247 (or (bolp) (forward-line 1))))
248 (autoload (make-autoload form load-name))
249 (doc-string-elt (get (car-safe form)
252 (setq autoloads-done (cons (nth 1 form)
254 (setq autoload form))
255 (if (and doc-string-elt
256 (stringp (nth doc-string-elt autoload)))
257 ;; We need to hack the printing because the
258 ;; doc-string must be printed specially for
259 ;; make-docfile (sigh).
260 (let* ((p (nthcdr (1- doc-string-elt)
265 ;; XEmacs change: don't let ^^L's get into
266 ;; the file or sorting is hard.
267 (let ((print-escape-newlines t)
272 (mapcar (function (lambda (elt)
278 (setq p2 (point-marker))
281 (while (search-forward "\^L" p2 t)
286 (princ "\"\\\n" outbuf)
287 (let ((begin (save-excursion
291 (prin1-to-string (car elt)) 1)
293 ;; Insert a backslash before each ( that
294 ;; appears at the beginning of a line in
299 (while (search-backward "\n(" begin t)
306 (prin1-to-string (cdr elt))
310 ;; XEmacs change: another fucking ^L hack
311 (let ((p (save-excursion
314 (print-escape-newlines t)
316 (print autoload outbuf)
319 (setq p2 (point-marker))
322 (while (search-forward "\^L" p2 t)
328 ;; Copy the rest of the line to the output.
329 (let ((begin (point)))
331 (cond ((looking-at "immediate\\s *$") ; XEmacs
332 ;; This is here so that you can automatically
333 ;; have small hook functions copied to
334 ;; loaddefs.el so that it's not necessary to
335 ;; load a whole file just to get a two-line
336 ;; do-nothing find-file-hook... --Stig
343 (princ (buffer-substring begin (point)) outbuf))))
345 ;; Don't read the comment.
351 (setq funlist (cdr funlist)))))))
353 ;; We created this buffer, so we should kill it.
354 (kill-buffer (current-buffer)))
356 (setq output-end (point-marker))))
358 ;; XEmacs -- always do this so that we cache the information
359 ;; that we've processed the file already.
361 (insert generate-autoload-section-header)
362 (prin1 (list 'autoloads autoloads-done load-name trim-name)
365 ;;;; (insert ";;; Generated autoloads from "
366 ;;;; (autoload-trim-file-name file) "\n")
367 ;; Warn if we put a line in loaddefs.el
368 ;; that is long enough to cause trouble.
369 (when (< output-end (point))
370 (setq output-end (point-marker)))
371 (while (< (point) output-end)
372 ;; (let ((beg (point)))
374 ;; Emacs -- I still haven't figured this one out.
375 ;; (if (> (- (point) beg) 900)
377 ;; (message "A line is too long--over 900 characters")
379 ;; (goto-char output-end)))
382 (goto-char output-end)
383 (insert generate-autoload-section-trailer)))
384 (or noninteractive ; XEmacs: only need one line in -batch mode.
385 (message "Generating autoloads for %s...done" file))))
388 (defconst autoload-file-name "auto-autoloads.el"
389 "Generic filename to put autoloads into.
390 Unless you are an XEmacs maintainer, it is probably unwise to change this.")
392 (defvar autoload-target-directory "../lisp/"
393 "Directory to put autoload declaration file into.
394 Unless you know what you're doing, don't mess with this.")
396 (defvar generated-autoload-file
397 (expand-file-name (concat autoload-target-directory
400 "*File `update-file-autoloads' puts autoloads into.
401 A .el file can set this in its local variables section to make its
402 autoloads go somewhere else.
404 Note that `batch-update-directory' binds this variable to its own value,
405 generally the file named `autoload-file-name' in the directory being
408 (defconst cusload-file-name "custom-load.el"
409 "Generic filename to put custom loads into.
410 Unless you are an XEmacs maintainer, it is probably unwise to change this.")
413 (defun update-file-autoloads (file)
414 "Update the autoloads for FILE in `generated-autoload-file'
415 \(which FILE might bind in its local variables).
416 This function refuses to update autoloads files."
417 (interactive "fUpdate autoloads for file: ")
418 (setq file (expand-file-name file))
419 (when (and (file-newer-than-file-p file generated-autoload-file)
420 (not (member (file-name-nondirectory file)
421 (list autoload-file-name))))
423 (let ((load-name (replace-in-string (file-name-nondirectory file)
426 (trim-name (autoload-trim-file-name file))
429 (let ((find-file-hooks nil))
430 (set-buffer (or (get-file-buffer generated-autoload-file)
431 (find-file-noselect generated-autoload-file))))
432 ;; Make sure we can scribble in it.
433 (setq buffer-read-only nil)
434 ;; First delete all sections for this file.
435 (goto-char (point-min))
436 (while (search-forward generate-autoload-section-header nil t)
437 (setq section-begin (match-beginning 0))
438 (setq form (read (current-buffer)))
439 (when (string= (nth 2 form) load-name)
440 (search-forward generate-autoload-section-trailer)
441 (delete-region section-begin (point))))
443 ;; Now find insertion point for new section
444 (block find-insertion-point
445 (goto-char (point-min))
446 (while (search-forward generate-autoload-section-header nil t)
447 (setq form (read (current-buffer)))
448 (when (string< trim-name (nth 3 form))
449 ;; Found alphabetically correct insertion point
450 (goto-char (match-beginning 0))
451 (return-from find-insertion-point))
452 (search-forward generate-autoload-section-trailer))
453 (when (eq (point) (point-min)) ; No existing entries?
454 (goto-char (point-max)))) ; Append.
456 ;; Add in new sections for file
457 (generate-file-autoloads file))
459 (when (interactive-p) (save-buffer)))))
462 (defun update-autoloads-here ()
463 "Update sections of the current buffer generated by `update-file-autoloads'."
465 (let ((generated-autoload-file (buffer-file-name)))
467 (goto-char (point-min))
468 (while (search-forward generate-autoload-section-header nil t)
469 (let* ((form (condition-case ()
470 (read (current-buffer))
473 ;; XEmacs change: if we can't find the file as specified, look
474 ;; around a bit more.
475 (cond ((and (stringp file)
476 (or (get-file-buffer file)
477 (file-exists-p file))))
480 (let ((loc (locate-file (file-name-nondirectory file)
484 (setq loc (expand-file-name
485 (autoload-trim-file-name loc)
487 (if (or (get-file-buffer loc)
495 "Can't find library `%s'; remove its autoloads? "
500 (format "Find `%s' load file: "
505 (let ((begin (match-beginning 0)))
506 (search-forward generate-autoload-section-trailer)
507 (delete-region begin (point))))
509 (generate-file-autoloads file)))))))
512 (defun update-autoloads-from-directory (dir)
513 "Update `generated-autoload-file' with all the current autoloads from DIR.
514 This runs `update-file-autoloads' on each .el file in DIR.
515 Obsolete autoload entries for files that no longer exist are deleted.
516 Note that, if this function is called from `batch-update-directory',
517 `generated-autoload-file' was rebound in that function."
518 (interactive "DUpdate autoloads for directory: ")
519 (setq dir (expand-file-name dir))
520 (let ((simple-dir (file-name-as-directory
521 (file-name-nondirectory
522 (directory-file-name dir))))
523 (enable-local-eval nil))
525 (let ((find-file-hooks nil))
526 (set-buffer (find-file-noselect generated-autoload-file)))
527 (goto-char (point-min))
528 (while (search-forward generate-autoload-section-header nil t)
529 (let* ((begin (match-beginning 0))
530 (form (condition-case ()
531 (read (current-buffer))
534 (when (and (stringp file)
535 (string= (file-name-directory file) simple-dir)
538 (file-name-nondirectory file) dir))))
539 ;; Remove the obsolete section.
540 (search-forward generate-autoload-section-trailer)
541 (delete-region begin (point)))))
542 ;; Update or create autoload sections for existing files.
543 (mapcar 'update-file-autoloads (directory-files dir t "^[^=].*\\.el$"))
544 (unless noninteractive
548 (defun batch-update-autoloads ()
549 "Update the autoloads for the files or directories on the command line.
550 Runs `update-file-autoloads' on files and `update-directory-autoloads'
551 on directories. Must be used only with -batch, and kills Emacs on completion.
552 Each file will be processed even if an error occurred previously.
553 For example, invoke `xemacs -batch -f batch-update-autoloads *.el'.
554 The directory to which the auto-autoloads.el file must be the first parameter
555 on the command line."
556 (unless noninteractive
557 (error "batch-update-autoloads is to be used only with -batch"))
558 (let ((defdir (directory-file-name default-directory))
559 (enable-local-eval nil)) ; Don't query in batch mode.
560 ;; (message "Updating autoloads in %s..." generated-autoload-file)
561 (dolist (arg command-line-args-left)
562 (setq arg (expand-file-name arg defdir))
564 ((file-directory-p arg)
565 (message "Updating autoloads for directory %s..." arg)
566 (update-autoloads-from-directory arg))
568 (update-file-autoloads arg))
569 (t (error "No such file or directory: %s" arg))))
570 (fixup-autoload-buffer (concat (if autoload-package-name
571 autoload-package-name
572 (file-name-nondirectory defdir))
574 (save-some-buffers t)
578 (defun fixup-autoload-buffer (sym)
580 (set-buffer (find-file-noselect generated-autoload-file))
581 (goto-char (point-min))
582 (if (and (not (= (point-min) (point-max)))
583 (not (looking-at ";;; DO NOT MODIFY THIS FILE")))
585 (insert ";;; DO NOT MODIFY THIS FILE\n")
586 (insert "(if (featurep '" sym ")")
587 (insert " (error \"Already loaded\"))\n")
588 (goto-char (point-max))
589 (insert "\n(provide '" sym ")\n")))))
591 (defvar autoload-package-name nil)
593 ;; #### this function is almost identical to, but subtly different from,
594 ;; batch-update-autoloads. Both of these functions, unfortunately, are
595 ;; used in various build scripts in xemacs-packages. They should be
596 ;; merged. (However, it looks like no scripts pass more than one arg,
597 ;; making merging easy.) --ben
600 (defun batch-update-directory ()
601 "Update the autoloads for the directories on the command line.
602 Runs `update-file-autoloads' on each file in the given directory, and must
603 be used only with -batch."
604 (unless noninteractive
605 (error "batch-update-directory is to be used only with -batch"))
606 (let ((defdir default-directory)
607 (enable-local-eval nil)) ; Don't query in batch mode.
608 (dolist (arg command-line-args-left)
609 (setq arg (expand-file-name arg defdir))
610 (let ((generated-autoload-file (expand-file-name autoload-file-name
613 ((file-directory-p arg)
614 (message "Updating autoloads in directory %s..." arg)
615 (update-autoloads-from-directory arg))
616 (t (error "No such file or directory: %s" arg)))
617 (fixup-autoload-buffer (concat (if autoload-package-name
618 autoload-package-name
619 (file-name-nondirectory arg))
621 (save-some-buffers t))
625 (setq command-line-args-left nil)))
627 ;; #### i created the following. this one and the last should be merged into
628 ;; batch-update-autoloads and batch-update-one-directory. --ben
631 (defun batch-update-one-directory ()
632 "Update the autoloads for a single directory on the command line.
633 Runs `update-file-autoloads' on each file in the given directory, and must
634 be used only with -batch."
635 (unless noninteractive
636 (error "batch-update-directory is to be used only with -batch"))
637 (let ((defdir default-directory)
638 (enable-local-eval nil)) ; Don't query in batch mode.
639 (let ((arg (car command-line-args-left)))
640 (setq command-line-args-left (cdr command-line-args-left))
641 (setq arg (expand-file-name arg defdir))
642 (let ((generated-autoload-file (expand-file-name autoload-file-name
645 ((file-directory-p arg)
646 (message "Updating autoloads in directory %s..." arg)
647 (update-autoloads-from-directory arg))
648 (t (error "No such file or directory: %s" arg)))
649 (fixup-autoload-buffer (concat (if autoload-package-name
650 autoload-package-name
651 (file-name-nondirectory arg))
653 (save-some-buffers t))
659 ;;; autoload.el ends here