X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=src%2Fevents.c;h=d445146bf56c1c7b91c0aff5952195f5e8688f97;hp=6fe8e6e7e55fc92e6f26820d20e7b7a8dfdc2476;hb=14ac73276fa152e8f0b74602792afc0b9c3236c9;hpb=77dcef404dc78635f6ffa8f71a803d2bc7cc8921 diff --git a/src/events.c b/src/events.c index 6fe8e6e..d445146 100644 --- a/src/events.c +++ b/src/events.c @@ -30,24 +30,14 @@ Boston, MA 02111-1307, USA. */ #include "console-tty.h" /* for stuff in character_to_event */ #include "device.h" #include "console-x.h" /* for x_event_name prototype */ -#include "extents.h" /* Just for the EXTENTP abort check... */ +#include "console-gtk.h" /* for gtk_event_name prototype */ +#include "extents.h" /* Just for the EXTENTP ABORT check... */ #include "events.h" #include "frame.h" #include "glyphs.h" #include "keymap.h" /* for key_desc_list_to_event() */ #include "redisplay.h" #include "window.h" - -#ifdef WINDOWSNT -/* Hmm, under unix we want X modifiers, under NT we want X modifiers if - we are running X and Windows modifiers otherwise. - gak. This is a kludge until we support multiple native GUIs! -*/ -#undef MOD_ALT -#undef MOD_CONTROL -#undef MOD_SHIFT -#endif - #include "events-mod.h" /* Where old events go when they are explicitly deallocated. @@ -81,51 +71,51 @@ static void deinitialize_event (Lisp_Object ev) { int i; - struct Lisp_Event *event = XEVENT (ev); + Lisp_Event *event = XEVENT (ev); - for (i = 0; i < (int) (sizeof (struct Lisp_Event) / sizeof (int)); i++) + for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++) ((int *) event) [i] = 0xdeadbeef; event->event_type = dead_event; event->channel = Qnil; - set_lheader_implementation (&(event->lheader), lrecord_event); + set_lheader_implementation (&event->lheader, &lrecord_event); XSET_EVENT_NEXT (ev, Qnil); } /* Set everything to zero or nil so that it's predictable. */ void -zero_event (struct Lisp_Event *e) +zero_event (Lisp_Event *e) { xzero (*e); - set_lheader_implementation (&(e->lheader), lrecord_event); + set_lheader_implementation (&e->lheader, &lrecord_event); e->event_type = empty_event; e->next = Qnil; e->channel = Qnil; } static Lisp_Object -mark_event (Lisp_Object obj, void (*markobj) (Lisp_Object)) +mark_event (Lisp_Object obj) { - struct Lisp_Event *event = XEVENT (obj); + Lisp_Event *event = XEVENT (obj); switch (event->event_type) { case key_press_event: - markobj (event->event.key.keysym); + mark_object (event->event.key.keysym); break; case process_event: - markobj (event->event.process.process); + mark_object (event->event.process.process); break; case timeout_event: - markobj (event->event.timeout.function); - markobj (event->event.timeout.object); + mark_object (event->event.timeout.function); + mark_object (event->event.timeout.object); break; case eval_event: case misc_user_event: - markobj (event->event.eval.function); - markobj (event->event.eval.object); + mark_object (event->event.eval.function); + mark_object (event->event.eval.object); break; case magic_eval_event: - markobj (event->event.magic_eval.object); + mark_object (event->event.magic_eval.object); break; case button_press_event: case button_release_event: @@ -135,14 +125,14 @@ mark_event (Lisp_Object obj, void (*markobj) (Lisp_Object)) case dead_event: break; default: - abort (); + ABORT (); } - markobj (event->channel); + mark_object (event->channel); return event->next; } static void -print_event_1 (CONST char *str, Lisp_Object obj, Lisp_Object printcharfun) +print_event_1 (const char *str, Lisp_Object obj, Lisp_Object printcharfun) { char buf[255]; write_c_string (str, printcharfun); @@ -179,7 +169,7 @@ print_event (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) assert (INTP (Vx)); Vy = Fevent_y_pixel (obj); assert (INTP (Vy)); - sprintf (buf, "#event_type != e2->event_type) return 0; if (!EQ (e1->channel, e2->channel)) return 0; /* if (e1->timestamp != e2->timestamp) return 0; */ switch (e1->event_type) { - default: abort (); + default: ABORT (); case process_event: return EQ (e1->event.process.process, e2->event.process.process); @@ -279,6 +269,12 @@ event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) { struct console *con = XCONSOLE (CDFW_CONSOLE (e1->channel)); +#ifdef HAVE_GTK + if (CONSOLE_GTK_P (con)) + return (!memcmp (&e1->event.magic.underlying_gdk_event, + &e2->event.magic.underlying_gdk_event, + sizeof (GdkEvent))); +#endif #ifdef HAVE_X_WINDOWS if (CONSOLE_X_P (con)) return (e1->event.magic.underlying_x_event.xany.serial == @@ -293,8 +289,9 @@ event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) if (CONSOLE_MSWINDOWS_P (con)) return (!memcmp(&e1->event.magic.underlying_mswindows_event, &e2->event.magic.underlying_mswindows_event, - sizeof(union magic_data))); + sizeof (union magic_data))); #endif + ABORT (); return 1; /* not reached */ } @@ -307,7 +304,7 @@ event_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) static unsigned long event_hash (Lisp_Object obj, int depth) { - struct Lisp_Event *e = XEVENT (obj); + Lisp_Event *e = XEVENT (obj); unsigned long hash; hash = HASH2 (e->event_type, LISP_HASH (e->channel)); @@ -348,6 +345,10 @@ event_hash (Lisp_Object obj, int depth) case magic_event: { struct console *con = XCONSOLE (CDFW_CONSOLE (EVENT_CHANNEL (e))); +#ifdef HAVE_GTK + if (CONSOLE_GTK_P (con)) + return HASH2 (hash, e->event.magic.underlying_gdk_event.type); +#endif #ifdef HAVE_X_WINDOWS if (CONSOLE_X_P (con)) return HASH2 (hash, e->event.magic.underlying_x_event.xany.serial); @@ -360,6 +361,8 @@ event_hash (Lisp_Object obj, int depth) if (CONSOLE_MSWINDOWS_P (con)) return HASH2 (hash, e->event.magic.underlying_mswindows_event); #endif + ABORT (); + return 0; } case empty_event: @@ -367,7 +370,7 @@ event_hash (Lisp_Object obj, int depth) return hash; default: - abort (); + ABORT (); } return 0; /* unreached */ @@ -375,7 +378,7 @@ event_hash (Lisp_Object obj, int depth) DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event, mark_event, print_event, 0, event_equal, - event_hash, struct Lisp_Event); + event_hash, 0, Lisp_Event); DEFUN ("make-event", Fmake_event, 0, 2, 0, /* @@ -426,9 +429,8 @@ WARNING: the event object returned may be a reused one; see the function */ (type, plist)) { - Lisp_Object tail, keyword, value; Lisp_Object event = Qnil; - struct Lisp_Event *e; + Lisp_Event *e; EMACS_INT coord_x = 0, coord_y = 0; struct gcpro gcpro1; @@ -457,7 +459,7 @@ WARNING: the event object returned may be a reused one; see the function (e.g. CHANNEL), which we don't want in empty events. */ e->event_type = empty_event; if (!NILP (plist)) - error ("Cannot set properties of empty event"); + syntax_error ("Cannot set properties of empty event", plist); UNGCPRO; return event; } @@ -480,7 +482,7 @@ WARNING: the event object returned may be a reused one; see the function else { /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */ - signal_simple_error ("Invalid event type", type); + invalid_argument ("Invalid event type", type); } EVENT_CHANNEL (e) = Qnil; @@ -488,164 +490,169 @@ WARNING: the event object returned may be a reused one; see the function plist = Fcopy_sequence (plist); Fcanonicalize_plist (plist, Qnil); -#define WRONG_EVENT_TYPE_FOR_PROPERTY(type, prop) \ - error_with_frob (prop, "Invalid property for %s event", \ - string_data (symbol_name (XSYMBOL (type)))) +#define WRONG_EVENT_TYPE_FOR_PROPERTY(event_type, prop) \ + syntax_error_2 ("Invalid property for event type", prop, event_type) - EXTERNAL_PROPERTY_LIST_LOOP (tail, keyword, value, plist) - { - if (EQ (keyword, Qchannel)) - { - if (e->event_type == key_press_event) - { - if (!CONSOLEP (value)) - value = wrong_type_argument (Qconsolep, value); - } - else - { - if (!FRAMEP (value)) - value = wrong_type_argument (Qframep, value); - } - EVENT_CHANNEL (e) = value; - } - else if (EQ (keyword, Qkey)) - { - switch (e->event_type) - { - case key_press_event: - if (!SYMBOLP (value) && !CHARP (value)) - signal_simple_error ("Invalid event key", value); - e->event.key.keysym = value; - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qbutton)) - { - CHECK_NATNUM (value); - check_int_range (XINT (value), 0, 7); - - switch (e->event_type) - { - case button_press_event: - case button_release_event: - e->event.button.button = XINT (value); - break; - case misc_user_event: - e->event.misc.button = XINT (value); - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qmodifiers)) - { - int modifiers = 0; - Lisp_Object sym; - - EXTERNAL_LIST_LOOP_2 (sym, value) - { - if (EQ (sym, Qcontrol)) modifiers |= MOD_CONTROL; - else if (EQ (sym, Qmeta)) modifiers |= MOD_META; - else if (EQ (sym, Qsuper)) modifiers |= MOD_SUPER; - else if (EQ (sym, Qhyper)) modifiers |= MOD_HYPER; - else if (EQ (sym, Qalt)) modifiers |= MOD_ALT; - else if (EQ (sym, Qsymbol)) modifiers |= MOD_ALT; - else if (EQ (sym, Qshift)) modifiers |= MOD_SHIFT; - else - signal_simple_error ("Invalid key modifier", sym); - } - - switch (e->event_type) - { - case key_press_event: - e->event.key.modifiers = modifiers; - break; - case button_press_event: - case button_release_event: - e->event.button.modifiers = modifiers; - break; - case pointer_motion_event: - e->event.motion.modifiers = modifiers; - break; - case misc_user_event: - e->event.misc.modifiers = modifiers; - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qx)) - { - switch (e->event_type) - { - case pointer_motion_event: - case button_press_event: - case button_release_event: - case misc_user_event: - /* Allow negative values, so we can specify toolbar - positions. */ - CHECK_INT (value); - coord_x = XINT (value); - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qy)) - { - switch (e->event_type) - { - case pointer_motion_event: - case button_press_event: - case button_release_event: - case misc_user_event: - /* Allow negative values; see above. */ - CHECK_INT (value); - coord_y = XINT (value); - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qtimestamp)) - { - CHECK_NATNUM (value); - e->timestamp = XINT (value); - } - else if (EQ (keyword, Qfunction)) - { - switch (e->event_type) - { - case misc_user_event: - e->event.eval.function = value; - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else if (EQ (keyword, Qobject)) - { - switch (e->event_type) - { - case misc_user_event: - e->event.eval.object = value; - break; - default: - WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); - break; - } - } - else - signal_simple_error_2 ("Invalid property", keyword, value); - } + { + EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist) + { + if (EQ (keyword, Qchannel)) + { + if (e->event_type == key_press_event) + { + if (!CONSOLEP (value)) + value = wrong_type_argument (Qconsolep, value); + } + else + { + if (!FRAMEP (value)) + value = wrong_type_argument (Qframep, value); + } + EVENT_CHANNEL (e) = value; + } + else if (EQ (keyword, Qkey)) + { + switch (e->event_type) + { + case key_press_event: + if (!SYMBOLP (value) && !CHARP (value)) + syntax_error ("Invalid event key", value); + e->event.key.keysym = value; + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qbutton)) + { + CHECK_NATNUM (value); + check_int_range (XINT (value), 0, 7); + + switch (e->event_type) + { + case button_press_event: + case button_release_event: + e->event.button.button = XINT (value); + break; + case misc_user_event: + e->event.misc.button = XINT (value); + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qmodifiers)) + { + int modifiers = 0; + + EXTERNAL_LIST_LOOP_2 (sym, value) + { + if (EQ (sym, Qcontrol)) modifiers |= XEMACS_MOD_CONTROL; + else if (EQ (sym, Qmeta)) modifiers |= XEMACS_MOD_META; + else if (EQ (sym, Qsuper)) modifiers |= XEMACS_MOD_SUPER; + else if (EQ (sym, Qhyper)) modifiers |= XEMACS_MOD_HYPER; + else if (EQ (sym, Qalt)) modifiers |= XEMACS_MOD_ALT; + else if (EQ (sym, Qsymbol)) modifiers |= XEMACS_MOD_ALT; + else if (EQ (sym, Qshift)) modifiers |= XEMACS_MOD_SHIFT; + else if (EQ (sym, Qbutton1)) modifiers |= XEMACS_MOD_BUTTON1; + else if (EQ (sym, Qbutton2)) modifiers |= XEMACS_MOD_BUTTON2; + else if (EQ (sym, Qbutton3)) modifiers |= XEMACS_MOD_BUTTON3; + else if (EQ (sym, Qbutton4)) modifiers |= XEMACS_MOD_BUTTON4; + else if (EQ (sym, Qbutton5)) modifiers |= XEMACS_MOD_BUTTON5; + else + syntax_error ("Invalid key modifier", sym); + } + + switch (e->event_type) + { + case key_press_event: + e->event.key.modifiers = modifiers; + break; + case button_press_event: + case button_release_event: + e->event.button.modifiers = modifiers; + break; + case pointer_motion_event: + e->event.motion.modifiers = modifiers; + break; + case misc_user_event: + e->event.misc.modifiers = modifiers; + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qx)) + { + switch (e->event_type) + { + case pointer_motion_event: + case button_press_event: + case button_release_event: + case misc_user_event: + /* Allow negative values, so we can specify toolbar + positions. */ + CHECK_INT (value); + coord_x = XINT (value); + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qy)) + { + switch (e->event_type) + { + case pointer_motion_event: + case button_press_event: + case button_release_event: + case misc_user_event: + /* Allow negative values; see above. */ + CHECK_INT (value); + coord_y = XINT (value); + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qtimestamp)) + { + CHECK_NATNUM (value); + e->timestamp = XINT (value); + } + else if (EQ (keyword, Qfunction)) + { + switch (e->event_type) + { + case misc_user_event: + e->event.eval.function = value; + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else if (EQ (keyword, Qobject)) + { + switch (e->event_type) + { + case misc_user_event: + e->event.eval.object = value; + break; + default: + WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); + break; + } + } + else + syntax_error_2 ("Invalid property", keyword, value); + } + } /* Insert the channel, if missing. */ if (NILP (EVENT_CHANNEL (e))) @@ -679,7 +686,7 @@ WARNING: the event object returned may be a reused one; see the function e->event.misc.y = coord_y; break; default: - abort(); + ABORT(); } } @@ -688,19 +695,25 @@ WARNING: the event object returned may be a reused one; see the function { case key_press_event: if (UNBOUNDP (e->event.key.keysym)) - error ("A key must be specified to make a keypress event"); + syntax_error ("A key must be specified to make a keypress event", + plist); break; case button_press_event: if (!e->event.button.button) - error ("A button must be specified to make a button-press event"); + syntax_error + ("A button must be specified to make a button-press event", + plist); break; case button_release_event: if (!e->event.button.button) - error ("A button must be specified to make a button-release event"); + syntax_error + ("A button must be specified to make a button-release event", + plist); break; case misc_user_event: if (NILP (e->event.misc.function)) - error ("A function must be specified to make a misc-user event"); + syntax_error ("A function must be specified to make a misc-user event", + plist); break; default: break; @@ -734,18 +747,18 @@ that it is safe to do so. if (EQ (event, Vlast_command_event) || EQ (event, Vlast_input_event) || EQ (event, Vunread_command_event)) - abort (); + ABORT (); len = XVECTOR_LENGTH (Vthis_command_keys); for (i = 0; i < len; i++) if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i])) - abort (); + ABORT (); if (!NILP (Vrecent_keys_ring)) { int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring); for (i = 0; i < recent_ring_len; i++) if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i])) - abort (); + ABORT (); } } #endif /* 0 */ @@ -760,30 +773,37 @@ that it is safe to do so. } DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /* -Make a copy of the given event object. -If a second argument is given, the first event is copied into the second -and the second is returned. If the second argument is not supplied (or -is nil) then a new event will be made as with `allocate-event.' See also -the function `deallocate-event'. +Make a copy of the event object EVENT1. +If a second event argument EVENT2 is given, EVENT1 is copied into +EVENT2 and EVENT2 is returned. If EVENT2 is not supplied (or is nil) +then a new event will be made as with `make-event'. See also the +function `deallocate-event'. */ (event1, event2)) { CHECK_LIVE_EVENT (event1); if (NILP (event2)) event2 = Fmake_event (Qnil, Qnil); - else CHECK_LIVE_EVENT (event2); - if (EQ (event1, event2)) - return signal_simple_continuable_error_2 - ("copy-event called with `eq' events", event1, event2); + else + { + CHECK_LIVE_EVENT (event2); + if (EQ (event1, event2)) + return signal_simple_continuable_error_2 + ("copy-event called with `eq' events", event1, event2); + } assert (XEVENT_TYPE (event1) <= last_event_type); assert (XEVENT_TYPE (event2) <= last_event_type); { - Lisp_Object save_next = XEVENT_NEXT (event2); + Lisp_Event *ev2 = XEVENT (event2); + Lisp_Event *ev1 = XEVENT (event1); + + ev2->event_type = ev1->event_type; + ev2->channel = ev1->channel; + ev2->timestamp = ev1->timestamp; + ev2->event = ev1->event; - *XEVENT (event2) = *XEVENT (event1); - XSET_EVENT_NEXT (event2, save_next); return event2; } } @@ -805,7 +825,7 @@ deallocate_event_chain (Lisp_Object event_chain) /* Return the last event in a chain. NOTE: You cannot pass nil as a value here! The routine will - abort if you do. */ + ABORT if you do. */ Lisp_Object event_chain_tail (Lisp_Object event_chain) @@ -892,7 +912,7 @@ event_chain_count (Lisp_Object event_chain) return n; } -/* Find the event before EVENT in an event chain. This aborts +/* Find the event before EVENT in an event chain. This ABORTs if the event is not in the chain. */ Lisp_Object @@ -908,7 +928,7 @@ event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event) event_chain = XEVENT_NEXT (event_chain); } - abort (); + ABORT (); return Qnil; } @@ -963,11 +983,11 @@ command_event_p (Lisp_Object event) void -character_to_event (Emchar c, struct Lisp_Event *event, struct console *con, +character_to_event (Emchar c, Lisp_Event *event, struct console *con, int use_console_meta_flag, int do_backspace_mapping) { Lisp_Object k = Qnil; - unsigned int m = 0; + int m = 0; if (event->event_type == dead_event) error ("character-to-event called with a deallocated event!"); @@ -986,21 +1006,21 @@ character_to_event (Emchar c, struct Lisp_Event *event, struct console *con, break; case 1: /* top bit is meta */ c -= 128; - m = MOD_META; + m = XEMACS_MOD_META; break; default: /* this is a real character */ break; } } - if (c < ' ') c += '@', m |= MOD_CONTROL; - if (m & MOD_CONTROL) + if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL; + if (m & XEMACS_MOD_CONTROL) { switch (c) { - case 'I': k = QKtab; m &= ~MOD_CONTROL; break; - case 'J': k = QKlinefeed; m &= ~MOD_CONTROL; break; - case 'M': k = QKreturn; m &= ~MOD_CONTROL; break; - case '[': k = QKescape; m &= ~MOD_CONTROL; break; + case 'I': k = QKtab; m &= ~XEMACS_MOD_CONTROL; break; + case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break; + case 'M': k = QKreturn; m &= ~XEMACS_MOD_CONTROL; break; + case '[': k = QKescape; m &= ~XEMACS_MOD_CONTROL; break; default: #if defined(HAVE_TTY) if (do_backspace_mapping && @@ -1008,9 +1028,9 @@ character_to_event (Emchar c, struct Lisp_Event *event, struct console *con, c - '@' == XCHAR (con->tty_erase_char)) { k = QKbackspace; - m &= ~MOD_CONTROL; + m &= ~XEMACS_MOD_CONTROL; } -#endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ +#endif /* defined(HAVE_TTY) && !defined(CYGWIN) */ break; } if (c >= 'A' && c <= 'Z') c -= 'A'-'a'; @@ -1019,7 +1039,7 @@ character_to_event (Emchar c, struct Lisp_Event *event, struct console *con, else if (do_backspace_mapping && CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char)) k = QKbackspace; -#endif /* defined(HAVE_TTY) && !defined(__CYGWIN32__) */ +#endif /* defined(HAVE_TTY) && !defined(CYGWIN) */ else if (c == 127) k = QKdelete; else if (c == ' ') @@ -1032,17 +1052,18 @@ character_to_event (Emchar c, struct Lisp_Event *event, struct console *con, event->event.key.modifiers = m; } - /* This variable controls what character name -> character code mapping we are using. Window-system-specific code sets this to some symbol, and we use that symbol as the plist key to convert keysyms into 8-bit codes. In this way one can have several character sets predefined and switch them by changing this. + + #### This is utterly bogus and should be removed. */ Lisp_Object Vcharacter_set_property; Emchar -event_to_character (struct Lisp_Event *event, +event_to_character (Lisp_Event *event, int allow_extra_modifiers, int allow_meta, int allow_non_ascii) @@ -1052,16 +1073,16 @@ event_to_character (struct Lisp_Event *event, if (event->event_type != key_press_event) { - if (event->event_type == dead_event) abort (); + assert (event->event_type != dead_event); return -1; } if (!allow_extra_modifiers && - event->event.key.modifiers & (MOD_SUPER|MOD_HYPER|MOD_ALT)) + event->event.key.modifiers & (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_MOD_ALT)) return -1; if (CHAR_OR_CHAR_INTP (event->event.key.keysym)) c = XCHAR_OR_CHAR_INT (event->event.key.keysym); else if (!SYMBOLP (event->event.key.keysym)) - abort (); + ABORT (); else if (allow_non_ascii && !NILP (Vcharacter_set_property) /* Allow window-system-specific extensibility of keysym->code mapping */ @@ -1075,7 +1096,7 @@ event_to_character (struct Lisp_Event *event, else return -1; - if (event->event.key.modifiers & MOD_CONTROL) + if (event->event.key.modifiers & XEMACS_MOD_CONTROL) { if (c >= 'a' && c <= 'z') c -= ('a' - 'A'); @@ -1093,7 +1114,7 @@ event_to_character (struct Lisp_Event *event, if (! allow_extra_modifiers) return -1; } - if (event->event.key.modifiers & MOD_META) + if (event->event.key.modifiers & XEMACS_MOD_META) { if (! allow_meta) return -1; if (c & 0200) return -1; /* don't allow M-oslash (overlap) */ @@ -1135,46 +1156,48 @@ Note that specifying both ALLOW-META and ALLOW-NON-ASCII is ambiguous, as } DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /* -Convert keystroke CH into an event structure ,replete with bucky bits. -The keystroke is the first argument, and the event to fill -in is the second. This function contains knowledge about what the codes -``mean'' -- for example, the number 9 is converted to the character ``Tab'', -not the distinct character ``Control-I''. +Convert KEY-DESCRIPTION into an event structure, replete with bucky bits. + +KEY-DESCRIPTION is the first argument, and the event to fill in is the +second. This function contains knowledge about what various kinds of +arguments ``mean'' -- for example, the number 9 is converted to the +character ``Tab'', not the distinct character ``Control-I''. -Note that CH (the keystroke specifier) can be an integer, a character, -a symbol such as 'clear, or a list such as '(control backspace). +KEY-DESCRIPTION can be an integer, a character, a symbol such as 'clear, +or a list such as '(control backspace). -If the optional second argument is an event, it is modified; -otherwise, a new event object is created. +If the optional second argument EVENT is an event, it is modified and +returned; otherwise, a new event object is created and returned. Optional third arg CONSOLE is the console to store in the event, and defaults to the selected console. -If CH is an integer or character, the high bit may be interpreted as the -meta key. (This is done for backward compatibility in lots of places.) -If USE-CONSOLE-META-FLAG is nil, this will always be the case. If -USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for CONSOLE affects -whether the high bit is interpreted as a meta key. (See `set-input-mode'.) -If you don't want this silly meta interpretation done, you should pass -in a list containing the character. +If KEY-DESCRIPTION is an integer or character, the high bit may be +interpreted as the meta key. (This is done for backward compatibility +in lots of places.) If USE-CONSOLE-META-FLAG is nil, this will always +be the case. If USE-CONSOLE-META-FLAG is non-nil, the `meta' flag for +CONSOLE affects whether the high bit is interpreted as a meta +key. (See `set-input-mode'.) If you don't want this silly meta +interpretation done, you should pass in a list containing the +character. Beware that character-to-event and event-to-character are not strictly inverse functions, since events contain much more information than the -ASCII character set can encode. +Lisp character object type can encode. */ - (ch, event, console, use_console_meta_flag)) + (keystroke, event, console, use_console_meta_flag)) { struct console *con = decode_console (console); if (NILP (event)) event = Fmake_event (Qnil, Qnil); else CHECK_LIVE_EVENT (event); - if (CONSP (ch) || SYMBOLP (ch)) - key_desc_list_to_event (ch, event, 1); + if (CONSP (keystroke) || SYMBOLP (keystroke)) + key_desc_list_to_event (keystroke, event, 1); else { - CHECK_CHAR_COERCE_INT (ch); - character_to_event (XCHAR (ch), XEVENT (event), con, + CHECK_CHAR_COERCE_INT (keystroke); + character_to_event (XCHAR (keystroke), XEVENT (event), con, !NILP (use_console_meta_flag), 1); } return event; @@ -1219,7 +1242,7 @@ key_sequence_to_event_chain (Lisp_Object seq) } void -format_event_object (char *buf, struct Lisp_Event *event, int brief) +format_event_object (char *buf, Lisp_Event *event, int brief) { int mouse_p = 0; int mod = 0; @@ -1233,13 +1256,13 @@ format_event_object (char *buf, struct Lisp_Event *event, int brief) key = event->event.key.keysym; /* Hack. */ if (! brief && CHARP (key) && - mod & (MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER)) + mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER)) { int k = XCHAR (key); if (k >= 'a' && k <= 'z') key = make_char (k - ('a' - 'A')); else if (k >= 'A' && k <= 'Z') - mod |= MOD_SHIFT; + mod |= XEMACS_MOD_SHIFT; } break; } @@ -1255,8 +1278,15 @@ format_event_object (char *buf, struct Lisp_Event *event, int brief) } case magic_event: { - CONST char *name = NULL; - + const char *name = NULL; + +#ifdef HAVE_GTK + { + Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); + if (CONSOLE_GTK_P (XCONSOLE (console))) + name = gtk_event_name (event->event.magic.underlying_gdk_event.type); + } +#endif #ifdef HAVE_X_WINDOWS { Lisp_Object console = CDFW_CONSOLE (EVENT_CHANNEL (event)); @@ -1277,16 +1307,17 @@ format_event_object (char *buf, struct Lisp_Event *event, int brief) case empty_event: strcpy (buf, "empty"); return; case dead_event: strcpy (buf, "DEAD-EVENT"); return; default: - abort (); + ABORT (); + return; } #define modprint1(x) do { strcpy (buf, (x)); buf += sizeof (x)-1; } while (0) #define modprint(x,y) do { if (brief) modprint1 (y); else modprint1 (x); } while (0) - if (mod & MOD_CONTROL) modprint ("control-", "C-"); - if (mod & MOD_META) modprint ("meta-", "M-"); - if (mod & MOD_SUPER) modprint ("super-", "S-"); - if (mod & MOD_HYPER) modprint ("hyper-", "H-"); - if (mod & MOD_ALT) modprint ("alt-", "A-"); - if (mod & MOD_SHIFT) modprint ("shift-", "Sh-"); + if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-"); + if (mod & XEMACS_MOD_META) modprint ("meta-", "M-"); + if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-"); + if (mod & XEMACS_MOD_HYPER) modprint ("hyper-", "H-"); + if (mod & XEMACS_MOD_ALT) modprint ("alt-", "A-"); + if (mod & XEMACS_MOD_SHIFT) modprint ("shift-", "Sh-"); if (mouse_p) { modprint1 ("button"); @@ -1303,7 +1334,7 @@ format_event_object (char *buf, struct Lisp_Event *event, int brief) } else if (SYMBOLP (key)) { - CONST char *str = 0; + const char *str = 0; if (brief) { if (EQ (key, QKlinefeed)) str = "LFD"; @@ -1322,13 +1353,13 @@ format_event_object (char *buf, struct Lisp_Event *event, int brief) } else { - struct Lisp_String *name = XSYMBOL (key)->name; + Lisp_String *name = XSYMBOL (key)->name; memcpy (buf, string_data (name), string_length (name) + 1); str += string_length (name); } } else - abort (); + ABORT (); if (mouse_p) strncpy (buf, "up", 4); } @@ -1358,7 +1389,7 @@ The `next-event' field is changed by calling `set-next-event'. */ (event)) { - struct Lisp_Event *e; + Lisp_Event *e; CHECK_LIVE_EVENT (event); return XEVENT_NEXT (event); @@ -1434,13 +1465,17 @@ empty The event has been allocated but not assigned. return Qempty; default: - abort (); + ABORT (); return Qnil; } } DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /* Return the timestamp of the event object EVENT. +Timestamps are measured in milliseconds since the start of the window system. +They are NOT related to any current time measurement. +They should be compared with `event-timestamp<'. +See also `current-event-timestamp'. */ (event)) { @@ -1448,29 +1483,56 @@ Return the timestamp of the event object EVENT. /* This junk is so that timestamps don't get to be negative, but contain as many bits as this particular emacs will allow. */ - return make_int (((1L << (VALBITS - 1)) - 1) & - XEVENT (event)->timestamp); + return make_int (EMACS_INT_MAX & XEVENT (event)->timestamp); +} + +#define TIMESTAMP_HALFSPACE (1L << (INT_VALBITS - 2)) + +DEFUN ("event-timestamp<", Fevent_timestamp_lessp, 2, 2, 0, /* +Return true if timestamp TIME1 is earlier than timestamp TIME2. +This correctly handles timestamp wrap. +See also `event-timestamp' and `current-event-timestamp'. +*/ + (time1, time2)) +{ + EMACS_INT t1, t2; + + CHECK_NATNUM (time1); + CHECK_NATNUM (time2); + t1 = XINT (time1); + t2 = XINT (time2); + + if (t1 < t2) + return t2 - t1 < TIMESTAMP_HALFSPACE ? Qt : Qnil; + else + return t1 - t2 < TIMESTAMP_HALFSPACE ? Qnil : Qt; } #define CHECK_EVENT_TYPE(e,t1,sym) do { \ CHECK_LIVE_EVENT (e); \ if (XEVENT(e)->event_type != (t1)) \ - e = wrong_type_argument ((sym),(e)); \ + e = wrong_type_argument (sym,e); \ } while (0) -#define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ - CHECK_LIVE_EVENT (e); \ - if (XEVENT(e)->event_type != (t1) && \ - XEVENT(e)->event_type != (t2)) \ - e = wrong_type_argument ((sym),(e)); \ +#define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ + CHECK_LIVE_EVENT (e); \ + { \ + emacs_event_type CET_type = XEVENT (e)->event_type; \ + if (CET_type != (t1) && \ + CET_type != (t2)) \ + e = wrong_type_argument (sym,e); \ + } \ } while (0) -#define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \ - CHECK_LIVE_EVENT (e); \ - if (XEVENT(e)->event_type != (t1) && \ - XEVENT(e)->event_type != (t2) && \ - XEVENT(e)->event_type != (t3)) \ - e = wrong_type_argument ((sym),(e)); \ +#define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \ + CHECK_LIVE_EVENT (e); \ + { \ + emacs_event_type CET_type = XEVENT (e)->event_type; \ + if (CET_type != (t1) && \ + CET_type != (t2) && \ + CET_type != (t3)) \ + e = wrong_type_argument (sym,e); \ + } \ } while (0) DEFUN ("event-key", Fevent_key, 1, 1, 0, /* @@ -1484,7 +1546,7 @@ This will be a character if the event is associated with one, else a symbol. } DEFUN ("event-button", Fevent_button, 1, 1, 0, /* -Return the button-number of the given button-press or button-release event. +Return the button-number of the button-press or button-release event EVENT. */ (event)) { @@ -1503,9 +1565,9 @@ Return the button-number of the given button-press or button-release event. } DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /* -Return a number representing the modifier keys which were down +Return a number representing the modifier keys and buttons which were down when the given mouse or keyboard event was produced. -See also the function event-modifiers. +See also the function `event-modifiers'. */ (event)) { @@ -1529,21 +1591,67 @@ See also the function event-modifiers. } DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /* -Return a list of symbols, the names of the modifier keys +Return a list of symbols, the names of the modifier keys and buttons which were down when the given mouse or keyboard event was produced. -See also the function event-modifier-bits. +See also the function `event-modifier-bits'. + +The possible symbols in the list are + +`shift': The Shift key. Will not appear, in general, on key events + where the keysym is an ASCII character, because using Shift + on such a character converts it into another character rather + than actually just adding a Shift modifier. + +`control': The Control key. + +`meta': The Meta key. On PC's and PC-style keyboards, this is generally + labelled \"Alt\"; Meta is a holdover from early Lisp Machines and + such, propagated through the X Window System. On Sun keyboards, + this key is labelled with a diamond. + +`alt': The \"Alt\" key. Alt is in quotes because this does not refer + to what it obviously should refer to, namely the Alt key on PC + keyboards. Instead, it refers to the key labelled Alt on Sun + keyboards, and to no key at all on PC keyboards. + +`super': The Super key. Most keyboards don't have any such key, but + under X Windows using `xmodmap' you can assign any key (such as + an underused right-shift, right-control, or right-alt key) to + this key modifier. No support currently exists under MS Windows + for generating these modifiers. + +`hyper': The Hyper key. Works just like the Super key. + +`button1': The mouse buttons. This means that the specified button was held +`button2': down at the time the event occurred. NOTE: For button-press +`button3': events, the button that was just pressed down does NOT appear in +`button4': the modifiers. +`button5': + +Button modifiers are currently ignored when defining and looking up key and +mouse strokes in keymaps. This could be changed, which would allow a user to +create button-chord actions, use a button as a key modifier and do other +clever things. */ (event)) { int mod = XINT (Fevent_modifier_bits (event)); Lisp_Object result = Qnil; - if (mod & MOD_SHIFT) result = Fcons (Qshift, result); - if (mod & MOD_ALT) result = Fcons (Qalt, result); - if (mod & MOD_HYPER) result = Fcons (Qhyper, result); - if (mod & MOD_SUPER) result = Fcons (Qsuper, result); - if (mod & MOD_META) result = Fcons (Qmeta, result); - if (mod & MOD_CONTROL) result = Fcons (Qcontrol, result); - return result; + struct gcpro gcpro1; + + GCPRO1 (result); + if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result); + if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result); + if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result); + if (mod & XEMACS_MOD_SUPER) result = Fcons (Qsuper, result); + if (mod & XEMACS_MOD_META) result = Fcons (Qmeta, result); + if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result); + if (mod & XEMACS_MOD_BUTTON1) result = Fcons (Qbutton1, result); + if (mod & XEMACS_MOD_BUTTON2) result = Fcons (Qbutton2, result); + if (mod & XEMACS_MOD_BUTTON3) result = Fcons (Qbutton3, result); + if (mod & XEMACS_MOD_BUTTON4) result = Fcons (Qbutton4, result); + if (mod & XEMACS_MOD_BUTTON5) result = Fcons (Qbutton5, result); + RETURN_UNGCPRO (Fnreverse (result)); } static int @@ -1578,7 +1686,7 @@ event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative) w = find_window_by_pixel_pos (*x, *y, f->root_window); if (!w) - return 1; /* #### What should really happen here. */ + return 1; /* #### What should really happen here? */ *x -= w->pixel_left; *y -= w->pixel_top; @@ -1750,9 +1858,9 @@ event_pixel_translation (Lisp_Object event, int *char_x, int *char_y, || TOOLBAR_BUTTONP (ret_obj1) #endif )) - abort (); + ABORT (); if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2))) - abort (); + ABORT (); if (char_x) *char_x = ret_x; @@ -2033,7 +2141,7 @@ If the event did not occur over a toolbar button, nil is returned. } DEFUN ("event-process", Fevent_process, 1, 1, 0, /* -Return the process of the given process-output event. +Return the process of the process-output event EVENT. */ (event)) { @@ -2092,7 +2200,7 @@ This is in the form of a property list (alternating keyword/value pairs). (event)) { Lisp_Object props = Qnil; - struct Lisp_Event *e; + Lisp_Event *e; struct gcpro gcpro1; CHECK_LIVE_EVENT (event); @@ -2103,7 +2211,7 @@ This is in the form of a property list (alternating keyword/value pairs). switch (e->event_type) { - default: abort (); + default: ABORT (); case process_event: props = cons3 (Qprocess, e->event.process.process, props); @@ -2171,6 +2279,8 @@ This is in the form of a property list (alternating keyword/value pairs). void syms_of_events (void) { + INIT_LRECORD_IMPLEMENTATION (event); + DEFSUBR (Fcharacter_to_event); DEFSUBR (Fevent_to_character); @@ -2183,6 +2293,7 @@ syms_of_events (void) DEFSUBR (Fevent_properties); DEFSUBR (Fevent_timestamp); + DEFSUBR (Fevent_timestamp_lessp); DEFSUBR (Fevent_key); DEFSUBR (Fevent_button); DEFSUBR (Fevent_modifier_bits); @@ -2223,11 +2334,28 @@ syms_of_events (void) defsymbol (&Qbutton_release, "button-release"); defsymbol (&Qmisc_user, "misc-user"); defsymbol (&Qascii_character, "ascii-character"); + + defsymbol (&QKbackspace, "backspace"); + defsymbol (&QKtab, "tab"); + defsymbol (&QKlinefeed, "linefeed"); + defsymbol (&QKreturn, "return"); + defsymbol (&QKescape, "escape"); + defsymbol (&QKspace, "space"); + defsymbol (&QKdelete, "delete"); +} + + +void +reinit_vars_of_events (void) +{ + Vevent_resource = Qnil; } void vars_of_events (void) { + reinit_vars_of_events (); + DEFVAR_LISP ("character-set-property", &Vcharacter_set_property /* A symbol used to look up the 8-bit character of a keysym. To convert a keysym symbol to an 8-bit code, as when that key is @@ -2237,22 +2365,4 @@ system-specific code will set up appropriate properties and set this variable. */ ); Vcharacter_set_property = Qnil; - - Vevent_resource = Qnil; - - QKbackspace = KEYSYM ("backspace"); - QKtab = KEYSYM ("tab"); - QKlinefeed = KEYSYM ("linefeed"); - QKreturn = KEYSYM ("return"); - QKescape = KEYSYM ("escape"); - QKspace = KEYSYM ("space"); - QKdelete = KEYSYM ("delete"); - - staticpro (&QKbackspace); - staticpro (&QKtab); - staticpro (&QKlinefeed); - staticpro (&QKreturn); - staticpro (&QKescape); - staticpro (&QKspace); - staticpro (&QKdelete); }