Mercurial > emacs
annotate lib-src/make-docfile.c @ 5494:1ea2b4351945
[MSDOS]: #include "msdos.h" and <sys/param.h> needed for
the following changes.
(Ffile_name_directory, Fexpand_file_name) [FILE_SYSTEM_CASE]: Apply
case conversion if defined.
(Ffile_name_directory, Ffile_name_nondirectory, file_name_as_directory,
directory_file_name, Fexpand_file_name, Fsubstitute_in_file_name,
expand_and_dir_to_file) [MSDOS]: Drive letter support.
(Fexpand_file_name) [MSDOS]: Support for multiple default directories.
(Ffile_writeable_p) [MSDOS]: Don't call access with file name ending in slash.
(Finsert_file_contents) [MSDOS]: Determine file type by name (call
find-buffer-file-type) and change CR+LF to LF if it is a text file.
(Fwrite_region) [MSDOS]: Use text/binary mode as specified by buffer_file_type.
(syms_of_fileio) [MSDOS]: Set Qfind_buffer_file_type.
(Fsubstitute_in_file_name) [MSDOS]: Ignore case in environtment variable.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Sat, 08 Jan 1994 09:15:49 +0000 |
parents | 296db649863d |
children | 32ac07bd58ef |
rev | line source |
---|---|
24 | 1 /* Generate doc-string file for GNU Emacs from source files. |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
2 Copyright (C) 1985, 1986, 1992, 1993 Free Software Foundation, Inc. |
24 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
38 | 6 GNU Emacs is free software; you can redistribute it and/or modify |
7 it under the terms of the GNU General Public License as published by | |
638 | 8 the Free Software Foundation; either version 2, or (at your option) |
38 | 9 any later version. |
24 | 10 |
38 | 11 GNU Emacs is distributed in the hope that it will be useful, |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ | |
24 | 19 |
20 /* The arguments given to this program are all the C and Lisp source files | |
21 of GNU Emacs. .elc and .el and .c files are allowed. | |
22 A .o file can also be specified; the .c file it was made from is used. | |
23 This helps the makefile pass the correct list of files. | |
24 | |
25 The results, which go to standard output or to a file | |
26 specified with -a or -o (-a to append, -o to start from nothing), | |
27 are entries containing function or variable names and their documentation. | |
28 Each entry starts with a ^_ character. | |
29 Then comes F for a function or V for a variable. | |
30 Then comes the function or variable name, terminated with a newline. | |
31 Then comes the documentation for that function or variable. | |
32 */ | |
33 | |
34 #include <stdio.h> | |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
35 #ifdef MSDOS |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
36 #include <fcntl.h> |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
37 #endif /* MSDOS */ |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
38 |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
39 #ifdef MSDOS |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
40 #define READ_TEXT "rt" |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
41 #define READ_BINARY "rb" |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
42 #else /* not MSDOS */ |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
43 #define READ_TEXT "r" |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
44 #define READ_BINARY "r" |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
45 #endif /* not MSDOS */ |
24 | 46 |
47 FILE *outfile; | |
48 | |
49 main (argc, argv) | |
50 int argc; | |
51 char **argv; | |
52 { | |
53 int i; | |
54 int err_count = 0; | |
55 | |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
56 #ifdef MSDOS |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
57 _fmode = O_BINARY; /* all of files are treated as binary files */ |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
58 (stdout)->_flag &= ~_IOTEXT; |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
59 _setmode (fileno (stdout), O_BINARY); |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
60 #endif /* MSDOS */ |
24 | 61 outfile = stdout; |
62 | |
63 /* If first two args are -o FILE, output to FILE. */ | |
64 i = 1; | |
65 if (argc > i + 1 && !strcmp (argv[i], "-o")) | |
66 { | |
67 outfile = fopen (argv[i + 1], "w"); | |
68 i += 2; | |
69 } | |
70 if (argc > i + 1 && !strcmp (argv[i], "-a")) | |
71 { | |
72 outfile = fopen (argv[i + 1], "a"); | |
73 i += 2; | |
74 } | |
2814
0da5b58e98ed
Install patches from David J. Mackenzie to make the srcdir option
Jim Blandy <jimb@redhat.com>
parents:
2483
diff
changeset
|
75 if (argc > i + 1 && !strcmp (argv[i], "-d")) |
0da5b58e98ed
Install patches from David J. Mackenzie to make the srcdir option
Jim Blandy <jimb@redhat.com>
parents:
2483
diff
changeset
|
76 { |
0da5b58e98ed
Install patches from David J. Mackenzie to make the srcdir option
Jim Blandy <jimb@redhat.com>
parents:
2483
diff
changeset
|
77 chdir (argv[i + 1]); |
0da5b58e98ed
Install patches from David J. Mackenzie to make the srcdir option
Jim Blandy <jimb@redhat.com>
parents:
2483
diff
changeset
|
78 i += 2; |
0da5b58e98ed
Install patches from David J. Mackenzie to make the srcdir option
Jim Blandy <jimb@redhat.com>
parents:
2483
diff
changeset
|
79 } |
24 | 80 |
81 for (; i < argc; i++) | |
82 err_count += scan_file (argv[i]); /* err_count seems to be {mis,un}used */ | |
83 #ifndef VMS | |
84 exit (err_count); /* see below - shane */ | |
3028 | 85 #endif /* VMS */ |
24 | 86 } |
87 | |
164 | 88 /* Read file FILENAME and output its doc strings to outfile. */ |
24 | 89 /* Return 1 if file is not found, 0 if it is found. */ |
90 | |
91 scan_file (filename) | |
92 char *filename; | |
93 { | |
94 int len = strlen (filename); | |
95 if (!strcmp (filename + len - 4, ".elc")) | |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
96 return scan_lisp_file (filename, READ_BINARY); |
24 | 97 else if (!strcmp (filename + len - 3, ".el")) |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
98 return scan_lisp_file (filename, READ_TEXT); |
24 | 99 else |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
100 return scan_c_file (filename, READ_TEXT); |
24 | 101 } |
102 | |
103 char buf[128]; | |
104 | |
105 /* Skip a C string from INFILE, | |
106 and return the character that follows the closing ". | |
164 | 107 If printflag is positive, output string contents to outfile. |
24 | 108 If it is negative, store contents in buf. |
109 Convert escape sequences \n and \t to newline and tab; | |
110 discard \ followed by newline. */ | |
111 | |
112 read_c_string (infile, printflag) | |
113 FILE *infile; | |
114 int printflag; | |
115 { | |
116 register int c; | |
117 char *p = buf; | |
118 | |
119 c = getc (infile); | |
120 while (c != EOF) | |
121 { | |
122 while (c != '"' && c != EOF) | |
123 { | |
124 if (c == '\\') | |
125 { | |
126 c = getc (infile); | |
127 if (c == '\n') | |
128 { | |
129 c = getc (infile); | |
130 continue; | |
131 } | |
132 if (c == 'n') | |
133 c = '\n'; | |
134 if (c == 't') | |
135 c = '\t'; | |
136 } | |
137 if (printflag > 0) | |
138 putc (c, outfile); | |
139 else if (printflag < 0) | |
140 *p++ = c; | |
141 c = getc (infile); | |
142 } | |
143 c = getc (infile); | |
144 if (c != '"') | |
145 break; | |
4987
f052db139432
(read_c_string): For "", concatenate the two strings.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
146 /* If we had a "", concatenate the two strings. */ |
24 | 147 c = getc (infile); |
148 } | |
149 | |
150 if (printflag < 0) | |
151 *p = 0; | |
152 | |
153 return c; | |
154 } | |
155 | |
156 /* Write to file OUT the argument names of the function whose text is in BUF. | |
157 MINARGS and MAXARGS are the minimum and maximum number of arguments. */ | |
158 | |
159 write_c_args (out, buf, minargs, maxargs) | |
160 FILE *out; | |
161 char *buf; | |
162 int minargs, maxargs; | |
163 { | |
1206 | 164 register char *p; |
1250 | 165 int in_ident = 0; |
166 int just_spaced = 0; | |
24 | 167 |
168 | 168 fprintf (out, "arguments: "); |
24 | 169 |
1206 | 170 for (p = buf; *p; p++) |
24 | 171 { |
1250 | 172 char c = *p; |
2483
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
173 int ident_start = 0; |
1250 | 174 |
175 /* Notice when we start printing a new identifier. */ | |
176 if ((('A' <= c && c <= 'Z') | |
177 || ('a' <= c && c <= 'z') | |
178 || ('0' <= c && c <= '9') | |
179 || c == '_') | |
180 != in_ident) | |
24 | 181 { |
1250 | 182 if (!in_ident) |
183 { | |
184 in_ident = 1; | |
2483
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
185 ident_start = 1; |
1206 | 186 |
1250 | 187 if (minargs == 0 && maxargs > 0) |
188 fprintf (out, "&optional "); | |
189 just_spaced = 1; | |
1206 | 190 |
1250 | 191 minargs--; |
192 maxargs--; | |
193 } | |
194 else | |
195 in_ident = 0; | |
24 | 196 } |
638 | 197 |
1250 | 198 /* Print the C argument list as it would appear in lisp: |
199 print underscores as hyphens, and print commas as spaces. | |
200 Collapse adjacent spaces into one. */ | |
201 if (c == '_') c = '-'; | |
202 if (c == ',') c = ' '; | |
203 | |
2483
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
204 /* In C code, `default' is a reserved word, so we spell it |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
205 `defalt'; unmangle that here. */ |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
206 if (ident_start |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
207 && strncmp (p, "defalt", 6) == 0 |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
208 && ! (('A' <= p[6] && p[6] <= 'Z') |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
209 || ('a' <= p[6] && p[6] <= 'z') |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
210 || ('0' <= p[6] && p[6] <= '9') |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
211 || p[6] == '_')) |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
212 { |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
213 fprintf (out, "default"); |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
214 p += 5; |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
215 in_ident = 0; |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
216 just_spaced = 0; |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
217 } |
b4145a12422d
* make-docfile.c (write_c_args): Print an argument named "defalt"
Jim Blandy <jimb@redhat.com>
parents:
1676
diff
changeset
|
218 else if (c != ' ' || ! just_spaced) |
1250 | 219 putc (c, out); |
220 | |
221 just_spaced = (c == ' '); | |
24 | 222 } |
223 } | |
224 | |
225 /* Read through a c file. If a .o file is named, | |
226 the corresponding .c file is read instead. | |
227 Looks for DEFUN constructs such as are defined in ../src/lisp.h. | |
228 Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */ | |
229 | |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
230 scan_c_file (filename, mode) |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
231 char *filename, *mode; |
24 | 232 { |
233 FILE *infile; | |
234 register int c; | |
235 register int commas; | |
236 register int defunflag; | |
1676
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
237 register int defvarperbufferflag; |
24 | 238 register int defvarflag; |
239 int minargs, maxargs; | |
240 | |
241 if (filename[strlen (filename) - 1] == 'o') | |
242 filename[strlen (filename) - 1] = 'c'; | |
243 | |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
244 infile = fopen (filename, mode); |
24 | 245 |
246 /* No error if non-ex input file */ | |
247 if (infile == NULL) | |
248 { | |
249 perror (filename); | |
250 return 0; | |
251 } | |
252 | |
253 c = '\n'; | |
254 while (!feof (infile)) | |
255 { | |
256 if (c != '\n') | |
257 { | |
258 c = getc (infile); | |
259 continue; | |
260 } | |
261 c = getc (infile); | |
262 if (c == ' ') | |
263 { | |
264 while (c == ' ') | |
265 c = getc (infile); | |
266 if (c != 'D') | |
267 continue; | |
268 c = getc (infile); | |
269 if (c != 'E') | |
270 continue; | |
271 c = getc (infile); | |
272 if (c != 'F') | |
273 continue; | |
274 c = getc (infile); | |
275 if (c != 'V') | |
276 continue; | |
1676
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
277 c = getc (infile); |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
278 if (c != 'A') |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
279 continue; |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
280 c = getc (infile); |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
281 if (c != 'R') |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
282 continue; |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
283 c = getc (infile); |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
284 if (c != '_') |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
285 continue; |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
286 |
24 | 287 defvarflag = 1; |
288 defunflag = 0; | |
1676
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
289 |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
290 c = getc (infile); |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
291 defvarperbufferflag = (c == 'P'); |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
292 |
24 | 293 c = getc (infile); |
294 } | |
295 else if (c == 'D') | |
296 { | |
297 c = getc (infile); | |
298 if (c != 'E') | |
299 continue; | |
300 c = getc (infile); | |
301 if (c != 'F') | |
302 continue; | |
303 c = getc (infile); | |
304 defunflag = c == 'U'; | |
305 defvarflag = 0; | |
306 } | |
307 else continue; | |
308 | |
309 while (c != '(') | |
310 { | |
311 if (c < 0) | |
312 goto eof; | |
313 c = getc (infile); | |
314 } | |
315 | |
316 c = getc (infile); | |
317 if (c != '"') | |
318 continue; | |
319 c = read_c_string (infile, -1); | |
320 | |
321 if (defunflag) | |
322 commas = 5; | |
1676
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
323 else if (defvarperbufferflag) |
e8b3c6b52c1e
* make-docfile.c (scan_c_file): Since DEFVAR_PER_BUFFER now takes
Jim Blandy <jimb@redhat.com>
parents:
1250
diff
changeset
|
324 commas = 2; |
24 | 325 else if (defvarflag) |
326 commas = 1; | |
327 else /* For DEFSIMPLE and DEFPRED */ | |
328 commas = 2; | |
329 | |
330 while (commas) | |
331 { | |
332 if (c == ',') | |
333 { | |
334 commas--; | |
335 if (defunflag && (commas == 1 || commas == 2)) | |
336 { | |
337 do | |
338 c = getc (infile); | |
339 while (c == ' ' || c == '\n' || c == '\t'); | |
340 if (c < 0) | |
341 goto eof; | |
342 ungetc (c, infile); | |
343 if (commas == 2) /* pick up minargs */ | |
344 fscanf (infile, "%d", &minargs); | |
345 else /* pick up maxargs */ | |
346 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ | |
347 maxargs = -1; | |
348 else | |
349 fscanf (infile, "%d", &maxargs); | |
350 } | |
351 } | |
352 if (c < 0) | |
353 goto eof; | |
354 c = getc (infile); | |
355 } | |
356 while (c == ' ' || c == '\n' || c == '\t') | |
357 c = getc (infile); | |
358 if (c == '"') | |
359 c = read_c_string (infile, 0); | |
360 while (c != ',') | |
361 c = getc (infile); | |
362 c = getc (infile); | |
363 while (c == ' ' || c == '\n' || c == '\t') | |
364 c = getc (infile); | |
365 | |
366 if (c == '"') | |
367 { | |
368 putc (037, outfile); | |
369 putc (defvarflag ? 'V' : 'F', outfile); | |
370 fprintf (outfile, "%s\n", buf); | |
168 | 371 c = read_c_string (infile, 1); |
372 | |
373 /* If this is a defun, find the arguments and print them. If | |
374 this function takes MANY or UNEVALLED args, then the C source | |
375 won't give the names of the arguments, so we shouldn't bother | |
376 trying to find them. */ | |
377 if (defunflag && maxargs != -1) | |
24 | 378 { |
379 char argbuf[1024], *p = argbuf; | |
380 while (c != ')') | |
381 { | |
382 if (c < 0) | |
383 goto eof; | |
384 c = getc (infile); | |
385 } | |
386 /* Skip into arguments. */ | |
387 while (c != '(') | |
388 { | |
389 if (c < 0) | |
390 goto eof; | |
391 c = getc (infile); | |
392 } | |
393 /* Copy arguments into ARGBUF. */ | |
394 *p++ = c; | |
395 do | |
396 *p++ = c = getc (infile); | |
397 while (c != ')'); | |
398 *p = '\0'; | |
399 /* Output them. */ | |
400 fprintf (outfile, "\n\n"); | |
401 write_c_args (outfile, argbuf, minargs, maxargs); | |
402 } | |
403 } | |
404 } | |
405 eof: | |
406 fclose (infile); | |
407 return 0; | |
408 } | |
409 | |
410 /* Read a file of Lisp code, compiled or interpreted. | |
411 Looks for | |
412 (defun NAME ARGS DOCSTRING ...) | |
753 | 413 (defmacro NAME ARGS DOCSTRING ...) |
414 (autoload (quote NAME) FILE DOCSTRING ...) | |
24 | 415 (defvar NAME VALUE DOCSTRING) |
416 (defconst NAME VALUE DOCSTRING) | |
753 | 417 (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) |
418 (fset (quote NAME) #[... DOCSTRING ...]) | |
2966
e936d56c2354
(scan_lisp_file): Recognize defalias like fset.
Richard M. Stallman <rms@gnu.org>
parents:
2814
diff
changeset
|
419 (defalias (quote NAME) #[... DOCSTRING ...]) |
24 | 420 starting in column zero. |
753 | 421 (quote NAME) may appear as 'NAME as well. |
422 For defun, defmacro, and autoload, we know how to skip over the arglist. | |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3028
diff
changeset
|
423 For defvar, defconst, and fset we skip to the docstring with a kludgy |
753 | 424 formatting convention: all docstrings must appear on the same line as the |
425 initial open-paren (the one in column zero) and must contain a backslash | |
426 and a double-quote immediately after the initial double-quote. No newlines | |
427 must appear between the beginning of the form and the first double-quote. | |
428 The only source file that must follow this convention is loaddefs.el; aside | |
429 from that, it is always the .elc file that we look at, and they are no | |
430 problem because byte-compiler output follows this convention. | |
24 | 431 The NAME and DOCSTRING are output. |
432 NAME is preceded by `F' for a function or `V' for a variable. | |
433 An entry is output only if DOCSTRING has \ newline just after the opening " | |
434 */ | |
435 | |
753 | 436 void |
437 skip_white (infile) | |
438 FILE *infile; | |
439 { | |
440 char c = ' '; | |
441 while (c == ' ' || c == '\t' || c == '\n') | |
442 c = getc (infile); | |
443 ungetc (c, infile); | |
444 } | |
445 | |
446 void | |
447 read_lisp_symbol (infile, buffer) | |
448 FILE *infile; | |
449 char *buffer; | |
450 { | |
451 char c; | |
452 char *fillp = buffer; | |
453 | |
454 skip_white (infile); | |
455 while (1) | |
456 { | |
457 c = getc (infile); | |
458 if (c == '\\') | |
459 *(++fillp) = getc (infile); | |
460 else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')') | |
461 { | |
462 ungetc (c, infile); | |
463 *fillp = 0; | |
464 break; | |
465 } | |
466 else | |
467 *fillp++ = c; | |
468 } | |
469 | |
470 if (! buffer[0]) | |
471 fprintf (stderr, "## expected a symbol, got '%c'\n", c); | |
472 | |
473 skip_white (infile); | |
474 } | |
475 | |
476 | |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
477 scan_lisp_file (filename, mode) |
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
478 char *filename, *mode; |
24 | 479 { |
480 FILE *infile; | |
481 register int c; | |
482 | |
5449
296db649863d
[MSDOS]: Use text/binary mode as appropriate.
Richard M. Stallman <rms@gnu.org>
parents:
5317
diff
changeset
|
483 infile = fopen (filename, mode); |
24 | 484 if (infile == NULL) |
485 { | |
486 perror (filename); | |
487 return 0; /* No error */ | |
488 } | |
489 | |
490 c = '\n'; | |
491 while (!feof (infile)) | |
492 { | |
753 | 493 char buffer [BUFSIZ]; |
494 char *fillp = buffer; | |
495 char type; | |
496 | |
24 | 497 if (c != '\n') |
498 { | |
499 c = getc (infile); | |
500 continue; | |
501 } | |
502 c = getc (infile); | |
503 if (c != '(') | |
504 continue; | |
164 | 505 |
753 | 506 read_lisp_symbol (infile, buffer); |
507 | |
508 if (! strcmp (buffer, "defun") || | |
509 ! strcmp (buffer, "defmacro")) | |
24 | 510 { |
753 | 511 type = 'F'; |
512 read_lisp_symbol (infile, buffer); | |
513 | |
514 /* Skip the arguments: either "nil" or a list in parens */ | |
24 | 515 |
516 c = getc (infile); | |
753 | 517 if (c == 'n') /* nil */ |
518 { | |
519 if ((c = getc (infile)) != 'i' || | |
520 (c = getc (infile)) != 'l') | |
521 { | |
522 fprintf (stderr, "## unparsable arglist in %s (%s)\n", | |
523 buffer, filename); | |
524 continue; | |
525 } | |
526 } | |
527 else if (c != '(') | |
528 { | |
529 fprintf (stderr, "## unparsable arglist in %s (%s)\n", | |
530 buffer, filename); | |
531 continue; | |
532 } | |
533 else | |
534 while (c != ')') | |
535 c = getc (infile); | |
536 skip_white (infile); | |
24 | 537 |
753 | 538 /* If the next three characters aren't `dquote bslash newline' |
539 then we're not reading a docstring. | |
540 */ | |
541 if ((c = getc (infile)) != '"' || | |
542 (c = getc (infile)) != '\\' || | |
543 (c = getc (infile)) != '\n') | |
24 | 544 { |
753 | 545 #ifdef DEBUG |
546 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
547 buffer, filename); | |
548 #endif | |
549 continue; | |
550 } | |
551 } | |
552 | |
553 else if (! strcmp (buffer, "defvar") || | |
554 ! strcmp (buffer, "defconst")) | |
555 { | |
556 char c1 = 0, c2 = 0; | |
557 type = 'V'; | |
558 read_lisp_symbol (infile, buffer); | |
559 | |
560 /* Skip until the first newline; remember the two previous chars. */ | |
561 while (c != '\n' && c >= 0) | |
562 { | |
563 c2 = c1; | |
564 c1 = c; | |
24 | 565 c = getc (infile); |
566 } | |
753 | 567 |
568 /* If two previous characters were " and \, | |
569 this is a doc string. Otherwise, there is none. */ | |
570 if (c2 != '"' || c1 != '\\') | |
571 { | |
572 #ifdef DEBUG | |
573 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
574 buffer, filename); | |
575 #endif | |
576 continue; | |
577 } | |
578 } | |
579 | |
2966
e936d56c2354
(scan_lisp_file): Recognize defalias like fset.
Richard M. Stallman <rms@gnu.org>
parents:
2814
diff
changeset
|
580 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) |
753 | 581 { |
582 char c1 = 0, c2 = 0; | |
583 type = 'F'; | |
584 | |
585 c = getc (infile); | |
586 if (c == '\'') | |
587 read_lisp_symbol (infile, buffer); | |
24 | 588 else |
589 { | |
590 if (c != '(') | |
753 | 591 { |
592 fprintf (stderr, "## unparsable name in fset in %s\n", | |
593 filename); | |
594 continue; | |
595 } | |
596 read_lisp_symbol (infile, buffer); | |
597 if (strcmp (buffer, "quote")) | |
598 { | |
599 fprintf (stderr, "## unparsable name in fset in %s\n", | |
600 filename); | |
601 continue; | |
602 } | |
603 read_lisp_symbol (infile, buffer); | |
24 | 604 c = getc (infile); |
753 | 605 if (c != ')') |
606 { | |
607 fprintf (stderr, | |
608 "## unparsable quoted name in fset in %s\n", | |
609 filename); | |
610 continue; | |
611 } | |
24 | 612 } |
164 | 613 |
753 | 614 /* Skip until the first newline; remember the two previous chars. */ |
615 while (c != '\n' && c >= 0) | |
24 | 616 { |
753 | 617 c2 = c1; |
618 c1 = c; | |
24 | 619 c = getc (infile); |
620 } | |
753 | 621 |
622 /* If two previous characters were " and \, | |
623 this is a doc string. Otherwise, there is none. */ | |
624 if (c2 != '"' || c1 != '\\') | |
24 | 625 { |
753 | 626 #ifdef DEBUG |
627 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
628 buffer, filename); | |
629 #endif | |
24 | 630 continue; |
631 } | |
632 } | |
753 | 633 |
634 else if (! strcmp (buffer, "autoload")) | |
164 | 635 { |
753 | 636 type = 'F'; |
164 | 637 c = getc (infile); |
753 | 638 if (c == '\'') |
639 read_lisp_symbol (infile, buffer); | |
640 else | |
641 { | |
642 if (c != '(') | |
643 { | |
644 fprintf (stderr, "## unparsable name in autoload in %s\n", | |
645 filename); | |
646 continue; | |
647 } | |
648 read_lisp_symbol (infile, buffer); | |
649 if (strcmp (buffer, "quote")) | |
650 { | |
651 fprintf (stderr, "## unparsable name in autoload in %s\n", | |
652 filename); | |
653 continue; | |
654 } | |
655 read_lisp_symbol (infile, buffer); | |
656 c = getc (infile); | |
657 if (c != ')') | |
658 { | |
659 fprintf (stderr, | |
660 "## unparsable quoted name in autoload in %s\n", | |
661 filename); | |
662 continue; | |
663 } | |
664 } | |
665 skip_white (infile); | |
666 if ((c = getc (infile)) != '\"') | |
667 { | |
668 fprintf (stderr, "## autoload of %s unparsable (%s)\n", | |
669 buffer, filename); | |
670 continue; | |
671 } | |
672 read_c_string (infile, 0); | |
673 skip_white (infile); | |
164 | 674 |
753 | 675 /* If the next three characters aren't `dquote bslash newline' |
676 then we're not reading a docstring. | |
677 */ | |
678 if ((c = getc (infile)) != '"' || | |
679 (c = getc (infile)) != '\\' || | |
680 (c = getc (infile)) != '\n') | |
681 { | |
682 #ifdef DEBUG | |
683 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
684 buffer, filename); | |
685 #endif | |
686 continue; | |
687 } | |
164 | 688 } |
24 | 689 |
753 | 690 #ifdef DEBUG |
691 else if (! strcmp (buffer, "if") || | |
692 ! strcmp (buffer, "byte-code")) | |
693 ; | |
694 #endif | |
24 | 695 |
753 | 696 else |
697 { | |
698 #ifdef DEBUG | |
699 fprintf (stderr, "## unrecognised top-level form, %s (%s)\n", | |
700 buffer, filename); | |
701 #endif | |
702 continue; | |
703 } | |
24 | 704 |
753 | 705 /* At this point, there is a docstring that we should gobble. |
706 The opening quote (and leading backslash-newline) have already | |
707 been read. | |
708 */ | |
24 | 709 putc (037, outfile); |
753 | 710 putc (type, outfile); |
711 fprintf (outfile, "%s\n", buffer); | |
24 | 712 read_c_string (infile, 1); |
713 } | |
714 fclose (infile); | |
715 return 0; | |
716 } |