/* The event_stream interface for X11 with Xt, and/or tty screens.
   Copyright (C) 1991, 1992, 1993, 1994 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 "config.h"
#include "lisp.h"
#include "intl.h"
#include "systime.h"

#include <stdio.h>
#include <X11/X.h>
#include <X11/Xlib.h>
#include <X11/Xatom.h>
#include <X11/keysym.h>
#include "xintrinsic.h"

#include "lwlib.h"

#include "xterm.h"
#include "process.h"
#include "events.h"
#include "blockio.h"
#include "dispextern.h"
#include "screen.h"
#include "commands.h"

#include "EmacsScreen.h"

/* With the new event model, all events go through XtDispatchEvent()
   and are picked up by an event handler that is added to each screen
   widget. (This is how it's supposed to be.) In the old method,
   Emacs sucks out events directly from XtNextEvent() and only
   dispatches the events that it doesn't need to deal with.  This
   old way has lots of corresponding junk that is no longer
   necessary: lwlib extensions, synthetic XAnyEvents, unnecessary
   magic events, etc. */

/* 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. */
static Time last_server_timestamp;

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

extern XtAppContext Xt_app_con;

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;
  BLOCK_INPUT;
  if (x_keysym_map)
    XFree ((char *) x_keysym_map);
  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 CONST char *
index_to_name (int index)
{
  return ((index == ShiftMapIndex ? "ModShift"
           : (index == LockMapIndex ? "ModLock"
              : (index == ControlMapIndex ? "ModControl"
                 : (index == Mod1MapIndex ? "Mod1"
                    : (index == Mod2MapIndex ? "Mod2"
                       : (index == Mod3MapIndex ? "Mod3"
                          : (index == Mod4MapIndex ? "Mod4"
                             : (index == Mod5MapIndex ? "Mod5"
                                : "???")))))))));
}

/* Boy, I really wish C had local functions... */
struct c_doesnt_have_closures   /* >>> not yet used */
  {
    int warned_about_overlapping_modifiers;
    int warned_about_predefined_modifiers;
    int warned_about_duplicate_modifiers;
    int meta_bit;
    int hyper_bit;
    int super_bit;
    int symbol_bit;
    int mode_bit;
  };



static void
x_reset_modifier_mapping (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;

  BLOCK_INPUT;

  if (x_modifier_keymap)
    XFreeModifiermap (x_modifier_keymap);

  x_reset_key_mapping (display);

  x_modifier_keymap = XGetModifierMapping (display);

  /* Boy, I really wish C had local functions...
   */

#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 == ShiftMapIndex) modbarf (name,"ModShift"); \
  else if (modifier_index == LockMapIndex) modbarf (name,"ModLock"); \
  else if (modifier_index == ControlMapIndex) 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)
    {
      CONST 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.  If you intend for\n\
	these keys to have the same behavior, then change them to have the\n\
	same keysym as well as the same 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 (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;
}

/* called from EmacsScreen.c (actually from Xt itself) when a
   MappingNotify event is received.  For non-obvious reasons,
   our event handler does not see these events, so we need a
   special translation. */
void
emacs_Xt_mapping_action (Widget w, XEvent* event)
{
#if 0
  /* nyet.  Now this is handled by Xt. */
  BLOCK_INPUT;
  XRefreshKeyboardMapping (&event->xmapping);
  UNBLOCK_INPUT;
#endif
  /* 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 (event->xany.display);
  else if (event->xmapping.request == MappingModifier)
    x_reset_modifier_mapping (event->xany.display);
}


static XComposeStatus *x_compose_status;

#if (defined(sun) || defined(__sun)) && defined(__GNUC__)
# define SUNOS_GCC_L0_BUG
#endif

#ifdef SUNOS_GCC_L0_BUG
static void
x_to_emacs_keysym_sunos_bug (Lisp_Object *return_value_sunos_bug, /* >>>> */
                             XEvent *event, int simple_p)
#else /* !SUNOS_GCC_L0_BUG */
static Lisp_Object
x_to_emacs_keysym (XEvent *event, int simple_p)
#endif /* !SUNOS_GCC_L0_BUG */
     /* simple_p means don't try too hard (ASCII only) */
{
  char *name;
  KeySym keysym = 0;
  
#ifdef SUNOS_GCC_L0_BUG
# define return(lose) \
	do {*return_value_sunos_bug = (lose); goto return_it; } while (0)
#endif

  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 (make_number (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;
    /* >>> without return_value_sunos_bug, %l0 (GCC struct return pointer)
     * >>>  gets roached (top 8 bits cleared) around this call.
     */
    name = XKeysymToString (keysym);
    UNBLOCK_INPUT;
    if (!name || !name[0])	/* this shouldn't happen... */
      {
	char buf [255];
	sprintf (buf, "unknown_keysym_0x%X", (int) keysym);
	return (KEYSYM (buf));
      }
    /* If it's got a one-character name, that's good enough. */
    if (!name[1]) return (make_number (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 = tolower (*s1);
	*s2 = 0;
	return (KEYSYM (buf));
      }
    return (KEYSYM (name));
  }
#ifdef SUNOS_GCC_L0_BUG
# undef return
 return_it:
  return;
#endif
}

#ifdef SUNOS_GCC_L0_BUG
/* >>>>> */
static Lisp_Object
x_to_emacs_keysym (XEvent *event, int simple_p)
{
  Lisp_Object return_value_sunos_bug;
  x_to_emacs_keysym_sunos_bug (&return_value_sunos_bug, event, simple_p);
  return (return_value_sunos_bug);
}
#endif


extern int x_allow_sendevents;

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 EXTERNAL_WIDGET
      struct screen *s = x_any_window_to_screen (x_event->xany.window);
#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)
#ifdef EXTERNAL_WIDGET
	  /* BPW: events get sent to an ExternalShell using XSendEvent.
	     This is not a perfect solution. */
	  && !s->display.x->external_window_p
#endif
	  && !x_allow_sendevents)
	{
	  x_event->xany.type = 0;
	  goto MAGIC;
	}

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

      /* 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;

#ifdef I18N4
	    /* "A KeyPress event with a KeyCode of zero is used exclusively as
	       a signal that an input method has composed input which can be
	       returned..." -- X11 R5 Xlib - C Library manual, section 13.14.2.
	       We treat the signal itself as a magic event -- i.e., ignore it.
	     */
	    if (keycode == 0)
	      {
		get_composed_input (&(x_event->xkey),
				    SCREEN_INPUT_CONTEXT(selected_screen));
		goto MAGIC;
	      }
#endif

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

	    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...
	       */
	    XSETR (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.
	       */
	    /* ## type lossage: assuming equivalence of emacs and X keysyms */
	    if (! keysym_obeys_caps_lock_p ((KeySym) XFASTINT (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.keysym   = keysym;
	    break;
	  }
	case ButtonPress:
	case ButtonRelease:
	  {
	    struct screen *screen = x_window_to_screen (x_event->xbutton.window);
	    if (! screen)
	      goto MAGIC;	/* not for us */
	    XSETR (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;

      XSETR (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;
      {
	unsigned int modifiers = 0;
	if (x_event->xmotion.state & ShiftMask)   modifiers |= MOD_SHIFT;
	if (x_event->xmotion.state & ControlMask) modifiers |= MOD_CONTROL;
	if (x_event->xmotion.state & MetaMask)    modifiers |= MOD_META;
	if (x_event->xmotion.state & SuperMask)   modifiers |= MOD_SUPER;
	if (x_event->xmotion.state & HyperMask)   modifiers |= MOD_HYPER;
	if (x_event->xmotion.state & SymbolMask)  modifiers |= MOD_SYMBOL;
	/* Currently ignores Shift_Lock but probably shouldn't
	   (but it definitely should ignore Caps_Lock). */
	emacs_event->event.motion.modifiers = modifiers;
      }
    }
    break;
    
  case ClientMessage:
#ifdef I18N4
    if (x_event->xclient.message_type == wc_atom) {
      struct screen *screen = 0;

      screen = x_any_window_to_screen (x_event->xkey.window);
      if (! screen)
	screen = selected_screen;

      XSETR (emacs_event->channel, Lisp_Screen, screen);
      emacs_event->event_type       = wchar_event;
      emacs_event->timestamp        = x_event->xclient.data.l[0];
      emacs_event->event.wchar.data = x_event->xclient.data.l[1];
      break;
    }
#endif
    /* Patch bogus TAKE_FOCUS messages from MWM; CurrentTime is passed as the
       timestamp of the TAKE_FOCUS, which the ICCCM explicitly prohibits. */
    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;
      }
#ifdef EPOCH
    emacs_event->epoch_event = Qx_client_message;
#endif
    goto MAGIC;

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

/* >>>> With the new event model, there is no purpose at all
   to this business of generating eval events in the following
   function.  The function should simply call those Lisp
   functions directly.  This would significantly reduce
   the number of calls to redisplay() when something like
   moving from one window to another occurs.  At some
   point I'll probably make those changes. --ben */

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 ();

 KLUDGE_O_RAMA:

  switch (event->type) {

  case SelectionRequest:
    if (x_window_to_screen (event->xselectionrequest.owner))
      x_handle_selection_request (&event->xselectionrequest);
    else
      goto OTHER;
    break;

  case SelectionClear:
    if (x_window_to_screen (event->xselectionclear.window))
      x_handle_selection_clear (&event->xselectionclear);
    else
      goto OTHER;
    break;

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

  case PropertyNotify:
    if (x_window_to_screen (event->xproperty.window))
      {
	x_handle_property_notify (&event->xproperty);
#ifdef EPOCH
	dispatch_epoch_event (emacs_event, Qx_property_change);
#endif
      }
    else
      goto OTHER;
    break;
    
  case Expose:
    if (! (s = x_window_to_screen (event->xexpose.window)))
      goto OTHER;
    Cdumprectangle (event->xexpose.y, event->xexpose.x,
		    event->xexpose.height, event->xexpose.width, s);
    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;
    Cdumprectangle (event->xgraphicsexpose.y, event->xgraphicsexpose.x,
		    event->xgraphicsexpose.height, event->xgraphicsexpose.width,
		    s);
    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;
#ifdef EPOCH
      XEVENT (event)->epoch_event = Qx_map;
#endif
      XSETR (XEVENT (event)->event.eval.object, Lisp_Screen, s);
      enqueue_command_event (event);
    }
    goto OTHER;

  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;
#ifdef EPOCH
      XEVENT (event)->epoch_event = Qx_unmap;
#endif
      XSETR (XEVENT (event)->event.eval.object, Lisp_Screen, s);
      enqueue_command_event (event);
    }
    goto OTHER;
    
  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;
	  XSETR (XEVENT (event)->event.eval.object, Lisp_Screen, s);
	  enqueue_command_event (event);
	}
      goto OTHER;
    }

  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;
	  XSETR (XEVENT (event)->event.eval.object, Lisp_Screen, s);
	  enqueue_command_event (event);
	}
      goto OTHER;
    }

    /* in the old event model, where things didn't go through
       XtDispatchEvent(), it was necessarily to #ifdef out
       the following code and instead have focus events be
       handled by a translation on the EmacsScreen widget.
       In the new event model, both approaches are equivalent
       so there's no need for such kludgery. */
  case FocusIn:
  case FocusOut:
    /*
     * Also, it's curious that we're using x_any_window_to_screen() instead
     * of x_window_to_screen().  I don't know what the impact of this is.
     */
    s = x_any_window_to_screen (event->xfocus.window);
    if (!s)	/* Does this happen?  What does it mean? */
      goto OTHER;
#ifdef EXTERNAL_WIDGET
    /* External widget lossage: Ben said:
       YUCK.  The only way to make focus changes work properly is to
       completely ignore all FocusIn/FocusOut events and depend only
       on notifications from the ExternalClient widget. */
    if (s->display.x->external_window_p)
      goto OTHER;
#endif
    emacs_Xt_focus_event_handler (event, s);
    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 ();

	XSETR (scr, Lisp_Screen, s);
	next = next_screen (scr, 0, 0);
	/* WM_DELETE_WINDOW is a menu event, but other ClientMessages, such
	   as WM_TAKE_FOCUS, are eval events.  That's because delete-window
	   was probably executed with a mouse click, while the others could
	   have been sent as a result of mouse motion or some other implicit
	   action.  (Call this a "heuristic"...)  The reason for caring about
	   this is so that clicking on the close-box will make emacs prompt
	   using a dialog box instead of the minibuffer if there are unsaved
	   buffers.
	 */
	XEVENT (event)->event_type = menu_event;
	if (EQ (next, scr) || EQ (scr, Vglobal_minibuffer_screen))
	  {
	    XEVENT (event)->event.eval.function = Qsave_buffers_kill_emacs;
	    XEVENT (event)->event.eval.object = Qnil;
	  }
	else
	  {
	    XEVENT (event)->event.eval.function = Qdelete_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)
      {
	Lisp_Object scr;
	Lisp_Object levent = Fallocate_event ();

	XSETR (scr, Lisp_Screen, s);

	XEVENT (levent)->event_type = eval_event;
	XEVENT (levent)->event.eval.function = Qx_FocusIn_internal;
	XEVENT (levent)->event.eval.object = scr;
	enqueue_command_event (levent);
      }
#if 0
    else if (event->xclient.message_type == Xatom_WM_PROTOCOLS &&
	     event->xclient.data.l[0] == Xatom_WM_TAKE_FOCUS)
      {
	/* If there is a dialog box up, focus on it.

	   #### Actually, we're raising it too, which is wrong.  We should
	   #### just focus on it, but lwlib doesn't currently give us an
	   #### easy way to do that.  This should be fixed.
	 */
	unsigned long take_focus_timestamp = event->xclient.data.l[1];
	Widget widget = lw_raise_all_pop_up_widgets ();
	if (widget)
	  {
	    /* kludge: raise_all returns bottommost widget, but we really
	       want the topmost.  So just raise it for now. */
	    XMapRaised (XtDisplay (widget), XtWindow (widget));
	    /* Grab the focus with the timestamp of the TAKE_FOCUS. */
	    XSetInputFocus (XtDisplay (widget), XtWindow (widget),
			    RevertToParent, take_focus_timestamp);
	  }
      }
#endif
    else
      goto OTHER;
    break;

#if 0
    /* this is where we ought to be handling this event, but
       we don't see it here. --ben */
  case MappingNotify:	/* The user has run xmodmap */
#endif    

  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;
      XSETR (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;

  default:
  OTHER:
    ;
  }

#if 0
  /* This junk screws things up with the new dispatch-event model.
     Scrollbar and menubar expose events often get removed when
     they're not supposed to.  I don't think this stuff serves
     any purpose anymore anyway, now that the
     focus_and_expose_count_as_input_p kludge is in place.

     --Ben */

  /* #### This is a repulsive kludge!  Rewrite redisplay!!
     Redisplay is too slow; in particular, the function redisplay() takes way
     too long to realize that it doesn't need to do any work!  It regenerates
     the screen arrays too often.  So rather than fixing this, we avoid calling
     redisplay() after every event which is an exposure event (as on the
     debugger-panel buttons, which cause ~15 exposure events per screen) by
     batching up the exposure events.

     We process all consecutive Expose events at the same time without them
     ever getting turned into emacs events.  We used to process all pending
     Expose events, but that doesn't work; it's not ok to take them out of the
     queue out of order.
   */
#define EXPOSE_P(e) \
  (e->type == Expose || e->type == GraphicsExpose || e->type == NoExpose)

  if (EXPOSE_P (event))
    {
      Bool duh;
      BLOCK_INPUT;
      duh = (XtAppPending (Xt_app_con) & XtIMXEvent);
      UNBLOCK_INPUT;
      if (duh)
	{
	  BLOCK_INPUT;
	  XPeekEvent (display, event);
	  UNBLOCK_INPUT;
	  if (EXPOSE_P (event))
	    {
	      /* The event is acceptable, take it off the queue */
	      BLOCK_INPUT;
	      XNextEvent (display, event);
	      UNBLOCK_INPUT;
	      goto KLUDGE_O_RAMA;
	    }
	}
    }
#undef EXPOSE_P
#endif /* 0 */

}

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)
    {
#ifdef I18N4
      if (SCREEN_INPUT_CONTEXT(selected_screen))
	XSetICFocus (SCREEN_INPUT_CONTEXT(selected_screen));
#endif
      XEVENT (event)->event.eval.function = Qx_FocusIn_internal;
    }
  else if (x_event->xany.type == FocusOut)
    {
#ifdef I18N4
      if (SCREEN_INPUT_CONTEXT(selected_screen))
	XUnsetICFocus (SCREEN_INPUT_CONTEXT(selected_screen));
#endif
      XEVENT (event)->event.eval.function = Qx_FocusOut_internal;
    }
  else
    abort ();
  if (! s)
    if (! (s = x_any_window_to_screen (x_event->xfocus.window)))
      /* abort ();
	 focus events are sometimes generated just before
	 a screen is destroyed.  The screen has already been removed
	 from the list; otherwise there would be a call to
	 x_Focus*_internal with a bogus screen structure. */
      return;
  XSETR (XEVENT (event)->event.eval.object, Lisp_Screen, s);
  enqueue_command_event (event);
}


/************************************************************************/
/*				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 (XtPointer, XtIntervalId *);

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,
		     (XtPointer) 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;
}


/* called by XtAppNextEvent() */
static void
Xt_timeout_callback (XtPointer closure, XtIntervalId *id)
{
  struct timeout *timeout = (struct timeout *) closure;
  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);
}


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);
  xfree (timeout);
  UNBLOCK_INPUT;
}


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;
  xfree (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;
{
  int infd, outfd;
  get_process_file_descriptors (process, &infd, &outfd);
  if (NILP (process_fds_with_input[infd]))
    {
      XSETR (process_fds_with_input[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 (closure, source, id)    /* called by XtAppNextEvent() */
     void *closure;
     int *source;
     XtInputId *id;
{
  struct Lisp_Process *process = (struct Lisp_Process *) closure;
  mark_process_as_being_ready (process);
}

static void
emacs_Xt_select_process (process)
     struct Lisp_Process *process;
{
  int infd, outfd;
  BLOCK_INPUT;
  get_process_file_descriptors (process, &infd, &outfd);

  if (!NILP (process_fds_with_input [infd]) ||
      !NILP (process_fds_with_input [outfd]))
    /* This would mean that we're selecting input for a process without having
       deselected the old process on that fd.  Or something. */
    abort ();

  if (process_fds_to_input_ids[infd]  != 0 &&
      process_fds_to_input_ids[outfd] != 0 &&
      process_fds_to_input_ids[infd]  != ((XtInputId) -1) &&
      process_fds_to_input_ids[outfd] != ((XtInputId) -1))
    /* initialized to 0, set to -1 when cleared.  If it's another value, then
       something wasn't shut down properly.  I think the outfds should never
       turn up here (if they're distinct.)
     */
    abort ();

  process_fds_to_input_ids[infd] = 
    XtAppAddInput (Xt_app_con, infd,
		   (XtPointer) (XtInputReadMask /* | XtInputExceptMask */),
		   Xt_process_callback, (void *) process);
  UNBLOCK_INPUT;
}


static void
emacs_Xt_unselect_process (process)
     struct Lisp_Process *process;
{
  int infd, outfd;
  XtInputId id;
  get_process_file_descriptors (process, &infd, &outfd);

  /* If the infd is < 0, it has already been deleted, and Xt will freak
     because its calls to select() will fail.
   */
  if (infd < 0)
    abort ();

  if (!NILP (process_fds_with_input[infd]))
    {
      /* We are unselecting this process before we have drained the rest of
	 the input from it, probably from status_notify() in the command loop.
	 This can happen like so:

	  - We are waiting in XtAppNextEvent()
	  - Process generates output
	  - Process is marked as being ready, syntho-event is pushed
	  - Process dies, SIGCHLD gets generated before we return (!!!???)
	    It could happen I guess.
	  - sigchld_handler() marks process as dead
	  - Somehow we end up getting a new KeyPress event on the queue
	    at the same time (I'm really so sure how that happens but I'm
	    not sure it can't either so let's assume it can...)
	  - Key events have priority so we return that instead of the proc.
	  - Before dispatching the lisp key event we call status_notify()
	  - Which deselects the process that SIGCHLD marked as dead.

	 Thus we never remove it from _with_input and turn it into a lisp
	 event, so we need to do it here.  But this does not mean that we're
	 throwing away the last block of output - status_notify() has already
	 taken care of running the proc filter or whatever.
       */
      if (process != XPROCESS (process_fds_with_input[infd])) abort ();
      process_fds_with_input[infd] = Qnil;
      if (process_events_occurred <= 0) abort ();
      process_events_occurred--;
    }

  id = process_fds_to_input_ids [infd];
  if (! id) return;
  process_fds_to_input_ids [infd] = ((XtInputId) -1);
  BLOCK_INPUT;
  XtRemoveInput (id);
  UNBLOCK_INPUT;
}


/* This is called from GC when a process object is about to be freed.
   If we've still got pointers to it in this file, we're gonna lose hard.
 */
void
debug_process_finalization (struct Lisp_Process *p)
{
  int i;
  int infd, outfd;
  get_process_file_descriptors (p, &infd, &outfd);
  /* if it still has fds, then it hasn't been killed yet. */
  if (infd >= 0 || outfd >= 0) abort ();
  /* Better not still be in the "with input" table; we know it's got no fds. */
  for (i = 0; i < MAX_PROC_FDS; i++)
    {
      Lisp_Object process = process_fds_with_input [i];
      if (NILP (process)) continue;
      if (XPROCESS (process) == p) abort ();
    }
}


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++)
    {
      process = process_fds_with_input [i];
      if (!NILP (process))
	{
	  /* debugging */
	  int infd, outfd;
	  if (!PROCESSP (process)) abort ();
	  get_process_file_descriptors (XPROCESS (process), &infd, &outfd);
	  if (infd != i) abort ();

	  process_fds_with_input [i] = Qnil;
	  break;
	}
      }
  if (NILP (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;
{
}




/************************************************************************/
/*		debugging functions to decipher an event		*/
/************************************************************************/

#ifdef DEBUG_EXTERNAL_WIDGET
# define DEBUG_XT_EVENTS
# define DEBUG_XT_EVENTS_VERBOSELY
#endif 
#ifdef DEBUG_XT_EVENTS
#include "xintrinsicp.h"	/* only describe_event() needs this */
#include <X11/Xproto.h>		/* only describe_event() needs this */

extern char *x_event_name (int event_type);

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

void
describe_event (XEvent *event)
{
  char buf[100];
  if (event->xany.type == 0 &&
      (completed_timeouts || process_events_occurred)) {
    printf("%-30s", "0: internal dummy event\n");
  } else {
    sprintf (buf, "%s%s", x_event_name (event->xany.type),
	     event->xany.send_event ? " (send)" : "");
    printf ("%-30s", buf);
    switch (event->xany.type) {
    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 KeyPress:
    {
      Lisp_Object keysym;
      describe_event_window (event->xkey.window);
      printf ("   subwindow: %d\n", event->xkey.subwindow);
      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 (FIXNUMP (keysym) && XINT (keysym) > 32 && XINT (keysym) <= 255)
	printf ("   keysym: %c\n", XINT (keysym));
      else
	printf ("   keysym: %s\n", XSYMBOL (keysym)->name->data);
    }
      break;
#ifdef DEBUG_XT_EVENTS_VERBOSELY
    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 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" : "?"))));
      break;
#endif /* DEBUG_XT_EVENTS_VERBOSELY */
    default:
      printf ("\n");
      break;
    }
  } 
  fflush (stdout);
}
#endif /* include describe_event definition */



/************************************************************************/
/*			get the next event from Xt			*/
/************************************************************************/

static Lisp_Object dispatch_event_queue;
static struct Lisp_Event *dispatch_event_queue_tail;

enqueue_Xt_dispatch_event (Lisp_Object event)
{
  enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail);
}

Lisp_Object
dequeue_Xt_dispatch_event (void)
{
  return dequeue_event (&dispatch_event_queue, &dispatch_event_queue_tail);
}

extern void maybe_redisplay (void);
static int loop_stopped;

extern int redisplay_not_preempted;
extern int process_override_redisplay;

static int
emacs_Xt_next_event (struct Lisp_Event *emacs_event)
{
  redisplay_not_preempted = 0;

  loop_stopped = 0;
  while (NILP (dispatch_event_queue) &&
	 !loop_stopped &&
	 !completed_timeouts && 
	 !process_events_occurred)
    {
      /* Ok, this is necessary but we only want redisplay to happen
         once when we are in this loop unless we got here from
         accept-process-output in which case we don't want it to
         happen at all. */

      if (!redisplay_not_preempted && !process_override_redisplay &&
	  NILP (Vexecuting_macro))
	redisplay ();

      XtAppProcessEvent (Xt_app_con, XtIMAll);
    }

  /* I'm paranoid about something erroring out of
     accept-process-output and this getting left set.  This will get
     hit on a very regular basis and since we reset it before every
     call to next event won't cause it to become useless */
  process_override_redisplay = 0;

  if (loop_stopped)
    return 0;
  else if (!NILP (dispatch_event_queue))
    {
      Lisp_Object event, event2;
      XSETR (event2, Lisp_Event, emacs_event);
      event = dequeue_Xt_dispatch_event ();
      Fcopy_event (event, event2);
      Fdeallocate_event (event);
    }
  else if (completed_timeouts)
    Xt_timeout_to_emacs_event (emacs_event);
  else /* if (process_events_occurred) */
    Xt_process_to_emacs_event (emacs_event);

  return 1;
  /* #### describe_event() is not in here.  Someone put it here if they
     want it. */

  /* #### No I18N4 stuff here.  There appears to be no obvious place
     to call XFilterEvent().  I don't really understand that junk,
     anyway. */
}

static void
emacs_Xt_stop_next_event ()
{
  loop_stopped = 1;
}

void
emacs_Xt_event_handler (Widget wid /* unused */,
			XtPointer closure /* unused */,
			XEvent *event,
			Boolean *continue_to_dispatch /* unused */)
{
  Lisp_Object emacs_event = Fallocate_event ();
#ifdef DEBUG_XT_EVENTS
  describe_event(event);
#endif
  x_event_to_emacs_event (event, XEVENT (emacs_event));
  enqueue_Xt_dispatch_event (emacs_event);
}

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

static void x_check_for_interrupt_char (Display *);
static Bool look_for_key_or_mouse_event (Display *, XEvent *, XPointer);

struct look_for_key_or_mouse_event_closure {
  int ignore_expose_p;
  int result;
};

/* #### Note: with the NEW_XT_DISPATCH_EVENT model, it is conceivable
   that there could be a focus event sitting in the dispatch event
   queue that is not noticed by the following routine.  This could
   happen in some weird circumstances when a synthetic focus event
   gets dispatched by Motif without ever going through XtNextEvent().
   (It's been rumored that this happens; I don't actually know
   what the circumstances are.) This would imply that we should
   really scan the dispatch event queue as well as the server
   queue.  I really don't feel like writing the code, though.
   At worst, this will make exposure processing slower in some
   circumstances; and this should go away when the new redisplay
   model is in place and the "focus_and_expose_count_as_input_p"
   kludge isn't needed any more.

   Note also that, when this function is called, there should
   not normally be any real user events sitting in the dispatch
   event queue.  If there were any, this would indicate that
   someone passed a synthetic user event to XtDispatchEvent()
   and the event is destined for an EmacsScreen widget, which
   seems rather strange.

   --Ben */

static int
emacs_Xt_event_pending_p (int user_p, int focus_and_expose_count_as_input_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 true, then this function returns whether there are any
     *user generated* events available (that is, whether there are keyboard
     or mouse-click events ready to be read.)  This also implies that
     emacs_Xt_next_event() would not block.

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

  {
    int pending_value;
    BLOCK_INPUT;
    pending_value = XtAppPending (Xt_app_con);
#ifndef SIGIO
    x_check_for_interrupt_char (x_current_display);
#endif
    UNBLOCK_INPUT;

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

    if (! (pending_value & XtIMXEvent)) /* no X events means no user input */
      return 0;
  }
  {
    XEvent event;
    struct look_for_key_or_mouse_event_closure closure;
    closure.ignore_expose_p = !focus_and_expose_count_as_input_p;
    closure.result = 0;
    BLOCK_INPUT;
    XEventsQueued (display, QueuedAfterReading);
    XCheckIfEvent (display, &event, look_for_key_or_mouse_event,
		   (char *) &closure);
    UNBLOCK_INPUT;
    return closure.result;
  }
}


/* 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 *display, XEvent *event, XPointer arg)
{
  struct look_for_key_or_mouse_event_closure *closure
    = (struct look_for_key_or_mouse_event_closure *) arg;

  switch (event->xany.type)
    {
    case KeyPress:
      if (! x_key_is_modifier_p (event->xkey.keycode))
	closure->result = 1;
      break;
    case ButtonPress:
    case ButtonRelease:
      closure->result = 1;
      break;
    case Expose:
    case GraphicsExpose:
    case FocusIn:
    case FocusOut:
      /* This was added because otherwise it takes forever for Expose
         events to get noticed and handled.  This appears to be
         because redisplay is busy doing nothing.  So if we get an
         Expose event we'll just act as if we have input pending and
         that will safely abort redisplay and let the event get
         handled right way. */
      if (! closure->ignore_expose_p)
	closure->result = 1;
      break;
    }
  return False;
}


static Bool interrupt_char_predicate (Display *, XEvent *, XPointer);

/* This scans the X input queue for a KeyPress event that matches the
   interrupt character, and sets Vquit_flag.  This is called from the
   QUIT macro to determine whether we should quit.

   In a SIGIO world, this won't be caled unless a SIGIO has happened
   since the last time we checked.

   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)
{
  XEvent event;
  int queued;
  BLOCK_INPUT;
  XEventsQueued (display, QueuedAfterReading);
  queued = XCheckIfEvent (display, &event, interrupt_char_predicate, 0);
  UNBLOCK_INPUT;
  if (queued)
    {
      interrupt_signal (0);

#ifndef LISP_COMMAND_LOOP  /* <93Jul11.222009pdt.73959@atalanta.adoc.xerox.com>
                            * <9307120535.AA00405@thalidomide.lucid.com>
                            * <9307120934.AA01258@thalidomide.lucid.com>
                            */

      /* 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.
       */
      BLOCK_INPUT;
      if (! XEventsQueued (display, QueuedAlready))
	XPutBackEvent (display, &event);
      UNBLOCK_INPUT;
#endif /* !LISP_COMMAND_LOOP */
    }
}


static void
emacs_Xt_quit_p ()
{
  if (x_current_display) /* emacs may be exiting */
    x_check_for_interrupt_char (x_current_display);
}

static Bool
interrupt_char_predicate (Display *display, XEvent *event, XPointer data)
{
  char c;
  Lisp_Object 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);
}

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

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

  x_compose_status = (XComposeStatus *) xmalloc (sizeof (XComposeStatus));
  memset (x_compose_status, 0, sizeof (XComposeStatus));

  event_stream = (struct event_stream *) xmalloc (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->stop_next_event_cb	= emacs_Xt_stop_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;
  event_stream->quit_p_cb		= emacs_Xt_quit_p;
}

void
syms_of_event_Xt (void)
{
  dispatch_event_queue = Qnil;
  staticpro (&dispatch_event_queue);
}
