diff src/lread.c @ 83533:02e39decdc84

Merged from [e-mail] Patches applied: * [e-mail]/emacs--devo--0--patch-351 Update from CVS * [e-mail]/emacs--devo--0--patch-352 Update from CVS * [e-mail]/emacs--devo--0--patch-353 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-354 Update from CVS * [e-mail]/emacs--devo--0--patch-355 Update from CVS * [e-mail]/emacs--devo--0--patch-356 Update from CVS * [e-mail]/emacs--devo--0--patch-357 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-358 Update from CVS * [e-mail]/emacs--devo--0--patch-359 Update from CVS * [e-mail]/emacs--devo--0--patch-360 Update from CVS * [e-mail]/emacs--devo--0--patch-361 Update from CVS * [e-mail]/emacs--devo--0--patch-362 Update from CVS * [e-mail]/emacs--devo--0--patch-363 Update from CVS * [e-mail]/emacs--devo--0--patch-364 Update from CVS * [e-mail]/emacs--devo--0--patch-365 Update from CVS * [e-mail]/emacs--devo--0--patch-366 Update from CVS * [e-mail]/emacs--devo--0--patch-367 Merge from gnus--rel--5.10 * [e-mail]/emacs--devo--0--patch-368 Update from CVS * [e-mail]/emacs--devo--0--patch-369 Update from CVS * [e-mail]/emacs--devo--0--patch-370 Update from CVS * [e-mail]/gnus--rel--5.10--patch-115 Update from CVS * [e-mail]/gnus--rel--5.10--patch-116 Update from CVS * [e-mail]/gnus--rel--5.10--patch-117 Update from CVS * [e-mail]/gnus--rel--5.10--patch-118 Merge from emacs--devo--0 * [e-mail]/gnus--rel--5.10--patch-119 Update from CVS * [e-mail]/gnus--rel--5.10--patch-120 Update from CVS git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-573

--- a/src/lread.c	Fri Jul 14 05:56:32 2006 +0000
+++ b/src/lread.c	Sat Jul 29 09:59:12 2006 +0000
@@ -216,6 +216,9 @@
 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 @@
 
 /* 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 @@
    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 @@
 
   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 @@
       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 @@
   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 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 @@
   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 @@
       {
 	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 @@
   Lisp_Object data;
 
   if (STRINGP (Vload_file_name))
-    data = Fcons (Vload_file_name, Qnil);
-  else
-    data = Qnil;
-
-  Fsignal (Qend_of_file, data);
+    xsignal1 (Qend_of_file, Vload_file_name);
+
+  xsignal0 (Qend_of_file);
 }
 
 /* UNIBYTE specifies how to set load_convert_to_unibyte
@@ -1696,6 +1724,21 @@
   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 @@
   int c;
 
   val = read1 (readcharfun, &c, 0);
-  if (c)
-    Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1),
-							make_number (c)),
-					  Qnil));
-
-  return val;
+  if (!c)
+    return val;
+
+  xsignal1 (Qinvalid_read_syntax,
+	    Fmake_string (make_number (1), make_number (c)));
 }
 
 static int read_buffer_size;
@@ -1980,7 +2022,6 @@
     }
 }
 
-
 /* 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 @@
     {
       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 @@
 		  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 @@
 		     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 @@
 		  &= (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 @@
 	  /* 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 @@
 	      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 @@
 	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 @@
 			  || (new_backquote_flag && next_char == ','))));
 	  }
 	UNREAD (next_char);
-	if (!ok)
-	  Fsignal (Qinvalid_read_syntax, Fcons (make_string ("?", 1), Qnil));
-
-	return make_number (c);
+	if (ok)
+	  return make_number (c);
+
+	invalid_syntax ("?", 1);
       }
 
     case '"':
@@ -3122,8 +3158,7 @@
 	    {
 	      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 @@
 
 		  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)