xemacs-beta: src/event-stream.c comparison

comparison src/event-stream.c @ 30:ec9a17fef872 r19-15b98

Import from CVS: tag r19-15b98

author	cvs
date	Mon, 13 Aug 2007 08:52:29 +0200
parents	859a2309aef8
children	e04119814345

comparison

equal deleted inserted replaced

-:7976500f47f9
+:ec9a17fef872
 keyboard and mouse events by pushing them here.
 Chained through event_next()
 command_event_queue_tail is a pointer to the last-added element.
 */
-static Lisp_Object process_event_queue;
-static Lisp_Object process_event_queue_tail;
 static Lisp_Object command_event_queue;
 static Lisp_Object command_event_queue_tail;
 /* Nonzero means echo unfinished commands after this many seconds of pause. */
 static int echo_keystrokes;
 when waiting for an event.  Otherwise holding down C-g could
 cause a suspension back to the shell, which is generally
 undesirable. (#### This doesn't fully work.) */
 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                       */
 /**********************************************************************/
 /**********************************************************************/
 /*                    enqueuing and dequeuing events                  */
 /**********************************************************************/
-/* Add an event to the back of the process_event_queue */
-void
-enqueue_process_event (Lisp_Object event)
-{
-enqueue_event (event, &process_event_queue, &process_event_queue_tail);
-}
-Lisp_Object
-dequeue_process_event (void)
-{
-return dequeue_event (&process_event_queue, &process_event_queue_tail);
-}
 /* Add an event to the back of the command-event queue: it will be the next
 event read after all pending events.   This only works on keyboard,
 mouse-click, misc-user, and eval events.
 */
 void
 /* the number of keyboard characters read.  callint.c wants this.
 */
 Charcount num_input_chars;
 static void
-next_event_internal (Lisp_Object target_event, int allow_queued,
+next_event_internal (Lisp_Object target_event, int allow_queued)
-int allow_deferred)
 {
 struct gcpro gcpro1;
 /* QUIT;   This is incorrect - the caller must do this because some
 	     callers (ie, Fnext_event()) do not want to QUIT. */
 Fdeallocate_event (event);
 #ifdef DEBUG_XEMACS
 if (debug_emacs_events)
 	{
 	  write_c_string ("(command event queue) ",
-			  Qexternal_debugging_output);
-	  print_internal (target_event, Qexternal_debugging_output, 1);
-	  write_c_string ("\n", Qexternal_debugging_output);
-	}
-#endif
-}
-else if (allow_deferred && !NILP (process_event_queue))
-{
-Lisp_Object event = dequeue_process_event ();
-Fcopy_event (event, target_event);
-Fdeallocate_event (event);
-#ifdef DEBUG_EMACS
-if (debug_emacs_events)
-	{
-	  write_c_string ("(process event queue) ",
 			  Qexternal_debugging_output);
 	  print_internal (target_event, Qexternal_debugging_output, 1);
 	  write_c_string ("\n", Qexternal_debugging_output);
 	}
 #endif
 	 recent-keys. */
 else
 	{
 	  run_pre_idle_hook ();
 	  redisplay ();
-	  next_event_internal (event, 1, 1);
+	  next_event_internal (event, 1);
 	  Vquit_flag = Qnil; /* Read C-g as an event. */
 	  store_this_key = 1;
 	}
 }
 || event_stream_event_pending_p (1))
 {
 /* This will take stuff off the command_event_queue, or read it
 	 from the event_stream, but it will not block.
 */
-next_event_internal (event, 1, 1);
+next_event_internal (event, 1);
 Vquit_flag = Qnil; /* Treat C-g as a user event (ignore it).
 			    It is vitally important that we reset
 			    Vquit_flag here.  Otherwise, if we're
 			    reading from a TTY console,
 			    maybe_read_quit_event() will notice
 /**********************************************************************/
 /*                     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 any of these
+three routines will cause them to return immediately no matter what
+their arguments were.
+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)?
 */
 DEFUN ("accept-process-output", Faccept_process_output, 0, 3, 0, /*
 Allow any pending output from subprocesses to be read by Emacs.
 from PROCESS.  This argument may be a float, meaning wait some fractional
 part of a second.
 If the third arg is non-nil, it is a number of milliseconds that is added
 to the second arg.  (This exists only for compatibility.)
 Return non-nil iff we received any output before the timeout expired.
+If a filter function or timeout handler (such as installed by `add-timeout')
+calls any of accept-process-output, sleep-for, or sit-for, those calls
+will return nil immediately (regardless of their arguments) in recursive
+situations.  It is recommended that you never call accept-process-output
+from inside of a process filter function or timer event (either synchronous
+or asynchronous).
 */
 (process, timeout_secs, timeout_msecs))
 {
 /* This function can GC */
 struct gcpro gcpro1, gcpro2;
 Lisp_Object result = Qnil;
 int timeout_id;
 int timeout_enabled = 0;
 int done = 0;
 struct buffer *old_buffer = current_buffer;
+int count;
+/* Recusive call from a filter function or timeout handler. */
+if (!NILP(recursive_sit_for))
+return Qnil;
 /* We preserve the current buffer but nothing else.  If a focus
 change alters the selected window then the top level event loop
 will eventually alter current_buffer to match.  In the mean time
 we don't want to mess up whatever called this function. */
 }
 }
 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))))
 	 /* Calling detect_input_pending() is the wrong thing here, because
 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.
 		 */
-next_event_internal (event, 0, 1);
+next_event_internal (event, 0);
 /* If C-g was pressed while we were waiting, Vquit_flag got
 	 set and next_event_internal() also returns C-g.  When
 	 we enqueue the C-g below, it will get discarded.  The
 	 next time through, QUIT will be called and will signal a quit. */
 switch (XEVENT_TYPE (event))
 break;
 	  }
 	}
 }
-/* If our timeout has not been signalled yet, disable it. */
+unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil);
-if (timeout_enabled)
-event_stream_disable_wakeup (timeout_id, 0);
 Fdeallocate_event (event);
 UNGCPRO;
 current_buffer = old_buffer;
 return result;
 }
 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.
+If a filter function or timeout handler (such as installed by `add-timeout')
+calls any of accept-process-output, sleep-for, or sit-for, those calls
+will return nil immediately (regardless of their arguments) in recursive
+situations.  It is recommended that you never call sleep-for from inside
+of a process filter function or timer event (either synchronous or
+asynchronous).
 */
 (seconds))
 {
 /* This function can GC */
 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
 int id;
 Lisp_Object event = Qnil;
+int count;
 struct gcpro gcpro1;
+/* Recusive call from a filter function or timeout handler. */
+if (!NILP(recursive_sit_for))
+return Qnil;
 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;
 		 */
 /* We're a generator of the command_event_queue, so we can't be a
 	 consumer as well.  We don't care about command and eval-events
 	 anyway.
 */
-next_event_internal (event, 0, 0); /* blocks */
+next_event_internal (event, 0); /* blocks */
 /* See the comment in accept-process-output about Vquit_flag */
 switch (XEVENT_TYPE (event))
 	{
-case process_event:
-{
-/* Avoid calling filter functions recursively by squirreling
-away process events */
-enqueue_process_event (Fcopy_event (event, Qnil));
-goto DONE_LABEL;
-}
 	case timeout_event:
 	  /* We execute the event even if it's ours, and notice that it's
 	     happened above. */
+case process_event:
 	case pointer_motion_event:
 	case magic_event:
 {
 EXECUTE_INTERNAL:
 execute_internal_event (event);
 break;
 }
 	}
 }
 DONE_LABEL:
+unbind_to (count, make_int (id));
 Fdeallocate_event (event);
 UNGCPRO;
 return Qnil;
 }
 DEFUN ("sit-for", Fsit_for, 1, 2, 0, /*
 Perform redisplay, then wait ARG seconds or until user input is available.
 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.
 Value is t if waited the full time with no input arriving.
+If a filter function or timeout handler (such as installed by `add-timeout')
+calls any of accept-process-output, sleep-for, or sit-for, those calls
+will return nil immediately (regardless of their arguments) in recursive
+situations.  It is recommended that you never call sit-for from inside
+of a process filter function or timer event (either synchronous or
+asynchronous) with an argument other than 0.
 */
 (seconds, nodisplay))
 {
 /* This function can GC */
 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1);
 Lisp_Object event, result;
 struct gcpro gcpro1;
 int id;
+int count;
+/* Recusive call from a filter function or timeout handler. */
+if (!NILP(recursive_sit_for))
+return Qnil;
 /* The unread-command-events count as pending input */
 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event))
 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.
 */
+GCPRO1 (event);
 event = Fmake_event ();
-GCPRO1 (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
 and didn't generate a wakeup, but the resulting behavior was less than
 ideal; viz. the occurrence of (sit-for 0.001) scattered throughout
 the E-Lisp universe. */
 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.
 */
 		 */
 /* We're a generator of the command_event_queue, so we can't be a
 	 consumer as well.  In fact, we know there's nothing on the
 	 command_event_queue that we didn't just put there.
 */
-next_event_internal (event, 0, 0); /* blocks */
+next_event_internal (event, 0); /* blocks */
 /* See the comment in accept-process-output about Vquit_flag */
 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;
 	}
 switch (XEVENT_TYPE (event))
 	{
 	  {
 	    /* eval-events get delayed until later. */
 	    enqueue_command_event (Fcopy_event (event, Qnil));
 	    break;
 	  }
-case process_event:
-{
-/* Avoid recursive calls to process filters */
-enqueue_process_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:
 	  }
 	}
 }
 DONE_LABEL:
-/* If our timeout has not been signalled yet, disable it. */
+unbind_to (count, make_int (id));
-if (NILP (result))
-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
 would be inappropriate if there were any user events on the queue
 already: we would be misordering them.  But we know that there are
 /* We're a generator of the command_event_queue, so we can't be a
 	 consumer as well.  Also, we have no reason to consult the
 	 command_event_queue; there are only user and eval-events there,
 	 and we'd just have to put them back anyway.
 */
-next_event_internal (event, 0, 1);
+next_event_internal (event, 0);
 /* See the comment in accept-process-output about Vquit_flag */
 if (command_event_p (event)
 || (XEVENT_TYPE (event) == eval_event)
 	  || (XEVENT_TYPE (event) == magic_eval_event))
 enqueue_command_event_1 (event);
 command_event_queue = Qnil;
 staticpro (&command_event_queue);
 command_event_queue_tail = Qnil;
-process_event_queue = Qnil;
-staticpro (&process_event_queue);
-process_event_queue_tail = Qnil;
 Vlast_selected_frame = Qnil;
 staticpro (&Vlast_selected_frame);
 pending_timeout_list = Qnil;
 staticpro (&pending_timeout_list);
 something_happened = 0;
 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.
 */ );
 echo_keystrokes = 1;
 ;a should be inserted in foo.  Cursor highlighting should not change in
 ;the meantime.
 ;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 both sit-for and sleep-for.
+;make sure ^G aborts sit-for, sleep-for and accept-process-output:
 (defun tst ()
 (list (condition-case c
 	    (sleep-for 20)
 	  (quit c))
 	(read-char)))
 (tst)^Ja^G    ==>  ((quit) 97) with no signal
 (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)
 ESC ESC ESC ESC	- there are now two minibuffers active
 however C-g before "Quit" is displayed should leave minibuffer active.
 ;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)
+;; All three of these should return immediately.
+(sit-for 10)
+(sleep-for 10)
+(accept-process-output nil 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, not 105 or 96.
+*/

Mercurial > hg > xemacs-beta

comparison src/event-stream.c @ 30:ec9a17fef872 r19-15b98