aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--src/lread.c121
1 files changed, 113 insertions, 8 deletions
diff --git a/src/lread.c b/src/lread.c
index 5769fba3644..5d54b7ee704 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -60,6 +60,13 @@ int load_in_progress;
60/* Search path for files to be loaded. */ 60/* Search path for files to be loaded. */
61Lisp_Object Vload_path; 61Lisp_Object Vload_path;
62 62
63/* This is the user-visible association list that maps features to
64 lists of defs in their load files. */
65Lisp_Object Vload_history;
66
67/* This is useud to build the load history. */
68Lisp_Object Vcurrent_load_list;
69
63/* File for get_file_char to read from. Use by load */ 70/* File for get_file_char to read from. Use by load */
64static FILE *instream; 71static FILE *instream;
65 72
@@ -398,7 +405,7 @@ Return t if file exists.")
398 XSET (lispstream, Lisp_Internal_Stream, (int) ptr); 405 XSET (lispstream, Lisp_Internal_Stream, (int) ptr);
399 record_unwind_protect (load_unwind, lispstream); 406 record_unwind_protect (load_unwind, lispstream);
400 load_in_progress++; 407 load_in_progress++;
401 readevalloop (Qget_file_char, stream, Feval, 0); 408 readevalloop (Qget_file_char, stream, str, Feval, 0);
402 unbind_to (count, Qnil); 409 unbind_to (count, Qnil);
403 410
404 /* Run any load-hooks for this file. */ 411 /* Run any load-hooks for this file. */
@@ -540,6 +547,74 @@ openp (path, str, suffix, storeptr, exec_only)
540} 547}
541 548
542 549
550/* Merge the list we've accumulated of globals from the current input source
551 into the load_history variable. The details depend on whether
552 the source has an associated file name or not. */
553
554static void
555build_load_history (stream, source)
556 FILE *stream;
557 Lisp_Object source;
558{
559 register Lisp_Object tail, prev, newelt;
560 register Lisp_Object tem, tem2;
561 register int foundit, loading;
562
563 loading = stream || !NARROWED;
564
565 tail = Vload_history;
566 prev = Qnil;
567 foundit = 0;
568 while (!NILP (tail))
569 {
570 tem = Fcar (tail);
571
572 /* Find the feature's previous assoc list... */
573 if (!NILP (Fequal (source, Fcar (tem))))
574 {
575 foundit = 1;
576
577 /* If we're loading, remove it. */
578 if (loading)
579 {
580 if (NILP (prev))
581 Vload_history = Fcdr (tail);
582 else
583 Fsetcdr (prev, Fcdr (tail));
584 }
585
586 /* Otherwise, cons on new symbols that are not already members. */
587 else
588 {
589 tem2 = Vcurrent_load_list;
590
591 while (CONSP (tem2))
592 {
593 newelt = Fcar (tem2);
594
595 if (NILP (Fmemq (newelt, tem)))
596 Fsetcar (tail, Fcons (Fcar (tem),
597 Fcons (newelt, Fcdr (tem))));
598
599 tem2 = Fcdr (tem2);
600 QUIT;
601 }
602 }
603 }
604 else
605 prev = tail;
606 tail = Fcdr (tail);
607 QUIT;
608 }
609
610 /* If we're loading, cons the new assoc onto the front of load-history,
611 the most-recently-loaded position. Also do this if we didn't find
612 an existing member for the current source. */
613 if (loading || !foundit)
614 Vload_history = Fcons (Fnreverse(Vcurrent_load_list),
615 Vload_history);
616}
617
543Lisp_Object 618Lisp_Object
544unreadpure () /* Used as unwind-protect function in readevalloop */ 619unreadpure () /* Used as unwind-protect function in readevalloop */
545{ 620{
@@ -548,18 +623,27 @@ unreadpure () /* Used as unwind-protect function in readevalloop */
548} 623}
549 624
550static void 625static void
551readevalloop (readcharfun, stream, evalfun, printflag) 626readevalloop (readcharfun, stream, sourcename, evalfun, printflag)
552 Lisp_Object readcharfun; 627 Lisp_Object readcharfun;
553 FILE *stream; 628 FILE *stream;
629 Lisp_Object sourcename;
554 Lisp_Object (*evalfun) (); 630 Lisp_Object (*evalfun) ();
555 int printflag; 631 int printflag;
556{ 632{
557 register int c; 633 register int c;
558 register Lisp_Object val; 634 register Lisp_Object val;
635 Lisp_Object oldlist;
559 int count = specpdl_ptr - specpdl; 636 int count = specpdl_ptr - specpdl;
637 struct gcpro gcpro1, gcpro2;
560 638
561 specbind (Qstandard_input, readcharfun); 639 specbind (Qstandard_input, readcharfun);
562 640
641 oldlist = Vcurrent_load_list;
642 GCPRO2 (sourcename, oldlist);
643
644 Vcurrent_load_list = Qnil;
645 LOADHIST_ATTACH (sourcename);
646
563 while (1) 647 while (1)
564 { 648 {
565 instream = stream; 649 instream = stream;
@@ -595,6 +679,11 @@ readevalloop (readcharfun, stream, evalfun, printflag)
595 } 679 }
596 } 680 }
597 681
682 build_load_history (stream, sourcename);
683
684 Vcurrent_load_list = oldlist;
685 UNGCPRO;
686
598 unbind_to (count, Qnil); 687 unbind_to (count, Qnil);
599} 688}
600 689
@@ -629,7 +718,7 @@ point remains at the end of the last character read from the buffer.")
629 specbind (Qstandard_output, tem); 718 specbind (Qstandard_output, tem);
630 record_unwind_protect (save_excursion_restore, save_excursion_save ()); 719 record_unwind_protect (save_excursion_restore, save_excursion_save ());
631 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); 720 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
632 readevalloop (buf, 0, Feval, !NILP (printflag)); 721 readevalloop (buf, 0, XBUFFER (buf)->filename, Feval, !NILP (printflag));
633 unbind_to (count, Qnil); 722 unbind_to (count, Qnil);
634 723
635 return Qnil; 724 return Qnil;
@@ -647,7 +736,9 @@ point remains at the end of the last character read from the buffer.")
647 Lisp_Object printflag; 736 Lisp_Object printflag;
648{ 737{
649 int count = specpdl_ptr - specpdl; 738 int count = specpdl_ptr - specpdl;
650 Lisp_Object tem; 739 Lisp_Object tem, cbuf;
740
741 cbuf = Fcurrent_buffer ()
651 742
652 if (NILP (printflag)) 743 if (NILP (printflag))
653 tem = Qsymbolp; 744 tem = Qsymbolp;
@@ -656,7 +747,7 @@ point remains at the end of the last character read from the buffer.")
656 specbind (Qstandard_output, tem); 747 specbind (Qstandard_output, tem);
657 record_unwind_protect (save_excursion_restore, save_excursion_save ()); 748 record_unwind_protect (save_excursion_restore, save_excursion_save ());
658 SET_PT (BEGV); 749 SET_PT (BEGV);
659 readevalloop (Fcurrent_buffer (), 0, Feval, !NILP (printflag)); 750 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag));
660 return unbind_to (count, Qnil); 751 return unbind_to (count, Qnil);
661} 752}
662#endif 753#endif
@@ -675,7 +766,9 @@ point remains at the end of the last character read from the buffer.")
675 Lisp_Object b, e, printflag; 766 Lisp_Object b, e, printflag;
676{ 767{
677 int count = specpdl_ptr - specpdl; 768 int count = specpdl_ptr - specpdl;
678 Lisp_Object tem; 769 Lisp_Object tem, cbuf;
770
771 cbuf = Fcurrent_buffer ();
679 772
680 if (NILP (printflag)) 773 if (NILP (printflag))
681 tem = Qsymbolp; 774 tem = Qsymbolp;
@@ -690,7 +783,7 @@ point remains at the end of the last character read from the buffer.")
690 /* This both uses b and checks its type. */ 783 /* This both uses b and checks its type. */
691 Fgoto_char (b); 784 Fgoto_char (b);
692 Fnarrow_to_region (make_number (BEGV), e); 785 Fnarrow_to_region (make_number (BEGV), e);
693 readevalloop (Fcurrent_buffer (), 0, Feval, !NILP (printflag)); 786 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, !NILP (printflag));
694 787
695 return unbind_to (count, Qnil); 788 return unbind_to (count, Qnil);
696} 789}
@@ -1799,6 +1892,18 @@ An error in FORMS does not undo the load,\n\
1799but does prevent execution of the rest of the FORMS."); 1892but does prevent execution of the rest of the FORMS.");
1800 Vafter_load_alist = Qnil; 1893 Vafter_load_alist = Qnil;
1801 1894
1895 DEFVAR_LISP ("load-history", &Vload_history,
1896 "Alist mapping source file names to symbols and features.\n\
1897Each alist element is a list that starts with a file name,\n\
1898except for one element (optional) that starts with nil and describes\n\
1899definitions evaluated from buffers not visiting files.\n\
1900The remaining elements of each list are symbols defined as functions\n\
1901or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.");
1902 Vload_history = Qnil;
1903
1904 staticpro (&Vcurrent_load_list);
1905 Vcurrent_load_list = Qnil;
1906
1802 Qstandard_input = intern ("standard-input"); 1907 Qstandard_input = intern ("standard-input");
1803 staticpro (&Qstandard_input); 1908 staticpro (&Qstandard_input);
1804 1909