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