src/events.c

   1 /* Events: printing them, converting them to and from characters.
   2    Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
   3    Copyright (C) 1994, 1995 Board of Trustees, University of Illinois.
   4
   5 This file is part of XEmacs.
   6
   7 XEmacs is free software; you can redistribute it and/or modify it
   8 under the terms of the GNU General Public License as published by the
   9 Free Software Foundation; either version 2, or (at your option) any
  10 later version.
  11
  12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
  13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  14 FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  15 for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with XEmacs; see the file COPYING.  If not, write to
  19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 Boston, MA 02111-1307, USA.  */
  21
  22 /* Synched up with: Not in FSF. */
  23
  24 /* This file has been Mule-ized. */
  25
  26 #include <config.h>
  27 #include "lisp.h"
  28 #include "buffer.h"
  29 #include "console.h"
  30 #include "console-tty.h" /* for stuff in character_to_event */
  31 #include "device.h"
  32 #include "console-x.h"  /* for x_event_name prototype */
  33 #include "console-gtk.h" /* for gtk_event_name prototype */
  34 #include "extents.h"    /* Just for the EXTENTP ABORT check... */
  35 #include "events.h"
  36 #include "frame.h"
  37 #include "glyphs.h"
  38 #include "keymap.h" /* for key_desc_list_to_event() */
  39 #include "redisplay.h"
  40 #include "window.h"
  41 #include "events-mod.h"
  42
  43 /* Where old events go when they are explicitly deallocated.
  44    The event chain here is cut loose before GC, so these will be freed
  45    eventually.
  46  */
  47 static Lisp_Object Vevent_resource;
  48
  49 Lisp_Object Qeventp;
  50 Lisp_Object Qevent_live_p;
  51 Lisp_Object Qkey_press_event_p;
  52 Lisp_Object Qbutton_event_p;
  53 Lisp_Object Qmouse_event_p;
  54 Lisp_Object Qprocess_event_p;
  55
  56 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
  57 Lisp_Object Qascii_character;
  58
  59 EXFUN (Fevent_x_pixel, 1);
  60 EXFUN (Fevent_y_pixel, 1);
  61
  62 /* #### Ad-hoc hack.  Should be part of define_lrecord_implementation */
  63 void
  64 clear_event_resource (void)
  65 {
  66   Vevent_resource = Qnil;
  67 }
  68
  69 /* Make sure we lose quickly if we try to use this event */
  70 static void
  71 deinitialize_event (Lisp_Object ev)
  72 {
  73   int i;
  74   Lisp_Event *event = XEVENT (ev);
  75
  76   for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++)
  77     ((int *) event) [i] = 0xdeadbeef;
  78   event->event_type = dead_event;
  79   event->channel = Qnil;
  80   set_lheader_implementation (&event->lheader, &lrecord_event);
  81   XSET_EVENT_NEXT (ev, Qnil);
  82 }
  83
  84 /* Set everything to zero or nil so that it's predictable. */
  85 void
  86 zero_event (Lisp_Event *e)
  87 {
  88   xzero (*e);
  89   set_lheader_implementation (&e->lheader, &lrecord_event);
  90   e->event_type = empty_event;
  91   e->next = Qnil;
  92   e->channel = Qnil;
  93 }
  94
  95 static Lisp_Object
  96 mark_event (Lisp_Object obj)
  97 {
  98   Lisp_Event *event = XEVENT (obj);
  99
 100   switch (event->event_type)
 101     {
 102     case key_press_event:
 103       mark_object (event->event.key.keysym);
 104       break;
 105     case process_event:
 106       mark_object (event->event.process.process);
 107       break;
 108     case timeout_event:
 109       mark_object (event->event.timeout.function);
 110       mark_object (event->event.timeout.object);
 111       break;
 112     case eval_event:
 113     case misc_user_event:
 114       mark_object (event->event.eval.function);
 115       mark_object (event->event.eval.object);
 116       break;
 117     case magic_eval_event:
 118       mark_object (event->event.magic_eval.object);
 119       break;
 120     case button_press_event:
 121     case button_release_event:
 122     case pointer_motion_event:
 123     case magic_event:
 124     case empty_event:
 125     case dead_event:
 126       break;
 127     default:
 128       ABORT ();
 129     }
 130   mark_object (event->channel);
 131   return event->next;
 132 }
 133
 134 static void
 135 print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun)
 136 {
 137   char buf[255];
 138   write_c_string (str, printcharfun);
 139   format_event_object (buf, XEVENT (obj), 0);
 140   write_c_string (buf, printcharfun);
 141 }
 142
 143 static void
 144 print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 145 {
 146   if (print_readably)
 147     error ("Printing unreadable object #<event>");
 148
 149   switch (XEVENT (obj)->event_type)
 150     {
 151     case key_press_event:
 152       print_event_1 ("#<keypress-event ", obj, printcharfun);
 153       break;
 154     case button_press_event:
 155       print_event_1 ("#<buttondown-event ", obj, printcharfun);
 156       break;
 157     case button_release_event:
 158       print_event_1 ("#<buttonup-event ", obj, printcharfun);
 159       break;
 160     case magic_event:
 161     case magic_eval_event:
 162       print_event_1 ("#<magic-event ", obj, printcharfun);
 163       break;
 164     case pointer_motion_event:
 165       {
 166         char buf[64];
 167         Lisp_Object Vx, Vy;
 168         Vx = Fevent_x_pixel (obj);
 169         assert (INTP (Vx));
 170         Vy = Fevent_y_pixel (obj);
 171         assert (INTP (Vy));
 172         sprintf (buf, "#<motion-event %ld, %ld", (long) XINT (Vx), (long) XINT (Vy));
 173         write_c_string (buf, printcharfun);
 174         break;
 175       }
 176     case process_event:
 177         write_c_string ("#<process-event ", printcharfun);
 178         print_internal (XEVENT (obj)->event.process.process, printcharfun, 1);
 179         break;
 180     case timeout_event:
 181         write_c_string ("#<timeout-event ", printcharfun);
 182         print_internal (XEVENT (obj)->event.timeout.object, printcharfun, 1);
 183         break;
 184     case empty_event:
 185         write_c_string ("#<empty-event", printcharfun);
 186         break;
 187     case misc_user_event:
 188         write_c_string ("#<misc-user-event (", printcharfun);
 189         print_internal (XEVENT (obj)->event.misc.function, printcharfun, 1);
 190         write_c_string (" ", printcharfun);
 191         print_internal (XEVENT (obj)->event.misc.object, printcharfun, 1);
 192         write_c_string (")", printcharfun);
 193         break;
 194     case eval_event:
 195         write_c_string ("#<eval-event (", printcharfun);
 196         print_internal (XEVENT (obj)->event.eval.function, printcharfun, 1);
 197         write_c_string (" ", printcharfun);
 198         print_internal (XEVENT (obj)->event.eval.object, printcharfun, 1);
 199         write_c_string (")", printcharfun);
 200         break;
 201     case dead_event:
 202         write_c_string ("#<DEALLOCATED-EVENT", printcharfun);
 203         break;
 204     default:
 205         write_c_string ("#<UNKNOWN-EVENT-TYPE", printcharfun);
 206         break;
 207       }
 208   write_c_string (">", printcharfun);
 209 }
 210
 211 static int
 212 event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 213 {
 214   Lisp_Event *e1 = XEVENT (obj1);
 215   Lisp_Event *e2 = XEVENT (obj2);
 216
 217   if (e1->event_type != e2->event_type) return 0;
 218   if (!EQ (e1->channel, e2->channel)) return 0;
 219 /*  if (e1->timestamp != e2->timestamp) return 0; */
 220   switch (e1->event_type)
 221     {
 222     default: ABORT ();
 223
 224     case process_event:
 225       return EQ (e1->event.process.process, e2->event.process.process);
 226
 227     case timeout_event:
 228       return (internal_equal (e1->event.timeout.function,
 229                               e2->event.timeout.function, 0) &&
 230               internal_equal (e1->event.timeout.object,
 231                               e2->event.timeout.object, 0));
 232
 233     case key_press_event:
 234       return (EQ (e1->event.key.keysym, e2->event.key.keysym) &&
 235               (e1->event.key.modifiers == e2->event.key.modifiers));
 236
 237     case button_press_event:
 238     case button_release_event:
 239       return (e1->event.button.button    == e2->event.button.button &&
 240               e1->event.button.modifiers == e2->event.button.modifiers);
 241
 242     case pointer_motion_event:
 243       return (e1->event.motion.x == e2->event.motion.x &&
 244               e1->event.motion.y == e2->event.motion.y);
 245
 246     case misc_user_event:
 247       return (internal_equal (e1->event.eval.function,
 248                               e2->event.eval.function, 0) &&
 249               internal_equal (e1->event.eval.object,
 250                               e2->event.eval.object, 0) &&
 251               /* is this really needed for equality
 252                  or is x and y also important? */
 253               e1->event.misc.button    == e2->event.misc.button &&
 254               e1->event.misc.modifiers == e2->event.misc.modifiers);
 255
 256     case eval_event:
 257       return (internal_equal (e1->event.eval.function,
 258                               e2->event.eval.function, 0) &&
 259               internal_equal (e1->event.eval.object,
 260                               e2->event.eval.object, 0));
 261
 262     case magic_eval_event:
 263       return (e1->event.magic_eval.internal_function ==
 264               e2->event.magic_eval.internal_function &&
 265               internal_equal (e1->event.magic_eval.object,
 266                               e2->event.magic_eval.object, 0));
 267
 268     case magic_event:
 269       {
 270         struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel));
 271
 272 #ifdef HAVE_GTK
 273         if (CONSOLE_GTK_P (con))
 274           return (!memcmp (&e1->event.magic.underlying_gdk_event,
 275                            &e2->event.magic.underlying_gdk_event,
 276                            sizeof (GdkEvent)));
 277 #endif
 278 #ifdef HAVE_X_WINDOWS
 279         if (CONSOLE_X_P (con))
 280           return (e1->event.magic.underlying_x_event.xany.serial ==
 281                   e2->event.magic.underlying_x_event.xany.serial);
 282 #endif
 283 #ifdef HAVE_TTY
 284         if (CONSOLE_TTY_P (con))
 285           return (e1->event.magic.underlying_tty_event ==
 286                   e2->event.magic.underlying_tty_event);
 287 #endif
 288 #ifdef HAVE_MS_WINDOWS
 289         if (CONSOLE_MSWINDOWS_P (con))
 290           return (!memcmp(&e1->event.magic.underlying_mswindows_event,
 291                           &e2->event.magic.underlying_mswindows_event,
 292                           sizeof (union magic_data)));
 293 #endif
 294         ABORT ();
 295         return 1; /* not reached */
 296       }
 297
 298     case empty_event:      /* Empty and deallocated events are equal. */
 299     case dead_event:
 300       return 1;
 301     }
 302 }
 303
 304 static unsigned long
 305 event_hash (Lisp_Object obj, int depth)
 306 {
 307   Lisp_Event *e = XEVENT (obj);
 308   unsigned long hash;
 309
 310   hash = HASH2 (e->event_type, LISP_HASH (e->channel));
 311   switch (e->event_type)
 312     {
 313     case process_event:
 314       return HASH2 (hash, LISP_HASH (e->event.process.process));
 315
 316     case timeout_event:
 317       return HASH3 (hash, internal_hash (e->event.timeout.function, depth + 1),
 318                     internal_hash (e->event.timeout.object, depth + 1));
 319
 320     case key_press_event:
 321       return HASH3 (hash, LISP_HASH (e->event.key.keysym),
 322                     e->event.key.modifiers);
 323
 324     case button_press_event:
 325     case button_release_event:
 326       return HASH3 (hash, e->event.button.button, e->event.button.modifiers);
 327
 328     case pointer_motion_event:
 329       return HASH3 (hash, e->event.motion.x, e->event.motion.y);
 330
 331     case misc_user_event:
 332       return HASH5 (hash, internal_hash (e->event.misc.function, depth + 1),
 333                     internal_hash (e->event.misc.object, depth + 1),
 334                     e->event.misc.button, e->event.misc.modifiers);
 335
 336     case eval_event:
 337       return HASH3 (hash, internal_hash (e->event.eval.function, depth + 1),
 338                     internal_hash (e->event.eval.object, depth + 1));
 339
 340     case magic_eval_event:
 341       return HASH3 (hash,
 342                     (unsigned long) e->event.magic_eval.internal_function,
 343                     internal_hash (e->event.magic_eval.object, depth + 1));
 344
 345     case magic_event:
 346       {
 347         struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e)));
 348 #ifdef HAVE_GTK
 349         if (CONSOLE_GTK_P (con))
 350           return HASH2 (hash, e->event.magic.underlying_gdk_event.type);
 351 #endif
 352 #ifdef HAVE_X_WINDOWS
 353         if (CONSOLE_X_P (con))
 354           return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial);
 355 #endif
 356 #ifdef HAVE_TTY
 357         if (CONSOLE_TTY_P (con))
 358           return HASH2 (hash, e->event.magic.underlying_tty_event);
 359 #endif
 360 #ifdef HAVE_MS_WINDOWS
 361         if (CONSOLE_MSWINDOWS_P (con))
 362           return HASH2 (hash, e->event.magic.underlying_mswindows_event);
 363 #endif
 364         ABORT ();
 365         return 0;
 366       }
 367
 368     case empty_event:
 369     case dead_event:
 370       return hash;
 371
 372     default:
 373       ABORT ();
 374     }
 375
 376   return 0; /* unreached */
 377 }
 378
 379 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event,
 380                                      mark_event, print_event, 0, event_equal,
 381                                      event_hash, 0, Lisp_Event);
 382
 383 \f
 384 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
 385 Return a new event of type TYPE, with properties described by PLIST.
 386
 387 TYPE is a symbol, either `empty', `key-press', `button-press',
 388  `button-release', `misc-user' or `motion'.  If TYPE is nil, it
 389  defaults to `empty'.
 390
 391 PLIST is a property list, the properties being compatible to those
 392  returned by `event-properties'.  The following properties are
 393  allowed:
 394
 395  channel        -- The event channel, a frame or a console.  For
 396                    button-press, button-release, misc-user and motion events,
 397                    this must be a frame.  For key-press events, it must be
 398                    a console.  If channel is unspecified, it will be set to
 399                    the selected frame or selected console, as appropriate.
 400  key            -- The event key, a symbol or character.  Allowed only for
 401                    keypress events.
 402  button         -- The event button, integer 1, 2 or 3.  Allowed for
 403                    button-press, button-release and misc-user events.
 404  modifiers      -- The event modifiers, a list of modifier symbols.  Allowed
 405                    for key-press, button-press, button-release, motion and
 406                    misc-user events.
 407  function       -- Function. Allowed for misc-user events only.
 408  object         -- An object, function's parameter. Allowed for misc-user
 409                    events only.
 410  x              -- The event X coordinate, an integer.  This is relative
 411                    to the left of CHANNEL's root window.  Allowed for
 412                    motion, button-press, button-release and misc-user events.
 413  y              -- The event Y coordinate, an integer.  This is relative
 414                    to the top of CHANNEL's root window.  Allowed for
 415                    motion, button-press, button-release and misc-user events.
 416  timestamp      -- The event timestamp, a non-negative integer.  Allowed for
 417                    all types of events.  If unspecified, it will be set to 0
 418                    by default.
 419
 420 For event type `empty', PLIST must be nil.
 421  `button-release', or `motion'.  If TYPE is left out, it defaults to
 422  `empty'.
 423 PLIST is a list of properties, as returned by `event-properties'.  Not
 424  all properties are allowed for all kinds of events, and some are
 425  required.
 426
 427 WARNING: the event object returned may be a reused one; see the function
 428  `deallocate-event'.
 429 */
 430        (type, plist))
 431 {
 432   Lisp_Object event = Qnil;
 433   Lisp_Event *e;
 434   EMACS_INT coord_x = 0, coord_y = 0;
 435   struct gcpro gcpro1;
 436
 437   GCPRO1 (event);
 438
 439   if (NILP (type))
 440     type = Qempty;
 441
 442   if (!NILP (Vevent_resource))
 443     {
 444       event = Vevent_resource;
 445       Vevent_resource = XEVENT_NEXT (event);
 446     }
 447   else
 448     {
 449       event = allocate_event ();
 450     }
 451   e = XEVENT (event);
 452   zero_event (e);
 453
 454   if (EQ (type, Qempty))
 455     {
 456       /* For empty event, we return immediately, without processing
 457          PLIST.  In fact, processing PLIST would be wrong, because the
 458          sanitizing process would fill in the properties
 459          (e.g. CHANNEL), which we don't want in empty events.  */
 460       e->event_type = empty_event;
 461       if (!NILP (plist))
 462         syntax_error ("Cannot set properties of empty event", plist);
 463       UNGCPRO;
 464       return event;
 465     }
 466   else if (EQ (type, Qkey_press))
 467     {
 468       e->event_type = key_press_event;
 469       e->event.key.keysym = Qunbound;
 470     }
 471   else if (EQ (type, Qbutton_press))
 472     e->event_type = button_press_event;
 473   else if (EQ (type, Qbutton_release))
 474     e->event_type = button_release_event;
 475   else if (EQ (type, Qmotion))
 476     e->event_type = pointer_motion_event;
 477   else if (EQ (type, Qmisc_user))
 478     {
 479       e->event_type = misc_user_event;
 480       e->event.eval.function = e->event.eval.object = Qnil;
 481     }
 482   else
 483     {
 484       /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval.  */
 485       invalid_argument ("Invalid event type", type);
 486     }
 487
 488   EVENT_CHANNEL (e) = Qnil;
 489
 490   plist = Fcopy_sequence (plist);
 491   Fcanonicalize_plist (plist, Qnil);
 492
 493 #define WRONG_EVENT_TYPE_FOR_PROPERTY(event_type, prop) \
 494   syntax_error_2 ("Invalid property for event type", prop, event_type)
 495
 496   {
 497     EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist)
 498       {
 499         if (EQ (keyword, Qchannel))
 500           {
 501             if (e->event_type == key_press_event)
 502               {
 503                 if (!CONSOLEP (value))
 504                   value = wrong_type_argument (Qconsolep, value);
 505               }
 506             else
 507               {
 508                 if (!FRAMEP (value))
 509                   value = wrong_type_argument (Qframep, value);
 510               }
 511             EVENT_CHANNEL (e) = value;
 512           }
 513         else if (EQ (keyword, Qkey))
 514           {
 515             switch (e->event_type)
 516               {
 517               case key_press_event:
 518                 if (!SYMBOLP (value) && !CHARP (value))
 519                   syntax_error ("Invalid event key", value);
 520                 e->event.key.keysym = value;
 521                 break;
 522               default:
 523                 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
 524                 break;
 525               }
 526           }
 527         else if (EQ (keyword, Qbutton))
 528           {
 529             CHECK_NATNUM (value);
 530             check_int_range (XINT (value), 0, 7);
 531
 532             switch (e->event_type)
 533               {
 534               case button_press_event:
 535               case button_release_event:
 536                 e->event.button.button = XINT (value);
 537                 break;
 538               case misc_user_event:
 539                 e->event.misc.button = XINT (value);
 540                 break;
 541               default:
 542                 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
 543                 break;
 544               }
 545           }
 546         else if (EQ (keyword, Qmodifiers))
 547           {
 548             int modifiers = 0;
 549
 550             EXTERNAL_LIST_LOOP_2 (sym, value)
 551               {
 552                 if      (EQ (sym, Qcontrol)) modifiers |= XEMACS_MOD_CONTROL;
 553                 else if (EQ (sym, Qmeta))    modifiers |= XEMACS_MOD_META;
 554                 else if (EQ (sym, Qsuper))   modifiers |= XEMACS_MOD_SUPER;
 555                 else if (EQ (sym, Qhyper))   modifiers |= XEMACS_MOD_HYPER;
 556                 else if (EQ (sym, Qalt))     modifiers |= XEMACS_MOD_ALT;
 557                 else if (EQ (sym, Qsymbol))  modifiers |= XEMACS_MOD_ALT;
 558                 else if (EQ (sym, Qshift))   modifiers |= XEMACS_MOD_SHIFT;
 559                 else if (EQ (sym, Qbutton1))   modifiers |= XEMACS_MOD_BUTTON1;
 560                 else if (EQ (sym, Qbutton2))   modifiers |= XEMACS_MOD_BUTTON2;
 561                 else if (EQ (sym, Qbutton3))   modifiers |= XEMACS_MOD_BUTTON3;
 562                 else if (EQ (sym, Qbutton4))   modifiers |= XEMACS_MOD_BUTTON4;
 563                 else if (EQ (sym, Qbutton5))   modifiers |= XEMACS_MOD_BUTTON5;
 564                 else
 565                   syntax_error ("Invalid key modifier", sym);
 566               }
 567
 568             switch (e->event_type)
 569               {
 570               case key_press_event:
 571                 e->event.key.modifiers = modifiers;
 572                 break;
 573               case button_press_event:
 574               case button_release_event:
 575                 e->event.button.modifiers = modifiers;
 576                 break;
 577               case pointer_motion_event:
 578                 e->event.motion.modifiers = modifiers;
 579                 break;
 580               case misc_user_event:
 581                 e->event.misc.modifiers = modifiers;
 582                 break;
 583               default:
 584                 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
 585                 break;
 586               }
 587           }
 588         else if (EQ (keyword, Qx))
 589           {
 590             switch (e->event_type)
 591               {
 592               case pointer_motion_event:
 593               case button_press_event:
 594               case button_release_event:
 595               case misc_user_event:
 596                 /* Allow negative values, so we can specify toolbar
 597                    positions.  */
 598                 CHECK_INT (value);
 599                 coord_x = XINT (value);
 600                 break;
 601               default:
 602                 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
 603                 break;
 604               }
 605           }
 606         else if (EQ (keyword, Qy))
 607           {
 608             switch (e->event_type)
 609               {
 610               case pointer_motion_event:
 611               case button_press_event:
 612               case button_release_event:
 613               case misc_user_event:
 614                 /* Allow negative values; see above. */
 615                 CHECK_INT (value);
 616                 coord_y = XINT (value);
 617                 break;
 618               default:
 619                 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
 620                 break;
 621               }
 622           }
 623         else if (EQ (keyword, Qtimestamp))
 624           {
 625             CHECK_NATNUM (value);
 626             e->timestamp = XINT (value);
 627           }
 628         else if (EQ (keyword, Qfunction))
 629           {
 630             switch (e->event_type)
 631               {
 632               case misc_user_event:
 633                 e->event.eval.function = value;
 634                 break;
 635               default:
 636                 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
 637                 break;
 638               }
 639           }
 640         else if (EQ (keyword, Qobject))
 641           {
 642             switch (e->event_type)
 643               {
 644               case misc_user_event:
 645                 e->event.eval.object = value;
 646                 break;
 647               default:
 648                 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
 649                 break;
 650               }
 651           }
 652         else
 653           syntax_error_2 ("Invalid property", keyword, value);
 654       }
 655   }
 656
 657   /* Insert the channel, if missing. */
 658   if (NILP (EVENT_CHANNEL (e)))
 659     {
 660       if (e->event_type == key_press_event)
 661         EVENT_CHANNEL (e) = Vselected_console;
 662       else
 663         EVENT_CHANNEL (e) = Fselected_frame (Qnil);
 664     }
 665
 666   /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
 667      to the frame, so we must adjust accordingly.  */
 668   if (FRAMEP (EVENT_CHANNEL (e)))
 669     {
 670       coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e)));
 671       coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e)));
 672
 673       switch (e->event_type)
 674         {
 675         case pointer_motion_event:
 676           e->event.motion.x = coord_x;
 677           e->event.motion.y = coord_y;
 678           break;
 679         case button_press_event:
 680         case button_release_event:
 681           e->event.button.x = coord_x;
 682           e->event.button.y = coord_y;
 683           break;
 684         case misc_user_event:
 685           e->event.misc.x = coord_x;
 686           e->event.misc.y = coord_y;
 687           break;
 688         default:
 689           ABORT();
 690         }
 691     }
 692
 693   /* Finally, do some more validation.  */
 694   switch (e->event_type)
 695     {
 696     case key_press_event:
 697       if (UNBOUNDP (e->event.key.keysym))
 698         syntax_error ("A key must be specified to make a keypress event",
 699                       plist);
 700       break;
 701     case button_press_event:
 702       if (!e->event.button.button)
 703         syntax_error
 704           ("A button must be specified to make a button-press event",
 705            plist);
 706       break;
 707     case button_release_event:
 708       if (!e->event.button.button)
 709         syntax_error
 710           ("A button must be specified to make a button-release event",
 711            plist);
 712       break;
 713     case misc_user_event:
 714       if (NILP (e->event.misc.function))
 715         syntax_error ("A function must be specified to make a misc-user event",
 716                       plist);
 717       break;
 718     default:
 719       break;
 720     }
 721
 722   UNGCPRO;
 723   return event;
 724 }
 725
 726 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
 727 Allow the given event structure to be reused.
 728 You MUST NOT use this event object after calling this function with it.
 729 You will lose.  It is not necessary to call this function, as event
 730 objects are garbage-collected like all other objects; however, it may
 731 be more efficient to explicitly deallocate events when you are sure
 732 that it is safe to do so.
 733 */
 734        (event))
 735 {
 736   CHECK_EVENT (event);
 737
 738   if (XEVENT_TYPE (event) == dead_event)
 739     error ("this event is already deallocated!");
 740
 741   assert (XEVENT_TYPE (event) <= last_event_type);
 742
 743 #if 0
 744   {
 745     int i, len;
 746
 747     if (EQ (event, Vlast_command_event) ||
 748         EQ (event, Vlast_input_event)   ||
 749         EQ (event, Vunread_command_event))
 750       ABORT ();
 751
 752     len = XVECTOR_LENGTH (Vthis_command_keys);
 753     for (i = 0; i < len; i++)
 754       if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i]))
 755         ABORT ();
 756     if (!NILP (Vrecent_keys_ring))
 757       {
 758         int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring);
 759         for (i = 0; i < recent_ring_len; i++)
 760           if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i]))
 761             ABORT ();
 762       }
 763   }
 764 #endif /* 0 */
 765
 766   assert (!EQ (event, Vevent_resource));
 767   deinitialize_event (event);
 768 #ifndef ALLOC_NO_POOLS
 769   XSET_EVENT_NEXT (event, Vevent_resource);
 770   Vevent_resource = event;
 771 #endif
 772   return Qnil;
 773 }
 774
 775 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /*
 776 Make a copy of the event object EVENT1.
 777 If a second event argument EVENT2 is given, EVENT1 is copied into
 778 EVENT2 and EVENT2 is returned.  If EVENT2 is not supplied (or is nil)
 779 then a new event will be made as with `make-event'.  See also the
 780 function `deallocate-event'.
 781 */
 782        (event1, event2))
 783 {
 784   CHECK_LIVE_EVENT (event1);
 785   if (NILP (event2))
 786     event2 = Fmake_event (Qnil, Qnil);
 787   else
 788     {
 789       CHECK_LIVE_EVENT (event2);
 790       if (EQ (event1, event2))
 791         return signal_simple_continuable_error_2
 792           ("copy-event called with `eq' events", event1, event2);
 793     }
 794
 795   assert (XEVENT_TYPE (event1) <= last_event_type);
 796   assert (XEVENT_TYPE (event2) <= last_event_type);
 797
 798   {
 799     Lisp_Event *ev2 = XEVENT (event2);
 800     Lisp_Event *ev1 = XEVENT (event1);
 801
 802     ev2->event_type = ev1->event_type;
 803     ev2->channel    = ev1->channel;
 804     ev2->timestamp  = ev1->timestamp;
 805     ev2->event      = ev1->event;
 806
 807     return event2;
 808   }
 809 }
 810
 811 \f
 812
 813 /* Given a chain of events (or possibly nil), deallocate them all. */
 814
 815 void
 816 deallocate_event_chain (Lisp_Object event_chain)
 817 {
 818   while (!NILP (event_chain))
 819     {
 820       Lisp_Object next = XEVENT_NEXT (event_chain);
 821       Fdeallocate_event (event_chain);
 822       event_chain = next;
 823     }
 824 }
 825
 826 /* Return the last event in a chain.
 827    NOTE: You cannot pass nil as a value here!  The routine will
 828    ABORT if you do. */
 829
 830 Lisp_Object
 831 event_chain_tail (Lisp_Object event_chain)
 832 {
 833   while (1)
 834     {
 835       Lisp_Object next = XEVENT_NEXT (event_chain);
 836       if (NILP (next))
 837         return event_chain;
 838       event_chain = next;
 839     }
 840 }
 841
 842 /* Enqueue a single event onto the end of a chain of events.
 843    HEAD points to the first event in the chain, TAIL to the last event.
 844    If the chain is empty, both values should be nil. */
 845
 846 void
 847 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail)
 848 {
 849   assert (NILP (XEVENT_NEXT (event)));
 850   assert (!EQ (*tail, event));
 851
 852   if (!NILP (*tail))
 853     XSET_EVENT_NEXT (*tail, event);
 854   else
 855    *head = event;
 856   *tail = event;
 857
 858   assert (!EQ (event, XEVENT_NEXT (event)));
 859 }
 860
 861 /* Remove an event off the head of a chain of events and return it.
 862    HEAD points to the first event in the chain, TAIL to the last event. */
 863
 864 Lisp_Object
 865 dequeue_event (Lisp_Object *head, Lisp_Object *tail)
 866 {
 867   Lisp_Object event;
 868
 869   event = *head;
 870   *head = XEVENT_NEXT (event);
 871   XSET_EVENT_NEXT (event, Qnil);
 872   if (NILP (*head))
 873     *tail = Qnil;
 874   return event;
 875 }
 876
 877 /* Enqueue a chain of events (or possibly nil) onto the end of another
 878    chain of events.  HEAD points to the first event in the chain being
 879    queued onto, TAIL to the last event.  If the chain is empty, both values
 880    should be nil. */
 881
 882 void
 883 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head,
 884                      Lisp_Object *tail)
 885 {
 886   if (NILP (event_chain))
 887     return;
 888
 889   if (NILP (*head))
 890     {
 891       *head = event_chain;
 892       *tail = event_chain;
 893     }
 894   else
 895     {
 896       XSET_EVENT_NEXT (*tail, event_chain);
 897       *tail = event_chain_tail (event_chain);
 898     }
 899 }
 900
 901 /* Return the number of events (possibly 0) on an event chain. */
 902
 903 int
 904 event_chain_count (Lisp_Object event_chain)
 905 {
 906   Lisp_Object event;
 907   int n = 0;
 908
 909   EVENT_CHAIN_LOOP (event, event_chain)
 910     n++;
 911
 912   return n;
 913 }
 914
 915 /* Find the event before EVENT in an event chain.  This ABORTs
 916    if the event is not in the chain. */
 917
 918 Lisp_Object
 919 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event)
 920 {
 921   Lisp_Object previous = Qnil;
 922
 923   while (!NILP (event_chain))
 924     {
 925       if (EQ (event_chain, event))
 926         return previous;
 927       previous = event_chain;
 928       event_chain = XEVENT_NEXT (event_chain);
 929     }
 930
 931   ABORT ();
 932   return Qnil;
 933 }
 934
 935 Lisp_Object
 936 event_chain_nth (Lisp_Object event_chain, int n)
 937 {
 938   Lisp_Object event;
 939   EVENT_CHAIN_LOOP (event, event_chain)
 940     {
 941       if (!n)
 942         return event;
 943       n--;
 944     }
 945   return Qnil;
 946 }
 947
 948 Lisp_Object
 949 copy_event_chain (Lisp_Object event_chain)
 950 {
 951   Lisp_Object new_chain = Qnil;
 952   Lisp_Object new_chain_tail = Qnil;
 953   Lisp_Object event;
 954
 955   EVENT_CHAIN_LOOP (event, event_chain)
 956     {
 957       Lisp_Object copy = Fcopy_event (event, Qnil);
 958       enqueue_event (copy, &new_chain, &new_chain_tail);
 959     }
 960
 961   return new_chain;
 962 }
 963
 964 \f
 965
 966 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape,
 967  QKspace, QKdelete;
 968
 969 int
 970 command_event_p (Lisp_Object event)
 971 {
 972   switch (XEVENT_TYPE (event))
 973     {
 974     case key_press_event:
 975     case button_press_event:
 976     case button_release_event:
 977     case misc_user_event:
 978       return 1;
 979     default:
 980       return 0;
 981     }
 982 }
 983
 984
 985 void
 986 character_to_event (Emchar c, Lisp_Event *event, struct console *con,
 987                     int use_console_meta_flag, int do_backspace_mapping)
 988 {
 989   Lisp_Object k = Qnil;
 990   int m = 0;
 991   if (event->event_type == dead_event)
 992     error ("character-to-event called with a deallocated event!");
 993
 994 #ifndef MULE
 995   c &= 255;
 996 #endif
 997   if (c > 127 && c <= 255)
 998     {
 999       int meta_flag = 1;
1000       if (use_console_meta_flag && CONSOLE_TTY_P (con))
1001         meta_flag = TTY_FLAGS (con).meta_key;
1002       switch (meta_flag)
1003         {
1004         case 0: /* ignore top bit; it's parity */
1005           c -= 128;
1006           break;
1007         case 1: /* top bit is meta */
1008           c -= 128;
1009           m = XEMACS_MOD_META;
1010           break;
1011         default: /* this is a real character */
1012           break;
1013         }
1014     }
1015   if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL;
1016   if (m & XEMACS_MOD_CONTROL)
1017     {
1018       switch (c)
1019         {
1020         case 'I': k = QKtab;      m &= ~XEMACS_MOD_CONTROL; break;
1021         case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break;
1022         case 'M': k = QKreturn;   m &= ~XEMACS_MOD_CONTROL; break;
1023         case '[': k = QKescape;   m &= ~XEMACS_MOD_CONTROL; break;
1024         default:
1025 #if defined(HAVE_TTY)
1026           if (do_backspace_mapping &&
1027               CHARP (con->tty_erase_char) &&
1028               c - '@' == XCHAR (con->tty_erase_char))
1029             {
1030               k = QKbackspace;
1031               m &= ~XEMACS_MOD_CONTROL;
1032             }
1033 #endif /* defined(HAVE_TTY) && !defined(CYGWIN) */
1034           break;
1035         }
1036       if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1037     }
1038 #if defined(HAVE_TTY)
1039   else if (do_backspace_mapping &&
1040            CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1041     k = QKbackspace;
1042 #endif /* defined(HAVE_TTY) && !defined(CYGWIN) */
1043   else if (c == 127)
1044     k = QKdelete;
1045   else if (c == ' ')
1046     k = QKspace;
1047
1048   event->event_type          = key_press_event;
1049   event->timestamp           = 0; /* #### */
1050   event->channel             = make_console (con);
1051   event->event.key.keysym    = (!NILP (k) ? k : make_char (c));
1052   event->event.key.modifiers = m;
1053 }
1054
1055 /* This variable controls what character name -> character code mapping
1056    we are using.  Window-system-specific code sets this to some symbol,
1057    and we use that symbol as the plist key to convert keysyms into 8-bit
1058    codes.  In this way one can have several character sets predefined and
1059    switch them by changing this.
1060
1061    #### This is utterly bogus and should be removed.
1062  */
1063 Lisp_Object Vcharacter_set_property;
1064
1065 Emchar
1066 event_to_character (Lisp_Event *event,
1067                     int allow_extra_modifiers,
1068                     int allow_meta,
1069                     int allow_non_ascii)
1070 {
1071   Emchar c = 0;
1072   Lisp_Object code;
1073
1074   if (event->event_type != key_press_event)
1075     {
1076       assert (event->event_type != dead_event);
1077       return -1;
1078     }
1079   if (!allow_extra_modifiers &&
1080       event->event.key.modifiers & (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_MOD_ALT))
1081     return -1;
1082   if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1083     c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1084   else if (!SYMBOLP (event->event.key.keysym))
1085     ABORT ();
1086   else if (allow_non_ascii && !NILP (Vcharacter_set_property)
1087            /* Allow window-system-specific extensibility of
1088               keysym->code mapping */
1089            && CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1090                                               Vcharacter_set_property,
1091                                               Qnil)))
1092     c = XCHAR_OR_CHAR_INT (code);
1093   else if (CHAR_OR_CHAR_INTP (code = Fget (event->event.key.keysym,
1094                                            Qascii_character, Qnil)))
1095     c = XCHAR_OR_CHAR_INT (code);
1096   else
1097     return -1;
1098
1099   if (event->event.key.modifiers & XEMACS_MOD_CONTROL)
1100     {
1101       if (c >= 'a' && c <= 'z')
1102         c -= ('a' - 'A');
1103       else
1104         /* reject Control-Shift- keys */
1105         if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers)
1106           return -1;
1107
1108       if (c >= '@' && c <= '_')
1109         c -= '@';
1110       else if (c == ' ')  /* C-space and C-@ are the same. */
1111         c = 0;
1112       else
1113         /* reject keys that can't take Control- modifiers */
1114         if (! allow_extra_modifiers) return -1;
1115     }
1116
1117   if (event->event.key.modifiers & XEMACS_MOD_META)
1118     {
1119       if (! allow_meta) return -1;
1120       if (c & 0200) return -1;          /* don't allow M-oslash (overlap) */
1121 #ifdef MULE
1122       if (c >= 256) return -1;
1123 #endif
1124       c |= 0200;
1125     }
1126   return c;
1127 }
1128
1129 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /*
1130 Return the closest ASCII approximation to the given event object.
1131 If the event isn't a keypress, this returns nil.
1132 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in
1133  its translation; it will ignore modifier keys other than control and meta,
1134  and will ignore the shift modifier on those characters which have no
1135  shifted ASCII equivalent (Control-Shift-A for example, will be mapped to
1136  the same ASCII code as Control-A).
1137 If the ALLOW-META argument is non-nil, then the Meta modifier will be
1138  represented by turning on the high bit of the byte returned; otherwise, nil
1139  will be returned for events containing the Meta modifier.
1140 If the ALLOW-NON-ASCII argument is non-nil, then characters which are
1141  present in the prevailing character set (see the `character-set-property'
1142  variable) will be returned as their code in that character set, instead of
1143  the return value being restricted to ASCII.
1144 Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as
1145  both use the high bit; `M-x' and `oslash' will be indistinguishable.
1146 */
1147      (event, allow_extra_modifiers, allow_meta, allow_non_ascii))
1148 {
1149   Emchar c;
1150   CHECK_LIVE_EVENT (event);
1151   c = event_to_character (XEVENT (event),
1152                           !NILP (allow_extra_modifiers),
1153                           !NILP (allow_meta),
1154                           !NILP (allow_non_ascii));
1155   return c < 0 ? Qnil : make_char (c);
1156 }
1157
1158 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /*
1159 Convert KEY-DESCRIPTION into an event structure, replete with bucky bits.
1160
1161 KEY-DESCRIPTION is the first argument, and the event to fill in is the
1162 second.  This function contains knowledge about what various kinds of
1163 arguments ``mean'' -- for example, the number 9 is converted to the
1164 character ``Tab'', not the distinct character ``Control-I''.
1165
1166 KEY-DESCRIPTION can be an integer, a character, a symbol such as 'clear,
1167 or a list such as '(control backspace).
1168
1169 If the optional second argument EVENT is an event, it is modified and
1170 returned; otherwise, a new event object is created and returned.
1171
1172 Optional third arg CONSOLE is the console to store in the event, and
1173 defaults to the selected console.
1174
1175 If KEY-DESCRIPTION is an integer or character, the high bit may be
1176 interpreted as the meta key. (This is done for backward compatibility
1177 in lots of places.)  If USE-CONSOLE-META-FLAG is nil, this will always
1178 be the case.  If USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for
1179 CONSOLE affects whether the high bit is interpreted as a meta
1180 key. (See `set-input-mode'.)  If you don't want this silly meta
1181 interpretation done, you should pass in a list containing the
1182 character.
1183
1184 Beware that character-to-event and event-to-character are not strictly
1185 inverse functions, since events contain much more information than the
1186 Lisp character object type can encode.
1187 */
1188        (keystroke, event, console, use_console_meta_flag))
1189 {
1190   struct console *con = decode_console (console);
1191   if (NILP (event))
1192     event = Fmake_event (Qnil, Qnil);
1193   else
1194     CHECK_LIVE_EVENT (event);
1195   if (CONSP (keystroke) || SYMBOLP (keystroke))
1196     key_desc_list_to_event (keystroke, event, 1);
1197   else
1198     {
1199       CHECK_CHAR_COERCE_INT (keystroke);
1200       character_to_event (XCHAR (keystroke), XEVENT (event), con,
1201                           !NILP (use_console_meta_flag), 1);
1202     }
1203   return event;
1204 }
1205
1206 void
1207 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event)
1208 {
1209   assert (STRINGP (seq) || VECTORP (seq));
1210   assert (n < XINT (Flength (seq)));
1211
1212   if (STRINGP (seq))
1213     {
1214       Emchar ch = string_char (XSTRING (seq), n);
1215       Fcharacter_to_event (make_char (ch), event, Qnil, Qnil);
1216     }
1217   else
1218     {
1219       Lisp_Object keystroke = XVECTOR_DATA (seq)[n];
1220       if (EVENTP (keystroke))
1221         Fcopy_event (keystroke, event);
1222       else
1223         Fcharacter_to_event (keystroke, event, Qnil, Qnil);
1224     }
1225 }
1226
1227 Lisp_Object
1228 key_sequence_to_event_chain (Lisp_Object seq)
1229 {
1230   int len = XINT (Flength (seq));
1231   int i;
1232   Lisp_Object head = Qnil, tail = Qnil;
1233
1234   for (i = 0; i < len; i++)
1235     {
1236       Lisp_Object event = Fmake_event (Qnil, Qnil);
1237       nth_of_key_sequence_as_event (seq, i, event);
1238       enqueue_event (event, &head, &tail);
1239     }
1240
1241   return head;
1242 }
1243
1244 void
1245 format_event_object (char *buf, Lisp_Event *event, int brief)
1246 {
1247   int mouse_p = 0;
1248   int mod = 0;
1249   Lisp_Object key;
1250
1251   switch (event->event_type)
1252     {
1253     case key_press_event:
1254       {
1255         mod = event->event.key.modifiers;
1256         key = event->event.key.keysym;
1257         /* Hack. */
1258         if (! brief && CHARP (key) &&
1259             mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER))
1260         {
1261           int k = XCHAR (key);
1262           if (k >= 'a' && k <= 'z')
1263             key = make_char (k - ('a' - 'A'));
1264           else if (k >= 'A' && k <= 'Z')
1265             mod |= XEMACS_MOD_SHIFT;
1266         }
1267         break;
1268       }
1269     case button_release_event:
1270       mouse_p++;
1271       /* Fall through */
1272     case button_press_event:
1273       {
1274         mouse_p++;
1275         mod = event->event.button.modifiers;
1276         key = make_char (event->event.button.button + '0');
1277         break;
1278       }
1279     case magic_event:
1280       {
1281         const char *name = NULL;
1282
1283 #ifdef HAVE_GTK
1284         {
1285           Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1286           if (CONSOLE_GTK_P (XCONSOLE (console)))
1287             name = gtk_event_name (event->event.magic.underlying_gdk_event.type);
1288         }
1289 #endif
1290 #ifdef HAVE_X_WINDOWS
1291         {
1292           Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1293           if (CONSOLE_X_P (XCONSOLE (console)))
1294             name = x_event_name (event->event.magic.underlying_x_event.type);
1295         }
1296 #endif /* HAVE_X_WINDOWS */
1297         if (name) strcpy (buf, name);
1298         else strcpy (buf, "???");
1299         return;
1300       }
1301     case magic_eval_event:      strcpy (buf, "magic-eval"); return;
1302     case pointer_motion_event:  strcpy (buf, "motion");     return;
1303     case misc_user_event:       strcpy (buf, "misc-user");  return;
1304     case eval_event:            strcpy (buf, "eval");       return;
1305     case process_event:         strcpy (buf, "process");    return;
1306     case timeout_event:         strcpy (buf, "timeout");    return;
1307     case empty_event:           strcpy (buf, "empty");      return;
1308     case dead_event:            strcpy (buf, "DEAD-EVENT"); return;
1309     default:
1310       ABORT ();
1311       return;
1312     }
1313 #define modprint1(x)  do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0)
1314 #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0)
1315   if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-");
1316   if (mod & XEMACS_MOD_META)    modprint ("meta-",    "M-");
1317   if (mod & XEMACS_MOD_SUPER)   modprint ("super-",   "S-");
1318   if (mod & XEMACS_MOD_HYPER)   modprint ("hyper-",   "H-");
1319   if (mod & XEMACS_MOD_ALT)     modprint ("alt-",     "A-");
1320   if (mod & XEMACS_MOD_SHIFT)   modprint ("shift-",   "Sh-");
1321   if (mouse_p)
1322     {
1323       modprint1 ("button");
1324       --mouse_p;
1325     }
1326
1327 #undef modprint
1328 #undef modprint1
1329
1330   if (CHARP (key))
1331     {
1332       buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1333       *buf = 0;
1334     }
1335   else if (SYMBOLP (key))
1336     {
1337       const char *str = 0;
1338       if (brief)
1339         {
1340           if      (EQ (key, QKlinefeed))  str = "LFD";
1341           else if (EQ (key, QKtab))       str = "TAB";
1342           else if (EQ (key, QKreturn))    str = "RET";
1343           else if (EQ (key, QKescape))    str = "ESC";
1344           else if (EQ (key, QKdelete))    str = "DEL";
1345           else if (EQ (key, QKspace))     str = "SPC";
1346           else if (EQ (key, QKbackspace)) str = "BS";
1347         }
1348       if (str)
1349         {
1350           int i = strlen (str);
1351           memcpy (buf, str, i+1);
1352           str += i;
1353         }
1354       else
1355         {
1356           Lisp_String *name = XSYMBOL (key)->name;
1357           memcpy (buf, string_data (name), string_length (name) + 1);
1358           str += string_length (name);
1359         }
1360     }
1361   else
1362     ABORT ();
1363   if (mouse_p)
1364     strncpy (buf, "up", 4);
1365 }
1366
1367 DEFUN ("eventp", Feventp, 1, 1, 0, /*
1368 True if OBJECT is an event object.
1369 */
1370        (object))
1371 {
1372   return EVENTP (object) ? Qt : Qnil;
1373 }
1374
1375 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /*
1376 True if OBJECT is an event object that has not been deallocated.
1377 */
1378        (object))
1379 {
1380   return EVENTP (object) && XEVENT (object)->event_type != dead_event ?
1381     Qt : Qnil;
1382 }
1383
1384 #if 0 /* debugging functions */
1385
1386 xxDEFUN ("event-next", Fevent_next, 1, 1, 0, /*
1387 Return the event object's `next' event, or nil if it has none.
1388 The `next-event' field is changed by calling `set-next-event'.
1389 */
1390          (event))
1391 {
1392   Lisp_Event *e;
1393   CHECK_LIVE_EVENT (event);
1394
1395   return XEVENT_NEXT (event);
1396 }
1397
1398 xxDEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /*
1399 Set the `next event' of EVENT to NEXT-EVENT.
1400 NEXT-EVENT must be an event object or nil.
1401 */
1402          (event, next_event))
1403 {
1404   Lisp_Object ev;
1405
1406   CHECK_LIVE_EVENT (event);
1407   if (NILP (next_event))
1408     {
1409       XSET_EVENT_NEXT (event, Qnil);
1410       return Qnil;
1411     }
1412
1413   CHECK_LIVE_EVENT (next_event);
1414
1415   EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event))
1416     {
1417       QUIT;
1418       if (EQ (ev, event))
1419         signal_error (Qerror,
1420                       list3 (build_string ("Cyclic event-next"),
1421                              event,
1422                              next_event));
1423     }
1424   XSET_EVENT_NEXT (event, next_event);
1425   return next_event;
1426 }
1427
1428 #endif /* 0 */
1429
1430 DEFUN ("event-type", Fevent_type, 1, 1, 0, /*
1431 Return the type of EVENT.
1432 This will be a symbol; one of
1433
1434 key-press       A key was pressed.
1435 button-press    A mouse button was pressed.
1436 button-release  A mouse button was released.
1437 misc-user       Some other user action happened; typically, this is
1438                 a menu selection or scrollbar action.
1439 motion          The mouse moved.
1440 process         Input is available from a subprocess.
1441 timeout         A timeout has expired.
1442 eval            This causes a specified action to occur when dispatched.
1443 magic           Some window-system-specific event has occurred.
1444 empty           The event has been allocated but not assigned.
1445
1446 */
1447        (event))
1448 {
1449   CHECK_LIVE_EVENT (event);
1450   switch (XEVENT (event)->event_type)
1451     {
1452     case key_press_event:       return Qkey_press;
1453     case button_press_event:    return Qbutton_press;
1454     case button_release_event:  return Qbutton_release;
1455     case misc_user_event:       return Qmisc_user;
1456     case pointer_motion_event:  return Qmotion;
1457     case process_event:         return Qprocess;
1458     case timeout_event:         return Qtimeout;
1459     case eval_event:            return Qeval;
1460     case magic_event:
1461     case magic_eval_event:
1462       return Qmagic;
1463
1464     case empty_event:
1465       return Qempty;
1466
1467     default:
1468       ABORT ();
1469       return Qnil;
1470     }
1471 }
1472
1473 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1474 Return the timestamp of the event object EVENT.
1475 Timestamps are measured in milliseconds since the start of the window system.
1476 They are NOT related to any current time measurement.
1477 They should be compared with `event-timestamp<'.
1478 See also `current-event-timestamp'.
1479 */
1480        (event))
1481 {
1482   CHECK_LIVE_EVENT (event);
1483   /* This junk is so that timestamps don't get to be negative, but contain
1484      as many bits as this particular emacs will allow.
1485    */
1486   return make_int (EMACS_INT_MAX & XEVENT (event)->timestamp);
1487 }
1488
1489 #define TIMESTAMP_HALFSPACE (1L << (INT_VALBITS - 2))
1490
1491 DEFUN ("event-timestamp<", Fevent_timestamp_lessp, 2, 2, 0, /*
1492 Return true if timestamp TIME1 is earlier than timestamp TIME2.
1493 This correctly handles timestamp wrap.
1494 See also `event-timestamp' and `current-event-timestamp'.
1495 */
1496        (time1, time2))
1497 {
1498   EMACS_INT t1, t2;
1499
1500   CHECK_NATNUM (time1);
1501   CHECK_NATNUM (time2);
1502   t1 = XINT (time1);
1503   t2 = XINT (time2);
1504
1505   if (t1 < t2)
1506     return t2 - t1 < TIMESTAMP_HALFSPACE ? Qt : Qnil;
1507   else
1508     return t1 - t2 < TIMESTAMP_HALFSPACE ? Qnil : Qt;
1509 }
1510
1511 #define CHECK_EVENT_TYPE(e,t1,sym) do {         \
1512   CHECK_LIVE_EVENT (e);                         \
1513   if (XEVENT(e)->event_type != (t1))            \
1514     e = wrong_type_argument (sym,e);            \
1515 } while (0)
1516
1517 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do {             \
1518   CHECK_LIVE_EVENT (e);                                 \
1519   {                                                     \
1520     emacs_event_type CET_type = XEVENT (e)->event_type; \
1521     if (CET_type != (t1) &&                             \
1522         CET_type != (t2))                               \
1523       e = wrong_type_argument (sym,e);                  \
1524   }                                                     \
1525 } while (0)
1526
1527 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do {          \
1528   CHECK_LIVE_EVENT (e);                                 \
1529   {                                                     \
1530     emacs_event_type CET_type = XEVENT (e)->event_type; \
1531     if (CET_type != (t1) &&                             \
1532         CET_type != (t2) &&                             \
1533         CET_type != (t3))                               \
1534       e = wrong_type_argument (sym,e);                  \
1535   }                                                     \
1536 } while (0)
1537
1538 DEFUN ("event-key", Fevent_key, 1, 1, 0, /*
1539 Return the Keysym of the key-press event EVENT.
1540 This will be a character if the event is associated with one, else a symbol.
1541 */
1542        (event))
1543 {
1544   CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p);
1545   return XEVENT (event)->event.key.keysym;
1546 }
1547
1548 DEFUN ("event-button", Fevent_button, 1, 1, 0, /*
1549 Return the button-number of the button-press or button-release event EVENT.
1550 */
1551        (event))
1552 {
1553
1554   CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event,
1555                      misc_user_event, Qbutton_event_p);
1556 #ifdef HAVE_WINDOW_SYSTEM
1557   if ( XEVENT (event)->event_type == misc_user_event)
1558     return make_int (XEVENT (event)->event.misc.button);
1559   else
1560     return make_int (XEVENT (event)->event.button.button);
1561 #else /* !HAVE_WINDOW_SYSTEM */
1562   return Qzero;
1563 #endif /* !HAVE_WINDOW_SYSTEM */
1564
1565 }
1566
1567 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1568 Return a number representing the modifier keys and buttons which were down
1569 when the given mouse or keyboard event was produced.
1570 See also the function `event-modifiers'.
1571 */
1572        (event))
1573 {
1574  again:
1575   CHECK_LIVE_EVENT (event);
1576   switch (XEVENT (event)->event_type)
1577     {
1578     case key_press_event:
1579       return make_int (XEVENT (event)->event.key.modifiers);
1580     case button_press_event:
1581     case button_release_event:
1582       return make_int (XEVENT (event)->event.button.modifiers);
1583     case pointer_motion_event:
1584       return make_int (XEVENT (event)->event.motion.modifiers);
1585     case misc_user_event:
1586       return make_int (XEVENT (event)->event.misc.modifiers);
1587     default:
1588       event = wrong_type_argument (intern ("key-or-mouse-event-p"), event);
1589       goto again;
1590     }
1591 }
1592
1593 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1594 Return a list of symbols, the names of the modifier keys and buttons
1595 which were down when the given mouse or keyboard event was produced.
1596 See also the function `event-modifier-bits'.
1597
1598 The possible symbols in the list are
1599
1600 `shift':     The Shift key.  Will not appear, in general, on key events
1601              where the keysym is an ASCII character, because using Shift
1602              on such a character converts it into another character rather
1603              than actually just adding a Shift modifier.
1604
1605 `control':   The Control key.
1606
1607 `meta':      The Meta key.  On PC's and PC-style keyboards, this is generally
1608              labelled \"Alt\"; Meta is a holdover from early Lisp Machines and
1609              such, propagated through the X Window System.  On Sun keyboards,
1610              this key is labelled with a diamond.
1611
1612 `alt':       The \"Alt\" key.  Alt is in quotes because this does not refer
1613              to what it obviously should refer to, namely the Alt key on PC
1614              keyboards.  Instead, it refers to the key labelled Alt on Sun
1615              keyboards, and to no key at all on PC keyboards.
1616
1617 `super':     The Super key.  Most keyboards don't have any such key, but
1618              under X Windows using `xmodmap' you can assign any key (such as
1619              an underused right-shift, right-control, or right-alt key) to
1620              this key modifier.  No support currently exists under MS Windows
1621              for generating these modifiers.
1622
1623 `hyper':     The Hyper key.  Works just like the Super key.
1624
1625 `button1':   The mouse buttons.  This means that the specified button was held
1626 `button2':   down at the time the event occurred.  NOTE: For button-press
1627 `button3':   events, the button that was just pressed down does NOT appear in
1628 `button4':   the modifiers.
1629 `button5':
1630
1631 Button modifiers are currently ignored when defining and looking up key and
1632 mouse strokes in keymaps.  This could be changed, which would allow a user to
1633 create button-chord actions, use a button as a key modifier and do other
1634 clever things.
1635 */
1636        (event))
1637 {
1638   int mod = XINT (Fevent_modifier_bits (event));
1639   Lisp_Object result = Qnil;
1640   struct gcpro gcpro1;
1641
1642   GCPRO1 (result);
1643   if (mod & XEMACS_MOD_SHIFT)   result = Fcons (Qshift, result);
1644   if (mod & XEMACS_MOD_ALT)     result = Fcons (Qalt, result);
1645   if (mod & XEMACS_MOD_HYPER)   result = Fcons (Qhyper, result);
1646   if (mod & XEMACS_MOD_SUPER)   result = Fcons (Qsuper, result);
1647   if (mod & XEMACS_MOD_META)    result = Fcons (Qmeta, result);
1648   if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result);
1649   if (mod & XEMACS_MOD_BUTTON1) result = Fcons (Qbutton1, result);
1650   if (mod & XEMACS_MOD_BUTTON2) result = Fcons (Qbutton2, result);
1651   if (mod & XEMACS_MOD_BUTTON3) result = Fcons (Qbutton3, result);
1652   if (mod & XEMACS_MOD_BUTTON4) result = Fcons (Qbutton4, result);
1653   if (mod & XEMACS_MOD_BUTTON5) result = Fcons (Qbutton5, result);
1654   RETURN_UNGCPRO (Fnreverse (result));
1655 }
1656
1657 static int
1658 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1659 {
1660   struct window *w;
1661   struct frame *f;
1662
1663   if (XEVENT (event)->event_type == pointer_motion_event)
1664     {
1665       *x = XEVENT (event)->event.motion.x;
1666       *y = XEVENT (event)->event.motion.y;
1667     }
1668   else if (XEVENT (event)->event_type == button_press_event ||
1669            XEVENT (event)->event_type == button_release_event)
1670     {
1671       *x = XEVENT (event)->event.button.x;
1672       *y = XEVENT (event)->event.button.y;
1673     }
1674   else if (XEVENT (event)->event_type == misc_user_event)
1675     {
1676       *x = XEVENT (event)->event.misc.x;
1677       *y = XEVENT (event)->event.misc.y;
1678     }
1679   else
1680     return 0;
1681
1682   f = XFRAME (EVENT_CHANNEL (XEVENT (event)));
1683
1684   if (relative)
1685     {
1686       w = find_window_by_pixel_pos (*x, *y, f->root_window);
1687
1688       if (!w)
1689         return 1;       /* #### What should really happen here? */
1690
1691       *x -= w->pixel_left;
1692       *y -= w->pixel_top;
1693     }
1694   else
1695     {
1696       *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) -
1697         FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f);
1698       *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) -
1699         FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f);
1700     }
1701
1702   return 1;
1703 }
1704
1705 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /*
1706 Return the X position in pixels of mouse event EVENT.
1707 The value returned is relative to the window the event occurred in.
1708 This will signal an error if the event is not a mouse event.
1709 See also `mouse-event-p' and `event-x-pixel'.
1710 */
1711        (event))
1712 {
1713   int x, y;
1714
1715   CHECK_LIVE_EVENT (event);
1716
1717   if (!event_x_y_pixel_internal (event, &x, &y, 1))
1718     return wrong_type_argument (Qmouse_event_p, event);
1719   else
1720     return make_int (x);
1721 }
1722
1723 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /*
1724 Return the Y position in pixels of mouse event EVENT.
1725 The value returned is relative to the window the event occurred in.
1726 This will signal an error if the event is not a mouse event.
1727 See also `mouse-event-p' and `event-y-pixel'.
1728 */
1729        (event))
1730 {
1731   int x, y;
1732
1733   CHECK_LIVE_EVENT (event);
1734
1735   if (!event_x_y_pixel_internal (event, &x, &y, 1))
1736     return wrong_type_argument (Qmouse_event_p, event);
1737   else
1738     return make_int (y);
1739 }
1740
1741 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /*
1742 Return the X position in pixels of mouse event EVENT.
1743 The value returned is relative to the frame the event occurred in.
1744 This will signal an error if the event is not a mouse event.
1745 See also `mouse-event-p' and `event-window-x-pixel'.
1746 */
1747        (event))
1748 {
1749   int x, y;
1750
1751   CHECK_LIVE_EVENT (event);
1752
1753   if (!event_x_y_pixel_internal (event, &x, &y, 0))
1754     return wrong_type_argument (Qmouse_event_p, event);
1755   else
1756     return make_int (x);
1757 }
1758
1759 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /*
1760 Return the Y position in pixels of mouse event EVENT.
1761 The value returned is relative to the frame the event occurred in.
1762 This will signal an error if the event is not a mouse event.
1763 See also `mouse-event-p' `event-window-y-pixel'.
1764 */
1765        (event))
1766 {
1767   int x, y;
1768
1769   CHECK_LIVE_EVENT (event);
1770
1771   if (!event_x_y_pixel_internal (event, &x, &y, 0))
1772     return wrong_type_argument (Qmouse_event_p, event);
1773   else
1774     return make_int (y);
1775 }
1776
1777 /* Given an event, return a value:
1778
1779      OVER_TOOLBAR:      over one of the 4 frame toolbars
1780      OVER_MODELINE:     over a modeline
1781      OVER_BORDER:       over an internal border
1782      OVER_NOTHING:      over the text area, but not over text
1783      OVER_OUTSIDE:      outside of the frame border
1784      OVER_TEXT:         over text in the text area
1785      OVER_V_DIVIDER:    over windows vertical divider
1786
1787    and return:
1788
1789    The X char position in CHAR_X, if not a null pointer.
1790    The Y char position in CHAR_Y, if not a null pointer.
1791    (These last two values are relative to the window the event is over.)
1792    The window it's over in W, if not a null pointer.
1793    The buffer position it's over in BUFP, if not a null pointer.
1794    The closest buffer position in CLOSEST, if not a null pointer.
1795
1796    OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation().
1797 */
1798
1799 static int
1800 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y,
1801                          int *obj_x, int *obj_y,
1802                          struct window **w, Bufpos *bufp, Bufpos *closest,
1803                          Charcount *modeline_closest,
1804                          Lisp_Object *obj1, Lisp_Object *obj2)
1805 {
1806   int pix_x = 0;
1807   int pix_y = 0;
1808   int result;
1809   Lisp_Object frame;
1810
1811   int ret_x, ret_y, ret_obj_x, ret_obj_y;
1812   struct window *ret_w;
1813   Bufpos ret_bufp, ret_closest;
1814   Charcount ret_modeline_closest;
1815   Lisp_Object ret_obj1, ret_obj2;
1816
1817   CHECK_LIVE_EVENT (event);
1818   frame = XEVENT (event)->channel;
1819   switch (XEVENT (event)->event_type)
1820     {
1821     case pointer_motion_event :
1822       pix_x = XEVENT (event)->event.motion.x;
1823       pix_y = XEVENT (event)->event.motion.y;
1824       break;
1825     case button_press_event :
1826     case button_release_event :
1827       pix_x = XEVENT (event)->event.button.x;
1828       pix_y = XEVENT (event)->event.button.y;
1829       break;
1830     case misc_user_event :
1831       pix_x = XEVENT (event)->event.misc.x;
1832       pix_y = XEVENT (event)->event.misc.y;
1833       break;
1834     default:
1835       dead_wrong_type_argument (Qmouse_event_p, event);
1836     }
1837
1838   result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y,
1839                                        &ret_x, &ret_y, &ret_obj_x, &ret_obj_y,
1840                                        &ret_w, &ret_bufp, &ret_closest,
1841                                        &ret_modeline_closest,
1842                                        &ret_obj1, &ret_obj2);
1843
1844   if (result == OVER_NOTHING || result == OVER_OUTSIDE)
1845     ret_bufp = 0;
1846   else if (ret_w && NILP (ret_w->buffer))
1847     /* Why does this happen?  (Does it still happen?)
1848        I guess the window has gotten reused as a non-leaf... */
1849     ret_w = 0;
1850
1851   /* #### pixel_to_glyph_translation() sometimes returns garbage...
1852      The word has type Lisp_Type_Record (presumably meaning `extent') but the
1853      pointer points to random memory, often filled with 0, sometimes not.
1854    */
1855   /* #### Chuck, do we still need this crap? */
1856   if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1)
1857 #ifdef HAVE_TOOLBARS
1858                             || TOOLBAR_BUTTONP (ret_obj1)
1859 #endif
1860      ))
1861     ABORT ();
1862   if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2)))
1863     ABORT ();
1864
1865   if (char_x)
1866     *char_x = ret_x;
1867   if (char_y)
1868     *char_y = ret_y;
1869   if (obj_x)
1870     *obj_x = ret_obj_x;
1871   if (obj_y)
1872     *obj_y = ret_obj_y;
1873   if (w)
1874     *w = ret_w;
1875   if (bufp)
1876     *bufp = ret_bufp;
1877   if (closest)
1878     *closest = ret_closest;
1879   if (modeline_closest)
1880     *modeline_closest = ret_modeline_closest;
1881   if (obj1)
1882     *obj1 = ret_obj1;
1883   if (obj2)
1884     *obj2 = ret_obj2;
1885
1886   return result;
1887 }
1888
1889 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /*
1890 Return t if the mouse event EVENT occurred over the text area of a window.
1891 The modeline is not considered to be part of the text area.
1892 */
1893        (event))
1894 {
1895   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1896
1897   return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil;
1898 }
1899
1900 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /*
1901 Return t if the mouse event EVENT occurred over the modeline of a window.
1902 */
1903        (event))
1904 {
1905   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1906
1907   return result == OVER_MODELINE ? Qt : Qnil;
1908 }
1909
1910 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /*
1911 Return t if the mouse event EVENT occurred over an internal border.
1912 */
1913        (event))
1914 {
1915   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1916
1917   return result == OVER_BORDER ? Qt : Qnil;
1918 }
1919
1920 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /*
1921 Return t if the mouse event EVENT occurred over a toolbar.
1922 */
1923        (event))
1924 {
1925   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1926
1927   return result == OVER_TOOLBAR ? Qt : Qnil;
1928 }
1929
1930 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /*
1931 Return t if the mouse event EVENT occurred over a window divider.
1932 */
1933        (event))
1934 {
1935   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
1936
1937   return result == OVER_V_DIVIDER ? Qt : Qnil;
1938 }
1939
1940 struct console *
1941 event_console_or_selected (Lisp_Object event)
1942 {
1943   Lisp_Object channel = EVENT_CHANNEL (XEVENT (event));
1944   Lisp_Object console = CDFW_CONSOLE (channel);
1945
1946   if (NILP (console))
1947     console = Vselected_console;
1948
1949   return XCONSOLE (console);
1950 }
1951
1952 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /*
1953 Return the channel that the event EVENT occurred on.
1954 This will be a frame, device, console, or nil for some types
1955 of events (e.g. eval events).
1956 */
1957        (event))
1958 {
1959   CHECK_LIVE_EVENT (event);
1960   return EVENT_CHANNEL (XEVENT (event));
1961 }
1962
1963 DEFUN ("event-window", Fevent_window, 1, 1, 0, /*
1964 Return the window over which mouse event EVENT occurred.
1965 This may be nil if the event occurred in the border or over a toolbar.
1966 The modeline is considered to be within the window it describes.
1967 */
1968        (event))
1969 {
1970   struct window *w;
1971
1972   event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0);
1973
1974   if (!w)
1975     return Qnil;
1976   else
1977     {
1978       Lisp_Object window;
1979
1980       XSETWINDOW (window, w);
1981       return window;
1982     }
1983 }
1984
1985 DEFUN ("event-point", Fevent_point, 1, 1, 0, /*
1986 Return the character position of the mouse event EVENT.
1987 If the event did not occur over a window, or did not occur over text,
1988 then this returns nil.  Otherwise, it returns a position in the buffer
1989 visible in the event's window.
1990 */
1991        (event))
1992 {
1993   Bufpos bufp;
1994   struct window *w;
1995
1996   event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0);
1997
1998   return w && bufp ? make_int (bufp) : Qnil;
1999 }
2000
2001 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /*
2002 Return the character position closest to the mouse event EVENT.
2003 If the event did not occur over a window or over text, return the
2004 closest point to the location of the event.  If the Y pixel position
2005 overlaps a window and the X pixel position is to the left of that
2006 window, the closest point is the beginning of the line containing the
2007 Y position.  If the Y pixel position overlaps a window and the X pixel
2008 position is to the right of that window, the closest point is the end
2009 of the line containing the Y position.  If the Y pixel position is
2010 above a window, return 0.  If it is below the last character in a window,
2011 return the value of (window-end).
2012 */
2013        (event))
2014 {
2015   Bufpos bufp;
2016
2017   event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0);
2018
2019   return bufp ? make_int (bufp) : Qnil;
2020 }
2021
2022 DEFUN ("event-x", Fevent_x, 1, 1, 0, /*
2023 Return the X position of the mouse event EVENT in characters.
2024 This is relative to the window the event occurred over.
2025 */
2026        (event))
2027 {
2028   int char_x;
2029
2030   event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0);
2031
2032   return make_int (char_x);
2033 }
2034
2035 DEFUN ("event-y", Fevent_y, 1, 1, 0, /*
2036 Return the Y position of the mouse event EVENT in characters.
2037 This is relative to the window the event occurred over.
2038 */
2039        (event))
2040 {
2041   int char_y;
2042
2043   event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0);
2044
2045   return make_int (char_y);
2046 }
2047
2048 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /*
2049 Return the character position in the modeline that EVENT occurred over.
2050 EVENT should be a mouse event.  If EVENT did not occur over a modeline,
2051 nil is returned.  You can determine the actual character that the
2052 event occurred over by looking in `generated-modeline-string' at the
2053 returned character position.  Note that `generated-modeline-string'
2054 is buffer-local, and you must use EVENT's buffer when retrieving
2055 `generated-modeline-string' in order to get accurate results.
2056 */
2057        (event))
2058 {
2059   Charcount mbufp;
2060   int where;
2061
2062   where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0);
2063
2064   return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp);
2065 }
2066
2067 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /*
2068 Return the glyph that the mouse event EVENT occurred over, or nil.
2069 */
2070        (event))
2071 {
2072   Lisp_Object glyph;
2073   struct window *w;
2074
2075   event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0);
2076
2077   return w && GLYPHP (glyph) ? glyph : Qnil;
2078 }
2079
2080 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /*
2081 Return the extent of the glyph that the mouse event EVENT occurred over.
2082 If the event did not occur over a glyph, nil is returned.
2083 */
2084        (event))
2085 {
2086   Lisp_Object extent;
2087   struct window *w;
2088
2089   event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent);
2090
2091   return w && EXTENTP (extent) ? extent : Qnil;
2092 }
2093
2094 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /*
2095 Return the X pixel position of EVENT relative to the glyph it occurred over.
2096 EVENT should be a mouse event.  If the event did not occur over a glyph,
2097 nil is returned.
2098 */
2099        (event))
2100 {
2101   Lisp_Object extent;
2102   struct window *w;
2103   int obj_x;
2104
2105   event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent);
2106
2107   return w && EXTENTP (extent) ? make_int (obj_x) : Qnil;
2108 }
2109
2110 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /*
2111 Return the Y pixel position of EVENT relative to the glyph it occurred over.
2112 EVENT should be a mouse event.  If the event did not occur over a glyph,
2113 nil is returned.
2114 */
2115        (event))
2116 {
2117   Lisp_Object extent;
2118   struct window *w;
2119   int obj_y;
2120
2121   event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent);
2122
2123   return w && EXTENTP (extent) ? make_int (obj_y) : Qnil;
2124 }
2125
2126 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /*
2127 Return the toolbar button that the mouse event EVENT occurred over.
2128 If the event did not occur over a toolbar button, nil is returned.
2129 */
2130        (event))
2131 {
2132 #ifdef HAVE_TOOLBARS
2133   Lisp_Object button;
2134
2135   int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0);
2136
2137   return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil;
2138 #else
2139   return Qnil;
2140 #endif
2141 }
2142
2143 DEFUN ("event-process", Fevent_process, 1, 1, 0, /*
2144 Return the process of the process-output event EVENT.
2145 */
2146        (event))
2147 {
2148   CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p);
2149   return XEVENT (event)->event.process.process;
2150 }
2151
2152 DEFUN ("event-function", Fevent_function, 1, 1, 0, /*
2153 Return the callback function of EVENT.
2154 EVENT should be a timeout, misc-user, or eval event.
2155 */
2156        (event))
2157 {
2158  again:
2159   CHECK_LIVE_EVENT (event);
2160   switch (XEVENT (event)->event_type)
2161     {
2162     case timeout_event:
2163       return XEVENT (event)->event.timeout.function;
2164     case misc_user_event:
2165       return XEVENT (event)->event.misc.function;
2166     case eval_event:
2167       return XEVENT (event)->event.eval.function;
2168     default:
2169       event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2170       goto again;
2171     }
2172 }
2173
2174 DEFUN ("event-object", Fevent_object, 1, 1, 0, /*
2175 Return the callback function argument of EVENT.
2176 EVENT should be a timeout, misc-user, or eval event.
2177 */
2178        (event))
2179 {
2180  again:
2181   CHECK_LIVE_EVENT (event);
2182   switch (XEVENT (event)->event_type)
2183     {
2184     case timeout_event:
2185       return XEVENT (event)->event.timeout.object;
2186     case misc_user_event:
2187       return XEVENT (event)->event.misc.object;
2188     case eval_event:
2189       return XEVENT (event)->event.eval.object;
2190     default:
2191       event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event);
2192       goto again;
2193     }
2194 }
2195
2196 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /*
2197 Return a list of all of the properties of EVENT.
2198 This is in the form of a property list (alternating keyword/value pairs).
2199 */
2200        (event))
2201 {
2202   Lisp_Object props = Qnil;
2203   Lisp_Event *e;
2204   struct gcpro gcpro1;
2205
2206   CHECK_LIVE_EVENT (event);
2207   e = XEVENT (event);
2208   GCPRO1 (props);
2209
2210   props = cons3 (Qtimestamp, Fevent_timestamp (event), props);
2211
2212   switch (e->event_type)
2213     {
2214     default: ABORT ();
2215
2216     case process_event:
2217       props = cons3 (Qprocess, e->event.process.process, props);
2218       break;
2219
2220     case timeout_event:
2221       props = cons3 (Qobject,   Fevent_object   (event), props);
2222       props = cons3 (Qfunction, Fevent_function (event), props);
2223       props = cons3 (Qid, make_int (e->event.timeout.id_number), props);
2224       break;
2225
2226     case key_press_event:
2227       props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2228       props = cons3 (Qkey,       Fevent_key       (event), props);
2229       break;
2230
2231     case button_press_event:
2232     case button_release_event:
2233       props = cons3 (Qy,         Fevent_y_pixel   (event), props);
2234       props = cons3 (Qx,         Fevent_x_pixel   (event), props);
2235       props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2236       props = cons3 (Qbutton,    Fevent_button    (event), props);
2237       break;
2238
2239     case pointer_motion_event:
2240       props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2241       props = cons3 (Qy,         Fevent_y_pixel   (event), props);
2242       props = cons3 (Qx,         Fevent_x_pixel   (event), props);
2243       break;
2244
2245     case misc_user_event:
2246       props = cons3 (Qobject,    Fevent_object  (event), props);
2247       props = cons3 (Qfunction,  Fevent_function (event), props);
2248       props = cons3 (Qy,         Fevent_y_pixel   (event), props);
2249       props = cons3 (Qx,         Fevent_x_pixel   (event), props);
2250       props = cons3 (Qmodifiers, Fevent_modifiers (event), props);
2251       props = cons3 (Qbutton,    Fevent_button    (event), props);
2252       break;
2253
2254     case eval_event:
2255       props = cons3 (Qobject,   Fevent_object   (event), props);
2256       props = cons3 (Qfunction, Fevent_function (event), props);
2257       break;
2258
2259     case magic_eval_event:
2260     case magic_event:
2261       break;
2262
2263     case empty_event:
2264       RETURN_UNGCPRO (Qnil);
2265       break;
2266     }
2267
2268   props = cons3 (Qchannel, Fevent_channel (event), props);
2269   UNGCPRO;
2270
2271   return props;
2272 }
2273
2274 \f
2275 /************************************************************************/
2276 /*                            initialization                            */
2277 /************************************************************************/
2278
2279 void
2280 syms_of_events (void)
2281 {
2282   INIT_LRECORD_IMPLEMENTATION (event);
2283
2284   DEFSUBR (Fcharacter_to_event);
2285   DEFSUBR (Fevent_to_character);
2286
2287   DEFSUBR (Fmake_event);
2288   DEFSUBR (Fdeallocate_event);
2289   DEFSUBR (Fcopy_event);
2290   DEFSUBR (Feventp);
2291   DEFSUBR (Fevent_live_p);
2292   DEFSUBR (Fevent_type);
2293   DEFSUBR (Fevent_properties);
2294
2295   DEFSUBR (Fevent_timestamp);
2296   DEFSUBR (Fevent_timestamp_lessp);
2297   DEFSUBR (Fevent_key);
2298   DEFSUBR (Fevent_button);
2299   DEFSUBR (Fevent_modifier_bits);
2300   DEFSUBR (Fevent_modifiers);
2301   DEFSUBR (Fevent_x_pixel);
2302   DEFSUBR (Fevent_y_pixel);
2303   DEFSUBR (Fevent_window_x_pixel);
2304   DEFSUBR (Fevent_window_y_pixel);
2305   DEFSUBR (Fevent_over_text_area_p);
2306   DEFSUBR (Fevent_over_modeline_p);
2307   DEFSUBR (Fevent_over_border_p);
2308   DEFSUBR (Fevent_over_toolbar_p);
2309   DEFSUBR (Fevent_over_vertical_divider_p);
2310   DEFSUBR (Fevent_channel);
2311   DEFSUBR (Fevent_window);
2312   DEFSUBR (Fevent_point);
2313   DEFSUBR (Fevent_closest_point);
2314   DEFSUBR (Fevent_x);
2315   DEFSUBR (Fevent_y);
2316   DEFSUBR (Fevent_modeline_position);
2317   DEFSUBR (Fevent_glyph);
2318   DEFSUBR (Fevent_glyph_extent);
2319   DEFSUBR (Fevent_glyph_x_pixel);
2320   DEFSUBR (Fevent_glyph_y_pixel);
2321   DEFSUBR (Fevent_toolbar_button);
2322   DEFSUBR (Fevent_process);
2323   DEFSUBR (Fevent_function);
2324   DEFSUBR (Fevent_object);
2325
2326   defsymbol (&Qeventp, "eventp");
2327   defsymbol (&Qevent_live_p, "event-live-p");
2328   defsymbol (&Qkey_press_event_p, "key-press-event-p");
2329   defsymbol (&Qbutton_event_p, "button-event-p");
2330   defsymbol (&Qmouse_event_p, "mouse-event-p");
2331   defsymbol (&Qprocess_event_p, "process-event-p");
2332   defsymbol (&Qkey_press, "key-press");
2333   defsymbol (&Qbutton_press, "button-press");
2334   defsymbol (&Qbutton_release, "button-release");
2335   defsymbol (&Qmisc_user, "misc-user");
2336   defsymbol (&Qascii_character, "ascii-character");
2337
2338   defsymbol (&QKbackspace, "backspace");
2339   defsymbol (&QKtab, "tab");
2340   defsymbol (&QKlinefeed, "linefeed");
2341   defsymbol (&QKreturn, "return");
2342   defsymbol (&QKescape, "escape");
2343   defsymbol (&QKspace, "space");
2344   defsymbol (&QKdelete, "delete");
2345 }
2346
2347
2348 void
2349 reinit_vars_of_events (void)
2350 {
2351   Vevent_resource = Qnil;
2352 }
2353
2354 void
2355 vars_of_events (void)
2356 {
2357   reinit_vars_of_events ();
2358
2359   DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /*
2360 A symbol used to look up the 8-bit character of a keysym.
2361 To convert a keysym symbol to an 8-bit code, as when that key is
2362 bound to self-insert-command, we will look up the property that this
2363 variable names on the property list of the keysym-symbol.  The window-
2364 system-specific code will set up appropriate properties and set this
2365 variable.
2366 */ );
2367   Vcharacter_set_property = Qnil;
2368 }