/* Lisp parsing and input streams.
- Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998,
- 1999, 2000, 2001, 2003, 2004 Free Software Foundation, Inc.
+ Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
+ 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+ 2005, 2006, 2007 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
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 "keyboard.h"
#include "termhooks.h"
#include "coding.h"
+#include "blockinput.h"
#ifdef lint
#include <sys/inode.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;
+Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
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;
/* Nonzero means read should convert strings to unibyte. */
static int load_convert_to_unibyte;
-/* Function to use for loading an Emacs lisp source file (not
+/* Function to use for loading an Emacs Lisp source file (not
compiled) instead of readevalloop. */
Lisp_Object Vload_source_file_function;
Fread initializes this to zero, so we need not specbind it
or worry about what happens to it when there is an error. */
static int new_backquote_flag;
+static Lisp_Object Vold_style_backquotes, Qold_style_backquotes;
/* A list of file names for files being loaded in Fload. Used to
check for recursive loads. */
static void to_multibyte P_ ((char **, char **, int *));
static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
Lisp_Object (*) (), int,
+ Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object));
static Lisp_Object load_unwind P_ ((Lisp_Object));
static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
+static void invalid_syntax P_ ((const char *, int)) NO_RETURN;
+static void end_of_file_error P_ (()) NO_RETURN;
+
\f
/* Handle unreading and rereading of characters.
Write READCHAR to read a character,
if (EQ (readcharfun, Qget_file_char))
{
+ BLOCK_INPUT;
c = getc (instream);
#ifdef EINTR
/* Interrupted reads have been observed while reading over the network */
while (c == EOF && ferror (instream) && errno == EINTR)
{
+ UNBLOCK_INPUT;
QUIT;
+ BLOCK_INPUT;
clearerr (instream);
c = getc (instream);
}
#endif
+ UNBLOCK_INPUT;
return c;
}
else if (EQ (readcharfun, Qlambda))
read_bytecode_char (1);
else if (EQ (readcharfun, Qget_file_char))
- ungetc (c, instream);
+ {
+ BLOCK_INPUT;
+ ungetc (c, instream);
+ UNBLOCK_INPUT;
+ }
else
call1 (readcharfun, make_number (c));
}
character.
If INPUT_METHOD is nonzero, we invoke the current input method
- if the character warrants that. */
+ if the character warrants that.
+
+ If SECONDS is a number, we wait that many seconds for input, and
+ return Qnil if no input arrives within that time. */
Lisp_Object
read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
- input_method)
+ input_method, seconds)
int no_switch_frame, ascii_required, error_nonascii, input_method;
+ Lisp_Object seconds;
{
- register Lisp_Object val, delayed_switch_frame;
+ Lisp_Object val, delayed_switch_frame;
+ EMACS_TIME end_time;
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
delayed_switch_frame = Qnil;
+ /* Compute timeout. */
+ if (NUMBERP (seconds))
+ {
+ EMACS_TIME wait_time;
+ int sec, usec;
+ double duration = extract_float (seconds);
+
+ sec = (int) duration;
+ usec = (duration - sec) * 1000000;
+ EMACS_GET_TIME (end_time);
+ EMACS_SET_SECS_USECS (wait_time, sec, usec);
+ EMACS_ADD_TIME (end_time, end_time, wait_time);
+ }
+
/* Read until we get an acceptable event. */
retry:
- val = read_char (0, 0, 0,
- (input_method ? Qnil : Qt),
- 0);
+ val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
+ NUMBERP (seconds) ? &end_time : NULL);
if (BUFFERP (val))
goto retry;
switch-frame events will read it and process it. */
if (no_switch_frame
&& EVENT_HAS_PARAMETERS (val)
- && EQ (EVENT_HEAD (val), Qswitch_frame))
+ && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
{
delayed_switch_frame = val;
goto retry;
}
- if (ascii_required)
+ if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
{
/* Convert certain symbols to their ASCII equivalents. */
if (SYMBOLP (val))
return val;
}
-DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0,
+DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.
If the user generates an event which is not a character (i.e. a mouse
If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
-is used for reading a character. */)
- (prompt, inherit_input_method)
- Lisp_Object prompt, inherit_input_method;
+is used for reading a character.
+If the optional argument SECONDS is non-nil, it should be a number
+specifying the maximum number of seconds to wait for input. If no
+input arrives in that time, return nil. SECONDS may be a
+floating-point value. */)
+ (prompt, inherit_input_method, seconds)
+ Lisp_Object prompt, inherit_input_method, seconds;
{
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
- return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method));
+ return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
}
-DEFUN ("read-event", Fread_event, Sread_event, 0, 2, 0,
+DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
doc: /* Read an event object from the input stream.
If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
-is used for reading a character. */)
- (prompt, inherit_input_method)
- Lisp_Object prompt, inherit_input_method;
+is used for reading a character.
+If the optional argument SECONDS is non-nil, it should be a number
+specifying the maximum number of seconds to wait for input. If no
+input arrives in that time, return nil. SECONDS may be a
+floating-point value. */)
+ (prompt, inherit_input_method, seconds)
+ Lisp_Object prompt, inherit_input_method, seconds;
{
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
- return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method));
+ return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
}
-DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 2, 0,
+DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number. Non-character events are ignored.
If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
-is used for reading a character. */)
- (prompt, inherit_input_method)
- Lisp_Object prompt, inherit_input_method;
+is used for reading a character.
+If the optional argument SECONDS is non-nil, it should be a number
+specifying the maximum number of seconds to wait for input. If no
+input arrives in that time, return nil. SECONDS may be a
+floating-point value. */)
+ (prompt, inherit_input_method, seconds)
+ Lisp_Object prompt, inherit_input_method, seconds;
{
if (! NILP (prompt))
message_with_string ("%s", prompt, 0);
- return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method));
+ return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
}
DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
()
{
register Lisp_Object val;
+ BLOCK_INPUT;
XSETINT (val, getc (instream));
+ UNBLOCK_INPUT;
return val;
}
\f
-/* Value is non-zero if the file asswociated with file descriptor FD
+/* Value is non-zero if the file associated with file descriptor FD
is a compiled Lisp file that's safe to load. Only files compiled
with Emacs are safe to load. Files compiled with XEmacs can lead
to a crash in Fbyte_code because of an incompatible change in the
return Qnil;
}
+static Lisp_Object
+load_warn_old_style_backquotes (file)
+ Lisp_Object file;
+{
+ if (!NILP (Vold_style_backquotes))
+ {
+ Lisp_Object args[2];
+ args[0] = build_string ("!! File %s uses old-style backquotes !!");
+ args[1] = file;
+ Fmessage (2, args);
+ }
+ 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;
- Lisp_Object found, efound;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+ Lisp_Object found, efound, hist_file_name;
/* 1 means we printed the ".el is newer" message. */
int newer = 0;
/* 1 means we are loading a compiled file. */
Lisp_Object handler;
int safe_p = 1;
char *fmode = "r";
+ Lisp_Object tmp[2];
#ifdef DOS_NT
fmode = "rt";
#endif /* DOS_NT */
the need to gcpro noerror, nomessage and nosuffix.
(Below here, we care only whether they are nil or not.)
The presence of this call is the result of a historical accident:
- it used to be in every file-operations and when it got removed
+ it used to be in every file-operation and when it got removed
everywhere, it accidentally stayed here. Since then, enough people
supposedly have things like (load "$PROJECT/foo.el") in their .emacs
that it seemed risky to remove. */
if (SCHARS (file) > 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 (fd == -1)
{
if (NILP (noerror))
- Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
- Fcons (file, Qnil)));
- else
- return Qnil;
+ xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
+ return Qnil;
}
/* Tell startup.el whether or not we found the user's init file. */
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);
+ signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
+ }
record_unwind_protect (record_load_unwind, Vloads_in_progress);
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
+ /* Get the name for load-history. */
+ hist_file_name = (! NILP (Vpurify_flag)
+ ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
+ tmp[1] = Ffile_name_nondirectory (found),
+ tmp))
+ : found) ;
+
+ /* Check for the presence of old-style quotes and warn about them. */
+ specbind (Qold_style_backquotes, Qnil);
+ record_unwind_protect (load_warn_old_style_backquotes, file);
+
if (!bcmp (SDATA (found) + SBYTES (found) - 4,
".elc", 4))
/* Load .elc files directly, but not when they are
struct stat s1, s2;
int result;
+ GCPRO3 (file, found, hist_file_name);
+
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
if (fd >= 0)
emacs_close (fd);
- val = call4 (Vload_source_file_function, found, file,
+ val = call4 (Vload_source_file_function, found, hist_file_name,
NILP (noerror) ? Qnil : Qt,
NILP (nomessage) ? Qnil : Qt);
return unbind_to (count, val);
}
}
+ GCPRO3 (file, found, hist_file_name);
+
#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);
+ readevalloop (Qget_file_char, stream, hist_file_name,
+ Feval, 0, Qnil, Qnil, Qnil, Qnil);
unbind_to (count, Qnil);
- /* Run any load-hooks for this file. */
- temp = Fassoc (file, Vafter_load_alist);
- if (!NILP (temp))
- Fprogn (Fcdr (temp));
+ /* Run any eval-after-load forms for this file */
+ if (NILP (Vpurify_flag)
+ && (!NILP (Ffboundp (Qdo_after_load_evaluation))))
+ call1 (Qdo_after_load_evaluation, hist_file_name) ;
+
UNGCPRO;
if (saved_doc_string)
}
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)
+ {
+ BLOCK_INPUT;
+ fclose (stream);
+ UNBLOCK_INPUT;
+ }
if (--load_in_progress < 0) load_in_progress = 0;
return Qnil;
}
DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
doc: /* Search for FILENAME through PATH.
+Returns the file's name in absolute form, or nil if not found.
If SUFFIXES is non-nil, it should be a list of suffixes to append to
file name when searching.
If non-nil, PREDICATE is used instead of `file-readable-p'.
On success, returns a file descriptor. On failure, returns -1.
SUFFIXES is a list of strings containing possible suffixes.
- The empty suffix is automatically added iff the list is empty.
+ The empty suffix is automatically added if the list is empty.
PREDICATE non-nil means don't open the files,
just look for one that satisfies the predicate. In this case,
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);
}
static void
end_of_file_error ()
{
- Lisp_Object data;
-
if (STRINGP (Vload_file_name))
- data = Fcons (Vload_file_name, Qnil);
- else
- data = Qnil;
+ xsignal1 (Qend_of_file, Vload_file_name);
- Fsignal (Qend_of_file, data);
+ xsignal0 (Qend_of_file);
}
/* UNIBYTE specifies how to set load_convert_to_unibyte
for this invocation.
- READFUN, if non-nil, is used instead of `read'. */
+ READFUN, if non-nil, is used instead of `read'.
+
+ START, END specify region to read in current buffer (from eval-region).
+ If the input is not from a buffer, they must be nil. */
static void
-readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, readfun)
+readevalloop (readcharfun, stream, sourcename, evalfun,
+ printflag, unibyte, readfun, start, end)
Lisp_Object readcharfun;
FILE *stream;
Lisp_Object sourcename;
Lisp_Object (*evalfun) ();
int printflag;
Lisp_Object unibyte, readfun;
+ Lisp_Object start, end;
{
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 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);
+ /* We assume START is nil when input is not from a buffer. */
+ if (! NILP (start) && !b)
+ abort ();
+
+ 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);
+
+ /* Try to ensure sourcename is a truename, except whilst preloading. */
+ if (NILP (Vpurify_flag)
+ && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
+ && !NILP (Ffboundp (Qfile_truename)))
+ sourcename = call1 (Qfile_truename, sourcename) ;
LOADHIST_ATTACH (sourcename);
continue_reading_p = 1;
while (continue_reading_p)
{
+ int count1 = SPECPDL_INDEX ();
+
if (b != 0 && NILP (b->name))
error ("Reading from killed buffer");
+ 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);
+ 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 (c == ';')
{
while ((c = READCHAR) != '\n' && c != -1);
- continue;
+ goto read_next;
+ }
+ if (c < 0)
+ {
+ unbind_to (count1, Qnil);
+ break;
}
- if (c < 0) break;
/* Ignore whitespace here, so we can detect eof. */
if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
- continue;
+ goto read_next;
if (!NILP (Vpurify_flag) && c == '(')
{
- int count1 = SPECPDL_INDEX ();
record_unwind_protect (unreadpure, Qnil);
val = read_list (-1, readcharfun);
- unbind_to (count1, Qnil);
}
else
{
val = read_internal_start (readcharfun, Qnil, Qnil);
}
+ 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);
Programs can pass two arguments, BUFFER and PRINTFLAG.
BUFFER is the buffer to evaluate (nil means use current buffer).
PRINTFLAG controls printing of output:
-nil means discard it; anything else is stream for print.
+A value of nil means discard it; anything else is stream for print.
If the optional third argument FILENAME is non-nil,
it specifies the file name to use for `load-history'.
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)));
- readevalloop (buf, 0, filename, Feval, !NILP (printflag), unibyte, Qnil);
+ readevalloop (buf, 0, filename, Feval,
+ !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
unbind_to (count, Qnil);
return Qnil;
giving starting and ending indices in the current buffer
of the text to be executed.
Programs can pass third argument PRINTFLAG which controls output:
-nil means discard it; anything else is stream for printing it.
+A value of nil means discard it; anything else is stream for printing it.
Also the fourth argument READ-FUNCTION, if non-nil, is used
instead of `read' to read each expression. It gets one argument
which is the input stream for reading characters.
else
tem = printflag;
specbind (Qstandard_output, tem);
+ specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
- if (NILP (printflag))
- record_unwind_protect (save_excursion_restore, save_excursion_save ());
- record_unwind_protect (save_restriction_restore, save_restriction_save ());
-
- /* This both uses start and checks its type. */
- Fgoto_char (start);
- Fnarrow_to_region (make_number (BEGV), end);
+ /* readevalloop calls functions which check the type of start and end. */
readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
- !NILP (printflag), Qnil, read_function);
+ !NILP (printflag), Qnil, read_function,
+ start, end);
return unbind_to (count, Qnil);
}
return retval;
}
\f
+
+/* Signal Qinvalid_read_syntax error.
+ S is error string of length N (if > 0) */
+
+static void
+invalid_syntax (s, n)
+ const char *s;
+ int n;
+{
+ if (!n)
+ n = strlen (s);
+ xsignal1 (Qinvalid_read_syntax, make_string (s, n));
+}
+
+
/* Use this for recursive reads, in contexts where internal tokens
are not allowed. */
int c;
val = read1 (readcharfun, &c, 0);
- if (c)
- Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1),
- make_number (c)),
- Qnil));
+ if (!c)
+ return val;
- return val;
+ xsignal1 (Qinvalid_read_syntax,
+ Fmake_string (make_number (1), make_number (c)));
}
\f
static int read_buffer_size;
int *byterep;
{
register int c = READCHAR;
+ /* \u allows up to four hex digits, \U up to eight. Default to the
+ behaviour for \u, and change this value in the case that \U is seen. */
+ int unicode_hex_count = 4;
*byterep = 0;
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);
return i;
}
+ case 'U':
+ /* Post-Unicode-2.0: Up to eight hex chars. */
+ unicode_hex_count = 8;
+ case 'u':
+
+ /* A Unicode escape. We only permit them in strings and characters,
+ not arbitrarily in the source code, as in some other languages. */
+ {
+ int i = 0;
+ int count = 0;
+ Lisp_Object lisp_char;
+ struct gcpro gcpro1;
+
+ while (++count <= unicode_hex_count)
+ {
+ c = READCHAR;
+ /* isdigit and isalpha may be locale-specific, which we don't
+ want. */
+ if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
+ else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
+ else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
+ else
+ {
+ error ("Non-hex digit used for Unicode escape");
+ break;
+ }
+ }
+
+ GCPRO1 (readcharfun);
+ lisp_char = call2 (intern ("decode-char"), intern ("ucs"),
+ make_number (i));
+ UNGCPRO;
+
+ if (NILP (lisp_char))
+ {
+ error ("Unsupported Unicode code point: U+%x", (unsigned)i);
+ }
+
+ return XFASTINT (lisp_char);
+ }
+
default:
if (BASE_LEADING_CODE_P (c))
c = read_multibyte (c, readcharfun);
}
}
-
/* Read an integer in radix RADIX using READCHARFUN to read
characters. RADIX must be in the interval [2..36]; if it isn't, a
read error is signaled . Value is the integer read. Signals an
{
char buf[50];
sprintf (buf, "integer, radix %d", radix);
- Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil));
+ invalid_syntax (buf, 0);
}
return make_number (sign * number);
XCHAR_TABLE (tmp)->top = Qnil;
return tmp;
}
- Fsignal (Qinvalid_read_syntax,
- Fcons (make_string ("#^^", 3), Qnil));
+ invalid_syntax ("#^^", 3);
}
- Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil));
+ invalid_syntax ("#^", 2);
}
if (c == '&')
{
Accept such input in case it came from an old version. */
&& ! (XFASTINT (length)
== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
- Fsignal (Qinvalid_read_syntax,
- Fcons (make_string ("#&...", 5), Qnil));
+ invalid_syntax ("#&...", 5);
val = Fmake_bool_vector (length, Qnil);
bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
&= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
return val;
}
- Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5),
- Qnil));
+ invalid_syntax ("#&...", 5);
}
if (c == '[')
{
/* Read the string itself. */
tmp = read1 (readcharfun, &ch, 0);
if (ch != 0 || !STRINGP (tmp))
- Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
+ invalid_syntax ("#", 1);
GCPRO1 (tmp);
/* Read the intervals and their properties. */
while (1)
if (ch == 0)
plist = read1 (readcharfun, &ch, 0);
if (ch)
- Fsignal (Qinvalid_read_syntax,
- Fcons (build_string ("invalid string property list"),
- Qnil));
+ invalid_syntax ("Invalid string property list", 0);
Fset_text_properties (beg, end, plist, tmp);
}
UNGCPRO;
return read_integer (readcharfun, 2);
UNREAD (c);
- Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
+ invalid_syntax ("#", 1);
case ';':
while ((c = READCHAR) >= 0 && c != '\n');
case '`':
if (first_in_list)
- goto default_label;
+ {
+ Vold_style_backquotes = Qt;
+ goto default_label;
+ }
else
{
Lisp_Object value;
return Fcons (comma_type, Fcons (value, Qnil));
}
else
- goto default_label;
+ {
+ Vold_style_backquotes = Qt;
+ goto default_label;
+ }
case '?':
{
|| (new_backquote_flag && next_char == ','))));
}
UNREAD (next_char);
- if (!ok)
- Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil));
+ if (ok)
+ return make_number (c);
- return make_number (c);
+ invalid_syntax ("?", 1);
}
case '"':
break;
case 'N':
value = zero / zero;
+
+ /* If that made a "negative" NaN, negate it. */
+
+ {
+ int i;
+ union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
+
+ u_data.d = value;
+ u_minus_zero.d = - 0.0;
+ for (i = 0; i < sizeof (double); i++)
+ if (u_data.c[i] & u_minus_zero.c[i])
+ {
+ value = - value;
+ break;
+ }
+ }
+ /* Now VALUE is a positive NaN. */
break;
default:
value = atof (read_buffer + negative);
if (i == COMPILED_BYTECODE)
{
if (!STRINGP (item))
- error ("invalid byte code");
+ error ("Invalid byte code");
/* Delay handling the bytecode slot until we know whether
it is lazily-loaded (we can tell by whether the
item = Fread (bytestr);
if (!CONSP (item))
- error ("invalid byte code");
+ error ("Invalid byte code");
otem = XCONS (item);
bytestr = XCAR (item);
{
if (ch == ']')
return val;
- Fsignal (Qinvalid_read_syntax,
- Fcons (make_string (") or . in a vector", 18), Qnil));
+ invalid_syntax (") or . in a vector", 18);
}
if (ch == ')')
return val;
return val;
}
- return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
+ invalid_syntax (". in wrong context", 18);
}
- return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
+ invalid_syntax ("] in a list", 11);
}
tem = (read_pure && flag <= 0
? pure_cons (elt, Qnil)
check_obarray (obarray)
Lisp_Object obarray;
{
- while (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
+ if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
{
/* If Vobarray is now invalid, force it to be valid. */
if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
-
- obarray = wrong_type_argument (Qvectorp, obarray);
+ wrong_type_argument (Qvectorp, obarray);
}
return obarray;
}
Vload_path = Fcons (tem, Vload_path);
}
- /* Add site-list under the installation dir, if it exists. */
+ /* Add site-lisp under the installation dir, if it exists. */
tem = Fexpand_file_name (build_string ("site-lisp"),
Vinstallation_directory);
tem1 = Ffile_exists_p (tem);
/* NORMAL refers to the lisp dir in the source directory. */
/* We used to add ../lisp at the front here, but
that caused trouble because it was copied from dump_path
- into Vload_path, aboe, when Vinstallation_directory was non-nil.
+ into Vload_path, above, when Vinstallation_directory was non-nil.
It should be unnecessary. */
Vload_path = decode_env_path (0, normal);
dump_path = Vload_path;
}
/* Print a warning, using format string FORMAT, that directory DIRNAME
- does not exist. Print it on stderr and put it in *Message*. */
+ does not exist. Print it on stderr and put it in *Messages*. */
void
dir_warning (format, dirname)
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'. */);
+ doc: /* Non-nil if inside of `load'. */);
DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
doc: /* An alist of expressions to be evalled when particular files are loaded.
-Each element looks like (FILENAME FORMS...).
-When `load' is run and the file-name argument is FILENAME,
-the FORMS in the corresponding element are executed at the end of loading.
-
-FILENAME must match exactly! Normally FILENAME is the name of a library,
-with no directory specified, since that is how `load' is normally called.
-An error in FORMS does not undo the load,
-but does prevent execution of the rest of the FORMS.
-FILENAME can also be a symbol (a feature) and FORMS are then executed
-when the corresponding call to `provide' is made. */);
+Each element looks like (REGEXP-OR-FEATURE FORMS...).
+
+REGEXP-OR-FEATURE is either a regular expression to match file names, or
+a symbol \(a feature name).
+
+When `load' is run and the file-name argument matches an element's
+REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
+REGEXP-OR-FEATURE, the FORMS in the element are executed.
+
+An error in FORMS does not undo the load, but does prevent execution of
+the rest of the FORMS. */);
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.
-The remaining elements of each list are symbols defined as functions,
+
+The file name is absolute and is the true file name (i.e. it doesn't
+contain symbolic links) of the loaded file.
+
+The remaining elements of each list are symbols defined as variables
and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)',
-`(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'.
-An element `(t . SYMBOL)' precedes an entry that is just SYMBOL,
-and means that SYMBOL was an autoload before this file redefined it
-as a function. */);
+`(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . 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.
+
+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,
DEFVAR_LISP ("user-init-file", &Vuser_init_file,
doc: /* File name, including directory, of user's initialization file.
-If the file loaded had extension `.elc' and there was a corresponding `.el'
-file, this variable contains the name of the .el file, suitable for use
-by functions like `custom-save-all' which edit the init file. */);
+If the file loaded had extension `.elc', and the corresponding source file
+exists, this variable contains the name of source file, suitable for use
+by functions like `custom-save-all' which edit the init file.
+While Emacs loads and evaluates the init file, value is the real name
+of the file, regardless of whether or not it has the `.elc' extension. */);
Vuser_init_file = Qnil;
DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
Vload_read_function = Qnil;
DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
- doc: /* Function called in `load' for loading an Emacs lisp source file.
+ doc: /* Function called in `load' for loading an Emacs Lisp source file.
This function is for doing code conversion before reading the source file.
If nil, loading is done without any code conversion.
Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
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;
+
+ DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes,
+ doc: /* Set to non-nil when `read' encounters an old-style backquote. */);
+ Vold_style_backquotes = Qnil;
+ Qold_style_backquotes = intern ("old-style-backquotes");
+ staticpro (&Qold_style_backquotes);
+
/* 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);
+
+ Qfile_truename = intern ("file-truename");
+ staticpro (&Qfile_truename) ;
+
+ Qdo_after_load_evaluation = intern ("do-after-load-evaluation");
+ staticpro (&Qdo_after_load_evaluation) ;
+
staticpro (&dump_path);
staticpro (&read_objects);
read_objects = Qnil;
staticpro (&seen_list);
+ seen_list = Qnil;
Vloads_in_progress = Qnil;
staticpro (&Vloads_in_progress);
HCoop / bpt / emacs.git / blobdiff