Mercurial > hg > xemacs-beta

comparison lib-src/make-docfile.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 84b14dcb0985
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* Generate doc-string file for XEmacs from source files.
2 Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1998, 1999 J. Kean Johnston.
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.
37
38 Added 19.15/20.1: `-i site-packages' allow installer to dump extra packages
39 without modifying Makefiles, etc.
40 */
41
42 #define NO_SHORTNAMES /* Tell config not to load remap.h */
43 #include <../src/config.h>
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
54 #if defined(MSDOS) || defined(__CYGWIN32__)
55 #include <fcntl.h>
56 #endif /* MSDOS */
57 #ifdef WINDOWSNT
58 #include <direct.h>
59 #include <fcntl.h>
60 #include <io.h>
61 #include <stdlib.h>
62 #endif /* WINDOWSNT */
63
64 #include <sys/param.h>
65
66 #if defined(DOS_NT) || defined(__CYGWIN32__)
67 #define READ_TEXT "rt"
68 #define READ_BINARY "rb"
69 #define WRITE_BINARY "wb"
70 #define APPEND_BINARY "ab"
71 #else /* not DOS_NT */
72 #define READ_TEXT "r"
73 #define READ_BINARY "r"
74 #define WRITE_BINARY "w"
75 #define APPEND_BINARY "a"
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
94 static int scan_file (CONST char *filename);
95 static int read_c_string (FILE *, int, int);
96 static void write_c_args (FILE *out, CONST char *func, char *buf, int minargs,
97 int maxargs);
98 static int scan_c_file (CONST char *filename, CONST char *mode);
99 static void skip_white (FILE *);
100 static void read_lisp_symbol (FILE *, char *);
101 static int scan_lisp_file (CONST char *filename, CONST char *mode);
102
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
109 /* Name this program was invoked with. */
110 char *progname;
111
112 /* Set to 1 if this was invoked by ellcc */
113 int ellcc = 0;
114
115 /* Print error message. `s1' is printf control string, `s2' is arg for it. */
116
117 static void
118 error (CONST char *s1, CONST char *s2)
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
128 fatal (CONST char *s1, CONST char *s2)
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
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;
155 } else if (!(fp = fopen(extra_elcs, READ_BINARY))) {
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
180
181 int
182 main (int argc, char **argv)
183 {
184 int i;
185 int err_count = 0;
186 int first_infile;
187 char *extra_elcs = NULL;
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 {
212 outfile = fopen (argv[i + 1], WRITE_BINARY);
213 i += 2;
214 }
215 if (argc > i + 1 && !strcmp (argv[i], "-a"))
216 {
217 outfile = fopen (argv[i + 1], APPEND_BINARY);
218 i += 2;
219 }
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 }
226 if (argc > i + 1 && !strcmp (argv[i], "-d"))
227 {
228 chdir (argv[i + 1]);
229 i += 2;
230 }
231
232 if (argc > (i + 1) && !strcmp(argv[i], "-i")) {
233 extra_elcs = argv[i + 1];
234 i += 2;
235 }
236
237 if (outfile == 0)
238 fatal ("No output file specified", "");
239
240 if (ellcc)
241 fprintf (outfile, "{\n");
242
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 }
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
264 putc ('\n', outfile);
265 if (ellcc)
266 fprintf (outfile, "}\n\n");
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
277 scan_file (CONST char *filename)
278 {
279 int len = strlen (filename);
280 if (ellcc == 0 && len > 4 && !strcmp (filename + len - 4, ".elc"))
281 {
282 Current_file_type = elc_file;
283 return scan_lisp_file (filename, READ_BINARY);
284 }
285 else if (ellcc == 0 && len > 3 && !strcmp (filename + len - 3, ".el"))
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
306 static int
307 read_c_string (FILE *infile, int printflag, int c_docstring)
308 {
309 register int c;
310 char *p = buf;
311 int start = -1;
312
313 c = getc (infile);
314 while (c != EOF)
315 {
316 while ((c_docstring || c != '"') && c != EOF)
317 {
318 if (start)
319 {
320 if (c == '*')
321 {
322 int cc = getc (infile);
323 if (cc == '/')
324 break;
325 else
326 ungetc (cc, infile);
327 }
328
329 if (start != -1)
330 {
331 if (printflag > 0)
332 {
333 if (ellcc)
334 fprintf (outfile, "\\n\\");
335 putc ('\n', outfile);
336 }
337 else if (printflag < 0)
338 *p++ = '\n';
339 }
340 }
341
342 if (c == '\\')
343 {
344 c = getc (infile);
345 if (c == '\n')
346 {
347 c = getc (infile);
348 start = 1;
349 continue;
350 }
351 if (!c_docstring && c == 'n')
352 c = '\n';
353 if (c == 't')
354 c = '\t';
355 }
356 if (c == '\n')
357 start = 1;
358 else
359 {
360 start = 0;
361 if (printflag > 0) {
362 if (ellcc && c == '"')
363 putc ('\\', outfile);
364 putc (c, outfile);
365 }
366 else if (printflag < 0)
367 *p++ = c;
368 }
369 c = getc (infile);
370 }
371 /* look for continuation of string */
372 if (Current_file_type == c_file)
373 {
374 while (isspace (c = getc (infile)))
375 ;
376 if (c != '"')
377 break;
378 }
379 else
380 {
381 c = getc (infile);
382 if (c != '"')
383 break;
384 /* If we had a "", concatenate the two strings. */
385 }
386 c = getc (infile);
387 }
388
389 if (printflag < 0)
390 *p = 0;
391
392 return c;
393 }
394
395 /* Write to file OUT the argument names of function FUNC, whose text is in BUF.
396 MINARGS and MAXARGS are the minimum and maximum number of arguments. */
397
398 static void
399 write_c_args (FILE *out, CONST char *func, char *buff, int minargs,
400 int maxargs)
401 {
402 register char *p;
403 int in_ident = 0;
404 int just_spaced = 0;
405 #if 0
406 int need_space = 1;
407
408 fprintf (out, "(%s", func);
409 #else
410 /* XEmacs - "arguments:" is for parsing the docstring. FSF's help system
411 doesn't parse the docstring for arguments like we do, so we're also
412 going to omit the function name to preserve compatibility with elisp
413 that parses the docstring. Finally, not prefixing the arglist with
414 anything is asking for trouble because it's not uncommon to have an
415 unescaped parenthesis at the beginning of a line. --Stig */
416 fprintf (out, "arguments: (");
417 #endif
418
419 if (*buff == '(')
420 ++buff;
421
422 for (p = buff; *p; p++)
423 {
424 char c = *p;
425 int ident_start = 0;
426
427 /* Add support for ANSI prototypes. Hop over
428 "Lisp_Object" string (the only C type allowed in DEFUNs) */
429 static char lo[] = "Lisp_Object";
430 if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident &&
431 (strncmp (p, lo, sizeof (lo) - 1) == 0) &&
432 isspace(*(p + sizeof (lo) - 1)))
433 {
434 p += (sizeof (lo) - 1);
435 while (isspace (*p))
436 p++;
437 c = *p;
438 }
439
440 /* Notice when we start printing a new identifier. */
441 if (C_IDENTIFIER_CHAR_P (c) != in_ident)
442 {
443 if (!in_ident)
444 {
445 in_ident = 1;
446 ident_start = 1;
447 #if 0
448 /* XEmacs - This goes along with the change above. */
449 if (need_space)
450 putc (' ', out);
451 #endif
452 if (minargs == 0 && maxargs > 0)
453 fprintf (out, "&optional ");
454 just_spaced = 1;
455
456 minargs--;
457 maxargs--;
458 }
459 else
460 in_ident = 0;
461 }
462
463 /* Print the C argument list as it would appear in lisp:
464 print underscores as hyphens, and print commas as spaces.
465 Collapse adjacent spaces into one. */
466 if (c == '_') c = '-';
467 if (c == ',') c = ' ';
468
469 /* If the C argument name ends with `_', change it to ' ',
470 to allow use of C reserved words or global symbols as Lisp args. */
471 if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1]))
472 {
473 in_ident = 0;
474 just_spaced = 0;
475 }
476 else if (c != ' ' || ! just_spaced)
477 {
478 if (c >= 'a' && c <= 'z')
479 /* Upcase the letter. */
480 c += 'A' - 'a';
481 putc (c, out);
482 }
483
484 just_spaced = (c == ' ');
485 #if 0
486 need_space = 0;
487 #endif
488 }
489 if (!ellcc)
490 putc ('\n', out); /* XEmacs addition */
491 }
492
493 /* Read through a c file. If a .o file is named,
494 the corresponding .c file is read instead.
495 Looks for DEFUN constructs such as are defined in ../src/lisp.h.
496 Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED. */
497
498 static int
499 scan_c_file (CONST char *filename, CONST char *mode)
500 {
501 FILE *infile;
502 register int c;
503 register int commas;
504 register int defunflag;
505 register int defvarperbufferflag = 0;
506 register int defvarflag;
507 int minargs, maxargs;
508 int l = strlen (filename);
509 char f[MAXPATHLEN];
510
511 if (l > sizeof (f))
512 {
513 #ifdef ENAMETOOLONG
514 errno = ENAMETOOLONG;
515 #else
516 errno = EINVAL;
517 #endif
518 return (0);
519 }
520
521 strcpy (f, filename);
522 if (f[l - 1] == 'o')
523 f[l - 1] = 'c';
524 infile = fopen (f, mode);
525
526 /* No error if non-ex input file */
527 if (infile == NULL)
528 {
529 perror (f);
530 return 0;
531 }
532
533 c = '\n';
534 while (!feof (infile))
535 {
536 if (c != '\n')
537 {
538 c = getc (infile);
539 continue;
540 }
541 c = getc (infile);
542 if (c == ' ')
543 {
544 while (c == ' ')
545 c = getc (infile);
546 if (c != 'D')
547 continue;
548 c = getc (infile);
549 if (c != 'E')
550 continue;
551 c = getc (infile);
552 if (c != 'F')
553 continue;
554 c = getc (infile);
555 if (c != 'V')
556 continue;
557 c = getc (infile);
558 if (c != 'A')
559 continue;
560 c = getc (infile);
561 if (c != 'R')
562 continue;
563 c = getc (infile);
564 if (c != '_')
565 continue;
566
567 defvarflag = 1;
568 defunflag = 0;
569
570 c = getc (infile);
571 /* Note that this business doesn't apply under XEmacs.
572 DEFVAR_BUFFER_LOCAL in XEmacs behaves normally. */
573 defvarperbufferflag = (c == 'P');
574
575 c = getc (infile);
576 }
577 else if (c == 'D')
578 {
579 c = getc (infile);
580 if (c != 'E')
581 continue;
582 c = getc (infile);
583 if (c != 'F')
584 continue;
585 c = getc (infile);
586 defunflag = (c == 'U');
587 defvarflag = 0;
588 c = getc (infile);
589 }
590 else continue;
591
592 while (c != '(')
593 {
594 if (c < 0)
595 goto eof;
596 c = getc (infile);
597 }
598
599 c = getc (infile);
600 if (c != '"')
601 continue;
602 c = read_c_string (infile, -1, 0);
603
604 if (defunflag)
605 commas = 4;
606 else if (defvarperbufferflag)
607 commas = 2;
608 else if (defvarflag)
609 commas = 1;
610 else /* For DEFSIMPLE and DEFPRED */
611 commas = 2;
612
613 while (commas)
614 {
615 if (c == ',')
616 {
617 commas--;
618 if (defunflag && (commas == 1 || commas == 2))
619 {
620 do
621 c = getc (infile);
622 while (c == ' ' || c == '\n' || c == '\t')
623 ;
624 if (c < 0)
625 goto eof;
626 ungetc (c, infile);
627 if (commas == 2) /* pick up minargs */
628 fscanf (infile, "%d", &minargs);
629 else /* pick up maxargs */
630 if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
631 maxargs = -1;
632 else
633 fscanf (infile, "%d", &maxargs);
634 }
635 }
636 if (c < 0)
637 goto eof;
638 c = getc (infile);
639 }
640 while (c == ' ' || c == '\n' || c == '\t')
641 c = getc (infile);
642 if (c == '"')
643 c = read_c_string (infile, 0, 0);
644 if (defunflag | defvarflag)
645 {
646 while (c != '/')
647 c = getc (infile);
648 c = getc (infile);
649 while (c == '*')
650 c = getc (infile);
651 }
652 else
653 {
654 while (c != ',')
655 c = getc (infile);
656 c = getc (infile);
657 }
658 while (c == ' ' || c == '\n' || c == '\t')
659 c = getc (infile);
660 if (defunflag | defvarflag)
661 ungetc (c, infile);
662
663 if (defunflag || defvarflag || c == '"')
664 {
665 if (ellcc)
666 fprintf (outfile, " CDOC%s(\"%s\", \"\\\n",
667 defvarflag ? "SYM" : "SUBR", buf);
668 else
669 {
670 putc (037, outfile);
671 putc (defvarflag ? 'V' : 'F', outfile);
672 fprintf (outfile, "%s\n", buf);
673 }
674 c = read_c_string (infile, 1, (defunflag || defvarflag));
675
676 /* If this is a defun, find the arguments and print them. If
677 this function takes MANY or UNEVALLED args, then the C source
678 won't give the names of the arguments, so we shouldn't bother
679 trying to find them. */
680 if (defunflag && maxargs != -1)
681 {
682 char argbuf[1024], *p = argbuf;
683 #if 0 /* For old DEFUN's only */
684 while (c != ')')
685 {
686 if (c < 0)
687 goto eof;
688 c = getc (infile);
689 }
690 #endif
691 /* Skip into arguments. */
692 while (c != '(')
693 {
694 if (c < 0)
695 goto eof;
696 c = getc (infile);
697 }
698 /* Copy arguments into ARGBUF. */
699 *p++ = c;
700 do
701 *p++ = c = getc (infile);
702 while (c != ')');
703 *p = '\0';
704 /* Output them. */
705 if (ellcc)
706 fprintf (outfile, "\\n\\\n\\n\\\n");
707 else
708 fprintf (outfile, "\n\n");
709 write_c_args (outfile, buf, argbuf, minargs, maxargs);
710 }
711 if (ellcc)
712 fprintf (outfile, "\\n\");\n\n");
713 }
714 }
715 eof:
716 fclose (infile);
717 return 0;
718 }
719
720 /* Read a file of Lisp code, compiled or interpreted.
721 Looks for
722 (defun NAME ARGS DOCSTRING ...)
723 (defmacro NAME ARGS DOCSTRING ...)
724 (autoload (quote NAME) FILE DOCSTRING ...)
725 (defvar NAME VALUE DOCSTRING)
726 (defconst NAME VALUE DOCSTRING)
727 (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
728 (fset (quote NAME) #[... DOCSTRING ...])
729 (defalias (quote NAME) #[... DOCSTRING ...])
730 starting in column zero.
731 (quote NAME) may appear as 'NAME as well.
732
733 We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
734 When we find that, we save it for the following defining-form,
735 and we use that instead of reading a doc string within that defining-form.
736
737 For defun, defmacro, and autoload, we know how to skip over the arglist.
738 For defvar, defconst, and fset we skip to the docstring with a kludgy
739 formatting convention: all docstrings must appear on the same line as the
740 initial open-paren (the one in column zero) and must contain a backslash
741 and a double-quote immediately after the initial double-quote. No newlines
742 must appear between the beginning of the form and the first double-quote.
743 The only source file that must follow this convention is loaddefs.el; aside
744 from that, it is always the .elc file that we look at, and they are no
745 problem because byte-compiler output follows this convention.
746 The NAME and DOCSTRING are output.
747 NAME is preceded by `F' for a function or `V' for a variable.
748 An entry is output only if DOCSTRING has \ newline just after the opening "
749 */
750
751 static void
752 skip_white (FILE *infile)
753 {
754 char c = ' ';
755 while (c == ' ' || c == '\t' || c == '\n')
756 c = getc (infile);
757 ungetc (c, infile);
758 }
759
760 static void
761 read_lisp_symbol (FILE *infile, char *buffer)
762 {
763 char c;
764 char *fillp = buffer;
765
766 skip_white (infile);
767 while (1)
768 {
769 c = getc (infile);
770 if (c == '\\')
771 /* FSF has *(++fillp), which is wrong. */
772 *fillp++ = getc (infile);
773 else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')')
774 {
775 ungetc (c, infile);
776 *fillp = 0;
777 break;
778 }
779 else
780 *fillp++ = c;
781 }
782
783 if (! buffer[0])
784 fprintf (stderr, "## expected a symbol, got '%c'\n", c);
785
786 skip_white (infile);
787 }
788
789 static int
790 scan_lisp_file (CONST char *filename, CONST char *mode)
791 {
792 FILE *infile;
793 register int c;
794 char *saved_string = 0;
795
796 infile = fopen (filename, mode);
797 if (infile == NULL)
798 {
799 perror (filename);
800 return 0; /* No error */
801 }
802
803 c = '\n';
804 while (!feof (infile))
805 {
806 char buffer[BUFSIZ];
807 char type;
808
809 if (c != '\n')
810 {
811 c = getc (infile);
812 continue;
813 }
814 c = getc (infile);
815 /* Detect a dynamic doc string and save it for the next expression. */
816 if (c == '#')
817 {
818 c = getc (infile);
819 if (c == '@')
820 {
821 int length = 0;
822 int i;
823
824 /* Read the length. */
825 while ((c = getc (infile),
826 c >= '0' && c <= '9'))
827 {
828 length *= 10;
829 length += c - '0';
830 }
831
832 /* The next character is a space that is counted in the length
833 but not part of the doc string.
834 We already read it, so just ignore it. */
835 length--;
836
837 /* Read in the contents. */
838 if (saved_string != 0)
839 free (saved_string);
840 saved_string = (char *) xmalloc (length);
841 for (i = 0; i < length; i++)
842 saved_string[i] = getc (infile);
843 /* The last character is a ^_.
844 That is needed in the .elc file
845 but it is redundant in DOC. So get rid of it here. */
846 saved_string[length - 1] = 0;
847 /* Skip the newline. */
848 c = getc (infile);
849 while (c != '\n')
850 c = getc (infile);
851 }
852 continue;
853 }
854
855 if (c != '(')
856 continue;
857
858 read_lisp_symbol (infile, buffer);
859
860 if (! strcmp (buffer, "defun") ||
861 ! strcmp (buffer, "defmacro"))
862 {
863 type = 'F';
864 read_lisp_symbol (infile, buffer);
865
866 /* Skip the arguments: either "nil" or a list in parens */
867
868 c = getc (infile);
869 if (c == 'n') /* nil */
870 {
871 if ((c = getc (infile)) != 'i' ||
872 (c = getc (infile)) != 'l')
873 {
874 fprintf (stderr, "## unparsable arglist in %s (%s)\n",
875 buffer, filename);
876 continue;
877 }
878 }
879 else if (c != '(')
880 {
881 fprintf (stderr, "## unparsable arglist in %s (%s)\n",
882 buffer, filename);
883 continue;
884 }
885 else
886 while (c != ')')
887 c = getc (infile);
888 skip_white (infile);
889
890 /* If the next three characters aren't `dquote bslash newline'
891 then we're not reading a docstring.
892 */
893 if ((c = getc (infile)) != '"' ||
894 (c = getc (infile)) != '\\' ||
895 (c = getc (infile)) != '\n')
896 {
897 #ifdef DEBUG
898 fprintf (stderr, "## non-docstring in %s (%s)\n",
899 buffer, filename);
900 #endif
901 continue;
902 }
903 }
904
905 else if (! strcmp (buffer, "defvar") ||
906 ! strcmp (buffer, "defconst"))
907 {
908 char c1 = 0, c2 = 0;
909 type = 'V';
910 read_lisp_symbol (infile, buffer);
911
912 if (saved_string == 0)
913 {
914
915 /* Skip until the first newline; remember the two previous chars. */
916 while (c != '\n' && c >= 0)
917 {
918 /* ### Kludge -- Ignore any ESC x x ISO2022 sequences */
919 if (c == 27)
920 {
921 getc (infile);
922 getc (infile);
923 goto nextchar;
924 }
925
926 c2 = c1;
927 c1 = c;
928 nextchar:
929 c = getc (infile);
930 }
931
932 /* If two previous characters were " and \,
933 this is a doc string. Otherwise, there is none. */
934 if (c2 != '"' || c1 != '\\')
935 {
936 #ifdef DEBUG
937 fprintf (stderr, "## non-docstring in %s (%s)\n",
938 buffer, filename);
939 #endif
940 continue;
941 }
942 }
943 }
944
945 else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
946 {
947 char c1 = 0, c2 = 0;
948 type = 'F';
949
950 c = getc (infile);
951 if (c == '\'')
952 read_lisp_symbol (infile, buffer);
953 else
954 {
955 if (c != '(')
956 {
957 fprintf (stderr, "## unparsable name in fset in %s\n",
958 filename);
959 continue;
960 }
961 read_lisp_symbol (infile, buffer);
962 if (strcmp (buffer, "quote"))
963 {
964 fprintf (stderr, "## unparsable name in fset in %s\n",
965 filename);
966 continue;
967 }
968 read_lisp_symbol (infile, buffer);
969 c = getc (infile);
970 if (c != ')')
971 {
972 fprintf (stderr,
973 "## unparsable quoted name in fset in %s\n",
974 filename);
975 continue;
976 }
977 }
978
979 if (saved_string == 0)
980 {
981 /* Skip until the first newline; remember the two previous chars. */
982 while (c != '\n' && c >= 0)
983 {
984 c2 = c1;
985 c1 = c;
986 c = getc (infile);
987 }
988
989 /* If two previous characters were " and \,
990 this is a doc string. Otherwise, there is none. */
991 if (c2 != '"' || c1 != '\\')
992 {
993 #ifdef DEBUG
994 fprintf (stderr, "## non-docstring in %s (%s)\n",
995 buffer, filename);
996 #endif
997 continue;
998 }
999 }
1000 }
1001
1002 else if (! strcmp (buffer, "autoload"))
1003 {
1004 type = 'F';
1005 c = getc (infile);
1006 if (c == '\'')
1007 read_lisp_symbol (infile, buffer);
1008 else
1009 {
1010 if (c != '(')
1011 {
1012 fprintf (stderr, "## unparsable name in autoload in %s\n",
1013 filename);
1014 continue;
1015 }
1016 read_lisp_symbol (infile, buffer);
1017 if (strcmp (buffer, "quote"))
1018 {
1019 fprintf (stderr, "## unparsable name in autoload in %s\n",
1020 filename);
1021 continue;
1022 }
1023 read_lisp_symbol (infile, buffer);
1024 c = getc (infile);
1025 if (c != ')')
1026 {
1027 fprintf (stderr,
1028 "## unparsable quoted name in autoload in %s\n",
1029 filename);
1030 continue;
1031 }
1032 }
1033 skip_white (infile);
1034 if ((c = getc (infile)) != '\"')
1035 {
1036 fprintf (stderr, "## autoload of %s unparsable (%s)\n",
1037 buffer, filename);
1038 continue;
1039 }
1040 read_c_string (infile, 0, 0);
1041 skip_white (infile);
1042
1043 if (saved_string == 0)
1044 {
1045 /* If the next three characters aren't `dquote bslash newline'
1046 then we're not reading a docstring. */
1047 if ((c = getc (infile)) != '"' ||
1048 (c = getc (infile)) != '\\' ||
1049 (c = getc (infile)) != '\n')
1050 {
1051 #ifdef DEBUG
1052 fprintf (stderr, "## non-docstring in %s (%s)\n",
1053 buffer, filename);
1054 #endif
1055 continue;
1056 }
1057 }
1058 }
1059
1060 #if 0 /* causes crash */
1061 else if (! strcmp (buffer, "if") ||
1062 ! strcmp (buffer, "byte-code"))
1063 ;
1064 #endif
1065
1066 else
1067 {
1068 #ifdef DEBUG
1069 fprintf (stderr, "## unrecognized top-level form, %s (%s)\n",
1070 buffer, filename);
1071 #endif
1072 continue;
1073 }
1074
1075 /* At this point, we should either use the previous
1076 dynamic doc string in saved_string
1077 or gobble a doc string from the input file.
1078
1079 In the latter case, the opening quote (and leading
1080 backslash-newline) have already been read. */
1081 putc ('\n', outfile); /* XEmacs addition */
1082 putc (037, outfile);
1083 putc (type, outfile);
1084 fprintf (outfile, "%s\n", buffer);
1085 if (saved_string)
1086 {
1087 fputs (saved_string, outfile);
1088 /* Don't use one dynamic doc string twice. */
1089 free (saved_string);
1090 saved_string = 0;
1091 }
1092 else
1093 read_c_string (infile, 1, 0);
1094 }
1095 fclose (infile);
1096 return 0;
1097 }