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    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       else if (c != ' ' || ! just_spaced)
 481         {
 482           if (c >= 'a' && c <= 'z')
 483             /* Upcase the letter.  */
 484             c += 'A' - 'a';
 485           putc (c, out);
 486         }
 487
 488       just_spaced = (c == ' ');
 489 #if 0
 490       need_space = 0;
 491 #endif
 492     }
 493   if (!ellcc)
 494     putc ('\n', out); /* XEmacs addition */
 495 }
 496 \f
 497 /* Read through a c file.  If a .o file is named,
 498    the corresponding .c file is read instead.
 499    Looks for DEFUN constructs such as are defined in ../src/lisp.h.
 500    Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED.  */
 501
 502 static int
 503 scan_c_file (const char *filename, const char *mode)
 504 {
 505   FILE *infile;
 506   register int c;
 507   register int commas;
 508   register int defunflag;
 509   register int defvarperbufferflag = 0;
 510   register int defvarflag;
 511   int minargs, maxargs;
 512   int l = strlen (filename);
 513   char f[MAXPATHLEN];
 514
 515   if (l > sizeof (f))
 516   {
 517 #ifdef ENAMETOOLONG
 518     errno = ENAMETOOLONG;
 519 #else
 520     errno = EINVAL;
 521 #endif
 522     return (0);
 523   }
 524
 525   strcpy (f, filename);
 526   if (f[l - 1] == 'o')
 527     f[l - 1] = 'c';
 528   infile = fopen (f, mode);
 529
 530   /* No error if non-ex input file */
 531   if (infile == NULL)
 532     {
 533       perror (f);
 534       return 0;
 535     }
 536
 537   c = '\n';
 538   while (!feof (infile))
 539     {
 540       if (c != '\n')
 541         {
 542           c = getc (infile);
 543           continue;
 544         }
 545       c = getc (infile);
 546       if (c == ' ')
 547         {
 548           while (c == ' ')
 549             c = getc (infile);
 550           if (c != 'D')
 551             continue;
 552           c = getc (infile);
 553           if (c != 'E')
 554             continue;
 555           c = getc (infile);
 556           if (c != 'F')
 557             continue;
 558           c = getc (infile);
 559           if (c != 'V')
 560             continue;
 561           c = getc (infile);
 562           if (c != 'A')
 563             continue;
 564           c = getc (infile);
 565           if (c != 'R')
 566             continue;
 567           c = getc (infile);
 568           if (c != '_')
 569             continue;
 570
 571           defvarflag = 1;
 572           defunflag = 0;
 573
 574           c = getc (infile);
 575           /* Note that this business doesn't apply under XEmacs.
 576              DEFVAR_BUFFER_LOCAL in XEmacs behaves normally. */
 577           defvarperbufferflag = (c == 'P');
 578
 579           c = getc (infile);
 580         }
 581       else if (c == 'D')
 582         {
 583           c = getc (infile);
 584           if (c != 'E')
 585             continue;
 586           c = getc (infile);
 587           if (c != 'F')
 588             continue;
 589           c = getc (infile);
 590           defunflag = (c == 'U');
 591           defvarflag = 0;
 592           c = getc (infile);
 593         }
 594       else continue;
 595
 596       while (c != '(')
 597         {
 598           if (c < 0)
 599             goto eof;
 600           c = getc (infile);
 601         }
 602
 603       c = getc (infile);
 604       if (c != '"')
 605         continue;
 606       c = read_c_string (infile, -1, 0);
 607
 608       if (defunflag)
 609         commas = 4;
 610       else if (defvarperbufferflag)
 611         commas = 2;
 612       else if (defvarflag)
 613         commas = 1;
 614       else  /* For DEFSIMPLE and DEFPRED */
 615         commas = 2;
 616
 617       while (commas)
 618         {
 619           if (c == ',')
 620             {
 621               commas--;
 622               if (defunflag && (commas == 1 || commas == 2))
 623                 {
 624                   do
 625                     c = getc (infile);
 626                   while (c == ' ' || c == '\n' || c == '\t')
 627                     ;
 628                   if (c < 0)
 629                     goto eof;
 630                   ungetc (c, infile);
 631                   if (commas == 2) /* pick up minargs */
 632                     fscanf (infile, "%d", &minargs);
 633                   else /* pick up maxargs */
 634                     if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
 635                       maxargs = -1;
 636                     else
 637                       fscanf (infile, "%d", &maxargs);
 638                 }
 639             }
 640           if (c < 0)
 641             goto eof;
 642           c = getc (infile);
 643         }
 644       while (c == ' ' || c == '\n' || c == '\t')
 645         c = getc (infile);
 646       if (c == '"')
 647         c = read_c_string (infile, 0, 0);
 648       if (defunflag | defvarflag)
 649         {
 650           while (c != '/')
 651             c = getc (infile);
 652           c = getc (infile);
 653           while (c == '*')
 654             c = getc (infile);
 655         }
 656       else
 657         {
 658           while (c != ',')
 659             c = getc (infile);
 660           c = getc (infile);
 661         }
 662       while (c == ' ' || c == '\n' || c == '\t')
 663         c = getc (infile);
 664       if (defunflag | defvarflag)
 665         ungetc (c, infile);
 666
 667       if (defunflag || defvarflag || c == '"')
 668         {
 669       if (ellcc)
 670         fprintf (outfile, "  CDOC%s(\"%s\", \"\\\n",
 671                  defvarflag ? "SYM" : "SUBR", buf);
 672       else
 673         {
 674           putc (037, outfile);
 675           putc (defvarflag ? 'V' : 'F', outfile);
 676           fprintf (outfile, "%s\n", buf);
 677         }
 678           c = read_c_string (infile, 1, (defunflag || defvarflag));
 679
 680           /* If this is a defun, find the arguments and print them.  If
 681              this function takes MANY or UNEVALLED args, then the C source
 682              won't give the names of the arguments, so we shouldn't bother
 683              trying to find them.  */
 684           if (defunflag && maxargs != -1)
 685             {
 686               char argbuf[1024], *p = argbuf;
 687 #if 0 /* For old DEFUN's only */
 688               while (c != ')')
 689                 {
 690                   if (c < 0)
 691                     goto eof;
 692                   c = getc (infile);
 693                 }
 694 #endif
 695               /* Skip into arguments.  */
 696               while (c != '(')
 697                 {
 698                   if (c < 0)
 699                     goto eof;
 700                   c = getc (infile);
 701                 }
 702               /* Copy arguments into ARGBUF.  */
 703               *p++ = c;
 704               do
 705                 *p++ = c = getc (infile);
 706               while (c != ')');
 707               *p = '\0';
 708               /* Output them.  */
 709           if (ellcc)
 710             fprintf (outfile, "\\n\\\n\\n\\\n");
 711           else
 712             fprintf (outfile, "\n\n");
 713               write_c_args (outfile, buf, argbuf, minargs, maxargs);
 714             }
 715       if (ellcc)
 716         fprintf (outfile, "\\n\");\n\n");
 717         }
 718     }
 719  eof:
 720   fclose (infile);
 721   return 0;
 722 }
 723 \f
 724 /* Read a file of Lisp code, compiled or interpreted.
 725  Looks for
 726   (defun NAME ARGS DOCSTRING ...)
 727   (defmacro NAME ARGS DOCSTRING ...)
 728   (autoload (quote NAME) FILE DOCSTRING ...)
 729   (defvar NAME VALUE DOCSTRING)
 730   (defconst NAME VALUE DOCSTRING)
 731   (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
 732   (fset (quote NAME) #[... DOCSTRING ...])
 733   (defalias (quote NAME) #[... DOCSTRING ...])
 734  starting in column zero.
 735  (quote NAME) may appear as 'NAME as well.
 736
 737  We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
 738  When we find that, we save it for the following defining-form,
 739  and we use that instead of reading a doc string within that defining-form.
 740
 741  For defun, defmacro, and autoload, we know how to skip over the arglist.
 742  For defvar, defconst, and fset we skip to the docstring with a kludgy
 743  formatting convention: all docstrings must appear on the same line as the
 744  initial open-paren (the one in column zero) and must contain a backslash
 745  and a double-quote immediately after the initial double-quote.  No newlines
 746  must appear between the beginning of the form and the first double-quote.
 747  The only source file that must follow this convention is loaddefs.el; aside
 748  from that, it is always the .elc file that we look at, and they are no
 749  problem because byte-compiler output follows this convention.
 750  The NAME and DOCSTRING are output.
 751  NAME is preceded by `F' for a function or `V' for a variable.
 752  An entry is output only if DOCSTRING has \ newline just after the opening "
 753  */
 754
 755 static void
 756 skip_white (FILE *infile)
 757 {
 758   char c = ' ';
 759   while (c == ' ' || c == '\t' || c == '\n')
 760     c = getc (infile);
 761   ungetc (c, infile);
 762 }
 763
 764 static void
 765 read_lisp_symbol (FILE *infile, char *buffer)
 766 {
 767   char c;
 768   char *fillp = buffer;
 769
 770   skip_white (infile);
 771   while (1)
 772     {
 773       c = getc (infile);
 774       if (c == '\\')
 775         /* FSF has *(++fillp), which is wrong. */
 776         *fillp++ = getc (infile);
 777       else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')')
 778         {
 779           ungetc (c, infile);
 780           *fillp = 0;
 781           break;
 782         }
 783       else
 784         *fillp++ = c;
 785     }
 786
 787   if (! buffer[0])
 788     fprintf (stderr, "## expected a symbol, got '%c'\n", c);
 789
 790   skip_white (infile);
 791 }
 792
 793 static int
 794 scan_lisp_file (const char *filename, const char *mode)
 795 {
 796   FILE *infile;
 797   register int c;
 798   char *saved_string = 0;
 799
 800   infile = fopen (filename, mode);
 801   if (infile == NULL)
 802     {
 803       perror (filename);
 804       return 0;                         /* No error */
 805     }
 806
 807   c = '\n';
 808   while (!feof (infile))
 809     {
 810       char buffer[BUFSIZ];
 811       char type;
 812
 813       if (c != '\n')
 814         {
 815           c = getc (infile);
 816           continue;
 817         }
 818       c = getc (infile);
 819       /* Detect a dynamic doc string and save it for the next expression.  */
 820       if (c == '#')
 821         {
 822           c = getc (infile);
 823           if (c == '@')
 824             {
 825               int length = 0;
 826               int i;
 827
 828               /* Read the length.  */
 829               while ((c = getc (infile),
 830                       c >= '0' && c <= '9'))
 831                 {
 832                   length *= 10;
 833                   length += c - '0';
 834                 }
 835
 836               /* The next character is a space that is counted in the length
 837                  but not part of the doc string.
 838                  We already read it, so just ignore it.  */
 839               length--;
 840
 841               /* Read in the contents.  */
 842               if (saved_string != 0)
 843                 free (saved_string);
 844               saved_string = (char *) xmalloc (length);
 845               for (i = 0; i < length; i++)
 846                 saved_string[i] = getc (infile);
 847               /* The last character is a ^_.
 848                  That is needed in the .elc file
 849                  but it is redundant in DOC.  So get rid of it here.  */
 850               saved_string[length - 1] = 0;
 851               /* Skip the newline.  */
 852               c = getc (infile);
 853               while (c != '\n')
 854                 c = getc (infile);
 855             }
 856           continue;
 857         }
 858
 859       if (c != '(')
 860         continue;
 861
 862       read_lisp_symbol (infile, buffer);
 863
 864       if (! strcmp (buffer, "defun") ||
 865           ! strcmp (buffer, "defmacro"))
 866         {
 867           type = 'F';
 868           read_lisp_symbol (infile, buffer);
 869
 870           /* Skip the arguments: either "nil" or a list in parens */
 871
 872           c = getc (infile);
 873           if (c == 'n') /* nil */
 874             {
 875               if ((c = getc (infile)) != 'i' ||
 876                   (c = getc (infile)) != 'l')
 877                 {
 878                   fprintf (stderr, "## unparsable arglist in %s (%s)\n",
 879                            buffer, filename);
 880                   continue;
 881                 }
 882             }
 883           else if (c != '(')
 884             {
 885               fprintf (stderr, "## unparsable arglist in %s (%s)\n",
 886                        buffer, filename);
 887               continue;
 888             }
 889           else
 890             while (c != ')')
 891               c = getc (infile);
 892           skip_white (infile);
 893
 894           /* If the next three characters aren't `dquote bslash newline'
 895              then we're not reading a docstring.
 896            */
 897           if ((c = getc (infile)) != '"' ||
 898               (c = getc (infile)) != '\\' ||
 899               (c = getc (infile)) != '\n')
 900             {
 901 #ifdef DEBUG
 902               fprintf (stderr, "## non-docstring in %s (%s)\n",
 903                        buffer, filename);
 904 #endif
 905               continue;
 906             }
 907         }
 908
 909       else if (! strcmp (buffer, "defvar") ||
 910                ! strcmp (buffer, "defconst"))
 911         {
 912           char c1 = 0, c2 = 0;
 913           type = 'V';
 914           read_lisp_symbol (infile, buffer);
 915
 916           if (saved_string == 0)
 917             {
 918
 919               /* Skip until the first newline; remember the two previous chars. */
 920               while (c != '\n' && c >= 0)
 921                 {
 922                   /* #### Kludge -- Ignore any ESC x x ISO2022 sequences */
 923                   if (c == 27)
 924                     {
 925                       getc (infile);
 926                       getc (infile);
 927                       goto nextchar;
 928                     }
 929
 930                   c2 = c1;
 931                   c1 = c;
 932                 nextchar:
 933                   c = getc (infile);
 934                 }
 935
 936               /* If two previous characters were " and \,
 937                  this is a doc string.  Otherwise, there is none.  */
 938               if (c2 != '"' || c1 != '\\')
 939                 {
 940 #ifdef DEBUG
 941                   fprintf (stderr, "## non-docstring in %s (%s)\n",
 942                            buffer, filename);
 943 #endif
 944                   continue;
 945                 }
 946             }
 947         }
 948
 949       else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
 950         {
 951           char c1 = 0, c2 = 0;
 952           type = 'F';
 953
 954           c = getc (infile);
 955           if (c == '\'')
 956             read_lisp_symbol (infile, buffer);
 957           else
 958             {
 959               if (c != '(')
 960                 {
 961                   fprintf (stderr, "## unparsable name in fset in %s\n",
 962                            filename);
 963                   continue;
 964                 }
 965               read_lisp_symbol (infile, buffer);
 966               if (strcmp (buffer, "quote"))
 967                 {
 968                   fprintf (stderr, "## unparsable name in fset in %s\n",
 969                            filename);
 970                   continue;
 971                 }
 972               read_lisp_symbol (infile, buffer);
 973               c = getc (infile);
 974               if (c != ')')
 975                 {
 976                   fprintf (stderr,
 977                            "## unparsable quoted name in fset in %s\n",
 978                            filename);
 979                   continue;
 980                 }
 981             }
 982
 983           if (saved_string == 0)
 984             {
 985               /* Skip until the first newline; remember the two previous chars. */
 986               while (c != '\n' && c >= 0)
 987                 {
 988                   c2 = c1;
 989                   c1 = c;
 990                   c = getc (infile);
 991                 }
 992
 993               /* If two previous characters were " and \,
 994                  this is a doc string.  Otherwise, there is none.  */
 995               if (c2 != '"' || c1 != '\\')
 996                 {
 997 #ifdef DEBUG
 998                   fprintf (stderr, "## non-docstring in %s (%s)\n",
 999                            buffer, filename);
1000 #endif
1001                   continue;
1002                 }
1003             }
1004         }
1005
1006       else if (! strcmp (buffer, "autoload"))
1007         {
1008           type = 'F';
1009           c = getc (infile);
1010           if (c == '\'')
1011             read_lisp_symbol (infile, buffer);
1012           else
1013             {
1014               if (c != '(')
1015                 {
1016                   fprintf (stderr, "## unparsable name in autoload in %s\n",
1017                            filename);
1018                   continue;
1019                 }
1020               read_lisp_symbol (infile, buffer);
1021               if (strcmp (buffer, "quote"))
1022                 {
1023                   fprintf (stderr, "## unparsable name in autoload in %s\n",
1024                            filename);
1025                   continue;
1026                 }
1027               read_lisp_symbol (infile, buffer);
1028               c = getc (infile);
1029               if (c != ')')
1030                 {
1031                   fprintf (stderr,
1032                            "## unparsable quoted name in autoload in %s\n",
1033                            filename);
1034                   continue;
1035                 }
1036             }
1037           skip_white (infile);
1038           if ((c = getc (infile)) != '\"')
1039             {
1040               fprintf (stderr, "## autoload of %s unparsable (%s)\n",
1041                        buffer, filename);
1042               continue;
1043             }
1044           read_c_string (infile, 0, 0);
1045           skip_white (infile);
1046
1047           if (saved_string == 0)
1048             {
1049               /* If the next three characters aren't `dquote bslash newline'
1050                  then we're not reading a docstring.  */
1051               if ((c = getc (infile)) != '"'  ||
1052                   (c = getc (infile)) != '\\' ||
1053                   (c = getc (infile)) != '\n')
1054                 {
1055 #ifdef DEBUG
1056                   fprintf (stderr, "## non-docstring in %s (%s)\n",
1057                            buffer, filename);
1058 #endif
1059                   continue;
1060                 }
1061             }
1062         }
1063
1064 #if 0 /* causes crash */
1065       else if (! strcmp (buffer, "if") ||
1066                ! strcmp (buffer, "byte-code"))
1067         ;
1068 #endif
1069
1070       else
1071         {
1072 #ifdef DEBUG
1073           fprintf (stderr, "## unrecognized top-level form, %s (%s)\n",
1074                    buffer, filename);
1075 #endif
1076           continue;
1077         }
1078
1079       /* At this point, we should either use the previous
1080          dynamic doc string in saved_string
1081          or gobble a doc string from the input file.
1082
1083          In the latter case, the opening quote (and leading
1084          backslash-newline) have already been read.  */
1085       putc ('\n', outfile); /* XEmacs addition */
1086       putc (037, outfile);
1087       putc (type, outfile);
1088       fprintf (outfile, "%s\n", buffer);
1089       if (saved_string)
1090         {
1091           fputs (saved_string, outfile);
1092           /* Don't use one dynamic doc string twice.  */
1093           free (saved_string);
1094           saved_string = 0;
1095         }
1096       else
1097         read_c_string (infile, 1, 0);
1098     }
1099   fclose (infile);
1100   return 0;
1101 }