diff options
author | Karoly Lorentey <lorentey@elte.hu> | 2006-07-29 09:59:12 +0000 |
---|---|---|
committer | Karoly Lorentey <lorentey@elte.hu> | 2006-07-29 09:59:12 +0000 |
commit | 251bc578cc636223d618d06cf2a2bb7d07db9cce (patch) | |
tree | 58e1c6b0a35bb4a77e6cb77876e4bc6a9d3f2ab2 /src/lread.c | |
parent | 99715bbc447eb633e45ffa23b87284771ce3ac74 (diff) | |
parent | 0ed0527cb02180a50f6744086ce3a487740c73e4 (diff) | |
download | emacs-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.c | 151 |
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) |