Mercurial > hg > xemacs-beta

comparison src/events.c @ 213:78f53ef88e17 r20-4b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-4b5
author cvs
date Mon, 13 Aug 2007 10:06:47 +0200
parents 41ff10fd062f
children 1f0dabaa0855
comparison
equal deleted inserted replaced
212:d8688acf4c5b 213:78f53ef88e17
184 case magic_eval_event: 184 case magic_eval_event:
185 print_event_1 ("#<magic-event ", obj, printcharfun); 185 print_event_1 ("#<magic-event ", obj, printcharfun);
186 break; 186 break;
187 case pointer_motion_event: 187 case pointer_motion_event:
188 { 188 {
189 char buf[100]; 189 char buf[64];
190 sprintf (buf, "#<motion-event %d, %d", 190 sprintf (buf, "#<motion-event %d, %d",
191 XEVENT (obj)->event.motion.x, XEVENT (obj)->event.motion.y); 191 XEVENT (obj)->event.motion.x, XEVENT (obj)->event.motion.y);
192 write_c_string (buf, printcharfun); 192 write_c_string (buf, printcharfun);
193 break; 193 break;
194 } 194 }
296 #ifdef HAVE_TTY 296 #ifdef HAVE_TTY
297 if (CONSOLE_TTY_P (con)) 297 if (CONSOLE_TTY_P (con))
298 return (e1->event.magic.underlying_tty_event == 298 return (e1->event.magic.underlying_tty_event ==
299 e2->event.magic.underlying_tty_event); 299 e2->event.magic.underlying_tty_event);
300 #endif 300 #endif
301 #ifdef HAVE_W32GUI 301 #ifdef HAVE_MS_WINDOWS
302 if (CONSOLE_W32_P (con)) 302 if (CONSOLE_MSWINDOWS_P (con))
303 return (!memcmp(&e1->event.magic.underlying_w32_event, 303 return (!memcmp(&e1->event.magic.underlying_mswindows_event,
304 &e2->event.magic.underlying_w32_event, 304 &e2->event.magic.underlying_mswindows_event,
305 sizeof(union magic_data))); 305 sizeof(union magic_data)));
306 #endif 306 #endif
307 return 1; /* not reached */ 307 return 1; /* not reached */
308 } 308 }
309 309
369 #endif 369 #endif
370 #ifdef HAVE_TTY 370 #ifdef HAVE_TTY
371 if (CONSOLE_TTY_P (con)) 371 if (CONSOLE_TTY_P (con))
372 return HASH2 (hash, e->event.magic.underlying_tty_event); 372 return HASH2 (hash, e->event.magic.underlying_tty_event);
373 #endif 373 #endif
374 #ifdef HAVE_W32GUI 374 #ifdef HAVE_MS_WINDOWS
375 if (CONSOLE_W32_P (con)) 375 if (CONSOLE_MSWINDOWS_P (con))
376 return HASH6 (hash, e->event.magic.underlying_w32_event.message, 376 return HASH6 (hash, e->event.magic.underlying_mswindows_event.message,
377 e->event.magic.underlying_w32_event.data[0], 377 e->event.magic.underlying_mswindows_event.data[0],
378 e->event.magic.underlying_w32_event.data[1], 378 e->event.magic.underlying_mswindows_event.data[1],
379 e->event.magic.underlying_w32_event.data[2], 379 e->event.magic.underlying_mswindows_event.data[2],
380 e->event.magic.underlying_w32_event.data[3], 380 e->event.magic.underlying_mswindows_event.data[3],
381 ); 381 );
382 #endif 382 #endif
383 } 383 }
384 384
385 case empty_event: 385 case empty_event:
386 case dead_event: 386 case dead_event:
393 return 0; /* unreached */ 393 return 0; /* unreached */
394 } 394 }
395 395
396 396
397 DEFUN ("make-event", Fmake_event, 0, 2, 0, /* 397 DEFUN ("make-event", Fmake_event, 0, 2, 0, /*
398 Create a new event of type TYPE, with properties stored in PLIST. 398 Create a new event of type TYPE, with properties described by PLIST.
399
399 TYPE is a symbol, either `empty', `key-press', `button-press', 400 TYPE is a symbol, either `empty', `key-press', `button-press',
401 `button-release', `motion' or `dnd-drop'. If TYPE is nil, it
402 defaults to `empty'.
403
404 PLIST is a property list, the properties being compatible to those
405 returned by `event-properties'. The following properties are
406 allowed:
407
408 channel -- The event channel, a frame or a console. For
409 button-press, button-release and motion events, this
410 must be a frame. For key-press events, it must be a
411 console. If channel is unspecified, it will be set to
412 the selected frame or selected console, as appropriate.
413 key -- The event key, a symbol or character. Allowed only for
414 keypress events.
415 button -- The event button, integer 1, 2 or 3. Allowed only for
416 button-press and button-release events.
417 modifiers -- The event modifiers, a list of modifier symbols. Allowed
418 for key-press, button-press, button-release and motion
419 events.
420 x -- The event X coordinate, an integer. This is relative
421 to the left of CHANNEL's root window. Allowed for
422 motion, button-press and button-release events.
423 y -- The event Y coordinate, an integer. This is relative
424 to the top of CHANNEL's root window. Allowed for
425 motion, button-press and button-release events.
426 dnd-data -- The event DND data, a list of (INTEGER DATA). Allowed
427 for dnd-drop events, if support for DND has been
428 compiled into XEmacs.
429 timestamp -- The event timestamp, a non-negative integer. Allowed for
430 all types of events.
431
432 For event type `empty', PLIST must be nil.
400 `button-release', or `motion'. If TYPE is left out, it defaults to 433 `button-release', or `motion'. If TYPE is left out, it defaults to
401 `empty'. 434 `empty'.
402 PLIST is a list of properties, as returned by `event-properties'. Not 435 PLIST is a list of properties, as returned by `event-properties'. Not
403 all properties are allowed for all kinds of events, and some are 436 all properties are allowed for all kinds of events, and some are
404 required. 437 required.
405 438
406 WARNING, the event object returned may be a reused one; see the function 439 WARNING: the event object returned may be a reused one; see the function
407 `deallocate-event'. 440 `deallocate-event'.
408 */ 441 */
409 (type, plist)) 442 (type, plist))
410 { 443 {
411 Lisp_Object event, prop, val; 444 Lisp_Object tail, keyword, value;
445 Lisp_Object event = Qnil;
446 Lisp_Object dnd_data = Qnil;
412 struct Lisp_Event *e; 447 struct Lisp_Event *e;
448 EMACS_INT coord_x = 0, coord_y = 0;
449 struct gcpro gcpro1, gcpro2;
450
451 GCPRO2 (event, dnd_data);
413 452
414 if (NILP (type)) 453 if (NILP (type))
415 type = Qempty; 454 type = Qempty;
416 455
417 if (!NILP (Vevent_resource)) 456 if (!NILP (Vevent_resource))
424 event = allocate_event (); 463 event = allocate_event ();
425 } 464 }
426 e = XEVENT (event); 465 e = XEVENT (event);
427 zero_event (e); 466 zero_event (e);
428 467
429 if (EQ (type, Qkey_press)) 468 if (EQ (type, Qempty))
469 {
470 /* For empty event, we return immediately, without processing
471 PLIST. In fact, processing PLIST would be wrong, because the
472 sanitizing process would fill in the properties
473 (e.g. CHANNEL), which we don't want in empty events. */
474 e->event_type = empty_event;
475 if (!NILP (plist))
476 error ("Cannot set properties of empty event");
477 UNGCPRO;
478 return event;
479 }
480 else if (EQ (type, Qkey_press))
430 e->event_type = key_press_event; 481 e->event_type = key_press_event;
431 else if (EQ (type, Qbutton_press)) 482 else if (EQ (type, Qbutton_press))
432 e->event_type = button_press_event; 483 e->event_type = button_press_event;
433 else if (EQ (type, Qbutton_release)) 484 else if (EQ (type, Qbutton_release))
434 e->event_type = button_release_event; 485 e->event_type = button_release_event;
435 else if (EQ (type, Qmotion)) 486 else if (EQ (type, Qmotion))
436 e->event_type = pointer_motion_event; 487 e->event_type = pointer_motion_event;
437 else if (EQ (type, Qempty)) 488 #ifdef HAVE_OFFIX_DND
438 e->event_type = empty_event; 489 else if (EQ (type, Qdnd_drop))
490 {
491 e->event_type = dnd_drop_event;
492 e->event.dnd_drop.data = Qnil;
493 }
494 #endif
439 else 495 else
440 /* not allowed: Qmisc_user, Qprocess, Qtimeout, Qmagic, Qmagic_eval */ 496 {
441 /* dnd_drop is also not allowed */ 497 /* Not allowed: Qmisc_user, Qprocess, Qtimeout, Qmagic, Qeval,
442 signal_simple_error ("Invalid event type", type); 498 Qmagic_eval. */
499 /* #### Should we allow misc-user events? */
500 signal_simple_error ("Invalid event type", type);
501 }
502
503 plist = Fcopy_sequence (plist);
504 Fcanonicalize_plist (plist, Qnil);
443 505
444 /* Process the plist. */ 506 /* Process the plist. */
445 while (!NILP (plist)) 507 EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist)
446 { 508 {
447 prop = Fcar (plist); 509 if (EQ (keyword, Qchannel))
448 plist = Fcdr (plist);
449 val = Fcar (plist);
450 plist = Fcdr (plist);
451 if (EQ (prop, Qchannel))
452 { 510 {
453 if (!FRAMEP (val) && !NILP (val)) 511 if (e->event_type == key_press_event)
454 signal_simple_error ("Invalid event channel", val); 512 {
455 EVENT_CHANNEL (e) = val; 513 if (!CONSOLEP (value))
514 wrong_type_argument (Qconsolep, value);
515 }
516 else
517 {
518 if (!FRAMEP (value))
519 wrong_type_argument (Qframep, value);
520 }
521 EVENT_CHANNEL (e) = value;
456 } 522 }
457 else if (EQ (prop, Qkey)) 523 else if (EQ (keyword, Qkey))
458 { 524 {
459 if (e->event_type != key_press_event) 525 if (e->event_type != key_press_event)
460 wrong_type_argument (Qkey_press_event_p, event); 526 signal_simple_error ("Invalid event type for `key' property",
461 if (!SYMBOLP (val) && !CHARP (val)) 527 type);
462 signal_simple_error ("Invalid event key", val); 528 if (!SYMBOLP (value) && !CHARP (value))
463 e->event.key.keysym = val; 529 signal_simple_error ("Invalid event key", value);
530 e->event.key.keysym = value;
464 } 531 }
465 else if (EQ (prop, Qbutton)) 532 else if (EQ (keyword, Qbutton))
466 { 533 {
467 CHECK_NATNUM (val); 534 CHECK_NATNUM (value);
468 check_int_range (XINT(val), 1, 3); 535 check_int_range (XINT(value), 1, 3);
469 if (e->event_type != button_press_event 536 if (e->event_type != button_press_event
470 && e->event_type != button_release_event) 537 && e->event_type != button_release_event)
471 signal_simple_error ("Invalid event type for `button' property", 538 signal_simple_error ("Invalid event type for `button' property",
472 type); 539 type);
473 e->event.button.button = XINT (val); 540 e->event.button.button = XINT (value);
474 } 541 }
475 else if (EQ (prop, Qmodifiers)) 542 else if (EQ (keyword, Qmodifiers))
476 { 543 {
477 Lisp_Object tail, sym; 544 Lisp_Object modtail, sym;
478 int modifiers = 0; 545 int modifiers = 0;
479 546
480 if (e->event_type != key_press_event 547 if (e->event_type != key_press_event
481 && e->event_type != button_press_event 548 && e->event_type != button_press_event
482 && e->event_type != button_release_event 549 && e->event_type != button_release_event
483 && e->event_type != pointer_motion_event) 550 && e->event_type != pointer_motion_event)
551 /* Currently unreached. */
484 signal_simple_error ("Invalid event type for modifiers", type); 552 signal_simple_error ("Invalid event type for modifiers", type);
485 553
486 for (tail = val; !NILP (tail); tail = Fcdr (tail)) 554 EXTERNAL_LIST_LOOP (modtail, value)
487 { 555 {
488 sym = Fcar (tail); 556 sym = XCAR (modtail);
489 if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL; 557 if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL;
490 else if (EQ (sym, Qmeta)) modifiers |= MOD_META; 558 else if (EQ (sym, Qmeta)) modifiers |= MOD_META;
491 else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER; 559 else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER;
492 else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER; 560 else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER;
493 else if (EQ (sym, Qalt)) modifiers |= MOD_ALT; 561 else if (EQ (sym, Qalt)) modifiers |= MOD_ALT;
494 else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT; 562 else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT;
495 else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT; 563 else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT;
496 else 564 else
497 signal_simple_error ("Invalid key modifier", Fcar (tail)); 565 signal_simple_error ("Invalid key modifier", XCAR (modtail));
498 } 566 }
499 if (e->event_type == key_press_event) 567 if (e->event_type == key_press_event)
500 e->event.key.modifiers = modifiers; 568 e->event.key.modifiers = modifiers;
501 else if (e->event_type == button_press_event 569 else if (e->event_type == button_press_event
502 || e->event_type == button_release_event) 570 || e->event_type == button_release_event)
503 e->event.button.modifiers = modifiers; 571 e->event.button.modifiers = modifiers;
504 else /* pointer_motion_event */ 572 else /* pointer_motion_event */
505 e->event.motion.modifiers = modifiers; 573 e->event.motion.modifiers = modifiers;
506 } 574 }
507 else if (EQ (prop, Qx)) 575 else if (EQ (keyword, Qx))
508 { 576 {
509 CHECK_NATNUM (val); 577 /* Allow negative values, so we can specify toolbar
510 if (e->event_type == pointer_motion_event) 578 positions. */
511 e->event.motion.x = XINT (val); 579 CHECK_INT (value);
512 else if (e->event_type == button_press_event 580 if (e->event_type != pointer_motion_event
513 || e->event_type == button_release_event) 581 && e->event_type != button_press_event
514 e->event.button.x = XINT (val); 582 && e->event_type != button_release_event)
583 {
584 signal_simple_error ("Cannot assign `x' property to event",
585 type);
586 }
587 coord_x = XINT (value);
515 } 588 }
516 else if (EQ (prop, Qy)) 589 else if (EQ (keyword, Qy))
517 { 590 {
518 CHECK_NATNUM (val); 591 /* Allow negative values; see above. */
519 if (e->event_type == pointer_motion_event) 592 CHECK_INT (value);
520 e->event.motion.y = XINT (val); 593 if (e->event_type != pointer_motion_event
521 else if (e->event_type == button_press_event 594 && e->event_type != button_press_event
522 || e->event_type == button_release_event) 595 && e->event_type != button_release_event)
523 e->event.button.y = XINT (val); 596 {
597 signal_simple_error ("Cannot assign `y' property to event",
598 type);
599 }
600 coord_y = XINT (value);
524 } 601 }
525 else if (EQ (prop, Qtimestamp)) 602 else if (EQ (keyword, Qtimestamp))
526 { 603 {
527 CHECK_NATNUM (val); 604 CHECK_NATNUM (value);
528 e->timestamp = XINT (val); 605 e->timestamp = XINT (value);
529 } 606 }
607 #ifdef HAVE_OFFIX_DND
608 else if (EQ (keyword, Qdnd_data))
609 {
610 Lisp_Object dnd_tail;
611 /* Value is a list of (INT DATA). Data is a list. */
612 CHECK_CONS (value);
613 /* Oliver, change this to accept symbols, when the time is
614 ripe! */
615 CHECK_NATNUM (XCAR (value));
616 CHECK_CONS (XCDR (value));
617 if (!NILP (XCDR (XCDR (value))))
618 wrong_type_argument (Qlistp, XCDR (value));
619 /* Check the list validity. */
620 EXTERNAL_LIST_LOOP (dnd_tail, XCAR (XCDR (value)))
621 ;
622 /* And now, copy it all. */
623 e->event.dnd_drop.data = Fcopy_tree (value, Qnil);
624 }
625 #endif /* HAVE_OFFIX_DND */
530 else 626 else
531 signal_simple_error ("Invalid property", prop); 627 signal_simple_error ("Invalid property", keyword);
532 } /* while */ 628 } /* while */
533 629
534 /* Now, let's validate what we got. */ 630 /* Insert the channel, if missing. */
631 if (NILP (EVENT_CHANNEL (e)))
632 {
633 if (e->event_type == key_press_event)
634 EVENT_CHANNEL (e) = Vselected_console;
635 else
636 EVENT_CHANNEL (e) = Fselected_frame (Qnil);
637 }
638
639 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative
640 to the frame, so we must adjust accordingly. */
641 if (e->event_type == pointer_motion_event
642 || e->event_type == button_press_event
643 || e->event_type == button_release_event
644 #ifdef HAVE_OFFIX_DND
645 || e->event_type == dnd_drop_event
646 #endif
647 )
648 {
649 struct frame *f = XFRAME (EVENT_CHANNEL (e));
650
651 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (f);
652 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (f);
653
654 if (e->event_type == pointer_motion_event)
655 {
656 e->event.motion.x = coord_x;
657 e->event.motion.y = coord_y;
658 }
659 else if (e->event_type == button_press_event
660 || e->event_type == button_release_event
661 #ifdef HAVE_OFFIX_DND
662 || e->event_type == dnd_drop_event
663 #endif
664 )
665 {
666 e->event.button.x = coord_x;
667 e->event.button.y = coord_y;
668 }
669 }
670
671 /* Finally, do some more validation. */
535 switch (e->event_type) 672 switch (e->event_type)
536 { 673 {
537 case key_press_event: 674 case key_press_event:
538 if (!(SYMBOLP (e->event.key.keysym) || CHARP (e->event.key.keysym))) 675 if (!(SYMBOLP (e->event.key.keysym) || CHARP (e->event.key.keysym)))
539 error ("Undefined key for keypress event"); 676 error ("Undefined key for keypress event");
540 break; 677 break;
541 case button_press_event: 678 case button_press_event:
542 case button_release_event: 679 case button_release_event:
680 #ifdef HAVE_OFFIX_DND
681 case dnd_drop_event:
682 #endif
543 if (!e->event.button.button) 683 if (!e->event.button.button)
544 error ("Undefined button for button-press or button-release event"); 684 error ("Undefined button for %s event",
545 if (NILP (EVENT_CHANNEL (e))) 685 e->event_type == button_press_event
546 error ("Undefined channel for button-press or button-release event"); 686 ? "buton-press" :
547 break; 687 #ifdef HAVE_OFFIX_DND
688 e->event_type == button_release_event
689 ? "button-release" : "dnd-drop"
690 #else
691 "button-release"
692 #endif
693 );
694 #ifdef HAVE_OFFIX_DND
695 if ((e->event_type == dnd_drop_event) &&
696 NILP (e->event.dnd_drop.data))
697 error ("Unspecified data for dnd-drop event");
698 break;
699 #endif
548 default: 700 default:
549 break; 701 break;
550 } 702 }
703
704 UNGCPRO;
551 return event; 705 return event;
552 } 706 }
553 707
554 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /* 708 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /*
555 Allow the given event structure to be reused. 709 Allow the given event structure to be reused.