Mercurial > hg > xemacs-beta
annotate lib-src/make-docfile.c @ 5276:dd2976af8783
Add some missing #includes, termcap.c, hopefully fixing Adam Sjoegren's build.
2010-09-18 Aidan Kehoe <kehoea@parhasard.net>
* termcap.c:
Add a couple of missing includes here, which should fix builds
that use this file. (I have no access to such builds, but Mats'
buildbot shows output that indicates they fail at link time since
DEVICE_BAUD_RATE and IS_DIRECTORY_SEP are available.)
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Sat, 18 Sep 2010 15:03:54 +0100 |
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 } |