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