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