/* Lisp parsing and input streams.
Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
- 2005, 2006 Free Software Foundation, Inc.
+ 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,
#include "keyboard.h"
#include "termhooks.h"
#include "coding.h"
+#include "blockinput.h"
#ifdef lint
#include <sys/inode.h>
extern Lisp_Object Qevent_symbol_element_mask;
extern Lisp_Object Qfile_exists_p;
-/* non-zero iff inside `load' */
+/* non-zero if inside `load' */
int load_in_progress;
/* Directory in which the sources were found. */
/* 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 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.
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 in the exact order are
-determined by `load-suffixes'). Environment variable references in
+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'.
register FILE *stream;
register int fd = -1;
int count = SPECPDL_INDEX ();
- Lisp_Object temp;
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
/* 1 means we printed the ".el is newer" message. */
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 (fd >= 0)
emacs_close (fd);
- Fsignal (Qerror, Fcons (build_string ("Recursive load"),
- Fcons (found, Vloads_in_progress)));
+ 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);
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
{
FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
if (stream != NULL)
- fclose (stream);
+ {
+ BLOCK_INPUT;
+ fclose (stream);
+ UNBLOCK_INPUT;
+ }
if (--load_in_progress < 0) load_in_progress = 0;
return Qnil;
}
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,
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
int count = SPECPDL_INDEX ();
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;
if (MARKERP (readcharfun))
{
if (NILP (start))
- start = readcharfun;
+ start = readcharfun;
}
if (BUFFERP (readcharfun))
/* Try to ensure sourcename is a truename, except whilst preloading. */
if (NILP (Vpurify_flag)
- && !NILP (sourcename) && Ffile_name_absolute_p (sourcename)
- && (!NILP (Ffboundp (Qfile_truename))))
+ && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
+ && !NILP (Ffboundp (Qfile_truename)))
sourcename = call1 (Qfile_truename, sourcename) ;
LOADHIST_ATTACH (sourcename);
first_sexp = 0;
}
- build_load_history (sourcename,
+ build_load_history (sourcename,
stream || whole_buffer);
UNGCPRO;
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;
while (++count <= unicode_hex_count)
{
c = READCHAR;
- /* isdigit(), isalpha() may be locale-specific, which we don't
+ /* 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;
}
GCPRO1 (readcharfun);
- lisp_char = call2(intern("decode-char"), intern("ucs"),
- make_number(i));
+ lisp_char = call2 (intern ("decode-char"), intern ("ucs"),
+ make_number (i));
UNGCPRO;
- if (NILP(lisp_char))
+ if (NILP (lisp_char))
{
error ("Unsupported Unicode code point: U+%x", (unsigned)i);
}
}
}
-
/* 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 '"':
{
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)
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.
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.
+`(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. */);
doc: /* File name, including directory, of user's initialization 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. */);
+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
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;
HCoop / bpt / emacs.git / blobdiff