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