]> code.delx.au - gnu-emacs/blobdiff - src/keyboard.c
* keyboard.c (read_char): New arg END_TIME specifying timeout.
[gnu-emacs] / src / keyboard.c
index 30b06ef38fcc9e0b2ad878418eaa0415ee42007d..23e10aefac1f5c2b0e259490ee57dbba615e523b 100644 (file)
@@ -242,6 +242,9 @@ static int inhibit_local_menu_bar_menus;
 /* Nonzero means C-g should cause immediate error-signal.  */
 int immediate_quit;
 
+/* The user's hook function for outputting an error message.  */
+Lisp_Object Vcommand_error_function;
+
 /* The user's ERASE setting.  */
 Lisp_Object Vtty_erase_char;
 
@@ -1003,7 +1006,7 @@ recursive_edit_1 ()
   /* Handle throw from read_minibuf when using minibuffer
      while it's active but we're in another window.  */
   if (STRINGP (val))
-    Fsignal (Qerror, Fcons (val, Qnil));
+    xsignal1 (Qerror, val);
 
   return unbind_to (count, Qnil);
 }
@@ -1230,52 +1233,47 @@ cmd_error_internal (data, context)
      Lisp_Object data;
      char *context;
 {
-  Lisp_Object stream;
-  int kill_emacs_p = 0;
   struct frame *sf = SELECTED_FRAME ();
 
+  /* The immediate context is not interesting for Quits,
+     since they are asyncronous.  */
+  if (EQ (XCAR (data), Qquit))
+    Vsignaling_function = Qnil;
+
   Vquit_flag = Qnil;
   Vinhibit_quit = Qt;
-  clear_message (1, 0);
 
+  /* Use user's specified output function if any.  */
+  if (!NILP (Vcommand_error_function))
+    call3 (Vcommand_error_function, data,
+          build_string (context ? context : ""),
+          Vsignaling_function);
   /* If the window system or terminal frame hasn't been initialized
-     yet, or we're not interactive, it's best to dump this message out
-     to stderr and exit.  */
-  if (!sf->glyphs_initialized_p
-      /* This is the case of the frame dumped with Emacs, when we're
-        running under a window system.  */
-      || (!NILP (Vwindow_system)
-         && !inhibit_window_system
-         && FRAME_TERMCAP_P (sf))
-      || noninteractive)
-    {
-      stream = Qexternal_debugging_output;
-      kill_emacs_p = 1;
+     yet, or we're not interactive, write the message to stderr and exit.  */
+  else if (!sf->glyphs_initialized_p
+          /* This is the case of the frame dumped with Emacs, when we're
+             running under a window system.  */
+          || (!NILP (Vwindow_system)
+              && !inhibit_window_system
+              && FRAME_TERMCAP_P (sf))
+          || noninteractive)
+    {
+      print_error_message (data, Qexternal_debugging_output,
+                          context, Vsignaling_function);
+      Fterpri (Qexternal_debugging_output);
+      Fkill_emacs (make_number (-1));
     }
   else
     {
+      clear_message (1, 0);
       Fdiscard_input ();
       message_log_maybe_newline ();
       bitch_at_user ();
-      stream = Qt;
-    }
 
-  /* The immediate context is not interesting for Quits,
-     since they are asyncronous.  */
-  if (EQ (XCAR (data), Qquit))
-    Vsignaling_function = Qnil;
-
-  print_error_message (data, stream, context, Vsignaling_function);
+      print_error_message (data, Qt, context, Vsignaling_function);
+    }
 
   Vsignaling_function = Qnil;
-
-  /* If the window system or terminal frame hasn't been initialized
-     yet, or we're in -batch mode, this error should cause Emacs to exit.  */
-  if (kill_emacs_p)
-    {
-      Fterpri (stream);
-      Fkill_emacs (make_number (-1));
-    }
 }
 \f
 Lisp_Object command_loop_1 ();
@@ -1490,7 +1488,8 @@ command_loop_1 ()
          int count = SPECPDL_INDEX ();
          specbind (Qinhibit_quit, Qt);
 
-         Fsit_for (Vminibuffer_message_timeout, Qnil, Qnil);
+         sit_for (Vminibuffer_message_timeout, 0, 2);
+
          /* Clear the echo area.  */
          message2 (0, 0, 0);
          safe_run_hooks (Qecho_area_clear_hook);
@@ -2386,15 +2385,20 @@ do { if (polling_stopped_here) start_polling ();        \
    if we used a mouse menu to read the input, or zero otherwise.  If
    USED_MOUSE_MENU is null, we don't dereference it.
 
+   If END_TIME is non-null, it is a pointer to an EMACS_TIME
+   specifying the maximum time to wait until.  If no input arrives by
+   that time, stop waiting and return nil.
+
    Value is t if we showed a menu and the user rejected it.  */
 
 Lisp_Object
-read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
+read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu, end_time)
      int commandflag;
      int nmaps;
      Lisp_Object *maps;
      Lisp_Object prev_event;
      int *used_mouse_menu;
+     EMACS_TIME *end_time;
 {
   volatile Lisp_Object c;
   int count;
@@ -2674,6 +2678,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
      start echoing if enough time elapses.  */
 
   if (minibuf_level == 0
+      && !end_time
       && !current_kboard->immediate_echo
       && this_command_key_count > 0
       && ! noninteractive
@@ -2689,8 +2694,6 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
          /* Or not echoing before and echoing allowed.  */
          || (!echo_kboard && ok_to_echo_at_next_pause)))
     {
-      Lisp_Object tem0;
-
       /* After a mouse event, start echoing right away.
         This is because we are probably about to display a menu,
         and we don't want to delay before doing so.  */
@@ -2698,13 +2701,11 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
        echo_now ();
       else
        {
-         int sec, usec;
-         double duration = extract_float (Vecho_keystrokes);
-         sec = (int) duration;
-         usec = (duration - sec) * 1000000;
+         Lisp_Object tem0;
+
          save_getcjmp (save_jump);
          restore_getcjmp (local_getcjmp);
-         tem0 = sit_for (sec, usec, 1, 1, 0);
+         tem0 = sit_for (Vecho_keystrokes, 1, 1);
          restore_getcjmp (save_jump);
          if (EQ (tem0, Qt)
              && ! CONSP (Vunread_command_events))
@@ -2771,11 +2772,11 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
          && XINT (Vauto_save_timeout) > 0)
        {
          Lisp_Object tem0;
+         int timeout = delay_level * XFASTINT (Vauto_save_timeout) / 4;
 
          save_getcjmp (save_jump);
          restore_getcjmp (local_getcjmp);
-         tem0 = sit_for (delay_level * XFASTINT (Vauto_save_timeout) / 4,
-                         0, 1, 1, 0);
+         tem0 = sit_for (make_number (timeout), 1, 1);
          restore_getcjmp (save_jump);
 
          if (EQ (tem0, Qt)
@@ -2860,11 +2861,19 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
     {
       KBOARD *kb;
 
+      if (end_time)
+       {
+         EMACS_TIME now;
+         EMACS_GET_TIME (now);
+         if (EMACS_TIME_GE (now, *end_time))
+           goto exit;
+       }
+
       /* Actually read a character, waiting if necessary.  */
       save_getcjmp (save_jump);
       restore_getcjmp (local_getcjmp);
       timer_start_idle ();
-      c = kbd_buffer_get_event (&kb, used_mouse_menu);
+      c = kbd_buffer_get_event (&kb, used_mouse_menu, end_time);
       restore_getcjmp (save_jump);
 
 #ifdef MULTI_KBOARD
@@ -3201,7 +3210,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
 
       cancel_echoing ();
       do
-       c = read_char (0, 0, 0, Qnil, 0);
+       c = read_char (0, 0, 0, Qnil, 0, NULL);
       while (BUFFERP (c));
       /* Remove the help from the frame */
       unbind_to (count, Qnil);
@@ -3211,7 +3220,7 @@ read_char (commandflag, nmaps, maps, prev_event, used_mouse_menu)
        {
          cancel_echoing ();
          do
-           c = read_char (0, 0, 0, Qnil, 0);
+           c = read_char (0, 0, 0, Qnil, 0, NULL);
          while (BUFFERP (c));
        }
     }
@@ -3890,9 +3899,10 @@ clear_event (event)
    We always read and discard one event.  */
 
 static Lisp_Object
-kbd_buffer_get_event (kbp, used_mouse_menu)
+kbd_buffer_get_event (kbp, used_mouse_menu, end_time)
      KBOARD **kbp;
      int *used_mouse_menu;
+     EMACS_TIME *end_time;
 {
   register int c;
   Lisp_Object obj;
@@ -3936,13 +3946,24 @@ kbd_buffer_get_event (kbp, used_mouse_menu)
       if (!NILP (do_mouse_tracking) && some_mouse_moved ())
        break;
 #endif
-      {
+      if (end_time)
+       {
+         EMACS_TIME duration;
+         EMACS_GET_TIME (duration);
+         EMACS_SUB_TIME (duration, *end_time, duration);
+         if (EMACS_TIME_NEG_P (duration))
+           return Qnil;
+         else
+           wait_reading_process_output (EMACS_SECS (duration),
+                                        EMACS_USECS (duration), 
+                                        -1, 1, Qnil, NULL, 0);
+       }
+      else
        wait_reading_process_output (0, 0, -1, 1, Qnil, NULL, 0);
 
-       if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
-         /* Pass 1 for EXPECT since we just waited to have input.  */
-         read_avail_input (1);
-      }
+      if (!interrupt_input && kbd_fetch_ptr == kbd_store_ptr)
+       /* Pass 1 for EXPECT since we just waited to have input.  */
+       read_avail_input (1);
 #endif /* not VMS */
     }
 
@@ -8287,7 +8308,7 @@ read_char_minibuf_menu_prompt (commandflag, nmaps, maps)
       orig_defn_macro = current_kboard->defining_kbd_macro;
       current_kboard->defining_kbd_macro = Qnil;
       do
-       obj = read_char (commandflag, 0, 0, Qt, 0);
+       obj = read_char (commandflag, 0, 0, Qt, 0, NULL);
       while (BUFFERP (obj));
       current_kboard->defining_kbd_macro = orig_defn_macro;
 
@@ -8387,7 +8408,7 @@ access_keymap_keyremap (map, key, prompt, do_funcall)
   /* Handle a symbol whose function definition is a keymap
      or an array.  */
   if (SYMBOLP (next) && !NILP (Ffboundp (next))
-      && (!NILP (Farrayp (XSYMBOL (next)->function))
+      && (ARRAYP (XSYMBOL (next)->function)
          || KEYMAPP (XSYMBOL (next)->function)))
     next = XSYMBOL (next)->function;
 
@@ -8660,7 +8681,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
   /* Read the first char of the sequence specially, before setting
      up any keymaps, in case a filter runs and switches buffers on us.  */
   first_event = read_char (NILP (prompt), 0, submaps, last_nonmenu_event,
-                          &junk);
+                          &junk, NULL);
 #endif /* GOBBLE_FIRST_EVENT */
 
   orig_local_map = get_local_map (PT, current_buffer, Qlocal_map);
@@ -8863,7 +8884,7 @@ read_key_sequence (keybuf, bufsize, prompt, dont_downcase_last,
 #endif
            key = read_char (NILP (prompt), nmaps,
                             (Lisp_Object *) submaps, last_nonmenu_event,
-                            &used_mouse_menu);
+                            &used_mouse_menu, NULL);
          }
 
          /* read_char returns t when it shows a menu and the user rejects it.
@@ -9768,7 +9789,13 @@ a special event, so ignore the prefix argument and don't clear it.  */)
 \f
 DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_command,
        1, 1, "P",
-       doc: /* Read function name, then read its arguments and call it.  */)
+       doc: /* Read function name, then read its arguments and call it.
+
+To pass a numeric argument to the command you are invoking with, specify
+the numeric argument to this command.
+
+Noninteractively, the argument PREFIXARG is the prefix argument to
+give to the command you invoke, if it asks for an argument.  */)
      (prefixarg)
      Lisp_Object prefixarg;
 {
@@ -9874,19 +9901,18 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_
                                      Qmouse_movement)))
     {
       /* But first wait, and skip the message if there is input.  */
-      int delay_time;
-      if (!NILP (echo_area_buffer[0]))
-       /* This command displayed something in the echo area;
-          so wait a few seconds, then display our suggestion message.  */
-       delay_time = (NUMBERP (Vsuggest_key_bindings)
-                     ? XINT (Vsuggest_key_bindings) : 2);
+      Lisp_Object waited;
+
+      /* If this command displayed something in the echo area;
+        wait a few seconds, then display our suggestion message.  */
+      if (NILP (echo_area_buffer[0]))
+       waited = sit_for (make_number (0), 0, 2);
+      else if (NUMBERP (Vsuggest_key_bindings))
+       waited = sit_for (Vminibuffer_message_timeout, 0, 2);
       else
-       /* This command left the echo area empty,
-          so display our message immediately.  */
-       delay_time = 0;
+       waited = sit_for (make_number (2), 0, 2);
 
-      if (!NILP (Fsit_for (make_number (delay_time), Qnil, Qnil))
-         && ! CONSP (Vunread_command_events))
+      if (!NILP (waited) && ! CONSP (Vunread_command_events))
        {
          Lisp_Object binding;
          char *newmessage;
@@ -9906,10 +9932,12 @@ DEFUN ("execute-extended-command", Fexecute_extended_command, Sexecute_extended_
          message2_nolog (newmessage,
                          strlen (newmessage),
                          STRING_MULTIBYTE (binding));
-         if (!NILP (Fsit_for ((NUMBERP (Vsuggest_key_bindings)
-                               ? Vsuggest_key_bindings : make_number (2)),
-                              Qnil, Qnil))
-             && message_p)
+         if (NUMBERP (Vsuggest_key_bindings))
+           waited = sit_for (Vsuggest_key_bindings, 0, 2);
+         else
+           waited = sit_for (make_number (2), 0, 2);
+
+         if (!NILP (waited) && message_p)
            restore_message ();
 
          unbind_to (count, Qnil);
@@ -11480,6 +11508,15 @@ The value of that variable is passed to `quit-flag' and later causes a
 peculiar kind of quitting.  */);
   Vthrow_on_input = Qnil;
 
+  DEFVAR_LISP ("command-error-function", &Vcommand_error_function,
+              doc: /* If non-nil, function to output error messages.
+The arguments are the error data, a list of the form
+ (SIGNALED-CONDITIONS . SIGNAL-DATA)
+such as just as `condition-case' would bind its variable to,
+the context (a string which normally goes at the start of the message),
+and the Lisp function within which the error was signaled.  */);
+  Vcommand_error_function = Qnil;
+
   DEFVAR_LISP ("enable-disabled-menus-and-buttons",
               &Venable_disabled_menus_and_buttons,
               doc: /* If non-nil, don't ignore events produced by disabled menu items and tool-bar.