/* 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.
#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 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;
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,
\f
/* Get a character from the tty. */
-extern Lisp_Object read_char ();
-
/* Read input events until we get one that's acceptable for our purposes.
If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
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;
- /* Read until we get an acceptable event. */
+ /* 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);
+ do
+ val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
+ NUMBERP (seconds) ? &end_time : NULL);
+ while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
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,
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 int fd = -1;
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) ;
+
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);
record_unwind_protect (load_unwind, make_save_value (stream, 0));
record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
specbind (Qload_file_name, found);
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, 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)
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);
}
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'.
- START, END is region in current buffer (from eval-region). */
+
+ 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,
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);
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);
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'.
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.
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');
|| (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 '"':
{
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;
}
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'. */);
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 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)',
`(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,
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
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);