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