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