Mercurial > hg > xemacs-beta
diff src/event-stream.c @ 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 | e22b0213b713 |
children | cd0abfdb9e9d |
line wrap: on
line diff
--- 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