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