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         }
 726     }
 727  eof:
 728   fclose (infile);
 729   return 0;
 730 }
 731 \f
 732 /* Read a file of Lisp code, compiled or interpreted.
 733  Looks for
 734   (defun NAME ARGS DOCSTRING ...)
 735   (defmacro NAME ARGS DOCSTRING ...)
 736   (defsubst NAME ARGS DOCSTRING ...)
 737   (autoload (quote NAME) FILE DOCSTRING ...)
 738   (defvar NAME VALUE DOCSTRING)
 739   (defconst NAME VALUE DOCSTRING)
 740   (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
 741   (fset (quote NAME) #[... DOCSTRING ...])
 742   (defalias (quote NAME) #[... DOCSTRING ...])
 743   (custom-declare-variable (quote NAME) VALUE DOCSTRING ...)
 744  starting in column zero.
 745  (quote NAME) may appear as 'NAME as well.
 746
 747  We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
 748  When we find that, we save it for the following defining-form,
 749  and we use that instead of reading a doc string within that defining-form.
 750
 751  For defvar, defconst, and fset we skip to the docstring with a kludgy
 752  formatting convention: all docstrings must appear on the same line as the
 753  initial open-paren (the one in column zero) and must contain a backslash
 754  and a newline immediately after the initial double-quote.  No newlines
 755  must appear between the beginning of the form and the first double-quote.
 756  For defun, defmacro, and autoload, we know how to skip over the
 757  arglist, but the doc string must still have a backslash and newline
 758  immediately after the double quote.
 759  The only source files that must follow this convention are preloaded
 760  uncompiled ones like loaddefs.el and bindings.el; aside
 761  from that, it is always the .elc file that we look at, and they are no
 762  problem because byte-compiler output follows this convention.
 763  The NAME and DOCSTRING are output.
 764  NAME is preceded by `F' for a function or `V' for a variable.
 765  An entry is output only if DOCSTRING has \ newline just after the opening "
 766  */
 767
 768 void
 769 skip_white (infile)
 770      FILE *infile;
 771 {
 772   char c = ' ';
 773   while (c == ' ' || c == '\t' || c == '\n' || c == '\r')
 774     c = getc (infile);
 775   ungetc (c, infile);
 776 }
 777
 778 void
 779 read_lisp_symbol (infile, buffer)
 780      FILE *infile;
 781      char *buffer;
 782 {
 783   char c;
 784   char *fillp = buffer;
 785
 786   skip_white (infile);
 787   while (1)
 788     {
 789       c = getc (infile);
 790       if (c == '\\')
 791         *(++fillp) = getc (infile);
 792       else if (c == ' ' || c == '\t' || c == '\n' || c == '\r' || c == '(' || c == ')')
 793         {
 794           ungetc (c, infile);
 795           *fillp = 0;
 796           break;
 797         }
 798       else
 799         *fillp++ = c;
 800     }
 801
 802   if (! buffer[0])
 803     fprintf (stderr, "## expected a symbol, got '%c'\n", c);
 804
 805   skip_white (infile);
 806 }
 807
 808 int
 809 scan_lisp_file (filename, mode)
 810      char *filename, *mode;
 811 {
 812   FILE *infile;
 813   register int c;
 814   char *saved_string = 0;
 815
 816   infile = fopen (filename, mode);
 817   if (infile == NULL)
 818     {
 819       perror (filename);
 820       return 0;                         /* No error */
 821     }
 822
 823   c = '\n';
 824   while (!feof (infile))
 825     {
 826       char buffer[BUFSIZ];
 827       char type;
 828
 829       /* If not at end of line, skip till we get to one.  */
 830       if (c != '\n' && c != '\r')
 831         {
 832           c = getc (infile);
 833           continue;
 834         }
 835       /* Skip the line break.  */
 836       while (c == '\n' || c == '\r')
 837         c = getc (infile);
 838       /* Detect a dynamic doc string and save it for the next expression.  */
 839       if (c == '#')
 840         {
 841           c = getc (infile);
 842           if (c == '@')
 843             {
 844               int length = 0;
 845               int i;
 846
 847               /* Read the length.  */
 848               while ((c = getc (infile),
 849                       c >= '0' && c <= '9'))
 850                 {
 851                   length *= 10;
 852                   length += c - '0';
 853                 }
 854
 855               /* The next character is a space that is counted in the length
 856                  but not part of the doc string.
 857                  We already read it, so just ignore it.  */
 858               length--;
 859
 860               /* Read in the contents.  */
 861               if (saved_string != 0)
 862                 free (saved_string);
 863               saved_string = (char *) malloc (length);
 864               for (i = 0; i < length; i++)
 865                 saved_string[i] = getc (infile);
 866               /* The last character is a ^_.
 867                  That is needed in the .elc file
 868                  but it is redundant in DOC.  So get rid of it here.  */
 869               saved_string[length - 1] = 0;
 870               /* Skip the line break.  */
 871               while (c == '\n' && c == '\r')
 872                 c = getc (infile);
 873               /* Skip the following line.  */
 874               while (c != '\n' && c != '\r')
 875                 c = getc (infile);
 876             }
 877           continue;
 878         }
 879
 880       if (c != '(')
 881         continue;
 882
 883       read_lisp_symbol (infile, buffer);
 884
 885       if (! strcmp (buffer, "defun")
 886           || ! strcmp (buffer, "defmacro")
 887           || ! strcmp (buffer, "defsubst"))
 888         {
 889           type = 'F';
 890           read_lisp_symbol (infile, buffer);
 891
 892           /* Skip the arguments: either "nil" or a list in parens */
 893
 894           c = getc (infile);
 895           if (c == 'n') /* nil */
 896             {
 897               if ((c = getc (infile)) != 'i'
 898                   || (c = getc (infile)) != 'l')
 899                 {
 900                   fprintf (stderr, "## unparsable arglist in %s (%s)\n",
 901                            buffer, filename);
 902                   continue;
 903                 }
 904             }
 905           else if (c != '(')
 906             {
 907               fprintf (stderr, "## unparsable arglist in %s (%s)\n",
 908                        buffer, filename);
 909               continue;
 910             }
 911           else
 912             while (c != ')')
 913               c = getc (infile);
 914           skip_white (infile);
 915
 916           /* If the next three characters aren't `dquote bslash newline'
 917              then we're not reading a docstring.
 918            */
 919           if ((c = getc (infile)) != '"'
 920               || (c = getc (infile)) != '\\'
 921               || ((c = getc (infile)) != '\n' && c != '\r'))
 922             {
 923 #ifdef DEBUG
 924               fprintf (stderr, "## non-docstring in %s (%s)\n",
 925                        buffer, filename);
 926 #endif
 927               continue;
 928             }
 929         }
 930
 931       else if (! strcmp (buffer, "defvar")
 932                || ! strcmp (buffer, "defconst"))
 933         {
 934           char c1 = 0, c2 = 0;
 935           type = 'V';
 936           read_lisp_symbol (infile, buffer);
 937
 938           if (saved_string == 0)
 939             {
 940
 941               /* Skip until the end of line; remember two previous chars.  */
 942               while (c != '\n' && c != '\r' && c >= 0)
 943                 {
 944                   c2 = c1;
 945                   c1 = c;
 946                   c = getc (infile);
 947                 }
 948
 949               /* If two previous characters were " and \,
 950                  this is a doc string.  Otherwise, there is none.  */
 951               if (c2 != '"' || c1 != '\\')
 952                 {
 953 #ifdef DEBUG
 954                   fprintf (stderr, "## non-docstring in %s (%s)\n",
 955                            buffer, filename);
 956 #endif
 957                   continue;
 958                 }
 959             }
 960         }
 961
 962       else if (! strcmp (buffer, "custom-declare-variable"))
 963         {
 964           char c1 = 0, c2 = 0;
 965           type = 'V';
 966
 967           c = getc (infile);
 968           if (c == '\'')
 969             read_lisp_symbol (infile, buffer);
 970           else
 971             {
 972               if (c != '(')
 973                 {
 974                   fprintf (stderr,
 975                            "## unparsable name in custom-declare-variable in %s\n",
 976                            filename);
 977                   continue;
 978                 }
 979               read_lisp_symbol (infile, buffer);
 980               if (strcmp (buffer, "quote"))
 981                 {
 982                   fprintf (stderr,
 983                            "## unparsable name in custom-declare-variable in %s\n",
 984                            filename);
 985                   continue;
 986                 }
 987               read_lisp_symbol (infile, buffer);
 988               c = getc (infile);
 989               if (c != ')')
 990                 {
 991                   fprintf (stderr,
 992                            "## unparsable quoted name in custom-declare-variable in %s\n",
 993                            filename);
 994                   continue;
 995                 }
 996             }
 997
 998           if (saved_string == 0)
 999             {
1000               /* Skip to end of line; remember the two previous chars.  */
1001               while (c != '\n' && c != '\r' && c >= 0)
1002                 {
1003                   c2 = c1;
1004                   c1 = c;
1005                   c = getc (infile);
1006                 }
1007
1008               /* If two previous characters were " and \,
1009                  this is a doc string.  Otherwise, there is none.  */
1010               if (c2 != '"' || c1 != '\\')
1011                 {
1012 #ifdef DEBUG
1013                   fprintf (stderr, "## non-docstring in %s (%s)\n",
1014                            buffer, filename);
1015 #endif
1016                   continue;
1017                 }
1018             }
1019         }
1020
1021       else if (! strcmp (buffer, "fset") || ! strcmp (buffer, "defalias"))
1022         {
1023           char c1 = 0, c2 = 0;
1024           type = 'F';
1025
1026           c = getc (infile);
1027           if (c == '\'')
1028             read_lisp_symbol (infile, buffer);
1029           else
1030             {
1031               if (c != '(')
1032                 {
1033                   fprintf (stderr, "## unparsable name in fset in %s\n",
1034                            filename);
1035                   continue;
1036                 }
1037               read_lisp_symbol (infile, buffer);
1038               if (strcmp (buffer, "quote"))
1039                 {
1040                   fprintf (stderr, "## unparsable name in fset in %s\n",
1041                            filename);
1042                   continue;
1043                 }
1044               read_lisp_symbol (infile, buffer);
1045               c = getc (infile);
1046               if (c != ')')
1047                 {
1048                   fprintf (stderr,
1049                            "## unparsable quoted name in fset in %s\n",
1050                            filename);
1051                   continue;
1052                 }
1053             }
1054
1055           if (saved_string == 0)
1056             {
1057               /* Skip to end of line; remember the two previous chars.  */
1058               while (c != '\n' && c != '\r' && c >= 0)
1059                 {
1060                   c2 = c1;
1061                   c1 = c;
1062                   c = getc (infile);
1063                 }
1064
1065               /* If two previous characters were " and \,
1066                  this is a doc string.  Otherwise, there is none.  */
1067               if (c2 != '"' || c1 != '\\')
1068                 {
1069 #ifdef DEBUG
1070                   fprintf (stderr, "## non-docstring in %s (%s)\n",
1071                            buffer, filename);
1072 #endif
1073                   continue;
1074                 }
1075             }
1076         }
1077
1078       else if (! strcmp (buffer, "autoload"))
1079         {
1080           type = 'F';
1081           c = getc (infile);
1082           if (c == '\'')
1083             read_lisp_symbol (infile, buffer);
1084           else
1085             {
1086               if (c != '(')
1087                 {
1088                   fprintf (stderr, "## unparsable name in autoload in %s\n",
1089                            filename);
1090                   continue;
1091                 }
1092               read_lisp_symbol (infile, buffer);
1093               if (strcmp (buffer, "quote"))
1094                 {
1095                   fprintf (stderr, "## unparsable name in autoload in %s\n",
1096                            filename);
1097                   continue;
1098                 }
1099               read_lisp_symbol (infile, buffer);
1100               c = getc (infile);
1101               if (c != ')')
1102                 {
1103                   fprintf (stderr,
1104                            "## unparsable quoted name in autoload in %s\n",
1105                            filename);
1106                   continue;
1107                 }
1108             }
1109           skip_white (infile);
1110           if ((c = getc (infile)) != '\"')
1111             {
1112               fprintf (stderr, "## autoload of %s unparsable (%s)\n",
1113                        buffer, filename);
1114               continue;
1115             }
1116           read_c_string_or_comment (infile, 0, 0, 0);
1117           skip_white (infile);
1118
1119           if (saved_string == 0)
1120             {
1121               /* If the next three characters aren't `dquote bslash newline'
1122                  then we're not reading a docstring.  */
1123               if ((c = getc (infile)) != '"'
1124                   || (c = getc (infile)) != '\\'
1125                   || ((c = getc (infile)) != '\n' && c != '\r'))
1126                 {
1127 #ifdef DEBUG
1128                   fprintf (stderr, "## non-docstring in %s (%s)\n",
1129                            buffer, filename);
1130 #endif
1131                   continue;
1132                 }
1133             }
1134         }
1135
1136 #ifdef DEBUG
1137       else if (! strcmp (buffer, "if")
1138                || ! strcmp (buffer, "byte-code"))
1139         ;
1140 #endif
1141
1142       else
1143         {
1144 #ifdef DEBUG
1145           fprintf (stderr, "## unrecognised top-level form, %s (%s)\n",
1146                    buffer, filename);
1147 #endif
1148           continue;
1149         }
1150
1151       /* At this point, we should either use the previous
1152          dynamic doc string in saved_string
1153          or gobble a doc string from the input file.
1154
1155          In the latter case, the opening quote (and leading
1156          backslash-newline) have already been read.  */
1157
1158       putc (037, outfile);
1159       putc (type, outfile);
1160       fprintf (outfile, "%s\n", buffer);
1161       if (saved_string)
1162         {
1163           fputs (saved_string, outfile);
1164           /* Don't use one dynamic doc string twice.  */
1165           free (saved_string);
1166           saved_string = 0;
1167         }
1168       else
1169         read_c_string_or_comment (infile, 1, 0, 0);
1170     }
1171   fclose (infile);
1172   return 0;
1173 }