lib-src/make-docfile.c

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