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

comparison src/event-stream.c @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 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. */
+/* Authorship:
+Created 1991 by Jamie Zawinski.
+A great deal of work over the ages by Ben Wing (Mule-ization for 19.12,
+device abstraction for 19.12/19.13, async timers for 19.14,
+rewriting of focus code for 19.12, pre-idle hook for 19.12,
+redoing of signal and quit handling for 19.9 and 19.12,
+misc-user events to clean up menu/scrollbar handling for 19.11,
+function-key-map/key-translation-map/keyboard-translate-table for
+19.13/19.14, open-dribble-file for 19.13, much other cleanup).
+focus-follows-mouse from Chuck Thompson, 1995.
+XIM stuff by Martin Buchholz, c. 1996?.
+*/
 /* This file has been Mule-ized. */
 /*
 *	DANGER!!
 */
 /* TODO:
 This stuff is way too hard to maintain - needs rework.
-(global-set-key "\C-p" global-map) causes a crash - need recursion check.
 C-x @ h <scrollbar-drag> x causes a crash.
 The command builder should deal only with key and button events.
 Other command events should be able to come in the MIDDLE of a key
 sequence, without disturbing the key sequence composition, or the
 instead of RETYPING, the key sequence.
 */
 #include <config.h>
 #include "lisp.h"
-#ifdef HAVE_X_WINDOWS
-#include "console-x.h"		/* for menu accelerators ... */
-#include "gui-x.h"
-#include "../lwlib/lwlib.h"
-#else
-#define lw_menu_active	0
-#endif
 #include "blocktype.h"
 #include "buffer.h"
 #include "commands.h"
 #include "device.h"
 #include "frame.h"
 #include "insdel.h"		/* for buffer_reset_changes */
 #include "keymap.h"
 #include "lstream.h"
 #include "macros.h"		/* for defining_keyboard_macro */
+#include "menubar.h"            /* #### for evil kludges. */
 #include "process.h"
 #include "window.h"
 #include "sysdep.h"		/* init_poll_for_quit() */
 #include "syssignal.h"		/* SIGCHLD, etc. */
 /* Hooks to run before and after each command.  */
 Lisp_Object Vpre_command_hook, Vpost_command_hook;
 Lisp_Object Qpre_command_hook, Qpost_command_hook;
+/* See simple.el */
+Lisp_Object Qhandle_pre_motion_command, Qhandle_post_motion_command;
 /* Hook run when XEmacs is about to be idle. */
 Lisp_Object Qpre_idle_hook, Vpre_idle_hook;
 /* Control gratuitous keyboard focus throwing. */
 int focus_follows_mouse;
-#ifdef ILL_CONCEIVED_HOOK
+int modifier_keys_are_sticky;
+#if 0 /* FSF Emacs crap */
 /* Hook run after a command if there's no more input soon.  */
 Lisp_Object Qpost_command_idle_hook, Vpost_command_idle_hook;
 /* Delay time in microseconds before running post-command-idle-hook.  */
 int post_command_idle_delay;
-#endif /* ILL_CONCEIVED_HOOK */
-#ifdef DEFERRED_ACTION_CRAP
 /* List of deferred actions to be performed at a later time.
 The precise format isn't relevant here; we just check whether it is nil.  */
 Lisp_Object Vdeferred_action_list;
 /* Function to call to handle deferred actions, when there are any.  */
 Lisp_Object Vdeferred_action_function;
 Lisp_Object Qdeferred_action_function;
-#endif /* DEFERRED_ACTION_CRAP */
+#endif /* FSF Emacs crap */
 /* Non-nil disable property on a command means
 do not execute it; call disabled-command-hook's value instead. */
 Lisp_Object Qdisabled, Vdisabled_command_hook;
 Lisp_Object Vunread_command_event; /* obsoleteness support */
 static Lisp_Object Qunread_command_events, Qunread_command_event;
 /* Previous command, represented by a Lisp object.
-Does not include prefix commands and arg setting commands */
+Does not include prefix commands and arg setting commands. */
 Lisp_Object Vlast_command;
+/* Contents of this-command-properties for the last command. */
+Lisp_Object Vlast_command_properties;
 /* If a command sets this, the value goes into
-previous-command for the next command. */
+last-command for the next command. */
 Lisp_Object Vthis_command;
+/* If a command sets this, the value goes into
+last-command-properties for the next command. */
+Lisp_Object Vthis_command_properties;
 /* The value of point when the last command was executed.  */
 Bufpos last_point_position;
 /* The frame that was current when the last command was started. */
 int recent_keys_ring_index;
 /* Boolean specifying whether keystrokes should be added to
 recent-keys. */
 int inhibit_input_event_recording;
-/* prefix key(s) that must match in order to activate menu.
-This is ugly.  fix me.
-*/
-Lisp_Object Vmenu_accelerator_prefix;
-/* list of modifier keys to match accelerator for top level menus */
-Lisp_Object Vmenu_accelerator_modifiers;
-/* whether menu accelerators are enabled */
-Lisp_Object Vmenu_accelerator_enabled;
-/* keymap for auxiliary menu accelerator functions */
-Lisp_Object Vmenu_accelerator_map;
-Lisp_Object Qmenu_force;
-Lisp_Object Qmenu_fallback;
-Lisp_Object Qmenu_quit;
-Lisp_Object Qmenu_up;
-Lisp_Object Qmenu_down;
-Lisp_Object Qmenu_left;
-Lisp_Object Qmenu_right;
-Lisp_Object Qmenu_select;
-Lisp_Object Qmenu_escape;
 Lisp_Object Qself_insert_defer_undo;
 /* this is in keymap.c */
 extern Lisp_Object Fmake_keymap (Lisp_Object name);
 #endif
 /* The callback routines for the window system or terminal driver */
 struct event_stream *event_stream;
-/* This structure is what we use to encapsulate the state of a command sequence
-being composed; key events are executed by adding themselves to the command
-builder; if the command builder is then complete (does not still represent
-a prefix key sequence) it executes the corresponding command.
-*/
-struct command_builder
-{
-struct lcrecord_header header;
-Lisp_Object console; /* back pointer to the console this command
-			  builder is for */
-/* Qnil, or a Lisp_Event representing the first event read
-*  after the last command completed.  Threaded. */
-/* #### NYI */
-Lisp_Object prefix_events;
-/* Qnil, or a Lisp_Event representing event in the current
-*  keymap-lookup sequence.  Subsequent events are threaded via
-*  the event's next slot */
-Lisp_Object current_events;
-/* Last elt of above  */
-Lisp_Object most_current_event;
-/* Last elt before function map code took over. What this means is:
-All prefixes up to (but not including) this event have non-nil
-bindings, but the prefix including this event has a nil binding.
-Any events in the chain after this one were read solely because
-we're part of a possible function key.  If we end up with
-something that's not part of a possible function key, we have to
-unread all of those events. */
-Lisp_Object last_non_munged_event;
-/* One set of values for function-key-map, one for key-translation-map */
-struct munging_key_translation
-{
-/* First event that can begin a possible function key sequence
-(to be translated according to function-key-map).  Normally
-this is the first event in the chain.  However, once we've
-translated a sequence through function-key-map, this will point
-to the first event after the translated sequence: we don't ever
-want to translate any events twice through function-key-map, or
-things could get really screwed up (e.g. if the user created a
-translation loop).  If this is nil, then the next-read event is
-the first that can begin a function key sequence. */
-Lisp_Object first_mungeable_event;
-} munge_me[2];
-Bufbyte *echo_buf;
-Bytecount echo_buf_length;          /* size of echo_buf */
-Bytecount echo_buf_index;           /* index into echo_buf
-				       * -1 before doing echoing for new cmd */
-/* Self-insert-command is magic in that it doesn't always push an undo-
-boundary: up to 20 consecutive self-inserts can happen before an undo-
-boundary is pushed.  This variable is that counter.
-*/
-int self_insert_countdown;
-};
 static void echo_key_event (struct command_builder *, Lisp_Object event);
 static void maybe_kbd_translate (Lisp_Object event);
 /* This structure is basically a typeahead queue: things like
 static int
 event_stream_event_pending_p (int user)
 {
 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)
+event_stream->force_event_pending (f);
 }
 static int
 maybe_read_quit_event (Lisp_Event *event)
 {
 {
 if (event_stream)
 event_stream->quit_p_cb ();
 }
+static int
+event_stream_current_event_timestamp (struct console *c)
+{
+if (event_stream && event_stream->current_event_timestamp_cb)
+return event_stream->current_event_timestamp_cb (c);
+else
+return 0;
+}
 /**********************************************************************/
 /*                      Character prompting                           */
 /**********************************************************************/
 else
 echo_keystrokes = 0;
 if (minibuf_level == 0
 && echo_keystrokes > 0.0
-&& !lw_menu_active)
+#if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
+&& !x_kludge_lw_menu_active ()
+#endif
+)
 {
 if (!no_snooze)
 	{
 	  /* #### C-g here will cause QUIT.  Setting dont_check_for_quit
 	     doesn't work.  See check_quit. */
 Lisp_Object traduit = Fgethash (XEVENT (event)->event.key.keysym,
 				      Vkeyboard_translate_table, Qnil);
 if (!NILP (traduit) && SYMBOLP (traduit))
 	{
 	  XEVENT (event)->event.key.keysym = traduit;
+	  did_translate = 1;
+	}
+else if (CHARP (traduit))
+	{
+	  Lisp_Event ev2;
+	  zero_event (&ev2);
+	  character_to_event (XCHAR (traduit), &ev2,
+			      XCONSOLE (EVENT_CHANNEL (XEVENT (event))), 1, 1);
+	  XEVENT (event)->event.key.keysym = ev2.event.key.keysym;
+	  XEVENT (event)->event.key.modifiers |= ev2.event.key.modifiers;
 	  did_translate = 1;
 	}
 }
 #ifdef DEBUG_XEMACS
 /* Should never, ever be called. (except by an external debugger) */
 static void
 print_timeout (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
-CONST Lisp_Timeout *t = XTIMEOUT (obj);
+const Lisp_Timeout *t = XTIMEOUT (obj);
 char buf[64];
 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (timeout) 0x%lx>",
 	   (unsigned long) t);
 write_c_string (buf, printcharfun);
 The next available event will be
 -- any events in `unread-command-events' or `unread-command-event'; else
 -- the next event in the currently executing keyboard macro, if any; else
--- an event queued by `enqueue-eval-event', if any; else
+-- an event queued by `enqueue-eval-event', if any, or any similar event
+queued internally, such as a misc-user event. (For example, when an item
+is selected from a menu or from a `question'-type dialog box, the item's
+callback is not immediately executed, but instead a misc-user event
+is generated and placed onto this queue; when it is dispatched, the
+callback is executed.) Else
 -- the next available event from the window system or terminal driver.
 In the last case, this function will block until an event is available.
 The returned event will be one of the following types:
 struct console *con = XCONSOLE (Vselected_console);
 struct command_builder *command_builder =
 XCOMMAND_BUILDER (con->command_builder);
 int store_this_key = 0;
 struct gcpro gcpro1;
-#ifdef LWLIB_MENUBARS_LUCID
-extern int in_menu_callback;  /* defined in menubar-x.c */
-#endif /* LWLIB_MENUBARS_LUCID */
 GCPRO1 (event);
 /* DO NOT do QUIT anywhere within this function or the functions it calls.
 We want to read the ^G as an event. */
 }
 UNGCPRO;
 return event;
 }
+DEFUN ("dispatch-non-command-events", Fdispatch_non_command_events, 0, 0, 0, /*
+Dispatch any pending "magic" events.
+This function is useful for forcing the redisplay of native
+widgets. Normally these are redisplayed through a native window-system
+event encoded as magic event, rather than by the redisplay code.  This
+function does not call redisplay or do any of the other things that
+`next-event' does.
+*/
+())
+{
+/* This function can GC */
+Lisp_Object event = Qnil;
+struct gcpro gcpro1;
+GCPRO1 (event);
+event = Fmake_event (Qnil, Qnil);
+/* Make sure that there will be something in the native event queue
+so that externally managed things (e.g. widgets) get some CPU
+time. */
+event_stream_force_event_pending (selected_frame ());
+while (event_stream_event_pending_p (0))
+{
+QUIT; /* next_event_internal() does not QUIT. */
+/* We're a generator of the command_event_queue, so we can't be a
+	 consumer as well.  Also, we have no reason to consult the
+	 command_event_queue; there are only user and eval-events there,
+	 and we'd just have to put them back anyway.
+*/
+next_event_internal (event, 0); /* blocks */
+/* See the comment in accept-process-output about Vquit_flag */
+if (XEVENT_TYPE (event) == magic_event ||
+	  XEVENT_TYPE (event) == timeout_event ||
+	  XEVENT_TYPE (event) == process_event ||
+	  XEVENT_TYPE (event) == pointer_motion_event)
+	execute_internal_event (event);
+else
+	{
+	  enqueue_command_event_1 (event);
+	  break;
+	}
+}
+Fdeallocate_event (event);
+UNGCPRO;
+return Qnil;
+}
 static void
 reset_current_events (struct command_builder *command_builder)
 {
 Lisp_Object event = command_builder->current_events;
 reset_command_builder_event_chain (command_builder);
 UNGCPRO;
 return result;
 }
-/* This handy little function is used by xselect.c and energize.c to
+/* This handy little function is used by select-x.c to wait for replies
-wait for replies from processes that aren't really processes (that is,
+from processes that aren't really processes (e.g. the X server) */
-the X server and the Energize server).
-*/
 void
 wait_delaying_user_input (int (*predicate) (void *arg), void *predicate_arg)
 {
 /* This function can GC */
 Lisp_Object event = Fmake_event (Qnil, Qnil);
 return Qnil;
 return event_binding (event0, 1);
 }
-#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
-static void
-menu_move_up (void)
-{
-widget_value *current = lw_get_entries (False);
-widget_value *entries = lw_get_entries (True);
-widget_value *prev    = NULL;
-while (entries != current)
-{
-if (entries->name /*&& entries->enabled*/) prev = entries;
-entries = entries->next;
-assert (entries);
-}
-if (!prev)
-/* move to last item */
-{
-while (entries->next)
-	{
-	  if (entries->name /*&& entries->enabled*/) prev = entries;
-	  entries = entries->next;
-	}
-if (prev)
-	{
-	  if (entries->name /*&& entries->enabled*/)
-	    prev = entries;
-	}
-else
-	{
-	  /* no selectable items in this menu, pop up to previous level */
-	  lw_pop_menu ();
-	  return;
-	}
-}
-lw_set_item (prev);
-}
-static void
-menu_move_down (void)
-{
-widget_value *current = lw_get_entries (False);
-widget_value *new = current;
-while (new->next)
-{
-new = new->next;
-if (new->name /*&& new->enabled*/) break;
-}
-if (new==current||!(new->name/*||new->enabled*/))
-{
-new = lw_get_entries (True);
-while (new!=current)
-	{
-	  if (new->name /*&& new->enabled*/) break;
-	  new = new->next;
-	}
-if (new==current&&!(new->name /*|| new->enabled*/))
-	{
-	  lw_pop_menu ();
-	  return;
-	}
-}
-lw_set_item (new);
-}
-static void
-menu_move_left (void)
-{
-int level = lw_menu_level ();
-int l = level;
-widget_value *current;
-while (level-- >= 3)
-lw_pop_menu ();
-menu_move_up ();
-current = lw_get_entries (False);
-if (l > 2 && current->contents)
-lw_push_menu (current->contents);
-}
-static void
-menu_move_right (void)
-{
-int level = lw_menu_level ();
-int l = level;
-widget_value *current;
-while (level-- >= 3)
-lw_pop_menu ();
-menu_move_down ();
-current = lw_get_entries (False);
-if (l > 2 && current->contents)
-lw_push_menu (current->contents);
-}
-static void
-menu_select_item (widget_value *val)
-{
-if (val == NULL)
-val = lw_get_entries (False);
-/* is match a submenu? */
-if (val->contents)
-{
-/* enter the submenu */
-lw_set_item (val);
-lw_push_menu (val->contents);
-}
-else
-{
-/* Execute the menu entry by calling the menu's `select'
-	 callback function
-	 */
-lw_kill_menus (val);
-}
-}
-static Lisp_Object
-command_builder_operate_menu_accelerator (struct command_builder *builder)
-{
-/* this function can GC */
-struct console *con = XCONSOLE (Vselected_console);
-Lisp_Object evee = builder->most_current_event;
-Lisp_Object binding;
-widget_value *entries;
-extern int lw_menu_accelerate; /* lwlib.c */
-#if 0
-{
-int i;
-Lisp_Object t;
-char buf[50];
-t = builder->current_events;
-i = 0;
-while (!NILP (t))
-{
-	i++;
-	sprintf (buf,"OPERATE (%d): ",i);
-	write_c_string (buf, Qexternal_debugging_output);
-	print_internal (t, Qexternal_debugging_output, 1);
-	write_c_string ("\n", Qexternal_debugging_output);
-	t = XEVENT_NEXT (t);
-}
-}
-#endif /* 0 */
-/* menu accelerator keys don't go into keyboard macros */
-if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
-con->kbd_macro_ptr = con->kbd_macro_end;
-/* don't echo menu accelerator keys */
-/*reset_key_echo (builder, 1);*/
-if (!lw_menu_accelerate)
-{
-/* `convert' mouse display to keyboard display
-	 by entering the open submenu
-	 */
-entries = lw_get_entries (False);
-if (entries->contents)
-	{
-	  lw_push_menu (entries->contents);
-	  lw_display_menu (CurrentTime);
-	}
-}
-/* compare event to the current menu accelerators */
-entries=lw_get_entries (True);
-while (entries)
-{
-Lisp_Object accel;
-VOID_TO_LISP (accel, entries->accel);
-if (entries->name && !NILP (accel))
-	{
-	  if (event_matches_key_specifier_p (XEVENT (evee), accel))
-	    {
-	      /* a match! */
-	      menu_select_item (entries);
-	      if (lw_menu_active) lw_display_menu (CurrentTime);
-	      reset_this_command_keys (Vselected_console, 1);
-	      /*reset_command_builder_event_chain (builder);*/
-	      return Vmenu_accelerator_map;
-	    }
-	}
-entries = entries->next;
-}
-/* try to look up event in menu-accelerator-map */
-binding = event_binding_in (evee, Vmenu_accelerator_map, 1);
-if (NILP (binding))
-{
-/* beep at user for undefined key */
-return Qnil;
-}
-else
-{
-if (EQ (binding, Qmenu_quit))
-	{
-	  /* turn off menus and set quit flag */
-	  lw_kill_menus (NULL);
-	  Vquit_flag = Qt;
-	}
-else if (EQ (binding, Qmenu_up))
-	{
-	  int level = lw_menu_level ();
-	  if (level > 2)
-	    menu_move_up ();
-	}
-else if (EQ (binding, Qmenu_down))
-	{
-	  int level = lw_menu_level ();
-	  if (level > 2)
-	    menu_move_down ();
-	  else
-	    menu_select_item (NULL);
-	}
-else if (EQ (binding, Qmenu_left))
-	{
-	  int level = lw_menu_level ();
-	  if (level > 3)
-	    {
-	      lw_pop_menu ();
-	      lw_display_menu (CurrentTime);
-	    }
-	  else
-	    menu_move_left ();
-	}
-else if (EQ (binding, Qmenu_right))
-	{
-	  int level = lw_menu_level ();
-	  if (level > 2 &&
-	      lw_get_entries (False)->contents)
-	    {
-	      widget_value *current = lw_get_entries (False);
-	      if (current->contents)
-		menu_select_item (NULL);
-	    }
-	  else
-	    menu_move_right ();
-	}
-else if (EQ (binding, Qmenu_select))
-	menu_select_item (NULL);
-else if (EQ (binding, Qmenu_escape))
-	{
-	  int level = lw_menu_level ();
-	  if (level > 2)
-	    {
-	      lw_pop_menu ();
-	      lw_display_menu (CurrentTime);
-	    }
-	  else
-	    {
-	      /* turn off menus quietly */
-	      lw_kill_menus (NULL);
-	    }
-	}
-else if (KEYMAPP (binding))
-	{
-	  /* prefix key */
-	  reset_this_command_keys (Vselected_console, 1);
-	  /*reset_command_builder_event_chain (builder);*/
-	  return binding;
-	}
-else
-	{
-	  /* turn off menus and execute binding */
-	  lw_kill_menus (NULL);
-	  reset_this_command_keys (Vselected_console, 1);
-	  /*reset_command_builder_event_chain (builder);*/
-	  return binding;
-	}
-}
-if (lw_menu_active) lw_display_menu (CurrentTime);
-reset_this_command_keys (Vselected_console, 1);
-/*reset_command_builder_event_chain (builder);*/
-return Vmenu_accelerator_map;
-}
-static Lisp_Object
-menu_accelerator_junk_on_error (Lisp_Object errordata, Lisp_Object ignored)
-{
-Vmenu_accelerator_prefix    = Qnil;
-Vmenu_accelerator_modifiers = Qnil;
-Vmenu_accelerator_enabled   = Qnil;
-if (!NILP (errordata))
-{
-Lisp_Object args[2];
-args[0] = build_string ("Error in menu accelerators (setting to nil)");
-/* #### This should call
-	 (with-output-to-string (display-error errordata))
-	 but that stuff is all in Lisp currently. */
-args[1] = errordata;
-warn_when_safe_lispobj
-	(Qerror, Qwarning,
-	 emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s",
-				   Qnil, -1, 2, args));
-}
-return Qnil;
-}
-static Lisp_Object
-menu_accelerator_safe_compare (Lisp_Object event0)
-{
-if (CONSP (Vmenu_accelerator_prefix))
-{
-Lisp_Object t;
-t=Vmenu_accelerator_prefix;
-while (!NILP (t)
-	     && !NILP (event0)
-	     && event_matches_key_specifier_p (XEVENT (event0), Fcar (t)))
-	{
-	  t = Fcdr (t);
-	  event0 = XEVENT_NEXT (event0);
-	}
-if (!NILP (t))
-	return Qnil;
-}
-else if (NILP (event0))
-return Qnil;
-else if (event_matches_key_specifier_p (XEVENT (event0), Vmenu_accelerator_prefix))
-event0 = XEVENT_NEXT (event0);
-else
-return Qnil;
-return event0;
-}
-static Lisp_Object
-menu_accelerator_safe_mod_compare (Lisp_Object cons)
-{
-return (event_matches_key_specifier_p (XEVENT (XCAR (cons)), XCDR (cons))
-	  ? Qt
-	  : Qnil);
-}
-static Lisp_Object
-command_builder_find_menu_accelerator (struct command_builder *builder)
-{
-/* this function can GC */
-Lisp_Object event0 = builder->current_events;
-struct console *con = XCONSOLE (Vselected_console);
-struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
-Widget menubar_widget;
-/* compare entries in event0 against the menu prefix */
-if ((!CONSOLE_X_P (XCONSOLE (builder->console))) || NILP (event0) ||
-XEVENT (event0)->event_type != key_press_event)
-return Qnil;
-if (!NILP (Vmenu_accelerator_prefix))
-{
-event0 = condition_case_1 (Qerror,
-				 menu_accelerator_safe_compare,
-				 event0,
-				 menu_accelerator_junk_on_error,
-				 Qnil);
-}
-if (NILP (event0))
-return Qnil;
-menubar_widget = FRAME_X_MENUBAR_WIDGET (f);
-if (menubar_widget
-&& CONSP (Vmenu_accelerator_modifiers))
-{
-Lisp_Object fake;
-Lisp_Object last = Qnil;
-struct gcpro gcpro1;
-Lisp_Object matchp;
-widget_value *val;
-LWLIB_ID id = XPOPUP_DATA (f->menubar_data)->id;
-val = lw_get_all_values (id);
-if (val)
-	{
-	  val = val->contents;
-	  fake = Fcopy_sequence (Vmenu_accelerator_modifiers);
-	  last = fake;
-	  while (!NILP (Fcdr (last)))
-	    last = Fcdr (last);
-	  Fsetcdr (last, Fcons (Qnil, Qnil));
-	  last = Fcdr (last);
-	}
-fake = Fcons (Qnil, fake);
-GCPRO1 (fake);
-while (val)
-	{
-	  Lisp_Object accel;
-	  VOID_TO_LISP (accel, val->accel);
-	  if (val->name && !NILP (accel))
-	    {
-	      Fsetcar (last, accel);
-	      Fsetcar (fake, event0);
-	      matchp = condition_case_1 (Qerror,
-					 menu_accelerator_safe_mod_compare,
-					 fake,
-					 menu_accelerator_junk_on_error,
-					 Qnil);
-	      if (!NILP (matchp))
-		{
-		  /* we found one! */
-		  lw_set_menu (menubar_widget, val);
-		  /* yah - yet another hack.
-		     pretend emacs timestamp is the same as an X timestamp,
-		     which for the moment it is.  (read events.h)
-		     */
-		  lw_map_menu (XEVENT (event0)->timestamp);
-		  if (val->contents)
-		    lw_push_menu (val->contents);
-		  lw_display_menu (CurrentTime);
-		  /* menu accelerator keys don't go into keyboard macros */
-		  if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
-		    con->kbd_macro_ptr = con->kbd_macro_end;
-		  /* don't echo menu accelerator keys */
-		  /*reset_key_echo (builder, 1);*/
-		  reset_this_command_keys (Vselected_console, 1);
-		  UNGCPRO;
-		  return Vmenu_accelerator_map;
-		}
-	    }
-	  val = val->next;
-	}
-UNGCPRO;
-}
-return Qnil;
-}
-DEFUN ("accelerate-menu", Faccelerate_menu, 0, 0, "_", /*
-Make the menubar active.  Menu items can be selected using menu accelerators
-or by actions defined in menu-accelerator-map.
-*/
-())
-{
-struct console *con = XCONSOLE (Vselected_console);
-struct frame *f = XFRAME (CONSOLE_SELECTED_FRAME (con));
-LWLIB_ID id;
-widget_value *val;
-if (NILP (f->menubar_data))
-error ("Frame has no menubar.");
-id = XPOPUP_DATA (f->menubar_data)->id;
-val = lw_get_all_values (id);
-val = val->contents;
-lw_set_menu (FRAME_X_MENUBAR_WIDGET (f), val);
-lw_map_menu (CurrentTime);
-lw_display_menu (CurrentTime);
-/* menu accelerator keys don't go into keyboard macros */
-if (!NILP (con->defining_kbd_macro) && NILP (Vexecuting_macro))
-con->kbd_macro_ptr = con->kbd_macro_end;
-return Qnil;
-}
-#endif /* HAVE_X_WINDOWS && HAVE_MENUBARS */
 /* 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. */
 static Lisp_Object
 		      XEVENT (evee)->event.eval.object);
 else
 	return Qnil;
 }
-/* if we're currently in a menu accelerator, check there for further events */
+/* if we're currently in a menu accelerator, check there for further
+events */
+/* #### fuck me!  who wrote this crap?  think "abstraction", baby. */
 #if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
-if (lw_menu_active)
+if (x_kludge_lw_menu_active ())
 {
 return command_builder_operate_menu_accelerator (builder);
 }
 else
 {
 && !NILP (Vretry_undefined_key_binding_unshifted))
 {
 Lisp_Object terminal = builder->most_current_event;
 struct key_data* key = & XEVENT (terminal)->event.key;
 Emchar c = 0;
-if ((key->modifiers & MOD_SHIFT)
+if ((key->modifiers & XEMACS_MOD_SHIFT)
 || (CHAR_OR_CHAR_INTP (key->keysym)
 && ((c = XCHAR_OR_CHAR_INT (key->keysym)), c >= 'A' && c <= 'Z')))
 {
 Lisp_Event terminal_copy = *XEVENT (terminal);
-if (key->modifiers & MOD_SHIFT)
+if (key->modifiers & XEMACS_MOD_SHIFT)
-key->modifiers &= (~ MOD_SHIFT);
+key->modifiers &= (~ XEMACS_MOD_SHIFT);
 else
 key->keysym = make_char (c + 'a' - 'A');
 result = command_builder_find_leaf (builder, allow_misc_user_events_p);
 if (!NILP (result))
 	   pushing a new event.
 	   */
 	Fcopy_event (event, recent);
 	e = XEVENT (recent);
 	if (e->event_type == key_press_event)
-	  e->event.key.modifiers |= MOD_META;
+	  e->event.key.modifiers |= XEMACS_MOD_META;
 	else if (e->event_type == button_press_event
 		 || e->event_type == button_release_event)
-	  e->event.button.modifiers |= MOD_META;
+	  e->event.button.modifiers |= XEMACS_MOD_META;
 	else
 	  abort ();
 	{
 	  int tckn = event_chain_count (Vthis_command_keys);
 struct gcpro gcpro1;
 GCPRO1 (leaf);
 if (KEYMAPP (leaf))
 {
-	if (!lw_menu_active)
+#if defined (HAVE_X_WINDOWS) && defined (LWLIB_MENUBARS_LUCID)
+if (!x_kludge_lw_menu_active ())
+#else
+	if (1)
+#endif
 	  {
 	    Lisp_Object prompt = Fkeymap_prompt (leaf, Qt);
 	    if (STRINGP (prompt))
 	      {
 		/* Append keymap prompt to key echo buffer */
 		maybe_echo_keys (command_builder, 1);
 	      }
 	    else
 	      maybe_echo_keys (command_builder, 0);
 	  }
-	else if (!NILP (Vquit_flag)) {
+	else if (!NILP (Vquit_flag))
-	  Lisp_Object quit_event = Fmake_event(Qnil, Qnil);
+	  {
-	  Lisp_Event *e = XEVENT (quit_event);
+	    Lisp_Object quit_event = Fmake_event (Qnil, Qnil);
-	  /* if quit happened during menu acceleration, pretend we read it */
+	    Lisp_Event *e = XEVENT (quit_event);
-	  struct console *con = XCONSOLE (Fselected_console ());
+	    /* if quit happened during menu acceleration, pretend we read it */
-	  int ch = CONSOLE_QUIT_CHAR (con);
+	    struct console *con = XCONSOLE (Fselected_console ());
+	    int ch = CONSOLE_QUIT_CHAR (con);
-	  character_to_event (ch, e, con, 1, 1);
-	  e->channel = make_console (con);
+	    character_to_event (ch, e, con, 1, 1);
+	    e->channel = make_console (con);
-	  enqueue_command_event (quit_event);
-	  Vquit_flag = Qnil;
+	    enqueue_command_event (quit_event);
-	}
+	    Vquit_flag = Qnil;
+	  }
 }
 else if (!NILP (leaf))
 {
 	if (EQ (Qcommand, echo_area_status (f))
 	    && command_builder->echo_buf_index > 0)
 }
 else
 {
 	/* Start a new command next time */
 	Vlast_command = Vthis_command;
+	Vlast_command_properties = Vthis_command_properties;
+	Vthis_command_properties = Qnil;
 	/* Emacs 18 doesn't unconditionally clear the echoed keystrokes,
 	   so we don't either */
 	reset_this_command_keys (make_console (con), 0);
 }
 }
 XSETBUFFER (last_point_position_buffer, current_buffer);
 /* This function can GC */
 safe_run_hook_trapping_errors
 ("Error in `pre-command-hook' (setting hook to nil)",
 Qpre_command_hook, 1);
+/* This is a kludge, but necessary; see simple.el */
+call0 (Qhandle_pre_motion_command);
 }
 /* Run the post command hook. */
 static void
 we don't want the user to accidentally remove it.
 */
 Lisp_Object win = Fselected_window (Qnil);
-#if 0
 /* If the last command deleted the frame, `win' might be nil.
 It seems safest to do nothing in this case. */
+/* Note: Someone added the following comment and put #if 0's around
+this code, not realizing that doing this invites a crash in the
+line after. */
 /* #### This doesn't really fix the problem,
 if delete-frame is called by some hook */
 if (NILP (win))
 return;
-#endif
+/* This is a kludge, but necessary; see simple.el */
+call0 (Qhandle_post_motion_command);
 if (! zmacs_region_stays
 && (!MINI_WINDOW_P (XWINDOW (win))
 || EQ (zmacs_region_buffer (), WINDOW_BUFFER (XWINDOW (win)))))
 zmacs_deactivate_region ();
 safe_run_hook_trapping_errors
 ("Error in `post-command-hook' (setting hook to nil)",
 Qpost_command_hook, 1);
-#ifdef DEFERRED_ACTION_CRAP
+#if 0 /* FSF Emacs crap */
 if (!NILP (Vdeferred_action_list))
 call0 (Vdeferred_action_function);
-#endif
-#ifdef ILL_CONCEIVED_HOOK
 if (NILP (Vunread_command_events)
 && NILP (Vexecuting_macro)
 && !NILP (Vpost_command_idle_hook)
 && !NILP (Fsit_for (make_float ((double) post_command_idle_delay
 				      / 1000000), Qnil)))
 safe_run_hook_trapping_errors
 ("Error in `post-command-idle-hook' (setting hook to nil)",
 Qpost_command_idle_hook, 1);
-#endif
+#endif /* FSF Emacs crap */
-#if 0 /* FSFmacs */
+#if 0 /* FSF Emacs */
 if (!NILP (current_buffer->mark_active))
 {
 if (!NILP (Vdeactivate_mark) && !NILP (Vtransient_mark_mode))
 {
 current_buffer->mark_active = Qnil;
 }
 else if (current_buffer != prev_buffer ||
 	       BUF_MODIFF (current_buffer) != prev_modiff)
 	run_hook (intern ("activate-mark-hook"));
 }
-#endif /* FSFmacs */
+#endif /* FSF Emacs */
 /* #### Kludge!!! This is necessary to make sure that things
 are properly positioned even if post-command-hook moves point.
 #### There should be a cleaner way of handling this. */
 call0 (Qauto_show_make_point_visible);
 	       minibuffer.  If the command we are about to execute is
 	       self-insert, it's tricky: up to 20 consecutive self-inserts may
 	       be done without an undo boundary.  This counter is reset as
 	       soon as a command other than self-insert-command is executed.
-	       Programmers can also use the `self-insert-undo-magic'
+	       Programmers can also use the `self-insert-defer-undo'
-	       property to install that behaviour on functions other
+	       property to install that behavior on functions other
 	       than `self-insert-command', or to change the magic
-	       number 20 to something else.  */
+	       number 20 to something else.  #### DOCUMENT THIS!  */
 	    if (SYMBOLP (leaf))
 	      {
 		Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
 		if (NATNUMP (prop))
 }
 return Qnil;
 }
+DEFUN ("current-event-timestamp", Fcurrent_event_timestamp, 0, 1, 0, /*
+Return the current event timestamp of the window system associated with CONSOLE.
+CONSOLE defaults to the selected console if omitted.
+*/
+(console))
+{
+struct console *c = decode_console (console);
+int tiempo = event_stream_current_event_timestamp (c);
+/* This junk is so that timestamps don't get to be negative, but contain
+as many bits as this particular emacs will allow.
+*/
+return make_int (((1L << (VALBITS - 1)) - 1) & tiempo);
+}
 /************************************************************************/
 /*                            initialization                            */
 /************************************************************************/
 void
 syms_of_event_stream (void)
 {
+INIT_LRECORD_IMPLEMENTATION (command_builder);
+INIT_LRECORD_IMPLEMENTATION (timeout);
 defsymbol (&Qdisabled, "disabled");
 defsymbol (&Qcommand_event_p, "command-event-p");
-deferror (&Qundefined_keystroke_sequence, "undefined-keystroke-sequence",
+DEFERROR_STANDARD (Qundefined_keystroke_sequence, Qinvalid_argument);
-"Undefined keystroke sequence", Qerror);
 DEFSUBR (Frecent_keys);
 DEFSUBR (Frecent_keys_ring_size);
 DEFSUBR (Fset_recent_keys_ring_size);
 DEFSUBR (Finput_pending_p);
 DEFSUBR (Fadd_timeout);
 DEFSUBR (Fdisable_timeout);
 DEFSUBR (Fadd_async_timeout);
 DEFSUBR (Fdisable_async_timeout);
 DEFSUBR (Fdispatch_event);
+DEFSUBR (Fdispatch_non_command_events);
 DEFSUBR (Fread_key_sequence);
 DEFSUBR (Fthis_command_keys);
 DEFSUBR (Freset_this_command_lengths);
 DEFSUBR (Fopen_dribble_file);
-#if defined(HAVE_X_WINDOWS) && defined(LWLIB_MENUBARS_LUCID)
+DEFSUBR (Fcurrent_event_timestamp);
-DEFSUBR (Faccelerate_menu);
-#endif
 defsymbol (&Qpre_command_hook, "pre-command-hook");
 defsymbol (&Qpost_command_hook, "post-command-hook");
 defsymbol (&Qunread_command_events, "unread-command-events");
 defsymbol (&Qunread_command_event, "unread-command-event");
 defsymbol (&Qpre_idle_hook, "pre-idle-hook");
-#ifdef ILL_CONCEIVED_HOOK
+defsymbol (&Qhandle_pre_motion_command, "handle-pre-motion-command");
+defsymbol (&Qhandle_post_motion_command, "handle-post-motion-command");
+#if 0 /* FSF Emacs crap */
 defsymbol (&Qpost_command_idle_hook, "post-command-idle-hook");
-#endif
-#ifdef DEFERRED_ACTION_CRAP
 defsymbol (&Qdeferred_action_function, "deferred-action-function");
 #endif
 defsymbol (&Qretry_undefined_key_binding_unshifted,
 	     "retry-undefined-key-binding-unshifted");
 defsymbol (&Qauto_show_make_point_visible,
 	     "auto-show-make-point-visible");
-defsymbol (&Qmenu_force, "menu-force");
-defsymbol (&Qmenu_fallback, "menu-fallback");
-defsymbol (&Qmenu_quit, "menu-quit");
-defsymbol (&Qmenu_up, "menu-up");
-defsymbol (&Qmenu_down, "menu-down");
-defsymbol (&Qmenu_left, "menu-left");
-defsymbol (&Qmenu_right, "menu-right");
-defsymbol (&Qmenu_select, "menu-select");
-defsymbol (&Qmenu_escape, "menu-escape");
 defsymbol (&Qself_insert_defer_undo, "self-insert-defer-undo");
 defsymbol (&Qcancel_mode_internal, "cancel-mode-internal");
 }
 DEFVAR_LISP ("pre-idle-hook", &Vpre_idle_hook /*
 Normal hook run when XEmacs it about to be idle.
 This occurs whenever it is going to block, waiting for an event.
 This generally happens as a result of a call to `next-event',
 `next-command-event', `sit-for', `sleep-for', `accept-process-output',
-`x-get-selection', or various Energize-specific commands.
+or `x-get-selection'.
 Errors running the hook are caught and ignored.
 */ );
 Vpre_idle_hook = Qnil;
 DEFVAR_BOOL ("focus-follows-mouse", &focus_follows_mouse /*
 the keyboard focus.  XEmacs cannot in general detect when this mode is
 used by the window manager, so it is up to the user to set it.
 */ );
 focus_follows_mouse = 0;
-#ifdef ILL_CONCEIVED_HOOK
+#if 0 /* FSF Emacs crap */
 /* Ill-conceived because it's not run in all sorts of cases
 where XEmacs is blocking.  That's what `pre-idle-hook'
 is designed to solve. */
 xxDEFVAR_LISP ("post-command-idle-hook", &Vpost_command_idle_hook /*
 Normal hook run after each command is executed, if idle.
 xxDEFVAR_INT ("post-command-idle-delay", &post_command_idle_delay /*
 Delay time before running `post-command-idle-hook'.
 This is measured in microseconds.
 */ );
 post_command_idle_delay = 5000;
-#endif /* ILL_CONCEIVED_HOOK */
-#ifdef DEFERRED_ACTION_CRAP
 /* Random FSFmacs crap.  There is absolutely nothing to gain,
 and a great deal to lose, in using this in place of just
 setting `post-command-hook'. */
 xxDEFVAR_LISP ("deferred-action-list", &Vdeferred_action_list /*
 List of deferred actions to be performed at a later time.
 Function to call to handle deferred actions, after each command.
 This function is called with no arguments after each command
 whenever `deferred-action-list' is non-nil.
 */ );
 Vdeferred_action_function = Qnil;
-#endif /* DEFERRED_ACTION_CRAP */
+#endif /* FSF Emacs crap */
 DEFVAR_LISP ("last-command-event", &Vlast_command_event /*
 Last keyboard or mouse button event that was part of a command.  This
 variable is off limits: you may not set its value or modify the event that
 is its value, as it is destructively modified by `read-key-sequence'.  If
 The command can set this variable; whatever is put here
 will be in `last-command' during the following command.
 */ );
 Vthis_command = Qnil;
+DEFVAR_LISP ("last-command-properties", &Vlast_command_properties /*
+Value of `this-command-properties' for the last command.
+Used by commands to help synchronize consecutive commands, in preference
+to looking at `last-command' directly.
+*/ );
+Vlast_command_properties = Qnil;
+DEFVAR_LISP ("this-command-properties", &Vthis_command_properties /*
+Properties set by the current command.
+At the beginning of each command, the current value of this variable is
+copied to `last-command-properties', and then it is set to nil.  Use `putf'
+to add properties to this variable.  Commands should use this to communicate
+with pre/post-command hooks, subsequent commands, wrapping commands, etc.
+in preference to looking at and/or setting `this-command'.
+*/ );
+Vthis_command_properties = Qnil;
 DEFVAR_LISP ("help-char", &Vhelp_char /*
 Character to recognize as meaning Help.
 When it is read, do `(eval help-form)', and display result if it's a string.
 If the value of `help-form' is nil, this char can be read normally.
 This can be any form recognized as a single key specifier.
 -- If an entry maps a symbol to a symbol, then a key-press event whose
 keysym is the former symbol (with any modifiers at all) gets its
 keysym changed and its modifiers left alone.  This is useful for
 dealing with non-standard X keyboards, such as the grievous damage
 that Sun has inflicted upon the world.
+-- If an entry maps a symbol to a character, then a key-press event
+whose keysym is the former symbol (with any modifiers at all) gets
+changed into a key-press event matching the latter character, and the
+resulting modifiers are the union of the original and new modifiers.
 -- If an entry maps a character to a character, then a key-press event
 matching the former character gets converted to a key-press event
 matching the latter character.  This is useful on ASCII terminals
 for (e.g.) making C-\\ look like C-s, to get around flow-control
 problems.
 -- If an entry maps a character to a symbol, then a key-press event
 matching the character gets converted to a key-press event whose
 keysym is the given symbol and which has no modifiers.
+Here's an example: This makes typing parens and braces easier by rerouting
+their positions to eliminate the need to use the Shift key.
+(keyboard-translate ?[ ?()
+(keyboard-translate ?] ?))
+(keyboard-translate ?{ ?[)
+(keyboard-translate ?} ?])
+(keyboard-translate 'f11 ?{)
+(keyboard-translate 'f12 ?})
 */ );
 DEFVAR_LISP ("retry-undefined-key-binding-unshifted",
 &Vretry_undefined_key_binding_unshifted /*
 If a key-sequence which ends with a shifted keystroke is undefined
 with the last key unshifted.  (e.g. C-X C-F would be retried as C-X C-f.)
 If lookup still fails, a normal error is signalled.  In general,
 you should *bind* this, not set it.
 */ );
 Vretry_undefined_key_binding_unshifted = Qt;
+DEFVAR_BOOL ("modifier-keys-are-sticky", &modifier_keys_are_sticky /*
+*Non-nil makes modifier keys sticky.
+This means that you can release the modifier key before pressing down
+the key that you wish to be modified.  Although this is non-standard
+behavior, it is recommended because it reduces the strain on your hand,
+thus reducing the incidence of the dreaded Emacs-pinky syndrome.
+*/ );
+modifier_keys_are_sticky = 0;
 #ifdef HAVE_XIM
 DEFVAR_LISP ("composed-character-default-binding",
 &Vcomposed_character_default_binding /*
 The default keybinding to use for key events from composed input.
 DEFVAR_BOOL ("inhibit-input-event-recording", &inhibit_input_event_recording /*
 Non-nil inhibits recording of input-events to recent-keys ring.
 */ );
 inhibit_input_event_recording = 0;
-DEFVAR_LISP("menu-accelerator-prefix", &Vmenu_accelerator_prefix /*
-Prefix key(s) that must be typed before menu accelerators will be activated.
-Set this to a value acceptable by define-key.
-*/ );
-Vmenu_accelerator_prefix = Qnil;
-DEFVAR_LISP ("menu-accelerator-modifiers", &Vmenu_accelerator_modifiers /*
-Modifier keys which must be pressed to get to the top level menu accelerators.
-This is a list of modifier key symbols.  All modifier keys must be held down
-while a valid menu accelerator key is pressed in order for the top level
-menu to become active.
-See also menu-accelerator-enabled and menu-accelerator-prefix.
-*/ );
-Vmenu_accelerator_modifiers = list1 (Qmeta);
-DEFVAR_LISP ("menu-accelerator-enabled", &Vmenu_accelerator_enabled /*
-Whether menu accelerator keys can cause the menubar to become active.
-If 'menu-force or 'menu-fallback, then menu accelerator keys can
-be used to activate the top level menu.  Once the menubar becomes active, the
-accelerator keys can be used regardless of the value of this variable.
-menu-force is used to indicate that the menu accelerator key takes
-precedence over bindings in the current keymap(s).  menu-fallback means
-that bindings in the current keymap take precedence over menu accelerator keys.
-Thus a top level menu with an accelerator of "T" would be activated on a
-keypress of Meta-t if menu-accelerator-enabled is menu-force.
-However, if menu-accelerator-enabled is menu-fallback, then
-Meta-t will not activate the menubar and will instead run the function
-transpose-words, to which it is normally bound.
-See also menu-accelerator-modifiers and menu-accelerator-prefix.
-*/ );
-Vmenu_accelerator_enabled = Qnil;
 }
 void
 complex_vars_of_event_stream (void)
 {
 Vkeyboard_translate_table =
 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
-DEFVAR_LISP ("menu-accelerator-map", &Vmenu_accelerator_map /*
-Keymap for use when the menubar is active.
-The actions menu-quit, menu-up, menu-down, menu-left, menu-right,
-menu-select and menu-escape can be mapped to keys in this map.
-menu-quit    Immediately deactivate the menubar and any open submenus without
-selecting an item.
-menu-up      Move the menu cursor up one row in the current menu.  If the
-move extends past the top of the menu, wrap around to the bottom.
-menu-down    Move the menu cursor down one row in the current menu.  If the
-move extends past the bottom of the menu, wrap around to the top.
-If executed while the cursor is in the top level menu, move down
-into the selected menu.
-menu-left    Move the cursor from a submenu into the parent menu.  If executed
-while the cursor is in the top level menu, move the cursor to the
-left.  If the move extends past the left edge of the menu, wrap
-around to the right edge.
-menu-right   Move the cursor into a submenu.  If the cursor is located in the
-top level menu or is not currently on a submenu heading, then move
-the cursor to the next top level menu entry.  If the move extends
-past the right edge of the menu, wrap around to the left edge.
-menu-select  Activate the item under the cursor.  If the cursor is located on
-a submenu heading, then move the cursor into the submenu.
-menu-escape  Pop up to the next level of menus.  Moves from a submenu into its
-parent menu.  From the top level menu, this deactivates the
-menubar.
-This keymap can also contain normal key-command bindings, in which case the
-menubar is deactivated and the corresponding command is executed.
-The action bindings used by the menu accelerator code are designed to mimic
-the actions of menu traversal keys in a commonly used PC operating system.
-*/ );
-Vmenu_accelerator_map = Fmake_keymap(Qnil);
 }
 void
 init_event_stream (void)
 {

Mercurial > hg > xemacs-beta

comparison src/event-stream.c @ 442:abe6d1db359e r21-2-36