Mercurial > hg > xemacs-beta

comparison src/events.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
35 #include "frame.h" 35 #include "frame.h"
36 #include "glyphs.h" 36 #include "glyphs.h"
37 #include "keymap.h" /* for key_desc_list_to_event() */ 37 #include "keymap.h" /* for key_desc_list_to_event() */
38 #include "redisplay.h" 38 #include "redisplay.h"
39 #include "window.h" 39 #include "window.h"
40
41 #ifdef WINDOWSNT
42 /* Hmm, under unix we want X modifiers, under NT we want X modifiers if
43 we are running X and Windows modifiers otherwise.
44 gak. This is a kludge until we support multiple native GUIs!
45 */
46 #undef MOD_ALT
47 #undef MOD_CONTROL
48 #undef MOD_SHIFT
49 #endif
50
51 #include "events-mod.h" 40 #include "events-mod.h"
52 41
53 /* Where old events go when they are explicitly deallocated. 42 /* Where old events go when they are explicitly deallocated.
54 The event chain here is cut loose before GC, so these will be freed 43 The event chain here is cut loose before GC, so these will be freed
55 eventually. 44 eventually.
85 74
86 for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++) 75 for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++)
87 ((int *) event) [i] = 0xdeadbeef; 76 ((int *) event) [i] = 0xdeadbeef;
88 event->event_type = dead_event; 77 event->event_type = dead_event;
89 event->channel = Qnil; 78 event->channel = Qnil;
90 set_lheader_implementation (&(event->lheader), &lrecord_event); 79 set_lheader_implementation (&event->lheader, &lrecord_event);
91 XSET_EVENT_NEXT (ev, Qnil); 80 XSET_EVENT_NEXT (ev, Qnil);
92 } 81 }
93 82
94 /* Set everything to zero or nil so that it's predictable. */ 83 /* Set everything to zero or nil so that it's predictable. */
95 void 84 void
96 zero_event (Lisp_Event *e) 85 zero_event (Lisp_Event *e)
97 { 86 {
98 xzero (*e); 87 xzero (*e);
99 set_lheader_implementation (&(e->lheader), &lrecord_event); 88 set_lheader_implementation (&e->lheader, &lrecord_event);
100 e->event_type = empty_event; 89 e->event_type = empty_event;
101 e->next = Qnil; 90 e->next = Qnil;
102 e->channel = Qnil; 91 e->channel = Qnil;
103 } 92 }
104 93
140 mark_object (event->channel); 129 mark_object (event->channel);
141 return event->next; 130 return event->next;
142 } 131 }
143 132
144 static void 133 static void
145 print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun) 134 print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun)
146 { 135 {
147 char buf[255]; 136 char buf[255];
148 write_c_string (str, printcharfun); 137 write_c_string (str, printcharfun);
149 format_event_object (buf, XEVENT (obj), 0); 138 format_event_object (buf, XEVENT (obj), 0);
150 write_c_string (buf, printcharfun); 139 write_c_string (buf, printcharfun);
427 WARNING: the event object returned may be a reused one; see the function 416 WARNING: the event object returned may be a reused one; see the function
428 `deallocate-event'. 417 `deallocate-event'.
429 */ 418 */
430 (type, plist)) 419 (type, plist))
431 { 420 {
432 Lisp_Object tail, keyword, value;
433 Lisp_Object event = Qnil; 421 Lisp_Object event = Qnil;
434 Lisp_Event *e; 422 Lisp_Event *e;
435 EMACS_INT coord_x = 0, coord_y = 0; 423 EMACS_INT coord_x = 0, coord_y = 0;
436 struct gcpro gcpro1; 424 struct gcpro gcpro1;
437 425
458 PLIST. In fact, processing PLIST would be wrong, because the 446 PLIST. In fact, processing PLIST would be wrong, because the
459 sanitizing process would fill in the properties 447 sanitizing process would fill in the properties
460 (e.g. CHANNEL), which we don't want in empty events. */ 448 (e.g. CHANNEL), which we don't want in empty events. */
461 e->event_type = empty_event; 449 e->event_type = empty_event;
462 if (!NILP (plist)) 450 if (!NILP (plist))
463 error ("Cannot set properties of empty event"); 451 syntax_error ("Cannot set properties of empty event", plist);
464 UNGCPRO; 452 UNGCPRO;
465 return event; 453 return event;
466 } 454 }
467 else if (EQ (type, Qkey_press)) 455 else if (EQ (type, Qkey_press))
468 { 456 {
481 e->event.eval.function = e->event.eval.object = Qnil; 469 e->event.eval.function = e->event.eval.object = Qnil;
482 } 470 }
483 else 471 else
484 { 472 {
485 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */ 473 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */
486 signal_simple_error ("Invalid event type", type); 474 invalid_argument ("Invalid event type", type);
487 } 475 }
488 476
489 EVENT_CHANNEL (e) = Qnil; 477 EVENT_CHANNEL (e) = Qnil;
490 478
491 plist = Fcopy_sequence (plist); 479 plist = Fcopy_sequence (plist);
492 Fcanonicalize_plist (plist, Qnil); 480 Fcanonicalize_plist (plist, Qnil);
493 481
494 #define WRONG_EVENT_TYPE_FOR_PROPERTY(type, prop) \ 482 #define WRONG_EVENT_TYPE_FOR_PROPERTY(event_type, prop) \
495 error_with_frob (prop, "Invalid property for %s event", \ 483 syntax_error_2 ("Invalid property for event type", prop, event_type)
496 string_data (symbol_name (XSYMBOL (type)))) 484
497 485 {
498 EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist) 486 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist)
499 { 487 {
500 if (EQ (keyword, Qchannel)) 488 if (EQ (keyword, Qchannel))
501 { 489 {
502 if (e->event_type == key_press_event) 490 if (e->event_type == key_press_event)
503 { 491 {
504 if (!CONSOLEP (value)) 492 if (!CONSOLEP (value))
505 value = wrong_type_argument (Qconsolep, value); 493 value = wrong_type_argument (Qconsolep, value);
506 } 494 }
507 else 495 else
508 { 496 {
509 if (!FRAMEP (value)) 497 if (!FRAMEP (value))
510 value = wrong_type_argument (Qframep, value); 498 value = wrong_type_argument (Qframep, value);
511 } 499 }
512 EVENT_CHANNEL (e) = value; 500 EVENT_CHANNEL (e) = value;
513 } 501 }
514 else if (EQ (keyword, Qkey)) 502 else if (EQ (keyword, Qkey))
515 { 503 {
516 switch (e->event_type) 504 switch (e->event_type)
517 { 505 {
518 case key_press_event: 506 case key_press_event:
519 if (!SYMBOLP (value) && !CHARP (value)) 507 if (!SYMBOLP (value) && !CHARP (value))
520 signal_simple_error ("Invalid event key", value); 508 syntax_error ("Invalid event key", value);
521 e->event.key.keysym = value; 509 e->event.key.keysym = value;
522 break; 510 break;
523 default: 511 default:
524 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); 512 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
525 break; 513 break;
526 } 514 }
527 } 515 }
528 else if (EQ (keyword, Qbutton)) 516 else if (EQ (keyword, Qbutton))
529 { 517 {
530 CHECK_NATNUM (value); 518 CHECK_NATNUM (value);
531 check_int_range (XINT (value), 0, 7); 519 check_int_range (XINT (value), 0, 7);
532 520
533 switch (e->event_type) 521 switch (e->event_type)
534 { 522 {
535 case button_press_event: 523 case button_press_event:
536 case button_release_event: 524 case button_release_event:
537 e->event.button.button = XINT (value); 525 e->event.button.button = XINT (value);
538 break; 526 break;
539 case misc_user_event: 527 case misc_user_event:
540 e->event.misc.button = XINT (value); 528 e->event.misc.button = XINT (value);
541 break; 529 break;
542 default: 530 default:
543 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); 531 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
544 break; 532 break;
545 } 533 }
546 } 534 }
547 else if (EQ (keyword, Qmodifiers)) 535 else if (EQ (keyword, Qmodifiers))
548 { 536 {
549 int modifiers = 0; 537 int modifiers = 0;
550 Lisp_Object sym; 538
551 539 EXTERNAL_LIST_LOOP_2 (sym, value)
552 EXTERNAL_LIST_LOOP_2 (sym, value) 540 {
553 { 541 if (EQ (sym, Qcontrol)) modifiers |= XEMACS_MOD_CONTROL;
554 if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL; 542 else if (EQ (sym, Qmeta)) modifiers |= XEMACS_MOD_META;
555 else if (EQ (sym, Qmeta)) modifiers |= MOD_META; 543 else if (EQ (sym, Qsuper)) modifiers |= XEMACS_MOD_SUPER;
556 else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER; 544 else if (EQ (sym, Qhyper)) modifiers |= XEMACS_MOD_HYPER;
557 else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER; 545 else if (EQ (sym, Qalt)) modifiers |= XEMACS_MOD_ALT;
558 else if (EQ (sym, Qalt)) modifiers |= MOD_ALT; 546 else if (EQ (sym, Qsymbol)) modifiers |= XEMACS_MOD_ALT;
559 else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT; 547 else if (EQ (sym, Qshift)) modifiers |= XEMACS_MOD_SHIFT;
560 else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT; 548 else if (EQ (sym, Qbutton1)) modifiers |= XEMACS_MOD_BUTTON1;
561 else 549 else if (EQ (sym, Qbutton2)) modifiers |= XEMACS_MOD_BUTTON2;
562 signal_simple_error ("Invalid key modifier", sym); 550 else if (EQ (sym, Qbutton3)) modifiers |= XEMACS_MOD_BUTTON3;
563 } 551 else if (EQ (sym, Qbutton4)) modifiers |= XEMACS_MOD_BUTTON4;
564 552 else if (EQ (sym, Qbutton5)) modifiers |= XEMACS_MOD_BUTTON5;
565 switch (e->event_type) 553 else
566 { 554 syntax_error ("Invalid key modifier", sym);
567 case key_press_event: 555 }
568 e->event.key.modifiers = modifiers; 556
569 break; 557 switch (e->event_type)
570 case button_press_event: 558 {
571 case button_release_event: 559 case key_press_event:
572 e->event.button.modifiers = modifiers; 560 e->event.key.modifiers = modifiers;
573 break; 561 break;
574 case pointer_motion_event: 562 case button_press_event:
575 e->event.motion.modifiers = modifiers; 563 case button_release_event:
576 break; 564 e->event.button.modifiers = modifiers;
577 case misc_user_event: 565 break;
578 e->event.misc.modifiers = modifiers; 566 case pointer_motion_event:
579 break; 567 e->event.motion.modifiers = modifiers;
580 default: 568 break;
581 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); 569 case misc_user_event:
582 break; 570 e->event.misc.modifiers = modifiers;
583 } 571 break;
584 } 572 default:
585 else if (EQ (keyword, Qx)) 573 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
586 { 574 break;
587 switch (e->event_type) 575 }
588 { 576 }
589 case pointer_motion_event: 577 else if (EQ (keyword, Qx))
590 case button_press_event: 578 {
591 case button_release_event: 579 switch (e->event_type)
592 case misc_user_event: 580 {
593 /* Allow negative values, so we can specify toolbar 581 case pointer_motion_event:
594 positions. */ 582 case button_press_event:
595 CHECK_INT (value); 583 case button_release_event:
596 coord_x = XINT (value); 584 case misc_user_event:
597 break; 585 /* Allow negative values, so we can specify toolbar
598 default: 586 positions. */
599 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); 587 CHECK_INT (value);
600 break; 588 coord_x = XINT (value);
601 } 589 break;
602 } 590 default:
603 else if (EQ (keyword, Qy)) 591 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
604 { 592 break;
605 switch (e->event_type) 593 }
606 { 594 }
607 case pointer_motion_event: 595 else if (EQ (keyword, Qy))
608 case button_press_event: 596 {
609 case button_release_event: 597 switch (e->event_type)
610 case misc_user_event: 598 {
611 /* Allow negative values; see above. */ 599 case pointer_motion_event:
612 CHECK_INT (value); 600 case button_press_event:
613 coord_y = XINT (value); 601 case button_release_event:
614 break; 602 case misc_user_event:
615 default: 603 /* Allow negative values; see above. */
616 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); 604 CHECK_INT (value);
617 break; 605 coord_y = XINT (value);
618 } 606 break;
619 } 607 default:
620 else if (EQ (keyword, Qtimestamp)) 608 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
621 { 609 break;
622 CHECK_NATNUM (value); 610 }
623 e->timestamp = XINT (value); 611 }
624 } 612 else if (EQ (keyword, Qtimestamp))
625 else if (EQ (keyword, Qfunction)) 613 {
626 { 614 CHECK_NATNUM (value);
627 switch (e->event_type) 615 e->timestamp = XINT (value);
628 { 616 }
629 case misc_user_event: 617 else if (EQ (keyword, Qfunction))
630 e->event.eval.function = value; 618 {
631 break; 619 switch (e->event_type)
632 default: 620 {
633 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); 621 case misc_user_event:
634 break; 622 e->event.eval.function = value;
635 } 623 break;
636 } 624 default:
637 else if (EQ (keyword, Qobject)) 625 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
638 { 626 break;
639 switch (e->event_type) 627 }
640 { 628 }
641 case misc_user_event: 629 else if (EQ (keyword, Qobject))
642 e->event.eval.object = value; 630 {
643 break; 631 switch (e->event_type)
644 default: 632 {
645 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); 633 case misc_user_event:
646 break; 634 e->event.eval.object = value;
647 } 635 break;
648 } 636 default:
649 else 637 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword);
650 signal_simple_error_2 ("Invalid property", keyword, value); 638 break;
651 } 639 }
640 }
641 else
642 syntax_error_2 ("Invalid property", keyword, value);
643 }
644 }
652 645
653 /* Insert the channel, if missing. */ 646 /* Insert the channel, if missing. */
654 if (NILP (EVENT_CHANNEL (e))) 647 if (NILP (EVENT_CHANNEL (e)))
655 { 648 {
656 if (e->event_type == key_press_event) 649 if (e->event_type == key_press_event)
689 /* Finally, do some more validation. */ 682 /* Finally, do some more validation. */
690 switch (e->event_type) 683 switch (e->event_type)
691 { 684 {
692 case key_press_event: 685 case key_press_event:
693 if (UNBOUNDP (e->event.key.keysym)) 686 if (UNBOUNDP (e->event.key.keysym))
694 error ("A key must be specified to make a keypress event"); 687 syntax_error ("A key must be specified to make a keypress event",
688 plist);
695 break; 689 break;
696 case button_press_event: 690 case button_press_event:
697 if (!e->event.button.button) 691 if (!e->event.button.button)
698 error ("A button must be specified to make a button-press event"); 692 syntax_error
693 ("A button must be specified to make a button-press event",
694 plist);
699 break; 695 break;
700 case button_release_event: 696 case button_release_event:
701 if (!e->event.button.button) 697 if (!e->event.button.button)
702 error ("A button must be specified to make a button-release event"); 698 syntax_error
699 ("A button must be specified to make a button-release event",
700 plist);
703 break; 701 break;
704 case misc_user_event: 702 case misc_user_event:
705 if (NILP (e->event.misc.function)) 703 if (NILP (e->event.misc.function))
706 error ("A function must be specified to make a misc-user event"); 704 syntax_error ("A function must be specified to make a misc-user event",
705 plist);
707 break; 706 break;
708 default: 707 default:
709 break; 708 break;
710 } 709 }
711 710
975 void 974 void
976 character_to_event (Emchar c, Lisp_Event *event, struct console *con, 975 character_to_event (Emchar c, Lisp_Event *event, struct console *con,
977 int use_console_meta_flag, int do_backspace_mapping) 976 int use_console_meta_flag, int do_backspace_mapping)
978 { 977 {
979 Lisp_Object k = Qnil; 978 Lisp_Object k = Qnil;
980 unsigned int m = 0; 979 int m = 0;
981 if (event->event_type == dead_event) 980 if (event->event_type == dead_event)
982 error ("character-to-event called with a deallocated event!"); 981 error ("character-to-event called with a deallocated event!");
983 982
984 #ifndef MULE 983 #ifndef MULE
985 c &= 255; 984 c &= 255;
994 case 0: /* ignore top bit; it's parity */ 993 case 0: /* ignore top bit; it's parity */
995 c -= 128; 994 c -= 128;
996 break; 995 break;
997 case 1: /* top bit is meta */ 996 case 1: /* top bit is meta */
998 c -= 128; 997 c -= 128;
999 m = MOD_META; 998 m = XEMACS_MOD_META;
1000 break; 999 break;
1001 default: /* this is a real character */ 1000 default: /* this is a real character */
1002 break; 1001 break;
1003 } 1002 }
1004 } 1003 }
1005 if (c < ' ') c += '@', m |= MOD_CONTROL; 1004 if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL;
1006 if (m & MOD_CONTROL) 1005 if (m & XEMACS_MOD_CONTROL)
1007 { 1006 {
1008 switch (c) 1007 switch (c)
1009 { 1008 {
1010 case 'I': k = QKtab; m &= ~MOD_CONTROL; break; 1009 case 'I': k = QKtab; m &= ~XEMACS_MOD_CONTROL; break;
1011 case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break; 1010 case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break;
1012 case 'M': k = QKreturn; m &= ~MOD_CONTROL; break; 1011 case 'M': k = QKreturn; m &= ~XEMACS_MOD_CONTROL; break;
1013 case '[': k = QKescape; m &= ~MOD_CONTROL; break; 1012 case '[': k = QKescape; m &= ~XEMACS_MOD_CONTROL; break;
1014 default: 1013 default:
1015 #if defined(HAVE_TTY) 1014 #if defined(HAVE_TTY)
1016 if (do_backspace_mapping && 1015 if (do_backspace_mapping &&
1017 CHARP (con->tty_erase_char) && 1016 CHARP (con->tty_erase_char) &&
1018 c - '@' == XCHAR (con->tty_erase_char)) 1017 c - '@' == XCHAR (con->tty_erase_char))
1019 { 1018 {
1020 k = QKbackspace; 1019 k = QKbackspace;
1021 m &= ~MOD_CONTROL; 1020 m &= ~XEMACS_MOD_CONTROL;
1022 } 1021 }
1023 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ 1022 #endif /* defined(HAVE_TTY) && !defined(CYGWIN) */
1024 break; 1023 break;
1025 } 1024 }
1026 if (c >= 'A' && c <= 'Z') c -= 'A'-'a'; 1025 if (c >= 'A' && c <= 'Z') c -= 'A'-'a';
1027 } 1026 }
1028 #if defined(HAVE_TTY) 1027 #if defined(HAVE_TTY)
1029 else if (do_backspace_mapping && 1028 else if (do_backspace_mapping &&
1030 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char)) 1029 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char))
1031 k = QKbackspace; 1030 k = QKbackspace;
1032 #endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ 1031 #endif /* defined(HAVE_TTY) && !defined(CYGWIN) */
1033 else if (c == 127) 1032 else if (c == 127)
1034 k = QKdelete; 1033 k = QKdelete;
1035 else if (c == ' ') 1034 else if (c == ' ')
1036 k = QKspace; 1035 k = QKspace;
1037 1036
1065 { 1064 {
1066 assert (event->event_type != dead_event); 1065 assert (event->event_type != dead_event);
1067 return -1; 1066 return -1;
1068 } 1067 }
1069 if (!allow_extra_modifiers && 1068 if (!allow_extra_modifiers &&
1070 event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT)) 1069 event->event.key.modifiers & (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_MOD_ALT))
1071 return -1; 1070 return -1;
1072 if (CHAR_OR_CHAR_INTP (event->event.key.keysym)) 1071 if (CHAR_OR_CHAR_INTP (event->event.key.keysym))
1073 c = XCHAR_OR_CHAR_INT (event->event.key.keysym); 1072 c = XCHAR_OR_CHAR_INT (event->event.key.keysym);
1074 else if (!SYMBOLP (event->event.key.keysym)) 1073 else if (!SYMBOLP (event->event.key.keysym))
1075 abort (); 1074 abort ();
1084 Qascii_character, Qnil))) 1083 Qascii_character, Qnil)))
1085 c = XCHAR_OR_CHAR_INT (code); 1084 c = XCHAR_OR_CHAR_INT (code);
1086 else 1085 else
1087 return -1; 1086 return -1;
1088 1087
1089 if (event->event.key.modifiers & MOD_CONTROL) 1088 if (event->event.key.modifiers & XEMACS_MOD_CONTROL)
1090 { 1089 {
1091 if (c >= 'a' && c <= 'z') 1090 if (c >= 'a' && c <= 'z')
1092 c -= ('a' - 'A'); 1091 c -= ('a' - 'A');
1093 else 1092 else
1094 /* reject Control-Shift- keys */ 1093 /* reject Control-Shift- keys */
1102 else 1101 else
1103 /* reject keys that can't take Control- modifiers */ 1102 /* reject keys that can't take Control- modifiers */
1104 if (! allow_extra_modifiers) return -1; 1103 if (! allow_extra_modifiers) return -1;
1105 } 1104 }
1106 1105
1107 if (event->event.key.modifiers & MOD_META) 1106 if (event->event.key.modifiers & XEMACS_MOD_META)
1108 { 1107 {
1109 if (! allow_meta) return -1; 1108 if (! allow_meta) return -1;
1110 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */ 1109 if (c & 0200) return -1; /* don't allow M-oslash (overlap) */
1111 #ifdef MULE 1110 #ifdef MULE
1112 if (c >= 256) return -1; 1111 if (c >= 256) return -1;
1242 { 1241 {
1243 mod = event->event.key.modifiers; 1242 mod = event->event.key.modifiers;
1244 key = event->event.key.keysym; 1243 key = event->event.key.keysym;
1245 /* Hack. */ 1244 /* Hack. */
1246 if (! brief && CHARP (key) && 1245 if (! brief && CHARP (key) &&
1247 mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER)) 1246 mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER))
1248 { 1247 {
1249 int k = XCHAR (key); 1248 int k = XCHAR (key);
1250 if (k >= 'a' && k <= 'z') 1249 if (k >= 'a' && k <= 'z')
1251 key = make_char (k - ('a' - 'A')); 1250 key = make_char (k - ('a' - 'A'));
1252 else if (k >= 'A' && k <= 'Z') 1251 else if (k >= 'A' && k <= 'Z')
1253 mod |= MOD_SHIFT; 1252 mod |= XEMACS_MOD_SHIFT;
1254 } 1253 }
1255 break; 1254 break;
1256 } 1255 }
1257 case button_release_event: 1256 case button_release_event:
1258 mouse_p++; 1257 mouse_p++;
1264 key = make_char (event->event.button.button + '0'); 1263 key = make_char (event->event.button.button + '0');
1265 break; 1264 break;
1266 } 1265 }
1267 case magic_event: 1266 case magic_event:
1268 { 1267 {
1269 CONST char *name = NULL; 1268 const char *name = NULL;
1270 1269
1271 #ifdef HAVE_X_WINDOWS 1270 #ifdef HAVE_X_WINDOWS
1272 { 1271 {
1273 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); 1272 Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event));
1274 if (CONSOLE_X_P (XCONSOLE (console))) 1273 if (CONSOLE_X_P (XCONSOLE (console)))
1287 case timeout_event: strcpy (buf, "timeout"); return; 1286 case timeout_event: strcpy (buf, "timeout"); return;
1288 case empty_event: strcpy (buf, "empty"); return; 1287 case empty_event: strcpy (buf, "empty"); return;
1289 case dead_event: strcpy (buf, "DEAD-EVENT"); return; 1288 case dead_event: strcpy (buf, "DEAD-EVENT"); return;
1290 default: 1289 default:
1291 abort (); 1290 abort ();
1291 return;
1292 } 1292 }
1293 #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0) 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) 1294 #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0)
1295 if (mod & MOD_CONTROL) modprint ("control-", "C-"); 1295 if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-");
1296 if (mod & MOD_META) modprint ("meta-", "M-"); 1296 if (mod & XEMACS_MOD_META) modprint ("meta-", "M-");
1297 if (mod & MOD_SUPER) modprint ("super-", "S-"); 1297 if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-");
1298 if (mod & MOD_HYPER) modprint ("hyper-", "H-"); 1298 if (mod & XEMACS_MOD_HYPER) modprint ("hyper-", "H-");
1299 if (mod & MOD_ALT) modprint ("alt-", "A-"); 1299 if (mod & XEMACS_MOD_ALT) modprint ("alt-", "A-");
1300 if (mod & MOD_SHIFT) modprint ("shift-", "Sh-"); 1300 if (mod & XEMACS_MOD_SHIFT) modprint ("shift-", "Sh-");
1301 if (mouse_p) 1301 if (mouse_p)
1302 { 1302 {
1303 modprint1 ("button"); 1303 modprint1 ("button");
1304 --mouse_p; 1304 --mouse_p;
1305 } 1305 }
1312 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key)); 1312 buf += set_charptr_emchar ((Bufbyte *) buf, XCHAR (key));
1313 *buf = 0; 1313 *buf = 0;
1314 } 1314 }
1315 else if (SYMBOLP (key)) 1315 else if (SYMBOLP (key))
1316 { 1316 {
1317 CONST char *str = 0; 1317 const char *str = 0;
1318 if (brief) 1318 if (brief)
1319 { 1319 {
1320 if (EQ (key, QKlinefeed)) str = "LFD"; 1320 if (EQ (key, QKlinefeed)) str = "LFD";
1321 else if (EQ (key, QKtab)) str = "TAB"; 1321 else if (EQ (key, QKtab)) str = "TAB";
1322 else if (EQ (key, QKreturn)) str = "RET"; 1322 else if (EQ (key, QKreturn)) str = "RET";
1450 } 1450 }
1451 } 1451 }
1452 1452
1453 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /* 1453 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /*
1454 Return the timestamp of the event object EVENT. 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'.
1455 */ 1459 */
1456 (event)) 1460 (event))
1457 { 1461 {
1458 CHECK_LIVE_EVENT (event); 1462 CHECK_LIVE_EVENT (event);
1459 /* This junk is so that timestamps don't get to be negative, but contain 1463 /* This junk is so that timestamps don't get to be negative, but contain
1460 as many bits as this particular emacs will allow. 1464 as many bits as this particular emacs will allow.
1461 */ 1465 */
1462 return make_int (((1L << (VALBITS - 1)) - 1) & 1466 return make_int (((1L << (VALBITS - 1)) - 1) &
1463 XEVENT (event)->timestamp); 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;
1464 } 1490 }
1465 1491
1466 #define CHECK_EVENT_TYPE(e,t1,sym) do { \ 1492 #define CHECK_EVENT_TYPE(e,t1,sym) do { \
1467 CHECK_LIVE_EVENT (e); \ 1493 CHECK_LIVE_EVENT (e); \
1468 if (XEVENT(e)->event_type != (t1)) \ 1494 if (XEVENT(e)->event_type != (t1)) \
1518 #endif /* !HAVE_WINDOW_SYSTEM */ 1544 #endif /* !HAVE_WINDOW_SYSTEM */
1519 1545
1520 } 1546 }
1521 1547
1522 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /* 1548 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /*
1523 Return a number representing the modifier keys which were down 1549 Return a number representing the modifier keys and buttons which were down
1524 when the given mouse or keyboard event was produced. 1550 when the given mouse or keyboard event was produced.
1525 See also the function event-modifiers. 1551 See also the function `event-modifiers'.
1526 */ 1552 */
1527 (event)) 1553 (event))
1528 { 1554 {
1529 again: 1555 again:
1530 CHECK_LIVE_EVENT (event); 1556 CHECK_LIVE_EVENT (event);
1544 goto again; 1570 goto again;
1545 } 1571 }
1546 } 1572 }
1547 1573
1548 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /* 1574 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /*
1549 Return a list of symbols, the names of the modifier keys 1575 Return a list of symbols, the names of the modifier keys and buttons
1550 which were down when the given mouse or keyboard event was produced. 1576 which were down when the given mouse or keyboard event was produced.
1551 See also the function event-modifier-bits. 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.
1552 */ 1616 */
1553 (event)) 1617 (event))
1554 { 1618 {
1555 int mod = XINT (Fevent_modifier_bits (event)); 1619 int mod = XINT (Fevent_modifier_bits (event));
1556 Lisp_Object result = Qnil; 1620 Lisp_Object result = Qnil;
1557 if (mod & MOD_SHIFT) result = Fcons (Qshift, result); 1621 struct gcpro gcpro1;
1558 if (mod & MOD_ALT) result = Fcons (Qalt, result); 1622
1559 if (mod & MOD_HYPER) result = Fcons (Qhyper, result); 1623 GCPRO1 (result);
1560 if (mod & MOD_SUPER) result = Fcons (Qsuper, result); 1624 if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result);
1561 if (mod & MOD_META) result = Fcons (Qmeta, result); 1625 if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result);
1562 if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result); 1626 if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result);
1563 return 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));
1564 } 1636 }
1565 1637
1566 static int 1638 static int
1567 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative) 1639 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative)
1568 { 1640 {
1593 if (relative) 1665 if (relative)
1594 { 1666 {
1595 w = find_window_by_pixel_pos (*x, *y, f->root_window); 1667 w = find_window_by_pixel_pos (*x, *y, f->root_window);
1596 1668
1597 if (!w) 1669 if (!w)
1598 return 1; /* #### What should really happen here. */ 1670 return 1; /* #### What should really happen here? */
1599 1671
1600 *x -= w->pixel_left; 1672 *x -= w->pixel_left;
1601 *y -= w->pixel_top; 1673 *y -= w->pixel_top;
1602 } 1674 }
1603 else 1675 else
2186 /************************************************************************/ 2258 /************************************************************************/
2187 2259
2188 void 2260 void
2189 syms_of_events (void) 2261 syms_of_events (void)
2190 { 2262 {
2263 INIT_LRECORD_IMPLEMENTATION (event);
2264
2191 DEFSUBR (Fcharacter_to_event); 2265 DEFSUBR (Fcharacter_to_event);
2192 DEFSUBR (Fevent_to_character); 2266 DEFSUBR (Fevent_to_character);
2193 2267
2194 DEFSUBR (Fmake_event); 2268 DEFSUBR (Fmake_event);
2195 DEFSUBR (Fdeallocate_event); 2269 DEFSUBR (Fdeallocate_event);
2198 DEFSUBR (Fevent_live_p); 2272 DEFSUBR (Fevent_live_p);
2199 DEFSUBR (Fevent_type); 2273 DEFSUBR (Fevent_type);
2200 DEFSUBR (Fevent_properties); 2274 DEFSUBR (Fevent_properties);
2201 2275
2202 DEFSUBR (Fevent_timestamp); 2276 DEFSUBR (Fevent_timestamp);
2277 DEFSUBR (Fevent_timestamp_lessp);
2203 DEFSUBR (Fevent_key); 2278 DEFSUBR (Fevent_key);
2204 DEFSUBR (Fevent_button); 2279 DEFSUBR (Fevent_button);
2205 DEFSUBR (Fevent_modifier_bits); 2280 DEFSUBR (Fevent_modifier_bits);
2206 DEFSUBR (Fevent_modifiers); 2281 DEFSUBR (Fevent_modifiers);
2207 DEFSUBR (Fevent_x_pixel); 2282 DEFSUBR (Fevent_x_pixel);