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