/* The event_stream interface for X11 with Xt, and/or tty screens.
   Copyright (C) 1991, 1992 Free Software Foundation, Inc.

This file is part of GNU Emacs.

GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING.  If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */

#include <stdio.h>
#include <X11/X.h>
#include <X11/Xlib.h>
#include <X11/Xatom.h>
#include <X11/keysym.h>
#include <X11/IntrinsicP.h>	/* only describe_event() needs this */
#include <X11/Xproto.h>		/* only describe_event() needs this */
#include "ScreenWidgetP.h"

#include "config.h"
#include "lisp.h"
#include "process.h"
#include "events.h"

#include "blockio.h"
#include "dispextern.h"
#include "screen.h"
#include "xterm.h"		/* only describe_event() needs this */

static void describe_event ();
void emacs_Xt_focus_event_handler ();

/* The timestamp of the last button or key event used by emacs itself.
   This is used for asserting selections and input focus. */
Time mouse_timestamp;

/* This is the timestamp the last button or key event wether it was
   dispatched to emacs or widgets. */
Time global_mouse_timestamp;

/* This is the last known timestamp received from the server.  It is 
   maintained by x_event_to_emacs_event and used to patch bogus 
   WM_TAKE_FOCUS messages sent by Mwm. */
Time last_server_timestamp;

extern struct screen *x_window_to_screen (Window),
*x_any_window_to_screen (Window);

extern XtAppContext Xt_app_con;

extern Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn;
extern Lisp_Object QKescape, QKspace, QKdelete, QKnosymbol;

extern Lisp_Object Qeval;
extern Lisp_Object Qx_EnterNotify_internal, Qx_LeaveNotify_internal;
extern Lisp_Object Qx_FocusIn_internal, Qx_FocusOut_internal;
extern Lisp_Object Qx_VisibilityNotify_internal;
extern Lisp_Object Qx_non_VisibilityNotify_internal;
extern Lisp_Object Qx_MapNotify_internal, Qx_UnmapNotify_internal;

extern Display *x_current_display;
extern Atom Xatom_WM_PROTOCOLS, Xatom_WM_DELETE_WINDOW, Xatom_WM_TAKE_FOCUS;


/* X bogusly doesn't define the interpretations of any bits besides
   ModControl, ModShift, and ModLock; so the Interclient Communication
   Conventions Manual says that we have to bend over backwards to figure
   out what the other modifier bits mean.  According to ICCCM:

   - Any keycode which is assigned ModControl is a "control" key.

   - Any modifier bit which is assigned to a keycode which generates Meta_L
     or Meta_R is the modifier bit meaning "meta".  Likewise for Super, Hyper,
     etc.

   - Any keypress event which contains ModControl in its state should be
     interpreted as a "control" character.

   - Any keypress event which contains a modifier bit in its state which is
     generated by a keycode whose corresponding keysym is Meta_L or Meta_R
     should be interpreted as a "meta" character.  Likewise for Super, Hyper,
     etc.

   - It is illegal for a keysym to be associated with more than one modifier
     bit.

   This means that the only thing that emacs can reasonably interpret as a
   "meta" key is a key whose keysym is Meta_L or Meta_R, and which generates
   one of the modifier bits Mod1-Mod5.

   Unfortunately, many keyboards don't have Meta keys in their default
   configuration.  So, if there are no Meta keys, but there are "Alt" keys,
   emacs will interpret Alt as Meta.  If there are both Meta and Alt keys,
   then the Meta keys mean "Meta", and the Alt keys mean "Symbol".

   This works with the default configurations of the 19 keyboard-types I've
   checked.

   Emacs detects keyboard configurations which violate the above rules, and
   prints an error message on the standard-error-output.  (Perhaps it should
   use a pop-up-window instead.)
 */

static int MetaMask, HyperMask, SuperMask, SymbolMask, ModeMask;
static KeySym lock_interpretation;

static XModifierKeymap *x_modifier_keymap;

static KeySym *x_keysym_map;
static int x_keysym_map_min_code;
static int x_keysym_map_keysyms_per_code;

static void
x_reset_key_mapping (display)
     Display *display;
{
  int max_code;
  if (x_keysym_map)
    XFree ((char *) x_keysym_map);
  BLOCK_INPUT;
  XDisplayKeycodes (display, &x_keysym_map_min_code, &max_code);
  x_keysym_map = XGetKeyboardMapping (display, x_keysym_map_min_code,
				      max_code - x_keysym_map_min_code + 1,
				      &x_keysym_map_keysyms_per_code);
  UNBLOCK_INPUT;
}


static void
x_reset_modifier_mapping (display)
     Display *display;
{
  int modifier_index, modifier_key, column, mkpm;
  int warned_about_overlapping_modifiers = 0;
  int warned_about_predefined_modifiers = 0;
  int warned_about_duplicate_modifiers = 0;
  int meta_bit = 0;
  int hyper_bit = 0;
  int super_bit = 0;
  int symbol_bit = 0;
  int mode_bit = 0;

  lock_interpretation = 0;

  if (x_modifier_keymap)
    XFreeModifiermap (x_modifier_keymap);

  x_reset_key_mapping (display);

  BLOCK_INPUT;
  x_modifier_keymap = XGetModifierMapping (display);

  /* Boy, I really wish C had local functions...
   */
#define index_to_name(index) \
  ((index == 0 ? "ModShift" : (index == 1 ? "ModLock" : \
    (index == 2 ? "ModControl" : (index == 3 ? "Mod1" : \
     (index == 4 ? "Mod2" : (index == 5 ? "Mod3" : \
      (index == 6 ? "Mod4" : (index == 7 ? "Mod5" : "???")))))))))

#define modwarn(name,old,other) \
  fprintf (stderr, \
	   "emacs:  %s (0x%x) generates %s, which is generated by %s.\n", \
	     name, code, index_to_name (old), other), \
  warned_about_overlapping_modifiers = 1

#define modbarf(name,other) \
  fprintf (stderr, "emacs:  %s (0x%x) generates %s, which is nonsensical.\n", \
	   name, code, other), \
  warned_about_predefined_modifiers = 1

#define check_modifier(name,mask) \
  if ((1<<modifier_index) != mask) \
     fprintf (stderr, \
	      "emacs:  %s (0x%x) generates %s, which is nonsensical.\n", \
	      name, code, index_to_name (modifier_index)), \
     warned_about_predefined_modifiers = 1

#define store_modifier(name,old) \
  if (old && old != modifier_index) \
    fprintf (stderr, \
   "emacs:  %s (0x%x) generates both %s and %s, which is nonsensical.\n",\
	     name, code, index_to_name(old), index_to_name(modifier_index)), \
    warned_about_duplicate_modifiers = 1; \
  if (modifier_index == 0) modbarf (name,"ModShift"); \
  else if (modifier_index == 1) modbarf (name,"ModLock"); \
  else if (modifier_index == 2) modbarf (name,"ModControl"); \
  else if (sym == XK_Mode_switch) \
    mode_bit = modifier_index; /* Mode_switch is special, see below... */ \
  else if (modifier_index == meta_bit && old != meta_bit) \
    modwarn (name, meta_bit, "Meta"); \
  else if (modifier_index == super_bit && old != super_bit) \
    modwarn (name, super_bit, "Super"); \
  else if (modifier_index == hyper_bit && old != hyper_bit) \
    modwarn (name, hyper_bit, "Hyper"); \
  else if (modifier_index == symbol_bit && old != symbol_bit) \
    modwarn (name, symbol_bit, "Alt"); \
  else \
    old = modifier_index;

  mkpm = x_modifier_keymap->max_keypermod;
  for (modifier_index = 0; modifier_index < 8; modifier_index++)
    for (modifier_key = 0; modifier_key < mkpm; modifier_key++) {
      KeySym last_sym = 0;
      for (column = 0; column < 4; column += 2) {
	KeyCode code = x_modifier_keymap->modifiermap [modifier_index * mkpm
						       + modifier_key];
	KeySym sym = (code ? XKeycodeToKeysym (display, code, column) : 0);
	if (sym == last_sym) continue;
	last_sym = sym;
	switch (sym) {
	case XK_Mode_switch:store_modifier ("Mode_switch", mode_bit); break;
	case XK_Meta_L:     store_modifier ("Meta_L", meta_bit); break;
	case XK_Meta_R:     store_modifier ("Meta_R", meta_bit); break;
	case XK_Super_L:    store_modifier ("Super_L", super_bit); break;
	case XK_Super_R:    store_modifier ("Super_R", super_bit); break;
	case XK_Hyper_L:    store_modifier ("Hyper_L", hyper_bit); break;
	case XK_Hyper_R:    store_modifier ("Hyper_R", hyper_bit); break;
	case XK_Alt_L:      store_modifier ("Alt_L", symbol_bit); break;
	case XK_Alt_R:      store_modifier ("Alt_R", symbol_bit); break;
	case XK_Control_L:  check_modifier ("Control_L", ControlMask); break;
	case XK_Control_R:  check_modifier ("Control_R", ControlMask); break;
	case XK_Shift_L:    check_modifier ("Shift_L", ShiftMask); break;
	case XK_Shift_R:    check_modifier ("Shift_R", ShiftMask); break;
	case XK_Shift_Lock: check_modifier ("Shift_Lock", LockMask);
	  lock_interpretation = XK_Shift_Lock; break;
	case XK_Caps_Lock:  check_modifier ("Caps_Lock", LockMask);
	  lock_interpretation = XK_Caps_Lock; break;

	/* It probably doesn't make any sense for a modifier bit to be
	   assigned to a key that is not one of the above, but OpenWindows
	   assigns modifier bits to a couple of random function keys for
	   no reason that I can discern, so printing a warning here would
	   be annoying.
	 */
	}
      }
    }
#undef store_modifier
#undef check_modifier
#undef modwarn
#undef modbarf

  /* If there was no Meta key, then try using the Alt key instead.
     If there is both a Meta key and an Alt key, then the Alt key
     is treated as Symbol.
   */
  if (! meta_bit && symbol_bit)
    meta_bit = symbol_bit, symbol_bit = 0;

  /* mode_bit overrides everything, since it's processed down inside of
     XLookupString() instead of by us.  If Meta and Mode_switch both
     generate the same modifier bit (which is an error), then we don't
     interpret that bit as Meta, because we can't make XLookupString()
     not interpret it as Mode_switch; and interpreting it as both would
     be totally wrong.
   */
  if (mode_bit)
    {
      char *warn = 0;
      if (mode_bit == meta_bit) warn = "Meta", meta_bit = 0;
      else if (mode_bit == hyper_bit) warn = "Hyper", hyper_bit = 0;
      else if (mode_bit == super_bit) warn = "Super", super_bit = 0;
      else if (mode_bit == symbol_bit) warn = "Symbol", symbol_bit = 0;
      if (warn)
	{
	  fprintf (stderr,
		   "emacs:  %s is being used for both Mode_switch and %s.\n",
		   index_to_name (mode_bit), warn),
	  warned_about_overlapping_modifiers = 1;
	}
    }
#undef index_to_name

  MetaMask   = (meta_bit   ? (1 << meta_bit)  : 0);
  HyperMask  = (hyper_bit  ? (1 << hyper_bit) : 0);
  SuperMask  = (super_bit  ? (1 << super_bit) : 0);
  SymbolMask = (symbol_bit ? (1 << symbol_bit): 0);
  ModeMask   = (mode_bit   ? (1 << mode_bit)  : 0); /* unused */

  UNBLOCK_INPUT;

  if (warned_about_overlapping_modifiers)
    fprintf (stderr, "\n\
	Two distinct modifier keys (such as Meta and Hyper) cannot generate\n\
	the same modifier bit, because Emacs won't be able to tell which\n\
	modifier was actually held down when some other key is pressed.  It\n\
	won't be able to tell Meta-x and Hyper-x apart, for example.  Change\n\
	one of these keys to use some other modifier bit.\n");

  if (warned_about_predefined_modifiers)
    fprintf (stderr, "\n\
	The semantics of the modifier bits ModShift, ModLock, and ModControl\n\
	are predefined.  It does not make sense to assign ModControl to any\n\
	keysym other than Control_L or Control_R, or to assign any modifier\n\
	bits to the \"control\" keysyms other than ModControl.  You can't\n\
	turn a \"control\" key into a \"meta\" key (or vice versa) by simply\n\
	assigning the key a different modifier bit.  You must also make that\n\
	key generate an appropriate keysym (Control_L, Meta_L, etc).\n");

  /* Don\'t need to say anything more for warned_about_duplicate_modifiers. */

  if (warned_about_overlapping_modifiers || warned_about_predefined_modifiers)
    fprintf (stderr, "\n\
	The meanings of the modifier bits Mod1 through Mod5 are determined\n\
	by the keysyms used to control those bits.  Mod1 does NOT always\n\
	mean Meta, although some non-ICCCM-compliant programs assume that.\n");

  if (warned_about_overlapping_modifiers ||
      warned_about_predefined_modifiers ||
      warned_about_duplicate_modifiers)
    fprintf (stderr, "\n");
}

void
x_init_modifier_mapping (display)
     Display *display;
{
  x_keysym_map = 0;
  x_modifier_keymap = 0;
  x_reset_modifier_mapping (display);
}


static int
x_key_is_modifier_p (keycode)
     KeyCode keycode;
{
  KeySym *syms = &x_keysym_map [(keycode - x_keysym_map_min_code) *
				x_keysym_map_keysyms_per_code];
  int i;
  for (i = 0; i < x_keysym_map_keysyms_per_code; i++)
    if (IsModifierKey (syms [i]) ||
	syms [i] == XK_Mode_switch) /* why doesn't IsModifierKey count this? */
      return 1;
  return 0;
}


static int
keysym_obeys_caps_lock_p (sym)
     KeySym sym;
{
  /* Eeeeevil hack.  Don't apply caps-lock to things that aren't alphabetic
     characters, where "alphabetic" means something more than simply A-Z.
     That is, if caps-lock is down, typing ESC doesn't produce Shift-ESC.
     But if shift-lock is down, then it does.
   */
  if (lock_interpretation == XK_Shift_Lock)
    return 1;
  if (((sym >= XK_A) && (sym <= XK_Z)) ||
      ((sym >= XK_a) && (sym <= XK_z)) ||
      ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis)) ||
      ((sym >= XK_agrave) && (sym <= XK_odiaeresis)) ||
      ((sym >= XK_Ooblique) && (sym <= XK_Thorn)) ||
      ((sym >= XK_oslash) && (sym <= XK_thorn)))
    return 1;
  else
    return 0;
}


static XComposeStatus *x_compose_status;

static Lisp_Object
x_to_emacs_keysym (event, simple_p)
     XEvent *event;
     int simple_p;	/* means don't try too hard (ASCII only) */
{
  char *name;
  KeySym keysym = 0;
  
  BLOCK_INPUT;
  XLookupString (&event->xkey, 0, 0, &keysym, x_compose_status);
  UNBLOCK_INPUT;
  
  if (keysym >= XK_exclam && keysym <= XK_asciitilde)
    /* We must assume that the X keysym numbers for the ASCII graphic
       characters are the same as their ASCII codes.  */
    return keysym;

  switch (keysym) {
    /* These would be handled correctly by the default case, but by
       special-casing them here we don't garbage a string or call intern().
       */
  case XK_BackSpace:	return QKbackspace;
  case XK_Tab:		return QKtab;
  case XK_Linefeed:	return QKlinefeed;
  case XK_Return:	return QKreturn;
  case XK_Escape:	return QKescape;
  case XK_space:	return QKspace;
  case XK_Delete:	return QKdelete;
  case 0:		return Qnil;
  default:
    if (simple_p) return Qnil;
    BLOCK_INPUT;
    name = XKeysymToString (keysym);
    UNBLOCK_INPUT;
    if (!name || !name[0])	/* this shouldn't happen... */
      {
	char buf [255];
	sprintf (buf, "unknown_keysym_0x%X", keysym);
	return KEYSYM (buf);
      }
    /* If it's got a one-character name, that's good enough. */
    if (!name[1]) return name[0];

    /* If it's in the "Keyboard" character set, downcase it.
       The case of those keysyms is too totally random for us to
       force anyone to remember them.
       The case of the other character sets is significant, however.
     */
    if ((((unsigned int) keysym) & (~0xFF)) == ((unsigned int) 0xFF00))
      {
	char buf [255];
	char *s1, *s2;
	for (s1 = name, s2 = buf; *s1; s1++, s2++)
	  *s2 = ((*s1 >= 'A' && *s1 <= 'Z') ? (*s1 + ('a'-'A')) : *s1);
	*s2 = 0;
	return KEYSYM (buf);
      }
    return KEYSYM (name);
  }
}


extern int interrupt_char;
extern int x_allow_sendevents;

#ifdef LWLIB_HAS_EXTENSIONS
extern Widget XtWidgetToDispatchTo ();
#endif

static void
set_last_server_timestamp (XEvent* x_event)
{
  switch (x_event->xany.type)
    {
    case KeyPress:
    case KeyRelease:
      last_server_timestamp = x_event->xkey.time;
      break;

    case ButtonPress:
    case ButtonRelease:
      last_server_timestamp = x_event->xbutton.time;
      break;

    case MotionNotify:
      last_server_timestamp = x_event->xmotion.time;
      break;

    case EnterNotify:
    case LeaveNotify:
      last_server_timestamp = x_event->xcrossing.time;
      break;
      
    case PropertyNotify:
      last_server_timestamp = x_event->xproperty.time;
      break;

    case SelectionClear:
      last_server_timestamp = x_event->xselectionclear.time;
      break;

    case SelectionRequest:
      last_server_timestamp = x_event->xselectionrequest.time;
      break;

    case SelectionNotify:
      last_server_timestamp = x_event->xselection.time;
      break;
    }
}

static void
x_event_to_emacs_event (x_event, emacs_event)
     struct Lisp_Event *emacs_event;
     XEvent *x_event;
{
  Display *display = x_event->xany.display;

  set_last_server_timestamp (x_event);

  switch (x_event->xany.type) {
  case KeyPress:
  case ButtonPress:
  case ButtonRelease:
    {
      unsigned int modifiers = 0;
      int shift_p = x_event->xkey.state & ShiftMask;
      int lock_p  = x_event->xkey.state & LockMask;
#ifdef LWLIB_HAS_EXTENSIONS
      Widget to_widget;
#endif

      /* If this is a synthetic KeyPress or Button event, and the user
	 has expressed a disinterest in this security hole, then drop
	 it on the floor.  (Actually, turn it into a no-op XAnyEvent,
	 and turn that into a magic event.  XtDispatchEvent will ignore
	 it.  We have to return some kind of event here, we're committed.
       */
      if (((x_event->xany.type == KeyPress)
	   ? x_event->xkey.send_event
	   : x_event->xbutton.send_event)
	  && !x_allow_sendevents)
	{
	  x_event->xany.type = 0;
	  goto MAGIC;
	}

#ifdef LWLIB_HAS_EXTENSIONS
      BLOCK_INPUT;
      to_widget = XtWidgetToDispatchTo (x_event);
      UNBLOCK_INPUT;
#endif

      if (x_event->xany.type == KeyPress)
	global_mouse_timestamp = x_event->xkey.time;
      else
	global_mouse_timestamp = x_event->xbutton.time;

#ifdef LWLIB_HAS_EXTENSIONS
      if (to_widget && !XtIsSubclass (to_widget, emacsScreenWidgetClass))
	goto MAGIC;
#endif

      /* Ignore the caps-lock key w.r.t. mouse presses and releases. */
      if (x_event->xany.type != KeyPress)
	lock_p = 0;

      if (x_event->xkey.state & ControlMask) modifiers |= MOD_CONTROL;
      if (x_event->xkey.state & MetaMask)    modifiers |= MOD_META;
      if (x_event->xkey.state & SuperMask)   modifiers |= MOD_SUPER;
      if (x_event->xkey.state & HyperMask)   modifiers |= MOD_HYPER;
      if (x_event->xkey.state & SymbolMask)  modifiers |= MOD_SYMBOL;

      /* Ignore the caps-lock key if any other modifiers are down; this is
	 so that Caps doesn't turn C-x into C-X, which would suck. */
      if (modifiers)
	{
	  x_event->xkey.state &= (~LockMask);
	  lock_p = 0;
	}

      if (shift_p || lock_p)
	modifiers |= MOD_SHIFT;

      mouse_timestamp = global_mouse_timestamp;

      switch (x_event->xany.type) {
      case KeyPress:
	{
	  Lisp_Object keysym;
	  struct screen *screen = 0;
	  KeyCode keycode = x_event->xkey.keycode;


	  if (x_key_is_modifier_p (keycode)) /* it's a modifier key */
	    goto MAGIC;

#ifdef LWLIB_HAS_EXTENSIONS
	  if (to_widget)
	    screen = ((EmacsScreenWidget)to_widget)->emacs_screen.screen;
#endif
	  if (!screen)
	    screen = x_any_window_to_screen (x_event->xkey.window);

	  /* This doesn't seem right to me: shouldn't this be "goto MAGIC"? */
	  if (! screen)
	    screen = selected_screen;

	  /* At this point, screen->display.x->input_p may be false.
	     That's ok, because you can get keyboard input even if you
	     don't have focus...
	   */
	  XSET (emacs_event->channel, Lisp_Screen, screen);
	  keysym = x_to_emacs_keysym (x_event, 0);

	  /* If the emacs keysym is nil, then that means that the X keysym
	     was NoSymbol, which probably means that we're in the midst of
	     reading a Multi_key sequence, or a "dead" key prefix.  Ignore
	     it.
	   */
	  if (NILP (keysym))
	    goto MAGIC;

	  /* More caps-lock garbage: caps-lock should *only* add the shift
	     modifier to two-case keys (that is, A-Z and related characters.)
	     So at this point (after looking up the keysym) if the keysym
	     isn't a dual-case alphabetic, and if the caps lock key was down
	     but the shift key wasn't, then turn off the shift modifier.
	     Gag barf retch.
	   */
	  if (! keysym_obeys_caps_lock_p (keysym)
	      && lock_p
	      && !shift_p)
	    modifiers &= (~MOD_SHIFT);

	  /* If this key contains two distinct keysyms, that is, "shift"
	     generates a different keysym than the non-shifted key, then
	     don't apply the shift modifier bit: it's implicit.  Otherwise,
	     if there would be no other way to tell the difference between
	     the shifted and unshifted version of this key, apply the shift
	     bit.  Non-graphics, like Backspace and F1 get the shift bit in
	     the modifiers slot.  Neither the characters "a", "A", "2",
	     nor "@" normally have the shift bit set.  However, "F1"
	     normally does.
	   */
	  if (modifiers & MOD_SHIFT)
	    {
	      KeySym top, bot;
	      if (x_event->xkey.state & ModeMask)
		bot = XLookupKeysym (&x_event->xkey, 2),
		top = XLookupKeysym (&x_event->xkey, 3);
	      else
		bot = XLookupKeysym (&x_event->xkey, 0),
		top = XLookupKeysym (&x_event->xkey, 1);
	      if (top && bot && top != bot)
		modifiers &= ~MOD_SHIFT;
	    }
	  emacs_event->event_type	   = key_press_event;
	  emacs_event->timestamp	   = x_event->xkey.time;
	  emacs_event->event.key.modifiers = modifiers;
	  emacs_event->event.key.key       = keysym;
	  break;
	}
      case ButtonPress:
      case ButtonRelease:
	{
	  struct screen *screen = x_window_to_screen (x_event->xbutton.window);
	  if (! screen)
	    goto MAGIC; /* not for us */
	  XSET (emacs_event->channel, Lisp_Screen, screen);
	}

	if (x_event->type == ButtonPress)
	  emacs_event->event_type    = button_press_event;
	else emacs_event->event_type = button_release_event;
	emacs_event->timestamp		    = x_event->xbutton.time;
	emacs_event->event.button.modifiers = modifiers;
	emacs_event->event.button.button    = x_event->xbutton.button;
	emacs_event->event.button.x         = x_event->xbutton.x;
	emacs_event->event.button.y         = x_event->xbutton.y;
	break;
      }
    }
    break;

  case MotionNotify:
    {
      Window w = x_event->xmotion.window;
      struct screen *screen = x_window_to_screen (w);
      XEvent event2;

      if (! screen)
	goto MAGIC; /* not for us */

      /* We use MotionHintMask, so we will get only one motion event
	 until the next time we call XQueryPointer or the user clicks
	 the mouse.  So call XQueryPointer now (meaning that the event
	 will be in sync with the server just before Fnext_event()
	 returns).  If the mouse is still in motion, then the server
	 will immediately generate exactly one more motion event, which
	 will be on the queue waiting for us next time around.
       */
      event2 = *x_event;
      BLOCK_INPUT;
      if (XQueryPointer (x_event->xmotion.display, event2.xmotion.window,
			 &event2.xmotion.root, &event2.xmotion.subwindow,
			 &event2.xmotion.x_root, &event2.xmotion.y_root,
			 &event2.xmotion.x, &event2.xmotion.y,
			 &event2.xmotion.state))
	*x_event = event2;
      UNBLOCK_INPUT;

      mouse_timestamp = x_event->xmotion.time;

      XSET (emacs_event->channel, Lisp_Screen, screen);
      emacs_event->event_type	  = pointer_motion_event;
      emacs_event->timestamp	  = x_event->xmotion.time;
      emacs_event->event.motion.x = x_event->xmotion.x;
      emacs_event->event.motion.y = x_event->xmotion.y;
    }
    break;
    
  case ClientMessage:
    /* Patch bogus TAKE_FOCUS messages from MWM */
    if (x_event->xclient.message_type == Xatom_WM_PROTOCOLS
	&& x_event->xclient.data.l[0] == Xatom_WM_TAKE_FOCUS
	&& x_event->xclient.data.l[1] == 0)
      {
	x_event->xclient.data.l[1] = last_server_timestamp;
      }
    goto MAGIC;
    break;

  default:
  MAGIC:
    emacs_event->event_type = magic_event;
    emacs_event->channel = make_number (display); /* #### */
    bcopy ((char *) x_event,
	   (char *) &emacs_event->event.magic.underlying_event,
	   sizeof (XEvent));
    break;
  }
}


static void
emacs_Xt_handle_magic_event (emacs_event)
     struct Lisp_Event *emacs_event;
{
  XEvent *event = (XEvent *) &emacs_event->event.magic.underlying_event;
  struct screen *s;
  Display *display = event->xany.display;

    if (display != x_current_display)
      abort ();

  switch (event->type) {

  case SelectionRequest:
    if (x_window_to_screen (event->xselection.requestor))
      x_handle_selection_request (event);
    else
      goto OTHER;
    break;

  case SelectionClear:
    if (x_window_to_screen (event->xselection.requestor))
      x_handle_selection_clear (event);
    else
      goto OTHER;
    break;

  case SelectionNotify:
    if (x_window_to_screen (event->xselection.requestor))
      x_handle_selection_notify (event);
    else
      goto OTHER;
    break;

  case PropertyNotify:
    if (x_window_to_screen (event->xproperty.window))
      x_handle_property_notify (event);
    else
      goto OTHER;
    break;
    
  case Expose:
    if (! (s = x_window_to_screen (event->xexpose.window)))
      goto OTHER;
    repaint_lines (s, event->xexpose.x, event->xexpose.y,
		   event->xexpose.width, event->xexpose.height);
    break;

  case GraphicsExpose:	/* This occurs when an XCopyArea's source area was
			   obscured or not available. */
    if (! (s = x_window_to_screen (event->xexpose.window)))
      goto OTHER;
    repaint_lines (s, event->xgraphicsexpose.x, event->xgraphicsexpose.y,
		   event->xgraphicsexpose.width,
		   event->xgraphicsexpose.height);
    break;

  case MapNotify:
    if (! (s = x_any_window_to_screen (event->xunmap.window)))
      goto OTHER;
    {
      Lisp_Object event = Fallocate_event ();
      XEVENT (event)->event_type = eval_event;
      XEVENT (event)->event.eval.function = Qx_MapNotify_internal;
      XSET (XEVENT (event)->event.eval.object, Lisp_Screen, s);
      enqueue_command_event (event);
    }
    goto OTHER;
    break;

  case UnmapNotify:
    if (! (s = x_any_window_to_screen (event->xunmap.window)))
      goto OTHER;
    {
      Lisp_Object event = Fallocate_event ();
      XEVENT (event)->event_type = eval_event;
      XEVENT (event)->event.eval.function = Qx_UnmapNotify_internal;
      XSET (XEVENT (event)->event.eval.object, Lisp_Screen, s);
      enqueue_command_event (event);
    }
    goto OTHER;
    break;
    
  case EnterNotify:
    {
      if (! (s = x_any_window_to_screen (event->xcrossing.window)))
	goto OTHER;
      if (event->xcrossing.detail != NotifyInferior)
	{
	  Lisp_Object event = Fallocate_event ();
	  XEVENT (event)->event_type = eval_event;
	  XEVENT (event)->event.eval.function = Qx_EnterNotify_internal;
	  XSET (XEVENT (event)->event.eval.object, Lisp_Screen, s);
	  enqueue_command_event (event);
	}
      goto OTHER;
    }
    break;

  case LeaveNotify:
    {
      if (! (s = x_any_window_to_screen (event->xexpose.window)))
	goto OTHER;
      if (event->xcrossing.detail != NotifyInferior)
	{
	  Lisp_Object event = Fallocate_event ();
	  XEVENT (event)->event_type = eval_event;
	  XEVENT (event)->event.eval.function = Qx_LeaveNotify_internal;
	  XSET (XEVENT (event)->event.eval.object, Lisp_Screen, s);
	  enqueue_command_event (event);
	}
      goto OTHER;
    }
    break;

  case FocusIn:
  case FocusOut:
    if (s = x_any_window_to_screen (event->xfocus.window))
      emacs_Xt_focus_event_handler (event, s);
    goto OTHER;
    break;

  case ClientMessage:
    if (! (s = x_any_window_to_screen (event->xclient.window)))
      goto OTHER;
    if (event->xclient.message_type == Xatom_WM_PROTOCOLS &&
	event->xclient.data.l[0] == Xatom_WM_DELETE_WINDOW)
      {
	Lisp_Object scr;
	Lisp_Object next;
	Lisp_Object event = Fallocate_event ();

	XSET (scr, Lisp_Screen, s);
	next = next_screen (scr, 0, 0);
	XEVENT (event)->event_type = eval_event;
	if (EQ (next, scr) || EQ (scr, Vglobal_minibuffer_screen))
	  {
	    XEVENT (event)->event.eval.function =
	      intern ("save-buffers-kill-emacs");
	    XEVENT (event)->event.eval.object = Qnil;
	  }
	else
	  {
	    XEVENT (event)->event.eval.function = intern ("delete-screen");
	    XEVENT (event)->event.eval.object = scr;
	  }
	enqueue_command_event (event);
      }
    else if (event->xclient.message_type == Xatom_WM_PROTOCOLS &&
	     event->xclient.data.l[0] == Xatom_WM_TAKE_FOCUS)
      {
	XWindowAttributes xwa;
	BLOCK_INPUT;
	/* Check that the window is visible */
	if (XGetWindowAttributes (x_current_display, event->xclient.window,
				  &xwa)
	    && xwa.map_state == IsViewable)
	  XSetInputFocus (x_current_display, event->xclient.window,
			  RevertToParent, event->xclient.data.l[1]);
	UNBLOCK_INPUT;
      }
    goto OTHER;
    break;

  case MappingNotify:	/* The user has run xmodmap */
    BLOCK_INPUT;
    XRefreshKeyboardMapping (&event->xmapping);
    UNBLOCK_INPUT;
    /* xmodmap generates about a billion MappingKeyboard events, followed
       by a single MappingModifier event, so it might be worthwhile to
       take extra MappingKeyboard events out of the queue before requesting
       the current keymap from the server.
     */
    if (event->xmapping.request == MappingKeyboard)
      x_reset_key_mapping (display);
    else if (event->xmapping.request == MappingModifier)
      x_reset_modifier_mapping (display);
    goto OTHER;

  case VisibilityNotify: /* window visiblity has changed */
    if (! (s = x_any_window_to_screen (event->xvisibility.window)))
      goto OTHER;
    {
      Lisp_Object e = Fallocate_event ();
      Lisp_Object screen;
      XSET (screen, Lisp_Screen, s);
      XEVENT (e)->event_type = eval_event;
      if (event->xvisibility.state == VisibilityUnobscured)
	XEVENT (e)->event.eval.function = Qx_VisibilityNotify_internal;
      else
	XEVENT (e)->event.eval.function = Qx_non_VisibilityNotify_internal;
      XEVENT (e)->event.eval.object = screen;
      enqueue_command_event (e);
    }
    goto OTHER;
    break;

  default:
  OTHER:
    if (event->xany.display != x_current_display)
      abort ();
    BLOCK_INPUT;
    XtDispatchEvent (event);
    UNBLOCK_INPUT;
  }
}

void
emacs_Xt_focus_event_handler (x_event, s)
     XEvent *x_event;
     struct screen *s;
{
  Lisp_Object event = Fallocate_event ();
  XEVENT (event)->event_type = eval_event;
  if (x_event->xany.type == FocusIn)
    XEVENT (event)->event.eval.function = Qx_FocusIn_internal;
  else if (x_event->xany.type == FocusOut)
    XEVENT (event)->event.eval.function = Qx_FocusOut_internal;
  else
    abort ();
  if (! s)
    if (! (s = x_any_window_to_screen (x_event->xfocus.window)))
      abort ();
  XSET (XEVENT (event)->event.eval.object, Lisp_Screen, s);
  enqueue_command_event (event);
}




static void
describe_event_window (window)
     Window window;
{
  Lisp_Object tail, screen;
  struct screen *s;
  Widget w;
  printf ("   window: 0x%x", (int) window);
  if (w = XtWindowToWidget (x_current_display, window))
    printf (" %s", w->core.widget_class->core_class.class_name);
  if (s = x_any_window_to_screen (window))
    printf (" \"%s\"", XSTRING (s->name)->data);
  printf ("\n");
}


static void
describe_event (event)
     XEvent *event;
{
  printf ("%s\n", x_event_name (event->xany.type));
  switch (event->xany.type) {
  case Expose:
    describe_event_window (event->xexpose.window);
    printf ("   region: %d %d %d %d\n", event->xexpose.x, event->xexpose.y,
	    event->xexpose.width, event->xexpose.height);
    printf ("    count: %d\n", event->xexpose.count);
    break;
  case GraphicsExpose:
    describe_event_window (event->xgraphicsexpose.drawable);
    printf ("    major: %s\n",
	    (event->xgraphicsexpose.major_code == X_CopyArea ? "CopyArea"
	     : (event->xgraphicsexpose.major_code == X_CopyPlane ? "CopyPlane"
		: "?")));
    printf ("   region: %d %d %d %d\n",
	    event->xgraphicsexpose.x, event->xgraphicsexpose.y,
	    event->xgraphicsexpose.width, event->xgraphicsexpose.height);
    printf ("    count: %d\n", event->xgraphicsexpose.count);
    break;
  case FocusIn:
  case FocusOut:
    describe_event_window (event->xfocus.window);
    printf ("     mode: %s\n",
	    (event->xfocus.mode == NotifyNormal ? "Normal"
	     :(event->xfocus.mode == NotifyGrab ? "Grab"
	       :(event->xfocus.mode == NotifyUngrab ? "Ungrab"
		 :(event->xfocus.mode == NotifyWhileGrabbed ? "WhileGrabbed"
		   : "?")))));
    printf ("   detail: %s\n",
     (event->xfocus.detail == NotifyAncestor ? "Ancestor"
      :(event->xfocus.detail == NotifyVirtual ? "Virtual"
	:(event->xfocus.detail == NotifyInferior ? "Inferior"
	  :(event->xfocus.detail == NotifyNonlinear ? "Nonlinear"
	    :(event->xfocus.detail == NotifyNonlinearVirtual ?
	      "NonlinearVirtual"
	      :(event->xfocus.detail == NotifyPointer ? "Pointer"
		:(event->xfocus.detail == NotifyPointerRoot ? "PointerRoot"
		  :(event->xfocus.detail == NotifyDetailNone ?
		    "DetailNone" : "?")))))))));
    break;
  case EnterNotify:
  case LeaveNotify:
    describe_event_window (event->xcrossing.window);
/*
    printf (" subwindow: 0x%x\n", event->xcrossing.subwindow);
    printf ("      pos: %d %d\n", event->xcrossing.x, event->xcrossing.y);
    printf (" root pos: %d %d\n",
	    event->xcrossing.x_root, event->xcrossing.y_root);
 */
    printf ("     mode: %s\n",
	    (event->xcrossing.mode == NotifyNormal ? "Normal"
	     :(event->xcrossing.mode == NotifyGrab ? "Grab"
	       :(event->xcrossing.mode == NotifyUngrab ? "Ungrab"
		 :(event->xcrossing.mode == NotifyWhileGrabbed ?
		   "WhileGrabbed" : "?")))));
    printf ("   detail: %s\n",
     (event->xcrossing.detail == NotifyAncestor ? "Ancestor"
      :(event->xcrossing.detail == NotifyVirtual ? "Virtual"
	:(event->xcrossing.detail == NotifyInferior ? "Inferior"
	  :(event->xcrossing.detail == NotifyNonlinear ? "Nonlinear"
	    :(event->xcrossing.detail == NotifyNonlinearVirtual ?
	      "NonlinearVirtual"
	      :(event->xcrossing.detail == NotifyPointer ? "Pointer"
		:(event->xcrossing.detail == NotifyPointerRoot ?
		  "PointerRoot"
		  :(event->xcrossing.detail == NotifyDetailNone ?
		    "DetailNone" : "?")))))))));
    printf ("    focus: %d\n", event->xcrossing.focus);
/*
    printf ("    state: 0x%x\n", event->xcrossing.state);
 */
    break;
  case ConfigureNotify:
    describe_event_window (event->xconfigure.window);
    printf ("    above: 0x%x\n", event->xconfigure.above);
    printf ("     size: %d %d %d %d\n", event->xconfigure.x,
	    event->xconfigure.y,
	    event->xconfigure.width, event->xconfigure.height);
    printf ("  redirect: %d\n", event->xconfigure.override_redirect);
    break;
  case VisibilityNotify:
    describe_event_window (event->xvisibility.window);
    printf ("    state: %s\n",
	    (event->xvisibility.state == VisibilityUnobscured ?
	     "Unobscured"
	     :(event->xvisibility.state == VisibilityPartiallyObscured ?
	       "PartiallyObscured"
	       :(event->xvisibility.state == VisibilityFullyObscured ?
		 "FullyObscured" : "?"))));
  case KeyPress:
    {
      Lisp_Object keysym;
      describe_event_window (event->xkey.window);
      printf ("    state: ");
      if (event->xkey.state & ShiftMask)   printf ("Shift ");
      if (event->xkey.state & LockMask)    printf ("Lock ");
      if (event->xkey.state & ControlMask) printf ("Control ");
      if (event->xkey.state & Mod1Mask)    printf ("Mod1 ");
      if (event->xkey.state & Mod2Mask)    printf ("Mod2 ");
      if (event->xkey.state & Mod3Mask)    printf ("Mod3 ");
      if (event->xkey.state & Mod4Mask)    printf ("Mod4 ");
      if (event->xkey.state & Mod5Mask)    printf ("Mod5 ");
      if (event->xkey.state & MetaMask)	   printf ("Meta ");
      if (event->xkey.state & SuperMask)   printf ("Super ");
      if (event->xkey.state & HyperMask)   printf ("Hyper ");
      if (event->xkey.state & SymbolMask)  printf ("Symbol ");
      if (event->xkey.state & ModeMask)    printf ("Mode_switch ");

      if (! event->xkey.state) printf ("vanilla\n");
      else printf ("\n");
      if (x_key_is_modifier_p (event->xkey.keycode))
	printf ("   Modifier key");
      printf ("  keycode: 0x%x\n", event->xkey.keycode);
      keysym = x_to_emacs_keysym (event, 0);
      if (keysym < 1024)
	printf ("   keysym: %c\n", keysym);
      else
	printf ("   keysym: %s\n", XSYMBOL (keysym)->name->data);
    }
    break;
  }
}



static void
Xt_wake_up (display)
     Display *display;
{
  /* Generate an unnecessary event so that XtAppNextEvent will
     return right now.  This is done from inside of the callback
     functions attached to timeouts and file descriptors, because Xt doesn't
     consider those kinds of events as enough reason to return, and will
     continue waiting for an X event to arrive, even though there's a
     perfectly good timeout/fd event sitting around waiting to be processed.

     I used to do this by simply longjmp()ing out of the callback function,
     but that causes a small core leak inside of Xt.
   */
  XEvent fake_event;
  fake_event.type = 0;	/* XAnyEvent type, ignored. */
  fake_event.xany.display = display;
  fake_event.xany.window  = 0;
  BLOCK_INPUT;
  XPutBackEvent(display, &fake_event);
  UNBLOCK_INPUT;
}


/* timeout events */

static int timeout_id_tick;

static struct timeout {
  unsigned int id;
  Lisp_Object function, object;
  unsigned int msecs;
  unsigned int resignal_msecs;
  XtIntervalId interval_id;
  struct timeout *next;
} *pending_timeouts, *completed_timeouts;


static void Xt_timeout_callback ();

static void
generate_wakeup_internal (id, milliseconds, vanilliseconds, function, object)
     int id;
     unsigned int milliseconds, vanilliseconds;
     Lisp_Object function;
     Lisp_Object object;
{
  struct timeout *timeout = (struct timeout *)
    xmalloc (sizeof (struct timeout));
  timeout->id = id;
  timeout->msecs = milliseconds;
  timeout->resignal_msecs = vanilliseconds;
  timeout->function = function;
  timeout->object = object;
  timeout->next = pending_timeouts;
  pending_timeouts = timeout;
  BLOCK_INPUT;
  timeout->interval_id =
    XtAppAddTimeOut (Xt_app_con, milliseconds, Xt_timeout_callback, timeout);
  UNBLOCK_INPUT;
}


static int
emacs_Xt_generate_wakeup (msec, resignal, function, object)
     unsigned int msec, resignal;
     Lisp_Object function;
     Lisp_Object object;
{
  int id = timeout_id_tick++;
  generate_wakeup_internal (id, msec, resignal, function, object);
  return id;
}


static void
Xt_timeout_callback (timeout)	/* called by XtAppNextEvent() */
     struct timeout* timeout;
{
  struct timeout *t2 = pending_timeouts;
  /* Remove this one from the list of pending timeouts */
  if (t2 == timeout)
    pending_timeouts = pending_timeouts->next;
  else {
    while (t2->next && t2->next != timeout) t2 = t2->next;
    if (! t2->next) abort();
    t2->next = t2->next->next;
  }
  /* Add this one to the list of completed timeouts */
  timeout->next = completed_timeouts;
  completed_timeouts = timeout;

  /* If this timeout wants to be resignalled, do it now.
     We don't reuse the same timeout structure, but possibly we could.
   */
  if (timeout->resignal_msecs)
    generate_wakeup_internal (timeout->id,
			      timeout->resignal_msecs, timeout->resignal_msecs,
			      timeout->function, timeout->object);

  Xt_wake_up (x_current_display);
}


static void
emacs_Xt_disable_wakeup (id)
     int id;
{
  struct timeout *timeout, *t2;

  /* Find the timeout on the list of pending ones, if it's still there. */
  if (!pending_timeouts) return;
  if (id == pending_timeouts->id) {
    timeout = pending_timeouts;
    pending_timeouts = pending_timeouts->next;
  }
  else {
    t2 = pending_timeouts;
    while (t2->next && t2->next->id != id) t2 = t2->next;
    if (! t2->next) return;
    timeout = t2->next;
    t2->next = t2->next->next;
  }
  /* At this point, we've found the thing on the list of pending timeouts,
     and removed it.
   */
  timeout->function = Qnil;
  timeout->object = Qnil;
  timeout->msecs = 0;
  timeout->resignal_msecs = 0;
  timeout->id = 0;
  timeout->next = (struct timeout *) 0xDEADBEEF;
  BLOCK_INPUT;
  XtRemoveTimeOut (timeout->interval_id);
  UNBLOCK_INPUT;
  free (timeout);
}


static void
Xt_timeout_to_emacs_event (emacs_event)
     struct Lisp_Event *emacs_event;
{
  struct timeout *timeout = completed_timeouts;
  if (! timeout) abort ();
  completed_timeouts = completed_timeouts->next;
  emacs_event->event_type = timeout_event;
  emacs_event->timestamp  = timeout->msecs; /* #### wrong!! */
  emacs_event->event.timeout.function  = timeout->function;
  emacs_event->event.timeout.object    = timeout->object;
  emacs_event->event.timeout.id_number = timeout->id;
  free (timeout);
}


/* process events */

static Lisp_Object *process_fds_with_input;
static XtInputId   *process_fds_to_input_ids;
static int process_events_occurred;

#ifndef MAX_PROC_FDS
# define MAX_PROC_FDS FD_SETSIZE
#endif

void
mark_process_as_being_ready (process)
     struct Lisp_Process *process;
{
  if (NILP (process_fds_with_input [XFASTINT (process->infd)])) {
    XSET (process_fds_with_input [XFASTINT (process->infd)],
	  Lisp_Process,
	  process);
    /* Don't increment this if the current process is already marked
       as having input.
       */
    process_events_occurred++;
  }
}

static void
Xt_process_callback (process)	/* called by XtAppNextEvent() */
     struct Lisp_Process *process;
{
  mark_process_as_being_ready (process);
  Xt_wake_up (x_current_display);
}

static void
emacs_Xt_select_process (process)
     struct Lisp_Process *process;
{
  BLOCK_INPUT;
  process_fds_to_input_ids[XFASTINT (process->infd)] = 
    XtAppAddInput (Xt_app_con, XFASTINT (process->infd),
		   XtInputReadMask /* | XtInputExceptMask */,
		   Xt_process_callback, process);
  UNBLOCK_INPUT;
}


static void
emacs_Xt_unselect_process (process)
     struct Lisp_Process *process;
{
  int fd = XFASTINT (process->infd);
  XtInputId id;
  /* If the infd is 0, it has already been deleted, and Xt will freak
     because it's calls to select() will fail. */
  if (! fd) abort ();
  id = process_fds_to_input_ids [fd];
  if (! id) return;
  process_fds_to_input_ids [fd] = -1;
  BLOCK_INPUT;
  XtRemoveInput (id);
  UNBLOCK_INPUT;
}


static void
Xt_process_to_emacs_event (emacs_event)
     struct Lisp_Event *emacs_event;
{
  int i;
  Lisp_Object process;
  if (process_events_occurred <= 0) abort ();
  for (i = 0; i < MAX_PROC_FDS; i++)
    if (!NILP (process = process_fds_with_input [i])) {
      process_fds_with_input [i] = Qnil;
      break;
    }
  if (NILP (process) || !process) abort ();

  process_events_occurred--;
  emacs_event->event_type = process_event;
  emacs_event->timestamp  = 0; /* #### */
  emacs_event->event.process.process = process;
}


/* tty events */

static void
emacs_Xt_select_tty (file_descriptor)
     int file_descriptor;
{
}

static void
emacs_Xt_unselect_tty (file_descriptor)
     int file_descriptor;
{
}



static void XtAppNextEvent_non_synthetic ();


static void
emacs_Xt_next_event (emacs_event)
     struct Lisp_Event *emacs_event;
{
  XEvent x_event;

  /* If the event's type is XAnyEvent, then it's a fake, synthetic event
     that we generated inside a timeout callback just to make XtAppNextEvent
     return right away.  In order to avoid race conditions, all user input
     and window-system events must have higher priority than process and
     timer output.  So if the next event on the queue is one of these
     synthetic events, and there are non-synthetic events behind it, then
     take the following events first (leaving the synthetic event at the
     front of the queue, so that we don't forget to handle the procs/timers
     when there is nothing else left to handle.)
   */
  BLOCK_INPUT;
  XtAppNextEvent_non_synthetic (x_current_display, Xt_app_con, &x_event);
  UNBLOCK_INPUT;

  if (x_event.xany.type == 0 &&
      (completed_timeouts || process_events_occurred))
    {
      /* If we got here, then the only X event on the queue is a dummy event
	 representing timeouts or process output.  This means that all user
	 input has been consumed, and we can now do timeouts and processes.
       */
      if (completed_timeouts)
	Xt_timeout_to_emacs_event (emacs_event);
      else /* if (process_events_occurred) */
	Xt_process_to_emacs_event (emacs_event);
    }
  else
    x_event_to_emacs_event (&x_event, emacs_event);
}


static Bool
non_synthetic_event_p (display, event, arg)
     Display *display;
     XEvent *event;
     XtPointer arg;
{
  if (event->xany.type)
    return True;
  return False;
}

static void 
XtAppNextEvent_non_synthetic (dpy, app, x_event)
     Display *dpy;
     XtAppContext app;
     XEvent *x_event;
{
  if (! XCheckIfEvent (dpy, x_event, non_synthetic_event_p, 0))
    XtAppNextEvent (app, x_event);
}


/* Determining whether there is input pending, and noticing the interrupt
   character in a timely fashion.
 */

static void x_check_for_interrupt_char ();
static Bool look_for_key_or_mouse_event ();

static int
emacs_Xt_event_pending_p (user_p)
     int user_p;
{
  /* If `user_p' is false, then this function returns whether there are any
     X, timeout, or fd events pending (that is, whether emacs_Xt_next_event()
     would return immediately without blocking.)

     if `user_p' is false, then this function returns whether there are any
     *user generated* events available (that is, whether there are keyboard
     or mouse-click events ready to be read.)  This also implies that
     emacs_Xt_next_event() would not block.

     In a non-SIGIO world, this also checks whether the user has typed ^G,
     since this is a convenient place to do so.  We don't need to do this
     in a SIGIO world, since input causes an interrupt.
   */
  int res;
  XEvent event;
  Display *display = x_current_display;

  BLOCK_INPUT;
  res = XtAppPending (Xt_app_con);
#ifndef SIGIO
  x_check_for_interrupt_char (x_current_display);
#endif
  UNBLOCK_INPUT;

  if (! user_p)
    return (res != 0);

  if (! (res & XtIMXEvent)) /* no X events means no user input */
    return 0;

  res = 0;
  BLOCK_INPUT;
  XEventsQueued (display, QueuedAfterReading);
  XCheckIfEvent (display, &event, &look_for_key_or_mouse_event, (char *) &res);
  UNBLOCK_INPUT;
  return res;
}


/* This function is passed to XCheckIfEvent, but always returns 0, so that
   the event is not removed from the queue (that is, we're using XCheckIfEvent
   as a means of nondestructively iterating over the queue without blocking.)
   If one of the events in the queue is a user-input event (that is, a key
   or mouse-click event that is not a modifier key like shift) then it sets
   a flag to 1.
 */
static Bool
look_for_key_or_mouse_event (display, event, arg)
     Display *display;
     XEvent *event;
     XtPointer arg;
{
  switch (event->xany.type)
    {
    case KeyPress:
      if (x_key_is_modifier_p (event->xkey.keycode))
	break;
    case ButtonPress:
    case ButtonRelease:
      *((int *) arg) = 1;
      break;
    }
  return False;
}


#ifdef SIGIO
static void
emacs_Xt_event_sigio_handler ()
{
  if (x_input_blocked) return;
  if (!x_current_display) return; /* emacs is in the process of exiting */
  BLOCK_INPUT;
  x_check_for_interrupt_char (x_current_display);
  UNBLOCK_INPUT;
}
#endif


static Bool interrupt_char_predicate ();

/* This scans the X input queue for a KeyPress event that matches the
   interrupt character, and sets Vquit_flag.

   In a SIGIO world, this function is called from the SIGIO handler.  In
   a non-SIGIO world, this is called from emacs_Xt_event_pending_p (which
   is called from input_pending_p.)
 */
static void
x_check_for_interrupt_char (display)
     Display *display;
{
  XEvent event;
  BLOCK_INPUT;
  XEventsQueued (display, QueuedAfterReading);
  if (XCheckIfEvent (display, &event, interrupt_char_predicate, 0))
    {
      interrupt_signal (0);
      /* We have read a ^G.  If that is the only event in the queue, leave
	 it there so that it is read immediately.  If there are other events
	 in the queue (possibly ahead of it) it's ok to discard the ^G event
	 itself, as Vquit_flag is now set.  If we leave the ^G in the queue
	 with other events in front of it, then XCheckIfEvent will notice
	 the ^G multiple times, which is no good.
       */
      if (! XEventsQueued (display, QueuedAlready))
	XPutBackEvent (display, &event);
    }
  UNBLOCK_INPUT;
}


static Bool
interrupt_char_predicate (display, event, data)
     Display *display;
     XEvent *event;
     char *data;
{
  char c;
  KeySym keysym;
  if (event->type != KeyPress) return 0;
  if (! x_any_window_to_screen (event->xany.window)) return 0;
  if (event->xkey.state & (MetaMask | HyperMask | SuperMask | SymbolMask))
    return 0;

  /* This duplicates some code that exists elsewhere, but it's relatively
     fast and doesn't cons (important, because this is called from inside
     the SIGIO interrupt, and there could easily be a GC in progress.)
   */
  keysym = x_to_emacs_keysym (event, 1);
  if (NILP (keysym)) return 0;
  if (FIXNUMP (keysym))
    c = XINT (keysym);
  /* Highly doubtful that these are the interrupt character, but... */
  else if (EQ (keysym, QKbackspace))	c = '\b';
  else if (EQ (keysym, QKtab))		c = '\t';
  else if (EQ (keysym, QKlinefeed))	c = '\n';
  else if (EQ (keysym, QKreturn))	c = '\r';
  else if (EQ (keysym, QKescape))	c = 27;
  else if (EQ (keysym, QKspace))	c = ' ';
  else if (EQ (keysym, QKdelete))	c = 127;
  else return 0;

  /* This makes Control-Shift-G the same as Control-G, which might be bad. */
  if (event->xkey.state & ControlMask)  c &= 0x1F;
  if (event->xkey.state & MetaMask)     c |= 0x80;
  return (c == interrupt_char);
}


extern struct event_stream *event_stream;

void
emacs_Xt_make_event_stream ()
{
  timeout_id_tick = 1;
  pending_timeouts = 0;
  completed_timeouts = 0;

  process_fds_to_input_ids = (XtInputId *)
    calloc (MAX_PROC_FDS, sizeof (XtInputId));
  process_fds_with_input = (Lisp_Object *)
    malloc (MAX_PROC_FDS * sizeof (Lisp_Object));
  {
    int i;
    for (i = 0; i < MAX_PROC_FDS; i++) process_fds_with_input[i] = Qnil;
  }
  process_events_occurred = 0;

  x_compose_status = (XComposeStatus *) calloc (1, sizeof (XComposeStatus));

  event_stream = (struct event_stream *) malloc (sizeof (struct event_stream));
  event_stream->event_pending_p 	= emacs_Xt_event_pending_p;
  event_stream->next_event_cb	 	= emacs_Xt_next_event;
  event_stream->handle_magic_event_cb	= emacs_Xt_handle_magic_event;
  event_stream->generate_wakeup_cb 	= emacs_Xt_generate_wakeup;
  event_stream->disable_wakeup_cb 	= emacs_Xt_disable_wakeup;
  event_stream->select_tty_cb 		= emacs_Xt_select_tty;
  event_stream->unselect_tty_cb 	= emacs_Xt_unselect_tty;
  event_stream->select_process_cb 	= emacs_Xt_select_process;
  event_stream->unselect_process_cb 	= emacs_Xt_unselect_process;
#ifdef SIGIO
  event_stream->sigio_cb		= emacs_Xt_event_sigio_handler;
#endif
}
