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