comparison lib-src/make-docfile.c @ 753:8a4c2c149ec2

*** empty log message ***
author Jim Blandy <jimb@redhat.com>
date Wed, 08 Jul 1992 22:47:39 +0000
parents 39f0e62a8511
children de54d705652f
comparison
equal deleted inserted replaced
752:f7c08f6bd753 753:8a4c2c149ec2
346 } 346 }
347 347
348 /* Read a file of Lisp code, compiled or interpreted. 348 /* Read a file of Lisp code, compiled or interpreted.
349 Looks for 349 Looks for
350 (defun NAME ARGS DOCSTRING ...) 350 (defun NAME ARGS DOCSTRING ...)
351 (autoload 'NAME FILE DOCSTRING ...) 351 (defmacro NAME ARGS DOCSTRING ...)
352 (autoload (quote NAME) FILE DOCSTRING ...)
352 (defvar NAME VALUE DOCSTRING) 353 (defvar NAME VALUE DOCSTRING)
353 (defconst NAME VALUE DOCSTRING) 354 (defconst NAME VALUE DOCSTRING)
354 (fset (quote NAME) (make-byte-code (quote ARGS) ... "\ 355 (fset (quote NAME) (make-byte-code ... DOCSTRING ...))
355 DOCSTRING") 356 (fset (quote NAME) #[... DOCSTRING ...])
356 starting in column zero. 357 starting in column zero.
357 ARGS, FILE or VALUE is ignored. We do not know how to parse Lisp code 358 (quote NAME) may appear as 'NAME as well.
358 so we use a kludge to skip them: 359 For defun, defmacro, and autoload, we know how to skip over the arglist.
359 In a function definition, the form of ARGS of FILE is known, and we 360 For defvar, defconst, and fset we skip to the docstring with a klugey
360 can skip it. 361 formatting convention: all docstrings must appear on the same line as the
361 In a variable definition, we use a formatting convention: 362 initial open-paren (the one in column zero) and must contain a backslash
362 the DOCSTRING, if present, must be followed by a closeparen and a newline, 363 and a double-quote immediately after the initial double-quote. No newlines
363 and no newline must appear between the defvar or defconst and the docstring, 364 must appear between the beginning of the form and the first double-quote.
364 The only source file that must follow this convention is loaddefs.el; 365 The only source file that must follow this convention is loaddefs.el; aside
365 aside from that, it is always the .elc file that we look at, and 366 from that, it is always the .elc file that we look at, and they are no
366 they are no problem because byte-compiler output follows this convention. 367 problem because byte-compiler output follows this convention.
367 The NAME and DOCSTRING are output. 368 The NAME and DOCSTRING are output.
368 NAME is preceded by `F' for a function or `V' for a variable. 369 NAME is preceded by `F' for a function or `V' for a variable.
369 An entry is output only if DOCSTRING has \ newline just after the opening " 370 An entry is output only if DOCSTRING has \ newline just after the opening "
370 */ 371 */
371 372
373 void
374 skip_white (infile)
375 FILE *infile;
376 {
377 char c = ' ';
378 while (c == ' ' || c == '\t' || c == '\n')
379 c = getc (infile);
380 ungetc (c, infile);
381 }
382
383 void
384 read_lisp_symbol (infile, buffer)
385 FILE *infile;
386 char *buffer;
387 {
388 char c;
389 char *fillp = buffer;
390
391 skip_white (infile);
392 while (1)
393 {
394 c = getc (infile);
395 if (c == '\\')
396 *(++fillp) = getc (infile);
397 else if (c == ' ' || c == '\t' || c == '\n' || c == '(' || c == ')')
398 {
399 ungetc (c, infile);
400 *fillp = 0;
401 break;
402 }
403 else
404 *fillp++ = c;
405 }
406
407 if (! buffer[0])
408 fprintf (stderr, "## expected a symbol, got '%c'\n", c);
409
410 skip_white (infile);
411 }
412
413
372 scan_lisp_file (filename) 414 scan_lisp_file (filename)
373 char *filename; 415 char *filename;
374 { 416 {
375 FILE *infile; 417 FILE *infile;
376 register int c; 418 register int c;
377 register int commas;
378 register char *p;
379 int defvarflag;
380 419
381 infile = fopen (filename, "r"); 420 infile = fopen (filename, "r");
382 if (infile == NULL) 421 if (infile == NULL)
383 { 422 {
384 perror (filename); 423 perror (filename);
386 } 425 }
387 426
388 c = '\n'; 427 c = '\n';
389 while (!feof (infile)) 428 while (!feof (infile))
390 { 429 {
430 char buffer [BUFSIZ];
431 char *fillp = buffer;
432 char type;
433
391 if (c != '\n') 434 if (c != '\n')
392 { 435 {
393 c = getc (infile); 436 c = getc (infile);
394 continue; 437 continue;
395 } 438 }
396 c = getc (infile); 439 c = getc (infile);
397 if (c != '(') 440 if (c != '(')
398 continue; 441 continue;
399 442
400 /* Handle an autoload. */ 443 read_lisp_symbol (infile, buffer);
401 c = getc (infile); 444
402 if (c == 'a') 445 if (! strcmp (buffer, "defun") ||
403 { 446 ! strcmp (buffer, "defmacro"))
404 c = getc (infile); 447 {
405 if (c != 'u') 448 type = 'F';
406 continue; 449 read_lisp_symbol (infile, buffer);
407 c = getc (infile); 450
408 if (c != 't') 451 /* Skip the arguments: either "nil" or a list in parens */
409 continue; 452
410 c = getc (infile); 453 c = getc (infile);
411 if (c != 'o') 454 if (c == 'n') /* nil */
412 continue; 455 {
413 c = getc (infile); 456 if ((c = getc (infile)) != 'i' ||
414 if (c != 'l') 457 (c = getc (infile)) != 'l')
415 continue; 458 {
416 c = getc (infile); 459 fprintf (stderr, "## unparsable arglist in %s (%s)\n",
417 if (c != 'o') 460 buffer, filename);
418 continue; 461 continue;
419 c = getc (infile); 462 }
420 if (c != 'a') 463 }
421 continue; 464 else if (c != '(')
422 c = getc (infile); 465 {
423 if (c != 'd') 466 fprintf (stderr, "## unparsable arglist in %s (%s)\n",
424 continue; 467 buffer, filename);
425 468 continue;
426 c = getc (infile); 469 }
427 while (c == ' ') 470 else
428 c = getc (infile); 471 while (c != ')')
429 472 c = getc (infile);
473 skip_white (infile);
474
475 /* If the next three characters aren't `dquote bslash newline'
476 then we're not reading a docstring.
477 */
478 if ((c = getc (infile)) != '"' ||
479 (c = getc (infile)) != '\\' ||
480 (c = getc (infile)) != '\n')
481 {
482 #ifdef DEBUG
483 fprintf (stderr, "## non-docstring in %s (%s)\n",
484 buffer, filename);
485 #endif
486 continue;
487 }
488 }
489
490 else if (! strcmp (buffer, "defvar") ||
491 ! strcmp (buffer, "defconst"))
492 {
493 char c1 = 0, c2 = 0;
494 type = 'V';
495 read_lisp_symbol (infile, buffer);
496
497 /* Skip until the first newline; remember the two previous chars. */
498 while (c != '\n' && c >= 0)
499 {
500 c2 = c1;
501 c1 = c;
502 c = getc (infile);
503 }
504
505 /* If two previous characters were " and \,
506 this is a doc string. Otherwise, there is none. */
507 if (c2 != '"' || c1 != '\\')
508 {
509 #ifdef DEBUG
510 fprintf (stderr, "## non-docstring in %s (%s)\n",
511 buffer, filename);
512 #endif
513 continue;
514 }
515 }
516
517 else if (! strcmp (buffer, "fset"))
518 {
519 char c1 = 0, c2 = 0;
520 type = 'F';
521
522 c = getc (infile);
430 if (c == '\'') 523 if (c == '\'')
431 { 524 read_lisp_symbol (infile, buffer);
525 else
526 {
527 if (c != '(')
528 {
529 fprintf (stderr, "## unparsable name in fset in %s\n",
530 filename);
531 continue;
532 }
533 read_lisp_symbol (infile, buffer);
534 if (strcmp (buffer, "quote"))
535 {
536 fprintf (stderr, "## unparsable name in fset in %s\n",
537 filename);
538 continue;
539 }
540 read_lisp_symbol (infile, buffer);
432 c = getc (infile); 541 c = getc (infile);
433 } 542 if (c != ')')
543 {
544 fprintf (stderr,
545 "## unparsable quoted name in fset in %s\n",
546 filename);
547 continue;
548 }
549 }
550
551 /* Skip until the first newline; remember the two previous chars. */
552 while (c != '\n' && c >= 0)
553 {
554 c2 = c1;
555 c1 = c;
556 c = getc (infile);
557 }
558
559 /* If two previous characters were " and \,
560 this is a doc string. Otherwise, there is none. */
561 if (c2 != '"' || c1 != '\\')
562 {
563 #ifdef DEBUG
564 fprintf (stderr, "## non-docstring in %s (%s)\n",
565 buffer, filename);
566 #endif
567 continue;
568 }
569 }
570
571 else if (! strcmp (buffer, "autoload"))
572 {
573 type = 'F';
574 c = getc (infile);
575 if (c == '\'')
576 read_lisp_symbol (infile, buffer);
434 else 577 else
435 { 578 {
436 if (c != '(') 579 if (c != '(')
437 continue; 580 {
581 fprintf (stderr, "## unparsable name in autoload in %s\n",
582 filename);
583 continue;
584 }
585 read_lisp_symbol (infile, buffer);
586 if (strcmp (buffer, "quote"))
587 {
588 fprintf (stderr, "## unparsable name in autoload in %s\n",
589 filename);
590 continue;
591 }
592 read_lisp_symbol (infile, buffer);
438 c = getc (infile); 593 c = getc (infile);
439 if (c != 'q') 594 if (c != ')')
440 continue; 595 {
441 c = getc (infile); 596 fprintf (stderr,
442 if (c != 'u') 597 "## unparsable quoted name in autoload in %s\n",
443 continue; 598 filename);
444 c = getc (infile); 599 continue;
445 if (c != 'o') 600 }
446 continue; 601 }
447 c = getc (infile); 602 skip_white (infile);
448 if (c != 't') 603 if ((c = getc (infile)) != '\"')
449 continue; 604 {
450 c = getc (infile); 605 fprintf (stderr, "## autoload of %s unparsable (%s)\n",
451 if (c != 'e') 606 buffer, filename);
452 continue;
453 c = getc (infile);
454 if (c != ' ')
455 continue;
456 while (c == ' ')
457 c = getc (infile);
458 }
459
460 p = buf;
461 while (c != ' ' && c != ')')
462 {
463 if (c == EOF)
464 return 1;
465 if (c == '\\')
466 c = getc (infile);
467 *p++ = c;
468 c = getc (infile);
469 }
470 *p = 0;
471
472 while (c != '"')
473 {
474 if (c == EOF)
475 return 1;
476 c = getc (infile);
477 }
478 c = read_c_string (infile, 0);
479 }
480
481 /* Handle def* clauses. */
482 else if (c == 'd')
483 {
484 c = getc (infile);
485 if (c != 'e')
486 continue;
487 c = getc (infile);
488 if (c != 'f')
489 continue;
490 c = getc (infile);
491
492 /* Is this a defun? */
493 if (c == 'u')
494 {
495 c = getc (infile);
496 if (c != 'n')
497 continue;
498 defvarflag = 0;
499 }
500
501 /* Or a defvar? */
502 else if (c == 'v')
503 {
504 c = getc (infile);
505 if (c != 'a')
506 continue;
507 c = getc (infile);
508 if (c != 'r')
509 continue;
510 defvarflag = 1;
511 }
512
513 /* Or a defconst? */
514 else if (c == 'c')
515 {
516 c = getc (infile);
517 if (c != 'o')
518 continue;
519 c = getc (infile);
520 if (c != 'n')
521 continue;
522 c = getc (infile);
523 if (c != 's')
524 continue;
525 c = getc (infile);
526 if (c != 't')
527 continue;
528 defvarflag = 1;
529 }
530 else
531 continue;
532
533 /* Now we have seen "defun" or "defvar" or "defconst". */
534
535 while (c != ' ' && c != '\n' && c != '\t')
536 c = getc (infile);
537
538 while (c == ' ' || c == '\n' || c == '\t')
539 c = getc (infile);
540
541 /* Read and store name of function or variable being defined
542 Discard backslashes that are for quoting. */
543 p = buf;
544 while (c != ' ' && c != '\n' && c != '\t')
545 {
546 if (c == '\\')
547 c = getc (infile);
548 *p++ = c;
549 c = getc (infile);
550 }
551 *p = 0;
552
553 while (c == ' ' || c == '\n' || c == '\t')
554 c = getc (infile);
555
556 if (! defvarflag)
557 {
558 /* A function: */
559 /* Skip the arguments: either "nil" or a list in parens */
560 if (c == 'n')
561 {
562 while (c != ' ' && c != '\n' && c != '\t')
563 c = getc (infile);
564 }
565 else
566 {
567 while (c != '(')
568 c = getc (infile);
569 while (c != ')')
570 c = getc (infile);
571 }
572 c = getc (infile);
573 }
574 else
575 {
576 /* A variable: */
577
578 /* Skip until the first newline; remember
579 the two previous characters. */
580 char c1 = 0, c2 = 0;
581
582 while (c != '\n' && c >= 0)
583 {
584 c2 = c1;
585 c1 = c;
586 c = getc (infile);
587 }
588
589 /* If two previous characters were " and \,
590 this is a doc string. Otherwise, there is none. */
591 if (c2 == '"' && c1 == '\\')
592 {
593 putc (037, outfile);
594 putc ('V', outfile);
595 fprintf (outfile, "%s\n", buf);
596 read_c_string (infile, 1);
597 }
598 continue; 607 continue;
599 } 608 }
600 } 609 read_c_string (infile, 0);
601 610 skip_white (infile);
602 /* Handle an fset clause. */ 611
603 else if (c == 'f') 612 /* If the next three characters aren't `dquote bslash newline'
604 { 613 then we're not reading a docstring.
605 c = getc (infile); 614 */
606 if (c != 's') 615 if ((c = getc (infile)) != '"' ||
607 continue; 616 (c = getc (infile)) != '\\' ||
608 c = getc (infile); 617 (c = getc (infile)) != '\n')
609 if (c != 'e') 618 {
610 continue; 619 #ifdef DEBUG
611 c = getc (infile); 620 fprintf (stderr, "## non-docstring in %s (%s)\n",
612 if (c != 't') 621 buffer, filename);
613 continue; 622 #endif
614 623 continue;
615 /* Skip white space */ 624 }
616 do 625 }
617 c = getc (infile); 626
618 while (c == ' ' || c == '\n' || c == '\t'); 627 #ifdef DEBUG
619 628 else if (! strcmp (buffer, "if") ||
620 /* Recognize "(quote". */ 629 ! strcmp (buffer, "byte-code"))
621 if (c != '(') 630 ;
622 continue; 631 #endif
623 c = getc (infile); 632
624 if (c != 'q')
625 continue;
626 c = getc (infile);
627 if (c != 'u')
628 continue;
629 c = getc (infile);
630 if (c != 'o')
631 continue;
632 c = getc (infile);
633 if (c != 't')
634 continue;
635 c = getc (infile);
636 if (c != 'e')
637 continue;
638
639 /* Skip white space */
640 do
641 c = getc (infile);
642 while (c == ' ' || c == '\n' || c == '\t');
643
644 /* Read and store name of function or variable being defined
645 Discard backslashes that are for quoting. */
646 p = buf;
647 while (c != ')' && c != ' ' && c != '\n' && c != '\t')
648 {
649 if (c == '\\')
650 c = getc (infile);
651 *p++ = c;
652 c = getc (infile);
653 }
654 *p = '\0';
655
656 /* Skip white space */
657 do
658 c = getc (infile);
659 while (c == ' ' || c == '\n' || c == '\t');
660
661 /* Recognize "(make-byte-code". */
662 if (c != '(')
663 continue;
664 c = getc (infile);
665 if (c != 'm')
666 continue;
667 c = getc (infile);
668 if (c != 'a')
669 continue;
670 c = getc (infile);
671 if (c != 'k')
672 continue;
673 c = getc (infile);
674 if (c != 'e')
675 continue;
676 c = getc (infile);
677 if (c != '-')
678 continue;
679 c = getc (infile);
680 if (c != 'b')
681 continue;
682 c = getc (infile);
683 if (c != 'y')
684 continue;
685 c = getc (infile);
686 if (c != 't')
687 continue;
688 c = getc (infile);
689 if (c != 'e')
690 continue;
691 c = getc (infile);
692 if (c != '-')
693 continue;
694 c = getc (infile);
695 if (c != 'c')
696 continue;
697 c = getc (infile);
698 if (c != 'o')
699 continue;
700 c = getc (infile);
701 if (c != 'd')
702 continue;
703 c = getc (infile);
704 if (c != 'e')
705 continue;
706
707 /* Scan for a \" followed by a newline, or for )) followed by
708 a newline. If we find the latter first, this function has
709 no docstring. */
710 {
711 char c1 = 0, c2 = 0;
712
713 for (;;)
714 {
715
716 /* Find newlines, and remember the two previous characters. */
717 for (;;)
718 {
719 c = getc (infile);
720
721 if (c == '\n' || c < 0)
722 break;
723
724 c2 = c1;
725 c1 = c;
726 }
727
728 /* If we've hit eof, quit. */
729 if (c == EOF)
730 break;
731
732 /* If the last two characters were \", this is a docstring. */
733 else if (c2 == '"' && c1 == '\\')
734 {
735 putc (037, outfile);
736 putc ('F', outfile);
737 fprintf (outfile, "%s\n", buf);
738 read_c_string (infile, 1);
739 break;
740 }
741
742 /* If the last two characters were )), there is no
743 docstring. */
744 else if (c2 == ')' && c1 == ')')
745 break;
746 }
747 continue;
748 }
749 }
750 else 633 else
751 continue; 634 {
752 635 #ifdef DEBUG
753 /* Here for a function definition. 636 fprintf (stderr, "## unrecognised top-level form, %s (%s)\n",
754 We have skipped the file name or arguments 637 buffer, filename);
755 and arrived at where the doc string is, 638 #endif
756 if there is a doc string. */ 639 continue;
757 640 }
758 /* Skip whitespace */ 641
759 642 /* At this point, there is a docstring that we should gobble.
760 while (c == ' ' || c == '\n' || c == '\t') 643 The opening quote (and leading backslash-newline) have already
761 c = getc (infile); 644 been read.
762 645 */
763 /* " followed by \ and newline means a doc string we should gobble */ 646 putc ('\n', outfile);
764 if (c != '"')
765 continue;
766 c = getc (infile);
767 if (c != '\\')
768 continue;
769 c = getc (infile);
770 if (c != '\n')
771 continue;
772
773 putc (037, outfile); 647 putc (037, outfile);
774 putc ('F', outfile); 648 putc (type, outfile);
775 fprintf (outfile, "%s\n", buf); 649 fprintf (outfile, "%s\n", buffer);
776 read_c_string (infile, 1); 650 read_c_string (infile, 1);
777 } 651 }
778 fclose (infile); 652 fclose (infile);
779 return 0; 653 return 0;
780 } 654 }