Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- a/src/event-stream.c Mon Aug 13 08:51:58 2007 +0200 +++ b/src/event-stream.c Mon Aug 13 08:52:29 2007 +0200 @@ -251,8 +251,6 @@ 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; @@ -269,6 +267,13 @@ 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 */ @@ -1443,19 +1448,6 @@ /* 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. @@ -1845,8 +1837,7 @@ Charcount num_input_chars; static void -next_event_internal (Lisp_Object target_event, int allow_queued, - int allow_deferred) +next_event_internal (Lisp_Object target_event, int allow_queued) { struct gcpro gcpro1; /* QUIT; This is incorrect - the caller must do this because some @@ -1872,21 +1863,6 @@ } #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 - } else { struct Lisp_Event *e = XEVENT (target_event); @@ -2123,7 +2099,7 @@ { 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; } @@ -2324,7 +2300,7 @@ /* 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 @@ -2378,6 +2354,31 @@ /* 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)? */ @@ -2394,6 +2395,13 @@ 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)) { @@ -2405,6 +2413,11 @@ 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 @@ -2435,6 +2448,11 @@ 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)) || @@ -2467,7 +2485,7 @@ 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 @@ -2506,9 +2524,7 @@ } } - /* If our timeout has not been signalled yet, disable it. */ - if (timeout_enabled) - event_stream_disable_wakeup (timeout_id, 0); + unbind_to (count, timeout_enabled ? make_int (timeout_id) : Qnil); Fdeallocate_event (event); UNGCPRO; @@ -2519,6 +2535,13 @@ 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)) { @@ -2526,12 +2549,22 @@ 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. */ @@ -2546,21 +2579,14 @@ 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: { @@ -2576,6 +2602,7 @@ } } DONE_LABEL: + unbind_to (count, make_int (id)); Fdeallocate_event (event); UNGCPRO; return Qnil; @@ -2586,8 +2613,15 @@ 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 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)) { @@ -2596,6 +2630,11 @@ 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)) @@ -2622,8 +2661,8 @@ 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 @@ -2633,6 +2672,10 @@ 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. @@ -2658,11 +2701,16 @@ 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; } @@ -2674,13 +2722,6 @@ 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 @@ -2695,9 +2736,7 @@ } DONE_LABEL: - /* If our timeout has not been signalled yet, disable it. */ - if (NILP (result)) - event_stream_disable_wakeup (id, 0); + unbind_to (count, make_int (id)); /* 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 @@ -2736,7 +2775,7 @@ 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) @@ -4156,10 +4195,6 @@ 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); @@ -4181,6 +4216,8 @@ 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. */ ); @@ -4514,8 +4551,9 @@ ;do it with sleep-for. move cursor into foo, then back into *scratch* ;before typing. - -;make sure ^G aborts both sit-for and sleep-for. +;repeat also with (accept-process-output nil 20) + +;make sure ^G aborts sit-for, sleep-for and accept-process-output: (defun tst () (list (condition-case c @@ -4527,6 +4565,9 @@ (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) @@ -4541,3 +4582,61 @@ ;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. + + +*/