Mercurial > hg > xemacs-beta
comparison src/event-stream.c @ 32:e04119814345 r19-15b99
Import from CVS: tag r19-15b99
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:52:56 +0200 |
parents | ec9a17fef872 |
children | 8d2a9b52c682 |
comparison
equal
deleted
inserted
replaced
31:b9328a10c56c | 32:e04119814345 |
---|---|
2355 /**********************************************************************/ | 2355 /**********************************************************************/ |
2356 | 2356 |
2357 /* This is used in accept-process-output, sleep-for and sit-for. | 2357 /* This is used in accept-process-output, sleep-for and sit-for. |
2358 Before running any process_events in these routines, we set | 2358 Before running any process_events in these routines, we set |
2359 recursive_sit_for to Qt, and use this unwind protect to reset it to | 2359 recursive_sit_for to Qt, and use this unwind protect to reset it to |
2360 Qnil upon exit. When recursive_sit_for is Qt, calling any of these | 2360 Qnil upon exit. When recursive_sit_for is Qt, calling sit-for will |
2361 three routines will cause them to return immediately no matter what | 2361 cause it to return immediately. |
2362 their arguments were. | |
2363 | 2362 |
2364 All of these routines install timeouts, so we clear the installed | 2363 All of these routines install timeouts, so we clear the installed |
2365 timeout as well. | 2364 timeout as well. |
2366 | 2365 |
2367 Note: It's very easy to break the desired behaviours of these | 2366 Note: It's very easy to break the desired behaviours of these |
2393 from PROCESS. This argument may be a float, meaning wait some fractional | 2392 from PROCESS. This argument may be a float, meaning wait some fractional |
2394 part of a second. | 2393 part of a second. |
2395 If the third arg is non-nil, it is a number of milliseconds that is added | 2394 If the third arg is non-nil, it is a number of milliseconds that is added |
2396 to the second arg. (This exists only for compatibility.) | 2395 to the second arg. (This exists only for compatibility.) |
2397 Return non-nil iff we received any output before the timeout expired. | 2396 Return non-nil iff we received any output before the timeout expired. |
2398 | |
2399 If a filter function or timeout handler (such as installed by `add-timeout') | |
2400 calls any of accept-process-output, sleep-for, or sit-for, those calls | |
2401 will return nil immediately (regardless of their arguments) in recursive | |
2402 situations. It is recommended that you never call accept-process-output | |
2403 from inside of a process filter function or timer event (either synchronous | |
2404 or asynchronous). | |
2405 */ | 2397 */ |
2406 (process, timeout_secs, timeout_msecs)) | 2398 (process, timeout_secs, timeout_msecs)) |
2407 { | 2399 { |
2408 /* This function can GC */ | 2400 /* This function can GC */ |
2409 struct gcpro gcpro1, gcpro2; | 2401 struct gcpro gcpro1, gcpro2; |
2412 int timeout_id; | 2404 int timeout_id; |
2413 int timeout_enabled = 0; | 2405 int timeout_enabled = 0; |
2414 int done = 0; | 2406 int done = 0; |
2415 struct buffer *old_buffer = current_buffer; | 2407 struct buffer *old_buffer = current_buffer; |
2416 int count; | 2408 int count; |
2417 | |
2418 /* Recusive call from a filter function or timeout handler. */ | |
2419 if (!NILP(recursive_sit_for)) | |
2420 return Qnil; | |
2421 | 2409 |
2422 /* We preserve the current buffer but nothing else. If a focus | 2410 /* We preserve the current buffer but nothing else. If a focus |
2423 change alters the selected window then the top level event loop | 2411 change alters the selected window then the top level event loop |
2424 will eventually alter current_buffer to match. In the mean time | 2412 will eventually alter current_buffer to match. In the mean time |
2425 we don't want to mess up whatever called this function. */ | 2413 we don't want to mess up whatever called this function. */ |
2534 | 2522 |
2535 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /* | 2523 DEFUN ("sleep-for", Fsleep_for, 1, 1, 0, /* |
2536 Pause, without updating display, for ARG seconds. | 2524 Pause, without updating display, for ARG seconds. |
2537 ARG may be a float, meaning pause for some fractional part of a second. | 2525 ARG may be a float, meaning pause for some fractional part of a second. |
2538 | 2526 |
2539 If a filter function or timeout handler (such as installed by `add-timeout') | 2527 It is recommended that you never call sleep-for from inside of a process |
2540 calls any of accept-process-output, sleep-for, or sit-for, those calls | 2528 filter function or timer event (either synchronous or asynchronous). |
2541 will return nil immediately (regardless of their arguments) in recursive | |
2542 situations. It is recommended that you never call sleep-for from inside | |
2543 of a process filter function or timer event (either synchronous or | |
2544 asynchronous). | |
2545 */ | 2529 */ |
2546 (seconds)) | 2530 (seconds)) |
2547 { | 2531 { |
2548 /* This function can GC */ | 2532 /* This function can GC */ |
2549 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); | 2533 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); |
2550 int id; | 2534 int id; |
2551 Lisp_Object event = Qnil; | 2535 Lisp_Object event = Qnil; |
2552 int count; | 2536 int count; |
2553 struct gcpro gcpro1; | 2537 struct gcpro gcpro1; |
2554 | |
2555 /* Recusive call from a filter function or timeout handler. */ | |
2556 if (!NILP(recursive_sit_for)) | |
2557 return Qnil; | |
2558 | 2538 |
2559 GCPRO1 (event); | 2539 GCPRO1 (event); |
2560 | 2540 |
2561 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); | 2541 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0); |
2562 event = Fmake_event (); | 2542 event = Fmake_event (); |
2614 Optional second arg non-nil means don't redisplay, just wait for input. | 2594 Optional second arg non-nil means don't redisplay, just wait for input. |
2615 Redisplay is preempted as always if user input arrives, and does not | 2595 Redisplay is preempted as always if user input arrives, and does not |
2616 happen if input is available before it starts. | 2596 happen if input is available before it starts. |
2617 Value is t if waited the full time with no input arriving. | 2597 Value is t if waited the full time with no input arriving. |
2618 | 2598 |
2619 If a filter function or timeout handler (such as installed by `add-timeout') | 2599 If sit-for is called from within a process filter function or timer |
2620 calls any of accept-process-output, sleep-for, or sit-for, those calls | 2600 event (either synchronous or asynchronous) it will return immediately. |
2621 will return nil immediately (regardless of their arguments) in recursive | |
2622 situations. It is recommended that you never call sit-for from inside | |
2623 of a process filter function or timer event (either synchronous or | |
2624 asynchronous) with an argument other than 0. | |
2625 */ | 2601 */ |
2626 (seconds, nodisplay)) | 2602 (seconds, nodisplay)) |
2627 { | 2603 { |
2628 /* This function can GC */ | 2604 /* This function can GC */ |
2629 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); | 2605 unsigned long msecs = lisp_number_to_milliseconds (seconds, 1); |
2630 Lisp_Object event, result; | 2606 Lisp_Object event, result; |
2631 struct gcpro gcpro1; | 2607 struct gcpro gcpro1; |
2632 int id; | 2608 int id; |
2633 int count; | 2609 int count; |
2634 | 2610 |
2635 /* Recusive call from a filter function or timeout handler. */ | |
2636 if (!NILP(recursive_sit_for)) | |
2637 return Qnil; | |
2638 | |
2639 /* The unread-command-events count as pending input */ | 2611 /* The unread-command-events count as pending input */ |
2640 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event)) | 2612 if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event)) |
2641 return Qnil; | 2613 return Qnil; |
2642 | 2614 |
2643 /* If the command-builder already has user-input on it (not eval events) | 2615 /* If the command-builder already has user-input on it (not eval events) |
2654 | 2626 |
2655 /* If we're in a macro, or noninteractive, or early in temacs, then | 2627 /* If we're in a macro, or noninteractive, or early in temacs, then |
2656 don't wait. */ | 2628 don't wait. */ |
2657 if (noninteractive || !NILP (Vexecuting_macro)) | 2629 if (noninteractive || !NILP (Vexecuting_macro)) |
2658 return (Qnil); | 2630 return (Qnil); |
2631 | |
2632 /* Recusive call from a filter function or timeout handler. */ | |
2633 if (!NILP(recursive_sit_for)) | |
2634 { | |
2635 if (!event_stream_event_pending_p (1) && NILP (nodisplay)) | |
2636 { | |
2637 run_pre_idle_hook (); | |
2638 redisplay (); | |
2639 } | |
2640 return Qnil; | |
2641 } | |
2642 | |
2659 | 2643 |
2660 /* Otherwise, start reading events from the event_stream. | 2644 /* Otherwise, start reading events from the event_stream. |
2661 Do this loop at least once even if (sit-for 0) so that we | 2645 Do this loop at least once even if (sit-for 0) so that we |
2662 redisplay when no input pending. | 2646 redisplay when no input pending. |
2663 */ | 2647 */ |
3258 -- We do not reset this-command-keys when we finish reading a | 3242 -- We do not reset this-command-keys when we finish reading a |
3259 command. This is because some commands (e.g. C-u) act | 3243 command. This is because some commands (e.g. C-u) act |
3260 like command prefixes; they signal this by setting prefix-arg | 3244 like command prefixes; they signal this by setting prefix-arg |
3261 to non-nil. | 3245 to non-nil. |
3262 -- Therefore, we reset this-command-keys when we finish | 3246 -- Therefore, we reset this-command-keys when we finish |
3263 executing a comand, unless prefix-arg is set. | 3247 executing a command, unless prefix-arg is set. |
3264 -- However, if we ever do a non-local exit out of a command | 3248 -- However, if we ever do a non-local exit out of a command |
3265 loop (e.g. an error in a command), we need to reset | 3249 loop (e.g. an error in a command), we need to reset |
3266 this-command-keys. We do this by calling reset_this_command_keys() | 3250 this-command-keys. We do this by calling reset_this_command_keys() |
3267 from cmdloop.c, whenever an error causes an invocation of the | 3251 from cmdloop.c, whenever an error causes an invocation of the |
3268 default error handler, and whenever there's a throw to top-level.) | 3252 default error handler, and whenever there's a throw to top-level.) |
3292 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail); | 3276 enqueue_event (new, &Vthis_command_keys, &Vthis_command_keys_tail); |
3293 } | 3277 } |
3294 | 3278 |
3295 /* The following two functions are used in call-interactively, | 3279 /* The following two functions are used in call-interactively, |
3296 for the @ and e specifications. We used to just use | 3280 for the @ and e specifications. We used to just use |
3297 `current-mouse-event' (i.e. the last mouse event in this-comand-keys), | 3281 `current-mouse-event' (i.e. the last mouse event in this-command-keys), |
3298 but FSF does it more generally so we follow their lead. */ | 3282 but FSF does it more generally so we follow their lead. */ |
3299 | 3283 |
3300 Lisp_Object | 3284 Lisp_Object |
3301 extract_this_command_keys_nth_mouse_event (int n) | 3285 extract_this_command_keys_nth_mouse_event (int n) |
3302 { | 3286 { |
4617 `(+ (* (- (car ,end) (car ,start)) 65536.0) | 4601 `(+ (* (- (car ,end) (car ,start)) 65536.0) |
4618 (- (cadr ,end) (cadr ,start)) | 4602 (- (cadr ,end) (cadr ,start)) |
4619 (/ (- (caddr ,end) (caddr ,start)) 1000000.0))) | 4603 (/ (- (caddr ,end) (caddr ,start)) 1000000.0))) |
4620 | 4604 |
4621 (defun testee (ignore) | 4605 (defun testee (ignore) |
4622 ;; All three of these should return immediately. | 4606 (sit-for 10)) |
4623 (sit-for 10) | |
4624 (sleep-for 10) | |
4625 (accept-process-output nil 10)) | |
4626 | 4607 |
4627 (defun test-them () | 4608 (defun test-them () |
4628 (let ((start (current-time)) | 4609 (let ((start (current-time)) |
4629 end) | 4610 end) |
4630 (add-timeout 2 'testee nil) | 4611 (add-timeout 2 'testee nil) |
4634 (add-timeout 2 'testee nil) | 4615 (add-timeout 2 'testee nil) |
4635 (accept-process-output nil 5) | 4616 (accept-process-output nil 5) |
4636 (setq end (current-time)) | 4617 (setq end (current-time)) |
4637 (test-diff-time start end))) | 4618 (test-diff-time start end))) |
4638 | 4619 |
4639 (test-them) should sit for 15 seconds, not 105 or 96. | 4620 (test-them) should sit for 15 seconds. |
4640 | 4621 Repeat with testee set to sleep-for and accept-process-output. |
4622 These should each delay 36 seconds. | |
4641 | 4623 |
4642 */ | 4624 */ |