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