diff src/event-stream.c @ 70:131b0175ea99 r20-0b30

Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 56c54cf7c5b6
children b9518feda344
line wrap: on
line diff
--- a/src/event-stream.c	Mon Aug 13 09:00:04 2007 +0200
+++ b/src/event-stream.c	Mon Aug 13 09:02:59 2007 +0200
@@ -56,6 +56,10 @@
 #include "syssignal.h"		/* SIGCHLD, etc. */
 #include "systime.h"		/* to set Vlast_input_time */
 
+#ifdef MULE
+#include "mule-coding.h"
+#endif
+
 #include <errno.h>
 
 /* The number of keystrokes between auto-saves. */
@@ -74,9 +78,6 @@
 /* Hook run when XEmacs is about to be idle. */
 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
 
-/* Control gratuitous keyboard focus throwing. */
-int focus_follows_mouse;
-
 #ifdef ILL_CONCEIVED_HOOK
 /* Hook run after a command if there's no more input soon.  */
 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
@@ -163,6 +164,11 @@
 Lisp_Object Vretry_undefined_key_binding_unshifted;
 Lisp_Object Qretry_undefined_key_binding_unshifted;
 
+#ifdef HAVE_XIM
+/* If composed input is undefined, use self-insert-char */
+Lisp_Object Vcomposed_character_default_binding;
+#endif /* HAVE_XIM */
+
 /* Console that corresponds to our controlling terminal */
 Lisp_Object Vcontrolling_terminal;
 
@@ -267,13 +273,6 @@
 
 int emacs_is_blocking;
 
-/* Handlers which run during sit-for, sleep-for and accept-process-output
-   are not allowed to recursively call these routines.  We record here
-   if we are in that situation. */
-
-static Lisp_Object recursive_sit_for;
-
-
 
 /**********************************************************************/
 /*                       Command-builder object                       */
@@ -762,7 +761,7 @@
 static void
 maybe_do_auto_save (void)
 {
-  /* This function can call lisp */
+  /* This function can GC */
   keystrokes_since_auto_save++;
   if (auto_save_interval > 0 &&
       keystrokes_since_auto_save > max (auto_save_interval, 20) &&
@@ -868,7 +867,7 @@
 T if command input is currently available with no waiting.
 Actually, the value is nil only if we can be sure that no input is available.
 */
-       ())
+  ())
 {
   return ((detect_input_pending ()) ? Qt : Qnil);
 }
@@ -1203,34 +1202,6 @@
     }
 }
 
-int
-event_stream_wakeup_pending_p (int id, int async_p)
-{
-  struct timeout *timeout;
-  Lisp_Object rest = Qnil;
-  Lisp_Object timeout_list;
-  int found = 0;
-
-
-  if (async_p)
-    timeout_list = pending_async_timeout_list;
-  else
-    timeout_list = pending_timeout_list;
-
-  /* Find the element on the list of pending ones, if it's still there. */
-  LIST_LOOP (rest, timeout_list)
-    {
-      timeout = (struct timeout *) XOPAQUE_DATA (XCAR (rest));
-      if (timeout->id == id)
-	{
-	  found = 1;
-	  break;
-	}
-    }
-
-  return found;
-}
-
 
 /**** Asynch. timeout functions (see also signal.c) ****/
 
@@ -1414,7 +1385,7 @@
 callback function as a way of resignalling a timeout, think again.  There
 is a race condition.  That's why the RESIGNAL argument exists.
 */
-       (secs, function, object, resignal))
+     (secs, function, object, resignal))
 {
   unsigned long msecs = lisp_number_to_milliseconds (secs, 0);
   unsigned long msecs2 = (NILP (resignal) ? 0 :
@@ -1667,7 +1638,6 @@
 	 in emacs_handle_focus_change_final() is based on the _FOR_HOOKS
 	 value, we need to do so too. */
       if (!NILP (sel_frame) &&
-	  !focus_follows_mouse &&
 	  !EQ (DEVICE_FRAME_THAT_OUGHT_TO_HAVE_FOCUS (d), sel_frame) &&
 	  !NILP (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d)) &&
 	  !EQ (DEVICE_FRAME_WITH_FOCUS_FOR_HOOKS (d), sel_frame))
@@ -1968,7 +1938,7 @@
 */
        (event, prompt))
 {
-  /* This function can call lisp */
+  /* This function can GC */
   /* #### We start out using the selected console before an event
      is received, for echoing the partially completed command.
      This is most definitely wrong -- there needs to be a separate
@@ -1978,28 +1948,11 @@
     XCOMMAND_BUILDER (con->command_builder);
   int store_this_key = 0;
   struct gcpro gcpro1;
-#ifdef LWLIB_MENUBARS_LUCID
-  extern int in_menu_callback;  /* defined in menubar-x.c */
-#endif /* LWLIB_MENUBARS_LUCID */
-
   GCPRO1 (event);
+
   /* DO NOT do QUIT anywhere within this function or the functions it calls.
      We want to read the ^G as an event. */
 
-#ifdef LWLIB_MENUBARS_LUCID
-  /*
-   * #### Fix the menu code so this isn't necessary.
-   *
-   * We cannot allow the lwmenu code to be reentered, because the
-   * code is not written to be reentrant and will crash.  Therefore
-   * paths from the menu callbacks back into the menu code have to
-   * be blocked.  Fnext_event is the normal path into the menu code,
-   * so we signal an error here.
-   */
-  if (in_menu_callback)
-    error ("Attempt to call next-event inside menu callback");
-#endif /* LWLIB_MENUBARS_LUCID */
-
   if (NILP (event))
     event = Fmake_event ();
   else
@@ -2371,30 +2324,6 @@
 /*                     pausing until an action occurs                 */
 /**********************************************************************/
 
-/* This is used in accept-process-output, sleep-for and sit-for.
-   Before running any process_events in these routines, we set
-   recursive_sit_for to Qt, and use this unwind protect to reset it to
-   Qnil upon exit.  When recursive_sit_for is Qt, calling sit-for will
-   cause it to return immediately.
-   
-   All of these routines install timeouts, so we clear the installed
-   timeout as well.
-
-   Note: It's very easy to break the desired behaviours of these
-   3 routines.  If you make any changes to anything in this area, run
-   the regression tests at the bottom of the file.  -- dmoore */
-   
-
-static Lisp_Object
-sit_for_unwind (Lisp_Object timeout_id)
-{
-  if (!NILP(timeout_id))
-    Fdisable_timeout (timeout_id);
-
-  recursive_sit_for = Qnil;
-  return Qnil;
-}
-
 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
  */
 
@@ -2402,8 +2331,7 @@
 Allow any pending output from subprocesses to be read by Emacs.
 It is read into the process' buffers or given to their filter functions.
 Non-nil arg PROCESS means do not return until some output has been received
- from PROCESS. Nil arg PROCESS means do not return until some output has
- been received from any process.
+ from PROCESS.
 If the second arg is non-nil, it is the maximum number of seconds to wait:
  this function will return after that much time even if no input has arrived
  from PROCESS.  This argument may be a float, meaning wait some fractional
@@ -2420,9 +2348,7 @@
   Lisp_Object result = Qnil;
   int timeout_id;
   int timeout_enabled = 0;
-  int done = 0;
   struct buffer *old_buffer = current_buffer;
-  int count;
 
   /* We preserve the current buffer but nothing else.  If a focus
      change alters the selected window then the top level event loop
@@ -2434,7 +2360,7 @@
 
   GCPRO2 (event, process);
 
-  if (!NILP (timeout_secs) || !NILP (timeout_msecs))
+  if (!NILP (process) && (!NILP (timeout_secs) || !NILP (timeout_msecs)))
     {
       unsigned long msecs = 0;
       if (!NILP (timeout_secs))
@@ -2453,15 +2379,7 @@
 
   event = Fmake_event ();
 
-  count = specpdl_depth ();
-  record_unwind_protect (sit_for_unwind,
-			 timeout_enabled ? make_int (timeout_id) : Qnil);
-  recursive_sit_for = Qt;
-
-  while (!done &&
-         ((NILP (process) && timeout_enabled) ||
-          (NILP (process) && event_stream_event_pending_p (0)) ||
-          (!NILP (process))))
+  while (!NILP (process)
 	 /* Calling detect_input_pending() is the wrong thing here, because
 	    that considers the Vunread_command_events and command_event_queue.
 	    We don't need to look at the command_event_queue because we are
@@ -2476,15 +2394,8 @@
 	    loop will process it, and I don't think that there is ever a
 	    time when one calls accept-process-output with a nil argument
 	    and really need the processes to be handled. */
+	 || (!EQ (result, Qt) && event_stream_event_pending_p (0)))
     {
-      /* If our timeout has arrived, we move along. */
-      if (timeout_enabled && !event_stream_wakeup_pending_p (timeout_id, 0))
-	{
-	  timeout_enabled = 0;
-          done = 1;             /* We're  done. */
-          continue;             /* Don't call next_event_internal */
-	}
-
       QUIT;	/* next_event_internal() does not QUIT, so check for ^G
 		   before reading output from the process - this makes it
 		   less likely that the filter will actually be aborted.
@@ -2499,10 +2410,9 @@
 	{
 	case process_event:
 	  {
-	    if (NILP (process) ||
-                EQ (XEVENT (event)->event.process.process, process))
+	    if (EQ (XEVENT (event)->event.process.process, process))
 	      {
-                done = 1;
+		process = Qnil;
 		/* RMS's version always returns nil when proc is nil,
 		   and only returns t if input ever arrived on proc. */
 		result = Qt;
@@ -2512,8 +2422,17 @@
 	    break;
 	  }
 	case timeout_event:
-	  /* We execute the event even if it's ours, and notice that it's
-	     happened above. */
+	  {
+	    if (timeout_enabled &&
+                XEVENT (event)->event.timeout.id_number == timeout_id)
+	      {
+                timeout_enabled = 0;
+		process = Qnil; /* we're done */
+	      }
+	    else	/* a timeout that's not the one we're waiting for */
+              goto EXECUTE_INTERNAL;
+	    break;
+	  }
 	case pointer_motion_event:
 	case magic_event:
           {
@@ -2529,7 +2448,9 @@
 	}
     }
 
-  unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
+  /* If our timeout has not been signalled yet, disable it. */
+  if (timeout_enabled)
+    event_stream_disable_wakeup (timeout_id, 0);
 
   Fdeallocate_event (event);
   UNGCPRO;
@@ -2540,9 +2461,6 @@
 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /*
 Pause, without updating display, for ARG seconds.
 ARG may be a float, meaning pause for some fractional part of a second.
-
-It is recommended that you never call sleep-for from inside of a process
- filter function or timer event (either synchronous or asynchronous).
 */
        (seconds))
 {
@@ -2550,24 +2468,14 @@
   unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
   int id;
   Lisp_Object event = Qnil;
-  int count;
   struct gcpro gcpro1;
 
   GCPRO1 (event);
 
   id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
   event = Fmake_event ();
-
-  count = specpdl_depth ();
-  record_unwind_protect (sit_for_unwind, make_int (id));
-  recursive_sit_for = Qt;
-
   while (1)
     {
-      /* If our timeout has arrived, we move along. */
-      if (!event_stream_wakeup_pending_p (id, 0))
-	goto DONE_LABEL;
-
       QUIT;	/* next_event_internal() does not QUIT, so check for ^G
 		   before reading output from the process - this makes it
 		   less likely that the filter will actually be aborted.
@@ -2581,10 +2489,14 @@
       switch (XEVENT_TYPE (event))
 	{
 	case timeout_event:
-	  /* We execute the event even if it's ours, and notice that it's
-	     happened above. */
-        case process_event:
+	  {
+	    if (XEVENT (event)->event.timeout.id_number == id)
+	      goto DONE_LABEL;
+            else
+              goto EXECUTE_INTERNAL;
+	  }
 	case pointer_motion_event:
+	case process_event:
 	case magic_event:
           {
           EXECUTE_INTERNAL:
@@ -2599,7 +2511,6 @@
 	}
     }
  DONE_LABEL:
-  unbind_to (count, make_int (id));
   Fdeallocate_event (event);
   UNGCPRO;
   return Qnil;
@@ -2610,11 +2521,8 @@
 ARG may be a float, meaning a fractional part of a second.
 Optional second arg non-nil means don't redisplay, just wait for input.
 Redisplay is preempted as always if user input arrives, and does not
- happen if input is available before it starts.
+happen if input is available before it starts.
 Value is t if waited the full time with no input arriving.
-
-If sit-for is called from within a process filter function or timer
- event (either synchronous or asynchronous) it will return immediately.
 */
        (seconds, nodisplay))
 {
@@ -2623,7 +2531,6 @@
   Lisp_Object event, result;
   struct gcpro gcpro1;
   int id;
-  int count;
 
   /* The unread-command-events count as pending input */
   if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
@@ -2646,24 +2553,12 @@
   if (noninteractive || !NILP (Vexecuting_macro))
     return (Qnil);
 
-  /* Recusive call from a filter function or timeout handler. */
-  if (!NILP(recursive_sit_for))
-    {
-      if (!event_stream_event_pending_p (1) && NILP (nodisplay))
-	{
-	  run_pre_idle_hook ();
-	  redisplay ();
-	}
-      return Qnil;
-    }
-
-
   /* Otherwise, start reading events from the event_stream.
      Do this loop at least once even if (sit-for 0) so that we
      redisplay when no input pending.
    */
+  event = Fmake_event ();
   GCPRO1 (event);
-  event = Fmake_event ();
 
   /* Generate the wakeup even if MSECS is 0, so that existing timeout/etc.
      events get processed.  The old (pre-19.12) code special-cased this
@@ -2673,10 +2568,6 @@
 
   id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
 
-  count = specpdl_depth ();
-  record_unwind_protect (sit_for_unwind, make_int (id));
-  recursive_sit_for = Qt;
-
   while (1)
     {
       /* If there is no user input pending, then redisplay.
@@ -2687,8 +2578,8 @@
 	  redisplay ();
 	}
 
-      /* If our timeout has arrived, we move along. */
-      if (!event_stream_wakeup_pending_p (id, 0))
+      /* If we're no longer waiting for a timeout, bug out. */
+      if (! id)
 	{
 	  result = Qt;
 	  goto DONE_LABEL;
@@ -2707,11 +2598,6 @@
 
       if (command_event_p (event))
 	{
-	  QUIT;			/* If the command was C-g check it here
-				   so that we abort out of the sit-for,
-				   not the next command.  sleep-for and
-				   accept-process-output continue looping
-				   so they check QUIT again implicitly.*/
 	  result = Qnil;
 	  goto DONE_LABEL;
 	}
@@ -2723,11 +2609,16 @@
 	    enqueue_command_event (Fcopy_event (event, Qnil));
 	    break;
 	  }
-          
 	case timeout_event:
-	  /* We execute the event even if it's ours, and notice that it's
-	     happened above. */
-	default:
+	  {
+	    if (XEVENT (event)->event.timeout.id_number != id)
+	      /* a timeout that wasn't the one we're waiting for */
+	      goto EXECUTE_INTERNAL;
+	    id = 0;	/* assert that we are no longer waiting for it. */
+	    result = Qt;
+	    goto DONE_LABEL;
+	  }
+      default:
 	  {
 	  EXECUTE_INTERNAL:
 	    execute_internal_event (event);
@@ -2737,7 +2628,9 @@
     }
 
  DONE_LABEL:
-  unbind_to (count, make_int (id));
+  /* If our timeout has not been signalled yet, disable it. */
+  if (id)
+    event_stream_disable_wakeup (id, 0);
 
   /* Put back the event (if any) that made Fsit_for() exit before the
      timeout.  Note that it is being added to the back of the queue, which
@@ -2874,12 +2767,14 @@
 #endif
 		 )
 	  {
-	    /* Currently, we rely on SIGCHLD to indicate that the
-	       process has terminated.  Unfortunately, on some systems
-	       the SIGCHLD gets missed some of the time.  So we put an
-	       additional check in status_notify() to see whether a
-	       process has terminated.  We must tell status_notify()
-	       to enable that check, and we do so now. */
+	    /* Currently, we rely on SIGCHLD to indicate that
+	       the process has terminated.  Unfortunately, it
+	       appears that on some systems the SIGCHLD gets
+	       missed some of the time.  So, we put in am
+	       additional check in status_notify() to see
+	       whether a process has terminated.  We have to
+	       tell status_notify() to enable that check, and
+	       we do so now. */
 	    kick_status_notify ();
 	  }
 	else
@@ -3160,6 +3055,17 @@
 				     Vhelp_char))
     return (Vprefix_help_command);
 
+#ifdef HAVE_XIM
+  /* If keysym is a non-ASCII char, bind it to self-insert-char by default. */
+  if (XEVENT_TYPE (builder->most_current_event) == key_press_event
+      && !NILP (Vcomposed_character_default_binding))
+    {
+      Lisp_Object keysym = XEVENT (builder->most_current_event)->event.key.keysym;
+      if (CHARP (keysym) && !CHAR_ASCII_P (XCHAR (keysym)))
+        return Vcomposed_character_default_binding;
+    }
+#endif /* HAVE_XIM */
+  
   /* If we read extra events attempting to match a function key but end
      up failing, then we release those events back to the command loop
      and fail on the original lookup.  The released events will then be
@@ -3261,7 +3167,7 @@
       like command prefixes; they signal this by setting prefix-arg
       to non-nil.
    -- Therefore, we reset this-command-keys when we finish
-      executing a command, unless prefix-arg is set.
+      executing a comand, unless prefix-arg is set.
    -- However, if we ever do a non-local exit out of a command
       loop (e.g. an error in a command), we need to reset
       this-command-keys.  We do this by calling reset_this_command_keys()
@@ -3295,7 +3201,7 @@
 
 /* The following two functions are used in call-interactively,
    for the @ and e specifications.  We used to just use
-   `current-mouse-event' (i.e. the last mouse event in this-command-keys),
+   `current-mouse-event' (i.e. the last mouse event in this-comand-keys),
    but FSF does it more generally so we follow their lead. */
 
 Lisp_Object
@@ -4113,6 +4019,11 @@
       if (fd < 0)
 	error ("Unable to create dribble file");
       Vdribble_file = make_filedesc_output_stream (fd, 0, 0, LSTR_CLOSING);
+#ifdef MULE
+      Vdribble_file =
+	make_encoding_output_stream (XLSTREAM (Vdribble_file),
+				     Fget_coding_system (Qescape_quoted));
+#endif
     }
   return Qnil;
 }
@@ -4217,8 +4128,6 @@
   last_point_position_buffer = Qnil;
   staticpro (&last_point_position_buffer);
 
-  recursive_sit_for = Qnil;
-
   DEFVAR_INT ("echo-keystrokes", &echo_keystrokes /*
 *Nonzero means echo unfinished commands after this many seconds of pause.
 */ );
@@ -4256,13 +4165,6 @@
 */ );
   Vpre_idle_hook = Qnil;
 
-  DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
-Variable to control XEmacs behavior with respect to focus changing.
-If this variable is set to t, then XEmacs will not gratuitously change
-the keyboard focus.
-*/ );
-  focus_follows_mouse = 0;
-
 #ifdef ILL_CONCEIVED_HOOK
   /* Ill-conceived because it's not run in all sorts of cases
      where XEmacs is blocking.  That's what `pre-idle-hook'
@@ -4430,6 +4332,17 @@
 */ );
     Vretry_undefined_key_binding_unshifted = Qt;
 
+#ifdef HAVE_XIM
+  DEFVAR_LISP ("Vcomposed_character_default_binding",
+               &Vretry_undefined_key_binding_unshifted /* 
+The default keybinding to use for key events from composed input.
+Window systems frequently have ways to allow the user to compose
+single characters in a language using multiple keystrokes.
+XEmacs sees these as single character keypress events.
+*/ );
+  Vcomposed_character_default_binding = Qself_insert_command;
+#endif /* HAVE_XIM */
+
   Vcontrolling_terminal = Qnil;
   staticpro (&Vcontrolling_terminal);
 
@@ -4552,9 +4465,8 @@
 
 ;do it with sleep-for.  move cursor into foo, then back into *scratch*
 ;before typing.
-;repeat also with (accept-process-output nil 20)
-
-;make sure ^G aborts sit-for, sleep-for and accept-process-output:
+
+;make sure ^G aborts both sit-for and sleep-for.
 
  (defun tst ()
   (list (condition-case c
@@ -4566,9 +4478,6 @@
  (tst)^J^Ga    ==>  ((quit) 97) with no signal
  (tst)^Jabc^G  ==>  ((quit) 97) with no signal, and "bc" inserted in buffer
 
-; with sit-for only do the 2nd test.
-; Do all 3 tests with (accept-proccess-output nil 20)
-
 Do this:
   (setq enable-recursive-minibuffers t
       minibuffer-max-depth nil)
@@ -4583,59 +4492,3 @@
 ;do it all in both v18 and v19 and make sure all results are the same.
 ;all of these cases matter a lot, but some in quite subtle ways.
 */
-
-/*
-Additional test cases for accept-process-output, sleep-for, sit-for.
-Be sure you do all of the above checking for C-g and focus, too!
-
-; Make sure that timer handlers are run during, not after sit-for:
-(defun timer-check ()
-  (add-timeout 2 '(lambda (ignore) (message "timer ran")) nil)
-  (sit-for 5)
-  (message "after sit-for"))
-
-; The first message should appear after 2 seconds, and the final message
-; 3 seconds after that.
-; repeat above test with (sleep-for 5) and (accept-process-output nil 5)
-
-
-
-; Make sure that process filters are run during, not after sit-for.
-(defun fubar ()
-  (message "sit-for = %s" (sit-for 30)))
-(add-hook 'post-command-hook 'fubar)
-
-; Now type M-x shell RET
-; wait for the shell prompt then send: ls RET
-; the output of ls should fill immediately, and not wait 30 seconds.
-
-; repeat above test with (sleep-for 30) and (accept-process-output nil 30)
-
-
-
-; Make sure that recursive invocations return immediately:
-(defmacro test-diff-time (start end)
-  `(+ (* (- (car ,end) (car ,start)) 65536.0)
-      (- (cadr ,end) (cadr ,start))
-      (/ (- (caddr ,end) (caddr ,start)) 1000000.0)))
-
-(defun testee (ignore)
-  (sit-for 10))
-
-(defun test-them ()
-  (let ((start (current-time))
-        end)
-    (add-timeout 2 'testee nil)
-    (sit-for 5)
-    (add-timeout 2 'testee nil)
-    (sleep-for 5)
-    (add-timeout 2 'testee nil)
-    (accept-process-output nil 5)
-    (setq end (current-time))
-    (test-diff-time start end)))
-
-(test-them) should sit for 15 seconds.
-Repeat with testee set to sleep-for and accept-process-output.
-These should each delay 36 seconds.
-
-*/