X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/f0ed0a6c895c49f50c9cbcafe36b1a86a25a8620..10a0e6fe87378d0dafb5ce257aa60c8a1b25c708:/src/lread.c diff --git a/src/lread.c b/src/lread.c index 94fb5ddb15..d0442d38fd 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,7 +1,7 @@ /* Lisp parsing and input streams. Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005 Free Software Foundation, Inc. + 2005, 2006 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -27,6 +27,7 @@ Boston, MA 02110-1301, USA. */ #include #include #include +#include #include "lisp.h" #include "intervals.h" #include "buffer.h" @@ -99,7 +100,7 @@ int load_in_progress; Lisp_Object Vsource_directory; /* Search path and suffixes for files to be loaded. */ -Lisp_Object Vload_path, Vload_suffixes, default_suffixes; +Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes; /* File name of user's init file. */ Lisp_Object Vuser_init_file; @@ -434,7 +435,7 @@ static void substitute_in_interval P_ ((INTERVAL, Lisp_Object)); /* Get a character from the tty. */ -extern Lisp_Object read_char (); +extern Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, int *)); /* Read input events until we get one that's acceptable for our purposes. @@ -459,7 +460,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, input_method) int no_switch_frame, ascii_required, error_nonascii, input_method; { - register Lisp_Object val, delayed_switch_frame; + volatile register Lisp_Object val, delayed_switch_frame; #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -470,9 +471,9 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii, /* Read until we get an acceptable event. */ retry: - val = read_char (0, 0, 0, - (input_method ? Qnil : Qt), - 0); + do + val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0); + while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */ if (BUFFERP (val)) goto retry; @@ -654,23 +655,64 @@ load_error_handler (data) return Qnil; } +DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, + doc: /* Return the suffixes that `load' should try if a suffix is \ +required. +This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) + () +{ + Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext; + while (CONSP (suffixes)) + { + Lisp_Object exts = Vload_file_rep_suffixes; + suffix = XCAR (suffixes); + suffixes = XCDR (suffixes); + while (CONSP (exts)) + { + ext = XCAR (exts); + exts = XCDR (exts); + lst = Fcons (concat2 (suffix, ext), lst); + } + } + return Fnreverse (lst); +} + DEFUN ("load", Fload, Sload, 1, 5, 0, doc: /* Execute a file of Lisp code named FILE. First try FILE with `.elc' appended, then try with `.el', - then try FILE unmodified (the exact suffixes are determined by -`load-suffixes'). Environment variable references in FILE - are replaced with their values by calling `substitute-in-file-name'. +then try FILE unmodified (the exact suffixes in the exact order are +determined by `load-suffixes'). Environment variable references in +FILE are replaced with their values by calling `substitute-in-file-name'. This function searches the directories in `load-path'. + If optional second arg NOERROR is non-nil, - report no error if FILE doesn't exist. +report no error if FILE doesn't exist. Print messages at start and end of loading unless - optional third arg NOMESSAGE is non-nil. +optional third arg NOMESSAGE is non-nil. If optional fourth arg NOSUFFIX is non-nil, don't try adding - suffixes `.elc' or `.el' to the specified name FILE. +suffixes `.elc' or `.el' to the specified name FILE. If optional fifth arg MUST-SUFFIX is non-nil, insist on - the suffix `.elc' or `.el'; don't accept just FILE unless - it ends in one of those suffixes or includes a directory name. -Return t if file exists. */) +the suffix `.elc' or `.el'; don't accept just FILE unless +it ends in one of those suffixes or includes a directory name. + +If this function fails to find a file, it may look for different +representations of that file before trying another file. +It does so by adding the non-empty suffixes in `load-file-rep-suffixes' +to the file name. Emacs uses this feature mainly to find compressed +versions of files when Auto Compression mode is enabled. + +The exact suffixes that this function tries out, in the exact order, +are given by the value of the variable `load-file-rep-suffixes' if +NOSUFFIX is non-nil and by the return value of the function +`get-load-suffixes' if MUST-SUFFIX is non-nil. If both NOSUFFIX and +MUST-SUFFIX are nil, this function first tries out the latter suffixes +and then the former. + +Loading a file records its definitions, and its `provide' and +`require' calls, in an element of `load-history' whose +car is the file name loaded. See `load-history'. + +Return t if the file exists and loads successfully. */) (file, noerror, nomessage, nosuffix, must_suffix) Lisp_Object file, noerror, nomessage, nosuffix, must_suffix; { @@ -678,7 +720,7 @@ Return t if file exists. */) register int fd = -1; int count = SPECPDL_INDEX (); Lisp_Object temp; - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; Lisp_Object found, efound; /* 1 means we printed the ".el is newer" message. */ int newer = 0; @@ -725,7 +767,8 @@ Return t if file exists. */) int size = SBYTES (file); Lisp_Object tmp[2]; - GCPRO1 (file); + found = Qnil; + GCPRO2 (file, found); if (! NILP (must_suffix)) { @@ -744,9 +787,9 @@ Return t if file exists. */) fd = openp (Vload_path, file, (!NILP (nosuffix) ? Qnil - : !NILP (must_suffix) ? Vload_suffixes - : Fappend (2, (tmp[0] = Vload_suffixes, - tmp[1] = default_suffixes, + : !NILP (must_suffix) ? Fget_load_suffixes () + : Fappend (2, (tmp[0] = Fget_load_suffixes (), + tmp[1] = Vload_file_rep_suffixes, tmp))), &found, Qnil); UNGCPRO; @@ -796,8 +839,12 @@ Return t if file exists. */) if (!NILP (Fequal (found, XCAR (tem)))) count++; if (count > 3) - Fsignal (Qerror, Fcons (build_string ("Recursive load"), - Fcons (found, Vloads_in_progress))); + { + if (fd >= 0) + emacs_close (fd); + Fsignal (Qerror, Fcons (build_string ("Recursive load"), + Fcons (found, Vloads_in_progress))); + } record_unwind_protect (record_load_unwind, Vloads_in_progress); Vloads_in_progress = Fcons (found, Vloads_in_progress); } @@ -812,6 +859,8 @@ Return t if file exists. */) struct stat s1, s2; int result; + GCPRO2 (file, found); + if (!safe_to_load_p (fd)) { safe_p = 0; @@ -828,7 +877,6 @@ Return t if file exists. */) compiled = 1; - GCPRO1 (efound); efound = ENCODE_FILE (found); #ifdef DOS_NT @@ -838,7 +886,6 @@ Return t if file exists. */) SSET (efound, SBYTES (efound) - 1, 0); result = stat ((char *)SDATA (efound), &s2); SSET (efound, SBYTES (efound) - 1, 'c'); - UNGCPRO; if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) { @@ -848,12 +895,13 @@ Return t if file exists. */) /* If we won't print another message, mention this anyway. */ if (!NILP (nomessage)) { - Lisp_Object file; - file = Fsubstring (found, make_number (0), make_number (-1)); + Lisp_Object msg_file; + msg_file = Fsubstring (found, make_number (0), make_number (-1)); message_with_string ("Source file `%s' newer than byte-compiled file", - file, 1); + msg_file, 1); } } + UNGCPRO; } } else @@ -872,12 +920,12 @@ Return t if file exists. */) } } + GCPRO2 (file, found); + #ifdef WINDOWSNT emacs_close (fd); - GCPRO1 (efound); efound = ENCODE_FILE (found); stream = fopen ((char *) SDATA (efound), fmode); - UNGCPRO; #else /* not WINDOWSNT */ stream = fdopen (fd, fmode); #endif /* not WINDOWSNT */ @@ -904,7 +952,6 @@ Return t if file exists. */) message_with_string ("Loading %s...", file, 1); } - GCPRO1 (file); record_unwind_protect (load_unwind, make_save_value (stream, 0)); record_unwind_protect (load_descriptor_unwind, load_descriptor_list); specbind (Qload_file_name, found); @@ -912,8 +959,8 @@ Return t if file exists. */) load_descriptor_list = Fcons (make_number (fileno (stream)), load_descriptor_list); load_in_progress++; - readevalloop (Qget_file_char, stream, file, Feval, - 0, Qnil, Qnil, Qnil, Qnil); + readevalloop (Qget_file_char, stream, (! NILP (Vpurify_flag) ? file : found), + Feval, 0, Qnil, Qnil, Qnil, Qnil); unbind_to (count, Qnil); /* Run any load-hooks for this file. */ @@ -1070,7 +1117,7 @@ openp (path, str, suffixes, storeptr, predicate) SBYTES (XCAR (tail))); } - string = filename = Qnil; + string = filename = encoded_fn = Qnil; GCPRO6 (str, string, filename, path, suffixes, encoded_fn); if (storeptr) @@ -1100,7 +1147,7 @@ openp (path, str, suffixes, storeptr, predicate) fn = (char *) alloca (fn_size = 100 + want_size); /* Loop over suffixes. */ - for (tail = NILP (suffixes) ? default_suffixes : suffixes; + for (tail = NILP (suffixes) ? Fcons (build_string (""), Qnil) : suffixes; CONSP (tail); tail = XCDR (tail)) { int lsuffix = SBYTES (XCAR (tail)); @@ -1193,33 +1240,34 @@ openp (path, str, suffixes, storeptr, predicate) /* Merge the list we've accumulated of globals from the current input source into the load_history variable. The details depend on whether - the source has an associated file name or not. */ + the source has an associated file name or not. + + FILENAME is the file name that we are loading from. + ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */ static void -build_load_history (stream, source) - FILE *stream; - Lisp_Object source; +build_load_history (filename, entire) + Lisp_Object filename; + int entire; { register Lisp_Object tail, prev, newelt; register Lisp_Object tem, tem2; - register int foundit, loading; - - loading = stream || !NARROWED; + register int foundit = 0; tail = Vload_history; prev = Qnil; - foundit = 0; + while (CONSP (tail)) { tem = XCAR (tail); /* Find the feature's previous assoc list... */ - if (!NILP (Fequal (source, Fcar (tem)))) + if (!NILP (Fequal (filename, Fcar (tem)))) { foundit = 1; - /* If we're loading, remove it. */ - if (loading) + /* If we're loading the entire file, remove old data. */ + if (entire) { if (NILP (prev)) Vload_history = XCDR (tail); @@ -1251,10 +1299,10 @@ build_load_history (stream, source) QUIT; } - /* If we're loading, cons the new assoc onto the front of load-history, - the most-recently-loaded position. Also do this if we didn't find - an existing member for the current source. */ - if (loading || !foundit) + /* If we're loading an entire file, cons the new assoc onto the + front of load-history, the most-recently-loaded position. Also + do this if we didn't find an existing member for the file. */ + if (entire || !foundit) Vload_history = Fcons (Fnreverse (Vcurrent_load_list), Vload_history); } @@ -1310,23 +1358,34 @@ readevalloop (readcharfun, stream, sourcename, evalfun, register int c; register Lisp_Object val; int count = SPECPDL_INDEX (); - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *b = 0; + int bpos; int continue_reading_p; + /* Nonzero if reading an entire buffer. */ + int whole_buffer = 0; + /* 1 on the first time around. */ + int first_sexp = 1; + + if (MARKERP (readcharfun)) + { + if (NILP (start)) + start = readcharfun; + } if (BUFFERP (readcharfun)) b = XBUFFER (readcharfun); else if (MARKERP (readcharfun)) b = XMARKER (readcharfun)->buffer; - specbind (Qstandard_input, readcharfun); + specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */ specbind (Qcurrent_load_list, Qnil); record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil); load_convert_to_unibyte = !NILP (unibyte); readchar_backlog = -1; - GCPRO1 (sourcename); + GCPRO4 (sourcename, readfun, start, end); LOADHIST_ATTACH (sourcename); @@ -1340,12 +1399,32 @@ readevalloop (readcharfun, stream, sourcename, evalfun, if (!NILP (start)) { + /* Switch to the buffer we are reading from. */ record_unwind_protect (save_excursion_restore, save_excursion_save ()); + set_buffer_internal (b); + + /* Save point in it. */ + record_unwind_protect (save_excursion_restore, save_excursion_save ()); + /* Save ZV in it. */ record_unwind_protect (save_restriction_restore, save_restriction_save ()); + /* Those get unbound after we read one expression. */ + + /* Set point and ZV around stuff to be read. */ Fgoto_char (start); - Fnarrow_to_region (make_number (BEGV), end); + if (!NILP (end)) + Fnarrow_to_region (make_number (BEGV), end); + + /* Just for cleanliness, convert END to a marker + if it is an integer. */ + if (INTEGERP (end)) + end = Fpoint_max_marker (); } + /* On the first cycle, we can easily test here + whether we are reading the whole buffer. */ + if (b && first_sexp) + whole_buffer = (PT == BEG && ZV == Z); + instream = stream; read_next: c = READCHAR; @@ -1395,8 +1474,11 @@ readevalloop (readcharfun, stream, sourcename, evalfun, if (!NILP (start) && continue_reading_p) start = Fpoint_marker (); + + /* Restore saved point and BEGV. */ unbind_to (count1, Qnil); + /* Now eval what we just read. */ val = (*evalfun) (val); if (printflag) @@ -1407,9 +1489,13 @@ readevalloop (readcharfun, stream, sourcename, evalfun, else Fprint (val, Qnil); } + + first_sexp = 0; } - build_load_history (stream, sourcename); + build_load_history (sourcename, + stream || whole_buffer); + UNGCPRO; unbind_to (count, Qnil); @@ -1729,13 +1815,12 @@ read_escape (readcharfun, stringp, byterep) return c | alt_modifier; case 's': - if (stringp) - return ' '; c = READCHAR; - if (c != '-') { - UNREAD (c); - return ' '; - } + if (c != '-') + { + UNREAD (c); + return ' '; + } c = READCHAR; if (c == '\\') c = read_escape (readcharfun, 0, byterep); @@ -3793,6 +3878,7 @@ syms_of_lread () defsubr (&Sintern); defsubr (&Sintern_soft); defsubr (&Sunintern); + defsubr (&Sget_load_suffixes); defsubr (&Sload); defsubr (&Seval_buffer); defsubr (&Seval_region); @@ -3854,13 +3940,27 @@ Initialized based on EMACSLOADPATH environment variable, if any, otherwise to default specified by file `epaths.h' when Emacs was built. */); DEFVAR_LISP ("load-suffixes", &Vload_suffixes, - doc: /* *List of suffixes to try for files to load. -This list should not include the empty string. */); + doc: /* List of suffixes for (compiled or source) Emacs Lisp files. +This list should not include the empty string. +`load' and related functions try to append these suffixes, in order, +to the specified file name if a Lisp suffix is allowed or required. */); Vload_suffixes = Fcons (build_string (".elc"), Fcons (build_string (".el"), Qnil)); + DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes, + doc: /* List of suffixes that indicate representations of \ +the same file. +This list should normally start with the empty string. + +Enabling Auto Compression mode appends the suffixes in +`jka-compr-load-suffixes' to this list and disabling Auto Compression +mode removes them again. `load' and related functions use this list to +determine whether they should look for compressed versions of a file +and, if so, which suffixes they should try to append to the file name +in order to do so. However, if you want to customize which suffixes +the loading functions recognize as compression suffixes, you should +customize `jka-compr-load-suffixes' rather than the present variable. */); /* We don't use empty_string because it's not initialized yet. */ - default_suffixes = Fcons (build_string (""), Qnil); - staticpro (&default_suffixes); + Vload_file_rep_suffixes = Fcons (build_string (""), Qnil); DEFVAR_BOOL ("load-in-progress", &load_in_progress, doc: /* Non-nil iff inside of `load'. */); @@ -3880,7 +3980,7 @@ when the corresponding call to `provide' is made. */); Vafter_load_alist = Qnil; DEFVAR_LISP ("load-history", &Vload_history, - doc: /* Alist mapping source file names to symbols and features. + doc: /* Alist mapping file names to symbols and features. Each alist element is a list that starts with a file name, except for one element (optional) that starts with nil and describes definitions evaluated from buffers not visiting files. @@ -3889,7 +3989,10 @@ and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'. An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)', and means that SYMBOL was an autoload before this file redefined it -as a function. */); +as a function. + +During preloading, the file name recorded is relative to the main Lisp +directory. These file names are converted to absolute at startup. */); Vload_history = Qnil; DEFVAR_LISP ("load-file-name", &Vload_file_name,