git.chise.org Git - chise/xemacs-chise.git-/blob - src/event-gtk.c

   1 /* The event_stream interface for X11 with gtk, 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    Copyright (C) 2000 William Perry.
   6
   7 This file is part of XEmacs.
   8
   9 XEmacs is free software; you can redistribute it and/or modify it
  10 under the terms of the GNU General Public License as published by the
  11 Free Software Foundation; either version 2, or (at your option) any
  12 later version.
  13
  14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  16 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  17 for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with XEmacs; see the file COPYING.  If not, write to
  21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  22 Boston, MA 02111-1307, USA.  */
  23
  24 /* This file is heavily based upon event-Xt.c */
  25
  26 /* Synched up with: Not in FSF. */
  27
  28 #include <config.h>
  29 #include "lisp.h"
  30
  31 #include "console-gtk.h"
  32
  33 #include "blocktype.h"
  34 #include "buffer.h"
  35 #include "commands.h"
  36 #include "console.h"
  37 #include "console-tty.h"
  38 #include "events.h"
  39 #include "frame.h"
  40 #include "objects-gtk.h"
  41 #include "process.h"
  42 #include "redisplay.h"
  43 #include "elhash.h"
  44
  45 #include "gtk-xemacs.h"
  46
  47 #include "systime.h"
  48 #include "sysproc.h" /* for MAXDESC */
  49
  50 #ifdef FILE_CODING
  51 #include "lstream.h"
  52 #include "file-coding.h"
  53 #endif
  54
  55 #include <gdk/gdkkeysyms.h>
  56
  57 #ifdef HAVE_DRAGNDROP
  58 #include "dragdrop.h"
  59 #endif
  60
  61 #if defined (HAVE_OFFIX_DND)
  62 #include "offix.h"
  63 #endif
  64
  65 #include "events-mod.h"
  66
  67 #include <gdk/gdkx.h>
  68
  69 static struct event_stream *gtk_event_stream;
  70
  71 /* Do we accept events sent by other clients? */
  72 int gtk_allow_sendevents;
  73
  74 static int process_events_occurred;
  75 static int tty_events_occurred;
  76
  77 /* Mask of bits indicating the descriptors that we wait for input on */
  78 extern SELECT_TYPE input_wait_mask, process_only_mask, tty_only_mask;
  79
  80 static Lisp_Object gtk_keysym_to_emacs_keysym ();
  81 void debug_process_finalization (struct Lisp_Process *p);
  82 gboolean emacs_gtk_event_handler (GtkWidget *wid /* unused */,
  83                                   GdkEvent *event,
  84                                   gpointer closure /* unused */);
  85
  86 static int last_quit_check_signal_tick_count;
  87
  88 Lisp_Object Qkey_mapping;
  89 Lisp_Object Qsans_modifiers;
  90
  91 static void enqueue_gtk_dispatch_event (Lisp_Object event);
  92
  93 #define IS_MODIFIER_KEY(keysym)  \
  94   ((((keysym) >= GDK_Shift_L) && ((keysym) <= GDK_Hyper_R)) \
  95    || ((keysym) == GDK_Mode_switch) \
  96    || ((keysym) == GDK_Num_Lock))
  97
  98
  99 \f
 100 /************************************************************************/
 101 /*                           magic-event handling                       */
 102 /************************************************************************/
 103 static void
 104 handle_focus_event_1 (struct frame *f, int in_p)
 105 {
 106   /* We don't want to handle the focus change now, because we might
 107      be in an accept-process-output, sleep-for, or sit-for.  So
 108      we enqueue it.
 109
 110      Actually, we half handle it: we handle it as far as changing the
 111      box cursor for redisplay, but we don't call any hooks or do any
 112      select-frame stuff until after the sit-for.
 113    */
 114
 115     if (in_p)
 116     {
 117         GTK_WIDGET_SET_FLAGS (FRAME_GTK_TEXT_WIDGET (f), GTK_HAS_FOCUS);
 118     }
 119     else
 120     {
 121         GTK_WIDGET_UNSET_FLAGS (FRAME_GTK_TEXT_WIDGET (f), GTK_HAS_FOCUS);
 122     }
 123     gtk_widget_grab_focus (FRAME_GTK_TEXT_WIDGET (f));
 124     gtk_widget_draw_focus (FRAME_GTK_TEXT_WIDGET (f));
 125
 126     {
 127         Lisp_Object frm;
 128         Lisp_Object conser;
 129         struct gcpro gcpro1;
 130
 131         XSETFRAME (frm, f);
 132         conser = Fcons (frm, Fcons (FRAME_DEVICE (f), in_p ? Qt : Qnil));
 133         GCPRO1 (conser);
 134
 135         emacs_handle_focus_change_preliminary (conser);
 136         enqueue_magic_eval_event (emacs_handle_focus_change_final,
 137                                   conser);
 138         UNGCPRO;
 139     }
 140 }
 141
 142 /* both GDK_MAP and GDK_VISIBILITY_NOTIFY can cause this
 143    JV is_visible has the same semantics as f->visible*/
 144 static void
 145 change_frame_visibility (struct frame *f, int is_visible)
 146 {
 147   Lisp_Object frame;
 148
 149   XSETFRAME (frame, f);
 150
 151   if (!FRAME_VISIBLE_P (f) && is_visible)
 152     {
 153       FRAME_VISIBLE_P (f) = is_visible;
 154       /* This improves the double flicker when uniconifying a frame
 155          some.  A lot of it is not showing a buffer which has changed
 156          while the frame was iconified.  To fix it further requires
 157          the good 'ol double redisplay structure. */
 158       MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
 159       va_run_hook_with_args (Qmap_frame_hook, 1, frame);
 160     }
 161   else if (FRAME_VISIBLE_P (f) && !is_visible)
 162     {
 163       FRAME_VISIBLE_P (f) = 0;
 164       va_run_hook_with_args (Qunmap_frame_hook, 1, frame);
 165     }
 166   else if (FRAME_VISIBLE_P (f) * is_visible < 0)
 167     {
 168       FRAME_VISIBLE_P(f) = - FRAME_VISIBLE_P(f);
 169       if (FRAME_REPAINT_P (f))
 170               MARK_FRAME_WINDOWS_STRUCTURE_CHANGED (f);
 171       va_run_hook_with_args (Qmap_frame_hook, 1, frame);
 172     }
 173 }
 174
 175 static void
 176 handle_map_event (struct frame *f, GdkEvent *event)
 177 {
 178   Lisp_Object frame;
 179
 180   XSETFRAME (frame, f);
 181   if (event->any.type == GDK_MAP)
 182     {
 183       FRAME_GTK_TOTALLY_VISIBLE_P (f) = 1;
 184       change_frame_visibility (f, 1);
 185     }
 186   else
 187     {
 188       FRAME_GTK_TOTALLY_VISIBLE_P (f) = 0;
 189       change_frame_visibility (f, 0);
 190       /* Calling Fframe_iconified_p is the only way we have to
 191          correctly update FRAME_ICONIFIED_P */
 192       Fframe_iconified_p (frame);
 193     }
 194 }
 195
 196 static void
 197 handle_client_message (struct frame *f, GdkEvent *event)
 198 {
 199   Lisp_Object frame;
 200
 201   XSETFRAME (frame, f);
 202
 203   /* The event-Xt code used to handle WM_DELETE_WINDOW here, but we
 204      handle that directly in frame-gtk.c */
 205
 206   if (event->client.message_type == gdk_atom_intern ("WM_PROTOCOLS", 0) &&
 207            (GdkAtom) event->client.data.l[0] == gdk_atom_intern ("WM_TAKE_FOCUS", 0))
 208     {
 209       handle_focus_event_1 (f, 1);
 210     }
 211 }
 212
 213 static void
 214 emacs_gtk_handle_magic_event (struct Lisp_Event *emacs_event)
 215 {
 216   /* This function can GC */
 217   GdkEvent *event = &emacs_event->event.magic.underlying_gdk_event;
 218   struct frame *f = XFRAME (EVENT_CHANNEL (emacs_event));
 219
 220   if (!FRAME_LIVE_P (f))
 221     return;
 222
 223   switch (event->any.type)
 224     {
 225     case GDK_CLIENT_EVENT:
 226       handle_client_message (f, event);
 227       break;
 228
 229     case GDK_FOCUS_CHANGE:
 230       handle_focus_event_1 (f, event->focus_change.in);
 231       break;
 232
 233     case GDK_MAP:
 234     case GDK_UNMAP:
 235       handle_map_event (f, event);
 236       break;
 237
 238     case GDK_ENTER_NOTIFY:
 239       if (event->crossing.detail != GDK_NOTIFY_INFERIOR)
 240         {
 241           Lisp_Object frame;
 242
 243           XSETFRAME (frame, f);
 244           /* FRAME_X_MOUSE_P (f) = 1; */
 245           va_run_hook_with_args (Qmouse_enter_frame_hook, 1, frame);
 246         }
 247       break;
 248
 249     case GDK_LEAVE_NOTIFY:
 250       if (event->crossing.detail != GDK_NOTIFY_INFERIOR)
 251         {
 252           Lisp_Object frame;
 253
 254           XSETFRAME (frame, f);
 255           /* FRAME_X_MOUSE_P (f) = 0; */
 256           va_run_hook_with_args (Qmouse_leave_frame_hook, 1, frame);
 257         }
 258       break;
 259
 260     case GDK_VISIBILITY_NOTIFY: /* window visiblity has changed */
 261       if (event->visibility.window == GET_GTK_WIDGET_WINDOW (FRAME_GTK_SHELL_WIDGET (f)))
 262         {
 263           FRAME_GTK_TOTALLY_VISIBLE_P (f) =
 264             (event->visibility.state == GDK_VISIBILITY_UNOBSCURED);
 265           /* Note that the fvwm pager only sends VisibilityNotify when
 266              changing pages. Is this all we need to do ? JV */
 267           /* Nope.  We must at least trigger a redisplay here.
 268              Since this case seems similar to MapNotify, I've
 269              factored out some code to change_frame_visibility().
 270              This triggers the necessary redisplay and runs
 271              (un)map-frame-hook.  - dkindred@cs.cmu.edu */
 272           /* Changed it again to support the tristate visibility flag */
 273           change_frame_visibility (f, (event->visibility.state
 274                                        != GDK_VISIBILITY_FULLY_OBSCURED) ? 1 : -1);
 275         }
 276       break;
 277
 278     default:
 279       break;
 280     }
 281 }
 282
 283 /************************************************************************/
 284 /*                 Gtk to Emacs event conversion                        */
 285 /************************************************************************/
 286
 287 static int
 288 keysym_obeys_caps_lock_p (guint sym, struct device *d)
 289 {
 290   struct gtk_device *gd = DEVICE_GTK_DATA (d);
 291   /* Eeeeevil hack.  Don't apply Caps_Lock to things that aren't alphabetic
 292      characters, where "alphabetic" means something more than simply A-Z.
 293      That is, if Caps_Lock is down, typing ESC doesn't produce Shift-ESC.
 294      But if shift-lock is down, then it does. */
 295   if (gd->lock_interpretation == GDK_Shift_Lock)
 296     return 1;
 297
 298   return
 299     ((sym >= GDK_A)        && (sym <= GDK_Z))          ||
 300     ((sym >= GDK_a)        && (sym <= GDK_z))          ||
 301     ((sym >= GDK_Agrave)   && (sym <= GDK_Odiaeresis)) ||
 302     ((sym >= GDK_agrave)   && (sym <= GDK_odiaeresis)) ||
 303     ((sym >= GDK_Ooblique) && (sym <= GDK_Thorn))      ||
 304     ((sym >= GDK_oslash)   && (sym <= GDK_thorn));
 305 }
 306
 307 static void
 308 set_last_server_timestamp (struct device *d, GdkEvent *gdk_event)
 309 {
 310   guint32 t;
 311   switch (gdk_event->type)
 312     {
 313     case GDK_KEY_PRESS:
 314     case GDK_KEY_RELEASE:      t = gdk_event->key.time; break;
 315     case GDK_BUTTON_PRESS:
 316     case GDK_2BUTTON_PRESS:
 317     case GDK_3BUTTON_PRESS:
 318     case GDK_BUTTON_RELEASE:   t = gdk_event->button.time; break;
 319     case GDK_ENTER_NOTIFY:
 320     case GDK_LEAVE_NOTIFY:     t = gdk_event->crossing.time; break;
 321     case GDK_MOTION_NOTIFY:    t = gdk_event->motion.time; break;
 322     case GDK_PROPERTY_NOTIFY:  t = gdk_event->property.time; break;
 323     case GDK_SELECTION_CLEAR:
 324     case GDK_SELECTION_REQUEST:
 325     case GDK_SELECTION_NOTIFY: t = gdk_event->selection.time; break;
 326     default: return;
 327     }
 328   DEVICE_GTK_LAST_SERVER_TIMESTAMP (d) = t;
 329 }
 330
 331 static Lisp_Object
 332 gtk_keysym_to_emacs_keysym (guint keysym, int simple_p)
 333 {
 334   char *name;
 335   if (keysym >= GDK_exclam && keysym <= GDK_asciitilde)
 336     /* We must assume that the X keysym numbers for the ASCII graphic
 337        characters are the same as their ASCII codes.  */
 338     return make_char (keysym);
 339
 340   switch (keysym)
 341     {
 342       /* These would be handled correctly by the default case, but by
 343          special-casing them here we don't garbage a string or call
 344          intern().  */
 345     case GDK_BackSpace: return QKbackspace;
 346     case GDK_Tab:       return QKtab;
 347     case GDK_Linefeed:  return QKlinefeed;
 348     case GDK_Return:    return QKreturn;
 349     case GDK_Escape:    return QKescape;
 350     case GDK_space:     return QKspace;
 351     case GDK_Delete:    return QKdelete;
 352     case 0:             return Qnil;
 353     default:
 354       if (simple_p) return Qnil;
 355       /* !!#### not Mule-ized */
 356       name = gdk_keyval_name (keysym);
 357       if (!name || !name[0])
 358         /* This happens if there is a mismatch between the Xlib of
 359            XEmacs and the Xlib of the X server...
 360
 361            Let's hard-code in some knowledge of common keysyms introduced
 362            in recent X11 releases.  Snarfed from X11/keysymdef.h
 363
 364            Probably we should add some stuff here for X11R6. */
 365         switch (keysym)
 366           {
 367           case 0xFF95: return KEYSYM ("kp-home");
 368           case 0xFF96: return KEYSYM ("kp-left");
 369           case 0xFF97: return KEYSYM ("kp-up");
 370           case 0xFF98: return KEYSYM ("kp-right");
 371           case 0xFF99: return KEYSYM ("kp-down");
 372           case 0xFF9A: return KEYSYM ("kp-prior");
 373           case 0xFF9B: return KEYSYM ("kp-next");
 374           case 0xFF9C: return KEYSYM ("kp-end");
 375           case 0xFF9D: return KEYSYM ("kp-begin");
 376           case 0xFF9E: return KEYSYM ("kp-insert");
 377           case 0xFF9F: return KEYSYM ("kp-delete");
 378
 379           case 0x1005FF10: return KEYSYM ("SunF36"); /* labeled F11 */
 380           case 0x1005FF11: return KEYSYM ("SunF37"); /* labeled F12 */
 381           default:
 382             {
 383               char buf [64];
 384               sprintf (buf, "unknown-keysym-0x%X", (int) keysym);
 385               return KEYSYM (buf);
 386             }
 387           }
 388       /* If it's got a one-character name, that's good enough. */
 389       if (!name[1])
 390         return make_char (name[0]);
 391
 392       /* If it's in the "Keyboard" character set, downcase it.
 393          The case of those keysyms is too totally random for us to
 394          force anyone to remember them.
 395          The case of the other character sets is significant, however.
 396          */
 397       if ((((unsigned int) keysym) & (~0x1FF)) == ((unsigned int) 0xFE00))
 398         {
 399           char buf [255];
 400           char *s1, *s2;
 401           for (s1 = name, s2 = buf; *s1; s1++, s2++) {
 402             if (*s1 == '_') {
 403               *s2 = '-';
 404             } else {
 405               *s2 = tolower (* (unsigned char *) s1);
 406             }
 407           }
 408           *s2 = 0;
 409           return KEYSYM (buf);
 410         }
 411       return KEYSYM (name);
 412     }
 413 }
 414
 415 static Lisp_Object
 416 gtk_to_emacs_keysym (struct device *d, GdkEventKey *event, int simple_p)
 417      /* simple_p means don't try too hard (ASCII only) */
 418 {
 419   if (event->length != 1)
 420   {
 421 #ifdef FILE_CODING
 422       /* Generate multiple emacs events */
 423       Emchar ch;
 424       Lisp_Object instream, fb_instream;
 425       Lstream *istr;
 426       struct gcpro gcpro1, gcpro2;
 427
 428       fb_instream =
 429           make_fixed_buffer_input_stream ((unsigned char *) event->string, event->length);
 430
 431       /* ### Use Fget_coding_system (Vcomposed_input_coding_system) */
 432       instream =
 433           make_decoding_input_stream (XLSTREAM (fb_instream),
 434                                       Fget_coding_system (Qundecided));
 435
 436       istr = XLSTREAM (instream);
 437
 438       GCPRO2 (instream, fb_instream);
 439       while ((ch = Lstream_get_emchar (istr)) != EOF)
 440       {
 441           Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
 442           struct Lisp_Event *ev = XEVENT (emacs_event);
 443           ev->channel       = DEVICE_CONSOLE (d);
 444           ev->event_type    = key_press_event;
 445           ev->timestamp     = event->time;
 446           ev->event.key.modifiers = 0;
 447           ev->event.key.keysym    = make_char (ch);
 448           enqueue_gtk_dispatch_event (emacs_event);
 449       }
 450       Lstream_close (istr);
 451       UNGCPRO;
 452       Lstream_delete (istr);
 453       Lstream_delete (XLSTREAM (fb_instream));
 454 #else
 455       int i;
 456       for (i = 0; i < event->length; i++)
 457       {
 458           Lisp_Object emacs_event = Fmake_event (Qnil, Qnil);
 459           struct Lisp_Event *ev = XEVENT (emacs_event);
 460           ev->channel       = DEVICE_CONSOLE (d);
 461           ev->event_type    = key_press_event;
 462           ev->timestamp     = event->time;
 463           ev->event.key.modifiers = 0;
 464           ev->event.key.keysym    = make_char (event->string[i]);
 465           enqueue_gtk_dispatch_event (emacs_event);
 466       }
 467 #endif
 468       if (IS_MODIFIER_KEY (event->keyval) || (event->keyval == GDK_Mode_switch))
 469           return (Qnil);
 470       return (gtk_keysym_to_emacs_keysym (event->keyval, simple_p));
 471   }
 472   else
 473   {
 474       if (IS_MODIFIER_KEY (event->keyval) || (event->keyval == GDK_Mode_switch))
 475           return (Qnil);
 476       return (gtk_keysym_to_emacs_keysym (event->keyval, simple_p));
 477   }
 478 }
 479
 480 \f
 481 /************************************************************************/
 482 /*                              timeout events                          */
 483 /************************************************************************/
 484
 485 static int timeout_id_tick;
 486
 487 struct GTK_timeout {
 488     int id;
 489     guint timeout_id;
 490     struct GTK_timeout *next;
 491 } *pending_timeouts, *completed_timeouts;
 492
 493 struct GTK_timeout_blocktype
 494 {
 495   Blocktype_declare (struct GTK_timeout);
 496 } *the_GTK_timeout_blocktype;
 497
 498 /* called by the gtk main loop */
 499 static gint
 500 gtk_timeout_callback (gpointer closure)
 501 {
 502   struct GTK_timeout *timeout = (struct GTK_timeout *) closure;
 503   struct GTK_timeout *t2 = pending_timeouts;
 504
 505   /* Remove this one from the list of pending timeouts */
 506   if (t2 == timeout)
 507     pending_timeouts = pending_timeouts->next;
 508   else
 509     {
 510       while (t2->next && t2->next != timeout) t2 = t2->next;
 511       assert (t2->next);
 512       t2->next = t2->next->next;
 513     }
 514   /* Add this one to the list of completed timeouts */
 515   timeout->next = completed_timeouts;
 516   completed_timeouts = timeout;
 517   return(FALSE);
 518 }
 519
 520 static int
 521 emacs_gtk_add_timeout (EMACS_TIME thyme)
 522 {
 523   struct GTK_timeout *timeout = Blocktype_alloc (the_GTK_timeout_blocktype);
 524   EMACS_TIME current_time;
 525   int milliseconds;
 526
 527   timeout->id = timeout_id_tick++;
 528   timeout->next = pending_timeouts;
 529   pending_timeouts = timeout;
 530   EMACS_GET_TIME (current_time);
 531   EMACS_SUB_TIME (thyme, thyme, current_time);
 532   milliseconds = EMACS_SECS (thyme) * 1000 +
 533     EMACS_USECS (thyme) / 1000;
 534   if (milliseconds < 1)
 535     milliseconds = 1;
 536   timeout->timeout_id = gtk_timeout_add (milliseconds,
 537                                          gtk_timeout_callback,
 538                                          (gpointer) timeout);
 539   return timeout->id;
 540 }
 541
 542 static void
 543 emacs_gtk_remove_timeout (int id)
 544 {
 545   struct GTK_timeout *timeout, *t2;
 546
 547   timeout = NULL;
 548
 549   /* Find the timeout on the list of pending ones, if it's still there. */
 550   if (pending_timeouts)
 551     {
 552       if (id == pending_timeouts->id)
 553         {
 554           timeout = pending_timeouts;
 555           pending_timeouts = pending_timeouts->next;
 556         }
 557       else
 558         {
 559           t2 = pending_timeouts;
 560           while (t2->next && t2->next->id != id) t2 = t2->next;
 561           if ( t2->next)   /*found it */
 562             {
 563               timeout = t2->next;
 564               t2->next = t2->next->next;
 565             }
 566         }
 567       /* if it was pending, we have removed it from the list */
 568       if (timeout)
 569           gtk_timeout_remove (timeout->timeout_id);
 570     }
 571
 572   /* It could be that the call back was already called but we didn't convert
 573      into an Emacs event yet */
 574   if (!timeout && completed_timeouts)
 575     {
 576       /* Code duplication! */
 577       if (id == completed_timeouts->id)
 578         {
 579           timeout = completed_timeouts;
 580           completed_timeouts = completed_timeouts->next;
 581         }
 582       else
 583         {
 584           t2 = completed_timeouts;
 585           while (t2->next && t2->next->id != id) t2 = t2->next;
 586           if ( t2->next)   /*found it */
 587             {
 588               timeout = t2->next;
 589               t2->next = t2->next->next;
 590             }
 591         }
 592     }
 593
 594   /* If we found the thing on the lists of timeouts,
 595      and removed it, deallocate
 596   */
 597   if (timeout)
 598     Blocktype_free (the_GTK_timeout_blocktype, timeout);
 599 }
 600
 601 static void
 602 gtk_timeout_to_emacs_event (struct Lisp_Event *emacs_event)
 603 {
 604   struct GTK_timeout *timeout = completed_timeouts;
 605   assert (timeout);
 606   completed_timeouts = completed_timeouts->next;
 607   emacs_event->event_type = timeout_event;
 608   /* timeout events have nil as channel */
 609   emacs_event->timestamp  = 0; /* #### wrong!! */
 610   emacs_event->event.timeout.interval_id = timeout->id;
 611   Blocktype_free (the_GTK_timeout_blocktype, timeout);
 612 }
 613
 614 \f
 615 /************************************************************************/
 616 /*                      process and tty events                          */
 617 /************************************************************************/
 618
 619 struct what_is_ready_closure
 620 {
 621   int fd;
 622   Lisp_Object what;
 623   gint id;
 624 };
 625
 626 static Lisp_Object *filedesc_with_input;
 627 static struct what_is_ready_closure **filedesc_to_what_closure;
 628
 629 static void
 630 init_what_input_once (void)
 631 {
 632   int i;
 633
 634   filedesc_with_input = xnew_array (Lisp_Object, MAXDESC);
 635   filedesc_to_what_closure =
 636     xnew_array (struct what_is_ready_closure *, MAXDESC);
 637
 638   for (i = 0; i < MAXDESC; i++)
 639     {
 640       filedesc_to_what_closure[i] = 0;
 641       filedesc_with_input[i] = Qnil;
 642     }
 643
 644   process_events_occurred = 0;
 645   tty_events_occurred = 0;
 646 }
 647
 648 static void
 649 mark_what_as_being_ready (struct what_is_ready_closure *closure)
 650 {
 651   if (NILP (filedesc_with_input[closure->fd]))
 652     {
 653       SELECT_TYPE temp_mask;
 654       FD_ZERO (&temp_mask);
 655       FD_SET (closure->fd, &temp_mask);
 656       /* Check to make sure there's *really* input available.
 657          Sometimes things seem to get confused and this gets called
 658          for the tty fd when there's really only input available
 659          on some process's fd.  (It will subsequently get called
 660          for that process's fd, so returning without setting any
 661          flags will take care of it.)  To see the problem, uncomment
 662          the stderr_out below, turn NORMAL_QUIT_CHECK_TIMEOUT_MSECS
 663          down to 25, do sh -c 'xemacs -nw -q -f shell 2>/tmp/log'
 664          and press return repeatedly.  (Seen under AIX & Linux.)
 665          -dkindred@cs.cmu.edu */
 666       if (!poll_fds_for_input (temp_mask))
 667         {
 668 #if 0
 669           stderr_out ("mark_what_as_being_ready: no input available (fd=%d)\n",
 670                       closure->fd);
 671 #endif
 672           return;
 673         }
 674       filedesc_with_input[closure->fd] = closure->what;
 675       if (PROCESSP (closure->what))
 676         {
 677           /* Don't increment this if the current process is already marked
 678            *  as having input. */
 679           process_events_occurred++;
 680         }
 681       else
 682         {
 683           tty_events_occurred++;
 684         }
 685     }
 686 }
 687
 688 static void
 689 gtk_what_callback (gpointer closure, gint source, GdkInputCondition why)
 690 {
 691   /* If closure is 0, then we got a fake event from a signal handler.
 692      The only purpose of this is to make XtAppProcessEvent() stop
 693      blocking. */
 694   if (closure)
 695     mark_what_as_being_ready ((struct what_is_ready_closure *) closure);
 696   else
 697     {
 698       fake_event_occurred++;
 699       drain_signal_event_pipe ();
 700     }
 701 }
 702
 703 static void
 704 select_filedesc (int fd, Lisp_Object what)
 705 {
 706   struct what_is_ready_closure *closure;
 707
 708   /* If somebody is trying to select something that's already selected
 709      for, then something went wrong.  The generic routines ought to
 710      detect this and error before here. */
 711   assert (!filedesc_to_what_closure[fd]);
 712
 713   closure = xnew (struct what_is_ready_closure);
 714   closure->fd = fd;
 715   closure->what = what;
 716   closure->id = gdk_input_add (fd, GDK_INPUT_READ,
 717                                (GdkInputFunction) gtk_what_callback, closure);
 718   filedesc_to_what_closure[fd] = closure;
 719 }
 720
 721 static void
 722 unselect_filedesc (int fd)
 723 {
 724   struct what_is_ready_closure *closure = filedesc_to_what_closure[fd];
 725
 726   assert (closure);
 727   if (!NILP (filedesc_with_input[fd]))
 728     {
 729       /* We are unselecting this process before we have drained the rest of
 730          the input from it, probably from status_notify() in the command loop.
 731          This can happen like so:
 732
 733           - We are waiting in XtAppNextEvent()
 734           - Process generates output
 735           - Process is marked as being ready
 736           - Process dies, SIGCHLD gets generated before we return (!?)
 737             It could happen I guess.
 738           - sigchld_handler() marks process as dead
 739           - Somehow we end up getting a new KeyPress event on the queue
 740             at the same time (I'm really so sure how that happens but I'm
 741             not sure it can't either so let's assume it can...).
 742           - Key events have priority so we return that instead of the proc.
 743           - Before dispatching the lisp key event we call status_notify()
 744           - Which deselects the process that SIGCHLD marked as dead.
 745
 746          Thus we never remove it from _with_input and turn it into a lisp
 747          event, so we need to do it here.  But this does not mean that we're
 748          throwing away the last block of output - status_notify() has already
 749          taken care of running the proc filter or whatever.
 750        */
 751       filedesc_with_input[fd] = Qnil;
 752       if (PROCESSP (closure->what))
 753         {
 754           assert (process_events_occurred > 0);
 755           process_events_occurred--;
 756         }
 757       else
 758         {
 759           assert (tty_events_occurred > 0);
 760           tty_events_occurred--;
 761         }
 762     }
 763   gdk_input_remove (closure->id);
 764   xfree (closure);
 765   filedesc_to_what_closure[fd] = 0;
 766 }
 767
 768 static void
 769 emacs_gtk_select_process (struct Lisp_Process *p)
 770 {
 771   Lisp_Object process;
 772   int infd = event_stream_unixoid_select_process (p);
 773
 774   XSETPROCESS (process, p);
 775   select_filedesc (infd, process);
 776 }
 777
 778 static void
 779 emacs_gtk_unselect_process (struct Lisp_Process *p)
 780 {
 781   int infd = event_stream_unixoid_unselect_process (p);
 782
 783   unselect_filedesc (infd);
 784 }
 785
 786 static USID
 787 emacs_gtk_create_stream_pair (void* inhandle, void* outhandle,
 788                               Lisp_Object* instream, Lisp_Object* outstream, int flags)
 789 {
 790     USID u = event_stream_unixoid_create_stream_pair
 791         (inhandle, outhandle, instream, outstream, flags);
 792     if (u != USID_ERROR)
 793         u = USID_DONTHASH;
 794     return u;
 795 }
 796
 797 static USID
 798 emacs_gtk_delete_stream_pair (Lisp_Object instream, Lisp_Object outstream)
 799 {
 800   event_stream_unixoid_delete_stream_pair (instream, outstream);
 801   return USID_DONTHASH;
 802 }
 803
 804 /* This is called from GC when a process object is about to be freed.
 805    If we've still got pointers to it in this file, we're gonna lose hard.
 806  */
 807 void
 808 debug_process_finalization (struct Lisp_Process *p)
 809 {
 810 #if 0 /* #### */
 811   int i;
 812   Lisp_Object instr, outstr;
 813
 814   get_process_streams (p, &instr, &outstr);
 815   /* if it still has fds, then it hasn't been killed yet. */
 816   assert (NILP(instr));
 817   assert (NILP(outstr));
 818   /* Better not still be in the "with input" table; we know it's got no fds. */
 819   for (i = 0; i < MAXDESC; i++)
 820     {
 821       Lisp_Object process = filedesc_fds_with_input [i];
 822       assert (!PROCESSP (process) || XPROCESS (process) != p);
 823     }
 824 #endif
 825 }
 826
 827 static void
 828 gtk_process_to_emacs_event (struct Lisp_Event *emacs_event)
 829 {
 830   int i;
 831   Lisp_Object process;
 832
 833   assert (process_events_occurred > 0);
 834   for (i = 0; i < MAXDESC; i++)
 835     {
 836       process = filedesc_with_input[i];
 837       if (PROCESSP (process))
 838         break;
 839     }
 840   assert (i < MAXDESC);
 841   filedesc_with_input[i] = Qnil;
 842   process_events_occurred--;
 843   /* process events have nil as channel */
 844   emacs_event->event_type = process_event;
 845   emacs_event->timestamp  = 0; /* #### */
 846   emacs_event->event.process.process = process;
 847 }
 848
 849 static void
 850 emacs_gtk_select_console (struct console *con)
 851 {
 852   Lisp_Object console;
 853   int infd;
 854
 855   if (CONSOLE_GTK_P (con))
 856     return; /* Gtk consoles are automatically selected for when we initialize them */
 857   infd = event_stream_unixoid_select_console (con);
 858   XSETCONSOLE (console, con);
 859   select_filedesc (infd, console);
 860 }
 861
 862 static void
 863 emacs_gtk_unselect_console (struct console *con)
 864 {
 865   Lisp_Object console;
 866   int infd;
 867
 868   if (CONSOLE_GTK_P (con))
 869         return; /* X consoles are automatically selected for when we initialize them */
 870   infd = event_stream_unixoid_unselect_console (con);
 871   XSETCONSOLE (console, con);
 872   unselect_filedesc (infd);
 873 }
 874
 875 /* read an event from a tty, if one is available.  Returns non-zero
 876    if an event was available.  Note that when this function is
 877    called, there should always be a tty marked as ready for input.
 878    However, the input condition might actually be EOF, so there
 879    may not really be any input available. (In this case,
 880    read_event_from_tty_or_stream_desc() will arrange for the TTY device
 881    to be deleted.) */
 882
 883 static int
 884 gtk_tty_to_emacs_event (struct Lisp_Event *emacs_event)
 885 {
 886   int i;
 887
 888   assert (tty_events_occurred > 0);
 889   for (i = 0; i < MAXDESC; i++)
 890     {
 891       Lisp_Object console = filedesc_with_input[i];
 892       if (CONSOLEP (console))
 893         {
 894           assert (tty_events_occurred > 0);
 895           tty_events_occurred--;
 896           filedesc_with_input[i] = Qnil;
 897           if (read_event_from_tty_or_stream_desc
 898               (emacs_event, XCONSOLE (console), i))
 899             return 1;
 900         }
 901     }
 902
 903   return 0;
 904 }
 905
 906 \f
 907 /************************************************************************/
 908 /*                      Drag 'n Drop handling                           */
 909 /************************************************************************/
 910 #ifdef HAVE_DRAGNDROP
 911 #define TARGET_URI_LIST   0x00
 912 #define TARGET_TEXT_PLAIN 0x01
 913 #define TARGET_FILE_NAME  0x02
 914 #define TARGET_NETSCAPE   0x03
 915
 916 static GdkAtom preferred_targets[10];
 917
 918 void
 919 dragndrop_data_received (GtkWidget          *widget,
 920                          GdkDragContext     *context,
 921                          gint                x,
 922                          gint                y,
 923                          GtkSelectionData   *data,
 924                          guint               info,
 925                          guint               time)
 926 {
 927   Lisp_Object event = Fmake_event (Qnil, Qnil);
 928   struct device *d = gtk_any_window_to_device (widget->window);
 929   struct frame *f = gtk_any_widget_or_parent_to_frame (d, widget);
 930   struct Lisp_Event *ev = XEVENT (event);
 931   Lisp_Object l_type = Qnil, l_data = Qnil;
 932   Lisp_Object l_dndlist = Qnil, l_item = Qnil;
 933   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 934
 935   GCPRO4 (l_type, l_data, l_dndlist, l_item);
 936
 937   ev->event_type = misc_user_event;
 938   ev->timestamp = time;
 939
 940   XSETFRAME (ev->channel, f);
 941
 942   ev->event.misc.x = x;
 943   ev->event.misc.y = y;
 944
 945   if (data->type == preferred_targets[TARGET_URI_LIST])
 946     {
 947       /* newline-separated list of URLs */
 948       int start, end;
 949       const char *string_data = (char *) data->data;
 950
 951       l_type = Qdragdrop_URL;
 952
 953       for (start = 0, end = 0; string_data && string_data[end]; end++)
 954         {
 955           if ((string_data[end] == '\r') && (string_data[end+1] == '\n'))
 956             {
 957               l_item = make_string (&string_data[start], end - start);
 958               l_dndlist = Fcons (l_item, l_dndlist);
 959               ++end;
 960               start = ++end;
 961             }
 962         }
 963     }
 964   else if (data->type == preferred_targets[TARGET_TEXT_PLAIN])
 965     {
 966       /* Arbitrary string */
 967       l_type = Qdragdrop_MIME;
 968       l_dndlist = list1 (list3 (list1 (build_string ("text/plain")),
 969                                 build_string ("8_bit"),
 970                                 make_ext_string (data->data,
 971                                                  strlen ((char *)data->data),
 972                                                  Qctext)));
 973     }
 974   else if (data->type == preferred_targets[TARGET_FILE_NAME])
 975     {
 976       /* Random filename */
 977       char *hurl = dnd_url_hexify_string (data->data, "file:");
 978
 979       l_dndlist = list1 (make_string ((Bufbyte *)hurl, strlen (hurl)));
 980       l_type = Qdragdrop_URL;
 981
 982       xfree (hurl);
 983     }
 984   else if (data->type == preferred_targets[TARGET_NETSCAPE])
 985     {
 986       /* Single URL */
 987       l_dndlist = list1 (make_string ((Extbyte *)data->data,
 988                                       strlen ((char *)data->data)));
 989       l_type = Qdragdrop_URL;
 990     }
 991   else
 992     {
 993       /* Unknown type - what to do?
 994          We just pass it up to lisp - we already have a mime type.
 995       */
 996       l_type = Qdragdrop_MIME;
 997       l_dndlist = list1 (list3 (list1 (build_string (gdk_atom_name (data->type))),
 998                                 build_string ("8bit"),
 999                                 make_ext_string ((Extbyte *) data->data,
1000                                                  data->length, Qbinary)));
1001     }
1002
1003   ev->event.misc.function = Qdragdrop_drop_dispatch;
1004   ev->event.misc.object = Fcons (l_type, l_dndlist);
1005
1006   UNGCPRO;
1007
1008   gtk_drag_finish (context, TRUE, FALSE, time);
1009   enqueue_gtk_dispatch_event (event);
1010 }
1011
1012 gboolean
1013 dragndrop_dropped (GtkWidget *widget,
1014                    GdkDragContext *drag_context,
1015                    gint x,
1016                    gint y,
1017                    guint time,
1018                    gpointer user_data)
1019 {
1020   /* Netscape drops things like:
1021      STRING
1022      _SGI_ICON
1023      _SGI_ICON_TYPE
1024      SGI_FILE
1025      FILE_NAME
1026      _NETSCAPE_URL
1027
1028      gmc drops things like
1029      application/x-mc-desktop-icon
1030      text/uri-list
1031      text/plain
1032      _NETSCAPE_URL
1033
1034      We prefer:
1035      text/uri-list
1036      text/plain
1037      FILE_NAME
1038      _NETSCAPE_URL
1039      first one
1040   */
1041   GdkAtom found = 0;
1042   GList *list = drag_context->targets;
1043
1044   int i;
1045
1046   if (!preferred_targets[0])
1047     {
1048       preferred_targets[TARGET_URI_LIST]   = gdk_atom_intern ("text/uri-list", FALSE);
1049       preferred_targets[TARGET_TEXT_PLAIN] = gdk_atom_intern ("text/plain", FALSE);
1050       preferred_targets[TARGET_FILE_NAME]  = gdk_atom_intern ("FILE_NAME", FALSE);
1051       preferred_targets[TARGET_NETSCAPE]   = gdk_atom_intern ("_NETSCAPE_URL", FALSE);
1052     }
1053
1054 #if 0
1055   stderr_out ("Drop info available in the following formats: \n");
1056   while (list)
1057     {
1058       stderr_out ("\t%s\n", gdk_atom_name ((GdkAtom)list->data));
1059       list = list->next;
1060     }
1061   list = drag_context->targets;
1062 #endif
1063
1064   while (list && !found)
1065     {
1066       for (i = 0; preferred_targets[i] && !found; i++)
1067         {
1068           if ((GdkAtom) list->data == preferred_targets[i])
1069             {
1070               found = (GdkAtom) list->data;
1071             }
1072         }
1073       list = list->next;
1074     }
1075
1076   if (!found)
1077     {
1078       found = (GdkAtom) drag_context->targets->data;
1079     }
1080
1081   gtk_drag_get_data (GTK_WIDGET (user_data), drag_context, found, time);
1082   return (TRUE);
1083 }
1084 #endif /* HAVE_DRAGNDROP */
1085
1086 \f
1087 /************************************************************************/
1088 /*                      get the next event from gtk                     */
1089 /************************************************************************/
1090
1091 static Lisp_Object dispatch_event_queue, dispatch_event_queue_tail;
1092
1093 static void
1094 enqueue_gtk_dispatch_event (Lisp_Object event)
1095 {
1096   enqueue_event (event, &dispatch_event_queue, &dispatch_event_queue_tail);
1097 }
1098
1099 static Lisp_Object
1100 dequeue_gtk_dispatch_event (void)
1101 {
1102   return dequeue_event (&dispatch_event_queue, &dispatch_event_queue_tail);
1103 }
1104
1105 /* This business exists because menu events "happen" when
1106    menubar_selection_callback() is called from somewhere deep
1107    within XtAppProcessEvent in emacs_Xt_next_event().  The
1108    callback needs to terminate the modal loop in that function
1109    or else it will continue waiting until another event is
1110    received.
1111
1112    Same business applies to scrollbar events. */
1113
1114 void
1115 signal_special_gtk_user_event (Lisp_Object channel, Lisp_Object function,
1116                               Lisp_Object object)
1117 {
1118   Lisp_Object event = Fmake_event (Qnil, Qnil);
1119
1120   XEVENT (event)->event_type = misc_user_event;
1121   XEVENT (event)->channel = channel;
1122   XEVENT (event)->event.eval.function = function;
1123   XEVENT (event)->event.eval.object = object;
1124
1125   enqueue_gtk_dispatch_event (event);
1126 }
1127
1128 static void
1129 emacs_gtk_next_event (struct Lisp_Event *emacs_event)
1130 {
1131  we_didnt_get_an_event:
1132
1133   while (NILP (dispatch_event_queue) &&
1134          !completed_timeouts         &&
1135          !fake_event_occurred        &&
1136          !process_events_occurred    &&
1137          !tty_events_occurred)
1138     {
1139       gtk_main_iteration();
1140     }
1141
1142   if (!NILP (dispatch_event_queue))
1143     {
1144       Lisp_Object event, event2;
1145       XSETEVENT (event2, emacs_event);
1146       event = dequeue_gtk_dispatch_event ();
1147       Fcopy_event (event, event2);
1148       Fdeallocate_event (event);
1149     }
1150   else if (tty_events_occurred)
1151     {
1152       if (!gtk_tty_to_emacs_event (emacs_event))
1153         goto we_didnt_get_an_event;
1154     }
1155   else if (completed_timeouts)
1156     gtk_timeout_to_emacs_event (emacs_event);
1157   else if (fake_event_occurred)
1158     {
1159       /* A dummy event, so that a cycle of the command loop will occur. */
1160       fake_event_occurred = 0;
1161       /* eval events have nil as channel */
1162       emacs_event->event_type = eval_event;
1163       emacs_event->event.eval.function = Qidentity;
1164       emacs_event->event.eval.object = Qnil;
1165     }
1166   else /* if (process_events_occurred) */
1167     gtk_process_to_emacs_event (emacs_event);
1168 }
1169
1170 int
1171 gtk_event_to_emacs_event (struct frame *frame, GdkEvent *gdk_event, struct Lisp_Event *emacs_event)
1172 {
1173   struct device *d = NULL;
1174   struct gtk_device *gd = NULL;
1175   gboolean accept_any_window = FALSE;
1176
1177   if (!frame)
1178     {
1179       frame = XFRAME (Fselected_frame (Vdefault_gtk_device));
1180       accept_any_window = TRUE;
1181     }
1182
1183   d = XDEVICE (FRAME_DEVICE (frame));
1184   gd = DEVICE_GTK_DATA (d);
1185
1186   set_last_server_timestamp (d, gdk_event);
1187
1188   switch (gdk_event->type)
1189     {
1190       /* XEmacs handles double and triple clicking on its own, and if
1191          we capture these events, it royally confuses the code in
1192          ../lisp/mouse.el */
1193     case GDK_2BUTTON_PRESS:
1194     case GDK_3BUTTON_PRESS:
1195       return (0);
1196
1197     case GDK_BUTTON_PRESS:
1198     case GDK_BUTTON_RELEASE:
1199         /* We need to ignore button events outside our main window or
1200            things get ugly.  The standard scrollbars in Gtk try to be
1201            nice and pass the button press events up to the parent
1202            widget.  This causes us no end of grief though.  Effects
1203            range from setting point to the wrong place to selecting
1204            new windows. */
1205       {
1206         GdkWindow *w = gdk_window_at_pointer (NULL, NULL);
1207
1208         /* If you press mouse button and drag it around, and release
1209            it outside the window, you will get a NULL GdkWindow at
1210            pointer.  We need to forward these events on to XEmacs so
1211            that the mouse selection voodoo works.
1212         */
1213         if (w && (w != gdk_window_lookup (GDK_ROOT_WINDOW ())))
1214           {
1215             GdkEvent ev;
1216             GtkWidget *wid = NULL;
1217
1218             ev.any.window = w;
1219             wid = gtk_get_event_widget (&ev);
1220
1221             if (!GTK_IS_XEMACS (wid) && !accept_any_window)
1222               {
1223                 return (0);
1224               }
1225           }
1226         if (!accept_any_window)
1227           gtk_widget_grab_focus (FRAME_GTK_TEXT_WIDGET (frame));
1228       }
1229       /* Fall through */
1230     case GDK_KEY_PRESS:
1231       {
1232         unsigned int modifiers = 0;
1233         int shift_p, lock_p;
1234         gboolean key_event_p = (gdk_event->type == GDK_KEY_PRESS);
1235         unsigned int *state =
1236           key_event_p ? &gdk_event->key.state : &gdk_event->button.state;
1237
1238         /* If this is a synthetic KeyPress or Button event, and the user
1239            has expressed a disinterest in this security hole, then drop
1240            it on the floor. */
1241         /* #### BILL!!! Should this be a generic check for ANY synthetic
1242            event? */
1243         if ((gdk_event->any.send_event) && !gtk_allow_sendevents)
1244           return 0;
1245
1246         DEVICE_GTK_MOUSE_TIMESTAMP (d) =
1247           DEVICE_GTK_GLOBAL_MOUSE_TIMESTAMP (d) =
1248           key_event_p ? gdk_event->key.time : gdk_event->button.time;
1249
1250         if (*state & GDK_CONTROL_MASK)    modifiers |= XEMACS_MOD_CONTROL;
1251         if (*state & gd->MetaMask)   modifiers |= XEMACS_MOD_META;
1252         if (*state & gd->SuperMask)  modifiers |= XEMACS_MOD_SUPER;
1253         if (*state & gd->HyperMask)  modifiers |= XEMACS_MOD_HYPER;
1254         if (*state & gd->AltMask)    modifiers |= XEMACS_MOD_ALT;
1255
1256         {
1257           int numero_de_botao = -1;
1258
1259           if (!key_event_p)
1260             numero_de_botao = gdk_event->button.button;
1261
1262           /* the button gets noted either in the button or the modifiers
1263              field, but not both. */
1264           if (numero_de_botao != 1 && (*state & GDK_BUTTON1_MASK))
1265             modifiers |= XEMACS_MOD_BUTTON1;
1266           if (numero_de_botao != 2 && (*state & GDK_BUTTON2_MASK))
1267             modifiers |= XEMACS_MOD_BUTTON2;
1268           if (numero_de_botao != 3 && (*state & GDK_BUTTON3_MASK))
1269             modifiers |= XEMACS_MOD_BUTTON3;
1270           if (numero_de_botao != 4 && (*state & GDK_BUTTON4_MASK))
1271             modifiers |= XEMACS_MOD_BUTTON4;
1272           if (numero_de_botao != 5 && (*state & GDK_BUTTON5_MASK))
1273             modifiers |= XEMACS_MOD_BUTTON5;
1274         }
1275
1276         /* Ignore the Caps_Lock key if:
1277            - any other modifiers are down, so that Caps_Lock doesn't
1278            turn C-x into C-X, which would suck.
1279            - the event was a mouse event. */
1280         if (modifiers || ! key_event_p)
1281           *state &= (~GDK_LOCK_MASK);
1282
1283         shift_p = *state & GDK_SHIFT_MASK;
1284         lock_p  = *state & GDK_LOCK_MASK;
1285
1286         if (shift_p || lock_p)
1287           modifiers |= XEMACS_MOD_SHIFT;
1288
1289         if (key_event_p)
1290           {
1291             GdkEventKey *key_event = &gdk_event->key;
1292             Lisp_Object keysym;
1293
1294             /* This used to compute the frame from the given X window and
1295                store it here, but we really don't care about the frame. */
1296             emacs_event->channel = DEVICE_CONSOLE (d);
1297
1298             /* Keysym mucking has already been done inside the
1299                GdkEventKey parsing */
1300             keysym = gtk_to_emacs_keysym (d, key_event, 0);
1301
1302             /* If the emacs keysym is nil, then that means that the X
1303                keysym was either a Modifier or NoSymbol, which
1304                probably means that we're in the midst of reading a
1305                Multi_key sequence, or a "dead" key prefix, or XIM
1306                input. Ignore it. */
1307             if (NILP (keysym))
1308               return 0;
1309
1310             /* More Caps_Lock garbage: Caps_Lock should *only* add the
1311                shift modifier to two-case keys (that is, A-Z and
1312                related characters). So at this point (after looking up
1313                the keysym) if the keysym isn't a dual-case alphabetic,
1314                and if the caps lock key was down but the shift key
1315                wasn't, then turn off the shift modifier.  Gag barf */
1316             /* #### type lossage: assuming equivalence of emacs and
1317                X keysyms */
1318             /* !!#### maybe fix for Mule */
1319             if (lock_p && !shift_p &&
1320                 ! (CHAR_OR_CHAR_INTP (keysym)
1321                    && keysym_obeys_caps_lock_p
1322                    ((guint) XCHAR_OR_CHAR_INT (keysym), d)))
1323               modifiers &= (~XEMACS_MOD_SHIFT);
1324
1325             /* If this key contains two distinct keysyms, that is,
1326                "shift" generates a different keysym than the
1327                non-shifted key, then don't apply the shift modifier
1328                bit: it's implicit.  Otherwise, if there would be no
1329                other way to tell the difference between the shifted
1330                and unshifted version of this key, apply the shift bit.
1331                Non-graphics, like Backspace and F1 get the shift bit
1332                in the modifiers slot.  Neither the characters "a",
1333                "A", "2", nor "@" normally have the shift bit set.
1334                However, "F1" normally does. */
1335             if (modifiers & XEMACS_MOD_SHIFT)
1336               {
1337                 if (CHAR_OR_CHAR_INTP (keysym))
1338                   {
1339                     modifiers &= ~XEMACS_MOD_SHIFT;
1340                   }
1341               }
1342
1343             emacs_event->event_type          = key_press_event;
1344             emacs_event->timestamp           = key_event->time;
1345             emacs_event->event.key.modifiers = modifiers;
1346             emacs_event->event.key.keysym    = keysym;
1347           }
1348         else                    /* Mouse press/release event */
1349           {
1350             GdkEventButton *button_event = &gdk_event->button;
1351             XSETFRAME (emacs_event->channel, frame);
1352
1353             emacs_event->event_type = (button_event->type == GDK_BUTTON_RELEASE) ?
1354               button_release_event : button_press_event;
1355
1356             emacs_event->event.button.modifiers = modifiers;
1357             emacs_event->timestamp              = button_event->time;
1358             emacs_event->event.button.button    = button_event->button;
1359             emacs_event->event.button.x         = button_event->x;
1360             emacs_event->event.button.y         = button_event->y;
1361           }
1362       }
1363       break;
1364     case GDK_KEY_RELEASE:
1365         return 0;
1366         break;
1367     case GDK_MOTION_NOTIFY:
1368       {
1369         GdkEventMotion *ev = &gdk_event->motion;
1370         unsigned int modifiers = 0;
1371         gint x,y;
1372         GdkModifierType mask;
1373
1374         /* We use MOTION_HINT_MASK, so we will get only one motion
1375            event until the next time we call gdk_window_get_pointer or
1376            the user clicks the mouse.  So call gdk_window_get_pointer
1377            now (meaning that the event will be in sync with the server
1378            just before Fnext_event() returns).  If the mouse is still
1379            in motion, then the server will immediately generate
1380            exactly one more motion event, which will be on the queue
1381            waiting for us next time around. */
1382         gdk_window_get_pointer (ev->window, &x, &y, &mask);
1383
1384         DEVICE_GTK_MOUSE_TIMESTAMP (d) = ev->time;
1385
1386         XSETFRAME (emacs_event->channel, frame);
1387         emacs_event->event_type     = pointer_motion_event;
1388         emacs_event->timestamp      = ev->time;
1389         emacs_event->event.motion.x = x;
1390         emacs_event->event.motion.y = y;
1391         if (mask & GDK_SHIFT_MASK)      modifiers |= XEMACS_MOD_SHIFT;
1392         if (mask & GDK_CONTROL_MASK)    modifiers |= XEMACS_MOD_CONTROL;
1393         if (mask & gd->MetaMask)        modifiers |= XEMACS_MOD_META;
1394         if (mask & gd->SuperMask)       modifiers |= XEMACS_MOD_SUPER;
1395         if (mask & gd->HyperMask)       modifiers |= XEMACS_MOD_HYPER;
1396         if (mask & gd->AltMask)         modifiers |= XEMACS_MOD_ALT;
1397         if (mask & GDK_BUTTON1_MASK)    modifiers |= XEMACS_MOD_BUTTON1;
1398         if (mask & GDK_BUTTON2_MASK)    modifiers |= XEMACS_MOD_BUTTON2;
1399         if (mask & GDK_BUTTON3_MASK)    modifiers |= XEMACS_MOD_BUTTON3;
1400         if (mask & GDK_BUTTON4_MASK)    modifiers |= XEMACS_MOD_BUTTON4;
1401         if (mask & GDK_BUTTON5_MASK)    modifiers |= XEMACS_MOD_BUTTON5;
1402
1403         /* Currently ignores Shift_Lock but probably shouldn't
1404            (but it definitely should ignore Caps_Lock). */
1405         emacs_event->event.motion.modifiers = modifiers;
1406       }
1407     break;
1408
1409     default: /* it's a magic event */
1410       return (0);
1411         break;
1412     }
1413   return 1;
1414 }
1415
1416 static const char *event_name (GdkEvent *);
1417
1418 static gboolean
1419 generic_event_handler (GtkWidget *widget, GdkEvent *event)
1420 {
1421     Lisp_Object emacs_event = Qnil;
1422     if (!GTK_IS_XEMACS (widget))
1423     {
1424         stderr_out ("Got a %s event for a non-XEmacs widget\n",event_name (event));
1425         return (FALSE);
1426     }
1427
1428     emacs_event = Fmake_event (Qnil, Qnil);
1429
1430     if (gtk_event_to_emacs_event (GTK_XEMACS_FRAME (widget), event, XEVENT (emacs_event)))
1431     {
1432         enqueue_gtk_dispatch_event (emacs_event);
1433         return (TRUE);
1434     }
1435     else
1436     {
1437         Fdeallocate_event (emacs_event);
1438     }
1439     return (FALSE);
1440 }
1441
1442 gint emacs_gtk_key_event_handler(GtkWidget *widget, GdkEventKey *event)
1443 {
1444     return (generic_event_handler (widget, (GdkEvent *) event));
1445 }
1446
1447 gint emacs_gtk_button_event_handler(GtkWidget *widget, GdkEventButton *event)
1448 {
1449     return (generic_event_handler (widget, (GdkEvent *) event));
1450 }
1451
1452 gint emacs_gtk_motion_event_handler (GtkWidget *widget, GdkEventMotion *event)
1453 {
1454     return (generic_event_handler (widget, (GdkEvent *) event));
1455 }
1456
1457 gboolean
1458 emacs_shell_event_handler (GtkWidget *wid /* unused */,
1459                            GdkEvent *event,
1460                            gpointer closure)
1461 {
1462     struct frame *frame = (struct frame *) closure;
1463     Lisp_Object lisp_event = Fmake_event (Qnil, Qnil);
1464     struct Lisp_Event *emacs_event = XEVENT (lisp_event);
1465     GdkEvent *gdk_event_copy = &emacs_event->event.magic.underlying_gdk_event;
1466     struct device *d = XDEVICE (FRAME_DEVICE (frame));
1467     gboolean ignore_p = FALSE;
1468
1469     set_last_server_timestamp (d, event);
1470
1471 #define FROB(event_member) gdk_event_copy->event_member = event->event_member
1472
1473     switch (event->type)
1474     {
1475     case GDK_SELECTION_REQUEST:
1476     case GDK_SELECTION_CLEAR:
1477     case GDK_SELECTION_NOTIFY:  FROB(selection); break;
1478     case GDK_PROPERTY_NOTIFY:   FROB(property); break;
1479     case GDK_CLIENT_EVENT:      FROB(client); break;
1480     case GDK_MAP:
1481     case GDK_UNMAP:             FROB(any); break;
1482     case GDK_CONFIGURE:         FROB(configure); break;
1483     case GDK_ENTER_NOTIFY:
1484     case GDK_LEAVE_NOTIFY:      FROB(crossing); break;
1485     case GDK_FOCUS_CHANGE:      FROB(focus_change); break;
1486     case GDK_VISIBILITY_NOTIFY: FROB(visibility); break;
1487     default:
1488         ignore_p = TRUE;
1489         /* Hrmm... do we really want to swallow all the other events as magic? */
1490         *gdk_event_copy = *event;
1491         break;
1492     }
1493 #undef FROB
1494
1495     emacs_event->event_type = magic_event;
1496     XSETFRAME (emacs_event->channel, frame);
1497
1498     if (ignore_p)
1499     {
1500         stderr_out ("Ignoring event... (%s)\n", event_name (event));
1501         Fdeallocate_event (lisp_event);
1502         return (FALSE);
1503     }
1504     else
1505     {
1506         enqueue_gtk_dispatch_event (lisp_event);
1507         return (TRUE);
1508     }
1509 }
1510
1511 \f
1512 /************************************************************************/
1513 /*                      input pending / C-g checking                    */
1514 /************************************************************************/
1515 static void
1516 gtk_check_for_quit_char (struct device *d);
1517
1518 static void
1519 check_for_tty_quit_char (struct device *d)
1520 {
1521   SELECT_TYPE temp_mask;
1522   int infd = DEVICE_INFD (d);
1523   struct console *con = XCONSOLE (DEVICE_CONSOLE (d));
1524   Emchar quit_char = CONSOLE_QUIT_CHAR (con);
1525
1526   FD_ZERO (&temp_mask);
1527   FD_SET (infd, &temp_mask);
1528
1529   while (1)
1530     {
1531       Lisp_Object event;
1532       Emchar the_char;
1533
1534       if (!poll_fds_for_input (temp_mask))
1535         return;
1536
1537       event = Fmake_event (Qnil, Qnil);
1538       if (!read_event_from_tty_or_stream_desc (XEVENT (event), con, infd))
1539         /* EOF, or something ... */
1540         return;
1541       /* #### bogus.  quit-char should be allowed to be any sort
1542          of event. */
1543       the_char = event_to_character (XEVENT (event), 1, 0, 0);
1544       if (the_char >= 0 && the_char == quit_char)
1545         {
1546           Vquit_flag = Qt;
1547           /* do not queue the C-g.  See above. */
1548           return;
1549         }
1550
1551       /* queue the read event to be read for real later. */
1552       enqueue_gtk_dispatch_event (event);
1553     }
1554 }
1555
1556 static void
1557 emacs_gtk_quit_p (void)
1558 {
1559   Lisp_Object devcons, concons;
1560
1561   CONSOLE_LOOP (concons)
1562     {
1563       struct console *con = XCONSOLE (XCAR (concons));
1564       if (!con->input_enabled)
1565         continue;
1566
1567       CONSOLE_DEVICE_LOOP (devcons, con)
1568         {
1569           struct device *d;
1570           d = XDEVICE (XCAR (devcons));
1571
1572           if (DEVICE_GTK_P (d))
1573             /* emacs may be exiting */
1574             gtk_check_for_quit_char (d);
1575           else if (DEVICE_TTY_P (d))
1576             check_for_tty_quit_char (d);
1577         }
1578     }
1579 }
1580
1581 #include <gdk/gdkx.h>
1582
1583 static void
1584 drain_gtk_queue (void)
1585
1586 {
1587   /* We can't just spin through here and wait for GTKs idea of the
1588      event queue to get empty, or the queue never gets drained.  The
1589      situation is as follows.  A process event gets signalled, we put
1590      it on the queue, then we go into Fnext_event(), which calls
1591      drain_gtk_queue().  But gtk_events_pending() will always return
1592      TRUE if there are file-descriptor (aka our process) events
1593      pending.  Using GDK_events_pending() only shows us windowing
1594      system events.
1595   */
1596   if (GDK_DISPLAY ())
1597     while (gdk_events_pending ())
1598       gtk_main_iteration ();
1599 }
1600
1601 static int
1602 emacs_gtk_event_pending_p (int user_p)
1603 {
1604   Lisp_Object event;
1605   int tick_count_val;
1606
1607   /* If `user_p' is false, then this function returns whether there are any
1608      X, timeout, or fd events pending (that is, whether emacs_gtk_next_event()
1609      would return immediately without blocking).
1610
1611      if `user_p' is true, then this function returns whether there are any
1612      *user generated* events available (that is, whether there are keyboard
1613      or mouse-click events ready to be read).  This also implies that
1614      emacs_Xt_next_event() would not block.
1615
1616      In a non-SIGIO world, this also checks whether the user has typed ^G,
1617      since this is a convenient place to do so.  We don't need to do this
1618      in a SIGIO world, since input causes an interrupt.
1619    */
1620
1621   /* This function used to simply check whether there were any X
1622      events (or if user_p was 1, it iterated over all the pending
1623      X events using XCheckIfEvent(), looking for keystrokes and
1624      button events).  That worked in the old cheesoid event loop,
1625      which didn't go through XtAppDispatchEvent(), but it doesn't
1626      work any more -- X events may not result in anything.  For
1627      example, a button press in a blank part of the menubar appears
1628      as an X event but will not result in any Emacs events (a
1629      button press that activates the menubar results in an Emacs
1630      event through the stop_next_event mechanism).
1631
1632      The only accurate way of determining whether these X events
1633      translate into Emacs events is to go ahead and dispatch them
1634      until there's something on the dispatch queue. */
1635
1636   /* See if there are any user events already on the queue. */
1637   EVENT_CHAIN_LOOP (event, dispatch_event_queue)
1638     if (!user_p || command_event_p (event))
1639       return 1;
1640
1641   /* See if there's any TTY input available.
1642    */
1643   if (poll_fds_for_input (tty_only_mask))
1644     return 1;
1645
1646   if (!user_p)
1647     {
1648       /* If not user_p and there are any timer or file-desc events
1649          pending, we know there will be an event so we're through. */
1650 /*      XtInputMask pending_value; */
1651
1652       /* Note that formerly we just checked the value of XtAppPending()
1653          to determine if there was file-desc input.  This doesn't
1654          work any more with the signal_event_pipe; XtAppPending()
1655          will says "yes" in this case but there isn't really any
1656          input.  Another way of fixing this problem is for the
1657          signal_event_pipe to generate actual input in the form
1658          of an identity eval event or something. (#### maybe this
1659          actually happens?) */
1660
1661       if (poll_fds_for_input (process_only_mask))
1662         return 1;
1663
1664       /* #### Is there any way to do this in Gtk?  I don't think there
1665               is a 'peek' for events */
1666 #if 0
1667       pending_value = XtAppPending (Xt_app_con);
1668
1669       if (pending_value & XtIMTimer)
1670         return 1;
1671 #endif
1672     }
1673
1674   /* XtAppPending() can be super-slow, esp. over a network connection.
1675      Quantify results have indicated that in some cases the
1676      call to detect_input_pending() completely dominates the
1677      running time of redisplay().  Fortunately, in a SIGIO world
1678      we can more quickly determine whether there are any X events:
1679      if an event has happened since the last time we checked, then
1680      a SIGIO will have happened.  On a machine with broken SIGIO,
1681      we'll still be in an OK state -- the sigio_happened flag
1682      will get set at least once a second, so we'll be no more than
1683      one second behind reality. (In general it's OK if we
1684      erroneously report no input pending when input is actually
1685      pending() -- preemption is just a bit less efficient, that's
1686      all.  It's bad bad bad if you err the other way -- you've
1687      promised that `next-event' won't block but it actually will,
1688      and some action might get delayed until the next time you
1689      hit a key.)
1690      */
1691
1692   /* quit_check_signal_tick_count is volatile so try to avoid race conditions
1693      by using a temporary variable */
1694   tick_count_val = quit_check_signal_tick_count;
1695   if (last_quit_check_signal_tick_count != tick_count_val)
1696     {
1697       last_quit_check_signal_tick_count = tick_count_val;
1698
1699       /* We need to drain the entire queue now -- if we only
1700          drain part of it, we may later on end up with events
1701          actually pending but detect_input_pending() returning
1702          false because there wasn't another SIGIO. */
1703
1704       drain_gtk_queue ();
1705
1706       EVENT_CHAIN_LOOP (event, dispatch_event_queue)
1707         if (!user_p || command_event_p (event))
1708           return 1;
1709     }
1710
1711   return 0;
1712 }
1713
1714 \f
1715 /************************************************************************/
1716 /*                            initialization                            */
1717 /************************************************************************/
1718
1719 void
1720 syms_of_event_gtk (void)
1721 {
1722   defsymbol (&Qkey_mapping, "key-mapping");
1723   defsymbol (&Qsans_modifiers, "sans-modifiers");
1724 }
1725
1726 void reinit_vars_of_event_gtk (void)
1727 {
1728   gtk_event_stream = xnew (struct event_stream);
1729   gtk_event_stream->event_pending_p     = emacs_gtk_event_pending_p;
1730   gtk_event_stream->next_event_cb       = emacs_gtk_next_event;
1731   gtk_event_stream->handle_magic_event_cb= emacs_gtk_handle_magic_event;
1732   gtk_event_stream->add_timeout_cb      = emacs_gtk_add_timeout;
1733   gtk_event_stream->remove_timeout_cb   = emacs_gtk_remove_timeout;
1734   gtk_event_stream->select_console_cb   = emacs_gtk_select_console;
1735   gtk_event_stream->unselect_console_cb = emacs_gtk_unselect_console;
1736   gtk_event_stream->select_process_cb   = emacs_gtk_select_process;
1737   gtk_event_stream->unselect_process_cb = emacs_gtk_unselect_process;
1738   gtk_event_stream->quit_p_cb           = emacs_gtk_quit_p;
1739   gtk_event_stream->create_stream_pair_cb= emacs_gtk_create_stream_pair;
1740   gtk_event_stream->delete_stream_pair_cb= emacs_gtk_delete_stream_pair;
1741
1742   the_GTK_timeout_blocktype = Blocktype_new (struct GTK_timeout_blocktype);
1743
1744   /* this function only makes safe calls */
1745   init_what_input_once ();
1746 }
1747
1748 void
1749 vars_of_event_gtk (void)
1750 {
1751   reinit_vars_of_event_gtk ();
1752
1753   dispatch_event_queue = Qnil;
1754   staticpro (&dispatch_event_queue);
1755   dispatch_event_queue_tail = Qnil;
1756   staticpro (&dispatch_event_queue_tail);
1757
1758   DEFVAR_BOOL ("gtk-allow-sendevents", &gtk_allow_sendevents /*
1759 *Non-nil means to allow synthetic events.  Nil means they are ignored.
1760 Beware: allowing emacs to process SendEvents opens a big security hole.
1761 */ );
1762   gtk_allow_sendevents = 0;
1763
1764   last_quit_check_signal_tick_count = 0;
1765 }
1766
1767 void
1768 init_event_gtk_late (void) /* called when already initialized */
1769 {
1770   timeout_id_tick = 1;
1771   pending_timeouts = 0;
1772   completed_timeouts = 0;
1773
1774   event_stream = gtk_event_stream;
1775
1776 #if 0
1777   /* Shut GDK the hell up */
1778   gdk_error_trap_push ();
1779 #endif
1780
1781   gdk_input_add (signal_event_pipe[0], GDK_INPUT_READ,
1782                  (GdkInputFunction) gtk_what_callback, NULL);
1783 }
1784
1785 /* Bogus utility routines */
1786 static const char *event_name (GdkEvent *ev)
1787 {
1788   return (gtk_event_name (ev->any.type));
1789 }
1790
1791 /* This is down at the bottom of the file so I can avoid polluting the
1792    generic code with this X specific CRAP! */
1793
1794 #include <gdk/gdkx.h>
1795 #include <X11/keysym.h>
1796 /* #### BILL!!! Fix this please! */
1797
1798 \f
1799 /************************************************************************/
1800 /*                            keymap handling                           */
1801 /************************************************************************/
1802
1803 /* X bogusly doesn't define the interpretations of any bits besides
1804    ModControl, ModShift, and ModLock; so the Interclient Communication
1805    Conventions Manual says that we have to bend over backwards to figure
1806    out what the other modifier bits mean.  According to ICCCM:
1807
1808    - Any keycode which is assigned ModControl is a "control" key.
1809
1810    - Any modifier bit which is assigned to a keycode which generates Meta_L
1811      or Meta_R is the modifier bit meaning "meta".  Likewise for Super, Hyper,
1812      etc.
1813
1814    - Any keypress event which contains ModControl in its state should be
1815      interpreted as a "control" character.
1816
1817    - Any keypress event which contains a modifier bit in its state which is
1818      generated by a keycode whose corresponding keysym is Meta_L or Meta_R
1819      should be interpreted as a "meta" character.  Likewise for Super, Hyper,
1820      etc.
1821
1822    - It is illegal for a keysym to be associated with more than one modifier
1823      bit.
1824
1825    This means that the only thing that emacs can reasonably interpret as a
1826    "meta" key is a key whose keysym is Meta_L or Meta_R, and which generates
1827    one of the modifier bits Mod1-Mod5.
1828
1829    Unfortunately, many keyboards don't have Meta keys in their default
1830    configuration.  So, if there are no Meta keys, but there are "Alt" keys,
1831    emacs will interpret Alt as Meta.  If there are both Meta and Alt keys,
1832    then the Meta keys mean "Meta", and the Alt keys mean "Alt" (it used to
1833    mean "Symbol," but that just confused the hell out of way too many people).
1834
1835    This works with the default configurations of the 19 keyboard-types I've
1836    checked.
1837
1838    Emacs detects keyboard configurations which violate the above rules, and
1839    prints an error message on the standard-error-output.  (Perhaps it should
1840    use a pop-up-window instead.)
1841  */
1842
1843 static void
1844 gtk_reset_key_mapping (struct device *d)
1845 {
1846   Display *display = GDK_DISPLAY ();
1847   struct gtk_device *xd = DEVICE_GTK_DATA (d);
1848   XModifierKeymap *map = (XModifierKeymap *) xd->x_keysym_map;
1849   KeySym *keysym, *keysym_end;
1850   Lisp_Object hashtable;
1851   int key_code_count, keysyms_per_code;
1852
1853   if (map)
1854     XFree ((char *) map);
1855   XDisplayKeycodes (display,
1856                     &xd->x_keysym_map_min_code,
1857                     &xd->x_keysym_map_max_code);
1858   key_code_count = xd->x_keysym_map_max_code - xd->x_keysym_map_min_code + 1;
1859   map = (XModifierKeymap *)
1860     XGetKeyboardMapping (display, xd->x_keysym_map_min_code, key_code_count,
1861                          &xd->x_keysym_map_keysyms_per_code);
1862
1863   xd->x_keysym_map = (void *)map;
1864   hashtable = xd->x_keysym_map_hashtable;
1865   if (HASH_TABLEP (hashtable))
1866     {
1867       Fclrhash (hashtable);
1868     }
1869   else
1870     {
1871       xd->x_keysym_map_hashtable = hashtable =
1872         make_lisp_hash_table (128, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
1873     }
1874
1875   for (keysym = (KeySym *) map,
1876          keysyms_per_code = xd->x_keysym_map_keysyms_per_code,
1877          keysym_end = keysym + (key_code_count * keysyms_per_code);
1878        keysym < keysym_end;
1879        keysym += keysyms_per_code)
1880     {
1881       int j;
1882
1883       if (keysym[0] == NoSymbol)
1884         continue;
1885
1886       {
1887         char *name = XKeysymToString (keysym[0]);
1888         Lisp_Object sym = gtk_keysym_to_emacs_keysym (keysym[0], 0);
1889         if (name)
1890           {
1891             Fputhash (build_string (name), Qsans_modifiers, hashtable);
1892             Fputhash (sym, Qsans_modifiers, hashtable);
1893           }
1894       }
1895
1896       for (j = 1; j < keysyms_per_code; j++)
1897         {
1898           if (keysym[j] != keysym[0] &&
1899               keysym[j] != NoSymbol)
1900             {
1901               char *name = XKeysymToString (keysym[j]);
1902               Lisp_Object sym = gtk_keysym_to_emacs_keysym (keysym[j], 0);
1903               if (name && NILP (Fgethash (sym, hashtable, Qnil)))
1904                 {
1905                   Fputhash (build_string (name), Qt, hashtable);
1906                   Fputhash (sym, Qt, hashtable);
1907                 }
1908             }
1909         }
1910     }
1911 }
1912
1913 static const char *
1914 index_to_name (int indice)
1915 {
1916   switch (indice)
1917     {
1918     case ShiftMapIndex:   return "ModShift";
1919     case LockMapIndex:    return "ModLock";
1920     case ControlMapIndex: return "ModControl";
1921     case Mod1MapIndex:    return "Mod1";
1922     case Mod2MapIndex:    return "Mod2";
1923     case Mod3MapIndex:    return "Mod3";
1924     case Mod4MapIndex:    return "Mod4";
1925     case Mod5MapIndex:    return "Mod5";
1926     default:              return "???";
1927     }
1928 }
1929
1930 /* Boy, I really wish C had local functions... */
1931 struct c_doesnt_have_closures   /* #### not yet used */
1932 {
1933   int warned_about_overlapping_modifiers;
1934   int warned_about_predefined_modifiers;
1935   int warned_about_duplicate_modifiers;
1936   int meta_bit;
1937   int hyper_bit;
1938   int super_bit;
1939   int alt_bit;
1940   int mode_bit;
1941 };
1942
1943 static void
1944 gtk_reset_modifier_mapping (struct device *d)
1945 {
1946   Display *display = GDK_DISPLAY ();
1947   struct gtk_device *xd = DEVICE_GTK_DATA (d);
1948   int modifier_index, modifier_key, column, mkpm;
1949   int warned_about_overlapping_modifiers = 0;
1950   /*  int warned_about_predefined_modifiers  = 0; */
1951   /* int warned_about_duplicate_modifiers   = 0; */
1952   int meta_bit  = 0;
1953   int hyper_bit = 0;
1954   int super_bit = 0;
1955   int alt_bit   = 0;
1956   int mode_bit  = 0;
1957   XModifierKeymap *map = (XModifierKeymap *) xd->x_modifier_keymap;
1958
1959   xd->lock_interpretation = 0;
1960
1961   if (map)
1962     XFreeModifiermap (map);
1963
1964   gtk_reset_key_mapping (d);
1965
1966   xd->x_modifier_keymap = map = XGetModifierMapping (display);
1967
1968   /* Boy, I really wish C had local functions...
1969    */
1970
1971   /* The call to warn_when_safe must be on the same line as the string or
1972      make-msgfile won't pick it up properly (the newline doesn't confuse
1973      it, but the backslash does). */
1974
1975 #define store_modifier(name,old)                                           \
1976     old = modifier_index;
1977
1978   mkpm = map->max_keypermod;
1979   for (modifier_index = 0; modifier_index < 8; modifier_index++)
1980     for (modifier_key = 0; modifier_key < mkpm; modifier_key++) {
1981       KeySym last_sym = 0;
1982       for (column = 0; column < 4; column += 2) {
1983         KeyCode code = map->modifiermap[modifier_index * mkpm
1984                                                           + modifier_key];
1985         KeySym sym = (code ? XKeycodeToKeysym (display, code, column) : 0);
1986         if (sym == last_sym) continue;
1987         last_sym = sym;
1988         switch (sym) {
1989         case XK_Mode_switch:store_modifier ("Mode_switch", mode_bit); break;
1990         case XK_Meta_L:     store_modifier ("Meta_L", meta_bit); break;
1991         case XK_Meta_R:     store_modifier ("Meta_R", meta_bit); break;
1992         case XK_Super_L:    store_modifier ("Super_L", super_bit); break;
1993         case XK_Super_R:    store_modifier ("Super_R", super_bit); break;
1994         case XK_Hyper_L:    store_modifier ("Hyper_L", hyper_bit); break;
1995         case XK_Hyper_R:    store_modifier ("Hyper_R", hyper_bit); break;
1996         case XK_Alt_L:      store_modifier ("Alt_L", alt_bit); break;
1997         case XK_Alt_R:      store_modifier ("Alt_R", alt_bit); break;
1998 #if 0
1999         case XK_Control_L:  check_modifier ("Control_L", ControlMask); break;
2000         case XK_Control_R:  check_modifier ("Control_R", ControlMask); break;
2001         case XK_Shift_L:    check_modifier ("Shift_L", ShiftMask); break;
2002         case XK_Shift_R:    check_modifier ("Shift_R", ShiftMask); break;
2003 #endif
2004         case XK_Shift_Lock: /* check_modifier ("Shift_Lock", LockMask); */
2005           xd->lock_interpretation = XK_Shift_Lock; break;
2006         case XK_Caps_Lock:  /* check_modifier ("Caps_Lock", LockMask); */
2007           xd->lock_interpretation = XK_Caps_Lock; break;
2008
2009         /* It probably doesn't make any sense for a modifier bit to be
2010            assigned to a key that is not one of the above, but OpenWindows
2011            assigns modifier bits to a couple of random function keys for
2012            no reason that I can discern, so printing a warning here would
2013            be annoying. */
2014         }
2015       }
2016     }
2017 #undef store_modifier
2018 #undef check_modifier
2019 #undef modwarn
2020 #undef modbarf
2021
2022   /* If there was no Meta key, then try using the Alt key instead.
2023      If there is both a Meta key and an Alt key, then the Alt key
2024      is not disturbed and remains an Alt key. */
2025   if (! meta_bit && alt_bit)
2026     meta_bit = alt_bit, alt_bit = 0;
2027
2028   /* mode_bit overrides everything, since it's processed down inside of
2029      XLookupString() instead of by us.  If Meta and Mode_switch both
2030      generate the same modifier bit (which is an error), then we don't
2031      interpret that bit as Meta, because we can't make XLookupString()
2032      not interpret it as Mode_switch; and interpreting it as both would
2033      be totally wrong. */
2034   if (mode_bit)
2035     {
2036       const char *warn = 0;
2037       if      (mode_bit == meta_bit)  warn = "Meta",  meta_bit  = 0;
2038       else if (mode_bit == hyper_bit) warn = "Hyper", hyper_bit = 0;
2039       else if (mode_bit == super_bit) warn = "Super", super_bit = 0;
2040       else if (mode_bit == alt_bit)   warn = "Alt",   alt_bit   = 0;
2041       if (warn)
2042         {
2043           warn_when_safe
2044             (Qkey_mapping, Qwarning,
2045              "XEmacs:  %s is being used for both Mode_switch and %s.",
2046              index_to_name (mode_bit), warn),
2047             warned_about_overlapping_modifiers = 1;
2048         }
2049     }
2050 #undef index_to_name
2051
2052   xd->MetaMask   = (meta_bit   ? (1 << meta_bit)  : 0);
2053   xd->HyperMask  = (hyper_bit  ? (1 << hyper_bit) : 0);
2054   xd->SuperMask  = (super_bit  ? (1 << super_bit) : 0);
2055   xd->AltMask    = (alt_bit    ? (1 << alt_bit)   : 0);
2056   xd->ModeMask   = (mode_bit   ? (1 << mode_bit)  : 0); /* unused */
2057
2058 }
2059
2060 void
2061 gtk_init_modifier_mapping (struct device *d)
2062 {
2063   struct gtk_device *gd = DEVICE_GTK_DATA (d);
2064   gd->x_keysym_map_hashtable = Qnil;
2065   gd->x_keysym_map = NULL;
2066   gd->x_modifier_keymap = NULL;
2067   gtk_reset_modifier_mapping (d);
2068 }
2069
2070 #if 0
2071 static int
2072 gtk_key_is_modifier_p (KeyCode keycode, struct device *d)
2073 {
2074   struct gtk_device *xd = DEVICE_GTK_DATA (d);
2075   KeySym *syms;
2076   KeySym *map = (KeySym *) xd->x_keysym_map;
2077   int i;
2078
2079   if (keycode < xd->x_keysym_map_min_code ||
2080       keycode > xd->x_keysym_map_max_code)
2081     return 0;
2082
2083   syms = &map [(keycode - xd->x_keysym_map_min_code) *
2084               xd->x_keysym_map_keysyms_per_code];
2085   for (i = 0; i < xd->x_keysym_map_keysyms_per_code; i++)
2086     if (IsModifierKey (syms [i]) ||
2087         syms [i] == XK_Mode_switch) /* why doesn't IsModifierKey count this? */
2088       return 1;
2089   return 0;
2090 }
2091 #endif
2092
2093 struct _quit_predicate_closure {
2094   struct device *device;
2095   Bool *critical;
2096 };
2097
2098 static Bool
2099 quit_char_predicate (Display *display, XEvent *event, XPointer data)
2100 {
2101   struct _quit_predicate_closure *cl = (struct _quit_predicate_closure *) data;
2102   struct device *d = cl->device;
2103   struct frame *f = NULL;
2104   struct gtk_device *gd = DEVICE_GTK_DATA (d);
2105   char c, quit_char;
2106   Bool *critical = cl->critical;
2107   Lisp_Object keysym;
2108   GdkWindow *window = gdk_window_lookup (event->xany.window);
2109   guint32 keycode = 0;
2110   GdkEventKey gdk_event;
2111
2112   if (window)
2113     f = gtk_any_window_to_frame (d, window);
2114
2115   if (critical)
2116     *critical = False;
2117
2118   if ((event->type != KeyPress) ||
2119       (! window) ||
2120       (! f) ||
2121       (event->xkey.state
2122        & (gd->MetaMask | gd->HyperMask | gd->SuperMask | gd->AltMask)))
2123     {
2124       return 0;
2125     }
2126
2127   {
2128     char dummy[256];
2129     XLookupString (&(event->xkey), dummy, 200, (KeySym *)&keycode, 0);
2130   }
2131
2132   memset (&gdk_event, 0, sizeof (gdk_event));
2133   gdk_event.type = GDK_KEY_PRESS;
2134   gdk_event.window = window;
2135   gdk_event.keyval = keycode;
2136   gdk_event.state = event->xkey.state;
2137
2138   /* This duplicates some code that exists elsewhere, but it's relatively
2139      fast and doesn't cons. */
2140   keysym = gtk_to_emacs_keysym (d, &gdk_event, 1);
2141   if (NILP (keysym)) return 0;
2142   if (CHAR_OR_CHAR_INTP (keysym))
2143     c = XCHAR_OR_CHAR_INT (keysym);
2144   /* Highly doubtful that these are the quit character, but... */
2145   else if (EQ (keysym, QKbackspace))    c = '\b';
2146   else if (EQ (keysym, QKtab))          c = '\t';
2147   else if (EQ (keysym, QKlinefeed))     c = '\n';
2148   else if (EQ (keysym, QKreturn))       c = '\r';
2149   else if (EQ (keysym, QKescape))       c = 27;
2150   else if (EQ (keysym, QKspace))        c = ' ';
2151   else if (EQ (keysym, QKdelete))       c = 127;
2152   else return 0;
2153
2154   if (event->xkey.state & gd->MetaMask)     c |= 0x80;
2155   if ((event->xkey.state & ControlMask) && !(c >= 'A' && c <= 'Z'))
2156     c &= 0x1F;                  /* unshifted control characters */
2157   quit_char = CONSOLE_QUIT_CHAR (XCONSOLE (DEVICE_CONSOLE (d)));
2158
2159   if (c == quit_char)
2160     return True;
2161   /* If we've got Control-Shift-G instead of Control-G, that means
2162      we have a critical_quit.  Caps_Lock is its own modifier, so it
2163      won't cause ^G to act differently than before. */
2164   if (event->xkey.state & ControlMask)  c &= 0x1F;
2165   if (c == quit_char)
2166     {
2167       if (critical) *critical = True;
2168       return True;
2169     }
2170   return False;
2171 }
2172
2173 static void
2174 gtk_check_for_quit_char (struct device *d)
2175 {
2176   XEvent event;
2177   int queued;
2178   Bool critical_quit = False;
2179   struct _quit_predicate_closure closure;
2180
2181   XEventsQueued (GDK_DISPLAY (), QueuedAfterReading);
2182
2183   closure.device = d;
2184   closure.critical = &critical_quit;
2185
2186   queued = XCheckIfEvent (GDK_DISPLAY (), &event, quit_char_predicate, (char *) &closure);
2187
2188   if (queued)
2189     {
2190       Vquit_flag = (critical_quit ? Qcritical : Qt);
2191     }
2192 }