Mercurial > hg > xemacs-beta
annotate lisp/autoload.el @ 5176:8b2f75cecb89
rename objects* (.c, .h and .el files) to fontcolor*
-------------------- ChangeLog entries follow: --------------------
etc/ChangeLog addition:
2010-02-22 Ben Wing <ben@xemacs.org>
* dbxrc.in:
Rename objects.c -> fontcolor.c.
lisp/ChangeLog addition:
2010-02-22 Ben Wing <ben@xemacs.org>
* dumped-lisp.el (preloaded-file-list):
* font.el (font-tty-find-closest-color):
* fontcolor.el:
* fontcolor.el (ws-object-property-1): Removed.
* fontcolor.el (fontcolor-property-1): New.
* fontcolor.el (font-name):
* fontcolor.el (font-ascent):
* fontcolor.el (font-descent):
* fontcolor.el (font-width):
* fontcolor.el (font-height):
* fontcolor.el (font-proportional-p):
* fontcolor.el (font-properties):
* fontcolor.el (font-truename):
* fontcolor.el (color-name):
* fontcolor.el (color-rgb-components):
* x-faces.el:
Rename objects.el -> fontcolor.el.
lwlib/ChangeLog addition:
2010-02-22 Ben Wing <ben@xemacs.org>
* lwlib-colors.h:
objects*.h -> fontcolor*.h.
man/ChangeLog addition:
2010-02-22 Ben Wing <ben@xemacs.org>
* internals/internals.texi (A Summary of the Various XEmacs Modules):
* internals/internals.texi (Modules for other Display-Related Lisp Objects):
objects*.[ch] -> fontcolor*.[ch].
nt/ChangeLog addition:
2010-02-22 Ben Wing <ben@xemacs.org>
* xemacs.dsp:
* xemacs.mak:
* xemacs.mak (OPT_OBJS):
objects*.[ch] -> fontcolor*.[ch].
src/ChangeLog addition:
2010-02-22 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* Makefile.in.in (x_objs):
* Makefile.in.in (mswindows_objs):
* Makefile.in.in (tty_objs):
* Makefile.in.in (gtk_objs):
* Makefile.in.in (objs):
* console-tty.h:
* console-x-impl.h:
* console-x-impl.h (struct x_device):
* console-x.h:
* console-xlike-inc.h:
* depend:
* device-gtk.c:
* device-msw.c:
* device-x.c:
* device-x.c (x_init_device):
* device-x.c (x_finish_init_device):
* device.c:
* devslots.h (MARKED_SLOT):
* emacs.c (main_1):
* event-Xt.c:
* event-gtk.c:
* event-msw.c:
* faces.c:
* font-mgr.c:
* fontcolor-gtk-impl.h:
* fontcolor-gtk.c:
* fontcolor-gtk.c (syms_of_fontcolor_gtk):
* fontcolor-gtk.c (console_type_create_fontcolor_gtk):
* fontcolor-gtk.c (vars_of_fontcolor_gtk):
* fontcolor-gtk.h:
* fontcolor-impl.h:
* fontcolor-msw-impl.h:
* fontcolor-msw.c:
* fontcolor-msw.c (syms_of_fontcolor_mswindows):
* fontcolor-msw.c (console_type_create_fontcolor_mswindows):
* fontcolor-msw.c (reinit_vars_of_fontcolor_mswindows):
* fontcolor-msw.c (vars_of_fontcolor_mswindows):
* fontcolor-msw.h:
* fontcolor-msw.h (mswindows_color_to_string):
* fontcolor-tty-impl.h:
* fontcolor-tty.c:
* fontcolor-tty.c (syms_of_fontcolor_tty):
* fontcolor-tty.c (console_type_create_fontcolor_tty):
* fontcolor-tty.c (vars_of_fontcolor_tty):
* fontcolor-tty.h:
* fontcolor-x-impl.h:
* fontcolor-x.c:
* fontcolor-x.c (syms_of_fontcolor_x):
* fontcolor-x.c (console_type_create_fontcolor_x):
* fontcolor-x.c (vars_of_fontcolor_x):
* fontcolor-x.c (Xatoms_of_fontcolor_x):
* fontcolor-x.h:
* fontcolor.c:
* fontcolor.c (syms_of_fontcolor):
* fontcolor.c (specifier_type_create_fontcolor):
* fontcolor.c (reinit_specifier_type_create_fontcolor):
* fontcolor.c (reinit_vars_of_fontcolor):
* fontcolor.c (vars_of_fontcolor):
* fontcolor.h:
* fontcolor.h (set_face_boolean_attached_to):
* frame-gtk.c:
* frame-x.c:
* glyphs-eimage.c:
* glyphs-gtk.c:
* glyphs-msw.c:
* glyphs-widget.c:
* glyphs-x.c:
* glyphs.c:
* gtk-glue.c:
* gtk-glue.c (xemacs_type_register):
* gtk-xemacs.c:
* inline.c:
* intl-win32.c:
* lisp.h:
* lrecord.h:
* mule-charset.c:
* native-gtk-toolbar.c:
* redisplay-msw.c:
* redisplay-tty.c:
* redisplay.c:
* select-x.c:
* select.c:
* symsinit.h:
* toolbar-msw.c:
* toolbar-msw.c (TOOLBAR_ITEM_ID_BITS):
* toolbar-x.c:
* ui-gtk.c:
* window.c:
Rename objects*.[ch] -> fontcolor*.[ch]. Fix up all references to
the old files (e.g. in #include statements, Makefiles,
functions like syms_of_objects_x(), etc.).
tests/ChangeLog addition:
2010-02-22 Ben Wing <ben@xemacs.org>
* reproduce-crashes.el (8):
objects*.[ch] -> fontcolor*.[ch].
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 22 Feb 2010 06:49:30 -0600 |
parents | e29fcfd8df5f |
children | b0f4adffca7d |
rev | line source |
---|---|
1232 | 1 ;;; autoload.el --- maintain autoloads in auto-autoloads files. |
428 | 2 |
1753 | 3 ;; Copyright (C) 1991-1994, 1997, 2003 Free Software Foundation, Inc. |
428 | 4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp. |
2548 | 5 ;; Copyright (C) 1996, 2000, 2002, 2003, 2004 Ben Wing. |
428 | 6 |
2548 | 7 ;; Original Author: Roland McGrath <roland@gnu.ai.mit.edu> |
8 ;; Heavily Modified: XEmacs Maintainers | |
428 | 9 ;; Keywords: maint |
10 | |
11 ;; This file is part of XEmacs. | |
12 | |
13 ;; XEmacs is free software; you can redistribute it and/or modify it | |
14 ;; under the terms of the GNU General Public License as published by | |
15 ;; the Free Software Foundation; either version 2, or (at your option) | |
16 ;; any later version. | |
17 | |
18 ;; XEmacs is distributed in the hope that it will be useful, but | |
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
21 ;; General Public License for more details. | |
22 | |
23 ;; You should have received a copy of the GNU General Public License | |
24 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
26 ;; 02111-1307, USA. | |
27 | |
2548 | 28 ;;; Synched up with: FSF 21.2 by Ben Wing. |
29 ;;; Note that update-file-autoloads is seriously modified and not really | |
30 ;;; syncable. | |
428 | 31 |
32 ;;; Commentary: | |
33 | |
1232 | 34 ;; This code keeps auto-autoloads.el files up to date. It interprets |
35 ;; magic cookies (of the form ";;;###autoload" in Lisp source files | |
36 ;; and "/* ###autoload */" in C source files) in various useful ways. | |
2548 | 37 ;; It is also used to maintain custom-defines.el files, since most of |
38 ;; the logic for computing them is the same as for auto-autoloads.el. | |
1232 | 39 |
40 ;; Usage | |
41 ;; ===== | |
42 | |
43 ;; Recommended usage for this library, as implemented in the core | |
44 ;; build process, is | |
45 | |
46 ;; xemacs -no-packages -batch \ | |
2548 | 47 ;; -l autoload -f batch-update-directory-autoloads PREFIX DIRECTORY |
1232 | 48 |
49 ;; which causes XEmacs to update the file named by PATH from the .el | |
50 ;; files in DIRECTORY (but not recursing into subdirectories) and (if | |
51 ;; the autoload file is not already protected with a feature test) add | |
52 ;; a check and provide for 'PREFIX-autoloads. Currently there is no | |
53 ;; sanity check for the provided feature; it is recommended that you | |
54 ;; nuke any existing auto-autoloads.el before running the command. | |
55 | |
56 ;; There is not yet a recommended API for updating multiple directories | |
57 ;; into a single auto-autoloads file. Using the recipe above for each | |
58 ;; DIRECTORY with the same PATH should work but has not been tested. | |
59 ;; There is no API for recursing into subdirectories. There probably | |
60 ;; won't be; given the wide variety of ways that existing Lisp packages | |
61 ;; arrange their files, and the fact that source packages and installed | |
62 ;; packages have a somewhat different directory structure, this seems far | |
63 ;; too risky. Use a script or a Lisp library with an explicit list of | |
64 ;; PATHs; see update-elc.el for how to do this without recursive invocation | |
65 ;; of XEmacs). | |
66 | |
67 ;; The probable next step is to fix up the packages to use the | |
2548 | 68 ;; `batch-update-directory-autoloads' API. However, for backward |
1232 | 69 ;; compatibility with XEmacs 21.4 and 21.1, this can't be done quickly. |
70 | |
71 ;; For backward compatibility the API used in the packages/XEmacs.rules: | |
72 | |
73 ;; xemacs -vanilla -batch -eval "$(AUTOLOAD_PACKAGE_NAME)" \ | |
2548 | 74 ;; -l autoload -f batch-update-autoloads $(AUTOLOAD_PATH) |
1232 | 75 |
76 ;; is supported, and the implementation is unchanged. However, | |
77 ;; revision of the API (in a backward compatible way) and the | |
78 ;; implementation are planned, and until those stabilize it is too | |
79 ;; risky to use this version of XEmacs for package releases. | |
80 | |
81 ;; Implementation: | |
82 ;; =============== | |
83 | |
84 ;; #### This section should be moved to the Internals manual, or | |
85 ;; (maybe) the Lispref, and integrated with the information above. | |
86 ;; Don't believe anything written here; the code is still a mess, and | |
87 ;; this is a lot of guesswork. | |
88 | |
89 ;; Autoloads are used in a number of contexts, including core Lisp, | |
90 ;; packaged Lisp, and ELLs (dynamically loadable compiled objects | |
91 ;; providing Lisp functionality). There two general strategies for | |
92 ;; collecting autoloads. The first is to put autoloads for a package | |
93 ;; in a package-specific auto-autoloads file. This is easy to | |
94 ;; implement, and allows packages to be distributed with prebuilt | |
95 ;; auto-autoloads files. The second is to collect all the autoloads | |
96 ;; in a single global auto-autoloads file. This is alleged to speed | |
97 ;; up initialization significantly, but requires care to ensure that | |
98 ;; auto-autoloads files remain synchronized with the libraries. | |
99 | |
100 ;; The traditional logic for determining where to put autoload | |
101 ;; definitions is complex and is now deprecated. The special variable | |
102 ;; `generated-autoload-file' is used to hold the path to the file, and | |
103 ;; is initialized to the traditional (well, it's a new tradition with | |
104 ;; XEmacs 20) $blddir/lisp/auto-autoloads.el. However, this variable | |
105 ;; may be bound by calling code, or may be generated at collect time | |
106 ;; and I'm not even sure the initialized value was ever used any more. | |
107 | |
108 ;; Because there may be multiple auto-autoloads files in use (in XEmacs | |
109 ;; 21.x with a full complement of packages there are dozens), and they may | |
110 ;; contain initializations that would be dangerous to reexecute, each is | |
111 ;; protected by a feature test. By convention, the feature symbol is of | |
112 ;; the form "NAME-autoloads". For packages, the special variable | |
113 ;; `autoload-package-name' is used to determine NAME. In the core, | |
114 ;; autoloads are defined in the modules (all of which are collected in a | |
115 ;; single auto-autoloads file), using NAME=modules, in the lisp directory | |
116 ;; using NAME=lisp, and in the lisp/mule directory, using NAME=mule, for | |
117 ;; the autoloads feature. These latter are computed by the autoloads | |
118 ;; function at collect time. | |
428 | 119 |
120 ;; ChangeLog: | |
121 | |
1232 | 122 ;; See ./ChangeLog. |
428 | 123 |
124 ;;; Code: | |
125 | |
2548 | 126 ;; Need to load easy-mmode because we expand macro calls to easy-mmode |
127 ;; macros in make-autoloads below. | |
128 (require 'easy-mmode) | |
129 | |
1232 | 130 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
131 ;; Standard file and directory names | |
132 | |
133 ;; `autoload-file-name' is defvar'd and initialized in packages.el, | |
134 ;; which is loaded (and dumped) very early. If you find it isn't, you | |
135 ;; know what you're doing. | |
136 | |
137 (defconst autoload-target-directory "../lisp/" | |
138 "Standard directory containing autoload declaration file. | |
139 | |
140 Use `generated-autoload-file' (q.v.) to change its installation location.") | |
141 | |
142 ;; Dynamic variables for communication among functions | |
143 | |
2548 | 144 ;; FSF 21.2: |
145 ;; The autoload file is assumed to contain a trailer starting with a FormFeed | |
146 ;; character. | |
147 | |
1232 | 148 (defvar generated-autoload-file |
149 (expand-file-name autoload-file-name lisp-directory) | |
150 "*File `update-file-autoloads' puts autoloads into. | |
151 A .el file can set this in its local variables section to make its | |
152 autoloads go somewhere else. | |
153 | |
154 Note that `batch-update-directory' binds this variable to its own value, | |
155 generally the file named by `autoload-file-name' in the directory being | |
156 updated. XEmacs.rules setq's this variable for package autoloads.") | |
157 | |
2548 | 158 (defvar generate-autoload-function |
159 #'generate-file-autoloads | |
160 "Function to generate the autoloads for a file and insert at point. | |
161 Called with one argument, the file.") | |
162 | |
1232 | 163 (define-obsolete-variable-alias 'autoload-package-name |
164 'autoload-feature-prefix) | |
165 (defvar autoload-feature-prefix nil | |
166 "If non-nil, use this string to prefix the autoload feature name. | |
167 | |
168 Usually a package name (from AUTOLOAD_PACKAGE_NAME, defined in XEmacs.rules | |
169 in the top of the package hierarchy), or \"auto\" (reserved for the core Lisp | |
170 auto-autoloads file). Highest priority candidate except for an explicit | |
171 argument to `autoload-make-feature-name' (q.v.).") | |
172 | |
2548 | 173 (defvar autoload-feature-suffix "-autoloads" |
174 "String added to `autoload-feature-prefix' to create the autoload feature name.") | |
175 | |
1232 | 176 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
177 ;; Magic strings in source files | |
178 | |
179 (defconst generate-autoload-cookie ";;;###autoload" | |
180 "Magic comment indicating the following form should be autoloaded. | |
181 Used by `update-file-autoloads'. This string should be | |
182 meaningless to Lisp (e.g., a comment). | |
183 | |
184 This string is used: | |
185 | |
186 ;;;###autoload | |
187 \(defun function-to-be-autoloaded () ...) | |
188 | |
189 If this string appears alone on a line, the following form will be | |
190 read and an autoload made for it. If it is followed by the string | |
191 \"immediate\", then the form on the following line will be copied | |
192 verbatim. If there is further text on the line, that text will be | |
193 copied verbatim to `generated-autoload-file'.") | |
194 | |
195 (defconst generate-c-autoload-cookie "/* ###autoload" | |
196 "Magic C comment indicating the following form should be autoloaded. | |
197 Used by `update-file-autoloads'. This string should be | |
198 meaningless to C (e.g., a comment). | |
199 | |
200 This string is used: | |
201 | |
202 /* ###autoload */ | |
203 DEFUN (\"function-to-be-autoloaded\", ... ) | |
204 | |
205 If this string appears alone on a line, the following form will be | |
206 read and an autoload made for it. If there is further text on the line, | |
207 that text will be copied verbatim to `generated-autoload-file'.") | |
208 | |
209 (defconst generate-c-autoload-module "/* ###module" | |
210 "Magic C comment indicating the module containing autoloaded functions. | |
211 Since a module can consist of multiple C files, the module name may not be | |
212 the same as the C source file base name. In that case, use this comment to | |
213 indicate the actual name of the module from which to autoload functions.") | |
214 | |
215 (defconst generate-autoload-section-header "\f\n;;;### " | |
216 "String inserted before the form identifying | |
217 the section of autoloads for a file.") | |
218 | |
219 (defconst generate-autoload-section-trailer "\n;;;***\n" | |
220 "String which indicates the end of the section of autoloads for a file.") | |
221 | |
2548 | 222 (defconst generate-autoload-section-continuation ";;;;;; " |
223 "String to add on each continuation of the section header form.") | |
224 | |
1232 | 225 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
226 ;; Parsing the source file text. | |
2548 | 227 ;; Autoloads in C source differ from those in Lisp source. |
1232 | 228 |
4425
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
229 ; Add operator definitions to autoload-operators.el in the xemacs-base |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
230 ; package. |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
231 (ignore-errors (require 'autoload-operators)) |
4352
d2f4dd8611d9
Factor out lists of operators specially treated by 'make-autoload'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4332
diff
changeset
|
232 |
4425
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
233 ; As autoload-operators is new, provide stopgap measure for a while. |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
234 (if (not (boundp 'autoload-make-autoload-operators)) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
235 (progn |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
236 (defvar autoload-make-autoload-operators |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
237 '(defun define-skeleton defmacro define-derived-mode define-generic-mode |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
238 easy-mmode-define-minor-mode easy-mmode-define-global-mode |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
239 define-minor-mode defun* defmacro*) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
240 "`defun'-like operators that use `autoload' to load the library.") |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
241 |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
242 (defvar autoload-make-autoload-complex-operators |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
243 '(easy-mmode-define-minor-mode easy-mmode-define-global-mode |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
244 define-minor-mode) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
245 "`defun'-like operators to macroexpand before using `autoload'.") |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
246 |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
247 (put 'autoload 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
248 (put 'defun 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
249 (put 'defun* 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
250 (put 'defvar 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
251 (put 'defcustom 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
252 (put 'defconst 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
253 (put 'defmacro 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
254 (put 'defmacro* 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
255 (put 'defsubst 'doc-string-elt 3) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
256 (put 'define-skeleton 'doc-string-elt 2) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
257 (put 'define-derived-mode 'doc-string-elt 4) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
258 (put 'easy-mmode-define-minor-mode 'doc-string-elt 2) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
259 (put 'define-minor-mode 'doc-string-elt 2) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
260 (put 'define-generic-mode 'doc-string-elt 7) |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
261 ;; defin-global-mode has no explicit docstring. |
bfb8a26de3cb
Move autoload operator definitions to xemacs-base.
Mike Sperber <sperber@deinprogramm.de>
parents:
4352
diff
changeset
|
262 (put 'easy-mmode-define-global-mode 'doc-string-elt 1000))) |
4352
d2f4dd8611d9
Factor out lists of operators specially treated by 'make-autoload'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4332
diff
changeset
|
263 |
428 | 264 (defun make-autoload (form file) |
2548 | 265 "Turn FORM into an autoload or defvar for source file FILE. |
266 Returns nil if FORM is not a special autoload form (i.e. a function definition | |
267 or macro definition or a defcustom)." | |
268 (let ((car (car-safe form)) expand) | |
269 (cond | |
270 ;; For complex cases, try again on the macro-expansion. | |
4352
d2f4dd8611d9
Factor out lists of operators specially treated by 'make-autoload'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4332
diff
changeset
|
271 ((and (memq car autoload-make-autoload-complex-operators) |
2548 | 272 (setq expand (let ((load-file-name file)) (macroexpand form))) |
273 (eq (car expand) 'progn) | |
274 (memq :autoload-end expand)) | |
275 (let ((end (memq :autoload-end expand))) | |
276 ;; Cut-off anything after the :autoload-end marker. | |
277 (setcdr end nil) | |
278 (cons 'progn | |
279 (mapcar (lambda (form) (make-autoload form file)) | |
280 (cdr expand))))) | |
281 | |
282 ;; For special function-like operators, use the `autoload' function. | |
4352
d2f4dd8611d9
Factor out lists of operators specially treated by 'make-autoload'.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4332
diff
changeset
|
283 ((memq car autoload-make-autoload-operators) |
2548 | 284 (let* ((macrop (memq car '(defmacro defmacro*))) |
285 (name (nth 1 form)) | |
286 (body (nthcdr (get car 'doc-string-elt) form)) | |
4702
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
287 (doc (if (stringp (car body)) (pop body)))) |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
288 (if (memq car '(defmacro defmacro* defun defun*)) |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
289 (let ((arglist (nth 2 form)) |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
290 (placeholder (eval-when-compile (gensym)))) |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
291 (setq doc (concat (or doc "") |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
292 "\n\narguments: " |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
293 (replace-in-string |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
294 (cl-function-arglist placeholder arglist) |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
295 (format "^(%s ?" placeholder) |
eb1a409c317b
Unbreak autoload.el
Mike Sperber <sperber@deinprogramm.de>
parents:
4695
diff
changeset
|
296 "(") "\n")))) |
2548 | 297 ;; `define-generic-mode' quotes the name, so take care of that |
298 (list 'autoload (if (listp name) name (list 'quote name)) file doc | |
299 (or (and (memq car '(define-skeleton define-derived-mode | |
300 define-generic-mode | |
301 easy-mmode-define-global-mode | |
302 easy-mmode-define-minor-mode | |
303 define-minor-mode)) t) | |
304 (eq (car-safe (car body)) 'interactive)) | |
305 (if macrop (list 'quote 'macro) nil)))) | |
306 | |
307 ;; Convert defcustom to a simpler (and less space-consuming) defvar, | |
308 ;; but add some extra stuff if it uses :require. | |
309 ((eq car 'defcustom) | |
310 (let ((varname (car-safe (cdr-safe form))) | |
311 (init (car-safe (cdr-safe (cdr-safe form)))) | |
312 (doc (car-safe (cdr-safe (cdr-safe (cdr-safe form))))) | |
313 (rest (cdr-safe (cdr-safe (cdr-safe (cdr-safe form)))))) | |
314 (if (not (plist-get rest :require)) | |
315 `(defvar ,varname ,init ,doc) | |
316 `(progn | |
317 (defvar ,varname ,init ,doc) | |
318 (custom-add-to-group ,(plist-get rest :group) | |
319 ',varname 'custom-variable) | |
320 (custom-add-load ',varname | |
321 ,(plist-get rest :require)))))) | |
4303 | 322 ;; Coding systems. #### Would be nice to handle the docstring here too. |
323 ((memq car '(make-coding-system make-8-bit-coding-system)) | |
324 `(autoload-coding-system ,(nth 1 form) '(load ,file))) | |
2548 | 325 ;; nil here indicates that this is not a special autoload form. |
326 (t nil)))) | |
428 | 327 |
996 | 328 (defun make-c-autoload (module) |
329 "Make an autoload list for the DEFUN at point in MODULE. | |
330 Returns nil if the DEFUN is malformed." | |
331 (and | |
332 ;; Match the DEFUN | |
333 (search-forward "DEFUN" nil t) | |
334 ;; Match the opening parenthesis | |
335 (progn | |
336 (skip-syntax-forward " ") | |
337 (eq (char-after) ?\()) | |
338 ;; Match the opening quote of the Lisp function name | |
339 (progn | |
340 (forward-char) | |
341 (skip-syntax-forward " ") | |
342 (eq (char-after) ?\")) | |
343 ;; Extract the Lisp function name, interactive indicator, and docstring | |
344 (let* ((func-name (let ((begin (progn (forward-char) (point)))) | |
345 (search-forward "\"" nil t) | |
346 (backward-char) | |
347 (intern (buffer-substring begin (point))))) | |
348 (interact (progn | |
349 (search-forward "," nil t 4) | |
350 (skip-syntax-forward " ") | |
351 (not (eq (char-after) ?0)))) | |
352 (begin (progn | |
353 (search-forward "/*" nil t) | |
354 (forward-line 1) | |
355 (point)))) | |
356 (search-forward "*/" nil t) | |
357 (goto-char (match-beginning 0)) | |
358 (skip-chars-backward " \t\n\f") | |
359 (list 'autoload (list 'quote func-name) module | |
360 (buffer-substring begin (point)) interact nil)))) | |
361 | |
1232 | 362 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
363 ;; Generating autoloads for a single file | |
428 | 364 |
365 ;;;###autoload | |
2548 | 366 (defun generate-file-autoloads (file) |
1232 | 367 "Insert at point an autoload section for FILE. |
428 | 368 autoloads are generated for defuns and defmacros in FILE |
369 marked by `generate-autoload-cookie' (which see). | |
370 If FILE is being visited in a buffer, the contents of the buffer | |
371 are used." | |
372 (interactive "fGenerate autoloads for file: ") | |
1232 | 373 (cond ((string-match "\\.el$" file) |
2548 | 374 (generate-autoload-type-section |
1298 | 375 file |
376 (replace-in-string (file-name-nondirectory file) "\\.elc?$" "") | |
2548 | 377 nil #'generate-lisp-file-autoloads-1)) |
1232 | 378 ;; #### jj, are C++ modules possible? |
379 ((string-match "\\.c$" file) | |
2548 | 380 (generate-autoload-type-section |
1298 | 381 file |
382 (replace-in-string (file-name-nondirectory file) "\\.c$" "") | |
2548 | 383 t #'generate-c-file-autoloads-1)) |
1232 | 384 (t |
385 (error 'wrong-type-argument file "not a C or Elisp source file")))) | |
428 | 386 |
2548 | 387 (defun* generate-autoload-type-section (file load-name literal fun-to-call) |
1298 | 388 "Insert at point an autoload-type section for FILE. |
2548 | 389 LOAD-NAME is the non-directory portion of the name, with the final .el, .elc |
390 or .c section removed. If LITERAL, open the file literally, without decoding. | |
391 Calls FUN-TO-CALL to compute the autoloads, with the loaded file in the | |
392 current buffer, passing it OUTBUF (where to write the autoloads), LOAD-NAME, | |
393 and TRIM-NAME (result of calling `autoload-trim-file-name' on FILE)." | |
428 | 394 (let ((outbuf (current-buffer)) |
1298 | 395 (trim-name (autoload-trim-file-name file)) |
428 | 396 (autoloads-done '()) |
397 (print-length nil) | |
398 (print-readably t) ; XEmacs | |
399 (float-output-format nil) | |
1298 | 400 (visited (get-file-buffer file)) |
2548 | 401 suppress-form |
428 | 402 ;; (done-any nil) |
403 output-end) | |
404 | |
405 ;; If the autoload section we create here uses an absolute | |
406 ;; pathname for FILE in its header, and then Emacs is installed | |
407 ;; under a different path on another system, | |
408 ;; `update-autoloads-here' won't be able to find the files to be | |
409 ;; autoloaded. So, if FILE is in the same directory or a | |
410 ;; subdirectory of the current buffer's directory, we'll make it | |
411 ;; relative to the current buffer's directory. | |
412 (setq file (expand-file-name file)) | |
2548 | 413 ;; #### FSF 21.2. Do we want this? |
414 ; (let* ((source-truename (file-truename file)) | |
415 ; (dir-truename (file-name-as-directory | |
416 ; (file-truename default-directory))) | |
417 ; (len (length dir-truename))) | |
418 ; (if (and (< len (length source-truename)) | |
419 ; (string= dir-truename (substring source-truename 0 len))) | |
420 ; (setq file (substring source-truename len)))) | |
421 | |
422 ;; Check for suppression form (XEmacs) | |
423 (let* ((dir (file-name-directory file)) | |
424 (_pkg (expand-file-name "_pkg.el" dir)) | |
425 (pkg-vis (get-file-buffer _pkg)) | |
426 pkg-buf) | |
427 (save-excursion | |
428 (when (file-readable-p _pkg) | |
429 (unwind-protect | |
430 (progn | |
431 (let ((find-file-hooks nil) | |
432 (enable-local-variables nil)) | |
433 (set-buffer (or pkg-vis (find-file-noselect _pkg))) | |
434 (set-syntax-table emacs-lisp-mode-syntax-table)) | |
435 (save-excursion | |
436 (save-restriction | |
437 (widen) | |
438 (goto-char (point-min)) | |
439 (block nil | |
440 (while (search-forward "(package-suppress" nil t) | |
441 ;; skip over package-name | |
442 (forward-sexp 1) | |
443 (let ((supfile (read (current-buffer)))) | |
444 (when (equal supfile load-name) | |
445 (setq suppress-form (eval (read (current-buffer)))) | |
446 (return)))))))) | |
447 (unless pkg-vis | |
448 ;; We created this buffer, so we should kill it. | |
449 (if pkg-buf (kill-buffer pkg-buf))))))) | |
428 | 450 |
451 (save-excursion | |
452 (unwind-protect | |
453 (progn | |
2548 | 454 (let (;(find-file-hooks nil) |
455 ;(enable-local-variables nil) | |
456 ) | |
1298 | 457 (set-buffer (or visited (find-file-noselect file literal literal |
458 ))) | |
459 ;; This doesn't look right for C files, but it is. The only | |
460 ;; place we need the syntax table is when snarfing the Lisp | |
461 ;; function name. | |
460 | 462 (set-syntax-table emacs-lisp-mode-syntax-table)) |
2548 | 463 ; (if visited |
464 ; (set-buffer visited) | |
465 ; ;; It is faster to avoid visiting the file. | |
466 ; (set-buffer (get-buffer-create " *generate-autoload-file*")) | |
467 ; (kill-all-local-variables) | |
468 ; (erase-buffer) | |
469 ; (setq buffer-undo-list t | |
470 ; buffer-read-only nil) | |
471 ; ;; This doesn't look right for C files, but it is. The only | |
472 ; ;; place we need the syntax table is when snarfing the Lisp | |
473 ; ;; function name. | |
474 ; (emacs-lisp-mode) | |
475 ; (if literal | |
476 ; (insert-file-contents-literally file nil) | |
477 ; (insert-file-contents file nil))) | |
1298 | 478 (unless (setq autoloads-done |
2548 | 479 (funcall fun-to-call outbuf load-name trim-name)) |
480 (return-from generate-autoload-type-section)) | |
1298 | 481 ) |
428 | 482 (unless visited |
1298 | 483 ;; We created this buffer, so we should kill it. |
484 (kill-buffer (current-buffer))) | |
428 | 485 (set-buffer outbuf) |
486 (setq output-end (point-marker)))) | |
487 (if t ;; done-any | |
488 ;; XEmacs -- always do this so that we cache the information | |
489 ;; that we've processed the file already. | |
490 (progn | |
2548 | 491 ;; Insert the section-header line |
492 ;; which lists the file name and which functions are in it, etc. | |
428 | 493 (insert generate-autoload-section-header) |
2548 | 494 (prin1 (list 'autoloads autoloads-done load-name trim-name |
495 ;; In FSF 21.2. Also in FSF 19.30. Presumably | |
496 ;; deleted from XEmacs. | |
497 ;; (nth 5 (file-attributes file)) | |
498 ) | |
428 | 499 outbuf) |
500 (terpri outbuf) | |
2548 | 501 ;; #### Alas, we will have to think about this. Adding this means |
502 ;; that, once we have created or maintained an auto-autoloads file, | |
503 ;; we alone and our successors can update the file. The file itself | |
504 ;; will work fine in older XEmacsen, but they won't be able to | |
505 ;; update autoloads -- hence, to build. | |
506 ; ;; Break that line at spaces, to avoid very long lines. | |
507 ; ;; Make each sub-line into a comment. | |
508 ; (with-current-buffer outbuf | |
509 ; (save-excursion | |
510 ; (forward-line -1) | |
511 ; (while (not (eolp)) | |
512 ; (move-to-column 64) | |
513 ; (skip-chars-forward "^ \n") | |
514 ; (or (eolp) | |
515 ; (insert "\n" generate-autoload-section-continuation))))) | |
516 ;; XEmacs: This was commented out before. #### Correct? | |
517 ; (insert ";;; Generated autoloads from " | |
518 ; (autoload-trim-file-name file) "\n") | |
519 ;; XEmacs -- handle suppression | |
520 (when suppress-form | |
521 (insert "\n;;; Suppress form from _pkg.el\n") | |
522 (insert "(unless " (prin1-to-string suppress-form) "\n\n")) | |
428 | 523 (goto-char output-end) |
2548 | 524 ;; XEmacs -- handle suppression |
525 (when suppress-form | |
526 (insert "\n) ;; unless (suppressed)\n")) | |
428 | 527 (insert generate-autoload-section-trailer))) |
2548 | 528 )) |
529 | |
428 | 530 |
2548 | 531 (defun process-one-lisp-autoload (autoloads-done outbuf load-name) |
532 "Process a single autoload at point and write to OUTBUF. | |
533 Point should be just after a magic cookie string (e.g. ;;;###autoload). | |
534 Updates AUTOLOADS-DONE and returns the new value." | |
535 (skip-chars-forward " \t") | |
536 ;; (setq done-any t) | |
537 (if (eolp) | |
538 ;; Read the next form and make an autoload. | |
539 (let* ((form (prog1 (read (current-buffer)) | |
540 (or (bolp) (forward-line 1)))) | |
541 (autoload (make-autoload form load-name))) | |
542 (if autoload | |
543 (setq autoloads-done (cons (nth 1 form) | |
544 autoloads-done)) | |
545 (setq autoload form)) | |
546 (autoload-print-form autoload outbuf "")) | |
547 ;; Copy the rest of the line to the output. | |
548 (cond ((looking-at "immediate\\s *$") ; XEmacs | |
549 ;; This is here so that you can automatically | |
550 ;; have small hook functions copied to | |
551 ;; auto-autoloads.el so that it's not necessary | |
552 ;; to load a whole file just to get a two-line | |
553 ;; do-nothing find-file-hook... --Stig | |
554 (forward-line 1) | |
555 (let ((begin (point))) | |
556 (forward-sexp) | |
557 (forward-line 1) | |
4332
6ad202d453cb
Insert <immediate> into section header for immediate autoloads.
Mike Sperber <sperber@deinprogramm.de>
parents:
4303
diff
changeset
|
558 (princ (buffer-substring begin (point)) outbuf)) |
6ad202d453cb
Insert <immediate> into section header for immediate autoloads.
Mike Sperber <sperber@deinprogramm.de>
parents:
4303
diff
changeset
|
559 (setq autoloads-done (cons '<immediate> autoloads-done))) |
2548 | 560 (t |
561 (princ (buffer-substring | |
562 (progn | |
563 ;; Back up over whitespace, to preserve it. | |
564 (skip-chars-backward " \f\t") | |
565 (if (= (char-after (1+ (point))) ? ) | |
566 ;; Eat one space. | |
567 (forward-char 1)) | |
568 (point)) | |
569 (progn (forward-line 1) (point))) | |
570 outbuf)))) | |
571 autoloads-done) | |
572 | |
573 (defun* generate-lisp-file-autoloads-1 (outbuf load-name trim-name) | |
574 "Insert at point in OUTBUF an autoload section for an Elisp file. | |
575 The file is assumed to be already loaded and in the current buffer. | |
576 autoloads are generated for defuns and defmacros marked by | |
577 `generate-autoload-cookie' (which see)." | |
1298 | 578 (let ((autoloads-done '()) |
579 ) | |
580 (save-excursion | |
581 (save-restriction | |
582 (widen) | |
583 (goto-char (point-min)) | |
584 (unless (search-forward generate-autoload-cookie nil t) | |
585 (message "No autoloads found in %s" trim-name) | |
2548 | 586 (return-from generate-lisp-file-autoloads-1 nil)) |
1298 | 587 |
588 (message "Generating autoloads for %s..." trim-name) | |
589 (goto-char (point-min)) | |
2548 | 590 (while (not (eobp)) |
591 (skip-chars-forward " \t\n\f") | |
1298 | 592 (cond |
2548 | 593 ((looking-at (regexp-quote generate-autoload-cookie)) |
594 (search-forward generate-autoload-cookie) | |
595 (setq autoloads-done | |
596 (process-one-lisp-autoload autoloads-done outbuf load-name))) | |
1298 | 597 ((looking-at ";") |
598 ;; Don't read the comment. | |
599 (forward-line 1)) | |
600 (t | |
601 (forward-sexp 1) | |
602 (forward-line 1))) | |
2548 | 603 ))) |
604 (or noninteractive ; XEmacs: only need one line in -batch mode. | |
605 (message "Generating autoloads for %s...done" trim-name)) | |
1298 | 606 autoloads-done)) |
607 | |
2548 | 608 (defun* generate-c-file-autoloads-1 (outbuf load-name trim-name |
609 &optional funlist) | |
1232 | 610 "Insert at point an autoload section for the C file FILE. |
1048 | 611 autoloads are generated for defuns and defmacros in FILE |
996 | 612 marked by `generate-c-autoload-cookie' (which see). |
613 If FILE is being visited in a buffer, the contents of the buffer | |
614 are used." | |
1733 | 615 (let ((exists-p-format |
616 "(when (locate-file \"%s\" module-load-path module-extensions)\n") | |
617 autoloads-done) | |
996 | 618 (save-excursion |
1298 | 619 (save-restriction |
620 (widen) | |
621 (goto-char (point-min)) | |
622 ;; Is there a module name comment? | |
623 (when (search-forward generate-c-autoload-module nil t) | |
624 (skip-chars-forward " \t") | |
625 (let ((begin (point))) | |
626 (skip-chars-forward "^ \t\n\f") | |
627 (setq load-name (buffer-substring begin (point))))) | |
628 (if funlist | |
629 (progn | |
630 (message "Generating autoloads for %s..." trim-name) | |
1733 | 631 (princ (format exists-p-format load-name) outbuf) |
1298 | 632 (dolist (arg funlist) |
996 | 633 (goto-char (point-min)) |
1298 | 634 (re-search-forward |
635 (concat "DEFUN (\"" | |
636 (regexp-quote (symbol-name arg)) | |
637 "\"")) | |
638 (goto-char (match-beginning 0)) | |
639 (let ((autoload (make-c-autoload load-name))) | |
640 (when autoload | |
641 (push (nth 1 (nth 1 autoload)) autoloads-done) | |
2548 | 642 (autoload-print-form autoload outbuf " ")))) |
1298 | 643 ;; close the princ'd `when' form |
644 (princ ")" outbuf)) | |
645 (goto-char (point-min)) | |
646 (let ((match | |
647 (search-forward generate-c-autoload-cookie nil t))) | |
648 (unless match | |
649 (message "No autoloads found in %s" trim-name) | |
650 (return-from generate-c-file-autoloads-1 nil)) | |
651 | |
652 (message "Generating autoloads for %s..." trim-name) | |
1733 | 653 (princ (format exists-p-format load-name) outbuf) |
1298 | 654 (while match |
655 (forward-line 1) | |
656 (let ((autoload (make-c-autoload load-name))) | |
657 (when autoload | |
658 (push (nth 1 (nth 1 autoload)) autoloads-done) | |
2548 | 659 (autoload-print-form autoload outbuf " "))) |
1298 | 660 (setq match |
661 (search-forward generate-c-autoload-cookie nil t))) | |
662 ;; close the princ'd `when' form | |
663 (princ ")" outbuf))))) | |
2548 | 664 (or noninteractive ; XEmacs: only need one line in -batch mode. |
665 (message "Generating autoloads for %s...done" trim-name)) | |
1298 | 666 autoloads-done)) |
996 | 667 |
2548 | 668 ;;;###autoload |
669 (defun generate-custom-defines (file) | |
670 "Insert at point a custom-define section for FILE. | |
671 If FILE is being visited in a buffer, the contents of the buffer | |
672 are used." | |
673 (interactive "fGenerate custom defines for file: ") | |
674 (cond ((string-match "\\.el$" file) | |
675 (generate-autoload-type-section | |
676 file | |
677 (replace-in-string (file-name-nondirectory file) "\\.elc?$" "") | |
678 nil #'generate-custom-defines-1)) | |
679 ((string-match "\\.c$" file) | |
680 ;; no way to generate custom-defines for C files (currently?), | |
681 ;; but cannot signal an error. | |
682 nil) | |
683 (t | |
684 (error 'wrong-type-argument file "not a C or Elisp source file")))) | |
1232 | 685 |
2548 | 686 (defun* generate-custom-defines-1 (outbuf load-name trim-name) |
687 "Insert at point in OUTBUF a custom-define section for an Elisp file. | |
688 This contains all defcustoms and defgroups in the file. | |
689 The file is assumed to be already loaded and in the current buffer." | |
690 (let* ((search-regexp-1 "^(\\(defcustom\\|defgroup\\) ") | |
691 (search-string-2 ";;;###custom-define") | |
692 (search-regexp-2 (regexp-quote search-string-2)) | |
693 (autoloads-done '())) | |
694 (save-excursion | |
695 (save-restriction | |
696 (widen) | |
697 (goto-char (point-min)) | |
698 (unless (or (re-search-forward search-regexp-1 nil t) | |
699 (re-search-forward search-regexp-2 nil t)) | |
700 (message "No custom defines found in %s" trim-name) | |
701 (return-from generate-custom-defines-1 nil)) | |
702 (message "Generating custom defines for %s..." trim-name) | |
703 (princ "(defconst custom-define-current-source-file " outbuf) | |
704 (prin1 (file-relative-name (buffer-file-name) | |
705 (symbol-value-in-buffer 'default-directory | |
706 outbuf)) outbuf) | |
707 (princ ")\n" outbuf) | |
708 | |
709 (goto-char (point-min)) | |
710 (while (not (eobp)) | |
711 (skip-chars-forward " \t\n\f") | |
712 (cond | |
713 ((looking-at search-regexp-1) | |
714 ;; Read the next form and copy it to make an autoload. | |
715 (let* ((form (prog1 (read (current-buffer)) | |
716 (or (bolp) (forward-line 1)))) | |
717 (autoload form ;(make-autoload form load-name) | |
718 )) | |
719 (if autoload | |
720 (setq autoloads-done (cons (nth 1 form) | |
721 autoloads-done)) | |
722 (setq autoload form)) | |
723 (autoload-print-form autoload outbuf "")) | |
724 ) | |
725 ((looking-at search-regexp-2) | |
726 (search-forward search-string-2) | |
727 (beep) | |
728 (setq autoloads-done | |
729 (process-one-lisp-autoload autoloads-done outbuf load-name))) | |
730 ((looking-at ";") | |
731 ;; Don't read the comment. | |
732 (forward-line 1)) | |
733 (t | |
734 (forward-sexp 1) | |
735 (forward-line 1))) | |
736 ))) | |
737 (or noninteractive ; XEmacs: only need one line in -batch mode. | |
738 (message "Generating custom defines for %s...done" trim-name)) | |
739 autoloads-done)) | |
740 | |
741 ;; Assorted utilities for generating autoloads and pieces thereof | |
742 | |
743 (defun autoload-print-form (form outbuf margin) | |
996 | 744 "Print an autoload form, handling special characters. |
745 In particular, print docstrings with escapes inserted before left parentheses | |
746 at the beginning of lines and ^L characters." | |
2548 | 747 (cond |
748 ;; If the form is a sequence, recurse. | |
749 ((eq (car form) 'progn) | |
750 (mapcar #'(lambda (x) (autoload-print-form x outbuf margin)) | |
751 (cdr form))) | |
752 ;; Symbols at the toplevel are meaningless. | |
753 ((symbolp form) nil) | |
754 (t | |
755 (let ((doc-string-elt (get (car-safe form) 'doc-string-elt))) | |
756 (if (and doc-string-elt (stringp (nth doc-string-elt form))) | |
757 ;; We need to hack the printing because the doc-string must be | |
758 ;; printed specially for make-docfile (sigh). | |
759 (let* ((p (nthcdr (1- doc-string-elt) form)) | |
760 (elt (cdr p)) | |
761 (start-string (format "\n%s(" margin))) | |
762 (setcdr p nil) | |
763 (princ start-string outbuf) | |
764 ;; XEmacs change: don't let ^^L's get into | |
765 ;; the file or sorting is hard. | |
766 (let ((print-escape-newlines t) | |
767 ;;#### FSF 21.2 (print-escape-nonascii t) | |
768 (p (point outbuf)) | |
769 p2) | |
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4702
diff
changeset
|
770 (mapc #'(lambda (elt) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4702
diff
changeset
|
771 (prin1 elt outbuf) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4702
diff
changeset
|
772 (princ " " outbuf)) |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4702
diff
changeset
|
773 form) |
2548 | 774 (with-current-buffer outbuf |
775 (setq p2 (point-marker)) | |
776 (goto-char p) | |
777 (save-match-data | |
778 (while (search-forward "\^L" p2 t) | |
779 (delete-char -1) | |
780 (insert "\\^L"))) | |
781 (goto-char p2))) | |
782 (princ "\"\\\n" outbuf) | |
783 (let ((begin (point outbuf))) | |
784 (princ (substring (prin1-to-string (car elt)) 1) outbuf) | |
785 ;; Insert a backslash before each ( that appears at the beginning | |
786 ;; of a line in the doc string. | |
787 (with-current-buffer outbuf | |
788 (save-excursion | |
789 (while (search-backward start-string begin t) | |
790 (forward-char 1) | |
791 (insert "\\")))) | |
792 (if (null (cdr elt)) | |
793 (princ ")" outbuf) | |
794 (princ " " outbuf) | |
795 (princ (substring (prin1-to-string (cdr elt)) 1) outbuf)) | |
796 (terpri outbuf) | |
797 (princ margin outbuf))) | |
798 ;; XEmacs change: another ^L hack | |
799 (let ((p (point outbuf)) | |
800 (print-escape-newlines t) | |
801 ;;#### FSF 21.2 (print-escape-nonascii t) | |
996 | 802 p2) |
2548 | 803 (print form outbuf) |
804 (with-current-buffer outbuf | |
996 | 805 (setq p2 (point-marker)) |
806 (goto-char p) | |
807 (save-match-data | |
808 (while (search-forward "\^L" p2 t) | |
809 (delete-char -1) | |
810 (insert "\\^L"))) | |
2548 | 811 (goto-char p2)))))))) |
996 | 812 |
1232 | 813 (defun autoload-trim-file-name (file) |
814 "Returns relative pathname of FILE including the last directory. | |
428 | 815 |
1232 | 816 Hard-codes the directory separator as a forward slash." |
817 (setq file (expand-file-name file)) | |
818 (replace-in-string | |
819 (file-relative-name file (file-name-directory | |
820 (directory-file-name | |
821 (file-name-directory file)))) | |
822 ;; #### is this a good idea? | |
823 "\\\\" "/")) | |
428 | 824 |
2548 | 825 (defun autoload-read-section-header () |
826 "Read a section header form. | |
827 Since continuation lines have been marked as comments, | |
828 we must copy the text of the form and remove those comment | |
829 markers before we call `read'." | |
830 (save-match-data | |
831 (let ((beginning (point)) | |
832 string) | |
833 (forward-line 1) | |
834 (while (looking-at generate-autoload-section-continuation) | |
835 (forward-line 1)) | |
836 (setq string (buffer-substring beginning (point))) | |
837 (with-current-buffer (get-buffer-create " *autoload*") | |
838 (erase-buffer) | |
839 (insert string) | |
840 (goto-char (point-min)) | |
841 (while (search-forward generate-autoload-section-continuation nil t) | |
842 (replace-match " ")) | |
843 (goto-char (point-min)) | |
844 (read (current-buffer)))))) | |
845 | |
428 | 846 ;;;###autoload |
847 (defun update-file-autoloads (file) | |
848 "Update the autoloads for FILE in `generated-autoload-file' | |
849 \(which FILE might bind in its local variables). | |
1232 | 850 This function is a no-op for an autoloads file (ie, a file whose name is |
851 equal to `autoload-file-name')." | |
428 | 852 (interactive "fUpdate autoloads for file: ") |
853 (setq file (expand-file-name file)) | |
854 (when (and (file-newer-than-file-p file generated-autoload-file) | |
855 (not (member (file-name-nondirectory file) | |
856 (list autoload-file-name)))) | |
857 | |
858 (let ((load-name (replace-in-string (file-name-nondirectory file) | |
996 | 859 "\\.\\(elc?\\|c\\)$" |
428 | 860 "")) |
861 (trim-name (autoload-trim-file-name file)) | |
862 section-begin form) | |
863 (save-excursion | |
2548 | 864 ;; FSF has: [[ We want to get a value for generated-autoload-file |
865 ;; from the local variables section if it's there. ]] Not | |
866 ;; applicable in XEmacs, since we always keep the autoloads | |
867 ;; up-to-date. | |
868 | |
869 ;; #### FSF 21.2 adds: [[ We must read/write the file without any | |
870 ;; code conversion, but still decode EOLs. ]] Not clear if we need | |
871 ;; this. --ben | |
872 ;; (let ((coding-system-for-read 'raw-text)) | |
428 | 873 (let ((find-file-hooks nil)) |
874 (set-buffer (or (get-file-buffer generated-autoload-file) | |
875 (find-file-noselect generated-autoload-file)))) | |
2548 | 876 ;; FSF 21.2 says: |
877 | |
878 ;; [[ This is to make generated-autoload-file have Unix EOLs, so | |
879 ;; that it is portable to all platforms. ]] | |
880 ;; (setq buffer-file-coding-system 'raw-text-unix)) | |
881 ;; Not applicable in XEmacs, since we always keep the autoloads | |
882 ;; up-to-date and recompile when we build. | |
883 | |
884 ;; FSF 21.2: [not applicable to XEmacs] | |
885 ; (or (> (buffer-size) 0) | |
886 ; (error "Autoloads file %s does not exist" buffer-file-name)) | |
887 ; (or (file-writable-p buffer-file-name) | |
888 ; (error "Autoloads file %s is not writable" buffer-file-name)) | |
889 | |
890 ;; NOTE: The rest of this function is totally changed from FSF. | |
891 ;; Hence, not synched. | |
892 | |
428 | 893 ;; Make sure we can scribble in it. |
894 (setq buffer-read-only nil) | |
895 ;; First delete all sections for this file. | |
896 (goto-char (point-min)) | |
897 (while (search-forward generate-autoload-section-header nil t) | |
898 (setq section-begin (match-beginning 0)) | |
2548 | 899 (setq form (autoload-read-section-header)) |
428 | 900 (when (string= (nth 2 form) load-name) |
901 (search-forward generate-autoload-section-trailer) | |
902 (delete-region section-begin (point)))) | |
903 | |
904 ;; Now find insertion point for new section | |
905 (block find-insertion-point | |
906 (goto-char (point-min)) | |
907 (while (search-forward generate-autoload-section-header nil t) | |
2548 | 908 (setq form (autoload-read-section-header)) |
428 | 909 (when (string< trim-name (nth 3 form)) |
910 ;; Found alphabetically correct insertion point | |
911 (goto-char (match-beginning 0)) | |
912 (return-from find-insertion-point)) | |
913 (search-forward generate-autoload-section-trailer)) | |
914 (when (eq (point) (point-min)) ; No existing entries? | |
915 (goto-char (point-max)))) ; Append. | |
916 | |
917 ;; Add in new sections for file | |
2548 | 918 (funcall generate-autoload-function file)) |
428 | 919 |
920 (when (interactive-p) (save-buffer))))) | |
921 | |
1232 | 922 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
923 ;; Utilities for batch updates | |
924 | |
925 ;;;###autoload | |
2548 | 926 (defun batch-update-directory-autoloads () |
1232 | 927 "Update the autoloads for a directory, using a specified feature prefix. |
928 Must be used only with -batch. The feature prefix and directory to update | |
929 are taken from the first and second elements of `command-line-args-left', | |
930 respectively, and they are then removed from `command-line-args-left'. | |
931 | |
932 Runs `update-file-autoloads' on each file in the given directory. Always | |
933 rewrites the autoloads file, even if unchanged. Makes a feature name by | |
934 applying `autoload-make-feature-name' to the specified feature prefix. | |
935 | |
936 #### The API and semantics of this function are subject to change." | |
937 (unless noninteractive | |
2548 | 938 (error "batch-update-directory-autoloads: may be used only with -batch")) |
939 (update-autoload-files (list (cadr command-line-args-left)) | |
940 (car command-line-args-left) nil t) | |
941 (setq command-line-args-left (cddr command-line-args-left))) | |
1232 | 942 |
943 ;;;###autoload | |
2548 | 944 (defun batch-update-directory-custom-defines () |
945 "Update the custom defines for a directory, using a specified feature prefix. | |
946 Must be used only with -batch. The feature prefix and directory to update | |
947 are taken from the first and second elements of `command-line-args-left', | |
948 respectively, and they are then removed from `command-line-args-left'. | |
949 | |
950 Runs `update-file-autoloads' on each file in the given directory. Always | |
951 rewrites the autoloads file, even if unchanged. Makes a feature name by | |
952 applying `autoload-make-feature-name' to the specified feature prefix. | |
953 | |
954 #### The API and semantics of this function are subject to change." | |
955 (unless noninteractive | |
956 (error "batch-update-directory-custom-defines: may be used only with -batch")) | |
957 (update-custom-define-files (list (cadr command-line-args-left)) | |
958 (car command-line-args-left) nil t) | |
959 (setq command-line-args-left (cddr command-line-args-left))) | |
960 | |
961 ;;;###autoload | |
962 (defun update-autoload-files (files-or-dirs feature-prefix | |
963 &optional into-file force) | |
1232 | 964 "Update all the autoload files associated with FILES-OR-DIRS. |
965 FILES-OR-DIRS is a list of files and/or directories to be processed. | |
966 | |
967 An appropriate autoload file is chosen and a feature constructed for | |
968 each element of FILES-OR-DIRS. Fixup code testing for the autoload file's | |
969 feature and to provide the feature is added. | |
970 | |
2548 | 971 If optional INTO-FILE is non-`nil', it should specify a file into which |
972 the autoloads will be placed. Otherwise, the autoloads will be placed into | |
973 a file named `auto-autoloads.el' in the directory of each element in | |
974 FILES-OR-DIRS. | |
975 | |
976 FEATURE-PREFIX should be set to an appropriate prefix which will | |
977 be concatenated with \"-autoloads\" to produce the feature name. Otherwise | |
978 the appropriate autoload file for each file or directory (located in that | |
979 directory, or in the directory of the specified file) will be updated with | |
980 the directory's or file's autoloads and the protective forms will be added, | |
981 and the files will be saved. Use of the default here is unreliable, and | |
982 therefore deprecated. | |
1232 | 983 |
984 Note that if some of FILES-OR-DIRS are directories, recursion goes only | |
985 one level deep. | |
986 | |
987 If FORCE is non-nil, always save out the autoload files even if unchanged." | |
2548 | 988 (or (listp files-or-dirs) (setq files-or-dirs (list files-or-dirs))) |
1232 | 989 (let ((defdir (directory-file-name default-directory)) |
990 ;; value for all-into-one-file | |
2548 | 991 (autoload-feature-name (autoload-make-feature-name feature-prefix)) |
992 (enable-local-eval nil) ; Don't query in batch mode. | |
993 (autoload-feature-prefix feature-prefix) | |
994 ;; protect from change | |
995 (generated-autoload-file generated-autoload-file)) | |
1232 | 996 (dolist (arg files-or-dirs) |
997 (setq arg (expand-file-name arg defdir)) | |
998 (cond | |
999 ((file-directory-p arg) | |
2548 | 1000 (setq generated-autoload-file |
1001 (or into-file (expand-file-name autoload-file-name arg))) | |
1232 | 1002 (message "Updating autoloads for directory %s..." arg) |
2548 | 1003 (let ((simple-dir (file-name-as-directory |
1004 (file-name-nondirectory | |
1005 (directory-file-name arg)))) | |
1006 (enable-local-eval nil)) | |
1007 (save-excursion | |
1008 (let ((find-file-hooks nil)) | |
1009 (set-buffer (find-file-noselect generated-autoload-file))) | |
1010 (goto-char (point-min)) | |
1011 (while (search-forward generate-autoload-section-header nil t) | |
1012 (let* ((begin (match-beginning 0)) | |
1013 (form (autoload-read-section-header)) | |
1014 (file (nth 3 form))) | |
1015 (when (and (stringp file) | |
1016 (string= (file-name-directory file) simple-dir) | |
1017 (not (file-exists-p | |
1018 (expand-file-name | |
1019 (file-name-nondirectory file) arg)))) | |
1020 ;; Remove the obsolete section. | |
1021 (search-forward generate-autoload-section-trailer) | |
1022 (delete-region begin (point))))) | |
1023 ;; Update or create autoload sections for existing files. | |
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4702
diff
changeset
|
1024 (mapc 'update-file-autoloads |
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4702
diff
changeset
|
1025 (directory-files arg t "^[^=].*\\.\\(el\\|c\\)$"))))) |
1232 | 1026 ((file-exists-p arg) |
2548 | 1027 (setq generated-autoload-file |
1028 (or into-file (expand-file-name autoload-file-name | |
1029 (file-name-directory arg)))) | |
1232 | 1030 (update-file-autoloads arg)) |
1031 (t (error "No such file or directory: %s" arg))) | |
2548 | 1032 (when (not into-file) |
1232 | 1033 (autoload-featurep-protect-autoloads |
1034 (autoload-make-feature-name | |
2548 | 1035 (or feature-prefix |
1036 (file-name-nondirectory (directory-file-name arg))))) | |
1232 | 1037 (if force (set-buffer-modified-p |
1038 t (find-file-noselect generated-autoload-file))))) | |
2548 | 1039 (when into-file |
1232 | 1040 (autoload-featurep-protect-autoloads autoload-feature-name) |
1041 (if force (set-buffer-modified-p | |
2548 | 1042 t (find-file-noselect into-file)))) |
1232 | 1043 (save-some-buffers t) |
1044 )) | |
1045 | |
428 | 1046 ;;;###autoload |
2548 | 1047 (defun update-custom-define-files (files-or-dirs feature-prefix |
1048 &optional into-file force) | |
1049 "Update all the custom-define files associated with FILES-OR-DIRS. | |
1050 Works just like `update-file-autoloads'." | |
1051 (let* ((autoload-feature-suffix "-custom-defines") | |
1052 (autoload-file-name "custom-defines.el") | |
1053 (generate-autoload-function #'generate-custom-defines)) | |
1054 (update-autoload-files files-or-dirs feature-prefix into-file force))) | |
428 | 1055 |
1232 | 1056 (defun autoload-featurep-protect-autoloads (sym) |
428 | 1057 (save-excursion |
1058 (set-buffer (find-file-noselect generated-autoload-file)) | |
1059 (goto-char (point-min)) | |
2548 | 1060 (cond ((eq (point-min) (point-max)) nil) |
1061 ;; if there's some junk in the file but no sections, just | |
1062 ;; delete everything. the junk might be stuff inserted by | |
1063 ;; an older version of this function. | |
1064 ((not (search-forward generate-autoload-section-header nil t)) | |
1065 (delete-region (point-min) (point-max))) | |
1066 (t | |
1067 (goto-char (point-min)) | |
1068 (when (looking-at ";;; DO NOT MODIFY THIS FILE") | |
1069 (delete-region (point-min) | |
1070 (progn | |
1071 (search-forward generate-autoload-section-header) | |
1072 (match-beginning 0)))) | |
1073 ;; Determine and set the coding system for the file if under Mule. | |
1074 ;; If there are any extended characters in the input file, use | |
1075 ;; `escape-quoted' to make sure that both binary and extended | |
1076 ;; characters are output properly and distinguished properly. | |
1077 ;; Otherwise, use `raw-text' for maximum portability with non-Mule | |
1078 ;; Emacsen. | |
1079 (if (or (featurep '(not mule)) ;; Don't scan if no Mule support | |
1080 (progn | |
1081 (goto-char (point-min)) | |
1082 ;; mrb- There must be a better way than skip-chars-forward | |
1083 (skip-chars-forward (concat (char-to-string 0) "-" | |
1084 (char-to-string 255))) | |
1085 (eq (point) (point-max)))) | |
1086 (setq buffer-file-coding-system 'raw-text-unix) | |
1087 (setq buffer-file-coding-system 'escape-quoted)) | |
1088 (goto-char (point-min)) | |
1089 (insert ";;; DO NOT MODIFY THIS FILE") | |
1090 ;; NOTE: XEmacs prior to 21.5.12 or so had a bug in that it | |
1091 ;; recognized only one of the two magic-cookie styles (the -*- kind) | |
1092 ;; in find-file, but both of them in load. We go ahead and put both | |
1093 ;; in, just to be safe. | |
1094 (when (eq buffer-file-coding-system 'escape-quoted) | |
1095 (insert " -*- coding: escape-quoted; -*- | |
1096 \(or (featurep 'mule) (error \"Loading this file requires Mule support\")) | |
1097 ;;;###coding system: escape-quoted")) | |
1098 (insert "\n(if (featurep '" sym ")") | |
1099 (insert " (error \"Feature " sym " already loaded\"))\n") | |
1100 (goto-char (point-max)) | |
1101 (save-excursion | |
1102 (forward-line -1) | |
1103 (when (looking-at "(provide") | |
1104 (delete-region (point) (point-max)))) | |
1105 (unless (bolp) (insert "\n")) | |
1106 (unless (eq (char-before (1- (point))) ?\^L) | |
1107 (insert "\^L\n")) | |
1108 (insert "(provide '" sym ")\n"))))) | |
428 | 1109 |
1232 | 1110 (defun autoload-make-feature-name (&optional prefix) |
1111 "Generate the feature name to protect this auto-autoloads file from PREFIX. | |
428 | 1112 |
1232 | 1113 If PREFIX is nil, it defaults to the value of `autoload-feature-prefix' if |
1114 that is non-nil. | |
1115 | |
1116 The feature name must be globally unique for this version of XEmacs, | |
1117 including packages. | |
528 | 1118 |
1232 | 1119 For backward compatibility, if PREFIX and `autoload-feature-prefix' are both |
1120 `nil', PREFIX is computed as the last directory component of | |
1121 `generated-autoload-file'. This is likely to result in non-uniqueness, so | |
1122 do not use this feature." | |
1123 (concat | |
1124 (cond (prefix) | |
1125 (autoload-feature-prefix) | |
1126 ((stringp generated-autoload-file) | |
1127 (message "Warning: autoload computing feature prefix. | |
1128 You should specify it as an argument to `autoload-make-feature-name'.") | |
1129 (file-name-nondirectory | |
1130 (directory-file-name | |
1131 (file-name-directory generated-autoload-file)))) | |
1132 (t (error 'invalid-argument | |
1133 "Could not compute a feature name"))) | |
2548 | 1134 autoload-feature-suffix)) |
1232 | 1135 |
1136 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
1137 ;; Deprecated entry points | |
1138 | |
1139 ;; A grep of the core and packages shows use of `batch-update-autoloads' | |
1140 ;; by XEmacs.rules, pcomplete, eshell, oort-gnus; `batch-update-directory' | |
2548 | 1141 ;; by liece. The other two entry points (`batch-update-one-directory', |
1142 ;; `batch-force-update-one-directory') were not used at all. | |
1143 ;; | |
1144 ;; All except the first are now history. liece has been updated. | |
1145 ;; XEmacs.rules has been updated. The others will be, eventually. | |
528 | 1146 |
2548 | 1147 ;; There don't seem to be very many packages that use the first one (the |
1148 ;; "all-into-one-file" variety), and do they actually rely on this | |
1149 ;; functionality? --ben | |
1150 | |
1232 | 1151 ;; but XEmacs.rules does, though maybe it doesn't "rely" on it, and |
1152 ;; modules do now, and that relies on it. --sjt | |
528 | 1153 |
1154 ;;;###autoload | |
1155 (defun batch-update-autoloads () | |
1156 "Update the autoloads for the files or directories on the command line. | |
1157 Runs `update-file-autoloads' on files and `update-directory-autoloads' | |
1158 on directories. Must be used only with -batch, and kills Emacs on completion. | |
1159 Each file will be processed even if an error occurred previously. | |
1160 For example, invoke `xemacs -batch -f batch-update-autoloads *.el'. | |
1161 The directory to which the auto-autoloads.el file must be the first parameter | |
1162 on the command line." | |
1163 (unless noninteractive | |
1164 (error "batch-update-autoloads is to be used only with -batch")) | |
3431 | 1165 (update-autoload-files command-line-args-left autoload-feature-prefix |
1166 generated-autoload-file t) | |
528 | 1167 (kill-emacs 0)) |
442 | 1168 |
1232 | 1169 ;; Declare obsolescence |
1170 | |
1171 (make-obsolete-variable 'autoload-target-directory | |
1172 "Don't use this. Bind `generated-autoload-file' to an absolute path.") | |
1173 (make-obsolete 'batch-update-autoloads | |
1174 'autoload-update-directory-autoloads) | |
1175 | |
428 | 1176 (provide 'autoload) |
1177 | |
1178 ;;; autoload.el ends here |