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