aboutsummaryrefslogtreecommitdiffstats
path: root/src/lread.c
diff options
context:
space:
mode:
authorKaroly Lorentey2006-07-29 09:59:12 +0000
committerKaroly Lorentey2006-07-29 09:59:12 +0000
commit251bc578cc636223d618d06cf2a2bb7d07db9cce (patch)
tree58e1c6b0a35bb4a77e6cb77876e4bc6a9d3f2ab2 /src/lread.c
parent99715bbc447eb633e45ffa23b87284771ce3ac74 (diff)
parent0ed0527cb02180a50f6744086ce3a487740c73e4 (diff)
downloademacs-251bc578cc636223d618d06cf2a2bb7d07db9cce.tar.gz
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,
216static Lisp_Object load_unwind P_ ((Lisp_Object)); 216static Lisp_Object load_unwind P_ ((Lisp_Object));
217static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); 217static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
218 218
219static void invalid_syntax P_ ((const char *, int)) NO_RETURN;
220static void end_of_file_error P_ (()) NO_RETURN;
221
219 222
220/* Handle unreading and rereading of characters. 223/* Handle unreading and rereading of characters.
221 Write READCHAR to read a character, 224 Write READCHAR to read a character,
@@ -436,8 +439,6 @@ static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
436 439
437/* Get a character from the tty. */ 440/* Get a character from the tty. */
438 441
439extern Lisp_Object read_char P_ ((int, int, Lisp_Object *, Lisp_Object, int *));
440
441/* Read input events until we get one that's acceptable for our purposes. 442/* Read input events until we get one that's acceptable for our purposes.
442 443
443 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed 444 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 *));
454 character. 455 character.
455 456
456 If INPUT_METHOD is nonzero, we invoke the current input method 457 If INPUT_METHOD is nonzero, we invoke the current input method
457 if the character warrants that. */ 458 if the character warrants that.
459
460 If SECONDS is a number, we wait that many seconds for input, and
461 return Qnil if no input arrives within that time. */
458 462
459Lisp_Object 463Lisp_Object
460read_filtered_event (no_switch_frame, ascii_required, error_nonascii, 464read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
461 input_method) 465 input_method, seconds)
462 int no_switch_frame, ascii_required, error_nonascii, input_method; 466 int no_switch_frame, ascii_required, error_nonascii, input_method;
467 Lisp_Object seconds;
463{ 468{
464 Lisp_Object val, delayed_switch_frame; 469 Lisp_Object val, delayed_switch_frame;
470 EMACS_TIME end_time;
465 471
466#ifdef HAVE_WINDOW_SYSTEM 472#ifdef HAVE_WINDOW_SYSTEM
467 if (display_hourglass_p) 473 if (display_hourglass_p)
@@ -470,10 +476,25 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
470 476
471 delayed_switch_frame = Qnil; 477 delayed_switch_frame = Qnil;
472 478
473 /* Read until we get an acceptable event. */ 479 /* Compute timeout. */
480 if (NUMBERP (seconds))
481 {
482 EMACS_TIME wait_time;
483 int sec, usec;
484 double duration = extract_float (seconds);
485
486 sec = (int) duration;
487 usec = (duration - sec) * 1000000;
488 EMACS_GET_TIME (end_time);
489 EMACS_SET_SECS_USECS (wait_time, sec, usec);
490 EMACS_ADD_TIME (end_time, end_time, wait_time);
491 }
492
493/* Read until we get an acceptable event. */
474 retry: 494 retry:
475 do 495 do
476 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0); 496 val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
497 NUMBERP (seconds) ? &end_time : NULL);
477 while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */ 498 while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
478 499
479 if (BUFFERP (val)) 500 if (BUFFERP (val))
@@ -492,7 +513,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
492 goto retry; 513 goto retry;
493 } 514 }
494 515
495 if (ascii_required) 516 if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
496 { 517 {
497 /* Convert certain symbols to their ASCII equivalents. */ 518 /* Convert certain symbols to their ASCII equivalents. */
498 if (SYMBOLP (val)) 519 if (SYMBOLP (val))
@@ -537,7 +558,7 @@ read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
537 return val; 558 return val;
538} 559}
539 560
540DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0, 561DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
541 doc: /* Read a character from the command input (keyboard or macro). 562 doc: /* Read a character from the command input (keyboard or macro).
542It is returned as a number. 563It is returned as a number.
543If the user generates an event which is not a character (i.e. a mouse 564If 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
550If the optional argument PROMPT is non-nil, display that as a prompt. 571If the optional argument PROMPT is non-nil, display that as a prompt.
551If the optional argument INHERIT-INPUT-METHOD is non-nil and some 572If the optional argument INHERIT-INPUT-METHOD is non-nil and some
552input method is turned on in the current buffer, that input method 573input method is turned on in the current buffer, that input method
553is used for reading a character. */) 574is used for reading a character.
554 (prompt, inherit_input_method) 575If the optional argument SECONDS is non-nil, it should be a number
555 Lisp_Object prompt, inherit_input_method; 576specifying the maximum number of seconds to wait for input. If no
577input arrives in that time, return nil. SECONDS may be a
578floating-point value. */)
579 (prompt, inherit_input_method, seconds)
580 Lisp_Object prompt, inherit_input_method, seconds;
556{ 581{
557 if (! NILP (prompt)) 582 if (! NILP (prompt))
558 message_with_string ("%s", prompt, 0); 583 message_with_string ("%s", prompt, 0);
559 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method)); 584 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
560} 585}
561 586
562DEFUN ("read-event", Fread_event, Sread_event, 0, 2, 0, 587DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
563 doc: /* Read an event object from the input stream. 588 doc: /* Read an event object from the input stream.
564If the optional argument PROMPT is non-nil, display that as a prompt. 589If the optional argument PROMPT is non-nil, display that as a prompt.
565If the optional argument INHERIT-INPUT-METHOD is non-nil and some 590If the optional argument INHERIT-INPUT-METHOD is non-nil and some
566input method is turned on in the current buffer, that input method 591input method is turned on in the current buffer, that input method
567is used for reading a character. */) 592is used for reading a character.
568 (prompt, inherit_input_method) 593If the optional argument SECONDS is non-nil, it should be a number
569 Lisp_Object prompt, inherit_input_method; 594specifying the maximum number of seconds to wait for input. If no
595input arrives in that time, return nil. SECONDS may be a
596floating-point value. */)
597 (prompt, inherit_input_method, seconds)
598 Lisp_Object prompt, inherit_input_method, seconds;
570{ 599{
571 if (! NILP (prompt)) 600 if (! NILP (prompt))
572 message_with_string ("%s", prompt, 0); 601 message_with_string ("%s", prompt, 0);
573 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method)); 602 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
574} 603}
575 604
576DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 2, 0, 605DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
577 doc: /* Read a character from the command input (keyboard or macro). 606 doc: /* Read a character from the command input (keyboard or macro).
578It is returned as a number. Non-character events are ignored. 607It is returned as a number. Non-character events are ignored.
579 608
580If the optional argument PROMPT is non-nil, display that as a prompt. 609If the optional argument PROMPT is non-nil, display that as a prompt.
581If the optional argument INHERIT-INPUT-METHOD is non-nil and some 610If the optional argument INHERIT-INPUT-METHOD is non-nil and some
582input method is turned on in the current buffer, that input method 611input method is turned on in the current buffer, that input method
583is used for reading a character. */) 612is used for reading a character.
584 (prompt, inherit_input_method) 613If the optional argument SECONDS is non-nil, it should be a number
585 Lisp_Object prompt, inherit_input_method; 614specifying the maximum number of seconds to wait for input. If no
615input arrives in that time, return nil. SECONDS may be a
616floating-point value. */)
617 (prompt, inherit_input_method, seconds)
618 Lisp_Object prompt, inherit_input_method, seconds;
586{ 619{
587 if (! NILP (prompt)) 620 if (! NILP (prompt))
588 message_with_string ("%s", prompt, 0); 621 message_with_string ("%s", prompt, 0);
589 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method)); 622 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
590} 623}
591 624
592DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, 625DEFUN ("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. */)
799 if (fd == -1) 832 if (fd == -1)
800 { 833 {
801 if (NILP (noerror)) 834 if (NILP (noerror))
802 Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"), 835 xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
803 Fcons (file, Qnil))); 836 return Qnil;
804 else
805 return Qnil;
806 } 837 }
807 838
808 /* Tell startup.el whether or not we found the user's init file. */ 839 /* 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. */)
843 { 874 {
844 if (fd >= 0) 875 if (fd >= 0)
845 emacs_close (fd); 876 emacs_close (fd);
846 Fsignal (Qerror, Fcons (build_string ("Recursive load"), 877 signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
847 Fcons (found, Vloads_in_progress)));
848 } 878 }
849 record_unwind_protect (record_load_unwind, Vloads_in_progress); 879 record_unwind_protect (record_load_unwind, Vloads_in_progress);
850 Vloads_in_progress = Fcons (found, Vloads_in_progress); 880 Vloads_in_progress = Fcons (found, Vloads_in_progress);
@@ -1341,11 +1371,9 @@ end_of_file_error ()
1341 Lisp_Object data; 1371 Lisp_Object data;
1342 1372
1343 if (STRINGP (Vload_file_name)) 1373 if (STRINGP (Vload_file_name))
1344 data = Fcons (Vload_file_name, Qnil); 1374 xsignal1 (Qend_of_file, Vload_file_name);
1345 else
1346 data = Qnil;
1347 1375
1348 Fsignal (Qend_of_file, data); 1376 xsignal0 (Qend_of_file);
1349} 1377}
1350 1378
1351/* UNIBYTE specifies how to set load_convert_to_unibyte 1379/* UNIBYTE specifies how to set load_convert_to_unibyte
@@ -1696,6 +1724,21 @@ read_internal_start (stream, start, end)
1696 return retval; 1724 return retval;
1697} 1725}
1698 1726
1727
1728/* Signal Qinvalid_read_syntax error.
1729 S is error string of length N (if > 0) */
1730
1731static void
1732invalid_syntax (s, n)
1733 const char *s;
1734 int n;
1735{
1736 if (!n)
1737 n = strlen (s);
1738 xsignal1 (Qinvalid_read_syntax, make_string (s, n));
1739}
1740
1741
1699/* Use this for recursive reads, in contexts where internal tokens 1742/* Use this for recursive reads, in contexts where internal tokens
1700 are not allowed. */ 1743 are not allowed. */
1701 1744
@@ -1707,12 +1750,11 @@ read0 (readcharfun)
1707 int c; 1750 int c;
1708 1751
1709 val = read1 (readcharfun, &c, 0); 1752 val = read1 (readcharfun, &c, 0);
1710 if (c) 1753 if (!c)
1711 Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1), 1754 return val;
1712 make_number (c)),
1713 Qnil));
1714 1755
1715 return val; 1756 xsignal1 (Qinvalid_read_syntax,
1757 Fmake_string (make_number (1), make_number (c)));
1716} 1758}
1717 1759
1718static int read_buffer_size; 1760static int read_buffer_size;
@@ -1980,7 +2022,6 @@ read_escape (readcharfun, stringp, byterep)
1980 } 2022 }
1981} 2023}
1982 2024
1983
1984/* Read an integer in radix RADIX using READCHARFUN to read 2025/* Read an integer in radix RADIX using READCHARFUN to read
1985 characters. RADIX must be in the interval [2..36]; if it isn't, a 2026 characters. RADIX must be in the interval [2..36]; if it isn't, a
1986 read error is signaled . Value is the integer read. Signals an 2027 read error is signaled . Value is the integer read. Signals an
@@ -2040,7 +2081,7 @@ read_integer (readcharfun, radix)
2040 { 2081 {
2041 char buf[50]; 2082 char buf[50];
2042 sprintf (buf, "integer, radix %d", radix); 2083 sprintf (buf, "integer, radix %d", radix);
2043 Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil)); 2084 invalid_syntax (buf, 0);
2044 } 2085 }
2045 2086
2046 return make_number (sign * number); 2087 return make_number (sign * number);
@@ -2151,10 +2192,9 @@ read1 (readcharfun, pch, first_in_list)
2151 XCHAR_TABLE (tmp)->top = Qnil; 2192 XCHAR_TABLE (tmp)->top = Qnil;
2152 return tmp; 2193 return tmp;
2153 } 2194 }
2154 Fsignal (Qinvalid_read_syntax, 2195 invalid_syntax ("#^^", 3);
2155 Fcons (make_string ("#^^", 3), Qnil));
2156 } 2196 }
2157 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil)); 2197 invalid_syntax ("#^", 2);
2158 } 2198 }
2159 if (c == '&') 2199 if (c == '&')
2160 { 2200 {
@@ -2176,8 +2216,7 @@ read1 (readcharfun, pch, first_in_list)
2176 Accept such input in case it came from an old version. */ 2216 Accept such input in case it came from an old version. */
2177 && ! (XFASTINT (length) 2217 && ! (XFASTINT (length)
2178 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) 2218 == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
2179 Fsignal (Qinvalid_read_syntax, 2219 invalid_syntax ("#&...", 5);
2180 Fcons (make_string ("#&...", 5), Qnil));
2181 2220
2182 val = Fmake_bool_vector (length, Qnil); 2221 val = Fmake_bool_vector (length, Qnil);
2183 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, 2222 bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
@@ -2188,8 +2227,7 @@ read1 (readcharfun, pch, first_in_list)
2188 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; 2227 &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2189 return val; 2228 return val;
2190 } 2229 }
2191 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), 2230 invalid_syntax ("#&...", 5);
2192 Qnil));
2193 } 2231 }
2194 if (c == '[') 2232 if (c == '[')
2195 { 2233 {
@@ -2209,7 +2247,7 @@ read1 (readcharfun, pch, first_in_list)
2209 /* Read the string itself. */ 2247 /* Read the string itself. */
2210 tmp = read1 (readcharfun, &ch, 0); 2248 tmp = read1 (readcharfun, &ch, 0);
2211 if (ch != 0 || !STRINGP (tmp)) 2249 if (ch != 0 || !STRINGP (tmp))
2212 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); 2250 invalid_syntax ("#", 1);
2213 GCPRO1 (tmp); 2251 GCPRO1 (tmp);
2214 /* Read the intervals and their properties. */ 2252 /* Read the intervals and their properties. */
2215 while (1) 2253 while (1)
@@ -2225,9 +2263,7 @@ read1 (readcharfun, pch, first_in_list)
2225 if (ch == 0) 2263 if (ch == 0)
2226 plist = read1 (readcharfun, &ch, 0); 2264 plist = read1 (readcharfun, &ch, 0);
2227 if (ch) 2265 if (ch)
2228 Fsignal (Qinvalid_read_syntax, 2266 invalid_syntax ("Invalid string property list", 0);
2229 Fcons (build_string ("invalid string property list"),
2230 Qnil));
2231 Fset_text_properties (beg, end, plist, tmp); 2267 Fset_text_properties (beg, end, plist, tmp);
2232 } 2268 }
2233 UNGCPRO; 2269 UNGCPRO;
@@ -2380,7 +2416,7 @@ read1 (readcharfun, pch, first_in_list)
2380 return read_integer (readcharfun, 2); 2416 return read_integer (readcharfun, 2);
2381 2417
2382 UNREAD (c); 2418 UNREAD (c);
2383 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil)); 2419 invalid_syntax ("#", 1);
2384 2420
2385 case ';': 2421 case ';':
2386 while ((c = READCHAR) >= 0 && c != '\n'); 2422 while ((c = READCHAR) >= 0 && c != '\n');
@@ -2474,10 +2510,10 @@ read1 (readcharfun, pch, first_in_list)
2474 || (new_backquote_flag && next_char == ',')))); 2510 || (new_backquote_flag && next_char == ','))));
2475 } 2511 }
2476 UNREAD (next_char); 2512 UNREAD (next_char);
2477 if (!ok) 2513 if (ok)
2478 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil)); 2514 return make_number (c);
2479 2515
2480 return make_number (c); 2516 invalid_syntax ("?", 1);
2481 } 2517 }
2482 2518
2483 case '"': 2519 case '"':
@@ -3122,8 +3158,7 @@ read_list (flag, readcharfun)
3122 { 3158 {
3123 if (ch == ']') 3159 if (ch == ']')
3124 return val; 3160 return val;
3125 Fsignal (Qinvalid_read_syntax, 3161 invalid_syntax (") or . in a vector", 18);
3126 Fcons (make_string (") or . in a vector", 18), Qnil));
3127 } 3162 }
3128 if (ch == ')') 3163 if (ch == ')')
3129 return val; 3164 return val;
@@ -3216,9 +3251,9 @@ read_list (flag, readcharfun)
3216 3251
3217 return val; 3252 return val;
3218 } 3253 }
3219 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil)); 3254 invalid_syntax (". in wrong context", 18);
3220 } 3255 }
3221 return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil)); 3256 invalid_syntax ("] in a list", 11);
3222 } 3257 }
3223 tem = (read_pure && flag <= 0 3258 tem = (read_pure && flag <= 0
3224 ? pure_cons (elt, Qnil) 3259 ? pure_cons (elt, Qnil)