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