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