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 #include <unistd.h>
  50 #include <string.h>
  51 #include <ctype.h>
  52 #endif
  53
  54 #if defined(MSDOS) || defined(__CYGWIN32__)
  55 #include <fcntl.h>
  56 #endif /* MSDOS */
  57 #ifdef WINDOWSNT
  58 #include <direct.h>
  59 #include <fcntl.h>
  60 #include <io.h>
  61 #include <stdlib.h>
  62 #endif /* WINDOWSNT */
  63
  64 #include <sys/param.h>
  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 #define MDGET do { prevc = c; c = getc (infile); } while (0)
 307 static int
 308 read_c_string (FILE *infile, int printflag, int c_docstring)
 309 {
 310   register int prevc = 0, c = 0;
 311   char *p = buf;
 312   int start = -1;
 313
 314   MDGET;
 315   while (c != EOF)
 316     {
 317       while ((c_docstring || c != '"') && c != EOF)
 318         {
 319           if (c == '*')
 320             {
 321               int cc = getc (infile);
 322               if (cc == '/')
 323                 {
 324                   if (prevc != '\n')
 325                     {
 326                       if (printflag > 0)
 327                         {
 328                           if (ellcc)
 329                             fprintf (outfile, "\\n\\");
 330                           putc ('\n', outfile);
 331                         }
 332                       else if (printflag < 0)
 333                         *p++ = '\n';
 334                     }
 335                   break;
 336                 }
 337               else
 338                 ungetc (cc, infile);
 339             }
 340
 341           if (start == 1)
 342             {
 343               if (printflag > 0)
 344                 {
 345                   if (ellcc)
 346                     fprintf (outfile, "\\n\\");
 347                   putc ('\n', outfile);
 348                 }
 349               else if (printflag < 0)
 350                 *p++ = '\n';
 351             }
 352
 353           if (c == '\\')
 354             {
 355               MDGET;
 356               if (c == '\n')
 357                 {
 358                   MDGET;
 359                   start = 1;
 360                   continue;
 361                 }
 362               if (!c_docstring && c == 'n')
 363                 c = '\n';
 364               if (c == 't')
 365                 c = '\t';
 366             }
 367           if (c == '\n')
 368             start = 1;
 369           else
 370             {
 371               start = 0;
 372               if (printflag > 0)
 373                 {
 374                   if (ellcc && c == '"')
 375                     putc ('\\', outfile);
 376                   putc (c, outfile);
 377                 }
 378               else if (printflag < 0)
 379                 *p++ = c;
 380             }
 381           MDGET;
 382         }
 383       /* look for continuation of string */
 384       if (Current_file_type == c_file)
 385         {
 386           do
 387             {
 388               MDGET;
 389             }
 390           while (isspace (c));
 391           if (c != '"')
 392             break;
 393         }
 394       else
 395         {
 396           MDGET;
 397           if (c != '"')
 398             break;
 399           /* If we had a "", concatenate the two strings.  */
 400         }
 401       MDGET;
 402     }
 403
 404   if (printflag < 0)
 405     *p = 0;
 406
 407   return c;
 408 }
 409 \f
 410 /* Write to file OUT the argument names of function FUNC, whose text is in BUF.
 411    MINARGS and MAXARGS are the minimum and maximum number of arguments.  */
 412
 413 static void
 414 write_c_args (FILE *out, const char *func, char *buff, int minargs,
 415               int maxargs)
 416 {
 417   register char *p;
 418   int in_ident = 0;
 419   int just_spaced = 0;
 420 #if 0
 421   int need_space = 1;
 422
 423   fprintf (out, "(%s", func);
 424 #else
 425   /* XEmacs - "arguments:" is for parsing the docstring.  FSF's help system
 426      doesn't parse the docstring for arguments like we do, so we're also
 427      going to omit the function name to preserve compatibility with elisp
 428      that parses the docstring.  Finally, not prefixing the arglist with
 429      anything is asking for trouble because it's not uncommon to have an
 430      unescaped parenthesis at the beginning of a line. --Stig */
 431   fprintf (out, "arguments: (");
 432 #endif
 433
 434   if (*buff == '(')
 435     ++buff;
 436
 437   for (p = buff; *p; p++)
 438     {
 439       char c = *p;
 440       int ident_start = 0;
 441
 442       /* Add support for ANSI prototypes. Hop over
 443          "Lisp_Object" string (the only C type allowed in DEFUNs) */
 444       static char lo[] = "Lisp_Object";
 445       if ((C_IDENTIFIER_CHAR_P (c) != in_ident) && !in_ident &&
 446           (strncmp (p, lo, sizeof (lo) - 1) == 0) &&
 447           isspace((unsigned char) (* (p + sizeof (lo) - 1))))
 448         {
 449           p += (sizeof (lo) - 1);
 450           while (isspace ((unsigned char) (*p)))
 451             p++;
 452           c = *p;
 453         }
 454
 455       /* Notice when we start printing a new identifier.  */
 456       if (C_IDENTIFIER_CHAR_P (c) != in_ident)
 457         {
 458           if (!in_ident)
 459             {
 460               in_ident = 1;
 461               ident_start = 1;
 462 #if 0
 463               /* XEmacs - This goes along with the change above. */
 464               if (need_space)
 465                 putc (' ', out);
 466 #endif
 467               if (minargs == 0 && maxargs > 0)
 468                 fprintf (out, "&optional ");
 469               just_spaced = 1;
 470
 471               minargs--;
 472               maxargs--;
 473             }
 474           else
 475             in_ident = 0;
 476         }
 477
 478       /* Print the C argument list as it would appear in lisp:
 479          print underscores as hyphens, and print commas as spaces.
 480          Collapse adjacent spaces into one. */
 481       if (c == '_') c = '-';
 482       if (c == ',') c = ' ';
 483
 484       /* If the C argument name ends with `_', change it to ' ',
 485          to allow use of C reserved words or global symbols as Lisp args. */
 486       if (c == '-' && ! C_IDENTIFIER_CHAR_P (p[1]))
 487         {
 488           in_ident = 0;
 489           just_spaced = 0;
 490         }
 491       else if (c != ' ' || ! just_spaced)
 492         {
 493           if (c >= 'a' && c <= 'z')
 494             /* Upcase the letter.  */
 495             c += 'A' - 'a';
 496           putc (c, out);
 497         }
 498
 499       just_spaced = (c == ' ');
 500 #if 0
 501       need_space = 0;
 502 #endif
 503     }
 504   if (!ellcc)
 505     putc ('\n', out); /* XEmacs addition */
 506 }
 507 \f
 508 /* Read through a c file.  If a .o file is named,
 509    the corresponding .c file is read instead.
 510    Looks for DEFUN constructs such as are defined in ../src/lisp.h.
 511    Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED.  */
 512
 513 static int
 514 scan_c_file (const char *filename, const char *mode)
 515 {
 516   FILE *infile;
 517   register int c;
 518   register int commas;
 519   register int defunflag;
 520   register int defvarperbufferflag = 0;
 521   register int defvarflag;
 522   int minargs, maxargs;
 523   int l = strlen (filename);
 524   char f[MAXPATHLEN];
 525
 526   if (l > sizeof (f))
 527   {
 528 #ifdef ENAMETOOLONG
 529     errno = ENAMETOOLONG;
 530 #else
 531     errno = EINVAL;
 532 #endif
 533     return (0);
 534   }
 535
 536   strcpy (f, filename);
 537   if (f[l - 1] == 'o')
 538     f[l - 1] = 'c';
 539   infile = fopen (f, mode);
 540
 541   /* No error if non-ex input file */
 542   if (infile == NULL)
 543     {
 544       perror (f);
 545       return 0;
 546     }
 547
 548   c = '\n';
 549   while (!feof (infile))
 550     {
 551       if (c != '\n')
 552         {
 553           c = getc (infile);
 554           continue;
 555         }
 556       c = getc (infile);
 557       if (c == ' ')
 558         {
 559           while (c == ' ')
 560             c = getc (infile);
 561           if (c != 'D')
 562             continue;
 563           c = getc (infile);
 564           if (c != 'E')
 565             continue;
 566           c = getc (infile);
 567           if (c != 'F')
 568             continue;
 569           c = getc (infile);
 570           if (c != 'V')
 571             continue;
 572           c = getc (infile);
 573           if (c != 'A')
 574             continue;
 575           c = getc (infile);
 576           if (c != 'R')
 577             continue;
 578           c = getc (infile);
 579           if (c != '_')
 580             continue;
 581
 582           defvarflag = 1;
 583           defunflag = 0;
 584
 585           c = getc (infile);
 586           /* Note that this business doesn't apply under XEmacs.
 587              DEFVAR_BUFFER_LOCAL in XEmacs behaves normally. */
 588           defvarperbufferflag = (c == 'P');
 589
 590           c = getc (infile);
 591         }
 592       else if (c == 'D')
 593         {
 594           c = getc (infile);
 595           if (c != 'E')
 596             continue;
 597           c = getc (infile);
 598           if (c != 'F')
 599             continue;
 600           c = getc (infile);
 601           defunflag = (c == 'U');
 602           defvarflag = 0;
 603           c = getc (infile);
 604         }
 605       else continue;
 606
 607       while (c != '(')
 608         {
 609           if (c < 0)
 610             goto eof;
 611           c = getc (infile);
 612         }
 613
 614       c = getc (infile);
 615       if (c != '"')
 616         continue;
 617       c = read_c_string (infile, -1, 0);
 618
 619       if (defunflag)
 620         commas = 4;
 621       else if (defvarperbufferflag)
 622         commas = 2;
 623       else if (defvarflag)
 624         commas = 1;
 625       else  /* For DEFSIMPLE and DEFPRED */
 626         commas = 2;
 627
 628       while (commas)
 629         {
 630           if (c == ',')
 631             {
 632               commas--;
 633               if (defunflag && (commas == 1 || commas == 2))
 634                 {
 635                   do
 636                     c = getc (infile);
 637                   while (c == ' ' || c == '\n' || c == '\t')
 638                     ;
 639                   if (c < 0)
 640                     goto eof;
 641                   ungetc (c, infile);
 642                   if (commas == 2) /* pick up minargs */
 643                     fscanf (infile, "%d", &minargs);
 644                   else /* pick up maxargs */
 645                     if (c == 'M' || c == 'U') /* MANY || UNEVALLED */
 646                       maxargs = -1;
 647                     else
 648                       fscanf (infile, "%d", &maxargs);
 649                 }
 650             }
 651           if (c < 0)
 652             goto eof;
 653           c = getc (infile);
 654         }
 655       while (c == ' ' || c == '\n' || c == '\t')
 656         c = getc (infile);
 657       if (c == '"')
 658         c = read_c_string (infile, 0, 0);
 659       if (defunflag | defvarflag)
 660         {
 661           while (c != '/')
 662             c = getc (infile);
 663           c = getc (infile);
 664           while (c == '*')
 665             c = getc (infile);
 666         }
 667       else
 668         {
 669           while (c != ',')
 670             c = getc (infile);
 671           c = getc (infile);
 672         }
 673       while (c == ' ' || c == '\n' || c == '\t')
 674         c = getc (infile);
 675       if (defunflag | defvarflag)
 676         ungetc (c, infile);
 677
 678       if (defunflag || defvarflag || c == '"')
 679         {
 680       if (ellcc)
 681         fprintf (outfile, "  CDOC%s(\"%s\", \"\\\n",
 682                  defvarflag ? "SYM" : "SUBR", buf);
 683       else
 684         {
 685           putc (037, outfile);
 686           putc (defvarflag ? 'V' : 'F', outfile);
 687           fprintf (outfile, "%s\n", buf);
 688         }
 689           c = read_c_string (infile, 1, (defunflag || defvarflag));
 690
 691           /* If this is a defun, find the arguments and print them.  If
 692              this function takes MANY or UNEVALLED args, then the C source
 693              won't give the names of the arguments, so we shouldn't bother
 694              trying to find them.  */
 695           if (defunflag && maxargs != -1)
 696             {
 697               char argbuf[1024], *p = argbuf;
 698 #if 0 /* For old DEFUN's only */
 699               while (c != ')')
 700                 {
 701                   if (c < 0)
 702                     goto eof;
 703                   c = getc (infile);
 704                 }
 705 #endif
 706               /* Skip into arguments.  */
 707               while (c != '(')
 708                 {
 709                   if (c < 0)
 710                     goto eof;
 711                   c = getc (infile);
 712                 }
 713               /* Copy arguments into ARGBUF.  */
 714               *p++ = c;
 715               do
 716                 *p++ = c = getc (infile);
 717               while (c != ')');
 718               *p = '\0';
 719               /* Output them.  */
 720           if (ellcc)
 721             fprintf (outfile, "\\n\\\n\\n\\\n");
 722           else
 723             fprintf (outfile, "\n\n");
 724               write_c_args (outfile, buf, argbuf, minargs, maxargs);
 725             }
 726       if (ellcc)
 727         fprintf (outfile, "\\n\");\n\n");
 728         }
 729     }
 730  eof:
 731   fclose (infile);
 732   return 0;
 733 }
 734 \f
 735 /* Read a file of Lisp code, compiled or interpreted.
 736  Looks for
 737   (defun NAME ARGS DOCSTRING ...)
 738   (defmacro NAME ARGS DOCSTRING ...)
 739   (autoload (quote NAME) FILE DOCSTRING ...)
 740   (defvar NAME VALUE DOCSTRING)
 741   (defconst NAME VALUE DOCSTRING)
 742   (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
 743   (fset (quote NAME) #[... DOCSTRING ...])
 744   (defalias (quote NAME) #[... DOCSTRING ...])
 745  starting in column zero.
 746  (quote NAME) may appear as 'NAME as well.
 747
 748  We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
 749  When we find that, we save it for the following defining-form,
 750  and we use that instead of reading a doc string within that defining-form.
 751
 752  For defun, defmacro, and autoload, we know how to skip over the arglist.
 753  For defvar, defconst, and fset we skip to the docstring with a kludgy
 754  formatting convention: all docstrings must appear on the same line as the
 755  initial open-paren (the one in column zero) and must contain a backslash
 756  and a double-quote immediately after the initial double-quote.  No newlines
 757  must appear between the beginning of the form and the first double-quote.
 758  The only source file that must follow this convention is loaddefs.el; aside
 759  from that, it is always the .elc file that we look at, and they are no
 760  problem because byte-compiler output follows this convention.
 761  The NAME and DOCSTRING are output.
 762  NAME is preceded by `F' for a function or `V' for a variable.
 763  An entry is output only if DOCSTRING has \ newline just after the opening "
 764  */
 765
 766 static void
 767 skip_white (FILE *infile)
 768 {
 769   char c = ' ';
 770   while (c == ' ' || c == '\t' || c == '\n')
 771     c = getc (infile);
 772   ungetc (c, infile);
 773 }
 774
 775 static void
 776 read_lisp_symbol (FILE *infile, char *buffer)
 777 {
 778   char c;
 779   char *fillp = buffer;
 780
 781   skip_white (infile);
 782   while (1)
 783     {
 784       c = getc (infile);
 785       if (c == '\\')
 786         /* FSF has *(++fillp), which is wrong. */
 787         *fillp++ = getc (infile);
 788       else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')')
 789         {
 790           ungetc (c, infile);
 791           *fillp = 0;
 792           break;
 793         }
 794       else
 795         *fillp++ = c;
 796     }
 797
 798   if (! buffer[0])
 799     fprintf (stderr, "## expected a symbol, got '%c'\n", c);
 800
 801   skip_white (infile);
 802 }
 803
 804 static int
 805 scan_lisp_file (const char *filename, const char *mode)
 806 {
 807   FILE *infile;
 808   register int c;
 809   char *saved_string = 0;
 810
 811   infile = fopen (filename, mode);
 812   if (infile == NULL)
 813     {
 814       perror (filename);
 815       return 0;                         /* No error */
 816     }
 817
 818   c = '\n';
 819   while (!feof (infile))
 820     {
 821       char buffer[BUFSIZ];
 822       char type;
 823
 824       if (c != '\n')
 825         {
 826           c = getc (infile);
 827           continue;
 828         }
 829       c = getc (infile);
 830       /* Detect a dynamic doc string and save it for the next expression.  */
 831       if (c == '#')
 832         {
 833           c = getc (infile);
 834           if (c == '@')
 835             {
 836               int length = 0;
 837               int i;
 838
 839               /* Read the length.  */
 840               while ((c = getc (infile),
 841                       c >= '0' && c <= '9'))
 842                 {
 843                   length *= 10;
 844                   length += c - '0';
 845                 }
 846
 847               /* The next character is a space that is counted in the length
 848                  but not part of the doc string.
 849                  We already read it, so just ignore it.  */
 850               length--;
 851
 852               /* Read in the contents.  */
 853               if (saved_string != 0)
 854                 free (saved_string);
 855               saved_string = (char *) xmalloc (length);
 856               for (i = 0; i < length; i++)
 857                 saved_string[i] = getc (infile);
 858               /* The last character is a ^_.
 859                  That is needed in the .elc file
 860                  but it is redundant in DOC.  So get rid of it here.  */
 861               saved_string[length - 1] = 0;
 862               /* Skip the newline.  */
 863               c = getc (infile);
 864               while (c != '\n')
 865                 c = getc (infile);
 866             }
 867           continue;
 868         }
 869
 870       if (c != '(')
 871         continue;
 872
 873       read_lisp_symbol (infile, buffer);
 874
 875       if (! strcmp (buffer, "defun") ||
 876           ! strcmp (buffer, "defmacro"))
 877         {
 878           type = 'F';
 879           read_lisp_symbol (infile, buffer);
 880
 881           /* Skip the arguments: either "nil" or a list in parens */
 882
 883           c = getc (infile);
 884           if (c == 'n') /* nil */
 885             {
 886               if ((c = getc (infile)) != 'i' ||
 887                   (c = getc (infile)) != 'l')
 888                 {
 889                   fprintf (stderr, "## unparsable arglist in %s (%s)\n",
 890                            buffer, filename);
 891                   continue;
 892                 }
 893             }
 894           else if (c != '(')
 895             {
 896               fprintf (stderr, "## unparsable arglist in %s (%s)\n",
 897                        buffer, filename);
 898               continue;
 899             }
 900           else
 901             while (c != ')')
 902               c = getc (infile);
 903           skip_white (infile);
 904
 905           /* If the next three characters aren't `dquote bslash newline'
 906              then we're not reading a docstring.
 907            */
 908           if ((c = getc (infile)) != '"' ||
 909               (c = getc (infile)) != '\\' ||
 910               (c = getc (infile)) != '\n')
 911             {
 912 #ifdef DEBUG
 913               fprintf (stderr, "## non-docstring in %s (%s)\n",
 914                        buffer, filename);
 915 #endif
 916               continue;
 917             }
 918         }
 919
 920       else if (! strcmp (buffer, "defvar") ||
 921                ! strcmp (buffer, "defconst"))
 922         {
 923           char c1 = 0, c2 = 0;
 924           type = 'V';
 925           read_lisp_symbol (infile, buffer);
 926
 927           if (saved_string == 0)
 928             {
 929
 930               /* Skip until the first newline; remember the two previous chars. */
 931               while (c != '\n' && c >= 0)
 932                 {
 933                   /* #### Kludge -- Ignore any ESC x x ISO2022 sequences */
 934                   if (c == 27)
 935                     {
 936                       getc (infile);
 937                       getc (infile);
 938                       goto nextchar;
 939                     }
 940
 941                   c2 = c1;
 942                   c1 = c;
 943                 nextchar:
 944                   c = getc (infile);
 945                 }
 946
 947               /* If two previous characters were " and \,
 948                  this is a doc string.  Otherwise, there is none.  */
 949               if (c2 != '"' || c1 != '\\')
 950                 {
 951 #ifdef DEBUG
 952                   fprintf (stderr, "## non-docstring in %s (%s)\n",
 953                            buffer, filename);
 954 #endif
 955                   continue;
 956                 }
 957             }
 958         }
 959
 960       else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
 961         {
 962           char c1 = 0, c2 = 0;
 963           type = 'F';
 964
 965           c = getc (infile);
 966           if (c == '\'')
 967             read_lisp_symbol (infile, buffer);
 968           else
 969             {
 970               if (c != '(')
 971                 {
 972                   fprintf (stderr, "## unparsable name in fset in %s\n",
 973                            filename);
 974                   continue;
 975                 }
 976               read_lisp_symbol (infile, buffer);
 977               if (strcmp (buffer, "quote"))
 978                 {
 979                   fprintf (stderr, "## unparsable name in fset in %s\n",
 980                            filename);
 981                   continue;
 982                 }
 983               read_lisp_symbol (infile, buffer);
 984               c = getc (infile);
 985               if (c != ')')
 986                 {
 987                   fprintf (stderr,
 988                            "## unparsable quoted name in fset in %s\n",
 989                            filename);
 990                   continue;
 991                 }
 992             }
 993
 994           if (saved_string == 0)
 995             {
 996               /* Skip until the first newline; remember the two previous chars. */
 997               while (c != '\n' && c >= 0)
 998                 {
 999                   c2 = c1;
1000                   c1 = c;
1001                   c = getc (infile);
1002                 }
1003
1004               /* If two previous characters were " and \,
1005                  this is a doc string.  Otherwise, there is none.  */
1006               if (c2 != '"' || c1 != '\\')
1007                 {
1008 #ifdef DEBUG
1009                   fprintf (stderr, "## non-docstring in %s (%s)\n",
1010                            buffer, filename);
1011 #endif
1012                   continue;
1013                 }
1014             }
1015         }
1016
1017       else if (! strcmp (buffer, "autoload"))
1018         {
1019           type = 'F';
1020           c = getc (infile);
1021           if (c == '\'')
1022             read_lisp_symbol (infile, buffer);
1023           else
1024             {
1025               if (c != '(')
1026                 {
1027                   fprintf (stderr, "## unparsable name in autoload in %s\n",
1028                            filename);
1029                   continue;
1030                 }
1031               read_lisp_symbol (infile, buffer);
1032               if (strcmp (buffer, "quote"))
1033                 {
1034                   fprintf (stderr, "## unparsable name in autoload in %s\n",
1035                            filename);
1036                   continue;
1037                 }
1038               read_lisp_symbol (infile, buffer);
1039               c = getc (infile);
1040               if (c != ')')
1041                 {
1042                   fprintf (stderr,
1043                            "## unparsable quoted name in autoload in %s\n",
1044                            filename);
1045                   continue;
1046                 }
1047             }
1048           skip_white (infile);
1049           if ((c = getc (infile)) != '\"')
1050             {
1051               fprintf (stderr, "## autoload of %s unparsable (%s)\n",
1052                        buffer, filename);
1053               continue;
1054             }
1055           read_c_string (infile, 0, 0);
1056           skip_white (infile);
1057
1058           if (saved_string == 0)
1059             {
1060               /* If the next three characters aren't `dquote bslash newline'
1061                  then we're not reading a docstring.  */
1062               if ((c = getc (infile)) != '"'  ||
1063                   (c = getc (infile)) != '\\' ||
1064                   (c = getc (infile)) != '\n')
1065                 {
1066 #ifdef DEBUG
1067                   fprintf (stderr, "## non-docstring in %s (%s)\n",
1068                            buffer, filename);
1069 #endif
1070                   continue;
1071                 }
1072             }
1073         }
1074
1075 #if 0 /* causes crash */
1076       else if (! strcmp (buffer, "if") ||
1077                ! strcmp (buffer, "byte-code"))
1078         ;
1079 #endif
1080
1081       else
1082         {
1083 #ifdef DEBUG
1084           fprintf (stderr, "## unrecognized top-level form, %s (%s)\n",
1085                    buffer, filename);
1086 #endif
1087           continue;
1088         }
1089
1090       /* At this point, we should either use the previous
1091          dynamic doc string in saved_string
1092          or gobble a doc string from the input file.
1093
1094          In the latter case, the opening quote (and leading
1095          backslash-newline) have already been read.  */
1096       putc ('\n', outfile); /* XEmacs addition */
1097       putc (037, outfile);
1098       putc (type, outfile);
1099       fprintf (outfile, "%s\n", buffer);
1100       if (saved_string)
1101         {
1102           fputs (saved_string, outfile);
1103           /* Don't use one dynamic doc string twice.  */
1104           free (saved_string);
1105           saved_string = 0;
1106         }
1107       else
1108         read_c_string (infile, 1, 0);
1109     }
1110   fclose (infile);
1111   return 0;
1112 }