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