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