/* Lisp parsing and input streams.
- Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998,
- 1999, 2000, 2001, 2003, 2004, 2005 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
+ 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ 2005, 2006 Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include <config.h>
#include <sys/stat.h>
#include <sys/file.h>
#include <errno.h>
+#include <setjmp.h>
#include "lisp.h"
#include "intervals.h"
#include "buffer.h"
Lisp_Object Qascii_character, Qload, Qload_file_name;
Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
Lisp_Object Qinhibit_file_name_operation;
+Lisp_Object Qeval_buffer_list, Veval_buffer_list;
extern Lisp_Object Qevent_symbol_element_mask;
extern Lisp_Object Qfile_exists_p;
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;
\f
/* 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.
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)
/* 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;
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;
{
register FILE *stream;
register int fd = -1;
- register Lisp_Object lispstream;
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;
int size = SBYTES (file);
Lisp_Object tmp[2];
- GCPRO1 (file);
+ found = Qnil;
+ GCPRO2 (file, found);
if (! NILP (must_suffix))
{
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;
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);
}
struct stat s1, s2;
int result;
+ GCPRO2 (file, found);
+
if (!safe_to_load_p (fd))
{
safe_p = 0;
compiled = 1;
- GCPRO1 (efound);
efound = ENCODE_FILE (found);
#ifdef DOS_NT
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)
{
/* 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
}
}
+ 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 */
message_with_string ("Loading %s...", file, 1);
}
- GCPRO1 (file);
- lispstream = Fcons (Qnil, Qnil);
- XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16);
- XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff);
- record_unwind_protect (load_unwind, lispstream);
+ record_unwind_protect (load_unwind, make_save_value (stream, 0));
record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
specbind (Qload_file_name, found);
specbind (Qinhibit_file_name_operation, Qnil);
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. */
}
static Lisp_Object
-load_unwind (stream) /* used as unwind-protect function in load */
- Lisp_Object stream;
+load_unwind (arg) /* used as unwind-protect function in load */
+ Lisp_Object arg;
{
- fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
- | XFASTINT (XCDR (stream))));
+ FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
+ if (stream != NULL)
+ fclose (stream);
if (--load_in_progress < 0) load_in_progress = 0;
return Qnil;
}
SBYTES (XCAR (tail)));
}
- string = filename = Qnil;
+ string = filename = encoded_fn = Qnil;
GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
if (storeptr)
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));
\f
/* 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);
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);
}
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);
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;
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)
else
Fprint (val, Qnil);
}
+
+ first_sexp = 0;
}
- build_load_history (stream, sourcename);
+ build_load_history (sourcename,
+ stream || whole_buffer);
+
UNGCPRO;
unbind_to (count, Qnil);
if (NILP (filename))
filename = XBUFFER (buf)->filename;
+ specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
specbind (Qstandard_output, tem);
record_unwind_protect (save_excursion_restore, save_excursion_save ());
BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
else
tem = printflag;
specbind (Qstandard_output, tem);
+ specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
/* readevalloop calls functions which check the type of start and end. */
readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
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);
defsubr (&Sintern);
defsubr (&Sintern_soft);
defsubr (&Sunintern);
+ defsubr (&Sget_load_suffixes);
defsubr (&Sload);
defsubr (&Seval_buffer);
defsubr (&Seval_region);
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'. */);
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.
`(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,
Vbytecomp_version_regexp
= build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
+ DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
+ doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */);
+ Veval_buffer_list = Qnil;
+
/* Vsource_directory was initialized in init_lread. */
load_descriptor_list = Qnil;
Qload_file_name = intern ("load-file-name");
staticpro (&Qload_file_name);
+ Qeval_buffer_list = intern ("eval-buffer-list");
+ staticpro (&Qeval_buffer_list);
+
staticpro (&dump_path);
staticpro (&read_objects);
read_objects = Qnil;
staticpro (&seen_list);
+ seen_list = Qnil;
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);