cgit.sxemacs.org Git - sxemacs/blob - src/events/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 SXEmacs
   6
   7 SXEmacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or
  10 (at your option) any later version.
  11
  12 SXEmacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 You should have received a copy of the GNU General Public License
  18 along with this program.  If not, see <http://www.gnu.org/licenses/>. */
  19
  20
  21 /* Synched up with: Not in FSF. */
  22
  23 /* This file has been Mule-ized. */
  24
  25 #include <config.h>
  26 #include "lisp.h"
  27 #include "buffer.h"
  28 #include "ui/console.h"
  29 #include "ui/TTY/console-tty.h"         /* for stuff in
  30                                            character_to_event. needs
  31                                            refactoring */
  32 #include "ui/device.h"
  33 #include "ui/X11/console-x.h"   /* for x_event_name prototype in
  34                                    format_event_object. Needs refactoring */
  35 #include "extents.h"            /* Just for the EXTENTP abort check... */
  36 #define INCLUDE_EVENTS_H_PRIVATE_SPHERE
  37 #include "events.h"
  38 #include "ui/frame.h"
  39 #include "ui/glyphs.h"
  40 #include "ui/keymap.h"          /* for key_desc_list_to_event() */
  41 #include "ui/redisplay.h"
  42 #include "ui/window.h"
  43 #include "events-mod.h"
  44
  45 /* Where old events go when they are explicitly deallocated.
  46    The event chain here is cut loose before GC, so these will be freed
  47    eventually.
  48  */
  49 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
  50 static Lisp_Object Vevent_resource;
  51 #ifdef EF_USE_ASYNEQ
  52 static sxe_mutex_t Vevent_resource_mtx;
  53 #endif  /* EF_USE_ASYNEQ */
  54 #endif  /* BDWGC */
  55
  56 Lisp_Object Qeventp;
  57 Lisp_Object Qevent_live_p;
  58 Lisp_Object Qkey_press_event_p;
  59 Lisp_Object Qbutton_event_p;
  60 Lisp_Object Qmouse_event_p;
  61 Lisp_Object Qprocess_event_p;
  62
  63 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user;
  64 Lisp_Object Qascii_character;
  65
  66 EXFUN(Fevent_x_pixel, 1);
  67 EXFUN(Fevent_y_pixel, 1);
  68
  69 \f
  70 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
  71 static inline void
  72 init_Vevent_resource(void)
  73 {
  74         return;
  75 }
  76
  77 static inline void
  78 fini_Vevent_resource(void)
  79 {
  80         return;
  81 }
  82
  83 static inline void
  84 lock_Vevent_resource(void)
  85 {
  86         return;
  87 }
  88
  89 static inline void
  90 unlock_Vevent_resource(void)
  91 {
  92         return;
  93 }
  94 #elif defined EF_USE_ASYNEQ
  95 static inline void
  96 init_Vevent_resource(void)
  97 {
  98         Vevent_resource = Qnil;
  99         SXE_MUTEX_INIT(&Vevent_resource_mtx);
 100 }
 101
 102 static inline void
 103 fini_Vevent_resource(void)
 104 {
 105         SXE_MUTEX_FINI(&Vevent_resource_mtx);
 106         Vevent_resource = Qnil;
 107 }
 108
 109 static inline void
 110 lock_Vevent_resource(void)
 111 {
 112         SXE_MUTEX_LOCK(&Vevent_resource_mtx);
 113 }
 114
 115 static inline void
 116 unlock_Vevent_resource(void)
 117 {
 118         SXE_MUTEX_UNLOCK(&Vevent_resource_mtx);
 119 }
 120
 121 #else
 122 static inline void
 123 init_Vevent_resource(void)
 124 {
 125         Vevent_resource = Qnil;
 126 }
 127
 128 static inline void
 129 fini_Vevent_resource(void)
 130 {
 131         Vevent_resource = Qnil;
 132 }
 133
 134 static inline void
 135 lock_Vevent_resource(void)
 136 {
 137 }
 138
 139 static inline void
 140 unlock_Vevent_resource(void)
 141 {
 142 }
 143 #endif
 144
 145 /* #### Ad-hoc hack.  Should be part of define_lrecord_implementation */
 146 void clear_event_resource(void)
 147 {
 148 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
 149         lock_Vevent_resource();
 150         Vevent_resource = Qnil;
 151         unlock_Vevent_resource();
 152 #endif  /* !BDWGC */
 153 }
 154
 155 /* Make sure we lose quickly if we try to use this event */
 156 static void deinitialize_event(Lisp_Object ev)
 157 {
 158         Lisp_Event *event = XEVENT(ev);
 159
 160         for (sxe_index_t i = 0; i < (sizeof(Lisp_Event) / sizeof(int)); i++) {
 161                 ((int*)event)[i] = 0xdeadbeef;
 162         }
 163         event->event_type = dead_event;
 164         event->channel = Qnil;
 165         set_lheader_implementation(&event->lheader, &lrecord_event);
 166         XSET_EVENT_NEXT(ev, Qnil);
 167 }
 168
 169 /* Set everything to zero or nil so that it's predictable. */
 170 void zero_event(Lisp_Event * e)
 171 {
 172         xzero(*e);
 173         set_lheader_implementation(&e->lheader, &lrecord_event);
 174         e->event_type = empty_event;
 175         e->next = Qnil;
 176         e->channel = Qnil;
 177 }
 178
 179 static Lisp_Object mark_event(Lisp_Object obj)
 180 {
 181         Lisp_Event *event = XEVENT(obj);
 182
 183         switch (event->event_type) {
 184         case key_press_event:
 185                 mark_object(event->event.key.keysym);
 186                 break;
 187         case process_event:
 188                 mark_object(event->event.process.process);
 189                 break;
 190         case timeout_event:
 191                 mark_object(event->event.timeout.function);
 192                 mark_object(event->event.timeout.object);
 193                 break;
 194         case eval_event:
 195         case misc_user_event:
 196                 mark_object(event->event.eval.function);
 197                 mark_object(event->event.eval.object);
 198                 break;
 199         case magic_eval_event:
 200                 mark_object(event->event.magic_eval.object);
 201                 break;
 202 #ifdef EF_USE_ASYNEQ
 203         case work_started_event:
 204                 if (event->event.work_started.job)
 205                         mark_object(event->event.work_started.job);
 206                 break;
 207         case work_finished_event:
 208                 if (event->event.work_finished.job)
 209                         mark_object(event->event.work_finished.job);
 210                 break;
 211         case eaten_myself_event:
 212 #endif
 213         case button_press_event:
 214         case button_release_event:
 215         case pointer_motion_event:
 216         case magic_event:
 217         case empty_event:
 218         case dead_event:
 219                 break;
 220         default:
 221                 abort();
 222         }
 223         mark_object(event->channel);
 224         return event->next;
 225 }
 226
 227 static void
 228 print_event_1(const char *str, Lisp_Object obj, Lisp_Object printcharfun)
 229 {
 230         char buf[255];
 231         write_c_string(str, printcharfun);
 232         format_event_object(buf, XEVENT(obj), 0);
 233         write_c_string(buf, printcharfun);
 234 }
 235
 236 static void
 237 print_event(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 238 {
 239         if (print_readably)
 240                 error("Printing unreadable object #<event>");
 241
 242         switch (XEVENT(obj)->event_type) {
 243         case key_press_event:
 244                 print_event_1("#<keypress-event ", obj, printcharfun);
 245                 break;
 246         case button_press_event:
 247                 print_event_1("#<buttondown-event ", obj, printcharfun);
 248                 break;
 249         case button_release_event:
 250                 print_event_1("#<buttonup-event ", obj, printcharfun);
 251                 break;
 252         case magic_event:
 253         case magic_eval_event:
 254                 print_event_1("#<magic-event ", obj, printcharfun);
 255                 break;
 256         case pointer_motion_event: {
 257                 Lisp_Object Vx, Vy;
 258                 Vx = Fevent_x_pixel(obj);
 259                 assert(INTP(Vx));
 260                 Vy = Fevent_y_pixel(obj);
 261                 assert(INTP(Vy));
 262                 write_fmt_str(printcharfun, "#<motion-event %ld, %ld", (long)XINT(Vx),
 263                               (long)XINT(Vy));
 264                 break;
 265         }
 266         case process_event:
 267                 write_c_string("#<process-event ", printcharfun);
 268                 print_internal(XEVENT(obj)->event.process.process, printcharfun,
 269                                1);
 270                 break;
 271         case timeout_event:
 272                 write_c_string("#<timeout-event ", printcharfun);
 273                 print_internal(XEVENT(obj)->event.timeout.object, printcharfun,
 274                                1);
 275                 break;
 276         case empty_event:
 277                 write_c_string("#<empty-event", printcharfun);
 278                 break;
 279         case misc_user_event:
 280                 write_c_string("#<misc-user-event (", printcharfun);
 281                 print_internal(XEVENT(obj)->event.misc.function, printcharfun,
 282                                1);
 283                 write_c_string(" ", printcharfun);
 284                 print_internal(XEVENT(obj)->event.misc.object, printcharfun, 1);
 285                 write_c_string(")", printcharfun);
 286                 break;
 287         case eval_event:
 288                 write_c_string("#<eval-event (", printcharfun);
 289                 print_internal(XEVENT(obj)->event.eval.function, printcharfun,
 290                                1);
 291                 write_c_string(" ", printcharfun);
 292                 print_internal(XEVENT(obj)->event.eval.object, printcharfun, 1);
 293                 write_c_string(")", printcharfun);
 294                 break;
 295         case dead_event:
 296                 write_c_string("#<DEALLOCATED-EVENT", printcharfun);
 297                 break;
 298 #ifdef EF_USE_ASYNEQ
 299         case eaten_myself_event:
 300                 write_c_string("#<worker-suidice-event", printcharfun);
 301                 break;
 302         case work_started_event:
 303                 write_c_string("#<worker-work-started-event", printcharfun);
 304                 break;
 305         case work_finished_event:
 306                 write_c_string("#<worker-work-finished-event", printcharfun);
 307                 break;
 308 #endif  /* EF_USE_ASYNEQ */
 309         default:
 310                 write_c_string("#<UNKNOWN-EVENT-TYPE", printcharfun);
 311                 break;
 312         }
 313         write_c_string(">", printcharfun);
 314 }
 315
 316 static int
 317 event_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
 318 {
 319         Lisp_Event *e1 = XEVENT(obj1);
 320         Lisp_Event *e2 = XEVENT(obj2);
 321
 322         if (e1->event_type != e2->event_type)
 323                 return 0;
 324         if (!EQ(e1->channel, e2->channel))
 325                 return 0;
 326         /*  if (e1->timestamp != e2->timestamp) return 0; */
 327         switch (e1->event_type) {
 328         default:
 329                 abort();
 330
 331         case process_event:
 332                 return EQ(e1->event.process.process, e2->event.process.process);
 333
 334         case timeout_event:
 335                 return (internal_equal(e1->event.timeout.function,
 336                                        e2->event.timeout.function, 0) &&
 337                         internal_equal(e1->event.timeout.object,
 338                                        e2->event.timeout.object, 0));
 339
 340         case key_press_event:
 341                 return (EQ(e1->event.key.keysym, e2->event.key.keysym) &&
 342                         (e1->event.key.modifiers == e2->event.key.modifiers));
 343
 344         case button_press_event:
 345         case button_release_event:
 346                 return (e1->event.button.button == e2->event.button.button &&
 347                         e1->event.button.modifiers ==
 348                         e2->event.button.modifiers);
 349
 350         case pointer_motion_event:
 351                 return (e1->event.motion.x == e2->event.motion.x &&
 352                         e1->event.motion.y == e2->event.motion.y);
 353
 354         case misc_user_event:
 355                 return (internal_equal(e1->event.eval.function,
 356                                        e2->event.eval.function, 0) &&
 357                         internal_equal(e1->event.eval.object,
 358                                        e2->event.eval.object, 0) &&
 359                         /* is this really needed for equality
 360                            or is x and y also important? */
 361                         e1->event.misc.button == e2->event.misc.button &&
 362                         e1->event.misc.modifiers == e2->event.misc.modifiers);
 363
 364         case eval_event:
 365                 return (internal_equal(e1->event.eval.function,
 366                                        e2->event.eval.function, 0) &&
 367                         internal_equal(e1->event.eval.object,
 368                                        e2->event.eval.object, 0));
 369
 370         case magic_eval_event:
 371                 return (e1->event.magic_eval.internal_function ==
 372                         e2->event.magic_eval.internal_function &&
 373                         internal_equal(e1->event.magic_eval.object,
 374                                        e2->event.magic_eval.object, 0));
 375
 376         case magic_event: {
 377                 struct console *con =
 378                         XCONSOLE(CDFW_CONSOLE(e1->channel));
 379
 380 #ifdef HAVE_X_WINDOWS
 381                 if (CONSOLE_X_P(con))
 382                         return (e1->event.magic.underlying_x_event.xany.
 383                                 serial ==
 384                                 e2->event.magic.underlying_x_event.xany.
 385                                 serial);
 386 #endif
 387 #ifdef HAVE_TTY
 388                 if (CONSOLE_TTY_P(con))
 389                         return (e1->event.magic.underlying_tty_event ==
 390                                 e2->event.magic.underlying_tty_event);
 391 #endif
 392                 abort();
 393                 return 1;       /* not reached */
 394         }
 395
 396 #ifdef EF_USE_ASYNEQ
 397                 /* worker thread mumbo jumbo is never equal */
 398         case eaten_myself_event:
 399         case work_started_event:
 400         case work_finished_event:
 401                 return 0;
 402 #endif  /* EF_USE_ASYNEQ */
 403
 404                 /* Empty and deallocated events are equal. */
 405         case empty_event:
 406         case dead_event:
 407                 return 1;
 408         }
 409 }
 410
 411 static unsigned long
 412 event_hash(Lisp_Object obj, int depth)
 413 {
 414         Lisp_Event *e = XEVENT(obj);
 415         unsigned long hash;
 416
 417         hash = HASH2(e->event_type, LISP_HASH(e->channel));
 418         switch (e->event_type) {
 419         case process_event:
 420                 return HASH2(hash, LISP_HASH(e->event.process.process));
 421
 422         case timeout_event:
 423                 return HASH3(hash,
 424                              internal_hash(e->event.timeout.function,
 425                                            depth + 1),
 426                              internal_hash(e->event.timeout.object, depth + 1));
 427
 428         case key_press_event:
 429                 return HASH3(hash, LISP_HASH(e->event.key.keysym),
 430                              e->event.key.modifiers);
 431
 432         case button_press_event:
 433         case button_release_event:
 434                 return HASH3(hash, e->event.button.button,
 435                              e->event.button.modifiers);
 436
 437         case pointer_motion_event:
 438                 return HASH3(hash, e->event.motion.x, e->event.motion.y);
 439
 440         case misc_user_event:
 441                 return HASH5(hash,
 442                              internal_hash(e->event.misc.function, depth + 1),
 443                              internal_hash(e->event.misc.object, depth + 1),
 444                              e->event.misc.button, e->event.misc.modifiers);
 445
 446         case eval_event:
 447                 return HASH3(hash,
 448                              internal_hash(e->event.eval.function, depth + 1),
 449                              internal_hash(e->event.eval.object, depth + 1));
 450
 451         case magic_eval_event:
 452                 return HASH3(hash,
 453                              (unsigned long)e->event.magic_eval.
 454                              internal_function,
 455                              internal_hash(e->event.magic_eval.object,
 456                                            depth + 1));
 457
 458         case magic_event: {
 459                 struct console *con =
 460                         XCONSOLE(CDFW_CONSOLE(EVENT_CHANNEL(e)));
 461 #ifdef HAVE_X_WINDOWS
 462                 if (CONSOLE_X_P(con))
 463                         return HASH2(hash,
 464                                      e->event.magic.underlying_x_event.
 465                                      xany.serial);
 466 #endif
 467 #ifdef HAVE_TTY
 468                 if (CONSOLE_TTY_P(con))
 469                         return HASH2(hash,
 470                                      e->event.magic.
 471                                      underlying_tty_event);
 472 #endif
 473                 abort();
 474                 return 0;
 475         }
 476
 477 #ifdef EF_USE_ASYNEQ
 478         case eaten_myself_event:
 479         case work_started_event:
 480         case work_finished_event:
 481                 return (long unsigned int)obj;
 482 #endif  /* EF_USE_ASYNEQ */
 483
 484         case empty_event:
 485         case dead_event:
 486                 return hash;
 487
 488         default:
 489                 abort();
 490         }
 491
 492         return 0;               /* unreached */
 493 }
 494
 495 DEFINE_BASIC_LRECORD_IMPLEMENTATION("event", event,
 496                                     mark_event, print_event, 0, event_equal,
 497                                     event_hash, 0, Lisp_Event);
 498 \f
 499 Lisp_Object
 500 make_empty_event(void)
 501 {
 502         Lisp_Object event = Qnil;
 503         Lisp_Event *e;
 504
 505 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
 506 /* just allocate */
 507         event = allocate_event();
 508
 509 #else  /* !BDWGC */
 510         struct gcpro gcpro1;
 511
 512         GCPRO1(event);
 513         lock_Vevent_resource();
 514         if (!NILP(Vevent_resource)) {
 515                 event = Vevent_resource;
 516                 Vevent_resource = XEVENT_NEXT(event);
 517         } else {
 518                 event = allocate_event();
 519         }
 520         unlock_Vevent_resource();
 521 #endif  /* BDWGC */
 522         e = XEVENT(event);
 523         zero_event(e);
 524
 525         e->event_type = empty_event;
 526         e->next = Qnil;
 527         EVENT_CHANNEL(e) = Qnil;
 528
 529         UNGCPRO;
 530         return event;
 531 }
 532
 533 sxe_event_t
 534 make_noseeum_event(emacs_event_type event_type)
 535 {
 536         sxe_event_t res = xnew_and_zero(Lisp_Event);
 537
 538         res->event_type = event_type;
 539         res->next = Qnil;
 540         EVENT_CHANNEL(res) = Qnil;
 541         return res;
 542 }
 543
 544 DEFUN("make-event", Fmake_event, 0, 2, 0,       /*
 545 Return a new event of type TYPE, with properties described by PLIST.
 546
 547 TYPE is a symbol, either `empty', `key-press', `button-press',
 548 `button-release', `misc-user' or `motion'.  If TYPE is nil, it
 549 defaults to `empty'.
 550
 551 PLIST is a property list, the properties being compatible to those
 552 returned by `event-properties'.  The following properties are
 553 allowed:
 554
 555 channel   -- The event channel, a frame or a console.  For
 556 button-press, button-release, misc-user and motion events,
 557 this must be a frame.  For key-press events, it must be
 558 a console.  If channel is unspecified, it will be set to
 559 the selected frame or selected console, as appropriate.
 560 key               -- The event key, a symbol or character.  Allowed only for
 561 keypress events.
 562 button            -- The event button, integer 1, 2 or 3.  Allowed for
 563 button-press, button-release and misc-user events.
 564 modifiers -- The event modifiers, a list of modifier symbols.  Allowed
 565 for key-press, button-press, button-release, motion and
 566 misc-user events.
 567 function       -- Function. Allowed for misc-user events only.
 568 object         -- An object, function's parameter. Allowed for misc-user
 569 events only.
 570 x         -- The event X coordinate, an integer.  This is relative
 571 to the left of CHANNEL's root window.  Allowed for
 572 motion, button-press, button-release and misc-user events.
 573 y         -- The event Y coordinate, an integer.  This is relative
 574 to the top of CHANNEL's root window.  Allowed for
 575 motion, button-press, button-release and misc-user events.
 576 timestamp -- The event timestamp, a non-negative integer.  Allowed for
 577 all types of events.  If unspecified, it will be set to 0
 578 by default.
 579
 580 For event type `empty', PLIST must be nil.
 581 `button-release', or `motion'.  If TYPE is left out, it defaults to
 582 `empty'.
 583 PLIST is a list of properties, as returned by `event-properties'.  Not
 584 all properties are allowed for all kinds of events, and some are
 585 required.
 586
 587 WARNING: the event object returned may be a reused one; see the function
 588 `deallocate-event'.
 589 */
 590       (type, plist))
 591 {
 592         Lisp_Object event = Qnil;
 593         Lisp_Event *e;
 594         EMACS_INT coord_x = 0, coord_y = 0;
 595         struct gcpro gcpro1;
 596
 597         if (NILP(type)) {
 598                 /* common case */
 599                 return make_empty_event();
 600         }
 601
 602 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
 603         event = allocate_event();
 604
 605 #else  /* !BDWGC */
 606         GCPRO1(event);
 607         lock_Vevent_resource();
 608         if (!NILP(Vevent_resource)) {
 609                 event = Vevent_resource;
 610                 Vevent_resource = XEVENT_NEXT(event);
 611         } else {
 612                 event = allocate_event();
 613         }
 614         unlock_Vevent_resource();
 615 #endif  /* BDWGC */
 616         e = XEVENT(event);
 617         zero_event(e);
 618
 619         if (EQ(type, Qempty)) {
 620                 /* For empty event, we return immediately, without processing
 621                    PLIST.  In fact, processing PLIST would be wrong, because the
 622                    sanitizing process would fill in the properties
 623                    (e.g. CHANNEL), which we don't want in empty events.  */
 624                 e->event_type = empty_event;
 625                 if (!NILP(plist))
 626                         syntax_error("Cannot set properties of empty event",
 627                                      plist);
 628                 UNGCPRO;
 629                 return event;
 630         } else if (EQ(type, Qkey_press)) {
 631                 e->event_type = key_press_event;
 632                 e->event.key.keysym = Qunbound;
 633         } else if (EQ(type, Qbutton_press)) {
 634                 e->event_type = button_press_event;
 635         } else if (EQ(type, Qbutton_release)) {
 636                 e->event_type = button_release_event;
 637         } else if (EQ(type, Qmotion)) {
 638                 e->event_type = pointer_motion_event;
 639         } else if (EQ(type, Qmisc_user)) {
 640                 e->event_type = misc_user_event;
 641                 e->event.eval.function = e->event.eval.object = Qnil;
 642         } else {
 643                 /* Not allowed:
 644                    Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval.  */
 645                 invalid_argument("Invalid event type", type);
 646         }
 647
 648         EVENT_CHANNEL(e) = Qnil;
 649
 650         plist = Fcopy_sequence(plist);
 651         Fcanonicalize_plist(plist, Qnil);
 652
 653 #define WRONG_EVENT_TYPE_FOR_PROPERTY(event_type, prop)                 \
 654         syntax_error_2 ("Invalid property for event type", prop, event_type)
 655
 656         {
 657                 EXTERNAL_PROPERTY_LIST_LOOP_3(keyword, value, plist) {
 658                         if (EQ(keyword, Qchannel)) {
 659                                 if (e->event_type == key_press_event) {
 660                                         if (!CONSOLEP(value))
 661                                                 value =
 662                                                     wrong_type_argument
 663                                                     (Qconsolep, value);
 664                                 } else {
 665                                         if (!FRAMEP(value))
 666                                                 value =
 667                                                     wrong_type_argument(Qframep,
 668                                                                         value);
 669                                 }
 670                                 EVENT_CHANNEL(e) = value;
 671                         } else if (EQ(keyword, Qkey)) {
 672                                 switch (e->event_type) {
 673                                 case key_press_event:
 674                                         if (!SYMBOLP(value) && !CHARP(value))
 675                                                 syntax_error
 676                                                     ("Invalid event key",
 677                                                      value);
 678                                         e->event.key.keysym = value;
 679                                         break;
 680
 681                                         /* rest goes here */
 682                                 case empty_event:
 683                                 case button_press_event:
 684                                 case button_release_event:
 685                                 case pointer_motion_event:
 686                                 case process_event:
 687                                 case timeout_event:
 688                                 case magic_event:
 689                                 case magic_eval_event:
 690                                 case eval_event:
 691                                 case misc_user_event:
 692 #ifdef EF_USE_ASYNEQ
 693                                 case eaten_myself_event:
 694                                 case work_started_event:
 695                                 case work_finished_event:
 696 #endif  /* EF_USE_ASYNEQ */
 697                                 case dead_event:
 698                                 default:
 699                                         WRONG_EVENT_TYPE_FOR_PROPERTY(type,
 700                                                                       keyword);
 701                                         break;
 702                                 }
 703                         } else if (EQ(keyword, Qbutton)) {
 704                                 CHECK_NATNUM(value);
 705                                 check_int_range(XINT(value), 0, 7);
 706
 707                                 switch (e->event_type) {
 708                                 case button_press_event:
 709                                 case button_release_event:
 710                                         e->event.button.button = XINT(value);
 711                                         break;
 712                                 case misc_user_event:
 713                                         e->event.misc.button = XINT(value);
 714                                         break;
 715
 716                                         /* and the rest of that lot */
 717                                 case empty_event:
 718                                 case key_press_event:
 719                                 case pointer_motion_event:
 720                                 case process_event:
 721                                 case timeout_event:
 722                                 case magic_event:
 723                                 case magic_eval_event:
 724                                 case eval_event:
 725 #ifdef EF_USE_ASYNEQ
 726                                 case eaten_myself_event:
 727                                 case work_started_event:
 728                                 case work_finished_event:
 729 #endif  /* EF_USE_ASYNEQ */
 730                                 case dead_event:
 731                                 default:
 732                                         WRONG_EVENT_TYPE_FOR_PROPERTY(type,
 733                                                                       keyword);
 734                                         break;
 735                                 }
 736                         } else if (EQ(keyword, Qmodifiers)) {
 737                                 int modifiers = 0;
 738
 739                                 EXTERNAL_LIST_LOOP_2(sym, value) {
 740                                         if (EQ(sym, Qcontrol))
 741                                                 modifiers |= XEMACS_MOD_CONTROL;
 742                                         else if (EQ(sym, Qmeta))
 743                                                 modifiers |= XEMACS_MOD_META;
 744                                         else if (EQ(sym, Qsuper))
 745                                                 modifiers |= XEMACS_MOD_SUPER;
 746                                         else if (EQ(sym, Qhyper))
 747                                                 modifiers |= XEMACS_MOD_HYPER;
 748                                         else if (EQ(sym, Qalt))
 749                                                 modifiers |= XEMACS_MOD_ALT;
 750                                         else if (EQ(sym, Qsymbol))
 751                                                 modifiers |= XEMACS_MOD_ALT;
 752                                         else if (EQ(sym, Qshift))
 753                                                 modifiers |= XEMACS_MOD_SHIFT;
 754                                         else if (EQ(sym, Qbutton1))
 755                                                 modifiers |= XEMACS_MOD_BUTTON1;
 756                                         else if (EQ(sym, Qbutton2))
 757                                                 modifiers |= XEMACS_MOD_BUTTON2;
 758                                         else if (EQ(sym, Qbutton3))
 759                                                 modifiers |= XEMACS_MOD_BUTTON3;
 760                                         else if (EQ(sym, Qbutton4))
 761                                                 modifiers |= XEMACS_MOD_BUTTON4;
 762                                         else if (EQ(sym, Qbutton5))
 763                                                 modifiers |= XEMACS_MOD_BUTTON5;
 764                                         else
 765                                                 syntax_error
 766                                                     ("Invalid key modifier",
 767                                                      sym);
 768                                 }
 769
 770                                 switch (e->event_type) {
 771                                 case key_press_event:
 772                                         e->event.key.modifiers = modifiers;
 773                                         break;
 774                                 case button_press_event:
 775                                 case button_release_event:
 776                                         e->event.button.modifiers = modifiers;
 777                                         break;
 778                                 case pointer_motion_event:
 779                                         e->event.motion.modifiers = modifiers;
 780                                         break;
 781                                 case misc_user_event:
 782                                         e->event.misc.modifiers = modifiers;
 783                                         break;
 784
 785                                         /* here come the rest */
 786                                 case empty_event:
 787                                 case process_event:
 788                                 case timeout_event:
 789                                 case magic_event:
 790                                 case magic_eval_event:
 791                                 case eval_event:
 792 #ifdef EF_USE_ASYNEQ
 793                                 case eaten_myself_event:
 794                                 case work_started_event:
 795                                 case work_finished_event:
 796 #endif  /* EF_USE_ASYNEQ */
 797                                 case dead_event:
 798                                 default:
 799                                         WRONG_EVENT_TYPE_FOR_PROPERTY(type,
 800                                                                       keyword);
 801                                         break;
 802                                 }
 803                         } else if (EQ(keyword, Qx)) {
 804                                 switch (e->event_type) {
 805                                 case pointer_motion_event:
 806                                 case button_press_event:
 807                                 case button_release_event:
 808                                 case misc_user_event:
 809                                         /* Allow negative values, so we can specify toolbar
 810                                            positions.  */
 811                                         CHECK_INT(value);
 812                                         coord_x = XINT(value);
 813                                         break;
 814
 815                                         /* rest goes here */
 816                                 case empty_event:
 817                                 case key_press_event:
 818                                 case process_event:
 819                                 case timeout_event:
 820                                 case magic_event:
 821                                 case magic_eval_event:
 822                                 case eval_event:
 823 #ifdef EF_USE_ASYNEQ
 824                                 case eaten_myself_event:
 825                                 case work_started_event:
 826                                 case work_finished_event:
 827 #endif  /* EF_USE_ASYNEQ */
 828                                 case dead_event:
 829                                 default:
 830                                         WRONG_EVENT_TYPE_FOR_PROPERTY(type,
 831                                                                       keyword);
 832                                         break;
 833                                 }
 834                         } else if (EQ(keyword, Qy)) {
 835                                 switch (e->event_type) {
 836                                 case pointer_motion_event:
 837                                 case button_press_event:
 838                                 case button_release_event:
 839                                 case misc_user_event:
 840                                         /* Allow negative values; see above. */
 841                                         CHECK_INT(value);
 842                                         coord_y = XINT(value);
 843                                         break;
 844
 845                                         /* et la reste */
 846                                 case empty_event:
 847                                 case key_press_event:
 848                                 case process_event:
 849                                 case timeout_event:
 850                                 case magic_event:
 851                                 case magic_eval_event:
 852                                 case eval_event:
 853 #ifdef EF_USE_ASYNEQ
 854                                 case eaten_myself_event:
 855                                 case work_started_event:
 856                                 case work_finished_event:
 857 #endif  /* EF_USE_ASYNEQ */
 858                                 case dead_event:
 859                                 default:
 860                                         WRONG_EVENT_TYPE_FOR_PROPERTY(type,
 861                                                                       keyword);
 862                                         break;
 863                                 }
 864                         } else if (EQ(keyword, Qtimestamp)) {
 865                                 CHECK_NATNUM(value);
 866                                 e->timestamp = XINT(value);
 867                         } else if (EQ(keyword, Qfunction)) {
 868                                 switch (e->event_type) {
 869                                 case misc_user_event:
 870                                         e->event.eval.function = value;
 871                                         break;
 872
 873                                         /* rest goes here */
 874                                 case empty_event:
 875                                 case key_press_event:
 876                                 case button_press_event:
 877                                 case button_release_event:
 878                                 case pointer_motion_event:
 879                                 case process_event:
 880                                 case timeout_event:
 881                                 case magic_event:
 882                                 case magic_eval_event:
 883                                 case eval_event:
 884 #ifdef EF_USE_ASYNEQ
 885                                 case eaten_myself_event:
 886                                 case work_started_event:
 887                                 case work_finished_event:
 888 #endif  /* EF_USE_ASYNEQ */
 889                                 case dead_event:
 890                                 default:
 891                                         WRONG_EVENT_TYPE_FOR_PROPERTY(type,
 892                                                                       keyword);
 893                                         break;
 894                                 }
 895                         } else if (EQ(keyword, Qobject)) {
 896                                 switch (e->event_type) {
 897                                 case misc_user_event:
 898                                         e->event.eval.object = value;
 899                                         break;
 900
 901                                         /* rest goes here */
 902                                 case empty_event:
 903                                 case key_press_event:
 904                                 case button_press_event:
 905                                 case button_release_event:
 906                                 case pointer_motion_event:
 907                                 case process_event:
 908                                 case timeout_event:
 909                                 case magic_event:
 910                                 case magic_eval_event:
 911                                 case eval_event:
 912 #ifdef EF_USE_ASYNEQ
 913                                 case eaten_myself_event:
 914                                 case work_started_event:
 915                                 case work_finished_event:
 916 #endif  /* EF_USE_ASYNEQ */
 917                                 case dead_event:
 918                                 default:
 919                                         WRONG_EVENT_TYPE_FOR_PROPERTY(type,
 920                                                                       keyword);
 921                                         break;
 922                                 }
 923                         } else
 924                                 syntax_error_2("Invalid property", keyword,
 925                                                value);
 926                 }
 927         }
 928
 929         /* Insert the channel, if missing. */
 930         if (NILP(EVENT_CHANNEL(e))) {
 931                 if (e->event_type == key_press_event)
 932                         EVENT_CHANNEL(e) = Vselected_console;
 933                 else
 934                         EVENT_CHANNEL(e) = Fselected_frame(Qnil);
 935         }
 936
 937         /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
 938            to the frame, so we must adjust accordingly.  */
 939         if (FRAMEP(EVENT_CHANNEL(e))) {
 940                 coord_x +=
 941                     FRAME_REAL_LEFT_TOOLBAR_WIDTH(XFRAME(EVENT_CHANNEL(e)));
 942                 coord_y +=
 943                     FRAME_REAL_TOP_TOOLBAR_HEIGHT(XFRAME(EVENT_CHANNEL(e)));
 944
 945                 switch (e->event_type) {
 946                 case pointer_motion_event:
 947                         e->event.motion.x = coord_x;
 948                         e->event.motion.y = coord_y;
 949                         break;
 950                 case button_press_event:
 951                 case button_release_event:
 952                         e->event.button.x = coord_x;
 953                         e->event.button.y = coord_y;
 954                         break;
 955                 case misc_user_event:
 956                         e->event.misc.x = coord_x;
 957                         e->event.misc.y = coord_y;
 958                         break;
 959
 960                         /* rest goes here */
 961                 case empty_event:
 962                 case key_press_event:
 963                 case process_event:
 964                 case timeout_event:
 965                 case magic_event:
 966                 case magic_eval_event:
 967                 case eval_event:
 968 #ifdef EF_USE_ASYNEQ
 969                 case eaten_myself_event:
 970                 case work_started_event:
 971                 case work_finished_event:
 972 #endif  /* EF_USE_ASYNEQ */
 973                 case dead_event:
 974                 default:
 975                         abort();
 976                 }
 977         }
 978
 979         /* Finally, do some more validation.  */
 980         switch (e->event_type) {
 981         case key_press_event:
 982                 if (UNBOUNDP(e->event.key.keysym))
 983                         syntax_error
 984                             ("A key must be specified to make a "
 985                              "keypress event", plist);
 986                 break;
 987         case button_press_event:
 988                 if (!e->event.button.button)
 989                         syntax_error
 990                             ("A button must be specified to make a "
 991                              "button-press event", plist);
 992                 break;
 993         case button_release_event:
 994                 if (!e->event.button.button)
 995                         syntax_error
 996                             ("A button must be specified to make a "
 997                              "button-release event", plist);
 998                 break;
 999         case misc_user_event:
1000                 if (NILP(e->event.misc.function))
1001                         syntax_error
1002                             ("A function must be specified to make a "
1003                              "misc-user event", plist);
1004                 break;
1005
1006         case empty_event:
1007         case pointer_motion_event:
1008         case process_event:
1009         case timeout_event:
1010         case magic_event:
1011         case magic_eval_event:
1012         case eval_event:
1013 #ifdef EF_USE_ASYNEQ
1014         case eaten_myself_event:
1015         case work_started_event:
1016         case work_finished_event:
1017 #endif  /* EF_USE_ASYNEQ */
1018         case dead_event:
1019         default:
1020                 break;
1021         }
1022
1023         UNGCPRO;
1024         return event;
1025 }
1026
1027 DEFUN("deallocate-event", Fdeallocate_event, 1, 1, 0,   /*
1028 Allow the given event structure to be reused.
1029 You MUST NOT use this event object after calling this function with it.
1030 You will lose.  It is not necessary to call this function, as event
1031 objects are garbage-collected like all other objects; however, it may
1032 be more efficient to explicitly deallocate events when you are sure
1033 that it is safe to do so.
1034 */
1035       (event))
1036 {
1037         CHECK_EVENT(event);
1038
1039         if (XEVENT_TYPE(event) == dead_event)
1040                 error("this event is already deallocated!");
1041
1042         assert(XEVENT_TYPE(event) <= last_event_type);
1043
1044 #if 0
1045         {
1046                 int i, len;
1047
1048                 if (EQ(event, Vlast_command_event) ||
1049                     EQ(event, Vlast_input_event) ||
1050                     EQ(event, Vunread_command_event))
1051                         abort();
1052
1053                 len = XVECTOR_LENGTH(Vthis_command_keys);
1054                 for (i = 0; i < len; i++)
1055                         if (EQ(event, XVECTOR_DATA(Vthis_command_keys)[i]))