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 }