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