comparison src/lread.c @ 2548:c4c8a36043be

[xemacs-hg @ 2005-02-03 07:11:19 by ben] behavior ws #4: package-suppress, autoload update/sync, add easy-mmode/regexp-opt to core lread.c, lisp.h: Remove undeeded Vload_file_name_internal_the_purecopy, Qload_file_name -- use internal_bind_lisp_object instead of specbind. Add load-suppress-alist. * easy-mmode.el, regexp-opt.el: Move these files into core. Uncomment stuff depending on new custom.el. autoload.el: Removed. Major update. Sync with FSF 21.2. Create the ability to make custom-defines files. update-elc-2.el, update-elc.el: Rewrite to use new autoload API. update-elc.el: Add easy-mmode.
author ben
date Thu, 03 Feb 2005 07:11:28 +0000
parents 3d8143fc88e1
children bbc3231c4812
comparison
equal deleted inserted replaced
2547:a9527fcdf77f 2548:c4c8a36043be
57 static int new_backquote_flag, old_backquote_flag; 57 static int new_backquote_flag, old_backquote_flag;
58 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot; 58 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
59 #endif 59 #endif
60 Lisp_Object Qvariable_domain; /* I18N3 */ 60 Lisp_Object Qvariable_domain; /* I18N3 */
61 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist; 61 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
62 Lisp_Object Qcurrent_load_list; 62 Lisp_Object Vload_suppress_alist;
63 Lisp_Object Qload, Qload_file_name, Qload_internal, Qfset; 63 Lisp_Object Qload, Qload_internal, Qfset;
64 64
65 /* Hash-table that maps directory names to hashes of their contents. */ 65 /* Hash-table that maps directory names to hashes of their contents. */
66 static Lisp_Object Vlocate_file_hash_table; 66 static Lisp_Object Vlocate_file_hash_table;
67 67
68 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable; 68 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
116 116
117 /* Same as Vload_file_name but not Lisp-accessible. This ensures that 117 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
118 our #$ checks are reliable. */ 118 our #$ checks are reliable. */
119 Lisp_Object Vload_file_name_internal; 119 Lisp_Object Vload_file_name_internal;
120 120
121 Lisp_Object Vload_file_name_internal_the_purecopy;
122
123 /* Function to use for reading, in `load' and friends. */ 121 /* Function to use for reading, in `load' and friends. */
124 Lisp_Object Vload_read_function; 122 Lisp_Object Vload_read_function;
125 123
126 /* The association list of objects read with the #n=object form. 124 /* The association list of objects read with the #n=object form.
127 Each member of the list has the form (n . object), and is used to 125 Each member of the list has the form (n . object), and is used to
336 static Lisp_Object 334 static Lisp_Object
337 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */ 335 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
338 { 336 {
339 Lstream_close (XLSTREAM (stream)); 337 Lstream_close (XLSTREAM (stream));
340 return Qnil; 338 return Qnil;
339 }
340
341 /* Check if NONRELOC/RELOC (an absolute filename) is suppressed according
342 to load-suppress-alist. */
343 static int
344 check_if_suppressed (Ibyte *nonreloc, Lisp_Object reloc)
345 {
346 Bytecount len;
347
348 if (!NILP (reloc))
349 {
350 nonreloc = XSTRING_DATA (reloc);
351 len = XSTRING_LENGTH (reloc);
352 }
353 else
354 len = qxestrlen (nonreloc);
355
356 if (len >= 4 && !qxestrcmp_ascii (nonreloc + len - 4, ".elc"))
357 len -= 4;
358 else if (len >= 3 && !qxestrcmp_ascii (nonreloc + len - 3, ".el"))
359 len -= 3;
360
361 EXTERNAL_LIST_LOOP_2 (acons, Vload_suppress_alist)
362 {
363 if (CONSP (acons) && STRINGP (XCAR (acons)))
364 {
365 Lisp_Object name = XCAR (acons);
366 if (XSTRING_LENGTH (name) == len &&
367 !memcmp (XSTRING_DATA (name), nonreloc, len))
368 {
369 struct gcpro gcpro1;
370 Lisp_Object val;
371
372 GCPRO1 (reloc);
373 val = Feval (XCDR (acons));
374 UNGCPRO;
375
376 if (!NILP (val))
377 return 1;
378 }
379 }
380 }
381
382 return 0;
341 } 383 }
342 384
343 /* The plague is coming. 385 /* The plague is coming.
344 386
345 Ring around the rosy, pocket full of posy, 387 Ring around the rosy, pocket full of posy,
687 internal_bind_int (&load_in_progress, 1 + load_in_progress); 729 internal_bind_int (&load_in_progress, 1 + load_in_progress);
688 record_unwind_protect (load_unwind, lispstream); 730 record_unwind_protect (load_unwind, lispstream);
689 internal_bind_lisp_object (&Vload_descriptor_list, 731 internal_bind_lisp_object (&Vload_descriptor_list,
690 Fcons (make_int (fd), Vload_descriptor_list)); 732 Fcons (make_int (fd), Vload_descriptor_list));
691 internal_bind_lisp_object (&Vload_file_name_internal, found); 733 internal_bind_lisp_object (&Vload_file_name_internal, found);
692 internal_bind_lisp_object (&Vload_file_name_internal_the_purecopy, Qnil);
693 /* this is not a simple internal_bind. */ 734 /* this is not a simple internal_bind. */
694 record_unwind_protect (load_force_doc_string_unwind, 735 record_unwind_protect (load_force_doc_string_unwind,
695 Vload_force_doc_string_list); 736 Vload_force_doc_string_list);
696 Vload_force_doc_string_list = Qnil; 737 Vload_force_doc_string_list = Qnil;
697 specbind (Qload_file_name, found); 738 internal_bind_lisp_object (&Vload_file_name, found);
698 #ifdef I18N3 739 #ifdef I18N3
699 /* set it to nil; a call to #'domain will set it. */ 740 /* set it to nil; a call to #'domain will set it. */
700 internal_bind_lisp_object (&Vfile_domain, Qnil); 741 internal_bind_lisp_object (&Vfile_domain, Qnil);
701 #endif 742 #endif
702 743
815 file name when searching. 856 file name when searching.
816 857
817 If MODE is non-nil, it should be a symbol or a list of symbol representing 858 If MODE is non-nil, it should be a symbol or a list of symbol representing
818 requirements. Allowed symbols are `exists', `executable', `writable', and 859 requirements. Allowed symbols are `exists', `executable', `writable', and
819 `readable'. If MODE is nil, it defaults to `readable'. 860 `readable'. If MODE is nil, it defaults to `readable'.
861
862 Filenames are checked against `load-suppress-alist' to determine if they
863 should be ignored.
820 864
821 `locate-file' keeps hash tables of the directories it searches through, 865 `locate-file' keeps hash tables of the directories it searches through,
822 in order to speed things up. It tries valiantly to not get confused in 866 in order to speed things up. It tries valiantly to not get confused in
823 the face of a changing and unpredictable environment, but can occasionally 867 the face of a changing and unpredictable environment, but can occasionally
824 get tripped up. In this case, you will have to call 868 get tripped up. In this case, you will have to call
1022 /* Check that we can access or open it. */ 1066 /* Check that we can access or open it. */
1023 closure->fd = locate_file_open_or_access_file (fn, closure->mode); 1067 closure->fd = locate_file_open_or_access_file (fn, closure->mode);
1024 1068
1025 if (closure->fd >= 0) 1069 if (closure->fd >= 0)
1026 { 1070 {
1027 /* We succeeded; return this descriptor and filename. */ 1071 if (!check_if_suppressed (fn, Qnil))
1028 if (closure->storeptr) 1072 {
1029 *closure->storeptr = build_intstring (fn); 1073 /* We succeeded; return this descriptor and filename. */
1030 1074 if (closure->storeptr)
1031 return 1; 1075 *closure->storeptr = build_intstring (fn);
1076
1077 return 1;
1078 }
1032 } 1079 }
1033 } 1080 }
1034 /* Keep mapping. */ 1081 /* Keep mapping. */
1035 return 0; 1082 return 0;
1036 } 1083 }
1176 1223
1177 MODE nonnegative means don't open the files, 1224 MODE nonnegative means don't open the files,
1178 just look for one for which access(file,MODE) succeeds. In this case, 1225 just look for one for which access(file,MODE) succeeds. In this case,
1179 returns a nonnegative value on success. On failure, returns -1. 1226 returns a nonnegative value on success. On failure, returns -1.
1180 1227
1181 If STOREPTR is nonzero, it points to a slot where the name of 1228 If STOREPTR is non-nil, it points to a slot where the name of
1182 the file actually found should be stored as a Lisp string. 1229 the file actually found should be stored as a Lisp string.
1183 Nil is stored there on failure. 1230 Nil is stored there on failure.
1184 1231
1185 Called openp() in FSFmacs. */ 1232 Called openp() in FSFmacs. */
1186 1233
1375 1422
1376 /* Don't do this. It is not necessary, and it needlessly exposes 1423 /* Don't do this. It is not necessary, and it needlessly exposes
1377 READCHARFUN (which can be a stream) to Lisp. --hniksic */ 1424 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1378 /*specbind (Qstandard_input, readcharfun);*/ 1425 /*specbind (Qstandard_input, readcharfun);*/
1379 1426
1380 specbind (Qcurrent_load_list, Qnil); 1427 internal_bind_lisp_object (&Vcurrent_load_list, Qnil);
1381 1428
1382 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 1429 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1383 Vcurrent_compiled_function_annotation = Qnil; 1430 Vcurrent_compiled_function_annotation = Qnil;
1384 #endif 1431 #endif
1385 GCPRO2 (val, sourcename); 1432 GCPRO2 (val, sourcename);
3070 DEFSUBR (Feval_buffer); 3117 DEFSUBR (Feval_buffer);
3071 DEFSUBR (Feval_region); 3118 DEFSUBR (Feval_region);
3072 3119
3073 DEFSYMBOL (Qstandard_input); 3120 DEFSYMBOL (Qstandard_input);
3074 DEFSYMBOL (Qread_char); 3121 DEFSYMBOL (Qread_char);
3075 DEFSYMBOL (Qcurrent_load_list);
3076 DEFSYMBOL (Qload); 3122 DEFSYMBOL (Qload);
3077 DEFSYMBOL (Qload_file_name);
3078 DEFSYMBOL (Qload_internal); 3123 DEFSYMBOL (Qload_internal);
3079 DEFSYMBOL (Qfset); 3124 DEFSYMBOL (Qfset);
3080 3125
3081 #ifdef LISP_BACKQUOTES 3126 #ifdef LISP_BACKQUOTES
3082 DEFSYMBOL (Qbackquote); 3127 DEFSYMBOL (Qbackquote);
3138 "*Location of lisp files to be used when dumping ONLY."); */ 3183 "*Location of lisp files to be used when dumping ONLY."); */
3139 3184
3140 DEFVAR_BOOL ("load-in-progress", &load_in_progress /* 3185 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3141 Non-nil iff inside of `load'. 3186 Non-nil iff inside of `load'.
3142 */ ); 3187 */ );
3188
3189 DEFVAR_LISP ("load-suppress-alist", &Vload_suppress_alist /*
3190 An alist of expressions controlling whether particular files can be loaded.
3191 Each element looks like (FILENAME EXPR).
3192 FILENAME should be a full pathname, but without the .el suffix.
3193 When `load' is run and is about to load the specified file, it evaluates
3194 the form to determine if the file can be loaded.
3195 This variable is normally initialized automatically.
3196 */ );
3197 Vload_suppress_alist = Qnil;
3143 3198
3144 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /* 3199 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3145 An alist of expressions to be evalled when particular files are loaded. 3200 An alist of expressions to be evalled when particular files are loaded.
3146 Each element looks like (FILENAME FORMS...). 3201 Each element looks like (FILENAME FORMS...).
3147 When `load' is run and the file-name argument is FILENAME, 3202 When `load' is run and the file-name argument is FILENAME,
3253 staticpro (&Vload_force_doc_string_list); 3308 staticpro (&Vload_force_doc_string_list);
3254 3309
3255 Vload_file_name_internal = Qnil; 3310 Vload_file_name_internal = Qnil;
3256 staticpro (&Vload_file_name_internal); 3311 staticpro (&Vload_file_name_internal);
3257 3312
3258 Vload_file_name_internal_the_purecopy = Qnil;
3259 staticpro (&Vload_file_name_internal_the_purecopy);
3260
3261 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 3313 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3262 Vcurrent_compiled_function_annotation = Qnil; 3314 Vcurrent_compiled_function_annotation = Qnil;
3263 staticpro (&Vcurrent_compiled_function_annotation); 3315 staticpro (&Vcurrent_compiled_function_annotation);
3264 #endif 3316 #endif
3265 3317