src/event-Xt.c

   1 /* The event_stream interface for X11 with Xt, and/or tty frames.
   2    Copyright (C) 1991-5, 1997 Free Software Foundation, Inc.
   3    Copyright (C) 1995 Sun Microsystems, Inc.
   4    Copyright (C) 1996 Ben Wing.
   5
   6 This file is part of XEmacs.
   7
   8 XEmacs is free software; you can redistribute it and/or modify it
   9 under the terms of the GNU General Public License as published by the
  10 Free Software Foundation; either version 2, or (at your option) any
  11 later version.
  12
  13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  15 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  16 for more details.
  17
  18 You should have received a copy of the GNU General Public License
  19 along with XEmacs; see the file COPYING.  If not, write to
  20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 Boston, MA 02111-1307, USA.  */
  22
  23 /* Synched up with: Not in FSF. */
  24
  25 #include <config.h>
  26 #include "lisp.h"
  27
  28 #include "console-x.h"
  29 #include "../lwlib/lwlib.h"
  30 #include "EmacsFrame.h"
  31
  32 #include "blocktype.h"
  33 #include "buffer.h"
  34 #include "console.h"
  35 #include "console-tty.h"
  36 #include "events.h"
  37 #include "frame.h"
  38 #include "objects-x.h"
  39 #include "process.h"
  40 #include "redisplay.h"
  41 #include "elhash.h"
  42
  43 #include "systime.h"
  44 #include "sysproc.h" /* for MAXDESC */
  45
  46 #include "xintrinsicp.h"        /* CoreP.h needs this */
  47 #include <X11/CoreP.h>          /* Numerous places access the fields of
  48                                    a core widget directly.  We could
  49                                    use XtGetValues(), but ... */
  50 #include <X11/ShellP.h>
  51
  52 #ifdef HAVE_XIM
  53 #ifdef XIM_MOTIF
  54 #include <Xm/Xm.h>
  55 #endif
  56 #include "lstream.h"
  57 #include "file-coding.h"
  58 #endif
  59
  60 #ifdef HAVE_DRAGNDROP
  61 #include "dragdrop.h"
  62 #endif
  63
  64 #if defined (HAVE_OFFIX_DND)
  65 #include "offix.h"
  66 #endif
  67
  68 #include "events-mod.h"
  69
  70 void enqueue_focus_event (Widget wants_it, Lisp_Object frame, int in_p);
  71 static void handle_focus_event_1 (struct frame *f, int in_p);
  72 static void handle_focus_event_2 (Window w, struct frame *f, int in_p);
  73
  74 static struct event_stream *Xt_event_stream;
  75
  76 /* With the new event model, all events go through XtDispatchEvent()
  77    and are picked up by an event handler that is added to each frame
  78    widget. (This is how it's supposed to be.) In the old method,
  79    Emacs sucks out events directly from XtNextEvent() and only
  80    dispatches the events that it doesn't need to deal with.  This
  81    old way has lots of corresponding junk that is no longer
  82    necessary: lwlib extensions, synthetic XAnyEvents, unnecessary
  83    magic events, etc. */
  84
  85 /* The one and only one application context that Emacs uses. */
  86 XtAppContext Xt_app_con;
  87
  88 /* Do we accept events sent by other clients? */
  89 int x_allow_sendevents;
  90
  91 #ifdef DEBUG_XEMACS
  92 Fixnum debug_x_events;
  93 #endif
  94
  95 static int process_events_occurred;
  96 static int tty_events_occurred;
  97 static Widget widget_with_focus;
  98
  99 /* Mask of bits indicating the descriptors that we wait for input on */
 100 extern SELECT_TYPE input_wait_mask, process_only_mask, tty_only_mask;
 101
 102 static const String x_fallback_resources[] =
 103 {
 104   /* This file is automatically generated from the app-defaults file
 105      in ../etc/Emacs.ad.  These resources are consulted only if no
 106      app-defaults file is found at all.
 107    */
 108 #include <Emacs.ad.h>
 109   0
 110 };
 111
 112 static Lisp_Object x_keysym_to_emacs_keysym (KeySym keysym, int simple_p);
 113 void emacs_Xt_mapping_action (Widget w, XEvent *event);
 114 void debug_process_finalization (Lisp_Process *p);
 115 void emacs_Xt_event_handler (Widget wid, XtPointer closure, XEvent *event,
 116                              Boolean *continue_to_dispatch);
 117
 118 static int last_quit_check_signal_tick_count;
 119
 120 Lisp_Object Qkey_mapping;
 121 Lisp_Object Qsans_modifiers;
 122
 123 \f
 124 /************************************************************************/
 125 /*                            keymap handling                           */
 126 /************************************************************************/
 127
 128 /* X bogusly doesn't define the interpretations of any bits besides
 129    ModControl, ModShift, and ModLock; so the Interclient Communication
 130    Conventions Manual says that we have to bend over backwards to figure
 131    out what the other modifier bits mean.  According to ICCCM:
 132
 133    - Any keycode which is assigned ModControl is a "control" key.
 134
 135    - Any modifier bit which is assigned to a keycode which generates Meta_L
 136      or Meta_R is the modifier bit meaning "meta".  Likewise for Super, Hyper,
 137      etc.
 138
 139    - Any keypress event which contains ModControl in its state should be
 140      interpreted as a "control" character.
 141
 142    - Any keypress event which contains a modifier bit in its state which is
 143      generated by a keycode whose corresponding keysym is Meta_L or Meta_R
 144      should be interpreted as a "meta" character.  Likewise for Super, Hyper,
 145      etc.
 146
 147    - It is illegal for a keysym to be associated with more than one modifier
 148      bit.
 149
 150    This means that the only thing that emacs can reasonably interpret as a
 151    "meta" key is a key whose keysym is Meta_L or Meta_R, and which generates
 152    one of the modifier bits Mod1-Mod5.
 153
 154    Unfortunately, many keyboards don't have Meta keys in their default
 155    configuration.  So, if there are no Meta keys, but there are "Alt" keys,
 156    emacs will interpret Alt as Meta.  If there are both Meta and Alt keys,
 157    then the Meta keys mean "Meta", and the Alt keys mean "Alt" (it used to
 158    mean "Symbol," but that just confused the hell out of way too many people).
 159
 160    This works with the default configurations of the 19 keyboard-types I've
 161    checked.
 162
 163    Emacs detects keyboard configurations which violate the above rules, and
 164    prints an error message on the standard-error-output.  (Perhaps it should
 165    use a pop-up-window instead.)
 166  */
 167
 168 /* For every key on the keyboard that has a known character correspondence,
 169    we define the ascii-character property of the keysym, and make the
 170    default binding for the key be self-insert-command.
 171
 172    The following magic is basically intimate knowledge of X11/keysymdef.h.
 173    The keysym mappings defined by X11 are based on the iso8859 standards,
 174    except for Cyrillic and Greek.
 175
 176    In a non-Mule world, a user can still have a multi-lingual editor, by doing
 177    (set-face-font "...-iso8859-2" (current-buffer))
 178    for all their Latin-2 buffers, etc.  */
 179
 180 static Lisp_Object
 181 x_keysym_to_character (KeySym keysym)
 182 {
 183 #ifdef MULE
 184   Lisp_Object charset = Qzero;
 185 #define USE_CHARSET(var,cs) \
 186   ((var) = CHARSET_BY_LEADING_BYTE (LEADING_BYTE_##cs))
 187 #else
 188 #define USE_CHARSET(var,lb)
 189 #endif /* MULE */
 190   int code = 0;
 191
 192   if ((keysym & 0xff) < 0xa0)
 193     return Qnil;
 194
 195   switch (keysym >> 8)
 196     {
 197     case 0: /* ASCII + Latin1 */
 198       USE_CHARSET (charset, LATIN_ISO8859_1);
 199       code = keysym & 0x7f;
 200       break;
 201     case 1: /* Latin2 */
 202       USE_CHARSET (charset, LATIN_ISO8859_2);
 203       code = keysym & 0x7f;
 204       break;
 205     case 2: /* Latin3 */
 206       USE_CHARSET (charset, LATIN_ISO8859_3);
 207       code = keysym & 0x7f;
 208       break;
 209     case 3: /* Latin4 */
 210       USE_CHARSET (charset, LATIN_ISO8859_4);
 211       code = keysym & 0x7f;
 212       break;
 213     case 4: /* Katakana */
 214       USE_CHARSET (charset, KATAKANA_JISX0201);
 215       if ((keysym & 0xff) > 0xa0)
 216         code = keysym & 0x7f;
 217       break;
 218     case 5: /* Arabic */
 219       USE_CHARSET (charset, ARABIC_ISO8859_6);
 220       code = keysym & 0x7f;
 221       break;
 222     case 6: /* Cyrillic */
 223       {
 224         static unsigned char const cyrillic[] = /* 0x20 - 0x7f */
 225         {0x00, 0x72, 0x73, 0x71, 0x74, 0x75, 0x76, 0x77,
 226          0x78, 0x79, 0x7a, 0x7b, 0x7c, 0x00, 0x7e, 0x7f,
 227          0x70, 0x22, 0x23, 0x21, 0x24, 0x25, 0x26, 0x27,
 228          0x28, 0x29, 0x2a, 0x2b, 0x2c, 0x00, 0x2e, 0x2f,
 229          0x6e, 0x50, 0x51, 0x66, 0x54, 0x55, 0x64, 0x53,
 230          0x65, 0x58, 0x59, 0x5a, 0x5b, 0x5c, 0x5d, 0x5e,
 231          0x5f, 0x6f, 0x60, 0x61, 0x62, 0x63, 0x56, 0x52,
 232          0x6c, 0x6b, 0x57, 0x68, 0x6d, 0x69, 0x67, 0x6a,
 233          0x4e, 0x30, 0x31, 0x46, 0x34, 0x35, 0x44, 0x33,
 234          0x45, 0x38, 0x39, 0x3a, 0x3b, 0x3c, 0x3d, 0x3e,
 235          0x3f, 0x4f, 0x40, 0x41, 0x42, 0x43, 0x36, 0x32,
 236          0x4c, 0x4b, 0x37, 0x48, 0x4d, 0x49, 0x47, 0x4a};
 237         USE_CHARSET (charset, CYRILLIC_ISO8859_5);
 238         code = cyrillic[(keysym & 0x7f) - 0x20];
 239         break;
 240       }
 241     case 7: /* Greek */
 242       {
 243         static unsigned char const greek[] = /* 0x20 - 0x7f */
 244         {0x00, 0x36, 0x38, 0x39, 0x3a, 0x5a, 0x00, 0x3c,
 245          0x3e, 0x5b, 0x00, 0x3f, 0x00, 0x00, 0x35, 0x2f,
 246          0x00, 0x5c, 0x5d, 0x5e, 0x5f, 0x7a, 0x40, 0x7c,
 247          0x7d, 0x7b, 0x60, 0x7e, 0x00, 0x00, 0x00, 0x00,
 248          0x00, 0x41, 0x42, 0x43, 0x44, 0x45, 0x46, 0x47,
 249          0x48, 0x49, 0x4a, 0x4b, 0x4c, 0x4d, 0x4e, 0x4f,
 250          0x50, 0x51, 0x53, 0x00, 0x54, 0x55, 0x56, 0x57,
 251          0x58, 0x59, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
 252          0x00, 0x61, 0x62, 0x63, 0x64, 0x65, 0x66, 0x67,
 253          0x68, 0x69, 0x6a, 0x6b, 0x6c, 0x6d, 0x6e, 0x6f,
 254          0x70, 0x71, 0x73, 0x72, 0x74, 0x75, 0x76, 0x77,
 255          0x78, 0x79, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
 256         USE_CHARSET (charset, GREEK_ISO8859_7);
 257         code = greek[(keysym & 0x7f) - 0x20];
 258         break;
 259       }
 260     case 8: /* Technical */
 261       break;
 262     case 9: /* Special */
 263       break;
 264     case 10: /* Publishing */
 265       break;
 266     case 11: /* APL */
 267       break;
 268     case 12: /* Hebrew */
 269       USE_CHARSET (charset, HEBREW_ISO8859_8);
 270       code = keysym & 0x7f;
 271       break;
 272     case 13: /* Thai */
 273       /* #### This needs to deal with character composition. */
 274       USE_CHARSET (charset, THAI_TIS620);
 275       code = keysym & 0x7f;
 276       break;
 277     case 14: /* Korean Hangul */
 278       break;
 279     case 19: /* Latin 9 - ISO8859-15 - unsupported charset. */
 280       break;
 281     case 32: /* Currency */
 282       break;
 283     default:
 284       break;
 285     }
 286
 287   if (code == 0)
 288     return Qnil;
 289
 290 #ifdef MULE
 291   return make_char (MAKE_CHAR (charset, code, 0));
 292 #else
 293   return make_char (code + 0x80);
 294 #endif
 295 }
 296
 297 /* #### The way that keysym correspondence to characters should work:
 298    - a Lisp_Event should contain a keysym AND a character slot.
 299    - keybindings are tried with the keysym.  If no binding can be found,
 300    and there is a corresponding character, call self-insert-command.
 301
 302    #### Nuke x-iso8859-1.el.
 303    #### Nuke the Qascii_character property.
 304    #### Nuke Vcharacter_set_property.
 305 */
 306 static void
 307 maybe_define_x_key_as_self_inserting_character (KeySym keysym, Lisp_Object symbol)
 308 {
 309   Lisp_Object character = x_keysym_to_character (keysym);
 310
 311   if (CHARP (character))
 312     {
 313       extern Lisp_Object Vcurrent_global_map;
 314       extern Lisp_Object Qascii_character;
 315       if (NILP (Flookup_key (Vcurrent_global_map, symbol, Qnil)))
 316         {
 317           Fput (symbol, Qascii_character, character);
 318           Fdefine_key (Vcurrent_global_map, symbol, Qself_insert_command);
 319         }
 320     }
 321 }
 322
 323 static void
 324 x_has_keysym (KeySym keysym, Lisp_Object hash_table, int with_modifiers)
 325 {
 326   KeySym upper_lower[2];
 327   int j;
 328
 329   if (keysym < 0x80) /* Optimize for ASCII keysyms */
 330     return;
 331
 332   /* If you execute:
 333      xmodmap -e 'keysym NN = scaron'
 334      and then press (Shift scaron), X11 will return the different
 335      keysym `Scaron', but  `xmodmap -pke'  might not even mention `Scaron'.
 336      So we "register" both `scaron' and `Scaron'. */
 337 #ifdef HAVE_XCONVERTCASE
 338   XConvertCase (keysym, &upper_lower[0], &upper_lower[1]);
 339 #else
 340   upper_lower[0] = upper_lower[1] = keysym;
 341 #endif
 342
 343   for (j = 0; j < (upper_lower[0] == upper_lower[1] ? 1 : 2); j++)
 344     {
 345       char *name;
 346       keysym = upper_lower[j];
 347
 348       name = XKeysymToString (keysym);
 349       if (name)
 350         {
 351           /* X guarantees NAME to be in the Host Portable Character Encoding */
 352           Lisp_Object sym = x_keysym_to_emacs_keysym (keysym, 0);
 353           Lisp_Object new_value = with_modifiers ? Qt : Qsans_modifiers;
 354           Lisp_Object old_value = Fgethash (sym, hash_table, Qnil);
 355
 356           if (! EQ (old_value, new_value)
 357               && ! (EQ (old_value, Qsans_modifiers) &&
 358                     EQ (new_value, Qt)))
 359             {
 360               maybe_define_x_key_as_self_inserting_character (keysym, sym);
 361               Fputhash (build_ext_string (name, Qbinary), new_value, hash_table);
 362               Fputhash (sym, new_value, hash_table);
 363             }
 364         }
 365     }
 366 }
 367
 368 static void
 369 x_reset_key_mapping (struct device *d)
 370 {
 371   Display *display = DEVICE_X_DISPLAY (d);
 372   struct x_device *xd = DEVICE_X_DATA (d);
 373   KeySym *keysym, *keysym_end;
 374   Lisp_Object hash_table;
 375   int key_code_count, keysyms_per_code;
 376
 377   if (xd->x_keysym_map)
 378     XFree ((char *) xd->x_keysym_map);
 379   XDisplayKeycodes (display,
 380                     &xd->x_keysym_map_min_code,
 381                     &xd->x_keysym_map_max_code);
 382   key_code_count = xd->x_keysym_map_max_code - xd->x_keysym_map_min_code + 1;
 383   xd->x_keysym_map =
 384     XGetKeyboardMapping (display, xd->x_keysym_map_min_code, key_code_count,
 385                          &xd->x_keysym_map_keysyms_per_code);
 386
 387   hash_table = xd->x_keysym_map_hash_table;
 388   if (HASH_TABLEP (hash_table))
 389     Fclrhash (hash_table);
 390   else
 391     xd->x_keysym_map_hash_table = hash_table =
 392       make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
 393
 394   for (keysym = xd->x_keysym_map,
 395          keysyms_per_code = xd->x_keysym_map_keysyms_per_code,
 396          keysym_end = keysym + (key_code_count * keysyms_per_code);
 397        keysym < keysym_end;
 398        keysym += keysyms_per_code)
 399     {
 400       int j;
 401
 402       if (keysym[0] == NoSymbol)
 403         continue;
 404
 405       x_has_keysym (keysym[0], hash_table, 0);
 406
 407       for (j = 1; j < keysyms_per_code; j++)
 408         {
 409           if (keysym[j] != keysym[0] &&
 410               keysym[j] != NoSymbol)
 411             x_has_keysym (keysym[j], hash_table, 1);
 412         }
 413     }
 414 }
 415
 416 static const char *
 417 index_to_name (int indice)
 418 {
 419   switch (indice)
 420     {
 421     case ShiftMapIndex:   return "ModShift";
 422     case LockMapIndex:    return "ModLock";
 423     case ControlMapIndex: return "ModControl";
 424     case Mod1MapIndex:    return "Mod1";
 425     case Mod2MapIndex:    return "Mod2";
 426     case Mod3MapIndex:    return "Mod3";
 427     case Mod4MapIndex:    return "Mod4";
 428     case Mod5MapIndex:    return "Mod5";
 429     default:              return "???";
 430     }
 431 }
 432
 433 /* Boy, I really wish C had local functions... */
 434 struct c_doesnt_have_closures   /* #### not yet used */
 435 {
 436   int warned_about_overlapping_modifiers;
 437   int warned_about_predefined_modifiers;
 438   int warned_about_duplicate_modifiers;
 439   int meta_bit;
 440   int hyper_bit;
 441   int super_bit;
 442   int alt_bit;
 443   int mode_bit;
 444 };
 445
 446 static void
 447 x_reset_modifier_mapping (struct device *d)
 448 {
 449   Display *display = DEVICE_X_DISPLAY (d);
 450   struct x_device *xd = DEVICE_X_DATA (d);
 451   int modifier_index, modifier_key, column, mkpm;
 452   int warned_about_overlapping_modifiers = 0;
 453   int warned_about_predefined_modifiers  = 0;
 454   int warned_about_duplicate_modifiers   = 0;
 455   int meta_bit  = 0;
 456   int hyper_bit = 0;
 457   int super_bit = 0;
 458   int alt_bit   = 0;
 459   int mode_bit  = 0;
 460
 461   xd->lock_interpretation = 0;
 462
 463   if (xd->x_modifier_keymap)
 464     XFreeModifiermap (xd->x_modifier_keymap);
 465
 466   x_reset_key_mapping (d);
 467
 468   xd->x_modifier_keymap = XGetModifierMapping (display);
 469
 470   /* Boy, I really wish C had local functions...
 471    */
 472
 473   /* The call to warn_when_safe must be on the same line as the string or
 474      make-msgfile won't pick it up properly (the newline doesn't confuse
 475      it, but the backslash does). */
 476
 477 #define modwarn(name,old,other)                                         \
 478   warn_when_safe (Qkey_mapping, Qwarning, "XEmacs:  %s (0x%x) generates %s, which is generated by %s.", \
 479                   name, code, index_to_name (old), other),              \
 480   warned_about_overlapping_modifiers = 1
 481
 482 #define modbarf(name,other)                                                 \
 483   warn_when_safe (Qkey_mapping, Qwarning, "XEmacs:  %s (0x%x) generates %s, which is nonsensical.", \
 484                   name, code, other),                                       \
 485   warned_about_predefined_modifiers = 1
 486
 487 #define check_modifier(name,mask)                                             \
 488   if ((1<<modifier_index) != mask)                                            \
 489     warn_when_safe (Qkey_mapping, Qwarning, "XEmacs:  %s (0x%x) generates %s, which is nonsensical.", \
 490                     name, code, index_to_name (modifier_index)),              \
 491     warned_about_predefined_modifiers = 1
 492
 493 #define store_modifier(name,old)                                           \
 494   if (old && old != modifier_index)                                        \
 495     warn_when_safe (Qkey_mapping, Qwarning, "XEmacs:  %s (0x%x) generates both %s and %s, which is nonsensical.",\
 496                     name, code, index_to_name (old),                       \
 497                     index_to_name (modifier_index)),                       \
 498     warned_about_duplicate_modifiers = 1;                                  \
 499   if (modifier_index == ShiftMapIndex) modbarf (name,"ModShift");          \
 500   else if (modifier_index == LockMapIndex) modbarf (name,"ModLock");       \
 501   else if (modifier_index == ControlMapIndex) modbarf (name,"ModControl"); \
 502   else if (sym == XK_Mode_switch)                                          \
 503     mode_bit = modifier_index; /* Mode_switch is special, see below... */  \
 504   else if (modifier_index == meta_bit && old != meta_bit)                  \
 505     modwarn (name, meta_bit, "Meta");                                      \
 506   else if (modifier_index == super_bit && old != super_bit)                \
 507     modwarn (name, super_bit, "Super");                                    \
 508   else if (modifier_index == hyper_bit && old != hyper_bit)                \
 509     modwarn (name, hyper_bit, "Hyper");                                    \
 510   else if (modifier_index == alt_bit && old != alt_bit)                    \
 511     modwarn (name, alt_bit, "Alt");                                        \
 512   else                                                                     \
 513     old = modifier_index;
 514
 515   mkpm = xd->x_modifier_keymap->max_keypermod;
 516   for (modifier_index = 0; modifier_index < 8; modifier_index++)
 517     for (modifier_key = 0; modifier_key < mkpm; modifier_key++) {
 518       KeySym last_sym = 0;
 519       for (column = 0; column < 4; column += 2) {
 520         KeyCode code = xd->x_modifier_keymap->modifiermap[modifier_index * mkpm
 521                                                           + modifier_key];
 522         KeySym sym = (code ? XKeycodeToKeysym (display, code, column) : 0);
 523         if (sym == last_sym) continue;
 524         last_sym = sym;
 525         switch (sym) {
 526         case XK_Mode_switch:store_modifier ("Mode_switch", mode_bit); break;
 527         case XK_Meta_L:     store_modifier ("Meta_L", meta_bit); break;
 528         case XK_Meta_R:     store_modifier ("Meta_R", meta_bit); break;
 529         case XK_Super_L:    store_modifier ("Super_L", super_bit); break;
 530         case XK_Super_R:    store_modifier ("Super_R", super_bit); break;
 531         case XK_Hyper_L:    store_modifier ("Hyper_L", hyper_bit); break;
 532         case XK_Hyper_R:    store_modifier ("Hyper_R", hyper_bit); break;
 533         case XK_Alt_L:      store_modifier ("Alt_L", alt_bit); break;
 534         case XK_Alt_R:      store_modifier ("Alt_R", alt_bit); break;
 535         case XK_Control_L:  check_modifier ("Control_L", ControlMask); break;
 536         case XK_Control_R:  check_modifier ("Control_R", ControlMask); break;
 537         case XK_Shift_L:    check_modifier ("Shift_L", ShiftMask); break;
 538         case XK_Shift_R:    check_modifier ("Shift_R", ShiftMask); break;
 539         case XK_Shift_Lock: check_modifier ("Shift_Lock", LockMask);
 540           xd->lock_interpretation = XK_Shift_Lock; break;
 541         case XK_Caps_Lock:  check_modifier ("Caps_Lock", LockMask);
 542           xd->lock_interpretation = XK_Caps_Lock; break;
 543
 544         /* It probably doesn't make any sense for a modifier bit to be
 545            assigned to a key that is not one of the above, but OpenWindows
 546            assigns modifier bits to a couple of random function keys for
 547            no reason that I can discern, so printing a warning here would
 548            be annoying. */
 549         }
 550       }
 551     }
 552 #undef store_modifier
 553 #undef check_modifier
 554 #undef modwarn
 555 #undef modbarf
 556
 557   /* If there was no Meta key, then try using the Alt key instead.
 558      If there is both a Meta key and an Alt key, then the Alt key
 559      is not disturbed and remains an Alt key. */
 560   if (! meta_bit && alt_bit)
 561     meta_bit = alt_bit, alt_bit = 0;
 562
 563   /* mode_bit overrides everything, since it's processed down inside of
 564      XLookupString() instead of by us.  If Meta and Mode_switch both
 565      generate the same modifier bit (which is an error), then we don't
 566      interpret that bit as Meta, because we can't make XLookupString()
 567      not interpret it as Mode_switch; and interpreting it as both would
 568      be totally wrong. */
 569   if (mode_bit)
 570     {
 571       const char *warn = 0;
 572       if      (mode_bit == meta_bit)  warn = "Meta",  meta_bit  = 0;
 573       else if (mode_bit == hyper_bit) warn = "Hyper", hyper_bit = 0;
 574       else if (mode_bit == super_bit) warn = "Super", super_bit = 0;
 575       else if (mode_bit == alt_bit)   warn = "Alt",   alt_bit   = 0;
 576       if (warn)
 577         {
 578           warn_when_safe
 579             (Qkey_mapping, Qwarning,
 580              "XEmacs:  %s is being used for both Mode_switch and %s.",
 581              index_to_name (mode_bit), warn),
 582             warned_about_overlapping_modifiers = 1;
 583         }
 584     }
 585 #undef index_to_name
 586
 587   xd->MetaMask   = (meta_bit   ? (1 << meta_bit)  : 0);
 588   xd->HyperMask  = (hyper_bit  ? (1 << hyper_bit) : 0);
 589   xd->SuperMask  = (super_bit  ? (1 << super_bit) : 0);
 590   xd->AltMask    = (alt_bit    ? (1 << alt_bit)   : 0);
 591   xd->ModeMask   = (mode_bit   ? (1 << mode_bit)  : 0); /* unused */
 592
 593
 594   if (warned_about_overlapping_modifiers)
 595     warn_when_safe (Qkey_mapping, Qwarning, "\n"
 596 "       Two distinct modifier keys (such as Meta and Hyper) cannot generate\n"
 597 "       the same modifier bit, because Emacs won't be able to tell which\n"
 598 "       modifier was actually held down when some other key is pressed.  It\n"
 599 "       won't be able to tell Meta-x and Hyper-x apart, for example.  Change\n"
 600 "       one of these keys to use some other modifier bit.  If you intend for\n"
 601 "       these keys to have the same behavior, then change them to have the\n"
 602 "       same keysym as well as the same modifier bit.");
 603
 604   if (warned_about_predefined_modifiers)
 605     warn_when_safe (Qkey_mapping, Qwarning, "\n"
 606 "       The semantics of the modifier bits ModShift, ModLock, and ModControl\n"
 607 "       are predefined.  It does not make sense to assign ModControl to any\n"
 608 "       keysym other than Control_L or Control_R, or to assign any modifier\n"
 609 "       bits to the \"control\" keysyms other than ModControl.  You can't\n"
 610 "       turn a \"control\" key into a \"meta\" key (or vice versa) by simply\n"
 611 "       assigning the key a different modifier bit.  You must also make that\n"
 612 "       key generate an appropriate keysym (Control_L, Meta_L, etc).");
 613
 614   /* No need to say anything more for warned_about_duplicate_modifiers. */
 615
 616   if (warned_about_overlapping_modifiers || warned_about_predefined_modifiers)
 617     warn_when_safe (Qkey_mapping, Qwarning, "\n"
 618 "       The meanings of the modifier bits Mod1 through Mod5 are determined\n"
 619 "       by the keysyms used to control those bits.  Mod1 does NOT always\n"
 620 "       mean Meta, although some non-ICCCM-compliant programs assume that.");
 621 }
 622
 623 void
 624 x_init_modifier_mapping (struct device *d)
 625 {
 626   struct x_device *xd = DEVICE_X_DATA (d);
 627   xd->x_keysym_map_hash_table = Qnil;
 628   xd->x_keysym_map = NULL;
 629   xd->x_modifier_keymap = NULL;
 630   x_reset_modifier_mapping (d);
 631 }
 632
 633 static int
 634 x_key_is_modifier_p (KeyCode keycode, struct device *d)
 635 {
 636   struct x_device *xd = DEVICE_X_DATA (d);
 637   KeySym *syms;
 638   int i;
 639
 640   if (keycode < xd->x_keysym_map_min_code ||
 641       keycode > xd->x_keysym_map_max_code)
 642     return 0;
 643
 644   syms = &xd->x_keysym_map [(keycode - xd->x_keysym_map_min_code) *
 645                            xd->x_keysym_map_keysyms_per_code];
 646   for (i = 0; i < xd->x_keysym_map_keysyms_per_code; i++)
 647     if (IsModifierKey (syms [i]) ||
 648         syms [i] == XK_Mode_switch) /* why doesn't IsModifierKey count this? */
 649       return 1;
 650   return 0;
 651 }
 652
 653 /* key-handling code is always ugly.  It just ends up working out
 654    that way.
 655
 656    Here are some pointers:
 657
 658    -- DOWN_MASK indicates which modifiers should be treated as "down"
 659       when the corresponding upstroke happens.  It gets reset for
 660       a particular modifier when that modifier goes up, and reset
 661       for all modifiers when a non-modifier key is pressed.  Example:
 662
 663       I press Control-A-Shift and then release Control-A-Shift.
 664       I want the Shift key to be sticky but not the Control key.
 665
 666    -- LAST_DOWNKEY and RELEASE_TIME are used to keep track of
 667       auto-repeat -- see below.
 668
 669    -- If a modifier key is sticky, I can unstick it by pressing
 670       the modifier key again. */
 671
 672 static void
 673 x_handle_sticky_modifiers (XEvent *ev, struct device *d)
 674 {
 675   struct x_device *xd;
 676   KeyCode keycode;
 677   int type;
 678
 679   if (!modifier_keys_are_sticky) /* Optimize for non-sticky modifiers */
 680     return;
 681
 682   xd = DEVICE_X_DATA (d);
 683   keycode = ev->xkey.keycode;
 684   type = ev->type;
 685
 686   if (keycode < xd->x_keysym_map_min_code ||
 687       keycode > xd->x_keysym_map_max_code)
 688     return;
 689
 690   if (! ((type == KeyPress || type == KeyRelease) &&
 691          x_key_is_modifier_p (keycode, d)))
 692     { /* Not a modifier key */
 693       Bool key_event_p = (type == KeyPress || type == KeyRelease);
 694
 695       if (type == ButtonPress
 696           || (type == KeyPress
 697               && ((xd->last_downkey
 698                    && ((keycode != xd->last_downkey
 699                         || ev->xkey.time != xd->release_time)))
 700                   || (INTP (Vmodifier_keys_sticky_time)
 701                       && ev->xkey.time
 702                       > (xd->modifier_release_time
 703                          + XINT (Vmodifier_keys_sticky_time))))))
 704         {
 705           xd->need_to_add_mask = 0;
 706           xd->last_downkey = 0;
 707         }
 708       else if (type == KeyPress && !xd->last_downkey)
 709         xd->last_downkey = keycode;
 710
 711       if (type == KeyPress)
 712         xd->release_time = 0;
 713       if (type == KeyPress || type == ButtonPress)
 714         {
 715           xd->down_mask = 0;
 716           xd->modifier_release_time = 0;
 717         }
 718
 719       if (key_event_p)
 720         ev->xkey.state    |= xd->need_to_add_mask;
 721       else
 722         ev->xbutton.state |= xd->need_to_add_mask;
 723
 724       if (type == KeyRelease && keycode == xd->last_downkey)
 725         /* If I hold press-and-release the Control key and then press
 726            and hold down the right arrow, I want it to auto-repeat
 727            Control-Right.  On the other hand, if I do the same but
 728            manually press the Right arrow a bunch of times, I want
 729            to see one Control-Right and then a bunch of Rights.
 730            This means that we need to distinguish between an
 731            auto-repeated key and a key pressed and released a bunch
 732            of times.
 733
 734            Naturally, the designers of the X spec didn't see fit
 735            to provide an obvious way to distinguish these cases.
 736            So we assume that if the release and the next press
 737            occur at the same time, the key was actually auto-
 738            repeated.  Under Open-Windows, at least, this works. */
 739         xd->modifier_release_time = xd->release_time
 740           = key_event_p ? ev->xkey.time : ev->xbutton.time;
 741     }
 742   else                          /* Modifier key pressed */
 743     {
 744       int i;
 745       KeySym *syms = &xd->x_keysym_map [(keycode - xd->x_keysym_map_min_code) *
 746                                         xd->x_keysym_map_keysyms_per_code];
 747
 748       /* If a non-modifier key was pressed in the middle of a bunch
 749          of modifiers, then it unsticks all the modifiers that were
 750          previously pressed.  We cannot unstick the modifiers until
 751          now because we want to check for auto-repeat of the
 752          non-modifier key. */
 753
 754       if (xd->last_downkey)
 755         {
 756           xd->last_downkey = 0;
 757           xd->need_to_add_mask = 0;
 758         }
 759
 760       if (xd->modifier_release_time
 761           && INTP (Vmodifier_keys_sticky_time)
 762           && (ev->xkey.time
 763               > xd->modifier_release_time + XINT (Vmodifier_keys_sticky_time)))
 764         {
 765           xd->need_to_add_mask = 0;
 766           xd->down_mask = 0;
 767         }
 768
 769 #define FROB(mask)                              \
 770 do {                                            \
 771   if (type == KeyPress)                         \
 772     {                                           \
 773       /* If modifier key is already sticky,     \
 774          then unstick it.  Note that we do      \
 775          not test down_mask to deal with the    \
 776          unlikely but possible case that the    \
 777          modifier key auto-repeats. */          \
 778       if (xd->need_to_add_mask & mask)          \
 779         {                                       \
 780           xd->need_to_add_mask &= ~mask;        \
 781           xd->down_mask &= ~mask;               \
 782         }                                       \
 783       else                                      \
 784         xd->down_mask |= mask;                  \
 785     }                                           \
 786   else                                          \
 787     {                                           \
 788       if (xd->down_mask & mask)                 \
 789         {                                       \
 790           xd->down_mask &= ~mask;               \
 791           xd->need_to_add_mask |= mask;         \
 792         }                                       \
 793     }                                           \
 794   xd->modifier_release_time = ev->xkey.time;    \
 795 } while (0)
 796
 797       for (i = 0; i < xd->x_keysym_map_keysyms_per_code; i++)
 798         switch (syms[i])
 799           {
 800           case XK_Control_L: case XK_Control_R: FROB (ControlMask);   break;
 801           case XK_Shift_L:   case XK_Shift_R:   FROB (ShiftMask);     break;
 802           case XK_Meta_L:    case XK_Meta_R:    FROB (xd->MetaMask);  break;
 803           case XK_Super_L:   case XK_Super_R:   FROB (xd->SuperMask); break;
 804           case XK_Hyper_L:   case XK_Hyper_R:   FROB (xd->HyperMask); break;
 805           case XK_Alt_L:     case XK_Alt_R:     FROB (xd->AltMask);   break;
 806           }
 807     }
 808 #undef FROB
 809 }
 810
 811 static void
 812 clear_sticky_modifiers (struct device *d)
 813 {
 814   struct x_device *xd = DEVICE_X_DATA (d);
 815
 816   xd->need_to_add_mask = 0;
 817   xd->last_downkey     = 0;
 818   xd->release_time     = 0;
 819   xd->down_mask        = 0;
 820 }
 821
 822 static int
 823 keysym_obeys_caps_lock_p (KeySym sym, struct device *d)
 824 {
 825   struct x_device *xd = DEVICE_X_DATA (d);
 826   /* Eeeeevil hack.  Don't apply Caps_Lock to things that aren't alphabetic
 827      characters, where "alphabetic" means something more than simply A-Z.
 828      That is, if Caps_Lock is down, typing ESC doesn't produce Shift-ESC.
 829      But if shift-lock is down, then it does. */
 830   if (xd->lock_interpretation == XK_Shift_Lock)
 831     return 1;
 832
 833   return
 834     ((sym >= XK_A)        && (sym <= XK_Z))          ||
 835     ((sym >= XK_a)        && (sym <= XK_z))          ||
 836     ((sym >= XK_Agrave)   && (sym <= XK_Odiaeresis)) ||
 837     ((sym >= XK_agrave)   && (sym <= XK_odiaeresis)) ||
 838     ((sym >= XK_Ooblique) && (sym <= XK_Thorn))      ||
 839     ((sym >= XK_oslash)   && (sym <= XK_thorn));
 840 }
 841
 842 /* called from EmacsFrame.c (actually from Xt itself) when a
 843    MappingNotify event is received.  In its infinite wisdom, Xt
 844    decided that Xt event handlers never get MappingNotify events.
 845    O'Reilly Xt Programming Manual 9.1.2 says:
 846
 847    MappingNotify is automatically handled by Xt, so it isn't passed
 848    to event handlers and you don't need to worry about it.
 849
 850    Of course, we DO worry about it, so we need a special translation. */
 851 void
 852 emacs_Xt_mapping_action (Widget w, XEvent* event)
 853 {
 854   struct device *d = get_device_from_display (event->xany.display);
 855
 856   if (DEVICE_X_BEING_DELETED (d))
 857     return;
 858 #if 0
 859   /* nyet.  Now this is handled by Xt. */
 860   XRefreshKeyboardMapping (&event->xmapping);
 861 #endif
 862   /* xmodmap generates about a billion MappingKeyboard events, followed
 863      by a single MappingModifier event, so it might be worthwhile to
 864      take extra MappingKeyboard events out of the queue before requesting
 865      the current keymap from the server. */
 866   switch (event->xmapping.request)
 867     {
 868     case MappingKeyboard:  x_reset_key_mapping      (d); break;
 869     case MappingModifier:  x_reset_modifier_mapping (d); break;
 870     case MappingPointer:   /* Do something here? */      break;
 871     default: ABORT();
 872     }
 873 }
 874
 875 \f
 876 /************************************************************************/
 877 /*                  X to Emacs event conversion                         */
 878 /************************************************************************/
 879
 880 static Lisp_Object
 881 x_keysym_to_emacs_keysym (KeySym keysym, int simple_p)
 882 {
 883   char *name;
 884   if (keysym >= XK_exclam && keysym <= XK_asciitilde)
 885     /* We must assume that the X keysym numbers for the ASCII graphic
 886        characters are the same as their ASCII codes.  */
 887     return make_char (keysym);
 888
 889   switch (keysym)
 890     {
 891       /* These would be handled correctly by the default case, but by
 892          special-casing them here we don't garbage a string or call
 893          intern().  */
 894     case XK_BackSpace:  return QKbackspace;
 895     case XK_Tab:        return QKtab;
 896     case XK_Linefeed:   return QKlinefeed;
 897     case XK_Return:     return QKreturn;
 898     case XK_Escape:     return QKescape;
 899     case XK_space:      return QKspace;
 900     case XK_Delete:     return QKdelete;
 901     case 0:             return Qnil;
 902     default:
 903       if (simple_p) return Qnil;
 904       /* !!#### not Mule-ized */
 905       name = XKeysymToString (keysym);
 906       if (!name || !name[0])
 907         /* This happens if there is a mismatch between the Xlib of
 908            XEmacs and the Xlib of the X server...
 909
 910            Let's hard-code in some knowledge of common keysyms introduced
 911            in recent X11 releases.  Snarfed from X11/keysymdef.h
 912
 913            Probably we should add some stuff here for X11R6. */
 914         switch (keysym)
 915           {
 916           case 0xFF95: return KEYSYM ("kp-home");
 917           case 0xFF96: return KEYSYM ("kp-left");
 918           case 0xFF97: return KEYSYM ("kp-up");
 919           case 0xFF98: return KEYSYM ("kp-right");
 920           case 0xFF99: return KEYSYM ("kp-down");
 921           case 0xFF9A: return KEYSYM ("kp-prior");
 922           case 0xFF9B: return KEYSYM ("kp-next");
 923           case 0xFF9C: return KEYSYM ("kp-end");
 924           case 0xFF9D: return KEYSYM ("kp-begin");
 925           case 0xFF9E: return KEYSYM ("kp-insert");
 926           case 0xFF9F: return KEYSYM ("kp-delete");
 927
 928           case 0x1005FF10: return KEYSYM ("SunF36"); /* labeled F11 */
 929           case 0x1005FF11: return KEYSYM ("SunF37"); /* labeled F12 */
 930           default:
 931             {
 932               char buf [64];
 933               sprintf (buf, "unknown-keysym-0x%X", (int) keysym);
 934               return KEYSYM (buf);
 935             }
 936           }
 937       /* If it's got a one-character name, that's good enough. */
 938       if (!name[1])
 939         return make_char (name[0]);
 940
 941       /* If it's in the "Keyboard" character set, downcase it.
 942          The case of those keysyms is too totally random for us to
 943          force anyone to remember them.
 944          The case of the other character sets is significant, however.
 945          */
 946       if ((((unsigned int) keysym) & (~0x1FF)) == ((unsigned int) 0xFE00))
 947         {
 948           char buf [255];
 949           char *s1, *s2;
 950           for (s1 = name, s2 = buf; *s1; s1++, s2++) {
 951             if (*s1 == '_') {
 952               *s2 = '-';
 953             } else {
 954               *s2 = tolower (* (unsigned char *) s1);
 955             }
 956           }
 957           *s2 = 0;
 958           return KEYSYM (buf);
 959         }
 960       return KEYSYM (name);
 961     }
 962 }
 963
 964 static Lisp_Object
 965 x_to_emacs_keysym (XKeyPressedEvent *event, int simple_p)
 966      /* simple_p means don't try too hard (ASCII only) */
 967 {
 968   KeySym keysym = 0;
 969
 970 #ifdef HAVE_XIM
 971   int len;
 972   /* Some implementations of XmbLookupString don't return
 973      XBufferOverflow correctly, so increase the size of the xim input
 974      buffer from 64 to the more reasonable size 513, as Emacs has done.
 975      From Kenichi Handa. */
 976   char buffer[513];
 977   char *bufptr = buffer;
 978   int   bufsiz = sizeof (buffer);
 979   Status status;
 980 #ifdef XIM_XLIB
 981   XIC xic = FRAME_X_XIC (x_any_window_to_frame
 982                          (get_device_from_display (event->display),
 983                           event->window));
 984 #endif /* XIM_XLIB */
 985 #endif /* HAVE_XIM */
 986
 987   /* We use XLookupString if we're not using XIM, or are using
 988      XIM_XLIB but input context creation failed. */
 989 #if ! (defined (HAVE_XIM) && defined (XIM_MOTIF))
 990 #if defined (HAVE_XIM) && defined (XIM_XLIB)
 991      if (!xic)
 992 #endif /* XIM_XLIB */
 993     {
 994       /* Apparently it's necessary to specify a dummy here (rather
 995          than passing in 0) to avoid crashes on German IRIX */
 996       char dummy[256];
 997       XLookupString (event, dummy, 200, &keysym, 0);
 998       return (IsModifierKey (keysym) || keysym == XK_Mode_switch )
 999         ? Qnil : x_keysym_to_emacs_keysym (keysym, simple_p);
1000     }
1001 #endif /* ! XIM_MOTIF */
1002
1003 #ifdef HAVE_XIM
1004  Lookup_String: /* Come-From XBufferOverflow */
1005 #ifdef XIM_MOTIF
1006   len = XmImMbLookupString (XtWindowToWidget (event->display, event->window),
1007                             event, bufptr, bufsiz, &keysym, &status);
1008 #else /* XIM_XLIB */
1009   if (xic)
1010     len = XmbLookupString (xic, event, bufptr, bufsiz, &keysym, &status);
1011 #endif /* HAVE_XIM */
1012
1013 #ifdef DEBUG_XEMACS
1014   if (debug_x_events > 0)
1015     {
1016       stderr_out ("   status=");
1017 #define print_status_when(S) if (status == S) stderr_out (#S)
1018       print_status_when (XLookupKeySym);
1019       print_status_when (XLookupBoth);
1020       print_status_when (XLookupChars);
1021       print_status_when (XLookupNone);
1022       print_status_when (XBufferOverflow);
1023
1024       if (status == XLookupKeySym || status == XLookupBoth)
1025         stderr_out (" keysym=%s",  XKeysymToString (keysym));
1026       if (status == XLookupChars  || status == XLookupBoth)
1027         {
1028           if (len != 1)
1029             {
1030               int j;
1031               stderr_out (" chars=\"");
1032               for (j=0; j<len; j++)
1033                 stderr_out ("%c", bufptr[j]);
1034               stderr_out ("\"");
1035             }
1036           else if (bufptr[0] <= 32 || bufptr[0] >= 127)
1037             stderr_out (" char=0x%x", bufptr[0]);
1038           else
1039             stderr_out (" char=%c", bufptr[0]);
1040         }
1041       stderr_out ("\n");
1042     }
1043 #endif /* DEBUG_XEMACS */
1044
1045   switch (status)
1046     {
1047     case XLookupKeySym:
1048     case XLookupBoth:
1049       return (IsModifierKey (keysym) || keysym == XK_Mode_switch )
1050         ? Qnil : x_keysym_to_emacs_keysym (keysym, simple_p);
1051
1052     case XLookupChars:
1053       {
1054         /* Generate multiple emacs events */
1055         struct device *d = get_device_from_display (event->display);
1056         Emchar ch;
1057         Lisp_Object instream, fb_instream;
1058         Lstream *istr;
1059         struct gcpro gcpro1, gcpro2;
1060
1061         fb_instream = make_fixed_buffer_input_stream (bufptr, len);
1062
1063         /* #### Use Fget_coding_system (Vcomposed_input_coding_system) */
1064         instream =
1065           make_decoding_input_stream (XLSTREAM (fb_instream),
1066                                       Fget_coding_system (Qundecided));
1067
1068         istr = XLSTREAM (instream);
1069
1070         GCPRO2 (instream, fb_instream);
1071         while ((ch = Lstream_get_emchar (istr)) != EOF)
1072           {
1073             Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
1074             Lisp_Event *ev          = XEVENT (emacs_event);
1075             ev->channel             = DEVICE_CONSOLE (d);
1076             ev->event_type          = key_press_event;
1077             ev->timestamp           = event->time;
1078             ev->event.key.modifiers = 0;
1079             ev->event.key.keysym    = make_char (ch);
1080             enqueue_Xt_dispatch_event (emacs_event);
1081           }
1082         Lstream_close (istr);
1083         UNGCPRO;
1084         Lstream_delete (istr);
1085         Lstream_delete (XLSTREAM (fb_instream));
1086         return Qnil;
1087       }
1088     case XLookupNone: return Qnil;
1089     case XBufferOverflow:
1090       bufptr = (char *) alloca (len+1);
1091       bufsiz = len+1;
1092       goto Lookup_String;
1093     }
1094   return Qnil; /* not reached */
1095 #endif /* HAVE_XIM */
1096 }
1097
1098 static void
1099 set_last_server_timestamp (struct device *d, XEvent *x_event)
1100 {
1101   Time t;
1102   switch (x_event->type)
1103     {
1104     case KeyPress:
1105     case KeyRelease:       t = x_event->xkey.time;              break;
1106     case ButtonPress:
1107     case ButtonRelease:    t = x_event->xbutton.time;           break;
1108     case EnterNotify:
1109     case LeaveNotify:      t = x_event->xcrossing.time;         break;
1110     case MotionNotify:     t = x_event->xmotion.time;           break;
1111     case PropertyNotify:   t = x_event->xproperty.time;         break;
1112     case SelectionClear:   t = x_event->xselectionclear.time;   break;
1113     case SelectionRequest: t = x_event->xselectionrequest.time; break;
1114     case SelectionNotify:  t = x_event->xselection.time;        break;
1115     default: return;
1116     }
1117   DEVICE_X_LAST_SERVER_TIMESTAMP (d) = t;
1118 }
1119
1120 static int
1121 x_event_to_emacs_event (XEvent *x_event, Lisp_Event *emacs_event)
1122 {
1123   Display *display    = x_event->xany.display;
1124   struct device *d    = get_device_from_display (display);
1125   struct x_device *xd = DEVICE_X_DATA (d);
1126
1127   if (DEVICE_X_BEING_DELETED (d))
1128      /* #### Uh, is this 0 correct? */
1129      return 0;
1130
1131   set_last_server_timestamp (d, x_event);
1132
1133   switch (x_event->type)
1134     {
1135     case KeyRelease:
1136       x_handle_sticky_modifiers (x_event, d);
1137       return 0;
1138
1139     case KeyPress:
1140     case ButtonPress:
1141     case ButtonRelease:
1142       {
1143         int modifiers = 0;
1144         int shift_p, lock_p;
1145         Bool key_event_p = (x_event->type == KeyPress);
1146         unsigned int *state =
1147           key_event_p ? &x_event->xkey.state : &x_event->xbutton.state;
1148
1149         /* If this is a synthetic KeyPress or Button event, and the user
1150            has expressed a disinterest in this security hole, then drop
1151            it on the floor. */
1152         if ((key_event_p
1153              ? x_event->xkey.send_event
1154              : x_event->xbutton.send_event)
1155 #ifdef EXTERNAL_WIDGET
1156             /* ben: events get sent to an ExternalShell using XSendEvent.
1157                This is not a perfect solution. */
1158             && !FRAME_X_EXTERNAL_WINDOW_P
1159             (x_any_window_to_frame (d, x_event->xany.window))
1160 #endif
1161             && !x_allow_sendevents)
1162           return 0;
1163
1164         DEVICE_X_MOUSE_TIMESTAMP (d) =
1165           DEVICE_X_GLOBAL_MOUSE_TIMESTAMP (d) =
1166           key_event_p ? x_event->xkey.time : x_event->xbutton.time;
1167
1168         x_handle_sticky_modifiers (x_event, d);
1169
1170         if (*state & ControlMask)    modifiers |= XEMACS_MOD_CONTROL;
1171         if (*state & xd->MetaMask)   modifiers |= XEMACS_MOD_META;
1172         if (*state & xd->SuperMask)  modifiers |= XEMACS_MOD_SUPER;
1173         if (*state & xd->HyperMask)  modifiers |= XEMACS_MOD_HYPER;
1174         if (*state & xd->AltMask)    modifiers |= XEMACS_MOD_ALT;
1175         {
1176           int numero_de_botao = -1;
1177
1178           if (!key_event_p)
1179             numero_de_botao = x_event->xbutton.button;
1180
1181           /* the button gets noted either in the button or the modifiers
1182              field, but not both. */
1183           if (numero_de_botao != 1 && (*state & Button1Mask))
1184             modifiers |= XEMACS_MOD_BUTTON1;
1185           if (numero_de_botao != 2 && (*state & Button2Mask))
1186             modifiers |= XEMACS_MOD_BUTTON2;
1187           if (numero_de_botao != 3 && (*state & Button3Mask))
1188             modifiers |= XEMACS_MOD_BUTTON3;
1189           if (numero_de_botao != 4 && (*state & Button4Mask))
1190             modifiers |= XEMACS_MOD_BUTTON4;
1191           if (numero_de_botao != 5 && (*state & Button5Mask))
1192             modifiers |= XEMACS_MOD_BUTTON5;
1193         }
1194
1195         /* Ignore the Caps_Lock key if:
1196            - any other modifiers are down, so that Caps_Lock doesn't
1197              turn C-x into C-X, which would suck.
1198            - the event was a mouse event. */
1199         if (modifiers || ! key_event_p)
1200           *state &= (~LockMask);
1201
1202         shift_p = *state & ShiftMask;
1203         lock_p  = *state & LockMask;
1204
1205         if (shift_p || lock_p)
1206           modifiers |= XEMACS_MOD_SHIFT;
1207
1208         if (key_event_p)
1209           {
1210             Lisp_Object keysym;
1211             XKeyEvent *ev = &x_event->xkey;
1212             /* This used to compute the frame from the given X window and
1213                store it here, but we really don't care about the frame. */
1214             emacs_event->channel = DEVICE_CONSOLE (d);
1215             keysym = x_to_emacs_keysym (&x_event->xkey, 0);
1216
1217             /* If the emacs keysym is nil, then that means that the X
1218                keysym was either a Modifier or NoSymbol, which
1219                probably means that we're in the midst of reading a
1220                Multi_key sequence, or a "dead" key prefix, or XIM
1221                input. Ignore it. */
1222             if (NILP (keysym))
1223               return 0;
1224
1225             /* More Caps_Lock garbage: Caps_Lock should *only* add the
1226                shift modifier to two-case keys (that is, A-Z and
1227                related characters). So at this point (after looking up
1228                the keysym) if the keysym isn't a dual-case alphabetic,
1229                and if the caps lock key was down but the shift key
1230                wasn't, then turn off the shift modifier.  Gag barf */
1231             /* #### type lossage: assuming equivalence of emacs and
1232                X keysyms */
1233             /* !!#### maybe fix for Mule */
1234             if (lock_p && !shift_p &&
1235                 ! (CHAR_OR_CHAR_INTP (keysym)
1236                    && keysym_obeys_caps_lock_p
1237                    ((KeySym) XCHAR_OR_CHAR_INT (keysym), d)))
1238               modifiers &= (~XEMACS_MOD_SHIFT);
1239
1240             /* If this key contains two distinct keysyms, that is,
1241                "shift" generates a different keysym than the
1242                non-shifted key, then don't apply the shift modifier
1243                bit: it's implicit.  Otherwise, if there would be no
1244                other way to tell the difference between the shifted
1245                and unshifted version of this key, apply the shift bit.
1246                Non-graphics, like Backspace and F1 get the shift bit
1247                in the modifiers slot.  Neither the characters "a",
1248                "A", "2", nor "@" normally have the shift bit set.
1249                However, "F1" normally does. */
1250             if (modifiers & XEMACS_MOD_SHIFT)
1251               {
1252                 int Mode_switch_p = *state & xd->ModeMask;
1253                 KeySym bot = XLookupKeysym (ev, Mode_switch_p ? 2 : 0);
1254                 KeySym top = XLookupKeysym (ev, Mode_switch_p ? 3 : 1);
1255                 if (top && bot && top != bot)
1256                   modifiers &= ~XEMACS_MOD_SHIFT;
1257               }
1258             emacs_event->event_type          = key_press_event;
1259             emacs_event->timestamp           = ev->time;
1260             emacs_event->event.key.modifiers = modifiers;
1261             emacs_event->event.key.keysym    = keysym;
1262           }
1263         else                    /* Mouse press/release event */
1264           {
1265             XButtonEvent *ev = &x_event->xbutton;
1266             struct frame *frame = x_window_to_frame (d, ev->window);
1267
1268             if (! frame)
1269               return 0; /* not for us */
1270             XSETFRAME (emacs_event->channel, frame);
1271
1272             emacs_event->event_type = (x_event->type == ButtonPress) ?
1273               button_press_event : button_release_event;
1274
1275             emacs_event->event.button.modifiers = modifiers;
1276             emacs_event->timestamp              = ev->time;
1277             emacs_event->event.button.button    = ev->button;
1278             emacs_event->event.button.x         = ev->x;
1279             emacs_event->event.button.y         = ev->y;
1280             /* because we don't seem to get a FocusIn event for button clicks
1281                when a widget-glyph is selected we will assume that we want the
1282                focus if a button gets pressed. */
1283             if (x_event->type == ButtonPress)
1284               handle_focus_event_1 (frame, 1);
1285           }
1286       }
1287     break;
1288
1289     case MotionNotify:
1290       {
1291         XMotionEvent *ev = &x_event->xmotion;
1292         struct frame *frame = x_window_to_frame (d, ev->window);
1293         int modifiers = 0;
1294         XMotionEvent event2;
1295
1296         if (! frame)
1297           return 0; /* not for us */
1298
1299         /* We use MotionHintMask, so we will get only one motion event
1300            until the next time we call XQueryPointer or the user
1301            clicks the mouse.  So call XQueryPointer now (meaning that
1302            the event will be in sync with the server just before
1303            Fnext_event() returns).  If the mouse is still in motion,
1304            then the server will immediately generate exactly one more
1305            motion event, which will be on the queue waiting for us
1306            next time around. */
1307         event2 = *ev;
1308         if (XQueryPointer (event2.display, event2.window,
1309                            &event2.root,   &event2.subwindow,
1310                            &event2.x_root, &event2.y_root,
1311                            &event2.x,      &event2.y,
1312                            &event2.state))
1313           ev = &event2; /* only one structure copy */
1314
1315         DEVICE_X_MOUSE_TIMESTAMP (d) = ev->time;
1316
1317         XSETFRAME (emacs_event->channel, frame);
1318         emacs_event->event_type     = pointer_motion_event;
1319         emacs_event->timestamp      = ev->time;
1320         emacs_event->event.motion.x = ev->x;
1321         emacs_event->event.motion.y = ev->y;
1322         if (ev->state & ShiftMask)      modifiers |= XEMACS_MOD_SHIFT;
1323         if (ev->state & ControlMask)    modifiers |= XEMACS_MOD_CONTROL;
1324         if (ev->state & xd->MetaMask)   modifiers |= XEMACS_MOD_META;
1325         if (ev->state & xd->SuperMask)  modifiers |= XEMACS_MOD_SUPER;
1326         if (ev->state & xd->HyperMask)  modifiers |= XEMACS_MOD_HYPER;
1327         if (ev->state & xd->AltMask)    modifiers |= XEMACS_MOD_ALT;
1328         if (ev->state & Button1Mask)    modifiers |= XEMACS_MOD_BUTTON1;
1329         if (ev->state & Button2Mask)    modifiers |= XEMACS_MOD_BUTTON2;
1330         if (ev->state & Button3Mask)    modifiers |= XEMACS_MOD_BUTTON3;
1331         if (ev->state & Button4Mask)    modifiers |= XEMACS_MOD_BUTTON4;
1332         if (ev->state & Button5Mask)    modifiers |= XEMACS_MOD_BUTTON5;
1333         /* Currently ignores Shift_Lock but probably shouldn't
1334            (but it definitely should ignore Caps_Lock). */
1335         emacs_event->event.motion.modifiers = modifiers;
1336       }
1337     break;
1338
1339     case ClientMessage:
1340       {
1341         /* Patch bogus TAKE_FOCUS messages from MWM; CurrentTime is
1342            passed as the timestamp of the TAKE_FOCUS, which the ICCCM
1343            explicitly prohibits. */
1344         XClientMessageEvent *ev = &x_event->xclient;
1345 #ifdef HAVE_OFFIX_DND
1346         if (DndIsDropMessage(x_event))
1347           {
1348             unsigned int state;
1349             int modifiers = 0;
1350             unsigned int button=0;
1351             struct frame *frame = x_any_window_to_frame (d, ev->window);
1352             Extbyte *data;
1353             unsigned long size, dtype;
1354             Lisp_Object l_type = Qnil, l_data = Qnil;
1355             Lisp_Object l_dndlist = Qnil, l_item = Qnil;
1356             struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1357
1358             if (! frame)
1359               return 0; /* not for us */
1360
1361             GCPRO4 (l_type, l_data, l_dndlist, l_item);
1362             XSETFRAME (emacs_event->channel, frame);
1363
1364             emacs_event->event_type = misc_user_event;
1365             emacs_event->timestamp  = DEVICE_X_LAST_SERVER_TIMESTAMP (d);
1366
1367             state=DndDragButtons(x_event);
1368
1369             if (state & ShiftMask)      modifiers |= XEMACS_MOD_SHIFT;
1370             if (state & ControlMask)    modifiers |= XEMACS_MOD_CONTROL;
1371             if (state & xd->MetaMask)   modifiers |= XEMACS_MOD_META;
1372             if (state & xd->SuperMask)  modifiers |= XEMACS_MOD_SUPER;
1373             if (state & xd->HyperMask)  modifiers |= XEMACS_MOD_HYPER;
1374             if (state & xd->AltMask)    modifiers |= XEMACS_MOD_ALT;
1375             if (state & Button1Mask)    modifiers |= XEMACS_MOD_BUTTON1;
1376             if (state & Button2Mask)    modifiers |= XEMACS_MOD_BUTTON2;
1377             if (state & Button3Mask)    modifiers |= XEMACS_MOD_BUTTON3;
1378             if (state & Button4Mask)    modifiers |= XEMACS_MOD_BUTTON4;
1379             if (state & Button5Mask)    modifiers |= XEMACS_MOD_BUTTON5;
1380
1381             if (state & Button5Mask)    button = Button5;
1382             if (state & Button4Mask)    button = Button4;
1383             if (state & Button3Mask)    button = Button3;
1384             if (state & Button2Mask)    button = Button2;
1385             if (state & Button1Mask)    button = Button1;
1386
1387             emacs_event->event.misc.modifiers = modifiers;
1388             emacs_event->event.misc.button    = button;
1389
1390             DndDropCoordinates(FRAME_X_TEXT_WIDGET(frame), x_event,
1391                                &(emacs_event->event.misc.x),
1392                                &(emacs_event->event.misc.y) );
1393
1394             DndGetData(x_event,&data,&size);
1395
1396             dtype=DndDataType(x_event);
1397             switch (dtype)
1398               {
1399               case DndFiles: /* null terminated strings, end null */
1400                 {
1401                   int len;
1402                   char *hurl = NULL;
1403
1404                   while (*data)
1405                     {
1406                       len = strlen ((char*)data);
1407                       hurl = dnd_url_hexify_string ((char *)data, "file:");
1408                       l_item = make_string ((Bufbyte *)hurl, strlen (hurl));
1409                       l_dndlist = Fcons (l_item, l_dndlist);
1410                       data += len + 1;
1411                       xfree (hurl);
1412                     }
1413                   l_type = Qdragdrop_URL;
1414                 }
1415                 break;
1416               case DndText:
1417                 l_type = Qdragdrop_MIME;
1418                 l_dndlist = list1 ( list3 ( list1 ( make_string ((Bufbyte *)"text/plain", 10) ),
1419                                             make_string ((Bufbyte *)"8bit", 4),
1420                                             make_ext_string ((Extbyte *)data,
1421                                                              strlen((char *)data),
1422                                                              Qctext) ) );
1423                 break;
1424               case DndMIME:
1425                 /* we have to parse this in some way to extract
1426                    content-type and params (in the tm way) and
1427                    content encoding.
1428                    OR: if data is string, let tm do the job
1429                        if data is list[2], give the first two
1430                        to tm...
1431                 */
1432                 l_type = Qdragdrop_MIME;
1433                 l_dndlist = list1 ( make_ext_string ((Extbyte *)data,
1434                                                      strlen((char *)data),
1435                                                      Qbinary) );
1436                 break;
1437               case DndFile:
1438               case DndDir:
1439               case DndLink:
1440               case DndExe:
1441                 {
1442                   char *hurl = dnd_url_hexify_string ((char *) data, "file:");
1443
1444                   l_dndlist = list1 ( make_string ((Bufbyte *)hurl,
1445                                                    strlen (hurl)) );
1446                   l_type = Qdragdrop_URL;
1447
1448                   xfree (hurl);
1449                 }
1450                 break;
1451               case DndURL:
1452                 /* as it is a real URL it should already be escaped
1453                    and escaping again will break them (cause % is unsave) */
1454                 l_dndlist = list1 ( make_ext_string ((Extbyte *)data,
1455                                                      strlen ((char *)data),
1456                                                      Qfile_name) );
1457                 l_type = Qdragdrop_URL;
1458                 break;
1459               default: /* Unknown, RawData and any other type */
1460                 l_dndlist = list1 ( list3 ( list1 ( make_string ((Bufbyte *)"application/octet-stream", 24) ),
1461                                             make_string ((Bufbyte *)"8bit", 4),
1462                                             make_ext_string ((Extbyte *)data,
1463                                                              size,
1464                                                              Qbinary) ) );
1465                 l_type = Qdragdrop_MIME;
1466                 break;
1467               }
1468
1469             emacs_event->event.misc.function = Qdragdrop_drop_dispatch;
1470             emacs_event->event.misc.object = Fcons (l_type, l_dndlist);
1471
1472             UNGCPRO;
1473
1474             break;
1475           }
1476 #endif /* HAVE_OFFIX_DND */
1477         if (ev->message_type == DEVICE_XATOM_WM_PROTOCOLS (d)
1478             && (Atom) (ev->data.l[0]) == DEVICE_XATOM_WM_TAKE_FOCUS (d)
1479             && (Atom) (ev->data.l[1]) == 0)
1480           {
1481             ev->data.l[1] = DEVICE_X_LAST_SERVER_TIMESTAMP (d);
1482           }
1483       }
1484     /* fall through */
1485
1486     default: /* it's a magic event */
1487       {
1488         struct frame *frame;
1489         Window w;
1490         XEvent *x_event_copy = &emacs_event->event.magic.underlying_x_event;
1491
1492 #define FROB(event_member, window_member) \
1493         x_event_copy->event_member = x_event->event_member; \
1494         w = x_event->event_member.window_member
1495
1496         switch (x_event->type)
1497           {
1498           case SelectionRequest: FROB(xselectionrequest, owner);  break;
1499           case SelectionClear:   FROB(xselectionclear, window);   break;
1500           case SelectionNotify:  FROB(xselection, requestor);     break;
1501           case PropertyNotify:   FROB(xproperty, window);         break;
1502           case ClientMessage:    FROB(xclient, window);           break;
1503           case ConfigureNotify:  FROB(xconfigure, window);        break;
1504           case Expose:
1505           case GraphicsExpose:   FROB(xexpose, window);           break;
1506           case MapNotify:
1507           case UnmapNotify:      FROB(xmap, window);              break;
1508           case EnterNotify:
1509           case LeaveNotify:      FROB(xcrossing, window);         break;
1510           case FocusIn:
1511           case FocusOut:         FROB(xfocus, window);            break;
1512           case VisibilityNotify: FROB(xvisibility, window);       break;
1513           case CreateNotify: FROB(xcreatewindow, window);         break;
1514           default:
1515             w = x_event->xany.window;
1516             *x_event_copy = *x_event;
1517             break;
1518           }
1519 #undef FROB
1520         frame = x_any_window_to_frame (d, w);
1521
1522         if (!frame)
1523           return 0;
1524
1525         emacs_event->event_type = magic_event;
1526         XSETFRAME (emacs_event->channel, frame);
1527
1528         break;
1529       }
1530     }
1531   return 1;
1532 }
1533
1534
1535 \f
1536 /************************************************************************/
1537 /*                           magic-event handling                       */
1538 /************************************************************************/
1539
1540 static void
1541 handle_focus_event_1 (struct frame *f, int in_p)
1542 {
1543   handle_focus_event_2 (XtWindow (FRAME_X_TEXT_WIDGET (f)), f, in_p);
1544 }
1545
1546 static void
1547 handle_focus_event_2 (Window win, struct frame *f, int in_p)
1548 {
1549   /* Although this treats focus differently for all widgets (including
1550      the frame) it seems to work ok. */
1551   Widget needs_it = XtWindowToWidget (FRAME_X_DISPLAY (f), win);
1552
1553 #if XtSpecificationRelease > 5
1554   widget_with_focus = XtGetKeyboardFocusWidget (FRAME_X_TEXT_WIDGET (f));
1555 #endif
1556 #ifdef HAVE_XIM
1557   XIM_focus_event (f, in_p);
1558 #endif /* HAVE_XIM */
1559
1560   /* On focus change, clear all memory of sticky modifiers
1561      to avoid non-intuitive behavior. */
1562   clear_sticky_modifiers (XDEVICE (FRAME_DEVICE (f)));
1563
1564   /* We don't want to handle the focus change now, because we might
1565      be in an accept-process-output, sleep-for, or sit-for.  So
1566      we enqueue it.
1567
1568      Actually, we half handle it: we handle it as far as changing the
1569      box cursor for redisplay, but we don't call any hooks or do any
1570      select-frame stuff until after the sit-for.
1571
1572      Unfortunately native widgets break the model because they grab
1573      the keyboard focus and nothing sets it back again. I cannot find
1574      any reasonable way to do this elsewhere so we assert here that
1575      the keyboard focus is on the emacs text widget. Menus and dialogs
1576      do this in their selection callback, but we don't want that since
1577      a button having focus is legitimate. An edit field having focus
1578      is mandatory. Weirdly you get a FocusOut event when you click in
1579      a widget-glyph but you don't get a corresponding FocusIn when you
1580      click in the frame. Why is this?  */
1581   if (in_p
1582 #if XtSpecificationRelease > 5
1583       && needs_it != widget_with_focus
1584 #endif
1585       )
1586     {
1587       lw_set_keyboard_focus (FRAME_X_SHELL_WIDGET (f), needs_it);
1588     }
1589
1590   /* If we are focusing on a native widget then record and exit. */
1591   if (needs_it != FRAME_X_TEXT_WIDGET (f)) {
1592     widget_with_focus = needs_it;
1593     return;
1594   }
1595
1596   /* We have the focus now. See comment in
1597      emacs_Xt_handle_widget_losing_focus (). */
1598   if (in_p)
1599     widget_with_focus = NULL;
1600
1601   /* do the generic event-stream stuff. */
1602   {
1603     Lisp_Object frm;
1604     Lisp_Object conser;
1605     struct gcpro gcpro1;
1606
1607     XSETFRAME (frm, f);
1608     conser = Fcons (frm, Fcons (FRAME_DEVICE (f), in_p ? Qt : Qnil));
1609     GCPRO1 (conser);
1610     emacs_handle_focus_change_preliminary (conser);
1611     enqueue_magic_eval_event (emacs_handle_focus_change_final,
1612                               conser);
1613     UNGCPRO;
1614   }
1615 }
1616
1617 /* Create a synthetic X focus event. */
1618 void
1619 enqueue_focus_event (Widget wants_it, Lisp_Object frame, int in_p)
1620 {
1621   Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
1622   Lisp_Event *ev          = XEVENT (emacs_event);
1623   XEvent *x_event = &ev->event.magic.underlying_x_event;
1624
1625   x_event->type = in_p ? FocusIn : FocusOut;
1626   x_event->xfocus.window = XtWindow (wants_it);
1627
1628   ev->channel               = frame;
1629   ev->event_type            = magic_event;
1630
1631   enqueue_Xt_dispatch_event (emacs_event);
1632 }
1633
1634 /* The idea here is that when a widget glyph gets unmapped we don't
1635    want the focus to stay with it if it has focus - because it may
1636    well just get deleted next and then we have lost the focus until the
1637    user does something. So handle_focus_event_1 records the widget
1638    with keyboard focus when FocusOut is processed, and then, when a
1639    widget gets unmapped, it calls this function to restore focus if
1640    appropriate. */
1641 void emacs_Xt_handle_widget_losing_focus (struct frame* f, Widget losing_widget);
1642 void
1643 emacs_Xt_handle_widget_losing_focus (struct frame* f, Widget losing_widget)
1644 {
1645   if (losing_widget == widget_with_focus)
1646     {
1647       handle_focus_event_1 (f, 1);
1648     }
1649 }
1650
1651 /* This is called from the external-widget code */
1652
1653 void emacs_Xt_handle_focus_event (XEvent *event);
1654 void
1655 emacs_Xt_handle_focus_event (XEvent *event)
1656 {
1657   struct device *d = get_device_from_display (event->xany.display);
1658   struct frame *f;
1659
1660   if (DEVICE_X_BEING_DELETED (d))
1661     return;
1662
1663   /*
1664    * It's curious that we're using x_any_window_to_frame() instead
1665    * of x_window_to_frame().  I don't know what the impact of this is.
1666    */
1667   f = x_any_window_to_frame (d, event->xfocus.window);
1668   if (!f)
1669     /* focus events are sometimes generated just before
1670        a frame is destroyed. */
1671     return;
1672   handle_focus_event_1 (f, event->type == FocusIn);
1673 }
1674
1675 /* both MapNotify and VisibilityNotify can cause this
1676    JV is_visible has the same semantics as f->visible*/
1677 static void
1678 change_frame_visibility (struct frame *f, int is_visible)
1679 {
1680   Lisp_Object frame;
1681
1682   XSETFRAME (frame, f);
1683
1684   if (!FRAME_VISIBLE_P (f) && is_visible)
1685     {
1686       FRAME_VISIBLE_P (f) = is_visible;
1687       /* This improves the double flicker when uniconifying a frame
1688          some.  A lot of it is not showing a buffer which has changed
1689          while the frame was iconified.  To fix it further requires
1690          the good 'ol double redisplay structure. */
1691       MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
1692       va_run_hook_with_args (Qmap_frame_hook, 1, frame);
1693     }
1694   else if (FRAME_VISIBLE_P (f) && !is_visible)
1695     {
1696       FRAME_VISIBLE_P (f) = 0;
1697       va_run_hook_with_args (Qunmap_frame_hook, 1, frame);
1698     }
1699   else if (FRAME_VISIBLE_P (f) * is_visible < 0)
1700     {
1701       FRAME_VISIBLE_P(f) = - FRAME_VISIBLE_P(f);
1702       if (FRAME_REPAINT_P(f))
1703               MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
1704       va_run_hook_with_args (Qmap_frame_hook, 1, frame);
1705     }
1706 }
1707
1708 static void
1709 handle_map_event (struct frame *f, XEvent *event)
1710 {
1711   Lisp_Object frame;
1712
1713   XSETFRAME (frame, f);
1714   if (event->type == MapNotify)
1715     {
1716       XWindowAttributes xwa;
1717
1718       /* Bleagh!!!!!!  Apparently some window managers (e.g. MWM)
1719          send synthetic MapNotify events when a window is first
1720          created, EVEN IF IT'S CREATED ICONIFIED OR INVISIBLE.
1721          Or something like that.  We initially tried a different
1722          solution below, but that ran into a different window-
1723          manager bug.
1724
1725          It seems that the only reliable way is to treat a
1726          MapNotify event as a "hint" that the window might or
1727          might not be visible, and check explicitly. */
1728
1729       XGetWindowAttributes (event->xany.display, event->xmap.window,
1730                             &xwa);
1731       if (xwa.map_state != IsViewable)
1732         {
1733           /* Calling Fframe_iconified_p is the only way we have to
1734              correctly update FRAME_ICONIFIED_P */
1735           Fframe_iconified_p (frame);
1736           return;
1737         }
1738
1739       FRAME_X_TOTALLY_VISIBLE_P (f) = 1;
1740 #if 0
1741       /* Bleagh again!!!!  We initially tried the following hack
1742          around the MWM problem, but it turns out that TWM
1743          has a race condition when you un-iconify, where it maps
1744          the window and then tells the server that the window
1745          is un-iconified.  Usually, XEmacs wakes up between
1746          those two occurrences, and thus thinks that un-iconified
1747          windows are still iconified.
1748
1749          Ah, the joys of X. */
1750
1751       /* By Emacs definition, a frame that is iconified is not
1752          visible.  Marking a frame as visible will automatically cause
1753          frame-iconified-p to return nil, regardless of whether the
1754          frame is actually iconified.  Therefore, we have to ignore
1755          MapNotify events on iconified frames. (It's not obvious
1756          to me why these are being sent, but it happens at startup
1757          with frames that are initially iconified; perhaps they are
1758          synthetic MapNotify events coming from the window manager.)
1759          Note that `frame-iconified-p' queries the server
1760          to determine whether the frame is currently iconified,
1761          rather than consulting some internal (and likely
1762          inaccurate) state flag.  Therefore, ignoring the MapNotify
1763          is correct. */
1764       if (!FRAME_VISIBLE_P (f) && NILP (Fframe_iconified_p (frame)))
1765 #endif /* 0 */
1766         change_frame_visibility (f, 1);
1767     }
1768   else
1769     {
1770       FRAME_X_TOTALLY_VISIBLE_P (f) = 0;
1771       change_frame_visibility (f, 0);
1772       /* Calling Fframe_iconified_p is the only way we have to
1773          correctly update FRAME_ICONIFIED_P */
1774       Fframe_iconified_p (frame);
1775     }
1776 }
1777
1778 static void
1779 handle_client_message (struct frame *f, XEvent *event)
1780 {
1781   struct device *d = XDEVICE (FRAME_DEVICE (f));
1782   Lisp_Object frame;
1783
1784   XSETFRAME (frame, f);
1785
1786   if (event->xclient.message_type == DEVICE_XATOM_WM_PROTOCOLS (d) &&
1787       (Atom) (event->xclient.data.l[0]) == DEVICE_XATOM_WM_DELETE_WINDOW (d))
1788     {
1789       /* WM_DELETE_WINDOW is a misc-user event, but other ClientMessages,
1790          such as WM_TAKE_FOCUS, are eval events.  That's because delete-window
1791          was probably executed with a mouse click, while the others could
1792          have been sent as a result of mouse motion or some other implicit
1793          action.  (Call this a "heuristic"...)  The reason for caring about
1794          this is so that clicking on the close-box will make emacs prompt
1795          using a dialog box instead of the minibuffer if there are unsaved
1796          buffers.
1797          */
1798       enqueue_misc_user_event (frame, Qeval,
1799                                list3 (Qdelete_frame, frame, Qt));
1800     }
1801   else if (event->xclient.message_type == DEVICE_XATOM_WM_PROTOCOLS (d) &&
1802            (Atom) event->xclient.data.l[0] == DEVICE_XATOM_WM_TAKE_FOCUS (d))
1803     {
1804       handle_focus_event_1 (f, 1);
1805 #if 0
1806       /* If there is a dialog box up, focus on it.
1807
1808          #### Actually, we're raising it too, which is wrong.  We should
1809          #### just focus on it, but lwlib doesn't currently give us an
1810          #### easy way to do that.  This should be fixed.
1811          */
1812       unsigned long take_focus_timestamp = event->xclient.data.l[1];
1813       Widget widget = lw_raise_all_pop_up_widgets ();
1814       if (widget)
1815         {
1816           /* kludge: raise_all returns bottommost widget, but we really
1817              want the topmost.  So just raise it for now. */
1818           XMapRaised (XtDisplay (widget), XtWindow (widget));
1819           /* Grab the focus with the timestamp of the TAKE_FOCUS. */
1820           XSetInputFocus (XtDisplay (widget), XtWindow (widget),
1821                           RevertToParent, take_focus_timestamp);
1822         }
1823 #endif
1824     }
1825 }
1826
1827 /* #### I'm struggling to understand how the X event loop really works.
1828    Here is the problem:
1829
1830    When widgets get mapped / changed etc the actual display updates
1831    are done asynchronously via X events being processed - this
1832    normally happens when XtAppProcessEvent() gets called. However, if
1833    we are executing lisp code or even doing redisplay we won't
1834    necessarily process X events for a very long time. This has the
1835    effect of widgets only getting updated when XEmacs only goes into
1836    idle, or some other event causes processing of the X event queue.
1837
1838    XtAppProcessEvent can get called from the following places:
1839
1840      emacs_Xt_next_event () - this is normal event processing, almost
1841      any non-X event will take precedence and this means that we
1842      cannot rely on it to do the right thing at the right time for
1843      widget display.
1844
1845      drain_X_queue () - this happens when SIGIO gets tripped,
1846      processing the event queue allows C-g to be checked for. It gets
1847      called from emacs_Xt_event_pending_p ().
1848
1849    In order to solve this I have tried introducing a list primitive -
1850    dispatch-non-command-events - which forces processing of X events
1851    related to display. Unfortunately this has a number of problems,
1852    one is that it is possible for event_stream_event_pending_p to
1853    block for ever if there isn't actually an event. I guess this can
1854    happen if we drop the synthetic event for reason. It also relies on
1855    SIGIO processing which makes things rather fragile.
1856
1857    People have seen behaviour whereby XEmacs blocks until you move the
1858    mouse. This seems to indicate that dispatch-non-command-events is
1859    blocking. It may be that in a SIGIO world forcing SIGIO processing
1860    does the wrong thing.
1861 */
1862 static void
1863 emacs_Xt_force_event_pending (struct frame* f)
1864 {
1865   XEvent event;
1866
1867   Display* dpy = DEVICE_X_DISPLAY (XDEVICE (FRAME_DEVICE  (f)));
1868   event.xclient.type            = ClientMessage;
1869   event.xclient.display         = dpy;
1870   event.xclient.message_type    = XInternAtom (dpy, "BumpQueue", False);
1871   event.xclient.format          = 32;
1872   event.xclient.window          = 0;
1873
1874   /* Send the drop message */
1875   XSendEvent(dpy, XtWindow (FRAME_X_SHELL_WIDGET (f)),
1876              True, NoEventMask, &event);
1877   /* We rely on SIGIO and friends to realise we have generated an
1878      event. */
1879 }
1880
1881 static void
1882 emacs_Xt_handle_magic_event (Lisp_Event *emacs_event)
1883 {
1884   /* This function can GC */
1885   XEvent *event = &emacs_event->event.magic.underlying_x_event;
1886   struct frame *f = XFRAME (EVENT_CHANNEL (emacs_event));
1887
1888   if (!FRAME_LIVE_P (f) || DEVICE_X_BEING_DELETED (XDEVICE (FRAME_DEVICE (f))))
1889     return;
1890
1891   switch (event->type)
1892     {
1893     case SelectionRequest:
1894       x_handle_selection_request (&event->xselectionrequest);
1895       break;
1896
1897     case SelectionClear:
1898       x_handle_selection_clear (&event->xselectionclear);
1899       break;
1900
1901     case SelectionNotify:
1902       x_handle_selection_notify (&event->xselection);
1903       break;
1904
1905     case PropertyNotify:
1906       x_handle_property_notify (&event->xproperty);
1907       break;
1908
1909     case Expose:
1910       if (!check_for_ignored_expose (f, event->xexpose.x, event->xexpose.y,
1911                                      event->xexpose.width, event->xexpose.height)
1912           &&
1913           !find_matching_subwindow (f, event->xexpose.x, event->xexpose.y,
1914           event->xexpose.width, event->xexpose.height))
1915         x_redraw_exposed_area (f, event->xexpose.x, event->xexpose.y,
1916                                event->xexpose.width, event->xexpose.height);
1917       break;
1918
1919     case GraphicsExpose: /* This occurs when an XCopyArea's source area was
1920                             obscured or not available. */
1921       x_redraw_exposed_area (f, event->xexpose.x, event->xexpose.y,
1922                              event->xexpose.width, event->xexpose.height);
1923       break;
1924
1925     case MapNotify:
1926     case UnmapNotify:
1927       handle_map_event (f, event);
1928       break;
1929
1930     case EnterNotify:
1931       if (event->xcrossing.detail != NotifyInferior)
1932         {
1933           Lisp_Object frame;
1934
1935           XSETFRAME (frame, f);
1936           /* FRAME_X_MOUSE_P (f) = 1; */
1937           va_run_hook_with_args (Qmouse_enter_frame_hook, 1, frame);
1938         }
1939       break;
1940
1941     case LeaveNotify:
1942       if (event->xcrossing.detail != NotifyInferior)
1943         {
1944           Lisp_Object frame;
1945
1946           XSETFRAME (frame, f);
1947           /* FRAME_X_MOUSE_P (f) = 0; */
1948           va_run_hook_with_args (Qmouse_leave_frame_hook, 1, frame);
1949         }
1950       break;
1951
1952     case FocusIn:
1953     case FocusOut:
1954
1955 #ifdef EXTERNAL_WIDGET
1956       /* External widget lossage: Ben said:
1957          YUCK.  The only way to make focus changes work properly is to
1958          completely ignore all FocusIn/FocusOut events and depend only
1959          on notifications from the ExternalClient widget. */
1960       if (FRAME_X_EXTERNAL_WINDOW_P (f))
1961         break;
1962 #endif
1963       handle_focus_event_2 (event->xfocus.window, f, event->type == FocusIn);
1964       break;
1965
1966     case ClientMessage:
1967       handle_client_message (f, event);
1968       break;
1969
1970     case VisibilityNotify: /* window visibility has changed */
1971       if (event->xvisibility.window == XtWindow (FRAME_X_SHELL_WIDGET (f)))
1972         {
1973           FRAME_X_TOTALLY_VISIBLE_P (f) =
1974             (event->xvisibility.state == VisibilityUnobscured);
1975           /* Note that the fvwm pager only sends VisibilityNotify when
1976              changing pages. Is this all we need to do ? JV */
1977           /* Nope.  We must at least trigger a redisplay here.
1978              Since this case seems similar to MapNotify, I've
1979              factored out some code to change_frame_visibility().
1980              This triggers the necessary redisplay and runs
1981              (un)map-frame-hook.  - dkindred@cs.cmu.edu */
1982           /* Changed it again to support the tristate visibility flag */
1983           change_frame_visibility (f, (event->xvisibility.state
1984                                        != VisibilityFullyObscured) ? 1 : -1);
1985         }
1986       break;
1987
1988     case ConfigureNotify:
1989 #ifdef HAVE_XIM
1990       XIM_SetGeometry (f);
1991 #endif
1992       break;
1993
1994     case CreateNotify:
1995       break;
1996
1997     default:
1998       break;
1999     }
2000 }
2001
2002 \f
2003 /************************************************************************/
2004 /*                              timeout events                          */
2005 /************************************************************************/
2006
2007 static int timeout_id_tick;
2008
2009 /* Xt interval id's might not fit into an int (they're pointers, as it
2010    happens), so we need to provide a conversion list. */
2011
2012 /* pending_timeouts is a set (unordered), implemented as a stack.
2013    completed_timeouts* is a queue. */
2014 static struct Xt_timeout
2015 {
2016   int id;
2017   XtIntervalId interval_id;
2018   struct Xt_timeout *next;
2019 } *pending_timeouts, *completed_timeouts_head, *completed_timeouts_tail;
2020
2021 static struct Xt_timeout_blocktype
2022 {
2023   Blocktype_declare (struct Xt_timeout);
2024 } *the_Xt_timeout_blocktype;
2025
2026 /* called by XtAppNextEvent() */
2027 static void
2028 Xt_timeout_callback (XtPointer closure, XtIntervalId *id)
2029 {
2030   struct Xt_timeout *timeout = (struct Xt_timeout *) closure;
2031   struct Xt_timeout *t2 = pending_timeouts;
2032   /* Remove this one from the set of pending timeouts */
2033   if (t2 == timeout)
2034     pending_timeouts = pending_timeouts->next;
2035   else
2036     {
2037       while (t2->next && t2->next != timeout) t2 = t2->next;
2038       assert (t2->next);
2039       t2->next = t2->next->next;
2040     }
2041   /* Add this one to the queue of completed timeouts */
2042   timeout->next = NULL;
2043   if (completed_timeouts_head)
2044     completed_timeouts_tail->next = timeout;
2045   else
2046     completed_timeouts_head = timeout;
2047   completed_timeouts_tail = timeout;
2048 }
2049
2050 static int
2051 emacs_Xt_add_timeout (EMACS_TIME thyme)
2052 {
2053   struct Xt_timeout *timeout = Blocktype_alloc (the_Xt_timeout_blocktype);
2054   EMACS_TIME current_time;
2055   int milliseconds;
2056
2057   timeout->id = timeout_id_tick++;
2058   timeout->next = pending_timeouts;
2059   pending_timeouts = timeout;
2060   EMACS_GET_TIME (current_time);
2061   EMACS_SUB_TIME (thyme, thyme, current_time);
2062   milliseconds = EMACS_SECS (thyme) * 1000 +
2063     EMACS_USECS (thyme) / 1000;
2064   if (milliseconds < 1)
2065     milliseconds = 1;
2066   timeout->interval_id = XtAppAddTimeOut (Xt_app_con, milliseconds,
2067                                           Xt_timeout_callback,
2068                                           (XtPointer) timeout);
2069   return timeout->id;
2070 }
2071
2072 static void
2073 emacs_Xt_remove_timeout (int id)
2074 {
2075   struct Xt_timeout *timeout, *t2;
2076
2077   timeout = NULL;
2078
2079   /* Find the timeout on the list of pending ones, if it's still there. */
2080   if (pending_timeouts)
2081     {
2082       if (id == pending_timeouts->id)
2083         {
2084           timeout = pending_timeouts;
2085           pending_timeouts = pending_timeouts->next;
2086         }
2087       else
2088         {
2089           t2 = pending_timeouts;
2090           while (t2->next && t2->next->id != id) t2 = t2->next;
2091           if ( t2->next)   /*found it */
2092             {
2093               timeout = t2->next;
2094               t2->next = t2->next->next;
2095             }
2096         }
2097       /* if it was pending, we have removed it from the list */
2098       if (timeout)
2099         XtRemoveTimeOut (timeout->interval_id);
2100     }
2101
2102   /* It could be that Xt_timeout_callback was already called but we didn't
2103      convert into an Emacs event yet */
2104   if (!timeout && completed_timeouts_head)
2105     {
2106       /* Thank God for code duplication! */
2107       if (id == completed_timeouts_head->id)
2108         {
2109           timeout = completed_timeouts_head;
2110           completed_timeouts_head = completed_timeouts_head->next;
2111           /* this may not be necessary? */
2112           if (!completed_timeouts_head) completed_timeouts_tail = NULL;
2113         }
2114       else
2115         {
2116           t2 = completed_timeouts_head;
2117           while (t2->next && t2->next->id != id) t2 = t2->next;
2118           if (t2->next)   /* found it */
2119             {
2120               timeout = t2->next;
2121               t2->next = t2->next->next;
2122               if (!t2->next) completed_timeouts_tail = t2;
2123             }
2124         }
2125     }
2126
2127   /* If we found the thing on the lists of timeouts,
2128      and removed it, deallocate
2129   */
2130   if (timeout)
2131     Blocktype_free (the_Xt_timeout_blocktype, timeout);
2132 }
2133
2134 static void
2135 Xt_timeout_to_emacs_event (Lisp_Event *emacs_event)
2136 {
2137   struct Xt_timeout *timeout = completed_timeouts_head;
2138   assert (timeout);
2139   completed_timeouts_head = completed_timeouts_head->next;
2140   /* probably unnecessary */
2141   if (!completed_timeouts_head) completed_timeouts_tail = NULL;
2142   emacs_event->event_type = timeout_event;
2143   /* timeout events have nil as channel */
2144   emacs_event->timestamp  = 0; /* #### wrong!! */
2145   emacs_event->event.timeout.interval_id = timeout->id;
2146   emacs_event->event.timeout.function = Qnil;
2147   emacs_event->event.timeout.object = Qnil;
2148   Blocktype_free (the_Xt_timeout_blocktype, timeout);
2149 }
2150
2151 \f
2152 /************************************************************************/
2153 /*                      process and tty events                          */
2154 /************************************************************************/
2155
2156 struct what_is_ready_closure
2157 {
2158   int fd;
2159   Lisp_Object what;
2160   XtInputId id;
2161 };
2162
2163 static Lisp_Object *filedesc_with_input;
2164 static struct what_is_ready_closure **filedesc_to_what_closure;
2165
2166 static void
2167 init_what_input_once (void)
2168 {
2169   int i;
2170
2171   filedesc_with_input = xnew_array (Lisp_Object, MAXDESC);
2172   filedesc_to_what_closure =
2173     xnew_array (struct what_is_ready_closure *, MAXDESC);
2174
2175   for (i = 0; i < MAXDESC; i++)
2176     {
2177       filedesc_to_what_closure[i] = 0;
2178       filedesc_with_input[i] = Qnil;
2179     }
2180
2181   process_events_occurred = 0;
2182   tty_events_occurred = 0;
2183 }
2184
2185 static void
2186 mark_what_as_being_ready (struct what_is_ready_closure *closure)
2187 {
2188   if (NILP (filedesc_with_input[closure->fd]))
2189     {
2190       SELECT_TYPE temp_mask;
2191       FD_ZERO (&temp_mask);
2192       FD_SET (closure->fd, &temp_mask);
2193       /* Check to make sure there's *really* input available.
2194          Sometimes things seem to get confused and this gets called
2195          for the tty fd when there's really only input available
2196          on some process's fd.  (It will subsequently get called
2197          for that process's fd, so returning without setting any
2198          flags will take care of it.)  To see the problem, uncomment
2199          the stderr_out below, turn NORMAL_QUIT_CHECK_TIMEOUT_MSECS
2200          down to 25, do sh -c 'xemacs -nw -q -f shell 2>/tmp/log'
2201          and press return repeatedly.  (Seen under AIX & Linux.)
2202          -dkindred@cs.cmu.edu */
2203       if (!poll_fds_for_input (temp_mask))
2204         {
2205 #if 0
2206           stderr_out ("mark_what_as_being_ready: no input available (fd=%d)\n",
2207                       closure->fd);
2208 #endif
2209           return;
2210         }
2211       filedesc_with_input[closure->fd] = closure->what;
2212       if (PROCESSP (closure->what))
2213       /* Don't increment this if the current process is already marked
2214        *  as having input. */
2215         process_events_occurred++;
2216       else
2217         tty_events_occurred++;
2218     }
2219 }
2220
2221 static void
2222 Xt_what_callback (void *closure, int *source, XtInputId *id)
2223 {
2224   /* If closure is 0, then we got a fake event from a signal handler.
2225      The only purpose of this is to make XtAppProcessEvent() stop
2226      blocking. */
2227   if (closure)
2228     mark_what_as_being_ready ((struct what_is_ready_closure *) closure);
2229   else
2230     {
2231       fake_event_occurred++;
2232       drain_signal_event_pipe ();
2233     }
2234 }
2235
2236 static void
2237 select_filedesc (int fd, Lisp_Object what)
2238 {
2239   struct what_is_ready_closure *closure;
2240
2241   /* If somebody is trying to select something that's already selected
2242      for, then something went wrong.  The generic routines ought to
2243      detect this and error before here. */
2244   assert (!filedesc_to_what_closure[fd]);
2245
2246   closure = xnew (struct what_is_ready_closure);
2247   closure->fd = fd;
2248   closure->what = what;
2249   closure->id =
2250     XtAppAddInput (Xt_app_con, fd,
2251                    (XtPointer) (XtInputReadMask /* | XtInputExceptMask */),
2252                    Xt_what_callback, closure);
2253   filedesc_to_what_closure[fd] = closure;
2254 }
2255
2256 static void
2257 unselect_filedesc (int fd)
2258 {
2259   struct what_is_ready_closure *closure = filedesc_to_what_closure[fd];
2260
2261   assert (closure);
2262   if (!NILP (filedesc_with_input[fd]))
2263     {
2264       /* We are unselecting this process before we have drained the rest of
2265          the input from it, probably from status_notify() in the command loop.
2266          This can happen like so:
2267
2268           - We are waiting in XtAppNextEvent()
2269           - Process generates output
2270           - Process is marked as being ready
2271           - Process dies, SIGCHLD gets generated before we return (!?)
2272             It could happen I guess.
2273           - sigchld_handler() marks process as dead
2274           - Somehow we end up getting a new KeyPress event on the queue
2275             at the same time (I'm really so sure how that happens but I'm
2276             not sure it can't either so let's assume it can...).
2277           - Key events have priority so we return that instead of the proc.
2278           - Before dispatching the lisp key event we call status_notify()
2279           - Which deselects the process that SIGCHLD marked as dead.
2280
2281          Thus we never remove it from _with_input and turn it into a lisp
2282          event, so we need to do it here.  But this does not mean that we're
2283          throwing away the last block of output - status_notify() has already
2284          taken care of running the proc filter or whatever.
2285        */
2286       filedesc_with_input[fd] = Qnil;
2287       if (PROCESSP (closure->what))
2288         {
2289           assert (process_events_occurred > 0);
2290           process_events_occurred--;
2291         }
2292       else
2293         {
2294           assert (tty_events_occurred > 0);
2295           tty_events_occurred--;
2296         }
2297     }
2298   XtRemoveInput (closure->id);
2299   xfree (closure);
2300   filedesc_to_what_closure[fd] = 0;
2301 }
2302
2303 static void
2304 emacs_Xt_select_process (Lisp_Process *p)
2305 {
2306   Lisp_Object process;
2307   int infd = event_stream_unixoid_select_process (p);
2308
2309   XSETPROCESS (process, p);
2310   select_filedesc (infd, process);
2311 }
2312
2313 static void
2314 emacs_Xt_unselect_process (Lisp_Process *p)
2315 {
2316   int infd = event_stream_unixoid_unselect_process (p);
2317
2318   unselect_filedesc (infd);
2319 }
2320
2321 static USID
2322 emacs_Xt_create_stream_pair (void* inhandle, void* outhandle,
2323                 Lisp_Object* instream, Lisp_Object* outstream, int flags)
2324 {
2325   USID u = event_stream_unixoid_create_stream_pair
2326                 (inhandle, outhandle, instream, outstream, flags);
2327   if (u != USID_ERROR)
2328     u = USID_DONTHASH;
2329   return u;
2330 }
2331
2332 static USID
2333 emacs_Xt_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
2334 {
2335   event_stream_unixoid_delete_stream_pair (instream, outstream);
2336   return USID_DONTHASH;
2337 }
2338
2339 /* This is called from GC when a process object is about to be freed.
2340    If we've still got pointers to it in this file, we're gonna lose hard.
2341  */
2342 void
2343 debug_process_finalization (Lisp_Process *p)
2344 {
2345 #if 0 /* #### */
2346   int i;
2347   Lisp_Object instr, outstr;
2348
2349   get_process_streams (p, &instr, &outstr);
2350   /* if it still has fds, then it hasn't been killed yet. */
2351   assert (NILP(instr));
2352   assert (NILP(outstr));
2353   /* Better not still be in the "with input" table; we know it's got no fds. */
2354   for (i = 0; i < MAXDESC; i++)
2355     {
2356       Lisp_Object process = filedesc_fds_with_input [i];
2357       assert (!PROCESSP (process) || XPROCESS (process) != p);
2358     }
2359 #endif
2360 }
2361
2362 static void
2363 Xt_process_to_emacs_event (Lisp_Event *emacs_event)
2364 {
2365   int i;
2366
2367   assert (process_events_occurred > 0);
2368
2369   for (i = 0; i < MAXDESC; i++)
2370     {
2371       Lisp_Object process = filedesc_with_input[i];
2372       if (PROCESSP (process))
2373         {
2374           filedesc_with_input[i] = Qnil;
2375           process_events_occurred--;
2376           /* process events have nil as channel */
2377           emacs_event->event_type = process_event;
2378           emacs_event->timestamp  = 0; /* #### */
2379           emacs_event->event.process.process = process;
2380           return;
2381         }
2382     }
2383   ABORT ();
2384 }
2385
2386 static void
2387 emacs_Xt_select_console (struct console *con)
2388 {
2389   Lisp_Object console;
2390   int infd;
2391
2392   if (CONSOLE_X_P (con))
2393     return; /* X consoles are automatically selected for when we
2394                initialize them in Xt */
2395   infd = event_stream_unixoid_select_console (con);
2396   XSETCONSOLE (console, con);
2397   select_filedesc (infd, console);
2398 }
2399
2400 static void
2401 emacs_Xt_unselect_console (struct console *con)
2402 {
2403   Lisp_Object console;
2404   int infd;
2405
2406   if (CONSOLE_X_P (con))
2407     return; /* X consoles are automatically selected for when we
2408                initialize them in Xt */
2409   infd = event_stream_unixoid_unselect_console (con);
2410   XSETCONSOLE (console, con);
2411   unselect_filedesc (infd);
2412 }
2413
2414 /* read an event from a tty, if one is available.  Returns non-zero
2415    if an event was available.  Note that when this function is
2416    called, there should always be a tty marked as ready for input.
2417    However, the input condition might actually be EOF, so there
2418    may not really be any input available. (In this case,
2419    read_event_from_tty_or_stream_desc() will arrange for the TTY device
2420    to be deleted.) */
2421
2422 static int
2423 Xt_tty_to_emacs_event (Lisp_Event *emacs_event)
2424 {
2425   int i;
2426
2427   assert (tty_events_occurred > 0);
2428   for (i = 0; i < MAXDESC; i++)
2429     {
2430       Lisp_Object console = filedesc_with_input[i];
2431       if (CONSOLEP (console))
2432         {
2433           assert (tty_events_occurred > 0);
2434           tty_events_occurred--;
2435           filedesc_with_input[i] = Qnil;
2436           if (read_event_from_tty_or_stream_desc
2437               (emacs_event, XCONSOLE (console), i))
2438             return 1;
2439         }
2440     }
2441
2442   return 0;
2443 }
2444
2445 \f
2446 /************************************************************************/
2447 /*              debugging functions to decipher an event                */
2448 /************************************************************************/
2449
2450 #ifdef DEBUG_XEMACS
2451 #include "xintrinsicp.h"        /* only describe_event() needs this */
2452 #include <X11/Xproto.h>         /* only describe_event() needs this */
2453
2454 static void
2455 describe_event_window (Window window, Display *display)
2456 {
2457   struct frame *f;
2458   Widget w;
2459   stderr_out ("   window: 0x%lx", (unsigned long) window);
2460   w = XtWindowToWidget (display, window);
2461   if (w)
2462     stderr_out (" %s", w->core.widget_class->core_class.class_name);
2463   f = x_any_window_to_frame (get_device_from_display (display), window);
2464   if (f)
2465     {
2466       char *buf = alloca_array (char, XSTRING_LENGTH (f->name) + 4);
2467       sprintf (buf, " \"%s\"", XSTRING_DATA (f->name));
2468       write_string_to_stdio_stream (stderr, 0, (Bufbyte *) buf, 0,
2469                                     strlen (buf), Qterminal, 1);
2470     }
2471   stderr_out ("\n");
2472 }
2473
2474 static const char *
2475 XEvent_mode_to_string (int mode)
2476 {
2477   switch (mode)
2478   {
2479   case NotifyNormal:       return "Normal";
2480   case NotifyGrab:         return "Grab";
2481   case NotifyUngrab:       return "Ungrab";
2482   case NotifyWhileGrabbed: return "WhileGrabbed";
2483   default:                 return "???";
2484   }
2485 }
2486
2487 static const char *
2488 XEvent_detail_to_string (int detail)
2489 {
2490   switch (detail)
2491   {
2492   case NotifyAncestor:          return "Ancestor";
2493   case NotifyInferior:          return "Inferior";
2494   case NotifyNonlinear:         return "Nonlinear";
2495   case NotifyNonlinearVirtual:  return "NonlinearVirtual";
2496   case NotifyPointer:           return "Pointer";
2497   case NotifyPointerRoot:       return "PointerRoot";
2498   case NotifyDetailNone:        return "DetailNone";
2499   default:                      return "???";
2500   }
2501 }
2502
2503 static const char *
2504 XEvent_visibility_to_string (int state)
2505 {
2506   switch (state)
2507   {
2508   case VisibilityFullyObscured:     return "FullyObscured";
2509   case VisibilityPartiallyObscured: return "PartiallyObscured";
2510   case VisibilityUnobscured:        return "Unobscured";
2511   default:                          return "???";
2512   }
2513 }
2514
2515 static void
2516 describe_event (XEvent *event)
2517 {
2518   char buf[100];
2519   struct device *d = get_device_from_display (event->xany.display);
2520
2521   sprintf (buf, "%s%s", x_event_name (event->type),
2522            event->xany.send_event ? " (send)" : "");
2523   stderr_out ("%-30s", buf);
2524   switch (event->type)
2525     {
2526     case FocusIn:
2527     case FocusOut:
2528       {
2529         XFocusChangeEvent *ev = &event->xfocus;
2530         describe_event_window (ev->window, ev->display);
2531         stderr_out ("     mode: %s\n",   XEvent_mode_to_string  (ev->mode));
2532         stderr_out ("     detail: %s\n", XEvent_detail_to_string(ev->detail));
2533         break;
2534       }
2535
2536     case KeyPress:
2537       {
2538         XKeyEvent *ev = &event->xkey;
2539         unsigned int state = ev->state;
2540
2541         describe_event_window (ev->window, ev->display);
2542         stderr_out ("   subwindow: %ld\n", ev->subwindow);
2543         stderr_out ("   state: ");
2544         /* Complete list of modifier key masks */
2545         if (state & ShiftMask)   stderr_out ("Shift ");
2546         if (state & LockMask)    stderr_out ("Lock ");
2547         if (state & ControlMask) stderr_out ("Control ");
2548         if (state & Mod1Mask)    stderr_out ("Mod1 ");
2549         if (state & Mod2Mask)    stderr_out ("Mod2 ");
2550         if (state & Mod3Mask)    stderr_out ("Mod3 ");
2551         if (state & Mod4Mask)    stderr_out ("Mod4 ");
2552         if (state & Mod5Mask)    stderr_out ("Mod5 ");
2553
2554         if (! state)
2555           stderr_out ("vanilla\n");
2556         else
2557           stderr_out ("\n");
2558         if (x_key_is_modifier_p (ev->keycode, d))
2559           stderr_out ("   Modifier key");
2560         stderr_out ("   keycode: 0x%x\n", ev->keycode);
2561       }
2562     break;
2563
2564     case Expose:
2565       if (debug_x_events > 1)
2566         {
2567           XExposeEvent *ev = &event->xexpose;
2568           describe_event_window (ev->window, ev->display);
2569           stderr_out ("   region: x=%d y=%d width=%d height=%d\n",
2570                       ev->x, ev->y, ev->width, ev->height);
2571           stderr_out ("    count: %d\n", ev->count);
2572         }
2573       else
2574         stderr_out ("\n");
2575       break;
2576
2577     case GraphicsExpose:
2578       if (debug_x_events > 1)
2579         {
2580           XGraphicsExposeEvent *ev = &event->xgraphicsexpose;
2581           describe_event_window (ev->drawable, ev->display);
2582           stderr_out ("    major: %s\n",
2583                       (ev ->major_code == X_CopyArea  ? "CopyArea" :
2584                        (ev->major_code == X_CopyPlane ? "CopyPlane" : "?")));
2585           stderr_out ("   region: x=%d y=%d width=%d height=%d\n",
2586                       ev->x, ev->y, ev->width, ev->height);
2587           stderr_out ("    count: %d\n", ev->count);
2588         }
2589       else
2590         stderr_out ("\n");
2591       break;
2592
2593     case EnterNotify:
2594     case LeaveNotify:
2595       if (debug_x_events > 1)
2596         {
2597           XCrossingEvent *ev = &event->xcrossing;
2598           describe_event_window (ev->window, ev->display);
2599 #if 0
2600           stderr_out(" subwindow: 0x%x\n", ev->subwindow);
2601           stderr_out("      pos: %d %d\n", ev->x, ev->y);
2602           stderr_out(" root pos: %d %d\n", ev->x_root, ev->y_root);
2603 #endif
2604           stderr_out("    mode: %s\n",   XEvent_mode_to_string(ev->mode));
2605           stderr_out("    detail: %s\n", XEvent_detail_to_string(ev->detail));
2606           stderr_out("    focus: %d\n", ev->focus);
2607 #if 0
2608           stderr_out("    state: 0x%x\n", ev->state);
2609 #endif
2610         }
2611       else
2612         stderr_out("\n");
2613       break;
2614
2615     case ConfigureNotify:
2616       if (debug_x_events > 1)
2617         {
2618           XConfigureEvent *ev = &event->xconfigure;
2619           describe_event_window (ev->window, ev->display);
2620           stderr_out("    above: 0x%lx\n", ev->above);
2621           stderr_out("     size: %d %d %d %d\n", ev->x, ev->y,
2622                      ev->width, ev->height);
2623           stderr_out("  redirect: %d\n", ev->override_redirect);
2624         }
2625       else
2626         stderr_out("\n");
2627       break;
2628
2629     case VisibilityNotify:
2630       if (debug_x_events > 1)
2631         {
2632           XVisibilityEvent *ev = &event->xvisibility;
2633           describe_event_window (ev->window, ev->display);
2634           stderr_out("    state: %s\n", XEvent_visibility_to_string(ev->state));
2635         }
2636       else
2637         stderr_out ("\n");
2638       break;
2639
2640     case ClientMessage:
2641       {
2642         XClientMessageEvent *ev = &event->xclient;
2643         char *name = XGetAtomName (ev->display, ev->message_type);
2644         stderr_out ("%s", name);
2645         if (!strcmp (name, "WM_PROTOCOLS")) {
2646           char *protname = XGetAtomName (ev->display, ev->data.l[0]);
2647           stderr_out ("(%s)", protname);
2648           XFree (protname);
2649         }
2650         XFree (name);
2651         stderr_out ("\n");
2652         break;
2653       }
2654
2655     default:
2656       stderr_out ("\n");
2657       break;
2658     }
2659
2660   fflush (stdout);
2661 }
2662
2663 #endif /* include describe_event definition */
2664
2665 \f
2666 /************************************************************************/
2667 /*                      get the next event from Xt                      */
2668 /************************************************************************/
2669
2670 static Lisp_Object dispatch_event_queue, dispatch_event_queue_tail;
2671
2672 void
2673 enqueue_Xt_dispatch_event (Lisp_Object event)
2674 {
2675   enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail);
2676 }
2677
2678 static Lisp_Object
2679 dequeue_Xt_dispatch_event (void)
2680 {
2681   return dequeue_event (&dispatch_event_queue, &dispatch_event_queue_tail);
2682 }
2683
2684 /* This business exists because menu events "happen" when
2685    menubar_selection_callback() is called from somewhere deep
2686    within XtAppProcessEvent in emacs_Xt_next_event().  The
2687    callback needs to terminate the modal loop in that function
2688    or else it will continue waiting until another event is
2689    received.
2690
2691    Same business applies to scrollbar events. */
2692
2693 void
2694 signal_special_Xt_user_event (Lisp_Object channel, Lisp_Object function,
2695                               Lisp_Object object)
2696 {
2697   Lisp_Object event = Fmake_event (Qnil, Qnil);
2698
2699   XEVENT (event)->event_type = misc_user_event;
2700   XEVENT (event)->channel = channel;
2701   XEVENT (event)->event.eval.function = function;
2702   XEVENT (event)->event.eval.object = object;
2703
2704   enqueue_Xt_dispatch_event (event);
2705 }
2706
2707 static void
2708 emacs_Xt_next_event (Lisp_Event *emacs_event)
2709 {
2710  we_didnt_get_an_event:
2711
2712   while (NILP (dispatch_event_queue) &&
2713          !completed_timeouts_head    &&
2714          !fake_event_occurred        &&
2715          !process_events_occurred    &&
2716          !tty_events_occurred)
2717     {
2718
2719       /* Stupid logic in XtAppProcessEvent() dictates that, if process
2720          events and X events are both available, the process event gets
2721          taken first.  This will cause an infinite loop if we're being
2722          called from Fdiscard_input().
2723        */
2724       if (XtAppPending (Xt_app_con) & XtIMXEvent)
2725         XtAppProcessEvent (Xt_app_con, XtIMXEvent);
2726       else
2727         {
2728           Lisp_Object devcons, concons;
2729
2730           /* We're about to block.  Xt has a bug in it (big surprise,
2731              there) in that it blocks using select() and doesn't
2732              flush the Xlib output buffers (XNextEvent() does this
2733              automatically before blocking).  So it's necessary
2734              for us to do this ourselves.  If we don't do it, then
2735              display output may not be seen until the next time
2736              an X event is received. (This happens esp. with
2737              subprocess output that gets sent to a visible buffer.)
2738
2739              #### The above comment may not have any validity. */
2740
2741           DEVICE_LOOP_NO_BREAK (devcons, concons)
2742             {
2743               struct device *d;
2744               d = XDEVICE (XCAR (devcons));
2745
2746               if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d))
2747                 /* emacs may be exiting */
2748                 XFlush (DEVICE_X_DISPLAY (d));
2749             }
2750           XtAppProcessEvent (Xt_app_con, XtIMAll);
2751         }
2752     }
2753
2754   if (!NILP (dispatch_event_queue))
2755     {
2756       Lisp_Object event, event2;
2757       XSETEVENT (event2, emacs_event);
2758       event = dequeue_Xt_dispatch_event ();
2759       Fcopy_event (event, event2);
2760       Fdeallocate_event (event);
2761     }
2762   else if (tty_events_occurred)
2763     {
2764       if (!Xt_tty_to_emacs_event (emacs_event))
2765         goto we_didnt_get_an_event;
2766     }
2767   else if (completed_timeouts_head)
2768     Xt_timeout_to_emacs_event (emacs_event);
2769   else if (fake_event_occurred)
2770     {
2771       /* A dummy event, so that a cycle of the command loop will occur. */
2772       fake_event_occurred = 0;
2773       /* eval events have nil as channel */
2774       emacs_event->event_type = eval_event;
2775       emacs_event->event.eval.function = Qidentity;
2776       emacs_event->event.eval.object = Qnil;
2777     }
2778   else /* if (process_events_occurred) */
2779     Xt_process_to_emacs_event (emacs_event);
2780
2781   /* No need to call XFilterEvent; Xt does it for us */
2782 }
2783
2784 void
2785 emacs_Xt_event_handler (Widget wid /* unused */,
2786                         XtPointer closure /* unused */,
2787                         XEvent *event,
2788                         Boolean *continue_to_dispatch /* unused */)
2789 {
2790   Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
2791
2792 #ifdef DEBUG_XEMACS
2793   if (debug_x_events > 0)
2794     {
2795       describe_event (event);
2796     }
2797 #endif /* DEBUG_XEMACS */
2798   if (x_event_to_emacs_event (event, XEVENT (emacs_event)))
2799     enqueue_Xt_dispatch_event (emacs_event);
2800   else
2801     Fdeallocate_event (emacs_event);
2802 }
2803
2804 \f
2805 /************************************************************************/
2806 /*                      input pending / C-g checking                    */
2807 /************************************************************************/
2808
2809 static Bool
2810 quit_char_predicate (Display *display, XEvent *event, XPointer data)
2811 {
2812   struct device *d = get_device_from_display (display);
2813   struct x_device *xd = DEVICE_X_DATA (d);
2814   char c, quit_char;
2815   Bool *critical = (Bool *) data;
2816   Lisp_Object keysym;
2817
2818   if (critical)
2819     *critical = False;
2820   if ((event->type != KeyPress) ||
2821       (! x_any_window_to_frame (d, event->xany.window)) ||
2822       (event->xkey.state
2823        & (xd->MetaMask | xd->HyperMask | xd->SuperMask | xd->AltMask)))
2824     return 0;
2825
2826   /* This duplicates some code that exists elsewhere, but it's relatively
2827      fast and doesn't cons. */
2828   keysym = x_to_emacs_keysym (&event->xkey, 1);
2829   if (NILP (keysym)) return 0;
2830   if (CHAR_OR_CHAR_INTP (keysym))
2831     c = XCHAR_OR_CHAR_INT (keysym);
2832   /* Highly doubtful that these are the quit character, but... */
2833   else if (EQ (keysym, QKbackspace))    c = '\b';
2834   else if (EQ (keysym, QKtab))          c = '\t';
2835   else if (EQ (keysym, QKlinefeed))     c = '\n';
2836   else if (EQ (keysym, QKreturn))       c = '\r';
2837   else if (EQ (keysym, QKescape))       c = 27;
2838   else if (EQ (keysym, QKspace))        c = ' ';
2839   else if (EQ (keysym, QKdelete))       c = 127;
2840   else return 0;
2841
2842   if (event->xkey.state & xd->MetaMask)     c |= 0x80;
2843   if ((event->xkey.state & ControlMask) && !(c >= 'A' && c <= 'Z'))
2844     c &= 0x1F;                  /* unshifted control characters */
2845   quit_char = CONSOLE_QUIT_CHAR (XCONSOLE (DEVICE_CONSOLE (d)));
2846   if (c == quit_char)
2847     return True;
2848   /* If we've got Control-Shift-G instead of Control-G, that means
2849      we have a critical_quit.  Caps_Lock is its own modifier, so it
2850      won't cause ^G to act differently than before. */
2851   if (event->xkey.state & ControlMask)  c &= 0x1F;
2852   if (c == quit_char)
2853     {
2854       if (critical) *critical = True;
2855       return True;
2856     }
2857   return False;
2858 }
2859
2860 /* This scans the X input queue for a KeyPress event that matches the
2861    quit character, and sets Vquit_flag.  This is called from the
2862    QUIT macro to determine whether we should quit.
2863
2864    In a SIGIO world, this won't be called unless a SIGIO has happened
2865    since the last time we checked.
2866
2867    In a non-SIGIO world, this is called from emacs_Xt_event_pending_p
2868    (which is called from input_pending_p).
2869  */
2870 static void
2871 x_check_for_quit_char (Display *display)
2872 {
2873   XEvent event;
2874   int queued;
2875   Bool critical_quit = False;
2876   XEventsQueued (display, QueuedAfterReading);
2877   queued = XCheckIfEvent (display, &event,
2878                           quit_char_predicate,
2879                           (char *) &critical_quit);
2880   if (queued)
2881     {
2882       Vquit_flag = (critical_quit ? Qcritical : Qt);
2883       /* don't put the event back onto the queue.  Those functions that
2884          wanted to read a ^G directly have arranged to do this. */
2885     }
2886 }
2887
2888 static void
2889 check_for_tty_quit_char (struct device *d)
2890 {
2891   SELECT_TYPE temp_mask;
2892   int infd = DEVICE_INFD (d);
2893   struct console *con = XCONSOLE (DEVICE_CONSOLE (d));
2894   Emchar quit_char = CONSOLE_QUIT_CHAR (con);
2895
2896   FD_ZERO (&temp_mask);
2897   FD_SET (infd, &temp_mask);
2898
2899   while (1)
2900     {
2901       Lisp_Object event;
2902       Emchar the_char;
2903
2904       if (!poll_fds_for_input (temp_mask))
2905         return;
2906
2907       event = Fmake_event (Qnil, Qnil);
2908       if (!read_event_from_tty_or_stream_desc (XEVENT (event), con, infd))
2909         /* EOF, or something ... */
2910         return;
2911       /* #### bogus.  quit-char should be allowed to be any sort
2912          of event. */
2913       the_char = event_to_character (XEVENT (event), 1, 0, 0);
2914       if (the_char >= 0 && the_char == quit_char)
2915         {
2916           Vquit_flag = Qt;
2917           /* do not queue the C-g.  See above. */
2918           return;
2919         }
2920
2921       /* queue the read event to be read for real later. */
2922       enqueue_Xt_dispatch_event (event);
2923     }
2924 }
2925
2926 static void
2927 emacs_Xt_quit_p (void)
2928 {
2929   Lisp_Object devcons, concons;
2930   CONSOLE_LOOP (concons)
2931     {
2932       struct console *con = XCONSOLE (XCAR (concons));
2933       if (!con->input_enabled)
2934         continue;
2935
2936       CONSOLE_DEVICE_LOOP (devcons, con)
2937         {
2938           struct device *d;
2939           d = XDEVICE (XCAR (devcons));
2940
2941           if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d))
2942             /* emacs may be exiting */
2943             x_check_for_quit_char (DEVICE_X_DISPLAY (d));
2944           else if (DEVICE_TTY_P (d))
2945             check_for_tty_quit_char (d);
2946         }
2947     }
2948 }
2949
2950 static void
2951 drain_X_queue (void)
2952 {
2953   Lisp_Object devcons, concons;
2954   CONSOLE_LOOP (concons)
2955   {
2956     struct console *con = XCONSOLE (XCAR (concons));
2957     if (!con->input_enabled)
2958       continue;
2959
2960     /* sjt sez: Have you tried the loop over devices with XtAppPending(),
2961        not XEventsQueued()?
2962        Ben Sigelman sez: No.
2963        sjt sez: I'm guessing that the reason that your patch "works" is this:
2964
2965        +      struct device* d;
2966        +      Display* display;
2967        +      d = XDEVICE (XCAR (devcons));
2968        +      if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d)) {
2969
2970        Ie, if the device goes down, XEmacs detects that and deletes it.
2971        Then the if() fails (DEVICE_X_DISPLAY(d) is NULL), and we don't go
2972        into the Xlib-of-no-return.  If you know different, I'd like to hear
2973        about it. ;-)
2974
2975        These ideas haven't been tested; the code below works for Ben.
2976     */
2977     CONSOLE_DEVICE_LOOP (devcons, con)
2978     {
2979       struct device* d;
2980       Display* display;
2981       d = XDEVICE (XCAR (devcons));
2982       if (DEVICE_X_P (d) && DEVICE_X_DISPLAY (d)) {
2983         display = DEVICE_X_DISPLAY (d);
2984         while (XEventsQueued (display, QueuedAfterReading))
2985           XtAppProcessEvent (Xt_app_con, XtIMXEvent);
2986       }
2987     }
2988   }
2989   /* This is the old code, before Ben Sigelman's patch. */
2990   /*
2991   while (XtAppPending (Xt_app_con) & XtIMXEvent)
2992     XtAppProcessEvent (Xt_app_con, XtIMXEvent);
2993   */
2994 }
2995
2996 static int
2997 emacs_Xt_event_pending_p (int user_p)
2998 {
2999   Lisp_Object event;
3000   int tick_count_val;
3001
3002   /* If `user_p' is false, then this function returns whether there are any
3003      X, timeout, or fd events pending (that is, whether emacs_Xt_next_event()
3004      would return immediately without blocking).
3005
3006      if `user_p' is true, then this function returns whether there are any
3007      *user generated* events available (that is, whether there are keyboard
3008      or mouse-click events ready to be read).  This also implies that
3009      emacs_Xt_next_event() would not block.
3010
3011      In a non-SIGIO world, this also checks whether the user has typed ^G,
3012      since this is a convenient place to do so.  We don't need to do this
3013      in a SIGIO world, since input causes an interrupt.
3014    */
3015
3016 #if 0
3017   /* I don't think there's any point to this and it will nullify
3018      the speed gains achieved by the sigio_happened checking below.
3019      Its only advantage is that it may possibly make C-g response
3020      a bit faster.  The C-g will be noticed within 0.25 second, anyway,
3021      even without this. */
3022 #ifndef SIGIO
3023   /* First check for C-g if necessary */
3024   emacs_Xt_quit_p ();
3025 #endif
3026 #endif
3027
3028   /* This function used to simply check whether there were any X
3029      events (or if user_p was 1, it iterated over all the pending
3030      X events using XCheckIfEvent(), looking for keystrokes and
3031      button events).  That worked in the old cheesoid event loop,
3032      which didn't go through XtAppDispatchEvent(), but it doesn't
3033      work any more -- X events may not result in anything.  For
3034      example, a button press in a blank part of the menubar appears
3035      as an X event but will not result in any Emacs events (a
3036      button press that activates the menubar results in an Emacs
3037      event through the stop_next_event mechanism).
3038
3039      The only accurate way of determining whether these X events
3040      translate into Emacs events is to go ahead and dispatch them
3041      until there's something on the dispatch queue. */
3042
3043   /* See if there are any user events already on the queue. */
3044   EVENT_CHAIN_LOOP (event, dispatch_event_queue)
3045     if (!user_p || command_event_p (event))
3046       return 1;
3047
3048   /* See if there's any TTY input available.
3049    */
3050   if (poll_fds_for_input (tty_only_mask))
3051     return 1;
3052
3053   if (!user_p)
3054     {
3055       /* If not user_p and there are any timer or file-desc events
3056          pending, we know there will be an event so we're through. */
3057       XtInputMask pending_value;
3058
3059       /* Note that formerly we just checked the value of XtAppPending()
3060          to determine if there was file-desc input.  This doesn't
3061          work any more with the signal_event_pipe; XtAppPending()
3062          will says "yes" in this case but there isn't really any
3063          input.  Another way of fixing this problem is for the
3064          signal_event_pipe to generate actual input in the form
3065          of an identity eval event or something. (#### maybe this
3066          actually happens?) */
3067
3068       if (poll_fds_for_input (process_only_mask))
3069         return 1;
3070
3071       pending_value = XtAppPending (Xt_app_con);
3072
3073       if (pending_value & XtIMTimer)
3074         return 1;
3075     }
3076
3077   /* XtAppPending() can be super-slow, esp. over a network connection.
3078      Quantify results have indicated that in some cases the
3079      call to detect_input_pending() completely dominates the
3080      running time of redisplay().  Fortunately, in a SIGIO world
3081      we can more quickly determine whether there are any X events:
3082      if an event has happened since the last time we checked, then
3083      a SIGIO will have happened.  On a machine with broken SIGIO,
3084      we'll still be in an OK state -- the sigio_happened flag
3085      will get set at least once a second, so we'll be no more than
3086      one second behind reality. (In general it's OK if we
3087      erroneously report no input pending when input is actually
3088      pending() -- preemption is just a bit less efficient, that's
3089      all.  It's bad bad bad if you err the other way -- you've
3090      promised that `next-event' won't block but it actually will,
3091      and some action might get delayed until the next time you
3092      hit a key.)
3093      */
3094
3095   /* quit_check_signal_tick_count is volatile so try to avoid race conditions
3096      by using a temporary variable */
3097   tick_count_val = quit_check_signal_tick_count;
3098   if (last_quit_check_signal_tick_count != tick_count_val
3099 #if !defined (SIGIO) || defined (CYGWIN)
3100       || (XtIMXEvent & XtAppPending (Xt_app_con))
3101 #endif
3102       )
3103     {
3104       last_quit_check_signal_tick_count = tick_count_val;
3105
3106       /* We need to drain the entire queue now -- if we only
3107          drain part of it, we may later on end up with events
3108          actually pending but detect_input_pending() returning
3109          false because there wasn't another SIGIO. */
3110       drain_X_queue ();
3111
3112       EVENT_CHAIN_LOOP (event, dispatch_event_queue)
3113         if (!user_p || command_event_p (event))
3114           return 1;
3115     }
3116
3117   return 0;
3118 }
3119
3120 static int
3121 emacs_Xt_current_event_timestamp (struct console *c)
3122 {
3123   /* semi-yuck. */
3124   Lisp_Object devs = CONSOLE_DEVICE_LIST (c);
3125
3126   if (NILP (devs))
3127     return 0;
3128   else
3129     {
3130       struct device *d = XDEVICE (XCAR (devs));
3131       return DEVICE_X_LAST_SERVER_TIMESTAMP (d);
3132     }
3133 }
3134
3135 \f
3136 /************************************************************************/
3137 /*            replacement for standard string-to-pixel converter        */
3138 /************************************************************************/
3139
3140 /* This was constructed by ripping off the standard string-to-pixel
3141    converter from Converters.c in the Xt source code and modifying
3142    appropriately. */
3143
3144 #if 0
3145
3146 /* This is exported by the Xt library (at least by mine).  If this
3147    isn't the case somewhere, rename this appropriately and remove
3148    the '#if 0'.  Note, however, that I got "unknown structure"
3149    errors when I tried this. */
3150 XtConvertArgRec Const colorConvertArgs[] = {
3151   { XtWidgetBaseOffset, (XtPointer)XtOffsetOf(WidgetRec, core.screen),
3152     sizeof (Screen *) },
3153   { XtWidgetBaseOffset, (XtPointer)XtOffsetOf(WidgetRec, core.colormap),
3154     sizeof (Colormap) }
3155 };
3156
3157 #endif
3158
3159 #define done(type, value)               \
3160   if (toVal->addr != NULL) {             \
3161     if (toVal->size < sizeof(type)) {    \
3162       toVal->size = sizeof(type);        \
3163       return False;                      \
3164     }                                    \
3165     *(type*)(toVal->addr) = (value);     \
3166   } else {                               \
3167     static type static_val;              \
3168     static_val = (value);                \
3169     toVal->addr = (XPointer)&static_val; \
3170   }                                      \
3171   toVal->size = sizeof(type);            \
3172   return True /* Caller supplies `;' */
3173
3174 /* JH: We use this because I think there's a possibility this
3175    is called before the device is properly set up, in which case
3176    I don't want to ABORT. */
3177 extern struct device *get_device_from_display_1 (Display *dpy);
3178
3179 static
3180 Boolean EmacsXtCvtStringToPixel (
3181  Display     *dpy,
3182  XrmValuePtr  args,
3183  Cardinal    *num_args,
3184  XrmValuePtr  fromVal,
3185  XrmValuePtr  toVal,
3186  XtPointer   *closure_ret)
3187 {
3188   String       str = (String)fromVal->addr;
3189   XColor       screenColor;
3190   XColor       exactColor;
3191   Screen       *screen;
3192   Colormap     colormap;
3193   Visual       *visual;
3194   struct device *d;
3195   Status       status;
3196   String       params[1];
3197   Cardinal     num_params  = 1;
3198   XtAppContext the_app_con = XtDisplayToApplicationContext (dpy);
3199
3200   if (*num_args != 2) {
3201     XtAppWarningMsg(the_app_con, "wrongParameters", "cvtStringToPixel",
3202                     "XtToolkitError",
3203                     "String to pixel conversion needs screen and colormap arguments",
3204                     (String *)NULL, (Cardinal *)NULL);
3205     return False;
3206   }
3207
3208   screen   = *((Screen **)  args[0].addr);
3209   colormap = *((Colormap *) args[1].addr);
3210
3211   /* The original uses the private function CompareISOLatin1().
3212      Use XmuCompareISOLatin1() if you want, but I don't think it
3213      makes any difference here. */
3214   if (strcmp(str, XtDefaultBackground) == 0) {
3215     *closure_ret = False;
3216     /* This refers to the display's "*reverseVideo" resource.
3217        These display resources aren't documented anywhere that
3218        I can find, so I'm going to ignore this. */
3219     /* if (pd->rv) done(Pixel, BlackPixelOfScreen(screen)) else */
3220     done(Pixel, WhitePixelOfScreen(screen));
3221   }
3222   if (strcmp(str, XtDefaultForeground) == 0) {
3223     *closure_ret = False;
3224     /* if (pd->rv) done(Pixel, WhitePixelOfScreen(screen)) else */
3225     done(Pixel, BlackPixelOfScreen(screen));
3226   }
3227
3228   /* Originally called XAllocNamedColor() here. */
3229   if ((d = get_device_from_display_1(dpy))) {
3230     visual = DEVICE_X_VISUAL(d);
3231     if (colormap != DEVICE_X_COLORMAP(d)) {
3232       XtAppWarningMsg(the_app_con, "weirdColormap", "cvtStringToPixel",
3233                       "XtToolkitWarning",
3234                       "The colormap passed to cvtStringToPixel doesn't match the one registered to the device.\n",
3235                       NULL, 0);
3236       status = XAllocNamedColor(dpy, colormap, (char*)str, &screenColor, &exactColor);
3237     } else {
3238       status = XParseColor (dpy, colormap, (char*)str, &screenColor);
3239       if (status) {
3240         status = allocate_nearest_color (dpy, colormap, visual, &screenColor);
3241       }
3242     }
3243   } else {
3244     /* We haven't set up this device totally yet, so just punt */
3245     status = XAllocNamedColor(dpy, colormap, (char*)str, &screenColor, &exactColor);
3246   }
3247   if (status == 0) {
3248     params[0] = str;
3249     /* Server returns a specific error code but Xlib discards it.  Ugh */
3250     if (XLookupColor(DisplayOfScreen(screen), colormap, (char*) str,
3251                      &exactColor, &screenColor)) {
3252       XtAppWarningMsg(the_app_con, "noColormap", "cvtStringToPixel",
3253                       "XtToolkitError",
3254                       "Cannot allocate colormap entry for \"%s\"",
3255                       params, &num_params);
3256
3257     } else {
3258       XtAppWarningMsg(the_app_con, "badValue", "cvtStringToPixel",
3259                       "XtToolkitError",
3260                       "Color name \"%s\" is not defined", params, &num_params);
3261     }
3262
3263     *closure_ret = False;
3264     return False;
3265   } else {
3266     *closure_ret = (char*)True;
3267     done(Pixel, screenColor.pixel);
3268   }
3269 }
3270
3271 /* ARGSUSED */
3272 static void EmacsFreePixel (
3273   XtAppContext app,
3274   XrmValuePtr  toVal,
3275   XtPointer    closure,
3276   XrmValuePtr  args,
3277   Cardinal    *num_args)
3278 {
3279   if (*num_args != 2) {
3280     XtAppWarningMsg(app, "wrongParameters","freePixel","XtToolkitError",
3281                     "Freeing a pixel requires screen and colormap arguments",
3282                     (String *)NULL, (Cardinal *)NULL);
3283     return;
3284   }
3285
3286   if (closure) {
3287     Screen   *screen  = *((Screen **)  args[0].addr);
3288     Colormap colormap = *((Colormap *) args[1].addr);
3289     XFreeColors(DisplayOfScreen(screen), colormap,
3290                 (unsigned long*)toVal->addr, 1, (unsigned long)0);
3291   }
3292 }
3293
3294 \f
3295 /************************************************************************/
3296 /*            handle focus changes for native widgets                  */
3297 /************************************************************************/
3298 static void
3299 emacs_Xt_event_widget_focus_in (Widget   w,
3300                                 XEvent   *event,
3301                                 String   *params,
3302                                 Cardinal *num_params)
3303 {
3304   struct frame* f =
3305     x_any_widget_or_parent_to_frame (get_device_from_display (event->xany.display), w);
3306
3307   XtSetKeyboardFocus (FRAME_X_SHELL_WIDGET (f), w);
3308 }
3309
3310 static void
3311 emacs_Xt_event_widget_focus_out (Widget   w,
3312                                  XEvent   *event,
3313                                  String   *params,
3314                                  Cardinal *num_params)
3315 {
3316 }
3317
3318 static XtActionsRec widgetActionsList[] =
3319 {
3320   {"widget-focus-in",   emacs_Xt_event_widget_focus_in  },
3321   {"widget-focus-out",  emacs_Xt_event_widget_focus_out },
3322 };
3323
3324 static void
3325 emacs_Xt_event_add_widget_actions (XtAppContext ctx)
3326 {
3327   XtAppAddActions (ctx, widgetActionsList, 2);
3328 }
3329
3330 \f
3331 /************************************************************************/
3332 /*                            initialization                            */
3333 /************************************************************************/
3334
3335 void
3336 syms_of_event_Xt (void)
3337 {
3338   defsymbol (&Qkey_mapping, "key-mapping");
3339   defsymbol (&Qsans_modifiers, "sans-modifiers");
3340   defsymbol (&Qself_insert_command, "self-insert-command");
3341 }
3342
3343 void
3344 reinit_vars_of_event_Xt (void)
3345 {
3346   Xt_event_stream = xnew (struct event_stream);
3347   Xt_event_stream->event_pending_p       = emacs_Xt_event_pending_p;
3348   Xt_event_stream->force_event_pending   = emacs_Xt_force_event_pending;
3349   Xt_event_stream->next_event_cb         = emacs_Xt_next_event;
3350   Xt_event_stream->handle_magic_event_cb = emacs_Xt_handle_magic_event;
3351   Xt_event_stream->add_timeout_cb        = emacs_Xt_add_timeout;
3352   Xt_event_stream->remove_timeout_cb     = emacs_Xt_remove_timeout;
3353   Xt_event_stream->select_console_cb     = emacs_Xt_select_console;
3354   Xt_event_stream->unselect_console_cb   = emacs_Xt_unselect_console;
3355   Xt_event_stream->select_process_cb     = emacs_Xt_select_process;
3356   Xt_event_stream->unselect_process_cb   = emacs_Xt_unselect_process;
3357   Xt_event_stream->quit_p_cb             = emacs_Xt_quit_p;
3358   Xt_event_stream->create_stream_pair_cb = emacs_Xt_create_stream_pair;
3359   Xt_event_stream->delete_stream_pair_cb = emacs_Xt_delete_stream_pair;
3360   Xt_event_stream->current_event_timestamp_cb =
3361     emacs_Xt_current_event_timestamp;
3362
3363   the_Xt_timeout_blocktype = Blocktype_new (struct Xt_timeout_blocktype);
3364
3365   last_quit_check_signal_tick_count = 0;
3366
3367   /* this function only makes safe calls */
3368   init_what_input_once ();
3369 }
3370
3371 void
3372 vars_of_event_Xt (void)
3373 {
3374   reinit_vars_of_event_Xt ();
3375
3376   dispatch_event_queue = Qnil;
3377   staticpro (&dispatch_event_queue);
3378   dispatch_event_queue_tail = Qnil;
3379   dump_add_root_object (&dispatch_event_queue_tail);
3380
3381   DEFVAR_BOOL ("x-allow-sendevents", &x_allow_sendevents /*
3382 *Non-nil means to allow synthetic events.  Nil means they are ignored.
3383 Beware: allowing emacs to process SendEvents opens a big security hole.
3384 */ );
3385   x_allow_sendevents = 0;
3386
3387 #ifdef DEBUG_XEMACS
3388   DEFVAR_INT ("debug-x-events", &debug_x_events /*
3389 If non-zero, display debug information about X events that XEmacs sees.
3390 Information is displayed on stderr.  Currently defined values are:
3391
3392 1 == non-verbose output
3393 2 == verbose output
3394 */ );
3395   debug_x_events = 0;
3396 #endif
3397 }
3398
3399 /* This mess is a hack that patches the shell widget to treat visual inheritance
3400    the same as colormap and depth inheritance */
3401
3402 static XtInitProc orig_shell_init_proc;
3403
3404 static void ShellVisualPatch(Widget wanted, Widget new,
3405                              ArgList args, Cardinal *num_args)
3406 {
3407   Widget p;
3408   ShellWidget w = (ShellWidget) new;
3409
3410   /* first, call the original setup */
3411   (*orig_shell_init_proc)(wanted, new, args, num_args);
3412
3413   /* if the visual isn't explicitly set, grab it from the nearest shell ancestor */
3414   if (w->shell.visual == CopyFromParent) {
3415     p = XtParent(w);
3416     while (p && !XtIsShell(p)) p = XtParent(p);
3417     if (p) w->shell.visual = ((ShellWidget)p)->shell.visual;
3418   }
3419 }
3420
3421 void
3422 init_event_Xt_late (void) /* called when already initialized */
3423 {
3424   timeout_id_tick = 1;
3425   pending_timeouts = NULL;
3426   completed_timeouts_head = NULL; /* queue is empty */
3427   completed_timeouts_tail = NULL; /* just to be picky */
3428
3429   event_stream = Xt_event_stream;
3430
3431 #if defined(HAVE_XIM) || defined(USE_XFONTSET)
3432   Initialize_Locale();
3433 #endif /* HAVE_XIM || USE_XFONTSET */
3434
3435   XtToolkitInitialize ();
3436   Xt_app_con = XtCreateApplicationContext ();
3437   XtAppSetFallbackResources (Xt_app_con, (String *) x_fallback_resources);
3438
3439   /* In select-x.c */
3440   x_selection_timeout = (XtAppGetSelectionTimeout (Xt_app_con) / 1000);
3441   XSetErrorHandler (x_error_handler);
3442   XSetIOErrorHandler (x_IO_error_handler);
3443
3444 #ifndef WIN32_NATIVE
3445   XtAppAddInput (Xt_app_con, signal_event_pipe[0],
3446                  (XtPointer) (XtInputReadMask /* | XtInputExceptMask */),
3447                  Xt_what_callback, 0);
3448 #endif
3449
3450   XtAppSetTypeConverter (Xt_app_con, XtRString, XtRPixel,
3451                          EmacsXtCvtStringToPixel,
3452                          (XtConvertArgList) colorConvertArgs,
3453                          2, XtCacheByDisplay, EmacsFreePixel);
3454
3455 #ifdef XIM_XLIB
3456   XtAppSetTypeConverter (Xt_app_con, XtRString, XtRXimStyles,
3457                          EmacsXtCvtStringToXIMStyles,
3458                          NULL, 0,
3459                          XtCacheByDisplay, EmacsFreeXIMStyles);
3460 #endif /* XIM_XLIB */
3461   /* Add extra actions to native widgets to handle focus and friends. */
3462   emacs_Xt_event_add_widget_actions (Xt_app_con);
3463
3464   /* insert the visual inheritance patch/hack described above */
3465   orig_shell_init_proc = shellClassRec.core_class.initialize;
3466   shellClassRec.core_class.initialize = ShellVisualPatch;
3467
3468 }