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