summaryrefslogtreecommitdiff
path: root/src/lread.c
diff options
context:
space:
mode:
authorKaroly Lorentey <lorentey@elte.hu>2006-07-29 09:59:12 +0000
committerKaroly Lorentey <lorentey@elte.hu>2006-07-29 09:59:12 +0000
commit251bc578cc636223d618d06cf2a2bb7d07db9cce (patch)
tree58e1c6b0a35bb4a77e6cb77876e4bc6a9d3f2ab2 /src/lread.c
parent99715bbc447eb633e45ffa23b87284771ce3ac74 (diff)
parent0ed0527cb02180a50f6744086ce3a487740c73e4 (diff)
downloademacs-251bc578cc636223d618d06cf2a2bb7d07db9cce.tar.gz
emacs-251bc578cc636223d618d06cf2a2bb7d07db9cce.tar.bz2
emacs-251bc578cc636223d618d06cf2a2bb7d07db9cce.zip
Merged from emacs@sv.gnu.org
Patches applied: * emacs@sv.gnu.org/emacs--devo--0--patch-351 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-352 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-353 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-354 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-355 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-356 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-357 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-358 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-359 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-360 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-361 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-362 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-363 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-364 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-365 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-366 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-367 Merge from gnus--rel--5.10 * emacs@sv.gnu.org/emacs--devo--0--patch-368 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-369 Update from CVS * emacs@sv.gnu.org/emacs--devo--0--patch-370 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-115 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-116 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-117 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-118 Merge from emacs--devo--0 * emacs@sv.gnu.org/gnus--rel--5.10--patch-119 Update from CVS * emacs@sv.gnu.org/gnus--rel--5.10--patch-120 Update from CVS git-archimport-id: lorentey@elte.hu--2004/emacs--multi-tty--0--patch-573
Diffstat (limited to 'src/lread.c')
-rw-r--r--src/lread.c151
1 files changed, 93 insertions, 58 deletions
diff --git a/src/lread.c b/src/lread.c
index 91825bce152..ef76e72f75f 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -216,6 +216,9 @@ static void readevalloop P_ ((Lisp_Object, FILE*, 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;
+
/* Handle unreading and rereading of characters.
Write READCHAR to read a character,
@@ -436,8 +439,6 @@ static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
/* Get a character from the tty. */
-extern Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, int *));
-
/* Read input events until we get one that's acceptable for our purposes.
If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
@@ -454,14 +455,19 @@ extern Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, int *));
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;
{
Lisp_Object val, delayed_switch_frame;
+ EMACS_TIME end_time;
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
@@ -470,10 +476,25 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
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:
do
- 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);
while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
if (BUFFERP (val))
@@ -492,7 +513,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
goto retry;
}
- if (ascii_required)
+ if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
{
/* Convert certain symbols to their ASCII equivalents. */
if (SYMBOLP (val))
@@ -537,7 +558,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
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
@@ -550,43 +571,55 @@ If you want to read non-character events, or ignore them, call
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,
@@ -799,10 +832,8 @@ Return t if the file exists and loads successfully. */)
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. */
@@ -843,8 +874,7 @@ Return t if the file exists and loads successfully. */)
{
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);
@@ -1341,11 +1371,9 @@ 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
@@ -1696,6 +1724,21 @@ read_internal_start (stream, start, end)
return retval;
}
+
+/* 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. */
@@ -1707,12 +1750,11 @@ read0 (readcharfun)
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)));
}
static int read_buffer_size;
@@ -1980,7 +2022,6 @@ read_escape (readcharfun, stringp, byterep)
}
}
-
/* 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
@@ -2040,7 +2081,7 @@ read_integer (readcharfun, radix)
{
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);
@@ -2151,10 +2192,9 @@ read1 (readcharfun, pch, first_in_list)
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 == '&')
{
@@ -2176,8 +2216,7 @@ read1 (readcharfun, pch, first_in_list)
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,
@@ -2188,8 +2227,7 @@ read1 (readcharfun, pch, first_in_list)
&= (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 == '[')
{
@@ -2209,7 +2247,7 @@ read1 (readcharfun, pch, first_in_list)
/* 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)
@@ -2225,9 +2263,7 @@ read1 (readcharfun, pch, first_in_list)
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;
@@ -2380,7 +2416,7 @@ read1 (readcharfun, pch, first_in_list)
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');
@@ -2474,10 +2510,10 @@ read1 (readcharfun, pch, first_in_list)
|| (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 '"':
@@ -3122,8 +3158,7 @@ read_list (flag, readcharfun)
{
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;
@@ -3216,9 +3251,9 @@ read_list (flag, readcharfun)
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)