Mercurial > emacs
comparison src/lread.c @ 83530:46b1096093f5
Merged from emacs@sv.gnu.org.
Patches applied:
* emacs@sv.gnu.org/emacs--devo--0--patch-294
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-295
Merge from gnus--rel--5.10
* emacs@sv.gnu.org/emacs--devo--0--patch-296
Update from CVS: admin/FOR-RELEASE: Update refcard section.
* emacs@sv.gnu.org/emacs--devo--0--patch-297
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-298
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-299
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-300
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-301
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-302
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-303
Update from CVS
* emacs@sv.gnu.org/emacs--devo--0--patch-304
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-103
Update from CVS
* emacs@sv.gnu.org/gnus--rel--5.10--patch-104
Update from CVS
git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-570
author | Karoly Lorentey <lorentey@elte.hu> |
---|---|
date | Mon, 12 Jun 2006 07:27:12 +0000 |
parents | b6689e223e2f 767eeffaf27a |
children | a387c138b28e |
comparison
equal
deleted
inserted
replaced
83529:0d9e16eab053 | 83530:46b1096093f5 |
---|---|
87 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist; | 87 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist; |
88 Lisp_Object Qascii_character, Qload, Qload_file_name; | 88 Lisp_Object Qascii_character, Qload, Qload_file_name; |
89 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; | 89 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; |
90 Lisp_Object Qinhibit_file_name_operation; | 90 Lisp_Object Qinhibit_file_name_operation; |
91 Lisp_Object Qeval_buffer_list, Veval_buffer_list; | 91 Lisp_Object Qeval_buffer_list, Veval_buffer_list; |
92 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */ | |
92 | 93 |
93 extern Lisp_Object Qevent_symbol_element_mask; | 94 extern Lisp_Object Qevent_symbol_element_mask; |
94 extern Lisp_Object Qfile_exists_p; | 95 extern Lisp_Object Qfile_exists_p; |
95 | 96 |
96 /* non-zero iff inside `load' */ | 97 /* non-zero iff inside `load' */ |
718 { | 719 { |
719 register FILE *stream; | 720 register FILE *stream; |
720 register int fd = -1; | 721 register int fd = -1; |
721 int count = SPECPDL_INDEX (); | 722 int count = SPECPDL_INDEX (); |
722 Lisp_Object temp; | 723 Lisp_Object temp; |
723 struct gcpro gcpro1, gcpro2; | 724 struct gcpro gcpro1, gcpro2, gcpro3; |
724 Lisp_Object found, efound; | 725 Lisp_Object found, efound, hist_file_name; |
725 /* 1 means we printed the ".el is newer" message. */ | 726 /* 1 means we printed the ".el is newer" message. */ |
726 int newer = 0; | 727 int newer = 0; |
727 /* 1 means we are loading a compiled file. */ | 728 /* 1 means we are loading a compiled file. */ |
728 int compiled = 0; | 729 int compiled = 0; |
729 Lisp_Object handler; | 730 Lisp_Object handler; |
730 int safe_p = 1; | 731 int safe_p = 1; |
731 char *fmode = "r"; | 732 char *fmode = "r"; |
733 Lisp_Object tmp[2]; | |
732 #ifdef DOS_NT | 734 #ifdef DOS_NT |
733 fmode = "rt"; | 735 fmode = "rt"; |
734 #endif /* DOS_NT */ | 736 #endif /* DOS_NT */ |
735 | 737 |
736 CHECK_STRING (file); | 738 CHECK_STRING (file); |
743 | 745 |
744 /* Do this after the handler to avoid | 746 /* Do this after the handler to avoid |
745 the need to gcpro noerror, nomessage and nosuffix. | 747 the need to gcpro noerror, nomessage and nosuffix. |
746 (Below here, we care only whether they are nil or not.) | 748 (Below here, we care only whether they are nil or not.) |
747 The presence of this call is the result of a historical accident: | 749 The presence of this call is the result of a historical accident: |
748 it used to be in every file-operations and when it got removed | 750 it used to be in every file-operation and when it got removed |
749 everywhere, it accidentally stayed here. Since then, enough people | 751 everywhere, it accidentally stayed here. Since then, enough people |
750 supposedly have things like (load "$PROJECT/foo.el") in their .emacs | 752 supposedly have things like (load "$PROJECT/foo.el") in their .emacs |
751 that it seemed risky to remove. */ | 753 that it seemed risky to remove. */ |
752 if (! NILP (noerror)) | 754 if (! NILP (noerror)) |
753 { | 755 { |
763 /* Avoid weird lossage with null string as arg, | 765 /* Avoid weird lossage with null string as arg, |
764 since it would try to load a directory as a Lisp file */ | 766 since it would try to load a directory as a Lisp file */ |
765 if (SCHARS (file) > 0) | 767 if (SCHARS (file) > 0) |
766 { | 768 { |
767 int size = SBYTES (file); | 769 int size = SBYTES (file); |
768 Lisp_Object tmp[2]; | |
769 | 770 |
770 found = Qnil; | 771 found = Qnil; |
771 GCPRO2 (file, found); | 772 GCPRO2 (file, found); |
772 | 773 |
773 if (! NILP (must_suffix)) | 774 if (! NILP (must_suffix)) |
847 } | 848 } |
848 record_unwind_protect (record_load_unwind, Vloads_in_progress); | 849 record_unwind_protect (record_load_unwind, Vloads_in_progress); |
849 Vloads_in_progress = Fcons (found, Vloads_in_progress); | 850 Vloads_in_progress = Fcons (found, Vloads_in_progress); |
850 } | 851 } |
851 | 852 |
853 /* Get the name for load-history. */ | |
854 hist_file_name = (! NILP (Vpurify_flag) | |
855 ? Fconcat (2, (tmp[0] = Ffile_name_directory (file), | |
856 tmp[1] = Ffile_name_nondirectory (found), | |
857 tmp)) | |
858 : found) ; | |
859 | |
852 if (!bcmp (SDATA (found) + SBYTES (found) - 4, | 860 if (!bcmp (SDATA (found) + SBYTES (found) - 4, |
853 ".elc", 4)) | 861 ".elc", 4)) |
854 /* Load .elc files directly, but not when they are | 862 /* Load .elc files directly, but not when they are |
855 remote and have no handler! */ | 863 remote and have no handler! */ |
856 { | 864 { |
857 if (fd != -2) | 865 if (fd != -2) |
858 { | 866 { |
859 struct stat s1, s2; | 867 struct stat s1, s2; |
860 int result; | 868 int result; |
861 | 869 |
862 GCPRO2 (file, found); | 870 GCPRO3 (file, found, hist_file_name); |
863 | 871 |
864 if (!safe_to_load_p (fd)) | 872 if (!safe_to_load_p (fd)) |
865 { | 873 { |
866 safe_p = 0; | 874 safe_p = 0; |
867 if (!load_dangerous_libraries) | 875 if (!load_dangerous_libraries) |
911 { | 919 { |
912 Lisp_Object val; | 920 Lisp_Object val; |
913 | 921 |
914 if (fd >= 0) | 922 if (fd >= 0) |
915 emacs_close (fd); | 923 emacs_close (fd); |
916 val = call4 (Vload_source_file_function, found, file, | 924 val = call4 (Vload_source_file_function, found, hist_file_name, |
917 NILP (noerror) ? Qnil : Qt, | 925 NILP (noerror) ? Qnil : Qt, |
918 NILP (nomessage) ? Qnil : Qt); | 926 NILP (nomessage) ? Qnil : Qt); |
919 return unbind_to (count, val); | 927 return unbind_to (count, val); |
920 } | 928 } |
921 } | 929 } |
922 | 930 |
923 GCPRO2 (file, found); | 931 GCPRO3 (file, found, hist_file_name); |
924 | 932 |
925 #ifdef WINDOWSNT | 933 #ifdef WINDOWSNT |
926 emacs_close (fd); | 934 emacs_close (fd); |
927 efound = ENCODE_FILE (found); | 935 efound = ENCODE_FILE (found); |
928 stream = fopen ((char *) SDATA (efound), fmode); | 936 stream = fopen ((char *) SDATA (efound), fmode); |
957 specbind (Qload_file_name, found); | 965 specbind (Qload_file_name, found); |
958 specbind (Qinhibit_file_name_operation, Qnil); | 966 specbind (Qinhibit_file_name_operation, Qnil); |
959 load_descriptor_list | 967 load_descriptor_list |
960 = Fcons (make_number (fileno (stream)), load_descriptor_list); | 968 = Fcons (make_number (fileno (stream)), load_descriptor_list); |
961 load_in_progress++; | 969 load_in_progress++; |
962 readevalloop (Qget_file_char, stream, (! NILP (Vpurify_flag) ? file : found), | 970 readevalloop (Qget_file_char, stream, hist_file_name, |
963 Feval, 0, Qnil, Qnil, Qnil, Qnil); | 971 Feval, 0, Qnil, Qnil, Qnil, Qnil); |
964 unbind_to (count, Qnil); | 972 unbind_to (count, Qnil); |
965 | 973 |
966 /* Run any load-hooks for this file. */ | 974 /* Run any eval-after-load forms for this file */ |
967 temp = Fassoc (file, Vafter_load_alist); | 975 if (NILP (Vpurify_flag) |
968 if (!NILP (temp)) | 976 && (!NILP (Ffboundp (Qdo_after_load_evaluation)))) |
969 Fprogn (Fcdr (temp)); | 977 call1 (Qdo_after_load_evaluation, hist_file_name) ; |
978 | |
970 UNGCPRO; | 979 UNGCPRO; |
971 | 980 |
972 if (saved_doc_string) | 981 if (saved_doc_string) |
973 free (saved_doc_string); | 982 free (saved_doc_string); |
974 saved_doc_string = 0; | 983 saved_doc_string = 0; |
1391 | 1400 |
1392 readchar_backlog = -1; | 1401 readchar_backlog = -1; |
1393 | 1402 |
1394 GCPRO4 (sourcename, readfun, start, end); | 1403 GCPRO4 (sourcename, readfun, start, end); |
1395 | 1404 |
1405 /* Try to ensure sourcename is a truename, except whilst preloading. */ | |
1406 if (NILP (Vpurify_flag) | |
1407 && !NILP (sourcename) && Ffile_name_absolute_p (sourcename) | |
1408 && (!NILP (Ffboundp (Qfile_truename)))) | |
1409 sourcename = call1 (Qfile_truename, sourcename) ; | |
1410 | |
1396 LOADHIST_ATTACH (sourcename); | 1411 LOADHIST_ATTACH (sourcename); |
1397 | 1412 |
1398 continue_reading_p = 1; | 1413 continue_reading_p = 1; |
1399 while (continue_reading_p) | 1414 while (continue_reading_p) |
1400 { | 1415 { |
1749 Lisp_Object readcharfun; | 1764 Lisp_Object readcharfun; |
1750 int stringp; | 1765 int stringp; |
1751 int *byterep; | 1766 int *byterep; |
1752 { | 1767 { |
1753 register int c = READCHAR; | 1768 register int c = READCHAR; |
1769 /* \u allows up to four hex digits, \U up to eight. Default to the | |
1770 behaviour for \u, and change this value in the case that \U is seen. */ | |
1771 int unicode_hex_count = 4; | |
1754 | 1772 |
1755 *byterep = 0; | 1773 *byterep = 0; |
1756 | 1774 |
1757 switch (c) | 1775 switch (c) |
1758 { | 1776 { |
1911 } | 1929 } |
1912 } | 1930 } |
1913 | 1931 |
1914 *byterep = 2; | 1932 *byterep = 2; |
1915 return i; | 1933 return i; |
1934 } | |
1935 | |
1936 case 'U': | |
1937 /* Post-Unicode-2.0: Up to eight hex chars. */ | |
1938 unicode_hex_count = 8; | |
1939 case 'u': | |
1940 | |
1941 /* A Unicode escape. We only permit them in strings and characters, | |
1942 not arbitrarily in the source code, as in some other languages. */ | |
1943 { | |
1944 int i = 0; | |
1945 int count = 0; | |
1946 Lisp_Object lisp_char; | |
1947 struct gcpro gcpro1; | |
1948 | |
1949 while (++count <= unicode_hex_count) | |
1950 { | |
1951 c = READCHAR; | |
1952 /* isdigit(), isalpha() may be locale-specific, which we don't | |
1953 want. */ | |
1954 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0'); | |
1955 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10; | |
1956 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10; | |
1957 else | |
1958 { | |
1959 error ("Non-hex digit used for Unicode escape"); | |
1960 break; | |
1961 } | |
1962 } | |
1963 | |
1964 GCPRO1 (readcharfun); | |
1965 lisp_char = call2(intern("decode-char"), intern("ucs"), | |
1966 make_number(i)); | |
1967 UNGCPRO; | |
1968 | |
1969 if (EQ(Qnil, lisp_char)) | |
1970 { | |
1971 /* This is ugly and horrible and trashes the user's data. */ | |
1972 XSETFASTINT (i, MAKE_CHAR (charset_katakana_jisx0201, | |
1973 34 + 128, 46 + 128)); | |
1974 return i; | |
1975 } | |
1976 else | |
1977 { | |
1978 return XFASTINT (lisp_char); | |
1979 } | |
1916 } | 1980 } |
1917 | 1981 |
1918 default: | 1982 default: |
1919 if (BASE_LEADING_CODE_P (c)) | 1983 if (BASE_LEADING_CODE_P (c)) |
1920 c = read_multibyte (c, readcharfun); | 1984 c = read_multibyte (c, readcharfun); |
3971 DEFVAR_BOOL ("load-in-progress", &load_in_progress, | 4035 DEFVAR_BOOL ("load-in-progress", &load_in_progress, |
3972 doc: /* Non-nil iff inside of `load'. */); | 4036 doc: /* Non-nil iff inside of `load'. */); |
3973 | 4037 |
3974 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist, | 4038 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist, |
3975 doc: /* An alist of expressions to be evalled when particular files are loaded. | 4039 doc: /* An alist of expressions to be evalled when particular files are loaded. |
3976 Each element looks like (FILENAME FORMS...). | 4040 Each element looks like (REGEXP-OR-FEATURE FORMS...). |
3977 When `load' is run and the file-name argument is FILENAME, | 4041 |
3978 the FORMS in the corresponding element are executed at the end of loading. | 4042 REGEXP-OR-FEATURE is either a regular expression to match file names, or |
3979 | 4043 a symbol \(a feature name). |
3980 FILENAME must match exactly! Normally FILENAME is the name of a library, | 4044 |
3981 with no directory specified, since that is how `load' is normally called. | 4045 When `load' is run and the file-name argument matches an element's |
3982 An error in FORMS does not undo the load, | 4046 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol |
3983 but does prevent execution of the rest of the FORMS. | 4047 REGEXP-OR-FEATURE, the FORMS in the element are executed. |
3984 FILENAME can also be a symbol (a feature) and FORMS are then executed | 4048 |
3985 when the corresponding call to `provide' is made. */); | 4049 An error in FORMS does not undo the load, but does prevent execution of |
4050 the rest of the FORMS. */); | |
3986 Vafter_load_alist = Qnil; | 4051 Vafter_load_alist = Qnil; |
3987 | 4052 |
3988 DEFVAR_LISP ("load-history", &Vload_history, | 4053 DEFVAR_LISP ("load-history", &Vload_history, |
3989 doc: /* Alist mapping file names to symbols and features. | 4054 doc: /* Alist mapping file names to symbols and features. |
3990 Each alist element is a list that starts with a file name, | 4055 Each alist element is a list that starts with a file name, |
3991 except for one element (optional) that starts with nil and describes | 4056 except for one element (optional) that starts with nil and describes |
3992 definitions evaluated from buffers not visiting files. | 4057 definitions evaluated from buffers not visiting files. |
4058 | |
4059 The file name is absolute and is the true file name (i.e. it doesn't | |
4060 contain symbolic links) of the loaded file. | |
4061 | |
3993 The remaining elements of each list are symbols defined as variables | 4062 The remaining elements of each list are symbols defined as variables |
3994 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', | 4063 and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', |
3995 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'. | 4064 `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'. |
3996 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)', | 4065 An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)', |
3997 and means that SYMBOL was an autoload before this file redefined it | 4066 and means that SYMBOL was an autoload before this file redefined it |
4118 staticpro (&Qload_file_name); | 4187 staticpro (&Qload_file_name); |
4119 | 4188 |
4120 Qeval_buffer_list = intern ("eval-buffer-list"); | 4189 Qeval_buffer_list = intern ("eval-buffer-list"); |
4121 staticpro (&Qeval_buffer_list); | 4190 staticpro (&Qeval_buffer_list); |
4122 | 4191 |
4192 Qfile_truename = intern ("file-truename"); | |
4193 staticpro (&Qfile_truename) ; | |
4194 | |
4195 Qdo_after_load_evaluation = intern ("do-after-load-evaluation"); | |
4196 staticpro (&Qdo_after_load_evaluation) ; | |
4197 | |
4123 staticpro (&dump_path); | 4198 staticpro (&dump_path); |
4124 | 4199 |
4125 staticpro (&read_objects); | 4200 staticpro (&read_objects); |
4126 read_objects = Qnil; | 4201 read_objects = Qnil; |
4127 staticpro (&seen_list); | 4202 staticpro (&seen_list); |