cgit.sxemacs.org Git - sxemacs/blob - lib-src/make-docfile.c

   1 /* Generate doc-string file for SXEmacs from source files.
   2    Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Board of Trustees, University of Illinois.
   4    Copyright (C) 1998, 1999 J. Kean Johnston.
   5    Copyright (C) 2004 Steve Youngs.
   6
   7 This file is part of SXEmacs.
   8
   9 SXEmacs is free software: you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation, either version 3 of the License, or
  12 (at your option) any later version.
  13
  14 SXEmacs is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  21
  22 /* Synched up with: FSF 19.30. */
  23
  24 /* The arguments given to this program are all the C and Lisp source files
  25  of SXEmacs.  .elc and .el and .c files are allowed.
  26  A .o file can also be specified; the .c file it was made from is used.
  27  This helps the makefile pass the correct list of files.
  28
  29  The results, which go to standard output or to a file
  30  specified with -a or -o (-a to append, -o to start from nothing),
  31  are entries containing function or variable names and their documentation.
  32  Each entry starts with a ^_ character.
  33  Then comes F for a function or V for a variable.
  34  Then comes the function or variable name, terminated with a newline.
  35  Then comes the documentation for that function or variable.
  36
  37  Added 19.15/20.1:  `-i site-packages' allow installer to dump extra packages
  38  without modifying Makefiles, etc.
  39
  40  Big cleanup 2012-01-08  Sebastian Freundt
  41  */
  42
  43 #define NO_SHORTNAMES           /* Tell config not to load remap.h */
  44 #include <config.h>
  45
  46 #include <stdio.h>
  47 #include <errno.h>
  48 #if __STDC__ || defined(STDC_HEADERS)
  49 #include <stdlib.h>
  50 #ifdef HAVE_UNISTD_H
  51 #include <unistd.h>
  52 #endif
  53 #include <string.h>
  54 #include <ctype.h>
  55 #endif
  56
  57 #include <sys/param.h>
  58
  59 /* How long can a source filename be in DOC (including "\037S" at the start
  60     and "\n" at the end) ? */
  61 #define DOC_MAX_FILENAME_LENGTH 2048
  62 #define IS_DIRECTORY_SEP(arg) ('/' == arg)
  63
  64 /* Can't use the system assert on OS X, it can't find a definition for
  65    __eprintf on linking */
  66 #define assert(x) ((x) ? (void) 0 : (void) abort ())
  67
  68 #define READ_TEXT "r"
  69 #define READ_BINARY "r"
  70 #define WRITE_BINARY "w"
  71 #define APPEND_BINARY "a"
  72
  73 /* Stdio stream for output to the DOC file.  */
  74 static FILE *outfile;
  75 static char *modname = NULL;
  76
  77 enum {
  78         el_file,
  79         elc_file,
  80         c_file
  81 } Current_file_type;
  82
  83 static void put_filename (const char *filename);
  84 static int scan_file(const char *filename);
  85 static int read_c_string(FILE *, int, int);
  86 static void
  87 write_c_args(FILE * out, const char *func, char *buf, int minargs, int maxargs);
  88 static int scan_c_file(const char *filename, const char *mode);
  89 static void skip_white(FILE *);
  90 static void read_lisp_symbol(FILE *, char *);
  91 static int scan_lisp_file(const char *filename, const char *mode);
  92
  93 #define C_IDENTIFIER_CHAR_P(c)                  \
  94         (('A' <= c && c <= 'Z') ||              \
  95          ('a' <= c && c <= 'z') ||              \
  96          ('0' <= c && c <= '9') ||              \
  97          (c == '_'))
  98
  99 /* Name this program was invoked with.  */
 100 static char *progname;
 101
 102 /* Set to 1 if this was invoked by ellcc */
 103 static int ellcc = 0;
 104
 105 /**
 106  * Print error message.  `s1' is printf control string, `s2' is arg for it. */
 107 static void
 108 error(const char *s1, const char *s2)
 109 {
 110         fprintf(stderr, "%s: ", progname);
 111         fprintf(stderr, s1, s2);
 112         fprintf(stderr, "\n");
 113         return;
 114 }
 115
 116 /**
 117  * Print error message and exit.  */
 118 static void
 119 __attribute__((noreturn))
 120 fatal(const char *s1, const char *s2)
 121 {
 122         error(s1, s2);
 123         exit(1);
 124 }
 125
 126 /**
 127  * Like malloc but get fatal error if memory is exhausted.  */
 128 static void*
 129 xmalloc(unsigned int size)
 130 {
 131         void *result = malloc(size);
 132         if (result == NULL) {
 133                 fatal("virtual memory exhausted", 0);
 134         }
 135         return result;
 136 }
 137
 138 static char*
 139 next_extra_elc(char *extra_elcs)
 140 {
 141         static FILE *fp = NULL;
 142         static char line_buf[BUFSIZ];
 143         char *p = line_buf + 1;
 144
 145         if (!fp) {
 146                 if (!extra_elcs) {
 147                         return NULL;
 148                 } else if (!(fp = fopen(extra_elcs, READ_BINARY))) {
 149                         /* It is not an error if this file doesn't exist. */
 150                         return NULL;
 151                 }
 152                 if(!fgets(line_buf, BUFSIZ, fp)) {
 153                         fclose(fp);
 154                         fp = NULL;
 155                         return NULL;
 156                 }
 157         }
 158
 159 again:
 160         if (!fgets(line_buf, BUFSIZ, fp)) {
 161                 fclose(fp);
 162                 fp = NULL;
 163                 return NULL;
 164         }
 165         line_buf[0] = '\0';
 166         if (strlen(p) <= 2 || strlen(p) >= (BUFSIZ - 5)) {
 167                 /* reject too short or too long lines */
 168                 goto again;
 169         }
 170         p[strlen(p) - 2] = '\0';
 171         strcat(p, ".elc");
 172
 173         return p;
 174 }
 175
 176 static void
 177 write_doc_header(void)
 178 {
 179         char *tmp, *modout = strdup(modname), *modoutC;
 180         size_t modsz;
 181
 182         if ((tmp = strrchr(modout, '.')) != NULL) {
 183                 *tmp = '\0';
 184                 tmp = strrchr(modout, '.');
 185                 if (tmp != NULL) {
 186                         *tmp = '\0';
 187                 }
 188         }
 189         /* the same for modoutC */
 190         modoutC = strdup(modout);
 191         modsz = strlen(modoutC);
 192
 193         for (size_t i = 0; i < modsz; i++) {
 194                 /* for the C version we have to convert any non-char to _ */
 195                 if (!isdigit(modoutC[i]) && !isalpha(modoutC[i])) {
 196                         modoutC[i] = '_';
 197                 }
 198         }
 199
 200         fprintf(outfile, "/* DO NOT EDIT - AUTOMATICALLY GENERATED */\n\n");
 201         fprintf(outfile, "#include <emodules-ng.h>\n\n");
 202
 203         /* declare and start the LTX_docs() block */
 204         fprintf(outfile, "\n\nextern void %s_LTX_docs(void);\n", modoutC);
 205         fprintf(outfile, "\nvoid\n%s_LTX_docs(void)\n", modoutC);
 206         return;
 207 }
 208
 209 \f
 210 int
 211 main(int argc, char **argv)
 212 {
 213         int i;
 214         int err_count = 0;
 215         char *extra_elcs = NULL;
 216
 217         progname = argv[0];
 218
 219         outfile = stdout;
 220
 221         /* If first two args are -o FILE, output to FILE.  */
 222         for (i = 1; i < argc - 1;) {
 223                 if (!strcmp(argv[i], "-o")) {
 224                         outfile = fopen(argv[++i], WRITE_BINARY);
 225                 }
 226                 if (!strcmp(argv[i], "-a")) {
 227                         outfile = fopen(argv[++i], APPEND_BINARY);
 228                 }
 229                 if (!strcmp(argv[i], "-E")) {
 230                         if (modname == NULL) {
 231                                 modname = strdup(argv[i+1]);
 232                         }
 233                         ellcc = 1;
 234                         outfile = fopen(argv[++i], WRITE_BINARY);
 235                 }
 236                 if (!strcmp(argv[i], "-d")) {
 237                         if (chdir(argv[++i]) < 0) {
 238                                 fatal("Could not change to directory ",argv[i]);
 239                         }
 240                 }
 241
 242                 if (!strcmp(argv[i], "-i")) {
 243                         extra_elcs = argv[++i];
 244                 }
 245
 246                 if (!strcmp(argv[i], "--modname") || !strcmp(argv[i], "-m")) {
 247                         modname = strdup(argv[++i]);
 248                 }
 249                 i++;
 250         }
 251         if (outfile == 0) {
 252                 fatal("No output file specified", "");
 253         }
 254         if (ellcc) {
 255                 write_doc_header();
 256                 fprintf(outfile, "{\n");
 257         }
 258
 259         for (i = 1; i < argc; i++) {
 260                 int j;
 261
 262                 if (argc > i + 1 && !strcmp (argv[i], "-d")) {
 263                         /* XEmacs change; allow more than one chdir. The
 264                            idea is that the second chdir is to source-lisp,
 265                            and that any Lisp files not under there have the
 266                            full path specified.  */
 267                         i += 1;
 268                         if (chdir (argv[i]) < 0) {
 269                                 fatal("Could not change to directory ", argv[i]);
 270                         }
 271                         continue;
 272                 } else if (argv[i][0] == '-') {
 273                         i++;
 274                         continue;
 275                 }
 276                 /* Don't process one file twice.  */
 277                 for (j = 1; j < i; j++) {
 278                         if (!strcmp(argv[i], argv[j])) {
 279                                 break;
 280                         }
 281                 }
 282                 if (j == i) {
 283                         /* err_count seems to be {mis,un}used */
 284                         err_count += scan_file(argv[i]);
 285                 }
 286         }
 287
 288         if (extra_elcs) {
 289                 char *p;
 290
 291                 while ((p = next_extra_elc(extra_elcs)) != NULL) {
 292                         err_count += scan_file(p);
 293                 }
 294         }
 295
 296         putc('\n', outfile);
 297         if (ellcc) {
 298                 fprintf(outfile, "}\n\n");
 299         }
 300 #ifndef VMS
 301         exit(err_count > 0);
 302 #endif  /* VMS */
 303         return err_count > 0;
 304 }
 305
 306 /* Add a source file name boundary in the output file.  */
 307 static void
 308 put_filename (const char *filename)
 309 {
 310 /* XEmacs change; don't strip directory information. */
 311         /* <= because sizeof includes the nul byte at the end. Not quite
 312            right, because it should include the length of the symbol +
 313            "\037[VF]" instead of simply 10. */
 314         assert(sizeof("\037S\n") + strlen(filename) + 10
 315                <= DOC_MAX_FILENAME_LENGTH);
 316
 317         putc (037, outfile);
 318         putc ('S', outfile);
 319         fprintf (outfile, "%s\n", filename);
 320         return;
 321 }
 322
 323 /**
 324  * Read file FILENAME and output its doc strings to outfile.
 325  * Return 1 if file is not found, 0 if it is found. **/
 326 static int
 327 scan_file(const char *filename)
 328 {
 329         int len = strlen(filename);
 330
 331         if (ellcc == 0 && len > 4 && !strcmp(filename + len - 4, ".elc")) {
 332                 Current_file_type = elc_file;
 333                 return scan_lisp_file(filename, READ_BINARY);
 334         } else if (ellcc == 0 && len > 3 &&
 335                    strcmp(filename + len - 3, ".el") == 0) {
 336                 Current_file_type = el_file;
 337                 return scan_lisp_file(filename, READ_TEXT);
 338         } else {
 339                 Current_file_type = c_file;
 340                 return scan_c_file(filename, READ_TEXT);
 341         }
 342         /* not reached */
 343 }
 344 \f
 345 char buf[128];
 346
 347 /**
 348  * Print a simple return in accordance with printflag and ellcc state*/
 349 static void
 350 pr_char(int printflag, char **p, register int c)
 351 {
 352         if (printflag > 0) {
 353                 if (ellcc) {
 354                         switch (c) {
 355                         case '\n':
 356                                 putc('\\', outfile);
 357                                 putc('n', outfile);
 358                         case '"':
 359                                 putc('\\', outfile);
 360                         default:
 361                                 break;
 362                         }
 363                 }
 364                 putc(c, outfile);
 365         } else if (printflag < 0) {
 366                 char *tmp = *p;
 367                 *tmp++ = c;
 368                 *p = tmp;
 369         }
 370         return;
 371 }
 372
 373 #define MDGET                                           \
 374         do {                                            \
 375                 prevc = c;                              \
 376                 c = getc(infile);                       \
 377         } while (0)
 378
 379 /**
 380  * Skip a C string from INFILE,
 381  * and return the character that follows the closing ".
 382  * If printflag is positive, output string contents to outfile.
 383  * If it is negative, store contents in buf.
 384  * Convert escape sequences \n and \t to newline and tab;
 385  * discard \ followed by newline. **/
 386 static int
 387 read_c_string(FILE *infile, int printflag, int c_docstring)
 388 {
 389         register int prevc = 0;
 390         register int c = 0;
 391         char *p = buf;
 392         int start = -1;
 393
 394         MDGET;
 395         while (c != EOF) {
 396                 while ((c_docstring || c != '"') && c != EOF) {
 397                         if (c == '*') {
 398                                 int cc = getc(infile);
 399
 400                                 if (cc == '/' && prevc != '\n') {
 401                                         pr_char(printflag, &p, '\n');
 402                                         break;
 403                                 } else if (cc == '/') {
 404                                         break;
 405                                 } else {
 406                                         ungetc(cc, infile);
 407                                 }
 408                         }
 409
 410                         if (start == 1) {
 411                                 pr_char(printflag, &p, '\n');
 412                         }
 413
 414                         if (c == '\\') {
 415                                 MDGET;
 416                                 if (c == '\n') {
 417                                         MDGET;
 418                                         start = 1;
 419                                         continue;
 420                                 }
 421                                 if (!c_docstring && c == 'n') {
 422                                         c = '\n';
 423                                 }
 424                                 if (c == 't') {
 425                                         c = '\t';
 426                                 }
 427                         }
 428                         if (c == '\n') {
 429                                 start = 1;
 430                         } else {
 431                                 start = 0;
 432                                 pr_char(printflag, &p, c);
 433                         }
 434                         MDGET;
 435                 }
 436                 /* look for continuation of string */
 437                 if (Current_file_type == c_file) {
 438                         do {
 439                                 MDGET;
 440                         }
 441                         while (isspace(c));
 442                         if (c != '"') {
 443                                 break;
 444                         }
 445                 } else {
 446                         MDGET;
 447                         if (c != '"') {
 448                                 break;
 449                         }
 450                         /* If we had a "", concatenate the two strings. */
 451                 }
 452                 MDGET;
 453         }
 454
 455         if (printflag < 0) {
 456                 *p = 0;
 457         }
 458         return c;
 459 }
 460 \f
 461 /**
 462  * Write to file OUT the argument names of function FUNC, whose text is in BUF.
 463  * MINARGS and MAXARGS are the minimum and maximum number of arguments. **/
 464
 465 static void
 466 write_c_args(FILE *out, const char *func, char *buff, int minargs, int maxargs)
 467 {
 468         register char *p;
 469         int in_ident = 0;
 470         int just_spaced = 0;
 471         /* XEmacs - "arguments:" is for parsing the docstring.  FSF's help system
 472            doesn't parse the docstring for arguments like we do, so we're also
 473            going to omit the function name to preserve compatibility with elisp
 474            that parses the docstring.  Finally, not prefixing the arglist with
 475            anything is asking for trouble because it's not uncommon to have an
 476            unescaped parenthesis at the beginning of a line. --Stig */
 477         fprintf(out, "arguments: (");
 478
 479         if (*buff == '(') {
 480                 ++buff;
 481         }
 482
 483         for (p = buff; *p; p++) {
 484                 char c = *p;
 485
 486                 /* Add support for ANSI prototypes. Hop over
 487                    "Lisp_Object" string (the only C type allowed in DEFUNs) */
 488                 static char lo[] = "Lisp_Object";
 489                 if ((C_IDENTIFIER_CHAR_P(c) != in_ident) && !in_ident &&
 490                     (strncmp(p, lo, sizeof(lo) - 1) == 0) &&
 491                     isspace((unsigned char)(*(p + sizeof(lo) - 1)))) {
 492                         p += (sizeof(lo) - 1);
 493                         while (isspace((unsigned char)(*p))) {
 494                                 p++;
 495                         }
 496                         c = *p;
 497                 }
 498
 499                 /* Notice when we start printing a new identifier.  */
 500                 if (C_IDENTIFIER_CHAR_P(c) != in_ident) {
 501                         if (!in_ident) {
 502                                 in_ident = 1;
 503                                 if (minargs == 0 && maxargs > 0) {
 504                                         fprintf(out, "&optional ");
 505                                 }
 506                                 just_spaced = 1;
 507
 508                                 minargs--;
 509                                 maxargs--;
 510                         } else {
 511                                 in_ident = 0;
 512                         }
 513                 }
 514
 515                 /* Print the C argument list as it would appear in lisp:
 516                    print underscores as hyphens, and print commas as spaces.
 517                    Collapse adjacent spaces into one. */
 518                 if (c == '_') {
 519                         c = '-';
 520                 }
 521                 if (c == ',') {
 522                         c = ' ';
 523                 }
 524
 525                 /* If the C argument name ends with `_', change it to ' ', to
 526                    allow use of C reserved words or global symbols as Lisp
 527                    args. */
 528                 if (c == '-' && !C_IDENTIFIER_CHAR_P(p[1])) {
 529                         in_ident = 0;
 530                         just_spaced = 0;
 531                 }
 532                 /* If the character is carriage return, escape it for the C
 533                    compiler. */
 534                 else if (c == '\n') {
 535                         putc('\\', out);
 536                         putc('\n', out);
 537                 } else if (c != ' ' || !just_spaced) {
 538                         if (c >= 'a' && c <= 'z') {
 539                                 /* Upcase the letter.  */
 540                                 c += 'A' - 'a';
 541                         }
 542                         putc(c, out);
 543                 }
 544
 545                 just_spaced = (c == ' ');
 546         }
 547         if (!ellcc) {
 548                 /* XEmacs addition */
 549                 putc('\n', out);
 550         }
 551         return;
 552 }
 553 \f
 554 static int
 555 check_comma(FILE *infile, register int commas, int *minargs, int *maxargs)
 556 {
 557         register int c;
 558
 559         do {
 560                 c = getc(infile);
 561         } while (c == ' ' || c == '\n' || c == '\t');
 562         if (c < 0) {
 563                 return c;
 564         }
 565         ungetc(c, infile);
 566         if (commas == 2) {
 567                 /* pick up minargs */
 568                 if (fscanf(infile, "%d", minargs) != 1) {
 569                         fprintf(stderr, "Failed to read minargs\n");
 570                 }
 571         } else if (c == 'M' || c == 'U') {
 572                 /* MANY || UNEVALLED */
 573                 *maxargs = -1;
 574         } else {
 575                 /* pick up maxargs */
 576                 if (fscanf(infile, "%d", maxargs) != 1) {
 577                         fprintf(stderr, "Failed to read maxargs\n");
 578                 }
 579         }
 580         return c;
 581 }
 582
 583 /**
 584  * Read through a c file.  If a .o file is named, the corresponding .c file is
 585  * read instead.
 586  * Looks for DEFUN constructs such as are defined in ../src/lisp.h.
 587  * Accepts any word starting DEF... so it finds DEFSIMPLE and DEFPRED.  */
 588 static int
 589 scan_c_file(const char *filename, const char *mode)
 590 {
 591         FILE *infile;
 592         register int c;
 593         register int commas;
 594         register int defunflag;
 595         register int defvarperbufferflag = 0;
 596         register int defvarflag;
 597         int minargs;
 598         int maxargs;
 599         size_t l = strlen(filename);
 600         char f[MAXPATHLEN];
 601
 602         if (l > sizeof(f)) {
 603 #ifdef ENAMETOOLONG
 604                 errno = ENAMETOOLONG;
 605 #else
 606                 errno = EINVAL;
 607 #endif
 608                 return (0);
 609         }
 610
 611         strcpy(f, filename);
 612         if (f[l - 1] == 'o') {
 613                 f[l - 1] = 'c';
 614         }
 615         infile = fopen(f, mode);
 616
 617         /* No error if non-ex input file */
 618         if (infile == NULL) {
 619                 perror(f);
 620                 return 0;
 621         }
 622
 623         c = '\n';
 624         while (!feof(infile)) {
 625                 if (c != '\n') {
 626                         c = getc(infile);
 627                         continue;
 628                 }
 629                 c = getc(infile);
 630                 /*
 631                  * SXEmacs uses proper indentation so we need to
 632                  * search for `\t' instead of ' ' here.
 633                  */
 634                 if (c == '\t') {
 635                         while (c == '\t') {
 636                                 c = getc(infile);
 637                         }
 638                         if ((c == 'D') &&
 639                             (c = getc(infile)) == 'E' &&
 640                             (c = getc(infile)) == 'F' &&
 641                             (c = getc(infile)) == 'V' &&
 642                             (c = getc(infile)) == 'A' &&
 643                             (c = getc(infile)) == 'R' &&
 644                             (c = getc(infile)) == '_') {
 645                                 defvarflag = 1;
 646                                 defunflag = 0;
 647
 648                                 c = getc(infile);
 649                                 /* Note that this business doesn't apply under
 650                                    XEmacs.  DEFVAR_BUFFER_LOCAL in XEmacs
 651                                    behaves normally. */
 652                                 defvarperbufferflag = (c == 'P');
 653
 654                                 c = getc(infile);
 655                         } else {
 656                                 continue;
 657                         }
 658                 } else if (c == 'D' &&
 659                            (c = getc(infile)) == 'E' &&
 660                            (c = getc(infile)) == 'F') {
 661                         c = getc(infile);
 662                         defunflag = (c == 'U');
 663                         defvarflag = 0;
 664                         c = getc(infile);
 665                 } else {
 666                         continue;
 667                 }
 668                 while (c != '(') {
 669                         if (c < 0) {
 670                                 goto eof;
 671                         }
 672                         c = getc(infile);
 673                 }
 674
 675                 c = getc(infile);
 676                 if (c != '"') {
 677                         continue;
 678                 }
 679                 c = read_c_string(infile, -1, 0);
 680
 681                 if (defunflag) {
 682                         commas = 4;
 683                 } else if (defvarperbufferflag) {
 684                         commas = 2;
 685                 } else if (defvarflag) {
 686                         commas = 1;
 687                 } else {
 688                         /* For DEFSIMPLE and DEFPRED */
 689                         commas = 2;
 690                 }
 691                 for (; commas; c = getc(infile)) {
 692                         if (c == ',') {
 693                                 commas--;
 694                                 if (defunflag && (commas == 1 || commas == 2)) {
 695                                         c = check_comma(
 696                                                 infile, commas,
 697                                                 &minargs, &maxargs);
 698                                 }
 699                         }
 700                         if (c < 0) {
 701                                 goto eof;
 702                         }
 703                 }
 704                 while (c == ' ' || c == '\n' || c == '\t') {
 705                         c = getc(infile);
 706                 }
 707                 if (c == '"') {
 708                         c = read_c_string(infile, 0, 0);
 709                 }
 710                 if (defunflag | defvarflag) {
 711                         while (c != '/') {
 712                                 c = getc(infile);
 713                         }
 714                         c = getc(infile);
 715                         while (c == '*') {
 716                                 c = getc(infile);
 717                         }
 718                 } else {
 719                         while (c != ',') {
 720                                 c = getc(infile);
 721                         }
 722                         c = getc(infile);
 723                 }
 724                 while (c == ' ' || c == '\n' || c == '\t') {
 725                         c = getc(infile);
 726                 }
 727                 if (defunflag | defvarflag) {
 728                         ungetc(c, infile);
 729                 }
 730                 if (defunflag || defvarflag || c == '"') {
 731                         if (ellcc) {
 732                                 fprintf(outfile, "\tCDOC%s(\"%s\", \"\\\n",
 733                                         defvarflag ? "SYM" : "SUBR", buf);
 734                         } else {
 735                                 put_filename (filename); /* XEmacs addition */
 736                                 putc(037, outfile);
 737                                 putc(defvarflag ? 'V' : 'F', outfile);
 738                                 fprintf(outfile, "%s\n", buf);
 739                         }
 740                         c = read_c_string(infile, 1, (defunflag || defvarflag));
 741
 742                         /* If this is a defun, find the arguments and print
 743                            them.  If this function takes MANY or UNEVALLED args,
 744                            then the C source won't give the names of the
 745                            arguments, so we shouldn't bother trying to find
 746                            them.  */
 747                         if (defunflag && maxargs != -1) {
 748                                 char argbuf[1024];
 749                                 char *p = argbuf;
 750
 751                                 /* Skip into arguments.  */
 752                                 while (c != '(') {
 753                                         if (c < 0) {
 754                                                 goto eof;
 755                                         }
 756                                         c = getc(infile);
 757                                 }
 758                                 /* Copy arguments into ARGBUF. */
 759                                 *p++ = c;
 760                                 do {
 761                                         *p++ = c = getc(infile);
 762                                 } while (c != ')');
 763                                 *p = '\0';
 764                                 /* Output them. */
 765                                 if (ellcc) {
 766                                         fprintf(outfile, "\\n\\\n\\n\\\n");
 767                                 } else {
 768                                         fprintf(outfile, "\n\n");
 769                                 }
 770                                 write_c_args(
 771                                         outfile, buf, argbuf, minargs, maxargs);
 772                         }
 773                         if (ellcc) {
 774                                 fprintf(outfile, "\\n\");\n\n");
 775                         }
 776                 }
 777         }
 778 eof:
 779         fclose(infile);
 780         return 0;
 781 }
 782 \f
 783 /* Read a file of Lisp code, compiled or interpreted.
 784  Looks for
 785   (defun NAME ARGS DOCSTRING ...)
 786   (defmacro NAME ARGS DOCSTRING ...)
 787   (autoload (quote NAME) FILE DOCSTRING ...)
 788   (defvar NAME VALUE DOCSTRING)
 789   (defconst NAME VALUE DOCSTRING)
 790   (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
 791   (fset (quote NAME) #[... DOCSTRING ...])
 792   (defalias (quote NAME) #[... DOCSTRING ...])
 793  starting in column zero.
 794  (quote NAME) may appear as 'NAME as well.
 795
 796  We also look for #@LENGTH CONTENTS^_ at the beginning of the line.
 797  When we find that, we save it for the following defining-form,
 798  and we use that instead of reading a doc string within that defining-form.
 799
 800  For defun, defmacro, and autoload, we know how to skip over the arglist.
 801  For defvar, defconst, and fset we skip to the docstring with a kludgy
 802  formatting convention: all docstrings must appear on the same line as the
 803  initial open-paren (the one in column zero) and must contain a backslash
 804  and a double-quote immediately after the initial double-quote.  No newlines
 805  must appear between the beginning of the form and the first double-quote.
 806  The only source file that must follow this convention is loaddefs.el; aside
 807  from that, it is always the .elc file that we look at, and they are no
 808  problem because byte-compiler output follows this convention.
 809  The NAME and DOCSTRING are output.
 810  NAME is preceded by `F' for a function or `V' for a variable.
 811  An entry is output only if DOCSTRING has \ newline just after the opening "
 812
 813  Adds the filename a symbol or function was found in before its docstring;
 814  there's no need for this with the load-history available, but we do it for
 815  consistency with the C parsing code.
 816  */
 817
 818 static void
 819 skip_white(FILE *infile)
 820 {
 821         char c = ' ';
 822         while (c == ' ' || c == '\t' || c == '\n') {
 823                 c = getc(infile);
 824         }
 825         ungetc(c, infile);
 826         return;
 827 }
 828
 829 static void
 830 read_lisp_symbol(FILE *infile, char *buffer)
 831 {
 832         char c;
 833         char *fillp = buffer;
 834
 835         skip_white(infile);
 836         while (1) {
 837                 c = getc(infile);
 838                 if (c == '\\') {
 839                         /* FSF has *(++fillp), which is wrong. */
 840                         *fillp++ = getc(infile);
 841                 } else if (c == ' ' ||
 842                            c == '\t' ||
 843                            c == '\n' ||
 844                            c == '(' || c == ')') {
 845                         ungetc(c, infile);
 846                         *fillp = 0;
 847                         break;
 848                 } else {
 849                         *fillp++ = c;
 850                 }
 851         }
 852
 853         if (!buffer[0]) {
 854                 fprintf(stderr, "## expected a symbol, got '%c'\n", c);
 855         }
 856         skip_white(infile);
 857         return;
 858 }
 859
 860 static int
 861 get_dyna_doc(FILE *infile, char **saved_string)
 862 {
 863         int length = 0;
 864         int i;
 865         register int c;
 866
 867         /* Read the length.  */
 868         while ((c = getc(infile), c >= '0' && c <= '9')) {
 869                 length *= 10;
 870                 length += c - '0';
 871         }
 872
 873         /* The next character is a space that is counted in the length
 874            but not part of the doc string.
 875            We already read it, so just ignore it.  */
 876         length--;
 877
 878         /* Read in the contents.  */
 879         if (*saved_string != NULL) {
 880                 free(*saved_string);
 881         }
 882         *saved_string = xmalloc(length);
 883         for (i = 0; i < length; i++) {
 884                 c = getc(infile);
 885                 if ( c >= 0 )
 886                         (*saved_string)[i] = (char)(c & 0xFF);
 887                 else {
 888                         (*saved_string)[i] = '\0';
 889                         break;
 890                 }
 891         }
 892         /* The last character is a ^_.
 893          * That is needed in the .elc file
 894          * but it is redundant in DOC.  So get rid of it here.  */
 895         (*saved_string)[length - 1] = 0;
 896
 897         /* Skip the newline.  */
 898         c = getc(infile);
 899         while (c > 0 && c != '\n') {
 900                 c = getc(infile);
 901         }
 902         return c;
 903 }
 904
 905 static int
 906 scan_lisp_file(const char *filename, const char *mode)
 907 {
 908         FILE *infile;
 909         register int c;
 910         char *saved_string = 0;
 911
 912         infile = fopen(filename, mode);
 913         if (infile == NULL) {
 914                 perror(filename);
 915                 /* No error */
 916                 return 0;
 917         }
 918
 919         c = '\n';
 920         while (!feof(infile)) {
 921                 char buffer[BUFSIZ];
 922                 char type;
 923
 924                 if (c != '\n') {
 925                         c = getc(infile);
 926                         continue;
 927                 }
 928                 c = getc(infile);
 929                 /* Detect a dynamic doc string and save it for the next
 930                  * expression. */
 931                 if (c == '#') {
 932                         c = getc(infile);
 933                         if (c == '@') {
 934                                 c = get_dyna_doc(infile, &saved_string);
 935                         }
 936                         continue;
 937                 }
 938
 939                 if (c != '(') {
 940                         continue;
 941                 }
 942
 943                 read_lisp_symbol(infile, buffer);
 944
 945                 if (!strcmp(buffer, "defun") || !strcmp(buffer, "defmacro")) {
 946                         type = 'F';
 947                         read_lisp_symbol(infile, buffer);
 948
 949                         /* Skip the arguments: either "nil" or
 950                          * a list in parens */
 951                         c = getc(infile);
 952                         if (c == 'n') { /* nil */
 953                                 if ((c = getc(infile)) != 'i' ||
 954                                     (c = getc(infile)) != 'l') {
 955                                         fprintf(stderr, "\
 956 ## unparsable arglist in %s (%s)\n",
 957                                                 buffer, filename);
 958                                         continue;
 959                                 }
 960                         } else if (c != '(') {
 961                                 fprintf(stderr, "\
 962 ## unparsable arglist in %s (%s)\n",
 963                                         buffer, filename);
 964                                 continue;
 965                         } else {
 966                                 while (c != ')') {
 967                                         c = getc(infile);
 968                                 }
 969                         }
 970                         skip_white(infile);
 971
 972                         /* If the next three characters aren't
 973                          * `dquote bslash newline' then we're not
 974                          * reading a docstring. */
 975                         if ((c = getc(infile)) != '"' ||
 976                             (c = getc(infile)) != '\\' ||
 977                             (c = getc(infile)) != '\n') {
 978 #ifdef DEBUG
 979                                 fprintf(stderr, "\
 980 ## non-docstring in %s (%s)\n",
 981                                         buffer, filename);
 982 #endif
 983                                 continue;
 984                         }
 985
 986                 } else if (!strcmp(buffer, "defvar") ||
 987                            !strcmp(buffer, "defconst")) {
 988                         char c1 = 0;
 989                         char c2 = 0;
 990
 991                         type = 'V';
 992                         read_lisp_symbol(infile, buffer);
 993
 994                         if (saved_string == 0) {
 995                                 /* Skip until the first newline;
 996                                  * remember the two previous chars. */
 997                                 while (c != '\n' && c >= 0) {
 998                                         /* #### Kludge --
 999                                          * Ignore any ESC x x ISO2022 seqs */
1000                                         if (c == 27) {
1001                                                 (void)getc(infile);
1002                                                 (void)getc(infile);
1003                                                 goto nextchar;
1004                                         }
1005
1006                                         c2 = c1;
1007                                         c1 = c;
1008                                 nextchar:
1009                                         c = getc(infile);
1010                                 }
1011
1012                                 /* If two previous characters were " and \,
1013                                    this is a doc string.
1014                                    Otherwise, there is none.  */
1015                                 if (c2 != '"' || c1 != '\\') {
1016 #ifdef DEBUG
1017                                         fprintf(stderr, "\
1018 ## non-docstring in %s (%s)\n",
1019                                                 buffer, filename);
1020 #endif  /* DEBUG */
1021                                         continue;
1022                                 }
1023                         }
1024
1025                 } else if (!strcmp(buffer, "custom-declare-variable")) {
1026                         char c1 = 0, c2 = 0;
1027                         type = 'V';
1028
1029                         c = getc (infile);
1030                         if (c == '\'') {
1031                                 read_lisp_symbol (infile, buffer);
1032                         } else {
1033                                 if (c != '(') {
1034                                         fprintf(stderr, "\
1035 ## unparsable name in custom-declare-variable in %s\n",
1036                                                 filename);
1037                                         continue;
1038                                 }
1039                                 read_lisp_symbol (infile, buffer);
1040                                 if (strcmp (buffer, "quote")) {
1041                                         fprintf(stderr, "\
1042 ## unparsable name in custom-declare-variable in %s\n",
1043                                                 filename);
1044                                         continue;
1045                                 }
1046                                 read_lisp_symbol (infile, buffer);
1047                                 c = getc (infile);
1048                                 if (c != ')') {
1049                                         fprintf(stderr, "\
1050 ## unparsable quoted name in custom-declare-variable in %s\n",
1051                                                 filename);
1052                                         continue;
1053                                 }
1054                         }
1055
1056                         if (saved_string == 0) {
1057                                 /* Skip to end of line; remember the two
1058                                    previous chars.  */
1059                                 while (c != '\n' && c >= 0) {
1060                                         c2 = c1;
1061                                         c1 = c;
1062                                         /* SXEmacs: shame we can't do this. */
1063                                         /* c = getc_skipping_iso2022(infile); */
1064                                         getc (infile);
1065                                 }
1066
1067                                 /* If two previous characters were " and \,
1068                                    this is a doc string.  Otherwise, there is
1069                                    none.  */
1070                                 if (c2 != '"' || c1 != '\\') {
1071 #ifdef DEBUG
1072                                         fprintf(stderr, "\
1073 ## non-docstring in %s (%s)\n",
1074                                                 buffer, filename);
1075 #endif  /* DEBUG */
1076                                         continue;
1077                                 }
1078                         }
1079
1080                 } else if (!strcmp(buffer, "fset") ||
1081                            !strcmp(buffer, "defalias")) {
1082                         char c1 = 0, c2 = 0;
1083                         type = 'F';
1084
1085                         c = getc(infile);
1086                         if (c == '\'') {
1087                                 read_lisp_symbol(infile, buffer);
1088                         } else {
1089                                 if (c != '(') {
1090                                         fprintf(stderr, "\
1091 ## unparsable name in fset in %s\n",
1092                                                 filename);
1093                                         continue;
1094                                 }
1095                                 read_lisp_symbol(infile, buffer);
1096                                 if (strcmp(buffer, "quote")) {
1097                                         fprintf(stderr, "\
1098 ## unparsable name in fset in %s\n",
1099                                                 filename);
1100                                         continue;
1101                                 }
1102                                 read_lisp_symbol(infile, buffer);
1103                                 c = getc(infile);
1104                                 if (c != ')') {
1105                                         fprintf(stderr, "\
1106 ## unparsable quoted name in fset in %s\n",
1107                                                 filename);
1108                                         continue;
1109                                 }
1110                         }
1111
1112                         if (saved_string == 0) {
1113                                 /* Skip until the first newline;
1114                                  * remember the two previous chars. */
1115                                 while (c != '\n' && c >= 0) {
1116                                         c2 = c1;
1117                                         c1 = c;
1118                                         c = getc(infile);
1119                                 }
1120
1121                                 /* If two previous characters were " and \,
1122                                    this is a doc string.
1123                                    Otherwise, there is none.  */
1124                                 if (c2 != '"' || c1 != '\\') {
1125 #ifdef DEBUG
1126                                         fprintf(stderr, "\
1127 ## non-docstring in %s (%s)\n",
1128                                                 buffer, filename);
1129 #endif  /* DEBUG */
1130                                         continue;
1131                                 }
1132                         }
1133
1134                 } else if (!strcmp(buffer, "autoload")) {
1135                         type = 'F';
1136                         c = getc(infile);
1137                         if (c == '\'') {
1138                                 read_lisp_symbol(infile, buffer);
1139                         } else {
1140                                 if (c != '(') {
1141                                         fprintf(stderr, "\
1142 ## unparsable name in autoload in %s\n",
1143                                                 filename);
1144                                         continue;
1145                                 }
1146                                 read_lisp_symbol(infile, buffer);
1147                                 if (strcmp(buffer, "quote")) {
1148                                         fprintf(stderr, "\
1149 ## unparsable name in autoload in %s\n",
1150                                                 filename);
1151                                         continue;
1152                                 }
1153                                 read_lisp_symbol(infile, buffer);
1154                                 c = getc(infile);
1155                                 if (c != ')') {
1156                                         fprintf(stderr, "\
1157 ## unparsable quoted name in autoload in %s\n",
1158                                                 filename);
1159                                         continue;
1160                                 }
1161                         }
1162                         skip_white(infile);
1163                         if ((c = getc(infile)) != '\"') {
1164                                 fprintf(stderr, "\
1165 ## autoload of %s unparsable (%s)\n",
1166                                         buffer, filename);
1167                                 continue;
1168                         }
1169                         read_c_string(infile, 0, 0);
1170                         skip_white(infile);
1171
1172                         if (saved_string == 0) {
1173                                 /* If the next three characters aren't
1174                                    `dquote bslash newline'
1175                                    then we're not reading a docstring.  */
1176                                 if ((c = getc(infile)) != '"' ||
1177                                     (c = getc(infile)) != '\\' ||
1178                                     (c = getc(infile)) != '\n') {
1179 #ifdef DEBUG
1180                                         fprintf(stderr, "\
1181 ## non-docstring in %s (%s)\n",
1182                                                 buffer, filename);
1183 #endif  /* DEBUG */
1184                                         continue;
1185                                 }
1186                         }
1187
1188                 } else {
1189 #ifdef DEBUG
1190                         fprintf(stderr, "\
1191 ## unrecognized top-level form, %s (%s)\n",
1192                                 buffer, filename);
1193 #endif  /* DEBUG */
1194                         continue;
1195                 }
1196
1197                 /* At this point, we should either use the previous
1198                    dynamic doc string in saved_string
1199                    or gobble a doc string from the input file.
1200
1201                    In the latter case, the opening quote (and leading
1202                    backslash-newline) have already been read.  */
1203                 put_filename (filename); /* XEmacs addition */
1204                 putc(037, outfile);
1205                 putc(type, outfile);
1206                 fprintf(outfile, "%s\n", buffer);
1207                 if (saved_string) {
1208                         fputs(saved_string, outfile);
1209                         /* Don't use one dynamic doc string twice.  */
1210                         free(saved_string);
1211                         saved_string = 0;
1212                 } else {
1213                         read_c_string(infile, 1, 0);
1214                 }
1215         }
1216         if (saved_string) {
1217                 /* If this is true then a dynamic doc string was
1218                    detected without a next expression. We should not
1219                    emit anything since the input was badly formed,
1220                    but lets free the string...
1221                 */
1222                 free(saved_string);
1223                 saved_string = 0;
1224         }
1225         fclose(infile);
1226         return 0;
1227 }
1228
1229 /* make-docfile.c ends here */