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