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