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