Mercurial > hg > xemacs-beta
annotate lib-src/make-docfile.c @ 5287:cd167465bf69
More permission consistency.
author | Stephen J. Turnbull <stephen@xemacs.org> |
---|---|
date | Mon, 14 Jun 2010 15:03:08 +0900 |
parents | 39d74978fd32 |
children | 308d34e9f07d |
rev | line source |
---|---|
428 | 1 /* Generate doc-string file for XEmacs from source files. |
930 | 2 Copyright (C) 1985, 86, 92, 93, 94, 97, 1999, 2000, 2001 |
3 Free Software Foundation, Inc. | |
428 | 4 Copyright (C) 1995 Board of Trustees, University of Illinois. |
5 Copyright (C) 1998, 1999 J. Kean Johnston. | |
5076
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
6 Copyright (C) 2001, 2002, 2010 Ben Wing. |
930 | 7 |
8 This file is part of XEmacs. | |
9 | |
10 XEmacs is free software; you can redistribute it and/or modify | |
11 it under the terms of the GNU General Public License as published by | |
12 the Free Software Foundation; either version 2, or (at your option) | |
13 any later version. | |
428 | 14 |
930 | 15 XEmacs is distributed in the hope that it will be useful, |
16 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 GNU General Public License for more details. | |
19 | |
20 You should have received a copy of the GNU General Public License | |
21 along with XEmacs; see the file COPYING. If not, write to | |
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
23 Boston, MA 02111-1307, USA. */ | |
24 | |
1618 | 25 /* Synched up with: FSF 21.3. */ |
428 | 26 |
27 /* The arguments given to this program are all the C and Lisp source files | |
930 | 28 of XEmacs. .elc and .el and .c files are allowed. |
29 A .o or .obj file can also be specified; the .c file it was made from is used. | |
30 This helps the makefile pass the correct list of files. | |
31 | |
32 The results, which go to standard output or to a file | |
33 specified with -a or -o (-a to append, -o to start from nothing), | |
34 are entries containing function or variable names and their documentation. | |
35 Each entry starts with a ^_ character. | |
36 Then comes F for a function or V for a variable. | |
37 Then comes the function or variable name, terminated with a newline. | |
38 Then comes the documentation for that function or variable. | |
39 | |
40 Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages | |
41 without modifying Makefiles, etc. | |
428 | 42 */ |
43 | |
438 | 44 #include <config.h> |
930 | 45 #include <sysfile.h> |
428 | 46 |
3368 | 47 #include <assert.h> |
428 | 48 #include <stdio.h> |
49 #include <stdlib.h> | |
50 #include <string.h> | |
51 #include <ctype.h> | |
52 | |
2286 | 53 #include "compiler.h" |
54 | |
930 | 55 /* XEmacs addition */ |
56 #define C_IDENTIFIER_CHAR_P(c) \ | |
57 (('A' <= c && c <= 'Z') || \ | |
58 ('a' <= c && c <= 'z') || \ | |
59 ('0' <= c && c <= '9') || \ | |
60 (c == '_')) | |
428 | 61 |
3368 | 62 static void put_filename (const char *filename); |
442 | 63 static int scan_file (const char *filename); |
428 | 64 static int read_c_string (FILE *, int, int); |
442 | 65 static void write_c_args (FILE *out, const char *func, char *buf, int minargs, |
428 | 66 int maxargs); |
442 | 67 static int scan_c_file (const char *filename, const char *mode); |
428 | 68 static void skip_white (FILE *); |
69 static void read_lisp_symbol (FILE *, char *); | |
442 | 70 static int scan_lisp_file (const char *filename, const char *mode); |
428 | 71 |
930 | 72 /* Stdio stream for output to the DOC file. */ |
73 static FILE *outfile; | |
74 | |
75 /* XEmacs addition */ | |
76 enum | |
77 { | |
78 el_file, | |
79 elc_file, | |
80 c_file | |
81 } Current_file_type; | |
428 | 82 |
83 /* Name this program was invoked with. */ | |
84 char *progname; | |
85 | |
930 | 86 /* XEmacs addition: set to 1 if this was invoked by ellcc */ |
428 | 87 int ellcc = 0; |
88 | |
89 /* Print error message. `s1' is printf control string, `s2' is arg for it. */ | |
90 | |
91 static void | |
442 | 92 error (const char *s1, const char *s2) |
428 | 93 { |
94 fprintf (stderr, "%s: ", progname); | |
95 fprintf (stderr, s1, s2); | |
96 fprintf (stderr, "\n"); | |
97 } | |
98 | |
99 /* Print error message and exit. */ | |
100 | |
101 static void | |
442 | 102 fatal (const char *s1, const char *s2) |
428 | 103 { |
104 error (s1, s2); | |
105 exit (1); | |
106 } | |
107 | |
108 /* Like malloc but get fatal error if memory is exhausted. */ | |
109 | |
110 static long * | |
111 xmalloc (unsigned int size) | |
112 { | |
113 long *result = (long *) malloc (size); | |
114 if (result == NULL) | |
115 fatal ("virtual memory exhausted", 0); | |
116 return result; | |
117 } | |
118 | |
930 | 119 /* XEmacs addition */ |
428 | 120 static char * |
814 | 121 next_extra_elc (char *extra_elcs) |
428 | 122 { |
123 static FILE *fp = NULL; | |
124 static char line_buf[BUFSIZ]; | |
125 char *p = line_buf+1; | |
126 | |
814 | 127 if (!fp) |
128 { | |
129 if (!extra_elcs) | |
130 return NULL; | |
131 else if (!(fp = fopen (extra_elcs, READ_BINARY))) | |
132 { | |
133 /* It is not an error if this file doesn't exist. */ | |
134 /*fatal ("error opening site package file list", 0);*/ | |
135 return NULL; | |
136 } | |
137 fgets (line_buf, BUFSIZ, fp); | |
138 } | |
139 | |
930 | 140 do |
814 | 141 { |
930 | 142 if (!fgets (line_buf, BUFSIZ, fp)) |
143 { | |
144 fclose (fp); | |
145 fp = NULL; | |
146 return NULL; | |
147 } | |
148 line_buf[0] = '\0'; | |
814 | 149 /* reject too short or too long lines */ |
930 | 150 } while (strlen (p) <= 2 || strlen (p) >= (BUFSIZ - 5)); |
151 | |
814 | 152 p[strlen (p) - 2] = '\0'; |
153 strcat (p, ".elc"); | |
428 | 154 |
155 return p; | |
156 } | |
157 | |
158 | |
159 int | |
160 main (int argc, char **argv) | |
161 { | |
162 int i; | |
163 int err_count = 0; | |
164 int first_infile; | |
930 | 165 char *extra_elcs = NULL; /* XEmacs addition */ |
428 | 166 |
167 progname = argv[0]; | |
168 | |
169 outfile = stdout; | |
170 | |
171 /* Don't put CRs in the DOC file. */ | |
442 | 172 #ifdef WIN32_NATIVE |
428 | 173 _fmode = O_BINARY; |
174 _setmode (fileno (stdout), O_BINARY); | |
442 | 175 #endif /* WIN32_NATIVE */ |
428 | 176 |
177 /* If first two args are -o FILE, output to FILE. */ | |
178 i = 1; | |
179 if (argc > i + 1 && !strcmp (argv[i], "-o")) | |
180 { | |
181 outfile = fopen (argv[i + 1], WRITE_BINARY); | |
182 i += 2; | |
183 } | |
184 if (argc > i + 1 && !strcmp (argv[i], "-a")) | |
185 { | |
186 outfile = fopen (argv[i + 1], APPEND_BINARY); | |
187 i += 2; | |
188 } | |
930 | 189 if (argc > i + 1 && !strcmp (argv[i], "-d")) |
190 { | |
191 chdir (argv[i + 1]); | |
192 i += 2; | |
193 } | |
194 | |
195 /* Additional command line arguments for XEmacs */ | |
428 | 196 if (argc > i + 1 && !strcmp (argv[i], "-E")) |
197 { | |
198 outfile = fopen (argv[i + 1], APPEND_BINARY); | |
199 i += 2; | |
200 ellcc = 1; | |
201 } | |
814 | 202 if (argc > (i + 1) && !strcmp (argv[i], "-i")) |
203 { | |
204 extra_elcs = argv[i + 1]; | |
205 i += 2; | |
206 } | |
428 | 207 |
208 if (outfile == 0) | |
209 fatal ("No output file specified", ""); | |
210 | |
930 | 211 /* XEmacs addition */ |
428 | 212 if (ellcc) |
213 fprintf (outfile, "{\n"); | |
214 | |
215 first_infile = i; | |
216 for (; i < argc; i++) | |
217 { | |
930 | 218 /* XEmacs addition: the "if" clause is new; the "else" clause is the |
219 original FSF Emacs code */ | |
771 | 220 if (argv[i][0] == '@') |
221 { | |
222 /* Allow a file containing files to process, for use w/MS Windows | |
223 (where command-line length limits are more problematic) */ | |
224 FILE *argfile = fopen (argv[i] + 1, READ_TEXT); | |
2421 | 225 char arg[QXE_PATH_MAX]; |
771 | 226 |
227 if (!argfile) | |
228 fatal ("Unable to open argument file %s", argv[i] + 1); | |
2421 | 229 while (fgets (arg, QXE_PATH_MAX, argfile)) |
771 | 230 { |
231 if (arg[strlen (arg) - 1] == '\n') | |
232 arg[strlen (arg) - 1] = '\0'; /* chop \n */ | |
233 err_count += scan_file (arg); | |
234 } | |
235 } | |
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
236 else if (argc > i + 1 && !strcmp (argv[i], "-d")) |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
237 { |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
238 /* XEmacs change; allow more than one chdir. |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
239 The idea is that the second chdir is to source-lisp, and that |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
240 any Lisp files not under there have the full path specified. */ |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
241 i += 1; |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
242 chdir (argv[i]); |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
243 continue; |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
244 } |
771 | 245 else |
246 { | |
247 int j; | |
248 /* Don't process one file twice. */ | |
249 for (j = first_infile; j < i; j++) | |
250 if (! strcmp (argv[i], argv[j])) | |
251 break; | |
252 if (j == i) | |
253 err_count += scan_file (argv[i]); | |
254 } | |
428 | 255 } |
256 | |
930 | 257 /* XEmacs addition */ |
814 | 258 if (extra_elcs) |
259 { | |
260 char *p; | |
428 | 261 |
814 | 262 while ((p = next_extra_elc (extra_elcs)) != NULL) |
263 err_count += scan_file (p); | |
428 | 264 } |
265 | |
266 putc ('\n', outfile); | |
267 if (ellcc) | |
268 fprintf (outfile, "}\n\n"); | |
930 | 269 /* End XEmacs addition */ |
270 | |
428 | 271 #ifndef VMS |
272 exit (err_count > 0); | |
273 #endif /* VMS */ | |
274 return err_count > 0; | |
275 } | |
276 | |
3368 | 277 /* Add a source file name boundary in the output file. */ |
278 static void | |
279 put_filename (const char *filename) | |
280 { | |
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
281 /* XEmacs change; don't strip directory information. */ |
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
282 #if 0 |
3368 | 283 const char *tmp; |
284 | |
285 for (tmp = filename; *tmp; tmp++) | |
286 { | |
287 if (IS_DIRECTORY_SEP(*tmp)) | |
288 filename = tmp + 1; | |
289 } | |
4539
061e030e3270
Fix some bugs in load-history construction, built-in symbol file names.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4456
diff
changeset
|
290 #endif |
3368 | 291 |
292 /* <= because sizeof includes the nul byte at the end. Not quite right, | |
293 because it should include the length of the symbol + "\037[VF]" instead | |
294 of simply 10. */ | |
295 assert(sizeof("\037S\n") + strlen(filename) + 10 | |
296 <= DOC_MAX_FILENAME_LENGTH); | |
297 | |
298 putc (037, outfile); | |
299 putc ('S', outfile); | |
300 fprintf (outfile, "%s\n", filename); | |
301 } | |
302 | |
428 | 303 /* Read file FILENAME and output its doc strings to outfile. */ |
304 /* Return 1 if file is not found, 0 if it is found. */ | |
305 | |
306 static int | |
442 | 307 scan_file (const char *filename) |
428 | 308 { |
309 int len = strlen (filename); | |
930 | 310 |
311 /* XEmacs change: test ellcc and set Current_file_type in each case */ | |
428 | 312 if (ellcc == 0 && len > 4 && !strcmp (filename + len - 4, ".elc")) |
313 { | |
314 Current_file_type = elc_file; | |
315 return scan_lisp_file (filename, READ_BINARY); | |
316 } | |
317 else if (ellcc == 0 && len > 3 && !strcmp (filename + len - 3, ".el")) | |
318 { | |
319 Current_file_type = el_file; | |
4456
c785f98c6737
Pass READ_BINARY to scan_lisp_file, scan_c_file in make-docfile.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3368
diff
changeset
|
320 return scan_lisp_file (filename, READ_BINARY); |
428 | 321 } |
322 else | |
323 { | |
324 Current_file_type = c_file; | |
4456
c785f98c6737
Pass READ_BINARY to scan_lisp_file, scan_c_file in make-docfile.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3368
diff
changeset
|
325 return scan_c_file (filename, READ_BINARY); |
428 | 326 } |
327 } | |
930 | 328 |
329 /* XEmacs addition: ISO 2022 handling */ | |
814 | 330 static int |
331 getc_skipping_iso2022 (FILE *file) | |
332 { | |
333 register int c; | |
334 /* #### Kludge -- Ignore any ISO2022 sequences */ | |
335 c = getc (file); | |
336 while (c == 27) | |
337 { | |
338 c = getc (file); | |
339 if (c == '$') | |
340 c = getc (file); | |
341 if (c >= '(' && c <= '/') | |
342 c = getc (file); | |
343 c = getc (file); | |
344 } | |
345 return c; | |
346 } | |
347 | |
348 enum iso2022_state | |
349 { | |
350 ISO_NOTHING, | |
351 ISO_ESC, | |
352 ISO_DOLLAR, | |
353 ISO_FINAL_IS_NEXT, | |
354 ISO_DOLLAR_AND_FINAL_IS_NEXT | |
355 }; | |
356 | |
357 static int non_ascii_p; | |
358 | |
359 static int | |
360 getc_iso2022 (FILE *file) | |
361 { | |
362 /* #### Kludge -- Parse ISO2022 sequences (more or less) */ | |
363 static enum iso2022_state state; | |
364 static int prevc; | |
365 register int c; | |
366 c = getc (file); | |
367 switch (state) | |
368 { | |
369 case ISO_NOTHING: | |
370 if (c == 27) | |
371 state = ISO_ESC; | |
372 break; | |
373 | |
374 case ISO_ESC: | |
375 if (c == '$') | |
376 state = ISO_DOLLAR; | |
377 else if (c >= '(' && c <= '/') | |
378 state = ISO_FINAL_IS_NEXT; | |
379 else | |
380 state = ISO_NOTHING; | |
381 break; | |
382 | |
383 case ISO_DOLLAR: | |
384 if (c >= '(' && c <= '/') | |
385 state = ISO_DOLLAR_AND_FINAL_IS_NEXT; | |
386 else if (c >= '@' && c <= 'B') /* ESC $ @ etc */ | |
387 { | |
388 non_ascii_p = 1; | |
389 state = ISO_NOTHING; | |
390 } | |
391 else | |
392 state = ISO_NOTHING; | |
393 break; | |
394 | |
395 case ISO_FINAL_IS_NEXT: | |
396 if (prevc == '(' && c == 'B') /* ESC ( B, invoke ASCII */ | |
397 non_ascii_p = 0; | |
398 else if (prevc == '(' || prevc == ',') /* ESC ( x or ESC , x */ | |
399 non_ascii_p = 1; | |
400 state = ISO_NOTHING; | |
401 break; | |
402 | |
403 case ISO_DOLLAR_AND_FINAL_IS_NEXT: | |
404 if (prevc == '(' || prevc == ',') /* ESC $ ( x or ESC $ , x */ | |
405 non_ascii_p = 1; | |
406 state = ISO_NOTHING; | |
407 break; | |
408 } | |
409 | |
410 prevc = c; | |
411 return c; | |
412 } | |
413 | |
428 | 414 |
1111 | 415 char globalbuf[128]; |
428 | 416 |
417 /* Skip a C string from INFILE, | |
930 | 418 and return the character that follows the closing ". |
428 | 419 If printflag is positive, output string contents to outfile. |
420 If it is negative, store contents in buf. | |
421 Convert escape sequences \n and \t to newline and tab; | |
422 discard \ followed by newline. */ | |
423 | |
814 | 424 #define MDGET do { prevc = c; c = getc_iso2022 (infile); } while (0) |
428 | 425 static int |
426 read_c_string (FILE *infile, int printflag, int c_docstring) | |
427 { | |
442 | 428 register int prevc = 0, c = 0; |
1111 | 429 char *p = globalbuf; |
930 | 430 int start = -1; /* XEmacs addition */ |
428 | 431 |
442 | 432 MDGET; |
428 | 433 while (c != EOF) |
434 { | |
814 | 435 while ((c_docstring || c != '"' || non_ascii_p) && c != EOF) |
428 | 436 { |
930 | 437 /* XEmacs addition: the first two "if" clauses are new */ |
814 | 438 if (c == '*' && !non_ascii_p) |
428 | 439 { |
442 | 440 int cc = getc (infile); |
441 if (cc == '/') | |
428 | 442 { |
442 | 443 if (prevc != '\n') |
444 { | |
445 if (printflag > 0) | |
446 { | |
447 if (ellcc) | |
448 fprintf (outfile, "\\n\\"); | |
449 putc ('\n', outfile); | |
450 } | |
451 else if (printflag < 0) | |
452 *p++ = '\n'; | |
453 } | |
454 break; | |
428 | 455 } |
442 | 456 else |
457 ungetc (cc, infile); | |
458 } | |
428 | 459 |
442 | 460 if (start == 1) |
461 { | |
462 if (printflag > 0) | |
428 | 463 { |
442 | 464 if (ellcc) |
465 fprintf (outfile, "\\n\\"); | |
466 putc ('\n', outfile); | |
428 | 467 } |
442 | 468 else if (printflag < 0) |
469 *p++ = '\n'; | |
428 | 470 } |
930 | 471 /* End XEmacs addition */ |
428 | 472 |
814 | 473 if (c == '\\' && !non_ascii_p) |
428 | 474 { |
442 | 475 MDGET; |
428 | 476 if (c == '\n') |
477 { | |
442 | 478 MDGET; |
428 | 479 start = 1; |
480 continue; | |
481 } | |
482 if (!c_docstring && c == 'n') | |
483 c = '\n'; | |
484 if (c == 't') | |
485 c = '\t'; | |
486 } | |
930 | 487 |
488 /* XEmacs change: the "if" clause is new; the "else" clause is | |
489 mostly the original FSF Emacs code */ | |
428 | 490 if (c == '\n') |
491 start = 1; | |
492 else | |
493 { | |
494 start = 0; | |
442 | 495 if (printflag > 0) |
496 { | |
814 | 497 if (ellcc && c == '"' && !non_ascii_p) |
442 | 498 putc ('\\', outfile); |
499 putc (c, outfile); | |
500 } | |
428 | 501 else if (printflag < 0) |
502 *p++ = c; | |
503 } | |
442 | 504 MDGET; |
428 | 505 } |
930 | 506 /* XEmacs change: look for continuation of string */ |
428 | 507 if (Current_file_type == c_file) |
508 { | |
442 | 509 do |
510 { | |
511 MDGET; | |
512 } | |
513 while (isspace (c)); | |
814 | 514 if (c != '"' || non_ascii_p) |
428 | 515 break; |
516 } | |
517 else | |
518 { | |
442 | 519 MDGET; |
814 | 520 if (c != '"' || non_ascii_p) |
428 | 521 break; |
522 /* If we had a "", concatenate the two strings. */ | |
523 } | |
442 | 524 MDGET; |
428 | 525 } |
930 | 526 |
428 | 527 if (printflag < 0) |
528 *p = 0; | |
930 | 529 |
428 | 530 return c; |
531 } | |
532 | |
533 /* Write to file OUT the argument names of function FUNC, whose text is in BUF. | |
534 MINARGS and MAXARGS are the minimum and maximum number of arguments. */ | |
535 | |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
536 #define SKIPWHITE do { while (isspace ((unsigned char) (*p))) p++; } while (0) |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
537 |
428 | 538 static void |
2286 | 539 write_c_args (FILE *out, const char *UNUSED (func), char *buf, |
540 int minargs, int maxargs) | |
428 | 541 { |
542 register char *p; | |
543 int in_ident = 0; | |
544 int just_spaced = 0; | |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
545 int need_paren = 0; |
428 | 546 #if 0 |
547 int need_space = 1; | |
548 | |
549 fprintf (out, "(%s", func); | |
550 #else | |
551 /* XEmacs - "arguments:" is for parsing the docstring. FSF's help system | |
552 doesn't parse the docstring for arguments like we do, so we're also | |
553 going to omit the function name to preserve compatibility with elisp | |
554 that parses the docstring. Finally, not prefixing the arglist with | |
555 anything is asking for trouble because it's not uncommon to have an | |
556 unescaped parenthesis at the beginning of a line. --Stig */ | |
557 fprintf (out, "arguments: ("); | |
558 #endif | |
559 | |
930 | 560 if (*buf == '(') |
561 ++buf; | |
428 | 562 |
930 | 563 for (p = buf; *p; p++) |
428 | 564 { |
565 char c = *p; | |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
566 #if 0 |
428 | 567 int ident_start = 0; |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
568 #endif |
428 | 569 |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
570 /* XEmacs addition: used for ANSI prototypes and UNUSED macros. */ |
2603 | 571 static char uu [] = "UNUSED"; |
572 static char ui [] = "USED_IF_"; | |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
573 static char lo [] = "Lisp_Object"; |
428 | 574 |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
575 /* Notice when we enter or leave an identifier. */ |
428 | 576 if (C_IDENTIFIER_CHAR_P (c) != in_ident) |
577 { | |
578 if (!in_ident) | |
579 { | |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
580 /* Entering identifier. Print as we parse. */ |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
581 char *here; /* Target for backtracking. */ |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
582 |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
583 /* XEmacs addition: add support for ANSI prototypes and the |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
584 UNUSED macros. Hop over them. "Lisp_Object" is the only |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
585 C type allowed in DEFUNs. For the UNUSED macros we need |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
586 to eat parens, too. */ |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
587 /* Aren't these all vulnerable to buffer overrun? I guess that |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
588 means that the .c is busted, so we may as well just die ... */ |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
589 |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
590 /* Skip over "Lisp_Object". */ |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
591 if ((strncmp (p, lo, sizeof (lo) - 1) == 0) && |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
592 isspace ((unsigned char) p[sizeof (lo) - 1])) |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
593 { |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
594 p += (sizeof (lo) - 1); |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
595 SKIPWHITE; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
596 } |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
597 /* Skip over "UNUSED" or "USED_IF_*" invocation. */ |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
598 need_paren = 1; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
599 here = p; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
600 if (strncmp (p, uu, sizeof (uu) - 1) == 0) |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
601 p += (sizeof (uu) - 1); |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
602 else if (strncmp (p, ui, sizeof (ui) - 1) == 0) |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
603 p += (sizeof (ui) - 1); |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
604 else |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
605 need_paren = 0; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
606 |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
607 if (need_paren) |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
608 { |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
609 /* Skip rest of macro name, open paren, whitespace. */ |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
610 while (*p && C_IDENTIFIER_CHAR_P (*p)) |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
611 p++; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
612 SKIPWHITE; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
613 if (*p++ == '(') |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
614 SKIPWHITE; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
615 else |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
616 { |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
617 need_paren = 0; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
618 p = here; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
619 } |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
620 } |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
621 c = *p; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
622 |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
623 /* Do bookkeeping. Maybe output lambda keywords. */ |
428 | 624 in_ident = 1; |
625 #if 0 | |
626 /* XEmacs - This goes along with the change above. */ | |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
627 ident_start = 1; |
428 | 628 if (need_space) |
629 putc (' ', out); | |
630 #endif | |
631 if (minargs == 0 && maxargs > 0) | |
632 fprintf (out, "&optional "); | |
633 just_spaced = 1; | |
634 | |
635 minargs--; | |
636 maxargs--; | |
637 } | |
638 else | |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
639 { |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
640 /* Leaving identifier. */ |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
641 in_ident = 0; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
642 if (need_paren) |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
643 { |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
644 SKIPWHITE; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
645 if (*p == ')') |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
646 p++; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
647 c = *p; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
648 need_paren = 0; |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
649 } |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
650 } |
428 | 651 } |
652 | |
653 /* Print the C argument list as it would appear in lisp: | |
5076
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
654 print underscores as hyphens, and print commas, tabs and newlines |
930 | 655 as spaces. Collapse adjacent spaces into one. */ |
656 if (c == '_') | |
657 c = '-'; | |
5076
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
658 else if (c == ',' || c == '\n' || c == '\t') |
930 | 659 c = ' '; |
1618 | 660 /* XEmacs change: handle \n below for readability */ |
428 | 661 |
930 | 662 #if 0 |
663 /* In C code, `default' is a reserved word, so we spell it | |
664 `defalt'; unmangle that here. */ | |
665 if (ident_start | |
666 && strncmp (p, "defalt", 6) == 0 | |
667 && ! (('A' <= p[6] && p[6] <= 'Z') | |
668 || ('a' <= p[6] && p[6] <= 'z') | |
669 || ('0' <= p[6] && p[6] <= '9') | |
670 || p[6] == '_')) | |
671 { | |
672 fprintf (out, "DEFAULT"); | |
673 p += 5; | |
674 in_ident = 0; | |
675 just_spaced = 0; | |
676 } | |
677 #endif | |
428 | 678 /* If the C argument name ends with `_', change it to ' ', |
679 to allow use of C reserved words or global symbols as Lisp args. */ | |
680 if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1])) | |
681 { | |
682 in_ident = 0; | |
683 just_spaced = 0; | |
684 } | |
5076
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
685 #if 0 |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
686 /* [[ XEmacs change: if the character is carriage return or linefeed, |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
687 escape it for the compiler ]] I doubt the clause with '\r' ever |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
688 worked right, and outputting newlines now screws up the regexp |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
689 in function-documentation-1, so don't do this; instead, we treat |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
690 newlines like spaces. --ben */ |
1618 | 691 else if (c == '\n') |
692 { | |
693 putc('\\', out); | |
694 putc('\n', out); | |
5076
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
695 c = ' '; |
1618 | 696 } |
697 else if (c == '\r') | |
698 { | |
699 putc('\\', out); | |
700 putc('\r', out); | |
701 } | |
5076
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
702 #else |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
703 else if (c == '\r') /* Just eat it, since we expect a newline to |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
704 follow */ |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
705 ; |
d555581e3cba
fix issues with display of argument docstrings
Ben Wing <ben@xemacs.org>
parents:
4665
diff
changeset
|
706 #endif /* (not) 0 */ |
930 | 707 else if (c != ' ' || !just_spaced) |
428 | 708 { |
709 if (c >= 'a' && c <= 'z') | |
710 /* Upcase the letter. */ | |
711 c += 'A' - 'a'; | |
712 putc (c, out); | |
713 } | |
714 | |
715 just_spaced = (c == ' '); | |
716 #if 0 | |
717 need_space = 0; | |
718 #endif | |
719 } | |
930 | 720 /* XEmacs addition */ |
428 | 721 if (!ellcc) |
930 | 722 putc ('\n', out); |
428 | 723 } |
4665
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
724 #undef SKIPWHITE |
f3a65dff1912
Fix UNUSED and USED_IF parsing in make-docfile.c.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
4539
diff
changeset
|
725 |
428 | 726 |
771 | 727 /* Read through a c file. If a .o or .obj file is named, |
428 | 728 the corresponding .c file is read instead. |
729 Looks for DEFUN constructs such as are defined in ../src/lisp.h. | |
930 | 730 Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED ... |
731 which don't exist anymore! */ | |
428 | 732 |
733 static int | |
442 | 734 scan_c_file (const char *filename, const char *mode) |
428 | 735 { |
736 FILE *infile; | |
737 register int c; | |
738 register int commas; | |
739 register int defunflag; | |
740 register int defvarperbufferflag = 0; | |
741 register int defvarflag; | |
742 int minargs, maxargs; | |
743 int l = strlen (filename); | |
2421 | 744 char f[QXE_PATH_MAX]; |
428 | 745 |
930 | 746 /* XEmacs change: different method for checking filename extension */ |
2421 | 747 if (l > QXE_PATH_MAX - 1) |
647 | 748 { |
428 | 749 #ifdef ENAMETOOLONG |
647 | 750 errno = ENAMETOOLONG; |
428 | 751 #else |
647 | 752 errno = EINVAL; |
428 | 753 #endif |
930 | 754 return 0; |
647 | 755 } |
428 | 756 |
757 strcpy (f, filename); | |
771 | 758 if (l > 4 && !strcmp (f + l - 4, ".obj")) /* MS Windows */ |
759 strcpy (f + l - 4, ".c"); | |
428 | 760 if (f[l - 1] == 'o') |
761 f[l - 1] = 'c'; | |
762 infile = fopen (f, mode); | |
763 | |
764 /* No error if non-ex input file */ | |
765 if (infile == NULL) | |
766 { | |
767 perror (f); | |
768 return 0; | |
769 } | |
770 | |
930 | 771 #if 0 |
772 /* Reset extension to be able to detect duplicate files. */ | |
773 filename[strlen (filename) - 1] = extension; | |
774 #endif | |
775 | |
428 | 776 c = '\n'; |
777 while (!feof (infile)) | |
778 { | |
779 if (c != '\n') | |
780 { | |
781 c = getc (infile); | |
782 continue; | |
783 } | |
784 c = getc (infile); | |
785 if (c == ' ') | |
786 { | |
787 while (c == ' ') | |
788 c = getc (infile); | |
789 if (c != 'D') | |
790 continue; | |
791 c = getc (infile); | |
792 if (c != 'E') | |
793 continue; | |
794 c = getc (infile); | |
795 if (c != 'F') | |
796 continue; | |
797 c = getc (infile); | |
798 if (c != 'V') | |
799 continue; | |
800 c = getc (infile); | |
801 if (c != 'A') | |
802 continue; | |
803 c = getc (infile); | |
804 if (c != 'R') | |
805 continue; | |
806 c = getc (infile); | |
807 if (c != '_') | |
808 continue; | |
809 | |
810 defvarflag = 1; | |
811 defunflag = 0; | |
812 | |
813 c = getc (infile); | |
814 /* Note that this business doesn't apply under XEmacs. | |
815 DEFVAR_BUFFER_LOCAL in XEmacs behaves normally. */ | |
816 defvarperbufferflag = (c == 'P'); | |
817 | |
818 c = getc (infile); | |
819 } | |
820 else if (c == 'D') | |
821 { | |
822 c = getc (infile); | |
823 if (c != 'E') | |
824 continue; | |
825 c = getc (infile); | |
826 if (c != 'F') | |
827 continue; | |
828 c = getc (infile); | |
829 defunflag = (c == 'U'); | |
830 defvarflag = 0; | |
930 | 831 c = getc (infile); /* XEmacs addition */ |
428 | 832 } |
833 else continue; | |
834 | |
835 while (c != '(') | |
836 { | |
837 if (c < 0) | |
838 goto eof; | |
839 c = getc (infile); | |
840 } | |
841 | |
842 c = getc (infile); | |
843 if (c != '"') | |
844 continue; | |
845 c = read_c_string (infile, -1, 0); | |
846 | |
847 if (defunflag) | |
848 commas = 4; | |
849 else if (defvarperbufferflag) | |
850 commas = 2; | |
851 else if (defvarflag) | |
852 commas = 1; | |
930 | 853 else /* For DEFSIMPLE and DEFPRED ... which now don't exist! */ |
428 | 854 commas = 2; |
855 | |
856 while (commas) | |
857 { | |
858 if (c == ',') | |
859 { | |
860 commas--; | |
861 if (defunflag && (commas == 1 || commas == 2)) | |
862 { | |
863 do | |
864 c = getc (infile); | |
930 | 865 while (c == ' ' || c == '\n' || c == '\t'); |
428 | 866 if (c < 0) |
867 goto eof; | |
868 ungetc (c, infile); | |
869 if (commas == 2) /* pick up minargs */ | |
870 fscanf (infile, "%d", &minargs); | |
930 | 871 else /* pick up maxargs */ |
428 | 872 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */ |
873 maxargs = -1; | |
874 else | |
875 fscanf (infile, "%d", &maxargs); | |
876 } | |
877 } | |
878 if (c < 0) | |
879 goto eof; | |
880 c = getc (infile); | |
881 } | |
882 while (c == ' ' || c == '\n' || c == '\t') | |
883 c = getc (infile); | |
884 if (c == '"') | |
885 c = read_c_string (infile, 0, 0); | |
930 | 886 /* XEmacs change */ |
428 | 887 if (defunflag | defvarflag) |
888 { | |
889 while (c != '/') | |
853 | 890 { |
891 if (c < 0) | |
892 goto eof; | |
930 | 893 if (defunflag && c == '(') |
1111 | 894 fatal ("Missing doc string for DEFUN %s\n", globalbuf); |
853 | 895 c = getc (infile); |
896 } | |
428 | 897 c = getc (infile); |
898 while (c == '*') | |
899 c = getc (infile); | |
900 } | |
901 else | |
902 { | |
903 while (c != ',') | |
853 | 904 { |
905 if (c < 0) | |
906 goto eof; | |
907 c = getc (infile); | |
908 } | |
428 | 909 c = getc (infile); |
910 } | |
930 | 911 /* End XEmacs change */ |
428 | 912 while (c == ' ' || c == '\n' || c == '\t') |
913 c = getc (infile); | |
930 | 914 /* XEmacs addition */ |
428 | 915 if (defunflag | defvarflag) |
916 ungetc (c, infile); | |
930 | 917 /* End XEmacs addition */ |
428 | 918 |
919 if (defunflag || defvarflag || c == '"') | |
920 { | |
930 | 921 /* XEmacs change: the original code is in the "else" clause */ |
3368 | 922 /* XXX Must modify the documentation file name code to handle |
923 ELLCCs */ | |
814 | 924 if (ellcc) |
925 fprintf (outfile, " CDOC%s(\"%s\", \"\\\n", | |
1111 | 926 defvarflag ? "SYM" : "SUBR", globalbuf); |
814 | 927 else |
928 { | |
3368 | 929 put_filename (filename); /* XEmacs addition */ |
814 | 930 putc (037, outfile); |
931 putc (defvarflag ? 'V' : 'F', outfile); | |
1111 | 932 fprintf (outfile, "%s\n", globalbuf); |
814 | 933 } |
930 | 934 c = read_c_string (infile, 1, defunflag || defvarflag); |
428 | 935 |
936 /* If this is a defun, find the arguments and print them. If | |
937 this function takes MANY or UNEVALLED args, then the C source | |
938 won't give the names of the arguments, so we shouldn't bother | |
939 trying to find them. */ | |
940 if (defunflag && maxargs != -1) | |
941 { | |
942 char argbuf[1024], *p = argbuf; | |
2603 | 943 int paren_level = 1; |
814 | 944 #if 0 /* For old DEFUN's only */ |
428 | 945 while (c != ')') |
946 { | |
947 if (c < 0) | |
948 goto eof; | |
949 c = getc (infile); | |
950 } | |
951 #endif | |
952 /* Skip into arguments. */ | |
953 while (c != '(') | |
954 { | |
955 if (c < 0) | |
956 goto eof; | |
957 c = getc (infile); | |
958 } | |
959 /* Copy arguments into ARGBUF. */ | |
960 *p++ = c; | |
961 do | |
853 | 962 { |
963 *p++ = c = getc (infile); | |
964 if (c < 0) | |
965 goto eof; | |
2603 | 966 /* XEmacs change: handle macros with args (eg, UNUSED) */ |
967 if (c == ')') | |
968 paren_level--; | |
969 if (c == '(') | |
970 paren_level++; | |
853 | 971 } |
2603 | 972 while (paren_level > 0); |
428 | 973 *p = '\0'; |
974 /* Output them. */ | |
814 | 975 if (ellcc) |
976 fprintf (outfile, "\\n\\\n\\n\\\n"); | |
977 else | |
978 fprintf (outfile, "\n\n"); | |
1111 | 979 write_c_args (outfile, globalbuf, argbuf, minargs, maxargs); |
428 | 980 } |
814 | 981 if (ellcc) |
982 fprintf (outfile, "\\n\");\n\n"); | |
428 | 983 } |
984 } | |
985 eof: | |
986 fclose (infile); | |
987 return 0; | |
988 } | |
989 | |
990 /* Read a file of Lisp code, compiled or interpreted. | |
930 | 991 Looks for |
992 (defun NAME ARGS DOCSTRING ...) | |
993 (defmacro NAME ARGS DOCSTRING ...) | |
994 (defsubst NAME ARGS DOCSTRING ...) | |
995 (autoload (quote NAME) FILE DOCSTRING ...) | |
996 (defvar NAME VALUE DOCSTRING) | |
997 (defconst NAME VALUE DOCSTRING) | |
998 (fset (quote NAME) (make-byte-code ... DOCSTRING ...)) | |
999 (fset (quote NAME) #[... DOCSTRING ...]) | |
1000 (defalias (quote NAME) #[... DOCSTRING ...]) | |
1001 (custom-declare-variable (quote NAME) VALUE DOCSTRING ...) | |
1002 starting in column zero. | |
1003 (quote NAME) may appear as 'NAME as well. | |
428 | 1004 |
1005 We also look for #@LENGTH CONTENTS^_ at the beginning of the line. | |
1006 When we find that, we save it for the following defining-form, | |
1007 and we use that instead of reading a doc string within that defining-form. | |
1008 | |
930 | 1009 For defvar, defconst, and fset we skip to the docstring with a kludgy |
428 | 1010 formatting convention: all docstrings must appear on the same line as the |
930 | 1011 initial open-paren (the one in column zero) and must contain a backslash |
1012 and a newline immediately after the initial double-quote. No newlines | |
428 | 1013 must appear between the beginning of the form and the first double-quote. |
930 | 1014 For defun, defmacro, and autoload, we know how to skip over the |
1015 arglist, but the doc string must still have a backslash and newline | |
1016 immediately after the double quote. | |
1017 The only source files that must follow this convention are preloaded | |
1018 uncompiled ones like loaddefs.el and bindings.el; aside | |
428 | 1019 from that, it is always the .elc file that we look at, and they are no |
1020 problem because byte-compiler output follows this convention. | |
1021 The NAME and DOCSTRING are output. | |
1022 NAME is preceded by `F' for a function or `V' for a variable. | |
1023 An entry is output only if DOCSTRING has \ newline just after the opening " | |
3368 | 1024 |
1025 Adds the filename a symbol or function was found in before its docstring; | |
1026 there's no need for this with the load-history available, but we do it for | |
1027 consistency with the C parsing code. | |
428 | 1028 */ |
1029 | |
1030 static void | |
1031 skip_white (FILE *infile) | |
1032 { | |
1033 char c = ' '; | |
1034 while (c == ' ' || c == '\t' || c == '\n') | |
1035 c = getc (infile); | |
1036 ungetc (c, infile); | |
1037 } | |
1038 | |
1039 static void | |
1040 read_lisp_symbol (FILE *infile, char *buffer) | |
1041 { | |
1042 char c; | |
1043 char *fillp = buffer; | |
1044 | |
1045 skip_white (infile); | |
1046 while (1) | |
1047 { | |
1048 c = getc (infile); | |
1049 if (c == '\\') | |
1050 /* FSF has *(++fillp), which is wrong. */ | |
1051 *fillp++ = getc (infile); | |
1052 else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')') | |
1053 { | |
1054 ungetc (c, infile); | |
1055 *fillp = 0; | |
1056 break; | |
1057 } | |
1058 else | |
1059 *fillp++ = c; | |
1060 } | |
1061 | |
1062 if (! buffer[0]) | |
1063 fprintf (stderr, "## expected a symbol, got '%c'\n", c); | |
814 | 1064 |
428 | 1065 skip_white (infile); |
1066 } | |
1067 | |
1068 static int | |
442 | 1069 scan_lisp_file (const char *filename, const char *mode) |
428 | 1070 { |
1071 FILE *infile; | |
1072 register int c; | |
1073 char *saved_string = 0; | |
1074 | |
1075 infile = fopen (filename, mode); | |
1076 if (infile == NULL) | |
1077 { | |
1078 perror (filename); | |
930 | 1079 return 0; /* No error */ |
428 | 1080 } |
1081 | |
1082 c = '\n'; | |
1083 while (!feof (infile)) | |
1084 { | |
1085 char buffer[BUFSIZ]; | |
1086 char type; | |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1087 int no_docstring = 0; |
428 | 1088 |
930 | 1089 /* If not at end of line, skip till we get to one. */ |
428 | 1090 if (c != '\n') |
1091 { | |
814 | 1092 c = getc_skipping_iso2022 (infile); |
428 | 1093 continue; |
1094 } | |
930 | 1095 /* Skip the line break. */ |
1096 while (c == '\n') | |
1097 c = getc_skipping_iso2022 (infile); | |
428 | 1098 /* Detect a dynamic doc string and save it for the next expression. */ |
1099 if (c == '#') | |
1100 { | |
814 | 1101 c = getc_skipping_iso2022 (infile); |
428 | 1102 if (c == '@') |
1103 { | |
1104 int length = 0; | |
1105 int i; | |
1106 | |
1107 /* Read the length. */ | |
814 | 1108 while ((c = getc_skipping_iso2022 (infile), |
428 | 1109 c >= '0' && c <= '9')) |
1110 { | |
1111 length *= 10; | |
1112 length += c - '0'; | |
1113 } | |
1114 | |
1115 /* The next character is a space that is counted in the length | |
1116 but not part of the doc string. | |
1117 We already read it, so just ignore it. */ | |
1118 length--; | |
1119 | |
1120 /* Read in the contents. */ | |
1121 if (saved_string != 0) | |
1122 free (saved_string); | |
1123 saved_string = (char *) xmalloc (length); | |
1124 for (i = 0; i < length; i++) | |
1125 saved_string[i] = getc (infile); | |
1126 /* The last character is a ^_. | |
1127 That is needed in the .elc file | |
1128 but it is redundant in DOC. So get rid of it here. */ | |
1129 saved_string[length - 1] = 0; | |
930 | 1130 /* Skip the line break. */ |
1131 while (c == '\n') | |
1132 c = getc_skipping_iso2022 (infile); | |
1133 /* Skip the following line. */ | |
428 | 1134 while (c != '\n') |
930 | 1135 c = getc_skipping_iso2022 (infile); |
428 | 1136 } |
1137 continue; | |
1138 } | |
1139 | |
1140 if (c != '(') | |
1141 continue; | |
1142 | |
1143 read_lisp_symbol (infile, buffer); | |
1144 | |
930 | 1145 if (! strcmp (buffer, "defun") |
1146 || ! strcmp (buffer, "defmacro") | |
1147 || ! strcmp (buffer, "defsubst")) | |
428 | 1148 { |
1149 type = 'F'; | |
1150 read_lisp_symbol (infile, buffer); | |
1151 | |
1152 /* Skip the arguments: either "nil" or a list in parens */ | |
1153 | |
814 | 1154 c = getc_skipping_iso2022 (infile); |
930 | 1155 if (c == 'n') /* nil */ |
428 | 1156 { |
814 | 1157 if ((c = getc_skipping_iso2022 (infile)) != 'i' || |
1158 (c = getc_skipping_iso2022 (infile)) != 'l') | |
428 | 1159 { |
1160 fprintf (stderr, "## unparsable arglist in %s (%s)\n", | |
1161 buffer, filename); | |
1162 continue; | |
1163 } | |
1164 } | |
1165 else if (c != '(') | |
1166 { | |
1167 fprintf (stderr, "## unparsable arglist in %s (%s)\n", | |
1168 buffer, filename); | |
1169 continue; | |
1170 } | |
1171 else | |
1172 while (c != ')') | |
853 | 1173 { |
1174 c = getc_skipping_iso2022 (infile); | |
1175 if (c < 0) | |
1176 continue; | |
1177 } | |
428 | 1178 skip_white (infile); |
1179 | |
1180 /* If the next three characters aren't `dquote bslash newline' | |
1181 then we're not reading a docstring. | |
930 | 1182 */ |
814 | 1183 if ((c = getc_skipping_iso2022 (infile)) != '"' || |
1184 (c = getc_skipping_iso2022 (infile)) != '\\' || | |
1185 (c = getc_skipping_iso2022 (infile)) != '\n') | |
428 | 1186 { |
1187 #ifdef DEBUG | |
1188 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
1189 buffer, filename); | |
1190 #endif | |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1191 no_docstring = 1; |
428 | 1192 } |
1193 } | |
1194 | |
930 | 1195 else if (! strcmp (buffer, "defvar") |
1196 || ! strcmp (buffer, "defconst")) | |
428 | 1197 { |
1198 char c1 = 0, c2 = 0; | |
1199 type = 'V'; | |
1200 read_lisp_symbol (infile, buffer); | |
1201 | |
1202 if (saved_string == 0) | |
1203 { | |
1204 | |
930 | 1205 /* Skip until the end of line; remember two previous chars. */ |
428 | 1206 while (c != '\n' && c >= 0) |
1207 { | |
1208 c2 = c1; | |
1209 c1 = c; | |
814 | 1210 c = getc_skipping_iso2022 (infile); |
428 | 1211 } |
930 | 1212 |
1213 /* If two previous characters were " and \, | |
1214 this is a doc string. Otherwise, there is none. */ | |
1215 if (c2 != '"' || c1 != '\\') | |
1216 { | |
1217 #ifdef DEBUG | |
1218 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
1219 buffer, filename); | |
1220 #endif | |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1221 no_docstring = 1; |
930 | 1222 } |
1223 } | |
1224 } | |
428 | 1225 |
930 | 1226 else if (! strcmp (buffer, "custom-declare-variable")) |
1227 { | |
1228 char c1 = 0, c2 = 0; | |
1229 type = 'V'; | |
1230 | |
1231 c = getc (infile); | |
1232 if (c == '\'') | |
1233 read_lisp_symbol (infile, buffer); | |
1234 else | |
1235 { | |
1236 if (c != '(') | |
1237 { | |
1238 fprintf (stderr, | |
1239 "## unparsable name in custom-declare-variable in %s\n", | |
1240 filename); | |
1241 continue; | |
1242 } | |
1243 read_lisp_symbol (infile, buffer); | |
1244 if (strcmp (buffer, "quote")) | |
1245 { | |
1246 fprintf (stderr, | |
1247 "## unparsable name in custom-declare-variable in %s\n", | |
1248 filename); | |
1249 continue; | |
1250 } | |
1251 read_lisp_symbol (infile, buffer); | |
1252 c = getc (infile); | |
1253 if (c != ')') | |
1254 { | |
1255 fprintf (stderr, | |
1256 "## unparsable quoted name in custom-declare-variable in %s\n", | |
1257 filename); | |
1258 continue; | |
1259 } | |
1260 } | |
1261 | |
1262 if (saved_string == 0) | |
1263 { | |
1264 /* Skip to end of line; remember the two previous chars. */ | |
1265 while (c != '\n' && c >= 0) | |
1266 { | |
1267 c2 = c1; | |
1268 c1 = c; | |
1269 c = getc_skipping_iso2022 (infile); | |
1270 } | |
1271 | |
428 | 1272 /* If two previous characters were " and \, |
1273 this is a doc string. Otherwise, there is none. */ | |
1274 if (c2 != '"' || c1 != '\\') | |
1275 { | |
1276 #ifdef DEBUG | |
1277 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
1278 buffer, filename); | |
1279 #endif | |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1280 no_docstring = 1; |
428 | 1281 } |
1282 } | |
1283 } | |
1284 | |
1285 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias")) | |
1286 { | |
1287 char c1 = 0, c2 = 0; | |
1288 type = 'F'; | |
1289 | |
814 | 1290 c = getc_skipping_iso2022 (infile); |
428 | 1291 if (c == '\'') |
1292 read_lisp_symbol (infile, buffer); | |
1293 else | |
1294 { | |
1295 if (c != '(') | |
1296 { | |
1297 fprintf (stderr, "## unparsable name in fset in %s\n", | |
1298 filename); | |
1299 continue; | |
1300 } | |
1301 read_lisp_symbol (infile, buffer); | |
1302 if (strcmp (buffer, "quote")) | |
1303 { | |
1304 fprintf (stderr, "## unparsable name in fset in %s\n", | |
1305 filename); | |
1306 continue; | |
1307 } | |
1308 read_lisp_symbol (infile, buffer); | |
814 | 1309 c = getc_skipping_iso2022 (infile); |
428 | 1310 if (c != ')') |
1311 { | |
1312 fprintf (stderr, | |
1313 "## unparsable quoted name in fset in %s\n", | |
1314 filename); | |
1315 continue; | |
1316 } | |
1317 } | |
1318 | |
1319 if (saved_string == 0) | |
1320 { | |
930 | 1321 /* Skip to end of line; remember the two previous chars. */ |
428 | 1322 while (c != '\n' && c >= 0) |
1323 { | |
1324 c2 = c1; | |
1325 c1 = c; | |
814 | 1326 c = getc_skipping_iso2022 (infile); |
428 | 1327 } |
930 | 1328 |
428 | 1329 /* If two previous characters were " and \, |
1330 this is a doc string. Otherwise, there is none. */ | |
1331 if (c2 != '"' || c1 != '\\') | |
1332 { | |
1333 #ifdef DEBUG | |
1334 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
1335 buffer, filename); | |
1336 #endif | |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1337 no_docstring = 1; |
428 | 1338 } |
1339 } | |
1340 } | |
1341 | |
1342 else if (! strcmp (buffer, "autoload")) | |
1343 { | |
1344 type = 'F'; | |
814 | 1345 c = getc_skipping_iso2022 (infile); |
428 | 1346 if (c == '\'') |
1347 read_lisp_symbol (infile, buffer); | |
1348 else | |
1349 { | |
1350 if (c != '(') | |
1351 { | |
1352 fprintf (stderr, "## unparsable name in autoload in %s\n", | |
1353 filename); | |
1354 continue; | |
1355 } | |
1356 read_lisp_symbol (infile, buffer); | |
1357 if (strcmp (buffer, "quote")) | |
1358 { | |
1359 fprintf (stderr, "## unparsable name in autoload in %s\n", | |
1360 filename); | |
1361 continue; | |
1362 } | |
1363 read_lisp_symbol (infile, buffer); | |
814 | 1364 c = getc_skipping_iso2022 (infile); |
428 | 1365 if (c != ')') |
1366 { | |
1367 fprintf (stderr, | |
1368 "## unparsable quoted name in autoload in %s\n", | |
1369 filename); | |
1370 continue; | |
1371 } | |
1372 } | |
1373 skip_white (infile); | |
814 | 1374 if ((c = getc_skipping_iso2022 (infile)) != '\"') |
428 | 1375 { |
1376 fprintf (stderr, "## autoload of %s unparsable (%s)\n", | |
1377 buffer, filename); | |
1378 continue; | |
1379 } | |
1380 read_c_string (infile, 0, 0); | |
1381 skip_white (infile); | |
1382 | |
1383 if (saved_string == 0) | |
1384 { | |
1385 /* If the next three characters aren't `dquote bslash newline' | |
1386 then we're not reading a docstring. */ | |
814 | 1387 if ((c = getc_skipping_iso2022 (infile)) != '"' || |
1388 (c = getc_skipping_iso2022 (infile)) != '\\' || | |
1389 (c = getc_skipping_iso2022 (infile)) != '\n') | |
428 | 1390 { |
1391 #ifdef DEBUG | |
1392 fprintf (stderr, "## non-docstring in %s (%s)\n", | |
1393 buffer, filename); | |
1394 #endif | |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1395 no_docstring = 1; |
428 | 1396 } |
1397 } | |
1398 } | |
1399 | |
814 | 1400 #if 0 /* causes crash */ |
930 | 1401 else if (! strcmp (buffer, "if") |
1402 || ! strcmp (buffer, "byte-code")) | |
428 | 1403 ; |
1404 #endif | |
1405 | |
1406 else | |
1407 { | |
1408 #ifdef DEBUG | |
1409 fprintf (stderr, "## unrecognized top-level form, %s (%s)\n", | |
1410 buffer, filename); | |
1411 #endif | |
1412 continue; | |
1413 } | |
1414 | |
1415 /* At this point, we should either use the previous | |
1416 dynamic doc string in saved_string | |
1417 or gobble a doc string from the input file. | |
930 | 1418 |
428 | 1419 In the latter case, the opening quote (and leading |
1420 backslash-newline) have already been read. */ | |
930 | 1421 |
3368 | 1422 put_filename (filename); /* XEmacs addition */ |
428 | 1423 putc (037, outfile); |
1424 putc (type, outfile); | |
1425 fprintf (outfile, "%s\n", buffer); | |
5206
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1426 if (!no_docstring) |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1427 { |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1428 if (saved_string) |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1429 { |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1430 fputs (saved_string, outfile); |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1431 /* Don't use one dynamic doc string twice. */ |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1432 free (saved_string); |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1433 saved_string = 0; |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1434 } |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1435 else |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1436 read_c_string (infile, 1, 0); |
39d74978fd32
Keep around file info for dumped functions and variables without docstrings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5076
diff
changeset
|
1437 } |
428 | 1438 } |
1439 fclose (infile); | |
1440 return 0; | |
1441 } |