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

comparison 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

comparison

equal deleted inserted replaced

-:c57f32e44416
+:fffe735e63ee
 /* The portable interface to event streams.
 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.
 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
 /* Non-nil disable property on a command means
 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;
 /* The nearest ASCII equivalent of the above. */
 Lisp_Object Vlast_command_char;
 recent-keys. */
 int inhibit_input_event_recording;
 Lisp_Object Qself_insert_defer_undo;
-/* this is in keymap.c */
+int in_modal_loop;
-extern Lisp_Object Fmake_keymap (Lisp_Object name);
+/* the number of keyboard characters read.  callint.c wants this. */
+Charcount num_input_chars;
 #ifdef DEBUG_XEMACS
 Fixnum debug_emacs_events;
 static void
 /* 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
+dispatch event queue. (MS Windows actually has an extra dispatch
-queue for non-user events and uses the generic one only for user events;
+queue for non-user events and uses the generic one only for user events.
-we should probably generalize this).
+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
 window-system event queue(s) and not yet process by
 next_event_internal().  It exists for two reasons: (1) because in many
 /* Handlers which run during sit-for, sleep-for and accept-process-output
 are not allowed to recursively call these routines.  We record here
 if we are in that situation. */
-static Lisp_Object recursive_sit_for;
+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);
 /**********************************************************************/
 /*                       Command-builder object                       */
 /**********************************************************************/
 /**********************************************************************/
 /*             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() */
 init_event_stream ();
 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);
 con->input_enabled = 1;
 }
 }
 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);
 con->input_enabled = 0;
 }
 void
 event_stream_select_process (Lisp_Process *proc, int doin, int doerr)
 {
 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)
 doin = 0;
 void
 event_stream_unselect_process (Lisp_Process *proc, int doin, int doerr)
 {
 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)
 doin = 0;
 				Lisp_Object *errstream,
 				USID *in_usid,
 				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);
 }
 				Lisp_Object outstream,
 				Lisp_Object errstream,
 				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)
 {
 /**********************************************************************/
 /*                          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. */
 /* When an auto-save happens, record the number of keystrokes, and
 {
 /* This function can call lisp */
 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 ();
 }
 }
 command_builder->echo_buf_index = buf_index;
 if (buf_index > 0)
 memcpy (command_builder->echo_buf,
 XSTRING_DATA (echo), buf_index + 1); /* terminating 0 */
 UNGCPRO;
-}
-/**********************************************************************/
-/*                          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                                */
 }
 }
 /**********************************************************************/
+/*                     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                     */
 /**********************************************************************/
 static int in_single_console;
 in_single_console_state (void)
 {
 return in_single_console;
 }
-/* the number of keyboard characters read.  callint.c wants this. */
+static void
-Charcount num_input_chars;
+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.
 If C-g was pressed, this function will attempt to QUIT.  If you want
 void
 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. */
-static void push_this_command_keys (Lisp_Object event);
+INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION | UNINHIBIT_QUIT);
-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.
 In most cases, you will want to use `next-command-event', which returns
 struct gcpro gcpro1;
 int depth;
 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
 CHECK_LIVE_EVENT (event);
 reset_command_builder_event_chain (command_builder);
 if (EVENTP (event))
 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.
 A user event is a key press, button press, button release, or
 "misc-user" event (menu selection or scrollbar action).
 */
 ())
 {
-/* This throws away user-input on the queue, but doesn't process any
+Lisp_Object concons;
-events.  Calling dispatch_event() here leads to a race condition.
-*/
+CONSOLE_LOOP (concons)
-Lisp_Object event = Fmake_event (Qnil, Qnil);
+{
-Lisp_Object head = Qnil, tail = Qnil;
+struct console *con = XCONSOLE (XCAR (concons));
-struct gcpro gcpro1;
-/* #### not correct here with Vselected_console?  Should
+/* If a macro was being defined then we have to mark the modeline
-discard-input take a console argument, or maybe map over
+	 has changed to ensure that it gets updated correctly. */
-all consoles? */
+if (!NILP (con->defining_kbd_macro))
-struct console *con = XCONSOLE (Vselected_console);
+	MARK_MODELINE_CHANGED;
+con->defining_kbd_macro = Qnil;
-/* next_event_internal() can cause arbitrary Lisp code to be evalled */
+reset_current_events (XCOMMAND_BUILDER (con->command_builder));
-GCPRO1 (event);
+}
-/* If a macro was being defined then we have to mark the modeline
-has changed to ensure that it gets updated correctly. */
+/* This function used to be a lot more complicated.  Now, we just
-if (!NILP (con->defining_kbd_macro))
+drain the pending queue and discard all user events from the
-MARK_MODELINE_CHANGED;
+command and dispatch queues. */
-con->defining_kbd_macro = Qnil;
+event_stream_drain_queue ();
-reset_current_events (XCOMMAND_BUILDER (con->command_builder));
+map_event_chain_remove (command_event_p_cb,
-while (!NILP (command_event_queue)
+			  &dispatch_event_queue, &dispatch_event_queue_tail,
-|| event_stream_event_pending_p (1))
+			  0, MECR_DEALLOCATE_EVENT);
-{
+map_event_chain_remove (command_event_p_cb,
-/* We want to ignore C-g's along with all other keypresses. */
+			  &command_event_queue, &command_event_queue_tail,
-int depth = begin_dont_check_for_quit ();
+			  0, MECR_DEALLOCATE_EVENT);
-/* 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);
-	}
-}
-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;
 return Qnil;
 }
 /*                     pausing until an action occurs                 */
 /**********************************************************************/
 /* This is used in accept-process-output, sleep-for and sit-for.
 Before running any process_events in these routines, we set
-recursive_sit_for to Qt, and use this unwind protect to reset it to
+recursive_sit_for to 1, and use this unwind protect to reset it to
-Qnil upon exit.  When recursive_sit_for is Qt, calling sit-for will
+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
 timeout as well.
 sit_for_unwind (Lisp_Object timeout_id)
 {
 if (!NILP(timeout_id))
 Fdisable_timeout (timeout_id);
-recursive_sit_for = Qnil;
+recursive_sit_for = 0;
 return Qnil;
 }
 /* #### Is (accept-process-output nil 3) supposed to be like (sleep-for 3)?
 */
 event = Fmake_event (Qnil, Qnil);
 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) ||
 (NILP (process) && event_stream_event_pending_p (0)) ||
 (!NILP (process))))
 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
 event = Fmake_event (Qnil, Qnil);
 count = specpdl_depth ();
 record_unwind_protect (sit_for_unwind, make_int (id));
-recursive_sit_for = Qt;
+recursive_sit_for = 1;
 while (1)
 {
 /* If our timeout has arrived, we move along. */
 if (!event_stream_wakeup_pending_p (id, 0))
 don't wait. */
 if (noninteractive || !NILP (Vexecuting_macro))
 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 ();
 return Qnil;
 }
 id = event_stream_generate_wakeup (msecs, 0, Qnil, Qnil, 0);
 count = specpdl_depth ();
 record_unwind_protect (sit_for_unwind, make_int (id));
-recursive_sit_for = Qt;
+recursive_sit_for = 1;
 while (1)
 {
 /* If there is no user input pending, then redisplay.
 */
 return Qnil;
 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.
 DID_MUNGE must be initialized before calling this function.  If munging
 events */
 /* #### fuck me!  who wrote this crap?  think "abstraction", baby. */
 /* #### 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);
 }
 else
 if (EQ (Vmenu_accelerator_enabled, Qmenu_force))
 	result = command_builder_find_menu_accelerator (builder);
 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);
 }
 #endif
 			&lrecord_command_builder);
 staticpro_nodump (&Vcommand_builder_free_list);
 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
 vars_of_event_stream (void)
 {

Mercurial > hg > xemacs-beta

comparison src/event-stream.c @ 1268:fffe735e63ee