Mercurial > hg > xemacs-beta
changeset 1268:fffe735e63ee
[xemacs-hg @ 2003-02-07 11:50:50 by ben]
fixes for menu crashes + better preemption behavior
This contains two related changes:
(1) Fix problems with reentrant calling of lwlib and associated
crashes when selecting menu items.
(2) Improve redisplay handling of preemption. Turn on lazy lock
and hold down page-down or page-up and you'll see what I mean.
They are related because they both touch on the code that retrieves
events and handles the internal queues.
console-msw.h, event-msw.c, event-stream.c, events.h, menubar-msw.c, menubar-x.c, menubar.h: mswindows_protect_modal_loop() has been generalized to
event_stream_protect_modal_loop(), and moved to event-stream.c.
mswindows_in_modal_loop ->in_modal_loop likewise. Changes in
event-msw.c and menubar-msw.c for the new names and calling format
(use structures instead of static variables in menubar-msw.c).
Delete former in_menu_callback and use in_modal_loop in its place.
Remove emacs_mswindows_quit_check_disallowed_p(), superseded by
in_modal_loop. Use event_stream_protect_modal_loop() in
pre_activate_callback() so that we get no lwlib reentrancy.
Rearrange some of the code in event-msw.c to be grouped better.
Make mswindows_drain_windows_queue() respect in_modal_loop and
do nothing if so.
cmdloop.c, event-stream.c: Don't conditionalize on LWLIB_MENUBARS_LUCID when giving error when
in_modal_loop, and give better error.
event-Xt.c, event-gtk.c: If in_modal_loop, only retrieve process and timeout events.
Don't retrieve any X events because processing them can lead
to reentrancy in lwlib -> death.
event-stream.c: Remove unused parameter to check_event_stream_ok() and change
all callers.
lisp.h, event-stream.c: Rearrange some functions for increased clarity -- in particular,
group all the input-pending/QUIT-related stuff together, and
put right next to next-event stuff, to which it's related.
Add the concept of "HOW_MANY" -- when asking whether user input
is pending, you can ask if at least HOW_MANY events are pending,
not just if any are. Add parameter to detect_input_pending()
for this. Change recursive_sit_for from a Lisp_Object (which
could only be Qt or Qnil) to an int, like it should be.
event-Xt.c, event-gtk.c, event-xlike-inc.c: New file.
Abstract out similar code in event_{Xt/gtk}_pending_p() and write
only once, using include-file tricks. Rewrite this function to
implement HOW_MANY and only process events when not in_modal_loop.
event-msw.c: Implement HOW_MANY and only process events when not in_modal_loop.
event-tty.c: Implement HOW_MANY.
redisplay.c: Add var `max-preempts' to control maximum number of preempts.
(#### perhaps not useful) Rewrite preemption check so that,
rather than preempting when any user events are available, only
preempt when a certain number (currently 4) of them are backed up.
This effectively allows redisplay to proceed to completion in the
presence of a fast auto-repeat (usually the auto-repeating is
generated dynamically as necessary), and you get much better
display behavior with lazy-lock active.
event-unixoid.c: Comment changes.
event-stream.c: Rewrite discard-input much more simply and safely using the
drain-queue functions. I think the old version might loop
forever if called when in_modal_loop.
SEMI-UNRELATED CHANGES:
-----------------------
event-stream.c: Turn QUIT-checking back on when running the pre-idle hook so it
can be quit out of.
indent.c: Document exact functioning of `vertical-motion' better, and its
differences from GNU Emacs.
| author | ben |
|---|---|
| date | Fri, 07 Feb 2003 11:50:54 +0000 |
| parents | c57f32e44416 |
| children | 13aa577c1dd2 |
| files | src/ChangeLog src/cmdloop.c src/console-msw.h src/event-Xt.c src/event-gtk.c src/event-msw.c src/event-stream.c src/event-tty.c src/event-unixoid.c src/event-xlike-inc.c src/events.h src/indent.c src/lisp.h src/menubar-msw.c src/menubar-x.c src/menubar.h src/redisplay.c |
| diffstat | 17 files changed, 979 insertions(+), 927 deletions(-) [+] |
line wrap: on
line diff
--- a/src/ChangeLog Fri Feb 07 01:43:07 2003 +0000 +++ b/src/ChangeLog Fri Feb 07 11:50:54 2003 +0000 @@ -1,3 +1,158 @@ +2003-02-07 Ben Wing <ben@xemacs.org> + + This contains two related changes: + + (1) Fix problems with reentrant calling of lwlib and associated + crashes when selecting menu items. + (2) Improve redisplay handling of preemption. Turn on lazy lock + and hold down page-down or page-up and you'll see what I mean. + + They are related because they both touch on the code that retrieves + events and handles the internal queues. + + * console-msw.h: + * event-msw.c: + * event-msw.c (mswindows_unmodalize_signal_maybe): + * event-msw.c (mswindows_unsafe_pump_events): + * event-msw.c (mswindows_pump_outstanding_events): + * event-msw.c (mswindows_need_event_in_modal_loop): + * event-msw.c (mswindows_drain_windows_queue): + * event-msw.c (mswindows_need_event): + * event-msw.c (reinit_vars_of_event_mswindows): + * event-stream.c (event_stream_protect_modal_loop): + * events.h: + * events.h (struct event_stream): + * menubar-msw.c (struct handle_wm_initmenu): + * menubar-msw.c (unsafe_handle_wm_initmenupopup): + * menubar-msw.c (unsafe_handle_wm_initmenu): + * menubar-msw.c (mswindows_handle_wm_initmenupopup): + * menubar-msw.c (mswindows_handle_wm_initmenu): + * menubar-x.c: + * menubar-x.c (protected_menu_item_descriptor_to_widget_value): + * menubar-x.c (pre_activate_callback): + * menubar.h: + + mswindows_protect_modal_loop() has been generalized to + event_stream_protect_modal_loop(), and moved to event-stream.c. + mswindows_in_modal_loop ->in_modal_loop likewise. Changes in + event-msw.c and menubar-msw.c for the new names and calling format + (use structures instead of static variables in menubar-msw.c). + Delete former in_menu_callback and use in_modal_loop in its place. + Remove emacs_mswindows_quit_check_disallowed_p(), superseded by + in_modal_loop. Use event_stream_protect_modal_loop() in + pre_activate_callback() so that we get no lwlib reentrancy. + + Rearrange some of the code in event-msw.c to be grouped better. + Make mswindows_drain_windows_queue() respect in_modal_loop and + do nothing if so. + + * cmdloop.c (command_loop_3): + * event-stream.c (Fnext_event): + Don't conditionalize on LWLIB_MENUBARS_LUCID when giving error when + in_modal_loop, and give better error. + + * event-Xt.c (emacs_Xt_next_event): + * event-Xt.c (emacs_Xt_drain_queue): + * event-gtk.c (emacs_gtk_drain_queue): + If in_modal_loop, only retrieve process and timeout events. + Don't retrieve any X events because processing them can lead + to reentrancy in lwlib -> death. + + * event-stream.c: + * event-stream.c (check_event_stream_ok): + * event-stream.c (event_stream_handle_magic_event): + * event-stream.c (event_stream_format_magic_event): + * event-stream.c (event_stream_compare_magic_event): + * event-stream.c (event_stream_hash_magic_event): + * event-stream.c (event_stream_add_timeout): + * event-stream.c (event_stream_remove_timeout): + * event-stream.c (event_stream_select_console): + * event-stream.c (event_stream_unselect_console): + * event-stream.c (event_stream_select_process): + * event-stream.c (event_stream_unselect_process): + * event-stream.c (event_stream_create_io_streams): + * event-stream.c (event_stream_delete_io_streams): + * event-stream.c (event_stream_current_event_timestamp): + * event-stream.c (event_stream_next_event): + Remove unused parameter to check_event_stream_ok() and change + all callers. + + * lisp.h: + * event-stream.c (maybe_do_auto_save): + * event-stream.c (emacs_handle_focus_change_preliminary): + * event-stream.c (emacs_handle_focus_change_final): + * event-stream.c (detect_input_pending): + * event-stream.c (maybe_read_quit_event): + * event-stream.c (remove_quit_p_event): + * event-stream.c (event_stream_quit_p): + * event-stream.c (event_stream_next_event): + * event-stream.c (sit_for_unwind): + * event-stream.c (Faccept_process_output): + * event-stream.c (Fsleep_for): + * event-stream.c (Fsit_for): + * event-stream.c (maybe_kbd_translate): + * event-stream.c (command_builder_find_leaf_no_mule_processing): + * event-stream.c (reinit_vars_of_event_stream): + Rearrange some functions for increased clarity -- in particular, + group all the input-pending/QUIT-related stuff together, and + put right next to next-event stuff, to which it's related. + Add the concept of "HOW_MANY" -- when asking whether user input + is pending, you can ask if at least HOW_MANY events are pending, + not just if any are. Add parameter to detect_input_pending() + for this. Change recursive_sit_for from a Lisp_Object (which + could only be Qt or Qnil) to an int, like it should be. + + * event-Xt.c: + * event-Xt.c (THIS_IS_X): + * event-gtk.c: + * event-gtk.c (THIS_IS_GTK): + * event-xlike-inc.c: New file. + Abstract out similar code in event_{Xt/gtk}_pending_p() and write + only once, using include-file tricks. Rewrite this function to + implement HOW_MANY and only process events when not in_modal_loop. + + * event-msw.c (emacs_mswindows_event_pending_p): + Implement HOW_MANY and only process events when not in_modal_loop. + + * event-tty.c: + * event-tty.c (tty_timeout_to_emacs_event): + * event-tty.c (emacs_tty_event_pending_p): + Implement HOW_MANY. + + * redisplay.c: + * redisplay.c (QUEUED_EVENTS_REQUIRED_FOR_PREEMPTION): + * redisplay.c (init_redisplay): + * redisplay.c (vars_of_redisplay): + Add var `max-preempts' to control maximum number of preempts. + (#### perhaps not useful) Rewrite preemption check so that, + rather than preempting when any user events are available, only + preempt when a certain number (currently 4) of them are backed up. + This effectively allows redisplay to proceed to completion in the + presence of a fast auto-repeat (usually the auto-repeating is + generated dynamically as necessary), and you get much better + display behavior with lazy-lock active. + + * event-unixoid.c: + Comment changes. + + * event-stream.c (command_event_p_cb): + * event-stream.c (Fdiscard_input): + Rewrite discard-input much more simply and safely using the + drain-queue functions. I think the old version might loop + forever if called when in_modal_loop. + + SEMI-UNRELATED CHANGES: + ----------------------- + + * event-stream.c (run_pre_idle_hook): + Turn QUIT-checking back on when running the pre-idle hook so it + can be quit out of. + + * indent.c: + Document exact functioning of `vertical-motion' better, and its + differences from GNU Emacs. + + 2003-02-06 Ben Wing <ben@xemacs.org> * unicode.c:
--- a/src/cmdloop.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/cmdloop.c Fri Feb 07 11:50:54 2003 +0000 @@ -238,26 +238,13 @@ static DOESNT_RETURN command_loop_3 (void) { -#ifdef LWLIB_MENUBARS_LUCID - extern int in_menu_callback; /* defined in menubar-x.c */ -#endif /* LWLIB_MENUBARS_LUCID */ - -#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, - * but waiting to signal an error there is too late in case where - * a new command loop has been started. The error will be caught - * and Fnext_event will be called again, looping forever. So we - * signal an error here to avoid the loop. + * If we are inside of a menu callback we cannot reenter the command loop + * because we will deadlock, as no input is allowed. */ - if (in_menu_callback) - invalid_operation ("Attempt to enter command_loop_3 inside menu callback", Qunbound); -#endif /* LWLIB_MENUBARS_LUCID */ + if (in_modal_loop) + invalid_operation ("Attempt to enter command loop inside menu callback", + Qunbound); /* This function can GC */ for (;;) {
--- a/src/console-msw.h Fri Feb 07 01:43:07 2003 +0000 +++ b/src/console-msw.h Fri Feb 07 11:50:54 2003 +0000 @@ -124,10 +124,6 @@ Lisp_Object object); Lisp_Object mswindows_cancel_dispatch_event (Lisp_Event *event); Lisp_Object mswindows_pump_outstanding_events (void); -Lisp_Object mswindows_protect_modal_loop (const char *error_string, - Lisp_Object (*bfun) - (Lisp_Object barg), - Lisp_Object barg, int flags); void mswindows_unmodalize_signal_maybe (void); COLORREF mswindows_string_to_color (const Ibyte *name);
--- a/src/event-Xt.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/event-Xt.c Fri Feb 07 11:50:54 2003 +0000 @@ -1,7 +1,7 @@ /* The event_stream interface for X11 with Xt, and/or tty frames. Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. This file is part of XEmacs. @@ -98,7 +98,8 @@ static Widget widget_with_focus; /* Mask of bits indicating the descriptors that we wait for input on */ -extern SELECT_TYPE input_wait_mask, process_only_mask, tty_only_mask; +extern SELECT_TYPE input_wait_mask, non_fake_input_wait_mask; +extern SELECT_TYPE process_only_mask, tty_only_mask; static const String x_fallback_resources[] = { @@ -121,6 +122,9 @@ Lisp_Object Qkey_mapping; Lisp_Object Qsans_modifiers; +#define THIS_IS_X +#include "event-xlike-inc.c" + /************************************************************************/ /* keymap handling */ @@ -2771,39 +2775,62 @@ !process_events_occurred && !tty_events_occurred) { - - /* Stupid logic in XtAppProcessEvent() dictates that, if process - events and X events are both available, the process event gets - taken first. This will cause an infinite loop if we're being - called from Fdiscard_input(). - */ - if (XtAppPending (Xt_app_con) & XtIMXEvent) - XtAppProcessEvent (Xt_app_con, XtIMXEvent); + if (in_modal_loop) + { + /* in_modal_loop gets set when we are in the process of + dispatching an event (more specifically, when we are inside of + a menu callback -- if we get here, it means we called a filter + and the filter did something that tried to fetch an event, + e.g. sit-for). In such a case, we cannot safely dispatch any + more events. This is because those dispatching those events + could cause lwlib to be entered reentranty, specifically if + they are menu events. lwlib is not designed for this and will + crash. We used to see this crash constantly as a result of + QUIT checking, but QUIT will not now function in a modal loop. + However, we can't just not process any events at all, because + that will make sit-for etc. hang. So we go ahead and process + the non-X kinds of events. */ + XtInputMask pending_value = XtAppPending (Xt_app_con); + + if (pending_value & (XtIMTimer | XtIMAlternateInput)) + XtAppProcessEvent (Xt_app_con, XtIMTimer | XtIMAlternateInput); + } else { - Lisp_Object devcons, concons; - - /* We're about to block. Xt has a bug in it (big surprise, - there) in that it blocks using select() and doesn't - flush the Xlib output buffers (XNextEvent() does this - automatically before blocking). So it's necessary - for us to do this ourselves. If we don't do it, then - display output may not be seen until the next time - an X event is received. (This happens esp. with - subprocess output that gets sent to a visible buffer.) - - #### The above comment may not have any validity. */ - - DEVICE_LOOP_NO_BREAK (devcons, concons) + /* Stupid logic in XtAppProcessEvent() dictates that, if process + events and X events are both available, the process event gets + taken first. This will cause an infinite loop if we're being + called from Fdiscard_input(). + */ + + if (XtAppPending (Xt_app_con) & XtIMXEvent) + XtAppProcessEvent (Xt_app_con, XtIMXEvent); + else { - struct device *d; - d = XDEVICE (XCAR (devcons)); - - if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d)) - /* emacs may be exiting */ - XFlush (DEVICE_X_DISPLAY (d)); + Lisp_Object devcons, concons; + + /* We're about to block. Xt has a bug in it (big surprise, + there) in that it blocks using select() and doesn't + flush the Xlib output buffers (XNextEvent() does this + automatically before blocking). So it's necessary + for us to do this ourselves. If we don't do it, then + display output may not be seen until the next time + an X event is received. (This happens esp. with + subprocess output that gets sent to a visible buffer.) + + #### The above comment may not have any validity. */ + + DEVICE_LOOP_NO_BREAK (devcons, concons) + { + struct device *d; + d = XDEVICE (XCAR (devcons)); + + if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d)) + /* emacs may be exiting */ + XFlush (DEVICE_X_DISPLAY (d)); + } + XtAppProcessEvent (Xt_app_con, XtIMAll); } - XtAppProcessEvent (Xt_app_con, XtIMAll); } } @@ -2864,154 +2891,36 @@ emacs_Xt_drain_queue (void) { Lisp_Object devcons, concons; - CONSOLE_LOOP (concons) + if (!in_modal_loop) { - struct console *con = XCONSOLE (XCAR (concons)); - if (!con->input_enabled) - continue; - - CONSOLE_DEVICE_LOOP (devcons, con) + CONSOLE_LOOP (concons) { - struct device *d; - Display *display; - d = XDEVICE (XCAR (devcons)); - if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d)) + struct console *con = XCONSOLE (XCAR (concons)); + if (!con->input_enabled) + continue; + + CONSOLE_DEVICE_LOOP (devcons, con) { - display = DEVICE_X_DISPLAY (d); - while (XEventsQueued (display, QueuedAfterReading)) - XtAppProcessEvent (Xt_app_con, XtIMXEvent); + struct device *d; + Display *display; + d = XDEVICE (XCAR (devcons)); + if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d)) + { + display = DEVICE_X_DISPLAY (d); + while (XEventsQueued (display, QueuedAfterReading)) + XtAppProcessEvent (Xt_app_con, XtIMXEvent); + } } } + /* + while (XtAppPending (Xt_app_con) & XtIMXEvent) + XtAppProcessEvent (Xt_app_con, XtIMXEvent); + */ } - /* - while (XtAppPending (Xt_app_con) & XtIMXEvent) - XtAppProcessEvent (Xt_app_con, XtIMXEvent); - */ - + +#ifdef HAVE_TTY drain_tty_devices (); -} - -static int -emacs_Xt_event_pending_p (int user_p) -{ - Lisp_Object event; - int tick_count_val; - - /* If `user_p' is false, then this function returns whether there are any - X, timeout, or fd events pending (that is, whether emacs_Xt_next_event() - would return immediately without blocking). - - if `user_p' is true, then this function returns whether there are any - *user generated* events available (that is, whether there are keyboard - or mouse-click events ready to be read). This also implies that - emacs_Xt_next_event() would not block. - - In a non-SIGIO world, this also checks whether the user has typed ^G, - since this is a convenient place to do so. We don't need to do this - in a SIGIO world, since input causes an interrupt. - */ - -#if 0 - /* I don't think there's any point to this and it will nullify - the speed gains achieved by the sigio_happened checking below. - Its only advantage is that it may possibly make C-g response - a bit faster. The C-g will be noticed within 0.25 second, anyway, - even without this. */ -#ifndef SIGIO - /* First check for C-g if necessary */ - event_stream_quit_p (); -#endif #endif - - /* This function used to simply check whether there were any X - events (or if user_p was 1, it iterated over all the pending - X events using XCheckIfEvent(), looking for keystrokes and - button events). That worked in the old cheesoid event loop, - which didn't go through XtAppDispatchEvent(), but it doesn't - work any more -- X events may not result in anything. For - example, a button press in a blank part of the menubar appears - as an X event but will not result in any Emacs events (a - button press that activates the menubar results in an Emacs - event through the stop_next_event mechanism). - - The only accurate way of determining whether these X events - translate into Emacs events is to go ahead and dispatch them - until there's something on the dispatch queue. */ - - /* See if there are any user events already on the queue. */ - EVENT_CHAIN_LOOP (event, dispatch_event_queue) - if (!user_p || command_event_p (event)) - return 1; - - /* See if there's any TTY input available. - */ - if (poll_fds_for_input (tty_only_mask)) - return 1; - - if (!user_p) - { - /* If not user_p and there are any timer or file-desc events - pending, we know there will be an event so we're through. */ - XtInputMask pending_value; - - /* Note that formerly we just checked the value of XtAppPending() - to determine if there was file-desc input. This doesn't - work any more with the signal_event_pipe; XtAppPending() - will says "yes" in this case but there isn't really any - input. Another way of fixing this problem is for the - signal_event_pipe to generate actual input in the form - of an identity eval event or something. (#### maybe this - actually happens?) */ - - if (poll_fds_for_input (process_only_mask)) - return 1; - - pending_value = XtAppPending (Xt_app_con); - - if (pending_value & XtIMTimer) - return 1; - } - - /* XtAppPending() can be super-slow, esp. over a network connection. - Quantify results have indicated that in some cases the call to - detect_input_pending() completely dominates the running time of - redisplay(). Fortunately, in a SIGIO world we can more quickly - determine whether there are any X events: if an event has - happened since the last time we checked, then a SIGIO will have - happened. On a machine with broken SIGIO, we'll still be in an - OK state -- quit_check_signal_tick_count will get ticked at least - every 1/4 second, so we'll be no more than that much behind - reality. (In general it's OK if we erroneously report no input - pending when input is actually pending() -- preemption is just a - bit less efficient, that's all. It's bad bad bad if you err the - other way -- you've promised that `next-event' won't block but it - actually will, and some action might get delayed until the next - time you hit a key.) - */ - - /* quit_check_signal_tick_count is volatile so try to avoid race conditions - by using a temporary variable */ - tick_count_val = quit_check_signal_tick_count; - if (last_quit_check_signal_tick_count != tick_count_val -#if !defined (SIGIO) || defined (CYGWIN) - || (XtIMXEvent & XtAppPending (Xt_app_con)) -#endif - ) - { - last_quit_check_signal_tick_count = tick_count_val; - - /* We need to drain the entire queue now -- if we only - drain part of it, we may later on end up with events - actually pending but detect_input_pending() returning - false because there wasn't another SIGIO. */ - emacs_Xt_drain_queue (); - - EVENT_CHAIN_LOOP (event, dispatch_event_queue) - if (!user_p || command_event_p (event)) - return 1; - } - - return 0; } int
--- a/src/event-gtk.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/event-gtk.c Fri Feb 07 11:50:54 2003 +0000 @@ -1,7 +1,7 @@ /* The event_stream interface for X11 with gtk, and/or tty frames. Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2001, 2002 Ben Wing. + Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. Copyright (C) 2000 William Perry. This file is part of XEmacs. @@ -93,6 +93,8 @@ || ((keysym) == GDK_Mode_switch) \ || ((keysym) == GDK_Num_Lock)) +#define THIS_IS_GTK +#include "event-xlike-inc.c" /************************************************************************/ @@ -1556,120 +1558,9 @@ while (gdk_events_pending ()) gtk_main_iteration (); +#ifdef HAVE_TTY drain_tty_devices (); -} - -static int -emacs_gtk_event_pending_p (int user_p) -{ - Lisp_Object event; - int tick_count_val; - - /* If `user_p' is false, then this function returns whether there are any - X, timeout, or fd events pending (that is, whether emacs_gtk_next_event() - would return immediately without blocking). - - if `user_p' is true, then this function returns whether there are any - *user generated* events available (that is, whether there are keyboard - or mouse-click events ready to be read). This also implies that - emacs_Xt_next_event() would not block. - - In a non-SIGIO world, this also checks whether the user has typed ^G, - since this is a convenient place to do so. We don't need to do this - in a SIGIO world, since input causes an interrupt. - */ - - /* This function used to simply check whether there were any X - events (or if user_p was 1, it iterated over all the pending - X events using XCheckIfEvent(), looking for keystrokes and - button events). That worked in the old cheesoid event loop, - which didn't go through XtAppDispatchEvent(), but it doesn't - work any more -- X events may not result in anything. For - example, a button press in a blank part of the menubar appears - as an X event but will not result in any Emacs events (a - button press that activates the menubar results in an Emacs - event through the stop_next_event mechanism). - - The only accurate way of determining whether these X events - translate into Emacs events is to go ahead and dispatch them - until there's something on the dispatch queue. */ - - /* See if there are any user events already on the queue. */ - EVENT_CHAIN_LOOP (event, dispatch_event_queue) - if (!user_p || command_event_p (event)) - return 1; - - /* See if there's any TTY input available. - */ - if (poll_fds_for_input (tty_only_mask)) - return 1; - - if (!user_p) - { - /* If not user_p and there are any timer or file-desc events - pending, we know there will be an event so we're through. */ -/* XtInputMask pending_value; */ - - /* Note that formerly we just checked the value of XtAppPending() - to determine if there was file-desc input. This doesn't - work any more with the signal_event_pipe; XtAppPending() - will says "yes" in this case but there isn't really any - input. Another way of fixing this problem is for the - signal_event_pipe to generate actual input in the form - of an identity eval event or something. (#### maybe this - actually happens?) */ - - if (poll_fds_for_input (process_only_mask)) - return 1; - - /* #### Is there any way to do this in Gtk? I don't think there - is a 'peek' for events */ -#if 0 - pending_value = XtAppPending (Xt_app_con); - - if (pending_value & XtIMTimer) - return 1; #endif - } - - /* XtAppPending() can be super-slow, esp. over a network connection. - Quantify results have indicated that in some cases the - call to detect_input_pending() completely dominates the - running time of redisplay(). Fortunately, in a SIGIO world - we can more quickly determine whether there are any X events: - if an event has happened since the last time we checked, then - a SIGIO will have happened. On a machine with broken SIGIO, - we'll still be in an OK state -- the sigio_happened flag - will get set at least once a second, so we'll be no more than - one second behind reality. (In general it's OK if we - erroneously report no input pending when input is actually - pending() -- preemption is just a bit less efficient, that's - all. It's bad bad bad if you err the other way -- you've - promised that `next-event' won't block but it actually will, - and some action might get delayed until the next time you - hit a key.) - */ - - /* quit_check_signal_tick_count is volatile so try to avoid race conditions - by using a temporary variable */ - tick_count_val = quit_check_signal_tick_count; - if (last_quit_check_signal_tick_count != tick_count_val) - { - last_quit_check_signal_tick_count = tick_count_val; - - /* We need to drain the entire queue now -- if we only - drain part of it, we may later on end up with events - actually pending but detect_input_pending() returning - false because there wasn't another SIGIO. */ - - emacs_gtk_drain_queue (); - - EVENT_CHAIN_LOOP (event, dispatch_event_queue) - if (!user_p || command_event_p (event)) - return 1; - } - - return 0; } static void
--- a/src/event-msw.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/event-msw.c Fri Feb 07 11:50:54 2003 +0000 @@ -1,7 +1,7 @@ /* The mswindows event_stream interface. Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1996, 2000, 2001, 2002 Ben Wing. + Copyright (C) 1996, 2000, 2001, 2002, 2003 Ben Wing. Copyright (C) 1997 Jonathan Harris. This file is part of XEmacs. @@ -169,7 +169,6 @@ /* This is the event signaled by the event pump. See mswindows_pump_outstanding_events for comments */ static int mswindows_error_caught_in_modal_loop; -static int mswindows_in_modal_loop; /* Count of wound timers */ static int mswindows_pending_timers_count; @@ -1129,43 +1128,6 @@ return !ascii_strcasecmp (class_name_buf, XEMACS_CLASS); } -struct mswindows_protect_modal_loop -{ - Lisp_Object (*bfun) (Lisp_Object barg); - Lisp_Object barg; -}; - -static Lisp_Object -mswindows_protect_modal_loop_1 (void *gack) -{ - struct mswindows_protect_modal_loop *gata = - (struct mswindows_protect_modal_loop *) gack; - - return (gata->bfun) (gata->barg); -} - -Lisp_Object -mswindows_protect_modal_loop (const char *error_string, - Lisp_Object (*bfun) (Lisp_Object barg), - Lisp_Object barg, int flags) -{ - Lisp_Object tmp; - struct mswindows_protect_modal_loop bluh; - - bluh.bfun = bfun; - bluh.barg = barg; - - ++mswindows_in_modal_loop; - tmp = call_trapping_problems (Qevent, error_string, - flags, 0, - mswindows_protect_modal_loop_1, &bluh); - if (UNBOUNDP (tmp)) - mswindows_error_caught_in_modal_loop = 1; - --mswindows_in_modal_loop; - - return tmp; -} - void mswindows_unmodalize_signal_maybe (void) { @@ -1177,7 +1139,7 @@ * condition_case. See mswindows_pump_outstanding_events */ static Lisp_Object -mswindows_unsafe_pump_events (Lisp_Object u_n_u_s_e_d) +mswindows_unsafe_pump_events (void *arg) { /* This function can call lisp */ Lisp_Object event = Fmake_event (Qnil, Qnil); @@ -1185,7 +1147,7 @@ int do_redisplay = 0; GCPRO1 (event); - while (detect_input_pending ()) + while (detect_input_pending (1)) { Fnext_event (event, Qnil); Fdispatch_event (event); @@ -1212,7 +1174,7 @@ * neither are waitable handles checked. The function pumps * thus only dispatch events already queued, as well as those * resulted in dispatching thereof. This is done by setting - * module local variable mswindows_in_modal_loop to nonzero. + * in_modal_loop to nonzero. * * Return value is Qt if no errors was trapped, or Qunbound if * there was an error. @@ -1244,88 +1206,15 @@ GCPRO1 (result); if (!mswindows_error_caught_in_modal_loop) - result = mswindows_protect_modal_loop - ("Error during event handling", mswindows_unsafe_pump_events, Qnil, 0); + result = event_stream_protect_modal_loop + ("Error during event handling", mswindows_unsafe_pump_events, 0, 0); UNGCPRO; + if (UNBOUNDP (result)) + mswindows_error_caught_in_modal_loop = 1; return result; } /* - * KEYBOARD_ONLY_P is set to non-zero when we are called from - * QUITP, and are interesting in keyboard messages only. - */ -static void -mswindows_drain_windows_queue (void) -{ - MSG msg; - - /* should call mswindows_need_event_in_modal_loop() if in modal loop */ - assert (!mswindows_in_modal_loop); - - while (qxePeekMessage (&msg, NULL, 0, 0, PM_REMOVE)) - { -#ifdef HAVE_DIALOGS - /* Don't translate messages destined for a dialog box, this - makes keyboard traversal work. I think?? */ - if (mswindows_is_dialog_msg (&msg)) - { - mswindows_unmodalize_signal_maybe (); - continue; - } -#endif /* HAVE_DIALOGS */ - - /* We have to translate messages that are not sent to an XEmacs - frame. This is so that key presses work ok in things like - edit fields. However, we *musn't* translate message for XEmacs - frames as this is handled in the wnd proc. - We also have to avoid generating paint magic events for windows - that aren't XEmacs frames */ - - if (!mswindows_window_is_xemacs (msg.hwnd)) - TranslateMessage (&msg); - else if (msg.message == WM_PAINT) - { - struct mswindows_frame *msframe; - - /* hdc will be NULL unless this is a subwindow - in which case we - shouldn't have received a paint message for it here. */ - assert (msg.wParam == 0); - - /* Queue a magic event for handling when safe */ - msframe = - FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (msg.hwnd))); - if (!msframe->paint_pending) - { - msframe->paint_pending = 1; - mswindows_enqueue_magic_event (msg.hwnd, WM_PAINT); - } - /* Don't dispatch. WM_PAINT is always the last message in the - queue so it's OK to just return. */ - return; - } - qxeDispatchMessage (&msg); - mswindows_unmodalize_signal_maybe (); - } -} - -static void -emacs_mswindows_drain_queue (void) -{ - mswindows_drain_windows_queue (); -#ifdef HAVE_TTY - drain_tty_devices (); -#endif -} - -static int -emacs_mswindows_quit_check_disallowed_p (void) -{ - /* Quit cannot happen in modal loop: all program - input is dedicated to Windows. */ - return mswindows_in_modal_loop; -} - -/* * This is a special flavor of the mswindows_need_event function, * used while in event pump. Actually, there is only kind of events * allowed while in event pump: a timer. An attempt to fetch any @@ -1371,6 +1260,73 @@ } } +/* BADLY_P non-zero means we were called from mswindows_need_event(1). It + only matters when we are in a modal loop, and causes us to fetch timer + events (the only kinds we can fetch in such a case). + */ +static void +mswindows_drain_windows_queue (int badly_p) +{ + MSG msg; + + if (in_modal_loop) + mswindows_need_event_in_modal_loop (badly_p); + else + while (qxePeekMessage (&msg, NULL, 0, 0, PM_REMOVE)) + { +#ifdef HAVE_DIALOGS + /* Don't translate messages destined for a dialog box, this + makes keyboard traversal work. I think?? */ + if (mswindows_is_dialog_msg (&msg)) + { + mswindows_unmodalize_signal_maybe (); + continue; + } +#endif /* HAVE_DIALOGS */ + + /* We have to translate messages that are not sent to an XEmacs + frame. This is so that key presses work ok in things like + edit fields. However, we *musn't* translate message for XEmacs + frames as this is handled in the wnd proc. + We also have to avoid generating paint magic events for windows + that aren't XEmacs frames */ + + if (!mswindows_window_is_xemacs (msg.hwnd)) + TranslateMessage (&msg); + else if (msg.message == WM_PAINT) + { + struct mswindows_frame *msframe; + + /* hdc will be NULL unless this is a subwindow - in which case we + shouldn't have received a paint message for it here. */ + assert (msg.wParam == 0); + + /* Queue a magic event for handling when safe */ + msframe = + FRAME_MSWINDOWS_DATA (XFRAME (mswindows_find_frame (msg.hwnd))); + if (!msframe->paint_pending) + { + msframe->paint_pending = 1; + mswindows_enqueue_magic_event (msg.hwnd, WM_PAINT); + } + /* Don't dispatch. WM_PAINT is always the last message in the + queue so it's OK to just return. */ + return; + } + qxeDispatchMessage (&msg); + mswindows_unmodalize_signal_maybe (); + } +} + +static void +emacs_mswindows_drain_queue (void) +{ + mswindows_drain_windows_queue (0); +#ifdef HAVE_TTY + drain_tty_devices (); +#endif +} + /* * This drains the event queue and fills up two internal queues until * an event of a type specified by USER_P is retrieved. @@ -1398,7 +1354,7 @@ EMACS_SET_SECS_USECS (sometime, 0, 0); EMACS_TIME_TO_SELECT_TIME (sometime, select_time_to_block); pointer_to_this = &select_time_to_block; - if (mswindows_in_modal_loop) + if (in_modal_loop) /* In modal loop with badly_p false, don't care about Windows events. */ FD_CLR (windows_fd, &temp_mask); @@ -1414,12 +1370,7 @@ else if (active > 0) { if (FD_ISSET (windows_fd, &temp_mask)) - { - if (mswindows_in_modal_loop) - mswindows_need_event_in_modal_loop (badly_p); - else - mswindows_drain_windows_queue (); - } + mswindows_drain_windows_queue (badly_p); else { #ifdef HAVE_TTY @@ -1486,7 +1437,7 @@ /* Now try getting a message or process event */ DWORD active; DWORD what_events; - if (mswindows_in_modal_loop) + if (in_modal_loop) /* In a modal loop, only look for timer events, and only if we really need one. */ { @@ -1607,13 +1558,7 @@ return; } else if (active == WAIT_OBJECT_0 + mswindows_waitable_count) - { - /* Got your message, thanks */ - if (mswindows_in_modal_loop) - mswindows_need_event_in_modal_loop (badly_p); - else - mswindows_drain_windows_queue (); - } + mswindows_drain_windows_queue (badly_p); else { int ix = active - WAIT_OBJECT_0; @@ -4384,11 +4329,32 @@ * emacs_mswindows_next_event() would not block. */ static int -emacs_mswindows_event_pending_p (int user_p) +emacs_mswindows_event_pending_p (int how_many) { - mswindows_need_event (0); - return (!NILP (dispatch_event_queue) - || (!user_p && !NILP (mswindows_s_dispatch_event_queue))); + if (!how_many) + { + mswindows_need_event (0); + return (!NILP (dispatch_event_queue) + || !NILP (mswindows_s_dispatch_event_queue)); + } + else + { + Lisp_Object event; + int count = 0; + + EVENT_CHAIN_LOOP (event, dispatch_event_queue) + count++; + + if (count >= how_many) + return 1; + + emacs_mswindows_drain_queue (); + + EVENT_CHAIN_LOOP (event, dispatch_event_queue) + count++; + + return count >= how_many; + } } /* @@ -5145,7 +5111,6 @@ void reinit_vars_of_event_mswindows (void) { - mswindows_in_modal_loop = 0; mswindows_pending_timers_count = 0; mswindows_event_stream = xnew_and_zero (struct event_stream); @@ -5159,7 +5124,6 @@ mswindows_event_stream->add_timeout_cb = emacs_mswindows_add_timeout; mswindows_event_stream->remove_timeout_cb = emacs_mswindows_remove_timeout; mswindows_event_stream->drain_queue_cb = emacs_mswindows_drain_queue; - mswindows_event_stream->quit_check_disallowed_p_cb = emacs_mswindows_quit_check_disallowed_p; mswindows_event_stream->select_console_cb = emacs_mswindows_select_console; mswindows_event_stream->unselect_console_cb = emacs_mswindows_unselect_console; mswindows_event_stream->select_process_cb = emacs_mswindows_select_process;
--- a/src/event-stream.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/event-stream.c Fri Feb 07 11:50:54 2003 +0000 @@ -2,7 +2,7 @@ Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing. This file is part of XEmacs. @@ -140,11 +140,6 @@ do not execute it; call disabled-command-hook's value instead. */ Lisp_Object Qdisabled; -EXFUN (Fnext_command_event, 2); - -static void pre_command_hook (void); -static void post_command_hook (void); - /* Last keyboard or mouse input event read as a command. */ Lisp_Object Vlast_command_event; @@ -249,8 +244,10 @@ Lisp_Object Qself_insert_defer_undo; -/* this is in keymap.c */ -extern Lisp_Object Fmake_keymap (Lisp_Object name); +int in_modal_loop; + +/* the number of keyboard characters read. callint.c wants this. */ +Charcount num_input_chars; #ifdef DEBUG_XEMACS Fixnum debug_emacs_events; @@ -276,14 +273,17 @@ /* The callback routines for the window system or terminal driver */ struct event_stream *event_stream; -static void echo_key_event (struct command_builder *, Lisp_Object event); -static void maybe_kbd_translate (Lisp_Object event); - /* There are two event queues here -- the command event queue (#### which should be called "deferred event queue" and is in my glyph ws) and the - dispatch event queue (#### MS Windows actually has an extra dispatch - queue for non-user events and uses the generic one only for user events; - we should probably generalize this). + dispatch event queue. (MS Windows actually has an extra dispatch + queue for non-user events and uses the generic one only for user events. + This is because user and non-user events in Windows come through the + same place -- the window procedure -- but under X, it's possible to + selectively process events such that we take all the user events before + the non-user ones. #### In fact, given the way we now drain the queue, + we might need two separate queues, like under Windows. Need to think + carefully exactly how this works, and should certainly generalize the + two different queues. The dispatch queue (which used to occur duplicated inside of each event implementation) is used for events that have been read from the @@ -343,8 +343,16 @@ are not allowed to recursively call these routines. We record here if we are in that situation. */ -static Lisp_Object recursive_sit_for; - +static int recursive_sit_for; + +static void pre_command_hook (void); +static void post_command_hook (void); +static void maybe_kbd_translate (Lisp_Object event); +static void push_this_command_keys (Lisp_Object event); +static void push_recent_keys (Lisp_Object event); +static void dribble_out_event (Lisp_Object event); +static void execute_internal_event (Lisp_Object event); +static int is_scrollbar_event (Lisp_Object event); /**********************************************************************/ @@ -513,17 +521,8 @@ /* Low-level interfaces onto event methods */ /**********************************************************************/ -enum event_stream_operation -{ - EVENT_STREAM_PROCESS, - EVENT_STREAM_TIMEOUT, - EVENT_STREAM_CONSOLE, - EVENT_STREAM_READ, - EVENT_STREAM_NOTHING, -}; - static void -check_event_stream_ok (enum event_stream_operation op) +check_event_stream_ok (void) { if (!event_stream && noninteractive) /* See comment in init_event_stream() */ @@ -531,147 +530,52 @@ else assert (event_stream); } -static int -event_stream_event_pending_p (int user) -{ - /* #### Hmmm ... There may be some duplication in "drain queue" and - "event pending". Couldn't we just drain the queue and see what's in - it, and not maybe need a separate event method for this? Would this - work when USER is 0? Maybe this would be slow? */ - return event_stream && event_stream->event_pending_p (user); -} - -static void -event_stream_force_event_pending (struct frame *f) -{ - if (event_stream->force_event_pending_cb) - event_stream->force_event_pending_cb (f); -} - -static int -maybe_read_quit_event (Lisp_Event *event) -{ - /* A C-g that came from `sigint_happened' will always come from the - controlling terminal. If that doesn't exist, however, then the - user manually sent us a SIGINT, and we pretend the C-g came from - the selected console. */ - struct console *con; - - if (CONSOLEP (Vcontrolling_terminal) && - CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal))) - con = XCONSOLE (Vcontrolling_terminal); - else - con = XCONSOLE (Fselected_console ()); - - if (sigint_happened) - { - sigint_happened = 0; - Vquit_flag = Qnil; - Fcopy_event (CONSOLE_QUIT_EVENT (con), wrap_event (event)); - return 1; - } - return 0; -} - -static void -event_stream_next_event (Lisp_Event *event) -{ - Lisp_Object event_obj; - - check_event_stream_ok (EVENT_STREAM_READ); - - event_obj = wrap_event (event); - zero_event (event); - /* SIGINT occurs when C-g was pressed on a TTY. (SIGINT might have - been sent manually by the user, but we don't care; we treat it - the same.) - - The SIGINT signal handler sets Vquit_flag as well as sigint_happened - and write a byte on our "fake pipe", which unblocks us when we are - waiting for an event. */ - - /* If SIGINT was received after we disabled quit checking (because - we want to read C-g's as characters), but before we got a chance - to start reading, notice it now and treat it as a character to be - read. If above callers wanted this to be QUIT, they can - determine this by comparing the event against quit-char. */ - - if (maybe_read_quit_event (event)) - { - DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj); - return; - } - - /* If a longjmp() happens in the callback, we're screwed. - Let's hope it doesn't. I think the code here is fairly - clean and doesn't do this. */ - emacs_is_blocking = 1; - event_stream->next_event_cb (event); - emacs_is_blocking = 0; - - /* Now check to see if C-g was pressed while we were blocking. - We treat it as an event, just like above. */ - if (maybe_read_quit_event (event)) - { - DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj); - return; - } - -#ifdef DEBUG_XEMACS - /* timeout events have more info set later, so - print the event out in next_event_internal(). */ - if (event->event_type != timeout_event) - DEBUG_PRINT_EMACS_EVENT ("real", event_obj); -#endif - maybe_kbd_translate (event_obj); -} - void event_stream_handle_magic_event (Lisp_Event *event) { - check_event_stream_ok (EVENT_STREAM_READ); + check_event_stream_ok (); event_stream->handle_magic_event_cb (event); } void event_stream_format_magic_event (Lisp_Event *event, Lisp_Object pstream) { - check_event_stream_ok (EVENT_STREAM_NOTHING); + check_event_stream_ok (); event_stream->format_magic_event_cb (event, pstream); } int event_stream_compare_magic_event (Lisp_Event *e1, Lisp_Event *e2) { - check_event_stream_ok (EVENT_STREAM_NOTHING); + check_event_stream_ok (); return event_stream->compare_magic_event_cb (e1, e2); } Hashcode event_stream_hash_magic_event (Lisp_Event *e) { - check_event_stream_ok (EVENT_STREAM_NOTHING); + check_event_stream_ok (); return event_stream->hash_magic_event_cb (e); } static int event_stream_add_timeout (EMACS_TIME timeout) { - check_event_stream_ok (EVENT_STREAM_TIMEOUT); + check_event_stream_ok (); return event_stream->add_timeout_cb (timeout); } static void event_stream_remove_timeout (int id) { - check_event_stream_ok (EVENT_STREAM_TIMEOUT); + check_event_stream_ok (); event_stream->remove_timeout_cb (id); } void event_stream_select_console (struct console *con) { - check_event_stream_ok (EVENT_STREAM_CONSOLE); + check_event_stream_ok (); if (!con->input_enabled) { event_stream->select_console_cb (con); @@ -682,7 +586,7 @@ void event_stream_unselect_console (struct console *con) { - check_event_stream_ok (EVENT_STREAM_CONSOLE); + check_event_stream_ok (); if (con->input_enabled) { event_stream->unselect_console_cb (con); @@ -695,7 +599,7 @@ { int cur_in, cur_err; - check_event_stream_ok (EVENT_STREAM_PROCESS); + check_event_stream_ok (); cur_in = get_process_selected_p (proc, 0); if (cur_in) @@ -725,7 +629,7 @@ { int cur_in, cur_err; - check_event_stream_ok (EVENT_STREAM_PROCESS); + check_event_stream_ok (); cur_in = get_process_selected_p (proc, 0); if (!cur_in) @@ -759,7 +663,7 @@ USID *err_usid, int flags) { - check_event_stream_ok (EVENT_STREAM_PROCESS); + check_event_stream_ok (); event_stream->create_io_streams_cb (inhandle, outhandle, errhandle, instream, outstream, errstream, in_usid, err_usid, flags); @@ -772,72 +676,11 @@ USID *in_usid, USID *err_usid) { - check_event_stream_ok (EVENT_STREAM_PROCESS); + check_event_stream_ok (); event_stream->delete_io_streams_cb (instream, outstream, errstream, in_usid, err_usid); } -static void -event_stream_drain_queue (void) -{ - if (event_stream && event_stream->drain_queue_cb) - event_stream->drain_queue_cb (); -} - -struct remove_quit_p_data -{ - int critical; -}; - -static int -remove_quit_p_event (Lisp_Object ev, void *the_data) -{ - struct remove_quit_p_data *data = (struct remove_quit_p_data *) the_data; - struct console *con = event_console_or_selected (ev); - - if (XEVENT_TYPE (ev) == key_press_event) - { - if (event_matches_key_specifier_p (ev, CONSOLE_QUIT_EVENT (con))) - return 1; - if (event_matches_key_specifier_p (ev, - CONSOLE_CRITICAL_QUIT_EVENT (con))) - { - data->critical = 1; - return 1; - } - } - - return 0; -} - -static int -event_stream_quit_check_disallowed_p (void) -{ - if (event_stream && event_stream->quit_check_disallowed_p_cb) - return event_stream->quit_check_disallowed_p_cb (); - else - return 0; -} - -void -event_stream_quit_p (void) -{ - struct remove_quit_p_data data; - - if (event_stream_quit_check_disallowed_p ()) - return; - - /* Drain queue so we can check for pending C-g events. */ - event_stream_drain_queue (); - data.critical = 0; - - if (map_event_chain_remove (remove_quit_p_event, - &dispatch_event_queue, - &dispatch_event_queue_tail, - &data, MECR_DEALLOCATE_EVENT)) - Vquit_flag = data.critical ? Qcritical : Qt; -} - static int event_stream_current_event_timestamp (struct console *c) { @@ -963,80 +806,6 @@ /* random junk */ /**********************************************************************/ -static void -maybe_kbd_translate (Lisp_Object event) -{ - Ichar c; - int did_translate = 0; - - if (XEVENT_TYPE (event) != key_press_event) - return; - if (!HASH_TABLEP (Vkeyboard_translate_table)) - return; - if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero)) - return; - - c = event_to_character (event, 0, 0, 0); - if (c != -1) - { - Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table, - Qnil); - if (!NILP (traduit) && SYMBOLP (traduit)) - { - XSET_EVENT_KEY_KEYSYM (event, traduit); - XSET_EVENT_KEY_MODIFIERS (event, 0); - did_translate = 1; - } - else if (CHARP (traduit)) - { - /* This used to call Fcharacter_to_event() directly into EVENT, - but that can eradicate timestamps and other such stuff. - This way is safer. */ - Lisp_Object ev2 = Fmake_event (Qnil, Qnil); - - character_to_event (XCHAR (traduit), XEVENT (ev2), - XCONSOLE (XEVENT_CHANNEL (event)), 0, 1); - XSET_EVENT_KEY_KEYSYM (event, XEVENT_KEY_KEYSYM (ev2)); - XSET_EVENT_KEY_MODIFIERS (event, XEVENT_KEY_MODIFIERS (ev2)); - Fdeallocate_event (ev2); - did_translate = 1; - } - } - - if (!did_translate) - { - Lisp_Object traduit = Fgethash (XEVENT_KEY_KEYSYM (event), - Vkeyboard_translate_table, Qnil); - if (!NILP (traduit) && SYMBOLP (traduit)) - { - XSET_EVENT_KEY_KEYSYM (event, traduit); - did_translate = 1; - } - else if (CHARP (traduit)) - { - /* This used to call Fcharacter_to_event() directly into EVENT, - but that can eradicate timestamps and other such stuff. - This way is safer. */ - Lisp_Object ev2 = Fmake_event (Qnil, Qnil); - - character_to_event (XCHAR (traduit), XEVENT (ev2), - XCONSOLE (XEVENT_CHANNEL (event)), 0, 1); - XSET_EVENT_KEY_KEYSYM (event, XEVENT_KEY_KEYSYM (ev2)); - XSET_EVENT_KEY_MODIFIERS (event, - XEVENT_KEY_MODIFIERS (event) | - XEVENT_KEY_MODIFIERS (ev2)); - - Fdeallocate_event (ev2); - did_translate = 1; - } - } - -#ifdef DEBUG_XEMACS - if (did_translate) - DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event); -#endif -} - /* NB: The following auto-save stuff is in keyboard.c in FSFmacs, and keystrokes_since_auto_save is equivalent to the difference between num_nonmacro_input_chars and last_auto_save. */ @@ -1065,7 +834,7 @@ keystrokes_since_auto_save++; if (auto_save_interval > 0 && keystrokes_since_auto_save > max (auto_save_interval, 20) && - !detect_input_pending ()) + !detect_input_pending (1)) { Fdo_auto_save (Qnil, Qnil); record_auto_save (); @@ -1136,45 +905,6 @@ /**********************************************************************/ -/* input pending */ -/**********************************************************************/ - -int -detect_input_pending (void) -{ - /* Always call the event_pending_p hook even if there's an unread - character, because that might do some needed ^G detection (on - systems without SIGIO, for example). - */ - if (event_stream_event_pending_p (1)) - return 1; - if (!NILP (Vunread_command_events) || !NILP (Vunread_command_event)) - return 1; - if (!NILP (command_event_queue)) - { - Lisp_Object event; - - EVENT_CHAIN_LOOP (event, command_event_queue) - { - if (XEVENT_TYPE (event) != eval_event - && XEVENT_TYPE (event) != magic_eval_event) - return 1; - } - } - return 0; -} - -DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /* -Return 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; -} - - -/**********************************************************************/ /* timeouts */ /**********************************************************************/ @@ -2121,6 +1851,165 @@ /**********************************************************************/ +/* input pending/quit checking */ +/**********************************************************************/ + +/* If HOW_MANY is 0, return true if there are any user or non-user events + pending. If HOW_MANY is > 0, return true if there are that many *user* + events pending, irrespective of non-user events. */ + +static int +event_stream_event_pending_p (int how_many) +{ + /* #### Hmmm ... There may be some duplication in "drain queue" and + "event pending". Couldn't we just drain the queue and see what's in + it, and not maybe need a separate event method for this? Would this + work when HOW_MANY is 0? Maybe this would be slow? */ + return event_stream && event_stream->event_pending_p (how_many); +} + +static void +event_stream_force_event_pending (struct frame *f) +{ + if (event_stream->force_event_pending_cb) + event_stream->force_event_pending_cb (f); +} + +void +event_stream_drain_queue (void) +{ + if (event_stream && event_stream->drain_queue_cb) + event_stream->drain_queue_cb (); +} + +/* Return non-zero if at least HOW_MANY user events are pending. */ +int +detect_input_pending (int how_many) +{ + Lisp_Object event; + + if (!NILP (Vunread_command_event)) + how_many--; + + how_many -= XINT (Fsafe_length (Vunread_command_events)); + + if (how_many <= 0) + return 1; + + EVENT_CHAIN_LOOP (event, command_event_queue) + { + if (XEVENT_TYPE (event) != eval_event + && XEVENT_TYPE (event) != magic_eval_event) + { + how_many--; + if (how_many <= 0) + return 1; + } + } + + return event_stream_event_pending_p (how_many); +} + +DEFUN ("input-pending-p", Finput_pending_p, 0, 0, 0, /* +Return 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 (1) ? Qt : Qnil; +} + +static int +maybe_read_quit_event (Lisp_Event *event) +{ + /* A C-g that came from `sigint_happened' will always come from the + controlling terminal. If that doesn't exist, however, then the + user manually sent us a SIGINT, and we pretend the C-g came from + the selected console. */ + struct console *con; + + if (CONSOLEP (Vcontrolling_terminal) && + CONSOLE_LIVE_P (XCONSOLE (Vcontrolling_terminal))) + con = XCONSOLE (Vcontrolling_terminal); + else + con = XCONSOLE (Fselected_console ()); + + if (sigint_happened) + { + sigint_happened = 0; + Vquit_flag = Qnil; + Fcopy_event (CONSOLE_QUIT_EVENT (con), wrap_event (event)); + return 1; + } + return 0; +} + +struct remove_quit_p_data +{ + int critical; +}; + +static int +remove_quit_p_event (Lisp_Object ev, void *the_data) +{ + struct remove_quit_p_data *data = (struct remove_quit_p_data *) the_data; + struct console *con = event_console_or_selected (ev); + + if (XEVENT_TYPE (ev) == key_press_event) + { + if (event_matches_key_specifier_p (ev, CONSOLE_QUIT_EVENT (con))) + return 1; + if (event_matches_key_specifier_p (ev, + CONSOLE_CRITICAL_QUIT_EVENT (con))) + { + data->critical = 1; + return 1; + } + } + + return 0; +} + +void +event_stream_quit_p (void) +{ + struct remove_quit_p_data data; + + /* Quit checking cannot happen in modal loop. Because it attempts to + retrieve and dispatch events, it will cause lots of problems if we try + to do this when already in the process of doing this -- deadlocking + under Windows, crashes in lwlib etc. under X due to non-reentrant + code. This is automatically caught, however, in + event_stream_drain_queue() (checks for in_modal_loop in the + event-specific code). */ + + /* Drain queue so we can check for pending C-g events. */ + event_stream_drain_queue (); + data.critical = 0; + + if (map_event_chain_remove (remove_quit_p_event, + &dispatch_event_queue, + &dispatch_event_queue_tail, + &data, MECR_DEALLOCATE_EVENT)) + Vquit_flag = data.critical ? Qcritical : Qt; +} + +Lisp_Object +event_stream_protect_modal_loop (const char *error_string, + Lisp_Object (*bfun) (void *barg), + void *barg, int flags) +{ + Lisp_Object tmp; + + ++in_modal_loop; + tmp = call_trapping_problems (Qevent, error_string, flags, 0, bfun, barg); + --in_modal_loop; + + return tmp; +} + + +/**********************************************************************/ /* retrieving the next event */ /**********************************************************************/ @@ -2145,8 +2034,58 @@ return in_single_console; } -/* the number of keyboard characters read. callint.c wants this. */ -Charcount num_input_chars; +static void +event_stream_next_event (Lisp_Event *event) +{ + Lisp_Object event_obj; + + check_event_stream_ok (); + + event_obj = wrap_event (event); + zero_event (event); + /* SIGINT occurs when C-g was pressed on a TTY. (SIGINT might have + been sent manually by the user, but we don't care; we treat it + the same.) + + The SIGINT signal handler sets Vquit_flag as well as sigint_happened + and write a byte on our "fake pipe", which unblocks us when we are + waiting for an event. */ + + /* If SIGINT was received after we disabled quit checking (because + we want to read C-g's as characters), but before we got a chance + to start reading, notice it now and treat it as a character to be + read. If above callers wanted this to be QUIT, they can + determine this by comparing the event against quit-char. */ + + if (maybe_read_quit_event (event)) + { + DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj); + return; + } + + /* If a longjmp() happens in the callback, we're screwed. + Let's hope it doesn't. I think the code here is fairly + clean and doesn't do this. */ + emacs_is_blocking = 1; + event_stream->next_event_cb (event); + emacs_is_blocking = 0; + + /* Now check to see if C-g was pressed while we were blocking. + We treat it as an event, just like above. */ + if (maybe_read_quit_event (event)) + { + DEBUG_PRINT_EMACS_EVENT ("SIGINT", event_obj); + return; + } + +#ifdef DEBUG_XEMACS + /* timeout events have more info set later, so + print the event out in next_event_internal(). */ + if (event->event_type != timeout_event) + DEBUG_PRINT_EMACS_EVENT ("real", event_obj); +#endif + maybe_kbd_translate (event_obj); +} /* Read an event from the window system (or tty). If ALLOW_QUEUED is non-zero, read from the command-event queue first. @@ -2225,18 +2164,15 @@ run_pre_idle_hook (void) { if (!NILP (Vpre_idle_hook) - && !detect_input_pending ()) + && !detect_input_pending (1)) safe_run_hook_trapping_problems ("Error in `pre-idle-hook' (setting hook to nil)", - Qpre_idle_hook, INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION); + Qpre_idle_hook, + /* Quit is inhibited as a result of being within next-event so + we need to fix that. */ + INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION | UNINHIBIT_QUIT); } -static void push_this_command_keys (Lisp_Object event); -static void push_recent_keys (Lisp_Object event); -static void dribble_out_event (Lisp_Object event); -static void execute_internal_event (Lisp_Object event); -static int is_scrollbar_event (Lisp_Object event); - DEFUN ("next-event", Fnext_event, 0, 2, 0, /* Return the next available event. Pass this object to `dispatch-event' to handle it. @@ -2295,23 +2231,25 @@ GCPRO1 (event); + /* This is not strictly necessary. Trying to retrieve an event inside of + a modal loop can cause major problems (see event_stream_quit_p()), but + the event-specific code knows about this and will make sure we don't + do anything dangerous. However, if we've gotten here, it's highly + likely that some code is trying to fetch user events (e.g. in custom + dialog-box code), and will almost certainly deadlock, so it's probably + best to error out. #### This could cause problems because there are + (potentially, at least) legitimate reasons for calling next-event + inside of a modal loop, in particular if the code is trying to search + for a timeout event, which will still get retrieved in such a case. + However, the code to error in such a case has already been present for + a long time without obvious problems so leaving it in isn't so + bad. --ben */ + if (in_modal_loop) + invalid_operation ("Attempt to call next-event inside modal loop", + Qunbound); + depth = begin_dont_check_for_quit (); -#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) - invalid_operation ("Attempt to call next-event inside menu callback", - Qunbound); -#endif /* LWLIB_MENUBARS_LUCID */ - if (NILP (event)) event = Fmake_event (Qnil, Qnil); else @@ -2642,6 +2580,12 @@ deallocate_event_chain (event); } +static int +command_event_p_cb (Lisp_Object ev, void *the_data) +{ + return command_event_p (ev); +} + DEFUN ("discard-input", Fdiscard_input, 0, 0, 0, /* Discard any pending "user" events. Also cancel any kbd macro being defined. @@ -2650,84 +2594,31 @@ */ ()) { - /* This throws away user-input on the queue, but doesn't process any - events. Calling dispatch_event() here leads to a race condition. - */ - Lisp_Object event = Fmake_event (Qnil, Qnil); - Lisp_Object head = Qnil, tail = Qnil; - struct gcpro gcpro1; - /* #### not correct here with Vselected_console? Should - discard-input take a console argument, or maybe map over - all consoles? */ - struct console *con = XCONSOLE (Vselected_console); - - /* next_event_internal() can cause arbitrary Lisp code to be evalled */ - GCPRO1 (event); - /* If a macro was being defined then we have to mark the modeline - has changed to ensure that it gets updated correctly. */ - if (!NILP (con->defining_kbd_macro)) - MARK_MODELINE_CHANGED; - con->defining_kbd_macro = Qnil; - reset_current_events (XCOMMAND_BUILDER (con->command_builder)); - - while (!NILP (command_event_queue) - || event_stream_event_pending_p (1)) + Lisp_Object concons; + + CONSOLE_LOOP (concons) { - /* We want to ignore C-g's along with all other keypresses. */ - int depth = begin_dont_check_for_quit (); - /* 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); - /* The following comment used to be here: - - [[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 that C-g has been set and send us another C-g. That - will cause us to get right back here, and read another C-g, - ad infinitum ...]] - - but I don't think this is correct; maybe_read_quit_event() - checks and resets sigint_happened. It shouldn't matter if we - reset here or outside of the while loop. --ben */ - Vquit_flag = Qnil; /* see begin_dont_check_for_quit() */ - - unbind_to (depth); - - /* If the event is a user event, ignore it. */ - if (!command_event_p (event)) - { - /* Otherwise, chain the event onto our list of events not to ignore, - and keep reading until the queue is empty. This does not mean - that if a subprocess is generating an infinite amount of output, - we will never terminate (*provided* that the behavior of - next_event_cb() is correct -- see the comment in events.h), - because this loop ends as soon as there are no more user events - on the command_event_queue or event_stream. - */ - enqueue_event (Fcopy_event (event, Qnil), &head, &tail); - } + struct console *con = XCONSOLE (XCAR (concons)); + + /* If a macro was being defined then we have to mark the modeline + has changed to ensure that it gets updated correctly. */ + if (!NILP (con->defining_kbd_macro)) + MARK_MODELINE_CHANGED; + con->defining_kbd_macro = Qnil; + reset_current_events (XCOMMAND_BUILDER (con->command_builder)); } - if (!NILP (command_event_queue) || !NILP (command_event_queue_tail)) - abort (); - - /* Now tack our chain of events back on to the front of the queue. - Actually, since the queue is now drained, we can just replace it. - The effect of this will be that we have deleted all user events - from the input stream without changing the relative ordering of - any other events. (Some events may have been taken from the - event_stream and added to the command_event_queue, however.) - - At this time, the command_event_queue will contain only eval_events. - */ - - command_event_queue = head; - command_event_queue_tail = tail; - - Fdeallocate_event (event); - UNGCPRO; + /* This function used to be a lot more complicated. Now, we just + drain the pending queue and discard all user events from the + command and dispatch queues. */ + event_stream_drain_queue (); + + map_event_chain_remove (command_event_p_cb, + &dispatch_event_queue, &dispatch_event_queue_tail, + 0, MECR_DEALLOCATE_EVENT); + map_event_chain_remove (command_event_p_cb, + &command_event_queue, &command_event_queue_tail, + 0, MECR_DEALLOCATE_EVENT); return Qnil; } @@ -2739,8 +2630,8 @@ /* 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 + recursive_sit_for to 1, and use this unwind protect to reset it to + Qnil upon exit. When recursive_sit_for is 1, calling sit-for will cause it to return immediately. All of these routines install timeouts, so we clear the installed @@ -2757,7 +2648,7 @@ if (!NILP(timeout_id)) Fdisable_timeout (timeout_id); - recursive_sit_for = Qnil; + recursive_sit_for = 0; return Qnil; } @@ -2822,7 +2713,7 @@ count = specpdl_depth (); record_unwind_protect (sit_for_unwind, timeout_enabled ? make_int (timeout_id) : Qnil); - recursive_sit_for = Qt; + recursive_sit_for = 1; while (!done && ((NILP (process) && timeout_enabled) || @@ -2919,7 +2810,7 @@ count = specpdl_depth (); record_unwind_protect (sit_for_unwind, make_int (id)); - recursive_sit_for = Qt; + recursive_sit_for = 1; while (1) { @@ -3000,7 +2891,7 @@ return Qnil; /* Recursive call from a filter function or timeout handler. */ - if (!NILP (recursive_sit_for)) + if (recursive_sit_for) { if (!event_stream_event_pending_p (1) && NILP (nodisplay)) redisplay (); @@ -3025,7 +2916,7 @@ count = specpdl_depth (); record_unwind_protect (sit_for_unwind, make_int (id)); - recursive_sit_for = Qt; + recursive_sit_for = 1; while (1) { @@ -3309,6 +3200,80 @@ return event_binding (event0, 1); } +static void +maybe_kbd_translate (Lisp_Object event) +{ + Ichar c; + int did_translate = 0; + + if (XEVENT_TYPE (event) != key_press_event) + return; + if (!HASH_TABLEP (Vkeyboard_translate_table)) + return; + if (EQ (Fhash_table_count (Vkeyboard_translate_table), Qzero)) + return; + + c = event_to_character (event, 0, 0, 0); + if (c != -1) + { + Lisp_Object traduit = Fgethash (make_char (c), Vkeyboard_translate_table, + Qnil); + if (!NILP (traduit) && SYMBOLP (traduit)) + { + XSET_EVENT_KEY_KEYSYM (event, traduit); + XSET_EVENT_KEY_MODIFIERS (event, 0); + did_translate = 1; + } + else if (CHARP (traduit)) + { + /* This used to call Fcharacter_to_event() directly into EVENT, + but that can eradicate timestamps and other such stuff. + This way is safer. */ + Lisp_Object ev2 = Fmake_event (Qnil, Qnil); + + character_to_event (XCHAR (traduit), XEVENT (ev2), + XCONSOLE (XEVENT_CHANNEL (event)), 0, 1); + XSET_EVENT_KEY_KEYSYM (event, XEVENT_KEY_KEYSYM (ev2)); + XSET_EVENT_KEY_MODIFIERS (event, XEVENT_KEY_MODIFIERS (ev2)); + Fdeallocate_event (ev2); + did_translate = 1; + } + } + + if (!did_translate) + { + Lisp_Object traduit = Fgethash (XEVENT_KEY_KEYSYM (event), + Vkeyboard_translate_table, Qnil); + if (!NILP (traduit) && SYMBOLP (traduit)) + { + XSET_EVENT_KEY_KEYSYM (event, traduit); + did_translate = 1; + } + else if (CHARP (traduit)) + { + /* This used to call Fcharacter_to_event() directly into EVENT, + but that can eradicate timestamps and other such stuff. + This way is safer. */ + Lisp_Object ev2 = Fmake_event (Qnil, Qnil); + + character_to_event (XCHAR (traduit), XEVENT (ev2), + XCONSOLE (XEVENT_CHANNEL (event)), 0, 1); + XSET_EVENT_KEY_KEYSYM (event, XEVENT_KEY_KEYSYM (ev2)); + XSET_EVENT_KEY_MODIFIERS (event, + XEVENT_KEY_MODIFIERS (event) | + XEVENT_KEY_MODIFIERS (ev2)); + + Fdeallocate_event (ev2); + did_translate = 1; + } + } + +#ifdef DEBUG_XEMACS + if (did_translate) + DEBUG_PRINT_EMACS_EVENT ("->keyboard-translate-table", event); +#endif +} + /* See if we can do function-key-map or key-translation-map translation on the current events in the command builder. If so, do this, and return the resulting binding, if any. @@ -3424,7 +3389,7 @@ /* #### this horribly-written crap can mess with global state, which this function should not do. i'm not fixing it now. someone needs to go and rewrite that shit correctly. --ben */ -#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) +#if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID) if (x_kludge_lw_menu_active ()) { return command_builder_operate_menu_accelerator (builder); @@ -3437,7 +3402,7 @@ if (NILP (result)) #endif result = command_builder_find_leaf_1 (builder); -#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID) +#if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID) if (NILP (result) && EQ (Vmenu_accelerator_enabled, Qmenu_fallback)) result = command_builder_find_menu_accelerator (builder); @@ -4867,7 +4832,8 @@ the_low_level_timeout_blocktype = Blocktype_new (struct low_level_timeout_blocktype); something_happened = 0; - recursive_sit_for = Qnil; + recursive_sit_for = 0; + in_modal_loop = 0; } void
--- a/src/event-tty.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/event-tty.c Fri Feb 07 11:50:54 2003 +0000 @@ -1,7 +1,7 @@ /* The event_stream interface for tty's. Copyright (C) 1994, 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 2002 Ben Wing. + Copyright (C) 1995, 2002, 2003 Ben Wing. This file is part of XEmacs. @@ -69,7 +69,8 @@ /* timeout events have nil as channel */ SET_EVENT_TYPE (emacs_event, timeout_event); SET_EVENT_TIMESTAMP_ZERO (emacs_event); /* #### */ - SET_EVENT_TIMEOUT_INTERVAL_ID (emacs_event, pop_low_level_timeout (&tty_timer_queue, 0)); + SET_EVENT_TIMEOUT_INTERVAL_ID (emacs_event, + pop_low_level_timeout (&tty_timer_queue, 0)); SET_EVENT_TIMEOUT_FUNCTION (emacs_event, Qnil); SET_EVENT_TIMEOUT_OBJECT (emacs_event, Qnil); } @@ -77,9 +78,9 @@ static int -emacs_tty_event_pending_p (int user_p) +emacs_tty_event_pending_p (int how_many) { - if (!user_p) + if (!how_many) { EMACS_TIME sometime; /* see if there's a pending timeout. */ @@ -87,10 +88,14 @@ if (tty_timer_queue && EMACS_TIME_EQUAL_OR_GREATER (sometime, tty_timer_queue->time)) return 1; + + return poll_fds_for_input (non_fake_input_wait_mask); } - return poll_fds_for_input (user_p ? tty_only_mask : - non_fake_input_wait_mask); + /* #### Not right! We need to *count* the number of pending events, which + means we need to have a dispatch queue and drain the pending events, + using drain_tty_devices(). */ + return poll_fds_for_input (tty_only_mask); } static void
--- a/src/event-unixoid.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/event-unixoid.c Fri Feb 07 11:50:54 2003 +0000 @@ -3,7 +3,7 @@ Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc. Copyright (C) 1995 Board of Trustees, University of Illinois. Copyright (C) 1995 Sun Microsystems, Inc. - Copyright (C) 1995, 1996, 2001, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing. This file is part of XEmacs. @@ -44,12 +44,14 @@ /* Mask of bits indicating the descriptors that we wait for input on. These work as follows: + In event-tty.c we call select() directly on this + to retrieve an event. In event-Xt.c we use + XtAppAddInput() and the call to select() is down in + the guts of Xt, but we still use the masks when checking for pending input, even in event-Xt.c. (We can't use XtAppPending() because of the presence of the signal event pipe.) + input_wait_mask == mask of all file descriptors we select() on, including TTY/stream console descriptors, process descriptors, and the signal event pipe. - Only used in event-tty.c; event-Xt.c uses - XtAppAddInput(), and the call to select() is down in - the guts of Xt. non_fake_input_wait_mask == same as input_wait_mask but minus the signal event pipe. Also only used in
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/event-xlike-inc.c Fri Feb 07 11:50:54 2003 +0000 @@ -0,0 +1,161 @@ +/* Shared event code between X and GTK -- include file. + Copyright (C) 1991-5, 1997 Free Software Foundation, Inc. + Copyright (C) 1995 Sun Microsystems, Inc. + Copyright (C) 1996, 2001, 2002, 2003 Ben Wing. + +This file is part of XEmacs. + +XEmacs is free software; you can redistribute it and/or modify it +under the terms of the GNU General Public License as published by the +Free Software Foundation; either version 2, or (at your option) any +later version. + +XEmacs is distributed in the hope that it will be useful, but WITHOUT +ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +for more details. + +You should have received a copy of the GNU General Public License +along with XEmacs; see the file COPYING. If not, write to +the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +Boston, MA 02111-1307, USA. */ + +/* Synched up with: Not in FSF. */ + +/* For some code it's reasonable to have only one copy and conditionalize + at run-time. For other code it isn't. #### Perhaps all code should be + included here, not in event-xlike.c. However, event-xlike.c is always + X-specific, whereas the following code isn't, in the GTK case. */ + +static int +#ifdef THIS_IS_GTK +emacs_gtk_event_pending_p (int how_many) +#else +emacs_Xt_event_pending_p (int how_many) +#endif +{ + Lisp_Object event; + int tick_count_val; + + /* If `how_many' is 0, then this function returns whether there are any + X, timeout, or fd events pending (that is, whether + emacs_Xt_next_event() would return immediately without blocking). + + If `how_many' is > 0, then this function returns whether there are + that many *user generated* events available (keyboard, mouse click, + etc.). This also implies that emacs_Xt_next_event() would not block. + */ + + /* This function used to simply check whether there were any X events (or + if user_p was 1, it iterated over all the pending X events using + XCheckIfEvent(), looking for keystrokes and button events). That + worked in the old cheesoid event loop, which didn't go through + XtAppDispatchEvent(), but it doesn't work any more -- X events may not + result in anything. For example, a button press in a blank part of + the menubar appears as an X event but will not result in any Emacs + events (a button press that activates the menubar results in an Emacs + event through the stop_next_event mechanism). + + The only accurate way of determining whether these X events translate + into Emacs events is to go ahead and dispatch them until there's + something on the dispatch queue. */ + + if (!how_many) + { + /* We're being asked for *ALL* events, not just user events. */ + + /* (1) Any pending events in the dispatch queue? */ + if (!NILP (dispatch_event_queue)) + return 1; + + /* (2) Any TTY or process input available? + + Note that formerly we just checked the value of XtAppPending() to + determine if there was file-desc input. This doesn't work any + more with the signal_event_pipe; XtAppPending() will says "yes" in + this case but there isn't really any input. So instead we keep + track of the file descriptors, and call select() ourselves. + Another way of fixing this problem is for the signal_event_pipe to + generate actual input in the form of an identity eval event or + something. (#### maybe this actually happens?) */ + + if (poll_fds_for_input (non_fake_input_wait_mask)) + return 1; + +#ifndef THIS_IS_GTK + /* (3) Any timeout input available? */ + if (XtAppPending (Xt_app_con) & XtIMTimer) + return 1; +#else + /* #### Is there any way to do this in Gtk? I don't think there + is a 'peek' for events */ +#endif + } + else + { + /* HOW_MANY > 0 */ + EVENT_CHAIN_LOOP (event, dispatch_event_queue) + { + if (command_event_p (event)) + { + how_many--; + if (how_many <= 0) + return 1; + } + } + } + + /* XtAppPending() can be super-slow, esp. over a network connection. + Quantify results have indicated that in some cases the call to + detect_input_pending() completely dominates the running time of + redisplay(). Fortunately, in a SIGIO world we can more quickly + determine whether there are any X events: if an event has happened + since the last time we checked, then a SIGIO will have happened. On a + machine with broken SIGIO, we'll still be in an OK state -- + quit_check_signal_tick_count will get ticked at least every 1/4 + second, so we'll be no more than that much behind reality. (In general + it's OK if we erroneously report no input pending when input is + actually pending() -- preemption is just a bit less efficient, that's + all. It's bad bad bad if you err the other way -- you've promised + that `next-event' won't block but it actually will, and some action + might get delayed until the next time you hit a key.) + */ + + if (!in_modal_loop) + { + /* quit_check_signal_tick_count is volatile so try to avoid race + conditions by using a temporary variable */ + tick_count_val = quit_check_signal_tick_count; + if (last_quit_check_signal_tick_count != tick_count_val +#if !defined (THIS_IS_GTK) && (!defined (SIGIO) || defined (CYGWIN)) + || (XtIMXEvent & XtAppPending (Xt_app_con)) +#endif + ) + { + last_quit_check_signal_tick_count = tick_count_val; + + /* We need to drain the entire queue now -- if we only drain part of + it, we may later on end up with events actually pending but + detect_input_pending() returning false because there wasn't + another SIGIO. */ + event_stream_drain_queue (); + + if (!how_many) + return !NILP (dispatch_event_queue); + + EVENT_CHAIN_LOOP (event, dispatch_event_queue) + { + if (command_event_p (event)) + { + how_many--; + if (how_many <= 0) + return 1; + } + } + + return 0; + } + } + + return 0; +}
--- a/src/events.h Fri Feb 07 01:43:07 2003 +0000 +++ b/src/events.h Fri Feb 07 11:50:54 2003 +0000 @@ -65,12 +65,13 @@ event_pending_cb A function which says whether there are events to be read. If called with an argument of 0, then this should say whether calling the next_event_cb will - block. If called with an argument of 1, then this - should say whether there are user-generated events - pending (that is, keypresses or mouse-clicks). This - is used for redisplay optimization, among other - things. On dumb ttys, these two results are the - same, but under a window system, they are not. + block. If called with a non-zero argument, then this + should say whether there are that many user-generated + events pending (that is, keypresses, mouse-clicks, + dialog-box selection events, etc.). (This is used for + redisplay optimization, among other things.) The + difference is that the former includes process events + and timer events, but the latter doesn't. If this function is not sure whether there are events to be read, it *must* return 0. Otherwise various @@ -205,7 +206,6 @@ void (*unselect_console_cb) (struct console *); void (*select_process_cb) (Lisp_Process *, int doin, int doerr); void (*unselect_process_cb) (Lisp_Process *, int doin, int doerr); - int (*quit_check_disallowed_p_cb)(void); void (*drain_queue_cb) (void); void (*force_event_pending_cb)(struct frame* f); void (*create_io_streams_cb) (void* /* inhandle*/, void* /*outhandle*/ , @@ -1031,6 +1031,7 @@ EXFUN (Fevent_point, 1); EXFUN (Fevent_window, 1); EXFUN (Fmake_event, 2); +EXFUN (Fnext_command_event, 2); extern Lisp_Object QKbackspace, QKdelete, QKescape, QKlinefeed, QKreturn; extern Lisp_Object QKspace, QKtab, Qmouse_event_p, Vcharacter_set_property; @@ -1127,6 +1128,10 @@ Lisp_Object errstream, USID* in_usid, USID* err_usid); +Lisp_Object event_stream_protect_modal_loop (const char *error_string, + Lisp_Object (*bfun) (void *barg), + void *barg, int flags); +void event_stream_drain_queue (void); void event_stream_quit_p (void); void run_pre_idle_hook (void); @@ -1173,7 +1178,7 @@ int in_single_console_state (void); extern int emacs_is_blocking; - +extern int in_modal_loop; extern volatile int sigint_happened; #ifdef HAVE_UNIXOID_EVENT_LOOP
--- a/src/indent.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/indent.c Fri Feb 07 11:50:54 2003 +0000 @@ -758,9 +758,15 @@ returned instead of the actual number of lines moved. A motion of zero lines returns the height of the current line. -Note that `vertical-motion' sets WINDOW's buffer's point, not -WINDOW's point. (This differs from FSF Emacs, which buggily always -sets current buffer's point, regardless of WINDOW.) +NOTE NOTE NOTE: GNU Emacs/XEmacs difference. + +What `vertical-motion' actually does is set WINDOW's buffer's point +if WINDOW is the selected window; else, it sets WINDOW's point. +This is unfortunately somewhat tricky to work with, and different +from GNU Emacs, which always uses the current buffer, not WINDOW's +buffer, always sets current buffer's point, and, from the +perspective of this function, temporarily makes WINDOW display +the current buffer if it wasn't already. */ (lines, window, pixels)) {
--- a/src/lisp.h Fri Feb 07 01:43:07 2003 +0000 +++ b/src/lisp.h Fri Feb 07 11:50:54 2003 +0000 @@ -4051,7 +4051,7 @@ EXFUN (Fsleep_for, 1); void wait_delaying_user_input (int (*) (void *), void *); -int detect_input_pending (void); +int detect_input_pending (int how_many); void reset_this_command_keys (Lisp_Object, int); Lisp_Object enqueue_misc_user_event (Lisp_Object, Lisp_Object, Lisp_Object); Lisp_Object enqueue_misc_user_event_pos (Lisp_Object, Lisp_Object, @@ -4216,6 +4216,7 @@ EXFUN (Frassq, 2); EXFUN (Fremassq, 2); EXFUN (Freplace_list, 2); +EXFUN (Fsafe_length, 1); EXFUN (Fsort, 2); EXFUN (Fstring_equal, 2); EXFUN (Fstring_lessp, 2);
--- a/src/menubar-msw.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/menubar-msw.c Fri Feb 07 11:50:54 2003 +0000 @@ -714,33 +714,43 @@ /* Message handling proxies */ /*------------------------------------------------------------------------*/ -static HMENU wm_initmenu_menu; -static struct frame *wm_initmenu_frame; +struct handle_wm_initmenu +{ + HMENU menu; + struct frame *frame; +}; static Lisp_Object -unsafe_handle_wm_initmenupopup (Lisp_Object u_n_u_s_e_d) +unsafe_handle_wm_initmenupopup (void *arg) { - return unsafe_handle_wm_initmenupopup_1 (wm_initmenu_menu, wm_initmenu_frame); + struct handle_wm_initmenu *z = (struct handle_wm_initmenu *) arg; + return unsafe_handle_wm_initmenupopup_1 (z->menu, z->frame); } static Lisp_Object -unsafe_handle_wm_initmenu (Lisp_Object u_n_u_s_e_d) +unsafe_handle_wm_initmenu (void *arg) { - return unsafe_handle_wm_initmenu_1 (wm_initmenu_frame); + struct handle_wm_initmenu *z = (struct handle_wm_initmenu *) arg; + return unsafe_handle_wm_initmenu_1 (z->frame); } Lisp_Object mswindows_handle_wm_initmenupopup (HMENU hmenu, struct frame *frm) { - /* We cannot pass hmenu as a lisp object. Use static var */ - wm_initmenu_menu = hmenu; - wm_initmenu_frame = frm; - /* Allow runaway filter code, e.g. custom, to be aborted. We are + struct handle_wm_initmenu z; + + z.menu = hmenu; + z.frame = frm; + + /* [[ Allow runaway filter code, e.g. custom, to be aborted. We are usually called from next_event_internal(), which has turned off - quit checking to read the C-g as an event. */ - return mswindows_protect_modal_loop ("Error during menu handling", - unsafe_handle_wm_initmenupopup, Qnil, - UNINHIBIT_QUIT); + quit checking to read the C-g as an event.]] + + #### This is bogus because by the very act of calling + event_stream_protect_modal_loop(), we disable event retrieval! */ + return event_stream_protect_modal_loop ("Error during menu handling", + unsafe_handle_wm_initmenupopup, &z, + UNINHIBIT_QUIT); } Lisp_Object @@ -749,10 +759,12 @@ /* Handle only frame menubar, ignore if from popup or system menu */ if (GetMenu (FRAME_MSWINDOWS_HANDLE (f)) == hmenu) { - wm_initmenu_frame = f; - return mswindows_protect_modal_loop ("Error during menu handling", - unsafe_handle_wm_initmenu, Qnil, - UNINHIBIT_QUIT); + struct handle_wm_initmenu z; + + z.frame = f; + return event_stream_protect_modal_loop ("Error during menu handling", + unsafe_handle_wm_initmenu, &z, + UNINHIBIT_QUIT); } return Qt; }
--- a/src/menubar-x.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/menubar-x.c Fri Feb 07 11:50:54 2003 +0000 @@ -396,18 +396,15 @@ midtwv.filter_p = filter_p; if (UNBOUNDP - (call_trapping_problems - (Qmenubar, "Error during menu callback", UNINHIBIT_QUIT, 0, - protected_menu_item_descriptor_to_widget_value_1, &midtwv))) + (event_stream_protect_modal_loop + ("Error during menu callback", + protected_menu_item_descriptor_to_widget_value_1, &midtwv, + UNINHIBIT_QUIT))) return 0; return midtwv.wv; } -#if defined (LWLIB_MENUBARS_LUCID) || (defined LWLIB_MENUBARS_MOTIF) -int in_menu_callback; -#endif - /* The order in which callbacks are run is funny to say the least. It's sometimes tricky to avoid running a callback twice, and to avoid returning prematurely. So, this function returns true @@ -435,7 +432,6 @@ struct device *d = get_device_from_display (XtDisplay (widget)); struct frame *f = x_any_window_to_frame (d, XtWindow (widget)); Lisp_Object frame; - int count; /* set in lwlib to the time stamp associated with the most recent menu operation */ @@ -460,17 +456,8 @@ assert (hack_wv->type == INCREMENTAL_TYPE); submenu_desc = VOID_TO_LISP (hack_wv->call_data); - /* - * #### Fix the menu code so this isn't necessary. - * - * Protect against reentering the menu code otherwise we will - * crash later when the code gets confused at the state - * changes. - */ - count = internal_bind_int (&in_menu_callback, 1); wv = (protected_menu_item_descriptor_to_widget_value (submenu_desc, SUBMENU_TYPE, 1, 0)); - unbind_to (count); if (!wv) {
--- a/src/menubar.h Fri Feb 07 01:43:07 2003 +0000 +++ b/src/menubar.h Fri Feb 07 11:50:54 2003 +0000 @@ -62,8 +62,6 @@ *builder); Lisp_Object command_builder_operate_menu_accelerator (struct command_builder *builder); - -extern int in_menu_callback; #endif extern int popup_menu_up_p;
--- a/src/redisplay.c Fri Feb 07 01:43:07 2003 +0000 +++ b/src/redisplay.c Fri Feb 07 11:50:54 2003 +0000 @@ -1,7 +1,7 @@ /* Display generation from window structure and buffer text. Copyright (C) 1994, 1995, 1996 Board of Trustees, University of Illinois. Copyright (C) 1995 Free Software Foundation, Inc. - Copyright (C) 1995, 1996, 2000, 2001, 2002 Ben Wing. + Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003 Ben Wing. Copyright (C) 1995 Sun Microsystems, Inc. Copyright (C) 1996 Chuck Thompson. @@ -314,14 +314,17 @@ /* This used to be 10 but 30 seems to give much better performance. */ #define INIT_MAX_PREEMPTS 30 -static int max_preempts; +static Fixnum max_preempts; + +#define QUEUED_EVENTS_REQUIRED_FOR_PREEMPTION 4 #define REDISPLAY_PREEMPTION_CHECK \ ((void) \ (preempted = \ (!disable_preemption && \ ((preemption_count < max_preempts) || !NILP (Vexecuting_macro)) && \ - (!INTERACTIVE || detect_input_pending ())))) + (!INTERACTIVE || \ + detect_input_pending (QUEUED_EVENTS_REQUIRED_FOR_PREEMPTION))))) /* * Redisplay global variables. @@ -9606,7 +9609,6 @@ { disable_preemption = 0; preemption_count = 0; - max_preempts = INIT_MAX_PREEMPTS; #ifndef PDUMP if (!initialized) @@ -9734,6 +9736,11 @@ */ ); cache_adjustment = 2; + DEFVAR_INT ("maximum-preempts", &max_preempts /* +Maximum number of times redisplay can be preempted by user input. +*/ ); + max_preempts = INIT_MAX_PREEMPTS; + DEFVAR_INT_MAGIC ("pixel-vertical-clip-threshold", &vertical_clip /* Minimum pixel height for clipped bottom display line. A clipped line shorter than this won't be displayed.