lib-src/make-docfile.c

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