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