Sync up with r21-4-11-chise-0_21-=gb2312.
[chise/xemacs-chise.git-] / lisp / autoload.el
1 ;;; autoload.el --- maintain autoloads in loaddefs.el.
2
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.
6
7 ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
8 ;; Keywords: maint
9
10 ;; This file is part of XEmacs.
11
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)
15 ;; any later version.
16
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.
21
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
25 ;; 02111-1307, USA.
26
27 ;;; Synched up with: Not synched with FSF.
28
29 ;;; Commentary:
30
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.
35
36 ;; ChangeLog:
37
38 ;; Sep-26-1997:  slb removed code dealing with customization.
39
40 ;;; Code:
41
42 (defun make-autoload (form file)
43   "Turn FORM, a defun or defmacro, into an autoload for source file FILE.
44 Returns nil if FORM is not a defun, define-skeleton or defmacro."
45   (let ((car (car-safe form)))
46     (if (memq car '(defun define-skeleton defmacro))
47         (let ((macrop (eq car 'defmacro))
48               name doc)
49           (setq form (cdr form)
50                 name (car form)
51                 ;; Ignore the arguments.
52                 form (cdr (if (eq car 'define-skeleton)
53                               form
54                             (cdr form)))
55                 doc (car form))
56           (if (stringp doc)
57               (setq form (cdr form))
58             (setq doc nil))
59           (list 'autoload (list 'quote name) file doc
60                 (or (eq car 'define-skeleton)
61                     (eq (car-safe (car form)) 'interactive))
62                 (if macrop (list 'quote 'macro) nil)))
63       nil)))
64
65 (put 'define-skeleton 'doc-string-elt 3)
66
67 (defvar generate-autoload-cookie ";;;###autoload"
68   "Magic comment indicating the following form should be autoloaded.
69 Used by `update-file-autoloads'.  This string should be
70 meaningless to Lisp (e.g., a comment).
71
72 This string is used:
73
74 ;;;###autoload
75 \(defun function-to-be-autoloaded () ...)
76
77 If this string appears alone on a line, the following form will be
78 read and an autoload made for it.  If it is followed by the string
79 \"immediate\", then the form on the following line will be copied
80 verbatim.  If there is further text on the line, that text will be
81 copied verbatim to `generated-autoload-file'.")
82
83 (defvar generate-autoload-section-header "\f\n;;;### "
84   "String inserted before the form identifying
85 the section of autoloads for a file.")
86
87 (defvar generate-autoload-section-trailer "\n;;;***\n"
88   "String which indicates the end of the section of autoloads for a file.")
89
90 (defvar autoload-package-name nil)
91
92 ;;; Forms which have doc-strings which should be printed specially.
93 ;;; A doc-string-elt property of ELT says that (nth ELT FORM) is
94 ;;; the doc-string in FORM.
95 ;;;
96 ;;; There used to be the following note here:
97 ;;; ;;; Note: defconst and defvar should NOT be marked in this way.
98 ;;; ;;; We don't want to produce defconsts and defvars that
99 ;;; ;;; make-docfile can grok, because then it would grok them twice,
100 ;;; ;;; once in foo.el (where they are given with ;;;###autoload) and
101 ;;; ;;; once in loaddefs.el.
102 ;;;
103 ;;; Counter-note: Yes, they should be marked in this way.
104 ;;; make-docfile only processes those files that are loaded into the
105 ;;; dumped Emacs, and those files should never have anything
106 ;;; autoloaded here.  The above-feared problem only occurs with files
107 ;;; which have autoloaded entries *and* are processed by make-docfile;
108 ;;; there should be no such files.
109
110 (put 'autoload 'doc-string-elt 3)
111 (put 'defun    'doc-string-elt 3)
112 (put 'defvar   'doc-string-elt 3)
113 (put 'defconst 'doc-string-elt 3)
114 (put 'defmacro 'doc-string-elt 3)
115
116 (defun autoload-trim-file-name (file)
117   "Returns a relative pathname of FILE including the last directory."
118   (setq file (expand-file-name file))
119   (replace-in-string
120    (file-relative-name file (file-name-directory
121                              (directory-file-name
122                               (file-name-directory file))))
123    "\\\\" "/"))
124
125 ;;;###autoload
126 (defun generate-file-autoloads (file &optional funlist)
127   "Insert at point a loaddefs autoload section for FILE.
128 autoloads are generated for defuns and defmacros in FILE
129 marked by `generate-autoload-cookie' (which see).
130 If FILE is being visited in a buffer, the contents of the buffer
131 are used."
132   (interactive "fGenerate autoloads for file: ")
133   (generate-file-autoloads-1 file funlist))
134
135 (defun* generate-file-autoloads-1 (file funlist)
136   "Insert at point a loaddefs autoload section for FILE.
137 autoloads are generated for defuns and defmacros in FILE
138 marked by `generate-autoload-cookie' (which see).
139 If FILE is being visited in a buffer, the contents of the buffer
140 are used."
141   (let ((outbuf (current-buffer))
142         (autoloads-done '())
143         (load-name (replace-in-string (file-name-nondirectory file)
144                                       "\\.elc?$"
145                                       ""))
146         (trim-name (autoload-trim-file-name file))
147         (dofiles (not (null funlist)))
148         (print-length nil)
149         (print-readably t) ; XEmacs
150         (float-output-format nil)
151         ;; (done-any nil)
152         (visited (get-file-buffer file))
153         output-end)
154
155     ;; If the autoload section we create here uses an absolute
156     ;; pathname for FILE in its header, and then Emacs is installed
157     ;; under a different path on another system,
158     ;; `update-autoloads-here' won't be able to find the files to be
159     ;; autoloaded.  So, if FILE is in the same directory or a
160     ;; subdirectory of the current buffer's directory, we'll make it
161     ;; relative to the current buffer's directory.
162     (setq file (expand-file-name file))
163
164     (save-excursion
165       (unwind-protect
166           (progn
167             (let ((find-file-hooks nil)
168                   (enable-local-variables nil))
169               (set-buffer (or visited (find-file-noselect file)))
170               (set-syntax-table lisp-mode-syntax-table))
171             (save-excursion
172               (save-restriction
173                 (widen)
174                 (goto-char (point-min))
175                 (unless (search-forward generate-autoload-cookie nil t)
176                   (message "No autoloads found in %s" trim-name)
177                   (return-from generate-file-autoloads-1))
178
179                 (message "Generating autoloads for %s..." trim-name)
180                 (goto-char (point-min))
181                 (while (if dofiles funlist (not (eobp)))
182                   (if (not dofiles)
183                       (skip-chars-forward " \t\n\f")
184                     (goto-char (point-min))
185                     (re-search-forward
186                      (concat "(def\\(un\\|var\\|const\\|macro\\) "
187                              (regexp-quote (symbol-name (car funlist)))
188                              "\\s "))
189                     (goto-char (match-beginning 0)))
190                   (cond
191                    ((or dofiles
192                         (looking-at (regexp-quote generate-autoload-cookie)))
193                     (if dofiles
194                         nil
195                       (search-forward generate-autoload-cookie)
196                       (skip-chars-forward " \t"))
197                     ;; (setq done-any t)
198                     (if (or dofiles (eolp))
199                         ;; Read the next form and make an autoload.
200                         (let* ((form (prog1 (read (current-buffer))
201                                        (or (bolp) (forward-line 1))))
202                                (autoload (make-autoload form load-name))
203                                (doc-string-elt (get (car-safe form)
204                                                     'doc-string-elt)))
205                           (if autoload
206                               (setq autoloads-done (cons (nth 1 form)
207                                                          autoloads-done))
208                             (setq autoload form))
209                           (if (and doc-string-elt
210                                    (stringp (nth doc-string-elt autoload)))
211                               ;; We need to hack the printing because the
212                               ;; doc-string must be printed specially for
213                               ;; make-docfile (sigh).
214                               (let* ((p (nthcdr (1- doc-string-elt)
215                                                 autoload))
216                                      (elt (cdr p)))
217                                 (setcdr p nil)
218                                 (princ "\n(" outbuf)
219                                 ;; XEmacs change: don't let ^^L's get into
220                                 ;; the file or sorting is hard.
221                                 (let ((print-escape-newlines t)
222                                       (p (save-excursion
223                                            (set-buffer outbuf)
224                                            (point)))
225                                       p2)
226                                   (mapcar (function (lambda (elt)
227                                                       (prin1 elt outbuf)
228                                                       (princ " " outbuf)))
229                                           autoload)
230                                   (save-excursion
231                                     (set-buffer outbuf)
232                                     (setq p2 (point-marker))
233                                     (goto-char p)
234                                     (save-match-data
235                                       (while (search-forward "\^L" p2 t)
236                                         (delete-char -1)
237                                         (insert "\\^L")))
238                                     (goto-char p2)
239                                     ))
240                                 (princ "\"\\\n" outbuf)
241                                 (let ((begin (save-excursion
242                                                (set-buffer outbuf)
243                                                (point))))
244                                   (princ (substring
245                                           (prin1-to-string (car elt)) 1)
246                                          outbuf)
247                                   ;; Insert a backslash before each ( that
248                                   ;; appears at the beginning of a line in
249                                   ;; the doc string.
250                                   (save-excursion
251                                     (set-buffer outbuf)
252                                     (save-excursion
253                                       (while (search-backward "\n(" begin t)
254                                         (forward-char 1)
255                                         (insert "\\"))))
256                                   (if (null (cdr elt))
257                                       (princ ")" outbuf)
258                                     (princ " " outbuf)
259                                     (princ (substring
260                                             (prin1-to-string (cdr elt))
261                                             1)
262                                            outbuf))
263                                   (terpri outbuf)))
264                             ;; XEmacs change: another fucking ^L hack
265                             (let ((p (save-excursion
266                                        (set-buffer outbuf)
267                                        (point)))
268                                   (print-escape-newlines t)
269                                   p2)
270                               (print autoload outbuf)
271                               (save-excursion
272                                 (set-buffer outbuf)
273                                 (setq p2 (point-marker))
274                                 (goto-char p)
275                                 (save-match-data
276                                   (while (search-forward "\^L" p2 t)
277                                     (delete-char -1)
278                                     (insert "\\^L")))
279                                 (goto-char p2)
280                                 ))
281                             ))
282                       ;; Copy the rest of the line to the output.
283                       (let ((begin (point)))
284                         ;; (terpri outbuf)
285                         (cond ((looking-at "immediate\\s *$") ; XEmacs
286                                ;; This is here so that you can automatically
287                                ;; have small hook functions copied to
288                                ;; loaddefs.el so that it's not necessary to
289                                ;; load a whole file just to get a two-line
290                                ;; do-nothing find-file-hook... --Stig
291                                (forward-line 1)
292                                (setq begin (point))
293                                (forward-sexp)
294                                (forward-line 1))
295                               (t
296                                (forward-line 1)))
297                         (princ (buffer-substring begin (point)) outbuf))))
298                    ((looking-at ";")
299                     ;; Don't read the comment.
300                     (forward-line 1))
301                    (t
302                     (forward-sexp 1)
303                     (forward-line 1)))
304                   (if dofiles
305                       (setq funlist (cdr funlist)))))))
306         (unless visited
307             ;; We created this buffer, so we should kill it.
308             (kill-buffer (current-buffer)))
309         (set-buffer outbuf)
310         (setq output-end (point-marker))))
311     (if t ;; done-any
312         ;; XEmacs -- always do this so that we cache the information
313         ;; that we've processed the file already.
314         (progn
315           (insert generate-autoload-section-header)
316           (prin1 (list 'autoloads autoloads-done load-name trim-name)
317                  outbuf)
318           (terpri outbuf)
319           ;;;; (insert ";;; Generated autoloads from "
320           ;;;;    (autoload-trim-file-name file) "\n")
321           ;; Warn if we put a line in loaddefs.el
322           ;; that is long enough to cause trouble.
323           (when (< output-end (point))
324             (setq output-end (point-marker)))
325           (while (< (point) output-end)
326             ;; (let ((beg (point)))
327               (end-of-line)
328               ;; Emacs -- I still haven't figured this one out.
329               ;; (if (> (- (point) beg) 900)
330                   ;; (progn
331                     ;; (message "A line is too long--over 900 characters")
332                     ;; (sleep-for 2)
333                     ;; (goto-char output-end)))
334               ;; )
335             (forward-line 1))
336           (goto-char output-end)
337           (insert generate-autoload-section-trailer)))
338     (or noninteractive ; XEmacs: only need one line in -batch mode.
339         (message "Generating autoloads for %s...done" file))))
340
341 \f
342 (defconst autoload-file-name "auto-autoloads.el"
343   "Generic filename to put autoloads into.
344 Unless you are an XEmacs maintainer, it is probably unwise to change this.")
345
346 (defvar autoload-target-directory "../lisp/"
347   "Directory to put autoload declaration file into.
348 Unless you know what you're doing, don't mess with this.")
349
350 (defvar generated-autoload-file
351   (expand-file-name (concat autoload-target-directory
352                             autoload-file-name)
353                     data-directory)
354   "*File `update-file-autoloads' puts autoloads into.
355 A .el file can set this in its local variables section to make its
356 autoloads go somewhere else.
357
358 Note that `batch-update-directory' binds this variable to its own value,
359 generally the file named `autoload-file-name' in the directory being
360 updated.")
361
362 (defconst cusload-file-name "custom-load.el"
363   "Generic filename to put custom loads into.
364 Unless you are an XEmacs maintainer, it is probably unwise to change this.")
365
366 ;;;###autoload
367 (defun update-file-autoloads (file)
368   "Update the autoloads for FILE in `generated-autoload-file'
369 \(which FILE might bind in its local variables).
370 This function refuses to update autoloads files."
371   (interactive "fUpdate autoloads for file: ")
372   (setq file (expand-file-name file))
373   (when (and (file-newer-than-file-p file generated-autoload-file)
374              (not (member (file-name-nondirectory file)
375                           (list autoload-file-name))))
376
377     (let ((load-name (replace-in-string (file-name-nondirectory file)
378                                         "\\.elc?$"
379                                         ""))
380           (trim-name (autoload-trim-file-name file))
381           section-begin form)
382       (save-excursion
383         (let ((find-file-hooks nil))
384           (set-buffer (or (get-file-buffer generated-autoload-file)
385                           (find-file-noselect generated-autoload-file))))
386         ;; Make sure we can scribble in it.
387         (setq buffer-read-only nil)
388         ;; First delete all sections for this file.
389         (goto-char (point-min))
390         (while (search-forward generate-autoload-section-header nil t)
391           (setq section-begin (match-beginning 0))
392           (setq form (read (current-buffer)))
393           (when (string= (nth 2 form) load-name)
394             (search-forward generate-autoload-section-trailer)
395             (delete-region section-begin (point))))
396
397         ;; Now find insertion point for new section
398         (block find-insertion-point
399           (goto-char (point-min))
400           (while (search-forward generate-autoload-section-header nil t)
401             (setq form (read (current-buffer)))
402             (when (string< trim-name (nth 3 form))
403               ;; Found alphabetically correct insertion point
404               (goto-char (match-beginning 0))
405               (return-from find-insertion-point))
406             (search-forward generate-autoload-section-trailer))
407           (when (eq (point) (point-min))        ; No existing entries?
408             (goto-char (point-max))))   ; Append.
409
410         ;; Add in new sections for file
411         (generate-file-autoloads file))
412
413       (when (interactive-p) (save-buffer)))))
414
415 ;;;###autoload
416 (defun update-autoloads-here ()
417   "Update sections of the current buffer generated by `update-file-autoloads'."
418   (interactive)
419   (let ((generated-autoload-file (buffer-file-name)))
420     (save-excursion
421       (goto-char (point-min))
422       (while (search-forward generate-autoload-section-header nil t)
423         (let* ((form (condition-case ()
424                          (read (current-buffer))
425                        (end-of-file nil)))
426                (file (nth 3 form)))
427           ;; XEmacs change: if we can't find the file as specified, look
428           ;; around a bit more.
429           (cond ((and (stringp file)
430                       (or (get-file-buffer file)
431                           (file-exists-p file))))
432                 ((and (stringp file)
433                       (save-match-data
434                         (let ((loc (locate-file (file-name-nondirectory file)
435                                                 load-path)))
436                           (if (null loc)
437                               nil
438                             (setq loc (expand-file-name
439                                        (autoload-trim-file-name loc)
440                                        ".."))
441                             (if (or (get-file-buffer loc)
442                                     (file-exists-p loc))
443                                 (setq file loc)
444                               nil))))))
445                 (t
446                  (setq file
447                        (if (y-or-n-p
448                             (format
449                              "Can't find library `%s'; remove its autoloads? "
450                              (nth 2 form) file))
451                            t
452                          (condition-case ()
453                              (read-file-name
454                               (format "Find `%s' load file: "
455                                       (nth 2 form))
456                               nil nil t)
457                            (quit nil))))))
458           (if file
459               (let ((begin (match-beginning 0)))
460                 (search-forward generate-autoload-section-trailer)
461                 (delete-region begin (point))))
462           (if (stringp file)
463               (generate-file-autoloads file)))))))
464
465 ;;;###autoload
466 (defun update-autoloads-from-directory (dir)
467   "Update `generated-autoload-file' with all the current autoloads from DIR.
468 This runs `update-file-autoloads' on each .el file in DIR.
469 Obsolete autoload entries for files that no longer exist are deleted.
470 Note that, if this function is called from `batch-update-directory',
471 `generated-autoload-file' was rebound in that function."
472   (interactive "DUpdate autoloads for directory: ")
473   (setq dir (expand-file-name dir))
474   (let ((simple-dir (file-name-as-directory
475                      (file-name-nondirectory
476                      (directory-file-name dir))))
477         (enable-local-eval nil))
478     (save-excursion
479       (let ((find-file-hooks nil))
480         (set-buffer (find-file-noselect generated-autoload-file)))
481       (goto-char (point-min))
482       (while (search-forward generate-autoload-section-header nil t)
483         (let* ((begin (match-beginning 0))
484                (form (condition-case ()
485                          (read (current-buffer))
486                        (end-of-file nil)))
487                (file (nth 3 form)))
488           (when (and (stringp file)
489                      (string= (file-name-directory file) simple-dir)
490                      (not (file-exists-p
491                            (expand-file-name
492                             (file-name-nondirectory file) dir))))
493             ;; Remove the obsolete section.
494             (search-forward generate-autoload-section-trailer)
495             (delete-region begin (point)))))
496       ;; Update or create autoload sections for existing files.
497       (mapcar 'update-file-autoloads (directory-files dir t "^[^=].*\\.el$"))
498       (unless noninteractive
499         (save-buffer)))))
500
501 ;;;###autoload
502 (defun batch-update-autoloads ()
503   "Update the autoloads for the files or directories on the command line.
504 Runs `update-file-autoloads' on files and `update-directory-autoloads'
505 on directories.  Must be used only with -batch, and kills Emacs on completion.
506 Each file will be processed even if an error occurred previously.
507 For example, invoke `xemacs -batch -f batch-update-autoloads *.el'.
508 The directory to which the auto-autoloads.el file must be the first parameter
509 on the command line."
510   (unless noninteractive
511     (error "batch-update-autoloads is to be used only with -batch"))
512   (let ((defdir default-directory)
513         (enable-local-eval nil))        ; Don't query in batch mode.
514     ;; (message "Updating autoloads in %s..." generated-autoload-file)
515     (dolist (arg command-line-args-left)
516       (setq arg (expand-file-name arg defdir))
517       (cond
518        ((file-directory-p arg)
519         (message "Updating autoloads for directory %s..." arg)
520         (update-autoloads-from-directory arg))
521        ((file-exists-p arg)
522         (update-file-autoloads arg))
523        (t (error "No such file or directory: %s" arg))))
524     (fixup-autoload-buffer (concat (if autoload-package-name
525                                        autoload-package-name
526                                      (file-name-nondirectory defdir))
527                                    "-autoloads"))
528     (save-some-buffers t)
529     ;; (message "Done")
530     (kill-emacs 0)))
531
532 (defun fixup-autoload-buffer (sym)
533   (save-excursion
534     (set-buffer (find-file-noselect generated-autoload-file))
535     (goto-char (point-min))
536     (if (and (not (= (point-min) (point-max)))
537              (not (looking-at ";;; DO NOT MODIFY THIS FILE")))
538         (progn
539           (insert ";;; DO NOT MODIFY THIS FILE\n")
540           (insert "(if (featurep '" sym ")")
541           (insert " (error \"Already loaded\"))\n")
542           (goto-char (point-max))
543           (insert "\n(provide '" sym ")\n")))))
544
545 (defvar autoload-package-name nil)
546
547 ;; #### this function is almost identical to, but subtly different from,
548 ;; batch-update-autoloads.  Both of these functions, unfortunately, are
549 ;; used in various build scripts in xemacs-packages.  They should be
550 ;; merged. (However, it looks like no scripts pass more than one arg,
551 ;; making merging easy.) --ben
552
553 ;;;###autoload
554 (defun batch-update-directory ()
555   "Update the autoloads for the directories on the command line.
556 Runs `update-file-autoloads' on each file in the given directory, and must
557 be used only with -batch."
558   (unless noninteractive
559     (error "batch-update-directory is to be used only with -batch"))
560   (let ((defdir default-directory)
561         (enable-local-eval nil))        ; Don't query in batch mode.
562     (dolist (arg command-line-args-left)
563       (setq arg (expand-file-name arg defdir))
564       (let ((generated-autoload-file (expand-file-name autoload-file-name
565                                                         arg)))
566         (cond
567          ((file-directory-p arg)
568           (message "Updating autoloads in directory %s..." arg)
569           (update-autoloads-from-directory arg))
570          (t (error "No such file or directory: %s" arg)))
571         (fixup-autoload-buffer (concat (if autoload-package-name
572                                            autoload-package-name
573                                          (file-name-nondirectory arg))
574                                 "-autoloads"))
575         (save-some-buffers t))
576       ;; (message "Done")
577       ;; (kill-emacs 0)
578       )
579     (setq command-line-args-left nil)))
580
581 ;; #### i created the following.  this one and the last should be merged into
582 ;; batch-update-autoloads and batch-update-one-directory. --ben
583
584 ;;;###autoload
585 (defun batch-update-one-directory ()
586   "Update the autoloads for a single directory on the command line.
587 Runs `update-file-autoloads' on each file in the given directory, and must
588 be used only with -batch."
589   (unless noninteractive
590     (error "batch-update-directory is to be used only with -batch"))
591   (let ((defdir default-directory)
592         (enable-local-eval nil))        ; Don't query in batch mode.
593     (let ((arg (car command-line-args-left)))
594       (setq command-line-args-left (cdr command-line-args-left))
595       (setq arg (expand-file-name arg defdir))
596       (let ((generated-autoload-file (expand-file-name autoload-file-name
597                                                         arg)))
598         (cond
599          ((file-directory-p arg)
600           (message "Updating autoloads in directory %s..." arg)
601           (update-autoloads-from-directory arg))
602          (t (error "No such file or directory: %s" arg)))
603         (fixup-autoload-buffer (concat (if autoload-package-name
604                                            autoload-package-name
605                                          (file-name-nondirectory arg))
606                                 "-autoloads"))
607         (save-some-buffers t))
608       ;; (message "Done")
609       )))
610
611 (provide 'autoload)
612
613 ;;; autoload.el ends here