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