Mercurial > hg > xemacs-beta
annotate src/events.c @ 4976:16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-04 Ben Wing <ben@xemacs.org>
* alloc.c (release_breathing_space):
* alloc.c (resize_string):
* alloc.c (sweep_lcrecords_1):
* alloc.c (SWEEP_FIXED_TYPE_BLOCK_1):
* alloc.c (ADDITIONAL_FREE_compiled_function):
* alloc.c (compact_string_chars):
* alloc.c (ADDITIONAL_FREE_string):
* alloc.c (sweep_strings):
* alloca.c (xemacs_c_alloca):
* alsaplay.c (alsa_play_sound_file):
* buffer.c (init_initial_directory):
* buffer.h:
* buffer.h (BUFFER_FREE):
* console-stream.c (stream_delete_console):
* console-tty.c (free_tty_console_struct):
* data.c (Fnumber_to_string):
* device-gtk.c (gtk_init_device):
* device-gtk.c (free_gtk_device_struct):
* device-gtk.c (gtk_delete_device):
* device-msw.c (mswindows_delete_device):
* device-msw.c (msprinter_delete_device):
* device-tty.c (free_tty_device_struct):
* device-tty.c (tty_delete_device):
* device-x.c (x_init_device):
* device-x.c (free_x_device_struct):
* device-x.c (x_delete_device):
* dialog-msw.c (handle_directory_dialog_box):
* dialog-x.c (dbox_descriptor_to_widget_value):
* dired-msw.c (Fmswindows_insert_directory):
* dired.c (free_user_cache):
* dired.c (user_name_completion_unwind):
* doc.c (unparesseuxify_doc_string):
* doc.c (Fsubstitute_command_keys):
* doprnt.c (emacs_doprnt_1):
* dumper.c (pdump_load_finish):
* dumper.c (pdump_file_free):
* dumper.c (pdump_file_unmap):
* dynarr.c:
* dynarr.c (Dynarr_free):
* editfns.c (uncache_home_directory):
* editfns.c (Fset_time_zone_rule):
* elhash.c:
* elhash.c (pdump_reorganize_hash_table):
* elhash.c (maphash_unwind):
* emacs.c (make_arg_list_1):
* emacs.c (free_argc_argv):
* emacs.c (sort_args):
* emacs.c (Frunning_temacs_p):
* emodules.c (attempt_module_delete):
* eval.c (free_pointer):
* event-Xt.c (unselect_filedesc):
* event-Xt.c (emacs_Xt_select_process):
* event-gtk.c (unselect_filedesc):
* event-gtk.c (dragndrop_data_received):
* event-msw.c (winsock_closer):
* event-msw.c (mswindows_dde_callback):
* event-msw.c (mswindows_wnd_proc):
* event-stream.c (finalize_command_builder):
* event-stream.c (free_command_builder):
* extents.c (free_gap_array):
* extents.c (free_extent_list):
* extents.c (free_soe):
* extents.c (extent_fragment_delete):
* extents.c (extent_priority_sort_function):
* file-coding.c (make_coding_system_1):
* file-coding.c (coding_finalizer):
* file-coding.c (set_coding_stream_coding_system):
* file-coding.c (chain_finalize_coding_stream_1):
* file-coding.c (chain_finalize):
* file-coding.c (free_detection_state):
* file-coding.c (coding_category_symbol_to_id):
* fileio.c:
* fileio.c (Ffile_name_directory):
* fileio.c (if):
* fileio.c (Ffile_symlink_p):
* filelock.c (FREE_LOCK_INFO):
* filelock.c (current_lock_owner):
* font-mgr.c (Ffc_name_unparse):
* font-mgr.c (Ffc_pattern_duplicate):
* frame-gtk.c (gtk_delete_frame):
* frame-msw.c (mswindows_delete_frame):
* frame-msw.c (msprinter_delete_frame):
* frame-x.c (x_cde_destroy_callback):
* frame-x.c (Fcde_start_drag_internal):
* frame-x.c (x_cde_transfer_callback):
* frame-x.c (x_delete_frame):
* frame.c (update_frame_title):
* frame.c (Fset_frame_pointer):
* gc.c (register_for_finalization):
* gccache-gtk.c (free_gc_cache):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c (free_gc_cache):
* gccache-x.c (gc_cache_lookup):
* glyphs-eimage.c:
* glyphs-eimage.c (jpeg_instantiate_unwind):
* glyphs-eimage.c (gif_instantiate_unwind):
* glyphs-eimage.c (png_instantiate_unwind):
* glyphs-eimage.c (png_instantiate):
* glyphs-eimage.c (tiff_instantiate_unwind):
* glyphs-gtk.c (convert_EImage_to_GDKImage):
* glyphs-gtk.c (gtk_finalize_image_instance):
* glyphs-gtk.c (gtk_init_image_instance_from_eimage):
* glyphs-gtk.c (gtk_xpm_instantiate):
* glyphs-msw.c (convert_EImage_to_DIBitmap):
* glyphs-msw.c (mswindows_init_image_instance_from_eimage):
* glyphs-msw.c (mswindows_initialize_image_instance_mask):
* glyphs-msw.c (xpm_to_eimage):
* glyphs-msw.c (mswindows_xpm_instantiate):
* glyphs-msw.c (xbm_create_bitmap_from_data):
* glyphs-msw.c (mswindows_finalize_image_instance):
* glyphs-x.c (convert_EImage_to_XImage):
* glyphs-x.c (x_finalize_image_instance):
* glyphs-x.c (x_init_image_instance_from_eimage):
* glyphs-x.c (x_xpm_instantiate):
* gui-x.c (free_popup_widget_value_tree):
* hash.c (free_hash_table):
* hash.c (grow_hash_table):
* hash.c (pregrow_hash_table_if_necessary):
* imgproc.c (build_EImage_quantable):
* insdel.c (uninit_buffer_text):
* intl-win32.c (convert_multibyte_to_internal_malloc):
* intl.c:
* intl.c (Fset_current_locale):
* keymap.c:
* keymap.c (where_is_recursive_mapper):
* keymap.c (where_is_internal):
* lisp.h:
* lisp.h (xfree):
* lstream.c (Lstream_close):
* lstream.c (resizing_buffer_closer):
* mule-coding.c:
* mule-coding.c (iso2022_finalize_detection_state):
* nt.c:
* nt.c (mswindows_get_long_filename):
* nt.c (nt_get_resource):
* nt.c (init_mswindows_environment):
* nt.c (get_cached_volume_information):
* nt.c (mswindows_opendir):
* nt.c (mswindows_closedir):
* nt.c (mswindows_readdir):
* nt.c (mswindows_stat):
* nt.c (mswindows_getdcwd):
* nt.c (Fmswindows_long_file_name):
* ntplay.c (nt_play_sound_file):
* ntplay.c (play_sound_data_1):
* number-gmp.c (gmp_free):
* number-gmp.c (init_number_gmp):
* number-mp.c (bignum_to_string):
* number-mp.c (BIGNUM_TO_TYPE):
* number.c (bignum_print):
* number.c (bignum_convfree):
* number.c (ratio_print):
* number.c (bigfloat_print):
* number.c (bigfloat_finalize):
* objects-gtk.c (gtk_finalize_color_instance):
* objects-gtk.c (gtk_finalize_font_instance):
* objects-msw.c (mswindows_finalize_color_instance):
* objects-msw.c (mswindows_finalize_font_instance):
* objects-tty.c (tty_finalize_color_instance):
* objects-tty.c (tty_finalize_font_instance):
* objects-tty.c (tty_font_list):
* objects-x.c (x_finalize_color_instance):
* objects-x.c (x_finalize_font_instance):
* process.c:
* process.c (finalize_process):
* realpath.c:
* redisplay.c (add_propagation_runes):
* regex.c:
* regex.c (xfree):
* regex.c (REGEX_FREE_STACK):
* regex.c (FREE_STACK_RETURN):
* regex.c (regex_compile):
* regex.c (regexec):
* regex.c (regfree):
* scrollbar-gtk.c (gtk_free_scrollbar_instance):
* scrollbar-gtk.c (gtk_release_scrollbar_instance):
* scrollbar-msw.c (mswindows_free_scrollbar_instance):
* scrollbar-msw.c (unshow_that_mofo):
* scrollbar-x.c (x_free_scrollbar_instance):
* scrollbar-x.c (x_release_scrollbar_instance):
* select-gtk.c (emacs_gtk_selection_handle):
* select-msw.c (mswindows_own_selection):
* select-x.c:
* select-x.c (x_handle_selection_request):
* select-x.c (unexpect_property_change):
* select-x.c (x_handle_property_notify):
* select-x.c (receive_incremental_selection):
* select-x.c (x_get_window_property_as_lisp_data):
* select-x.c (Fx_get_cutbuffer_internal):
* specifier.c (finalize_specifier):
* syntax.c (uninit_buffer_syntax_cache):
* sysdep.c (qxe_allocating_getcwd):
* sysdep.c (qxe_lstat):
* sysdep.c (copy_in_passwd):
* sysdep.c (qxe_ctime):
* sysdep.c (closedir):
* sysdep.c (DIRSIZ):
* termcap.c (tgetent):
* termcap.c (tprint):
* tests.c (Ftest_data_format_conversion):
* text.c (new_dfc_convert_copy_data):
* text.h (eifree):
* text.h (eito_alloca):
* text.h (eito_external):
* toolbar-msw.c (mswindows_output_toolbar):
* ui-gtk.c (CONVERT_RETVAL):
* ui-gtk.c (__allocate_object_storage):
* unicode.c (free_from_unicode_table):
* unicode.c (free_to_unicode_table):
* unicode.c (free_charset_unicode_tables):
* win32.c (mswindows_read_link_1):
Rename: xfree(VAL, TYPE)->xfree(VAL)
Command used:
gr 'xfree *\((.*),.*\);' 'xfree (\1);' *.[ch]
Followed by grepping for 'xfree.*,' and fixing anything left.
Rationale: Having to specify the TYPE argument is annoying and
error-prone. It was originally put in to work around warnings
due to strict aliasing but years and years ago I rewrote it
in a way that doesn't use the TYPE argument at all and no one
has complained since then. (And anyway, XEmacs is far from
ever being in compliance with strict aliasing and would require
far-reaching changes to get that way.)
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Thu, 04 Feb 2010 07:28:14 -0600 |
parents | e813cf16c015 |
children | d4f666cda5e6 6f2158fa75ed b5df3737028a |
rev | line source |
---|---|
428 | 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. | |
3063 | 4 Copyright (C) 2001, 2002, 2005 Ben Wing. |
428 | 5 |
6 This file is part of XEmacs. | |
7 | |
8 XEmacs is free software; you can redistribute it and/or modify it | |
9 under the terms of the GNU General Public License as published by the | |
10 Free Software Foundation; either version 2, or (at your option) any | |
11 later version. | |
12 | |
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
16 for more details. | |
17 | |
18 You should have received a copy of the GNU General Public License | |
19 along with XEmacs; see the file COPYING. If not, write to | |
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 Boston, MA 02111-1307, USA. */ | |
22 | |
23 /* Synched up with: Not in FSF. */ | |
24 | |
25 /* This file has been Mule-ized. */ | |
26 | |
27 #include <config.h> | |
28 #include "lisp.h" | |
29 #include "buffer.h" | |
30 #include "console.h" | |
31 #include "device.h" | |
788 | 32 #include "extents.h" |
428 | 33 #include "events.h" |
872 | 34 #include "frame-impl.h" |
428 | 35 #include "glyphs.h" |
36 #include "keymap.h" /* for key_desc_list_to_event() */ | |
788 | 37 #include "lstream.h" |
428 | 38 #include "redisplay.h" |
800 | 39 #include "toolbar.h" |
428 | 40 #include "window.h" |
41 | |
872 | 42 #include "console-tty-impl.h" /* for stuff in character_to_event */ |
800 | 43 |
2340 | 44 #ifdef HAVE_TTY |
45 #define USED_IF_TTY(decl) decl | |
46 #else | |
47 #define USED_IF_TTY(decl) UNUSED (decl) | |
48 #endif | |
49 | |
50 #ifdef HAVE_TOOLBARS | |
51 #define USED_IF_TOOLBARS(decl) decl | |
52 #else | |
53 #define USED_IF_TOOLBARS(decl) UNUSED (decl) | |
54 #endif | |
55 | |
428 | 56 /* Where old events go when they are explicitly deallocated. |
57 The event chain here is cut loose before GC, so these will be freed | |
58 eventually. | |
59 */ | |
60 static Lisp_Object Vevent_resource; | |
61 | |
62 Lisp_Object Qeventp; | |
63 Lisp_Object Qevent_live_p; | |
64 Lisp_Object Qkey_press_event_p; | |
65 Lisp_Object Qbutton_event_p; | |
66 Lisp_Object Qmouse_event_p; | |
67 Lisp_Object Qprocess_event_p; | |
68 | |
69 Lisp_Object Qkey_press, Qbutton_press, Qbutton_release, Qmisc_user; | |
2828 | 70 Lisp_Object Qcharacter_of_keysym, Qascii_character; |
428 | 71 |
771 | 72 |
73 /************************************************************************/ | |
74 /* definition of event object */ | |
75 /************************************************************************/ | |
428 | 76 |
77 /* #### Ad-hoc hack. Should be part of define_lrecord_implementation */ | |
78 void | |
79 clear_event_resource (void) | |
80 { | |
81 Vevent_resource = Qnil; | |
82 } | |
83 | |
934 | 84 /* Make sure we lose quickly if we try to use this event */ |
85 static void | |
86 deinitialize_event (Lisp_Object ev) | |
87 { | |
88 Lisp_Event *event = XEVENT (ev); | |
3063 | 89 int i; |
90 /* Preserve the old UID for this event, for tracking it */ | |
91 unsigned int old_uid = event->lheader.uid; | |
934 | 92 |
1204 | 93 for (i = 0; i < (int) (sizeof (Lisp_Event) / sizeof (int)); i++) |
94 ((int *) event) [i] = 0xdeadbeef; /* -559038737 base 10 */ | |
95 set_lheader_implementation (&event->lheader, &lrecord_event); | |
3063 | 96 event->lheader.uid = old_uid; |
934 | 97 set_event_type (event, dead_event); |
98 SET_EVENT_CHANNEL (event, Qnil); | |
428 | 99 XSET_EVENT_NEXT (ev, Qnil); |
100 } | |
101 | |
102 /* Set everything to zero or nil so that it's predictable. */ | |
103 void | |
440 | 104 zero_event (Lisp_Event *e) |
428 | 105 { |
3063 | 106 /* Preserve the old UID for this event, for tracking it */ |
107 unsigned int old_uid = e->lheader.uid; | |
108 | |
428 | 109 xzero (*e); |
442 | 110 set_lheader_implementation (&e->lheader, &lrecord_event); |
3063 | 111 e->lheader.uid = old_uid; |
1204 | 112 set_event_type (e, empty_event); |
113 SET_EVENT_CHANNEL (e, Qnil); | |
114 SET_EVENT_NEXT (e, Qnil); | |
428 | 115 } |
116 | |
1204 | 117 static const struct memory_description key_data_description_1 [] = { |
118 { XD_LISP_OBJECT, offsetof (struct Lisp_Key_Data, keysym) }, | |
119 { XD_END } | |
120 }; | |
121 | |
122 static const struct sized_memory_description key_data_description = { | |
123 sizeof (Lisp_Key_Data), key_data_description_1 | |
124 }; | |
125 | |
126 static const struct memory_description button_data_description_1 [] = { | |
127 { XD_END } | |
128 }; | |
129 | |
130 static const struct sized_memory_description button_data_description = { | |
131 sizeof (Lisp_Button_Data), button_data_description_1 | |
132 }; | |
133 | |
134 static const struct memory_description motion_data_description_1 [] = { | |
135 { XD_END } | |
136 }; | |
137 | |
138 static const struct sized_memory_description motion_data_description = { | |
139 sizeof (Lisp_Motion_Data), motion_data_description_1 | |
140 }; | |
141 | |
142 static const struct memory_description process_data_description_1 [] = { | |
143 { XD_LISP_OBJECT, offsetof (struct Lisp_Process_Data, process) }, | |
144 { XD_END } | |
145 }; | |
146 | |
147 static const struct sized_memory_description process_data_description = { | |
148 sizeof (Lisp_Process_Data), process_data_description_1 | |
149 }; | |
150 | |
151 static const struct memory_description timeout_data_description_1 [] = { | |
152 { XD_LISP_OBJECT, offsetof (struct Lisp_Timeout_Data, function) }, | |
153 { XD_LISP_OBJECT, offsetof (struct Lisp_Timeout_Data, object) }, | |
154 { XD_END } | |
155 }; | |
156 | |
157 static const struct sized_memory_description timeout_data_description = { | |
158 sizeof (Lisp_Timeout_Data), timeout_data_description_1 | |
159 }; | |
160 | |
161 static const struct memory_description eval_data_description_1 [] = { | |
162 { XD_LISP_OBJECT, offsetof (struct Lisp_Eval_Data, function) }, | |
163 { XD_LISP_OBJECT, offsetof (struct Lisp_Eval_Data, object) }, | |
164 { XD_END } | |
165 }; | |
166 | |
167 static const struct sized_memory_description eval_data_description = { | |
168 sizeof (Lisp_Eval_Data), eval_data_description_1 | |
169 }; | |
170 | |
171 static const struct memory_description misc_user_data_description_1 [] = { | |
172 { XD_LISP_OBJECT, offsetof (struct Lisp_Misc_User_Data, function) }, | |
173 { XD_LISP_OBJECT, offsetof (struct Lisp_Misc_User_Data, object) }, | |
174 { XD_END } | |
175 }; | |
176 | |
177 static const struct sized_memory_description misc_user_data_description = { | |
178 sizeof (Lisp_Misc_User_Data), misc_user_data_description_1 | |
179 }; | |
180 | |
181 static const struct memory_description magic_eval_data_description_1 [] = { | |
182 { XD_LISP_OBJECT, offsetof (struct Lisp_Magic_Eval_Data, object) }, | |
183 { XD_END } | |
184 }; | |
185 | |
186 static const struct sized_memory_description magic_eval_data_description = { | |
187 sizeof (Lisp_Magic_Eval_Data), magic_eval_data_description_1 | |
188 }; | |
189 | |
190 static const struct memory_description magic_data_description_1 [] = { | |
191 { XD_END } | |
192 }; | |
193 | |
194 static const struct sized_memory_description magic_data_description = { | |
195 sizeof (Lisp_Magic_Data), magic_data_description_1 | |
196 }; | |
197 | |
198 static const struct memory_description event_data_description_1 [] = { | |
2551 | 199 { XD_BLOCK_ARRAY, key_press_event, 1, { &key_data_description } }, |
200 { XD_BLOCK_ARRAY, button_press_event, 1, { &button_data_description } }, | |
201 { XD_BLOCK_ARRAY, button_release_event, 1, { &button_data_description } }, | |
202 { XD_BLOCK_ARRAY, pointer_motion_event, 1, { &motion_data_description } }, | |
203 { XD_BLOCK_ARRAY, process_event, 1, { &process_data_description } }, | |
204 { XD_BLOCK_ARRAY, timeout_event, 1, { &timeout_data_description } }, | |
205 { XD_BLOCK_ARRAY, magic_event, 1, { &magic_data_description } }, | |
206 { XD_BLOCK_ARRAY, magic_eval_event, 1, { &magic_eval_data_description } }, | |
207 { XD_BLOCK_ARRAY, eval_event, 1, { &eval_data_description } }, | |
208 { XD_BLOCK_ARRAY, misc_user_event, 1, { &misc_user_data_description } }, | |
1204 | 209 { XD_END } |
210 }; | |
211 | |
212 static const struct sized_memory_description event_data_description = { | |
213 0, event_data_description_1 | |
214 }; | |
215 | |
216 static const struct memory_description event_description [] = { | |
217 { XD_INT, offsetof (struct Lisp_Event, event_type) }, | |
218 { XD_LISP_OBJECT, offsetof (struct Lisp_Event, next) }, | |
219 { XD_LISP_OBJECT, offsetof (struct Lisp_Event, channel) }, | |
220 { XD_UNION, offsetof (struct Lisp_Event, event), | |
2551 | 221 XD_INDIRECT (0, 0), { &event_data_description } }, |
1204 | 222 { XD_END } |
223 }; | |
224 | |
225 #ifdef EVENT_DATA_AS_OBJECTS | |
226 | |
227 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("key-data", key_data, | |
228 0, /*dumpable-flag*/ | |
229 0, 0, 0, 0, 0, | |
230 key_data_description, | |
231 Lisp_Key_Data); | |
232 | |
233 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("button-data", button_data, | |
234 0, /*dumpable-flag*/ | |
235 0, 0, 0, 0, 0, | |
236 button_data_description, | |
237 Lisp_Button_Data); | |
238 | |
239 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("motion-data", motion_data, | |
240 0, /*dumpable-flag*/ | |
241 0, 0, 0, 0, 0, | |
242 motion_data_description, | |
243 Lisp_Motion_Data); | |
244 | |
245 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("process-data", process_data, | |
246 0, /*dumpable-flag*/ | |
247 0, 0, 0, 0, 0, | |
248 process_data_description, | |
249 Lisp_Process_Data); | |
250 | |
251 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("timeout-data", timeout_data, | |
252 0, /*dumpable-flag*/ | |
253 0, 0, 0, 0, 0, | |
254 timeout_data_description, | |
255 Lisp_Timeout_Data); | |
256 | |
257 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("eval-data", eval_data, | |
258 0, /*dumpable-flag*/ | |
259 0, 0, 0, 0, 0, | |
260 eval_data_description, | |
261 Lisp_Eval_Data); | |
262 | |
263 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("misc-user-data", misc_user_data, | |
264 0, /*dumpable-flag*/ | |
265 0, 0, 0, 0, 0, | |
266 misc_user_data_description, | |
267 Lisp_Misc_User_Data); | |
268 | |
269 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-eval-data", magic_eval_data, | |
270 0, /*dumpable-flag*/ | |
271 0, 0, 0, 0, 0, | |
272 magic_eval_data_description, | |
273 Lisp_Magic_Eval_Data); | |
274 | |
275 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("magic-data", magic_data, | |
276 0, /*dumpable-flag*/ | |
277 0, 0, 0, 0, 0, | |
278 magic_data_description, | |
279 Lisp_Magic_Data); | |
280 | |
281 #endif /* EVENT_DATA_AS_OBJECTS */ | |
282 | |
428 | 283 static Lisp_Object |
284 mark_event (Lisp_Object obj) | |
285 { | |
440 | 286 Lisp_Event *event = XEVENT (obj); |
428 | 287 |
288 switch (event->event_type) | |
289 { | |
290 case key_press_event: | |
1204 | 291 mark_object (EVENT_KEY_KEYSYM (event)); |
428 | 292 break; |
293 case process_event: | |
1204 | 294 mark_object (EVENT_PROCESS_PROCESS (event)); |
428 | 295 break; |
296 case timeout_event: | |
1204 | 297 mark_object (EVENT_TIMEOUT_FUNCTION (event)); |
298 mark_object (EVENT_TIMEOUT_OBJECT (event)); | |
428 | 299 break; |
300 case eval_event: | |
301 case misc_user_event: | |
1204 | 302 mark_object (EVENT_EVAL_FUNCTION (event)); |
303 mark_object (EVENT_EVAL_OBJECT (event)); | |
428 | 304 break; |
305 case magic_eval_event: | |
1204 | 306 mark_object (EVENT_MAGIC_EVAL_OBJECT (event)); |
428 | 307 break; |
308 case button_press_event: | |
309 case button_release_event: | |
310 case pointer_motion_event: | |
311 case magic_event: | |
312 case empty_event: | |
313 case dead_event: | |
314 break; | |
315 default: | |
2500 | 316 ABORT (); |
428 | 317 } |
318 mark_object (event->channel); | |
319 return event->next; | |
320 } | |
321 | |
322 static void | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
323 print_event_1 (const Ascbyte *str, Lisp_Object obj, Lisp_Object printcharfun) |
428 | 324 { |
793 | 325 DECLARE_EISTRING_MALLOC (ei); |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
326 write_ascstring (printcharfun, str); |
1204 | 327 format_event_object (ei, obj, 0); |
826 | 328 write_eistring (printcharfun, ei); |
793 | 329 eifree (ei); |
428 | 330 } |
331 | |
332 static void | |
2286 | 333 print_event (Lisp_Object obj, Lisp_Object printcharfun, |
334 int UNUSED (escapeflag)) | |
428 | 335 { |
336 if (print_readably) | |
563 | 337 printing_unreadable_object ("#<event>"); |
428 | 338 |
339 switch (XEVENT (obj)->event_type) | |
340 { | |
341 case key_press_event: | |
342 print_event_1 ("#<keypress-event ", obj, printcharfun); | |
343 break; | |
344 case button_press_event: | |
345 print_event_1 ("#<buttondown-event ", obj, printcharfun); | |
346 break; | |
347 case button_release_event: | |
348 print_event_1 ("#<buttonup-event ", obj, printcharfun); | |
349 break; | |
350 case magic_event: | |
351 case magic_eval_event: | |
352 print_event_1 ("#<magic-event ", obj, printcharfun); | |
353 break; | |
354 case pointer_motion_event: | |
355 { | |
356 Lisp_Object Vx, Vy; | |
357 Vx = Fevent_x_pixel (obj); | |
358 assert (INTP (Vx)); | |
359 Vy = Fevent_y_pixel (obj); | |
360 assert (INTP (Vy)); | |
793 | 361 write_fmt_string (printcharfun, "#<motion-event %ld, %ld", |
362 (long) XINT (Vx), (long) XINT (Vy)); | |
428 | 363 break; |
364 } | |
365 case process_event: | |
1204 | 366 write_fmt_string_lisp (printcharfun, "#<process-event %S", 1, |
367 XEVENT_PROCESS_PROCESS (obj)); | |
428 | 368 break; |
369 case timeout_event: | |
1204 | 370 write_fmt_string_lisp (printcharfun, "#<timeout-event %S", 1, |
371 XEVENT_TIMEOUT_OBJECT (obj)); | |
428 | 372 break; |
373 case empty_event: | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
374 write_ascstring (printcharfun, "#<empty-event"); |
428 | 375 break; |
376 case misc_user_event: | |
1204 | 377 write_fmt_string_lisp (printcharfun, "#<misc-user-event (%S", 1, |
378 XEVENT_MISC_USER_FUNCTION (obj)); | |
379 write_fmt_string_lisp (printcharfun, " %S)", 1, | |
380 XEVENT_MISC_USER_OBJECT (obj)); | |
428 | 381 break; |
382 case eval_event: | |
1204 | 383 write_fmt_string_lisp (printcharfun, "#<eval-event (%S", 1, |
384 XEVENT_EVAL_FUNCTION (obj)); | |
385 write_fmt_string_lisp (printcharfun, " %S)", 1, | |
386 XEVENT_EVAL_OBJECT (obj)); | |
428 | 387 break; |
388 case dead_event: | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
389 write_ascstring (printcharfun, "#<DEALLOCATED-EVENT"); |
428 | 390 break; |
391 default: | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
392 write_ascstring (printcharfun, "#<UNKNOWN-EVENT-TYPE"); |
428 | 393 break; |
394 } | |
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
395 write_ascstring (printcharfun, ">"); |
428 | 396 } |
397 | |
398 static int | |
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
399 event_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), |
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4780
diff
changeset
|
400 int UNUSED (foldcase)) |
428 | 401 { |
440 | 402 Lisp_Event *e1 = XEVENT (obj1); |
403 Lisp_Event *e2 = XEVENT (obj2); | |
428 | 404 |
405 if (e1->event_type != e2->event_type) return 0; | |
406 if (!EQ (e1->channel, e2->channel)) return 0; | |
407 /* if (e1->timestamp != e2->timestamp) return 0; */ | |
408 switch (e1->event_type) | |
409 { | |
2500 | 410 default: ABORT (); |
428 | 411 |
412 case process_event: | |
1204 | 413 return EQ (EVENT_PROCESS_PROCESS (e1), EVENT_PROCESS_PROCESS (e2)); |
428 | 414 |
415 case timeout_event: | |
1204 | 416 return (internal_equal (EVENT_TIMEOUT_FUNCTION (e1), |
417 EVENT_TIMEOUT_FUNCTION (e2), 0) && | |
418 internal_equal (EVENT_TIMEOUT_OBJECT (e1), | |
419 EVENT_TIMEOUT_OBJECT (e2), 0)); | |
428 | 420 |
421 case key_press_event: | |
1204 | 422 return (EQ (EVENT_KEY_KEYSYM (e1), EVENT_KEY_KEYSYM (e2)) && |
423 (EVENT_KEY_MODIFIERS (e1) == EVENT_KEY_MODIFIERS (e2))); | |
428 | 424 |
425 case button_press_event: | |
426 case button_release_event: | |
1204 | 427 return (EVENT_BUTTON_BUTTON (e1) == EVENT_BUTTON_BUTTON (e2) && |
428 EVENT_BUTTON_MODIFIERS (e1) == EVENT_BUTTON_MODIFIERS (e2)); | |
428 | 429 |
430 case pointer_motion_event: | |
1204 | 431 return (EVENT_MOTION_X (e1) == EVENT_MOTION_X (e2) && |
432 EVENT_MOTION_Y (e1) == EVENT_MOTION_Y (e2)); | |
428 | 433 |
434 case misc_user_event: | |
1204 | 435 return (internal_equal (EVENT_EVAL_FUNCTION (e1), |
436 EVENT_EVAL_FUNCTION (e2), 0) && | |
437 internal_equal (EVENT_EVAL_OBJECT (e1), | |
438 EVENT_EVAL_OBJECT (e2), 0) && | |
439 /* #### is this really needed for equality | |
428 | 440 or is x and y also important? */ |
1204 | 441 EVENT_MISC_USER_BUTTON (e1) == EVENT_MISC_USER_BUTTON (e2) && |
442 EVENT_MISC_USER_MODIFIERS (e1) == EVENT_MISC_USER_MODIFIERS (e2)); | |
428 | 443 |
444 case eval_event: | |
1204 | 445 return (internal_equal (EVENT_EVAL_FUNCTION (e1), |
446 EVENT_EVAL_FUNCTION (e2), 0) && | |
447 internal_equal (EVENT_EVAL_OBJECT (e1), | |
448 EVENT_EVAL_OBJECT (e2), 0)); | |
428 | 449 |
450 case magic_eval_event: | |
1204 | 451 return (EVENT_MAGIC_EVAL_INTERNAL_FUNCTION (e1) == |
452 EVENT_MAGIC_EVAL_INTERNAL_FUNCTION (e2) && | |
453 internal_equal (EVENT_MAGIC_EVAL_OBJECT (e1), | |
454 EVENT_MAGIC_EVAL_OBJECT (e2), 0)); | |
428 | 455 |
456 case magic_event: | |
788 | 457 return event_stream_compare_magic_event (e1, e2); |
428 | 458 |
459 case empty_event: /* Empty and deallocated events are equal. */ | |
460 case dead_event: | |
461 return 1; | |
462 } | |
463 } | |
464 | |
665 | 465 static Hashcode |
428 | 466 event_hash (Lisp_Object obj, int depth) |
467 { | |
440 | 468 Lisp_Event *e = XEVENT (obj); |
665 | 469 Hashcode hash; |
428 | 470 |
471 hash = HASH2 (e->event_type, LISP_HASH (e->channel)); | |
472 switch (e->event_type) | |
473 { | |
474 case process_event: | |
1204 | 475 return HASH2 (hash, LISP_HASH (EVENT_PROCESS_PROCESS (e))); |
428 | 476 |
477 case timeout_event: | |
1204 | 478 return HASH3 (hash, |
479 internal_hash (EVENT_TIMEOUT_FUNCTION (e), depth + 1), | |
480 internal_hash (EVENT_TIMEOUT_OBJECT (e), depth + 1)); | |
428 | 481 |
482 case key_press_event: | |
1204 | 483 return HASH3 (hash, LISP_HASH (EVENT_KEY_KEYSYM (e)), |
484 EVENT_KEY_MODIFIERS (e)); | |
428 | 485 |
486 case button_press_event: | |
487 case button_release_event: | |
1204 | 488 return HASH3 (hash, EVENT_BUTTON_BUTTON (e), EVENT_BUTTON_MODIFIERS (e)); |
428 | 489 |
490 case pointer_motion_event: | |
1204 | 491 return HASH3 (hash, EVENT_MOTION_X (e), EVENT_MOTION_Y (e)); |
428 | 492 |
493 case misc_user_event: | |
1204 | 494 return HASH5 (hash, |
495 internal_hash (EVENT_MISC_USER_FUNCTION (e), depth + 1), | |
496 internal_hash (EVENT_MISC_USER_OBJECT (e), depth + 1), | |
497 EVENT_MISC_USER_BUTTON (e), EVENT_MISC_USER_MODIFIERS (e)); | |
428 | 498 |
499 case eval_event: | |
1204 | 500 return HASH3 (hash, internal_hash (EVENT_EVAL_FUNCTION (e), depth + 1), |
501 internal_hash (EVENT_EVAL_OBJECT (e), depth + 1)); | |
428 | 502 |
503 case magic_eval_event: | |
504 return HASH3 (hash, | |
1204 | 505 (Hashcode) EVENT_MAGIC_EVAL_INTERNAL_FUNCTION (e), |
506 internal_hash (EVENT_MAGIC_EVAL_OBJECT (e), depth + 1)); | |
428 | 507 |
508 case magic_event: | |
788 | 509 return HASH2 (hash, event_stream_hash_magic_event (e)); |
428 | 510 |
511 case empty_event: | |
512 case dead_event: | |
513 return hash; | |
514 | |
515 default: | |
2500 | 516 ABORT (); |
428 | 517 } |
518 | |
519 return 0; /* unreached */ | |
520 } | |
934 | 521 |
522 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("event", event, | |
523 0, /*dumpable-flag*/ | |
524 mark_event, print_event, 0, event_equal, | |
1204 | 525 event_hash, event_description, |
526 Lisp_Event); | |
428 | 527 |
528 DEFUN ("make-event", Fmake_event, 0, 2, 0, /* | |
529 Return a new event of type TYPE, with properties described by PLIST. | |
530 | |
531 TYPE is a symbol, either `empty', `key-press', `button-press', | |
532 `button-release', `misc-user' or `motion'. If TYPE is nil, it | |
533 defaults to `empty'. | |
534 | |
535 PLIST is a property list, the properties being compatible to those | |
536 returned by `event-properties'. The following properties are | |
537 allowed: | |
538 | |
539 channel -- The event channel, a frame or a console. For | |
540 button-press, button-release, misc-user and motion events, | |
541 this must be a frame. For key-press events, it must be | |
542 a console. If channel is unspecified, it will be set to | |
543 the selected frame or selected console, as appropriate. | |
544 key -- The event key, a symbol or character. Allowed only for | |
545 keypress events. | |
546 button -- The event button, integer 1, 2 or 3. Allowed for | |
547 button-press, button-release and misc-user events. | |
548 modifiers -- The event modifiers, a list of modifier symbols. Allowed | |
549 for key-press, button-press, button-release, motion and | |
550 misc-user events. | |
551 function -- Function. Allowed for misc-user events only. | |
552 object -- An object, function's parameter. Allowed for misc-user | |
553 events only. | |
554 x -- The event X coordinate, an integer. This is relative | |
555 to the left of CHANNEL's root window. Allowed for | |
556 motion, button-press, button-release and misc-user events. | |
557 y -- The event Y coordinate, an integer. This is relative | |
558 to the top of CHANNEL's root window. Allowed for | |
559 motion, button-press, button-release and misc-user events. | |
560 timestamp -- The event timestamp, a non-negative integer. Allowed for | |
561 all types of events. If unspecified, it will be set to 0 | |
562 by default. | |
563 | |
564 For event type `empty', PLIST must be nil. | |
565 `button-release', or `motion'. If TYPE is left out, it defaults to | |
566 `empty'. | |
567 PLIST is a list of properties, as returned by `event-properties'. Not | |
568 all properties are allowed for all kinds of events, and some are | |
569 required. | |
570 | |
571 WARNING: the event object returned may be a reused one; see the function | |
572 `deallocate-event'. | |
573 */ | |
574 (type, plist)) | |
575 { | |
576 Lisp_Object event = Qnil; | |
440 | 577 Lisp_Event *e; |
428 | 578 EMACS_INT coord_x = 0, coord_y = 0; |
579 struct gcpro gcpro1; | |
580 | |
581 GCPRO1 (event); | |
582 | |
583 if (NILP (type)) | |
584 type = Qempty; | |
585 | |
586 if (!NILP (Vevent_resource)) | |
587 { | |
588 event = Vevent_resource; | |
589 Vevent_resource = XEVENT_NEXT (event); | |
590 } | |
591 else | |
592 { | |
593 event = allocate_event (); | |
594 } | |
595 e = XEVENT (event); | |
596 zero_event (e); | |
597 | |
598 if (EQ (type, Qempty)) | |
599 { | |
600 /* For empty event, we return immediately, without processing | |
601 PLIST. In fact, processing PLIST would be wrong, because the | |
602 sanitizing process would fill in the properties | |
603 (e.g. CHANNEL), which we don't want in empty events. */ | |
934 | 604 set_event_type (e, empty_event); |
428 | 605 if (!NILP (plist)) |
563 | 606 invalid_operation ("Cannot set properties of empty event", plist); |
428 | 607 UNGCPRO; |
608 return event; | |
609 } | |
610 else if (EQ (type, Qkey_press)) | |
611 { | |
934 | 612 set_event_type (e, key_press_event); |
1204 | 613 SET_EVENT_KEY_KEYSYM (e, Qunbound); |
428 | 614 } |
615 else if (EQ (type, Qbutton_press)) | |
934 | 616 set_event_type (e, button_press_event); |
428 | 617 else if (EQ (type, Qbutton_release)) |
934 | 618 set_event_type (e, button_release_event); |
428 | 619 else if (EQ (type, Qmotion)) |
934 | 620 set_event_type (e, pointer_motion_event); |
428 | 621 else if (EQ (type, Qmisc_user)) |
622 { | |
934 | 623 set_event_type (e, misc_user_event); |
1204 | 624 SET_EVENT_MISC_USER_FUNCTION (e, Qnil); |
625 SET_EVENT_MISC_USER_OBJECT (e, Qnil); | |
428 | 626 } |
627 else | |
628 { | |
629 /* Not allowed: Qprocess, Qtimeout, Qmagic, Qeval, Qmagic_eval. */ | |
563 | 630 invalid_constant ("Invalid event type", type); |
428 | 631 } |
632 | |
633 EVENT_CHANNEL (e) = Qnil; | |
634 | |
635 plist = Fcopy_sequence (plist); | |
636 Fcanonicalize_plist (plist, Qnil); | |
637 | |
442 | 638 #define WRONG_EVENT_TYPE_FOR_PROPERTY(event_type, prop) \ |
563 | 639 invalid_argument_2 ("Invalid property for event type", prop, event_type) |
428 | 640 |
442 | 641 { |
642 EXTERNAL_PROPERTY_LIST_LOOP_3 (keyword, value, plist) | |
643 { | |
644 if (EQ (keyword, Qchannel)) | |
645 { | |
1204 | 646 if (EVENT_TYPE (e) == key_press_event) |
442 | 647 { |
648 if (!CONSOLEP (value)) | |
649 value = wrong_type_argument (Qconsolep, value); | |
650 } | |
651 else | |
652 { | |
653 if (!FRAMEP (value)) | |
654 value = wrong_type_argument (Qframep, value); | |
655 } | |
656 EVENT_CHANNEL (e) = value; | |
657 } | |
658 else if (EQ (keyword, Qkey)) | |
659 { | |
1204 | 660 switch (EVENT_TYPE (e)) |
442 | 661 { |
662 case key_press_event: | |
663 if (!SYMBOLP (value) && !CHARP (value)) | |
563 | 664 invalid_argument ("Invalid event key", value); |
1204 | 665 SET_EVENT_KEY_KEYSYM (e, value); |
442 | 666 break; |
667 default: | |
668 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); | |
669 break; | |
670 } | |
671 } | |
672 else if (EQ (keyword, Qbutton)) | |
673 { | |
674 CHECK_NATNUM (value); | |
675 check_int_range (XINT (value), 0, 7); | |
428 | 676 |
1204 | 677 switch (EVENT_TYPE (e)) |
442 | 678 { |
679 case button_press_event: | |
680 case button_release_event: | |
1204 | 681 SET_EVENT_BUTTON_BUTTON (e, XINT (value)); |
442 | 682 break; |
683 case misc_user_event: | |
1204 | 684 SET_EVENT_MISC_USER_BUTTON (e, XINT (value)); |
442 | 685 break; |
686 default: | |
687 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); | |
688 break; | |
689 } | |
690 } | |
691 else if (EQ (keyword, Qmodifiers)) | |
692 { | |
693 int modifiers = 0; | |
428 | 694 |
442 | 695 EXTERNAL_LIST_LOOP_2 (sym, value) |
696 { | |
697 if (EQ (sym, Qcontrol)) modifiers |= XEMACS_MOD_CONTROL; | |
698 else if (EQ (sym, Qmeta)) modifiers |= XEMACS_MOD_META; | |
699 else if (EQ (sym, Qsuper)) modifiers |= XEMACS_MOD_SUPER; | |
700 else if (EQ (sym, Qhyper)) modifiers |= XEMACS_MOD_HYPER; | |
701 else if (EQ (sym, Qalt)) modifiers |= XEMACS_MOD_ALT; | |
702 else if (EQ (sym, Qsymbol)) modifiers |= XEMACS_MOD_ALT; | |
703 else if (EQ (sym, Qshift)) modifiers |= XEMACS_MOD_SHIFT; | |
704 else if (EQ (sym, Qbutton1)) modifiers |= XEMACS_MOD_BUTTON1; | |
705 else if (EQ (sym, Qbutton2)) modifiers |= XEMACS_MOD_BUTTON2; | |
706 else if (EQ (sym, Qbutton3)) modifiers |= XEMACS_MOD_BUTTON3; | |
707 else if (EQ (sym, Qbutton4)) modifiers |= XEMACS_MOD_BUTTON4; | |
708 else if (EQ (sym, Qbutton5)) modifiers |= XEMACS_MOD_BUTTON5; | |
709 else | |
563 | 710 invalid_constant ("Invalid key modifier", sym); |
442 | 711 } |
428 | 712 |
1204 | 713 switch (EVENT_TYPE (e)) |
442 | 714 { |
715 case key_press_event: | |
1204 | 716 SET_EVENT_KEY_MODIFIERS (e, modifiers); |
442 | 717 break; |
718 case button_press_event: | |
719 case button_release_event: | |
1204 | 720 SET_EVENT_BUTTON_MODIFIERS (e, modifiers); |
442 | 721 break; |
722 case pointer_motion_event: | |
1204 | 723 SET_EVENT_MOTION_MODIFIERS (e, modifiers); |
442 | 724 break; |
725 case misc_user_event: | |
1204 | 726 SET_EVENT_MISC_USER_MODIFIERS (e, modifiers); |
442 | 727 break; |
728 default: | |
729 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); | |
730 break; | |
731 } | |
732 } | |
733 else if (EQ (keyword, Qx)) | |
734 { | |
1204 | 735 switch (EVENT_TYPE (e)) |
442 | 736 { |
737 case pointer_motion_event: | |
738 case button_press_event: | |
739 case button_release_event: | |
740 case misc_user_event: | |
741 /* Allow negative values, so we can specify toolbar | |
742 positions. */ | |
743 CHECK_INT (value); | |
744 coord_x = XINT (value); | |
745 break; | |
746 default: | |
747 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); | |
748 break; | |
749 } | |
750 } | |
751 else if (EQ (keyword, Qy)) | |
752 { | |
1204 | 753 switch (EVENT_TYPE (e)) |
442 | 754 { |
755 case pointer_motion_event: | |
756 case button_press_event: | |
757 case button_release_event: | |
758 case misc_user_event: | |
759 /* Allow negative values; see above. */ | |
760 CHECK_INT (value); | |
761 coord_y = XINT (value); | |
762 break; | |
763 default: | |
764 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); | |
765 break; | |
766 } | |
767 } | |
768 else if (EQ (keyword, Qtimestamp)) | |
769 { | |
770 CHECK_NATNUM (value); | |
934 | 771 SET_EVENT_TIMESTAMP (e, XINT (value)); |
442 | 772 } |
773 else if (EQ (keyword, Qfunction)) | |
774 { | |
1204 | 775 switch (EVENT_TYPE (e)) |
442 | 776 { |
777 case misc_user_event: | |
1204 | 778 SET_EVENT_MISC_USER_FUNCTION (e, value); |
442 | 779 break; |
780 default: | |
781 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); | |
782 break; | |
783 } | |
784 } | |
785 else if (EQ (keyword, Qobject)) | |
786 { | |
1204 | 787 switch (EVENT_TYPE (e)) |
442 | 788 { |
789 case misc_user_event: | |
1204 | 790 SET_EVENT_MISC_USER_OBJECT (e, value); |
442 | 791 break; |
792 default: | |
793 WRONG_EVENT_TYPE_FOR_PROPERTY (type, keyword); | |
794 break; | |
795 } | |
796 } | |
797 else | |
563 | 798 invalid_constant_2 ("Invalid property", keyword, value); |
442 | 799 } |
800 } | |
428 | 801 |
802 /* Insert the channel, if missing. */ | |
803 if (NILP (EVENT_CHANNEL (e))) | |
804 { | |
934 | 805 if (EVENT_TYPE (e) == key_press_event) |
428 | 806 EVENT_CHANNEL (e) = Vselected_console; |
807 else | |
808 EVENT_CHANNEL (e) = Fselected_frame (Qnil); | |
809 } | |
810 | |
811 /* Fevent_properties, Fevent_x_pixel, etc. work with pixels relative | |
812 to the frame, so we must adjust accordingly. */ | |
813 if (FRAMEP (EVENT_CHANNEL (e))) | |
814 { | |
815 coord_x += FRAME_REAL_LEFT_TOOLBAR_WIDTH (XFRAME (EVENT_CHANNEL (e))); | |
816 coord_y += FRAME_REAL_TOP_TOOLBAR_HEIGHT (XFRAME (EVENT_CHANNEL (e))); | |
817 | |
818 switch (e->event_type) | |
819 { | |
820 case pointer_motion_event: | |
1204 | 821 SET_EVENT_MOTION_X (e, coord_x); |
822 SET_EVENT_MOTION_Y (e, coord_y); | |
428 | 823 break; |
824 case button_press_event: | |
825 case button_release_event: | |
1204 | 826 SET_EVENT_BUTTON_X (e, coord_x); |
827 SET_EVENT_BUTTON_Y (e, coord_y); | |
428 | 828 break; |
829 case misc_user_event: | |
1204 | 830 SET_EVENT_MISC_USER_X (e, coord_x); |
831 SET_EVENT_MISC_USER_Y (e, coord_y); | |
428 | 832 break; |
833 default: | |
2500 | 834 ABORT (); |
428 | 835 } |
836 } | |
837 | |
838 /* Finally, do some more validation. */ | |
1204 | 839 switch (EVENT_TYPE (e)) |
428 | 840 { |
841 case key_press_event: | |
1204 | 842 if (UNBOUNDP (EVENT_KEY_KEYSYM (e))) |
563 | 843 sferror ("A key must be specified to make a keypress event", |
442 | 844 plist); |
428 | 845 break; |
846 case button_press_event: | |
1204 | 847 if (!EVENT_BUTTON_BUTTON (e)) |
563 | 848 sferror |
442 | 849 ("A button must be specified to make a button-press event", |
850 plist); | |
428 | 851 break; |
852 case button_release_event: | |
1204 | 853 if (!EVENT_BUTTON_BUTTON (e)) |
563 | 854 sferror |
442 | 855 ("A button must be specified to make a button-release event", |
856 plist); | |
428 | 857 break; |
858 case misc_user_event: | |
1204 | 859 if (NILP (EVENT_MISC_USER_FUNCTION (e))) |
563 | 860 sferror ("A function must be specified to make a misc-user event", |
442 | 861 plist); |
428 | 862 break; |
863 default: | |
864 break; | |
865 } | |
866 | |
867 UNGCPRO; | |
868 return event; | |
869 } | |
870 | |
871 DEFUN ("deallocate-event", Fdeallocate_event, 1, 1, 0, /* | |
872 Allow the given event structure to be reused. | |
873 You MUST NOT use this event object after calling this function with it. | |
874 You will lose. It is not necessary to call this function, as event | |
875 objects are garbage-collected like all other objects; however, it may | |
876 be more efficient to explicitly deallocate events when you are sure | |
877 that it is safe to do so. | |
878 */ | |
879 (event)) | |
880 { | |
881 CHECK_EVENT (event); | |
882 | |
883 if (XEVENT_TYPE (event) == dead_event) | |
563 | 884 invalid_argument ("this event is already deallocated!", Qunbound); |
428 | 885 |
886 assert (XEVENT_TYPE (event) <= last_event_type); | |
887 | |
888 #if 0 | |
889 { | |
890 int i, len; | |
891 | |
892 if (EQ (event, Vlast_command_event) || | |
893 EQ (event, Vlast_input_event) || | |
894 EQ (event, Vunread_command_event)) | |
2500 | 895 ABORT (); |
428 | 896 |
897 len = XVECTOR_LENGTH (Vthis_command_keys); | |
898 for (i = 0; i < len; i++) | |
899 if (EQ (event, XVECTOR_DATA (Vthis_command_keys) [i])) | |
2500 | 900 ABORT (); |
428 | 901 if (!NILP (Vrecent_keys_ring)) |
902 { | |
903 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring); | |
904 for (i = 0; i < recent_ring_len; i++) | |
905 if (EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i])) | |
2500 | 906 ABORT (); |
428 | 907 } |
908 } | |
909 #endif /* 0 */ | |
910 | |
911 assert (!EQ (event, Vevent_resource)); | |
912 deinitialize_event (event); | |
913 #ifndef ALLOC_NO_POOLS | |
914 XSET_EVENT_NEXT (event, Vevent_resource); | |
915 Vevent_resource = event; | |
916 #endif | |
917 return Qnil; | |
918 } | |
919 | |
920 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /* | |
444 | 921 Make a copy of the event object EVENT1. |
922 If a second event argument EVENT2 is given, EVENT1 is copied into | |
923 EVENT2 and EVENT2 is returned. If EVENT2 is not supplied (or is nil) | |
924 then a new event will be made as with `make-event'. See also the | |
925 function `deallocate-event'. | |
428 | 926 */ |
927 (event1, event2)) | |
928 { | |
929 CHECK_LIVE_EVENT (event1); | |
930 if (NILP (event2)) | |
931 event2 = Fmake_event (Qnil, Qnil); | |
430 | 932 else |
933 { | |
934 CHECK_LIVE_EVENT (event2); | |
935 if (EQ (event1, event2)) | |
563 | 936 return signal_continuable_error_2 |
937 (Qinvalid_argument, | |
938 "copy-event called with `eq' events", event1, event2); | |
430 | 939 } |
428 | 940 |
941 assert (XEVENT_TYPE (event1) <= last_event_type); | |
942 assert (XEVENT_TYPE (event2) <= last_event_type); | |
943 | |
934 | 944 XSET_EVENT_TYPE (event2, XEVENT_TYPE (event1)); |
945 XSET_EVENT_CHANNEL (event2, XEVENT_CHANNEL (event1)); | |
946 XSET_EVENT_TIMESTAMP (event2, XEVENT_TIMESTAMP (event1)); | |
1204 | 947 |
948 #ifdef EVENT_DATA_AS_OBJECTS | |
949 copy_lisp_object (XEVENT_DATA (event2), XEVENT_DATA (event1)); | |
950 #else | |
951 XEVENT (event2)->event = XEVENT (event1)->event; | |
952 #endif | |
934 | 953 return event2; |
428 | 954 } |
955 | |
956 | |
771 | 957 /************************************************************************/ |
958 /* event chain functions */ | |
959 /************************************************************************/ | |
428 | 960 |
961 /* Given a chain of events (or possibly nil), deallocate them all. */ | |
962 | |
963 void | |
964 deallocate_event_chain (Lisp_Object event_chain) | |
965 { | |
966 while (!NILP (event_chain)) | |
967 { | |
968 Lisp_Object next = XEVENT_NEXT (event_chain); | |
969 Fdeallocate_event (event_chain); | |
970 event_chain = next; | |
971 } | |
972 } | |
973 | |
974 /* Return the last event in a chain. | |
975 NOTE: You cannot pass nil as a value here! The routine will | |
976 abort if you do. */ | |
977 | |
978 Lisp_Object | |
979 event_chain_tail (Lisp_Object event_chain) | |
980 { | |
981 while (1) | |
982 { | |
983 Lisp_Object next = XEVENT_NEXT (event_chain); | |
984 if (NILP (next)) | |
985 return event_chain; | |
986 event_chain = next; | |
987 } | |
988 } | |
989 | |
990 /* Enqueue a single event onto the end of a chain of events. | |
991 HEAD points to the first event in the chain, TAIL to the last event. | |
992 If the chain is empty, both values should be nil. */ | |
993 | |
994 void | |
995 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail) | |
996 { | |
997 assert (NILP (XEVENT_NEXT (event))); | |
998 assert (!EQ (*tail, event)); | |
999 | |
1000 if (!NILP (*tail)) | |
1001 XSET_EVENT_NEXT (*tail, event); | |
1002 else | |
1003 *head = event; | |
1004 *tail = event; | |
1005 | |
1006 assert (!EQ (event, XEVENT_NEXT (event))); | |
1007 } | |
1008 | |
1009 /* Remove an event off the head of a chain of events and return it. | |
1010 HEAD points to the first event in the chain, TAIL to the last event. */ | |
1011 | |
1012 Lisp_Object | |
1013 dequeue_event (Lisp_Object *head, Lisp_Object *tail) | |
1014 { | |
1015 Lisp_Object event; | |
1016 | |
1017 event = *head; | |
1018 *head = XEVENT_NEXT (event); | |
1019 XSET_EVENT_NEXT (event, Qnil); | |
1020 if (NILP (*head)) | |
1021 *tail = Qnil; | |
1022 return event; | |
1023 } | |
1024 | |
1025 /* Enqueue a chain of events (or possibly nil) onto the end of another | |
1026 chain of events. HEAD points to the first event in the chain being | |
1027 queued onto, TAIL to the last event. If the chain is empty, both values | |
1028 should be nil. */ | |
1029 | |
1030 void | |
1031 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head, | |
1032 Lisp_Object *tail) | |
1033 { | |
1034 if (NILP (event_chain)) | |
1035 return; | |
1036 | |
1037 if (NILP (*head)) | |
1038 { | |
1039 *head = event_chain; | |
1040 *tail = event_chain; | |
1041 } | |
1042 else | |
1043 { | |
1044 XSET_EVENT_NEXT (*tail, event_chain); | |
1045 *tail = event_chain_tail (event_chain); | |
1046 } | |
1047 } | |
1048 | |
1204 | 1049 /* Map a function over each event in the chain. If the function returns |
1050 non-zero, remove the event just processed. Return the total number of | |
1051 items removed. | |
1052 | |
1053 NOTE: | |
1054 | |
1055 If you want a simple mapping over an event chain, with no intention to | |
1056 add or remove items, just use EVENT_CHAIN_LOOP(). | |
1057 */ | |
1058 | |
1059 int | |
1060 map_event_chain_remove (int (*fn) (Lisp_Object ev, void *user_data), | |
1061 Lisp_Object *head, Lisp_Object *tail, | |
1062 void *user_data, int flags) | |
1063 { | |
1064 Lisp_Object event; | |
1065 Lisp_Object previous_event = Qnil; | |
1066 int count = 0; | |
1067 | |
1068 EVENT_CHAIN_LOOP (event, *head) | |
1069 { | |
1070 if (fn (event, user_data)) | |
1071 { | |
1072 if (NILP (previous_event)) | |
1073 dequeue_event (head, tail); | |
1074 else | |
1075 { | |
1076 XSET_EVENT_NEXT (previous_event, XEVENT_NEXT (event)); | |
1077 if (EQ (*tail, event)) | |
1078 *tail = previous_event; | |
1079 } | |
1080 | |
1081 if (flags & MECR_DEALLOCATE_EVENT) | |
1082 Fdeallocate_event (event); | |
1083 count++; | |
1084 } | |
1085 else | |
1086 previous_event = event; | |
1087 } | |
1088 return count; | |
1089 } | |
1090 | |
428 | 1091 /* Return the number of events (possibly 0) on an event chain. */ |
1092 | |
1093 int | |
1094 event_chain_count (Lisp_Object event_chain) | |
1095 { | |
1096 Lisp_Object event; | |
1097 int n = 0; | |
1098 | |
1099 EVENT_CHAIN_LOOP (event, event_chain) | |
1100 n++; | |
1101 | |
1102 return n; | |
1103 } | |
1104 | |
1105 /* Find the event before EVENT in an event chain. This aborts | |
1106 if the event is not in the chain. */ | |
1107 | |
1108 Lisp_Object | |
1109 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event) | |
1110 { | |
1111 Lisp_Object previous = Qnil; | |
1112 | |
1113 while (!NILP (event_chain)) | |
1114 { | |
1115 if (EQ (event_chain, event)) | |
1116 return previous; | |
1117 previous = event_chain; | |
1118 event_chain = XEVENT_NEXT (event_chain); | |
1119 } | |
1120 | |
2500 | 1121 ABORT (); |
428 | 1122 return Qnil; |
1123 } | |
1124 | |
1125 Lisp_Object | |
1126 event_chain_nth (Lisp_Object event_chain, int n) | |
1127 { | |
1128 Lisp_Object event; | |
1129 EVENT_CHAIN_LOOP (event, event_chain) | |
1130 { | |
1131 if (!n) | |
1132 return event; | |
1133 n--; | |
1134 } | |
1135 return Qnil; | |
1136 } | |
1137 | |
771 | 1138 /* Return a freshly allocated copy of all events in the given chain. */ |
1139 | |
428 | 1140 Lisp_Object |
1141 copy_event_chain (Lisp_Object event_chain) | |
1142 { | |
1143 Lisp_Object new_chain = Qnil; | |
1144 Lisp_Object new_chain_tail = Qnil; | |
1145 Lisp_Object event; | |
1146 | |
1147 EVENT_CHAIN_LOOP (event, event_chain) | |
1148 { | |
1149 Lisp_Object copy = Fcopy_event (event, Qnil); | |
1150 enqueue_event (copy, &new_chain, &new_chain_tail); | |
1151 } | |
1152 | |
1153 return new_chain; | |
1154 } | |
1155 | |
771 | 1156 /* Given a pointer (maybe nil) into an old chain (also maybe nil, if |
1157 pointer is nil) and a new chain which is a copy of the old, return | |
1158 the corresponding new pointer. */ | |
1159 Lisp_Object | |
1160 transfer_event_chain_pointer (Lisp_Object pointer, Lisp_Object old_chain, | |
1161 Lisp_Object new_chain) | |
1162 { | |
1163 if (NILP (pointer)) | |
1164 return Qnil; | |
1165 assert (!NILP (old_chain)); | |
800 | 1166 #ifdef ERROR_CHECK_STRUCTURES |
771 | 1167 /* make sure we're actually in the chain */ |
1168 event_chain_find_previous (old_chain, pointer); | |
1169 assert (event_chain_count (old_chain) == event_chain_count (new_chain)); | |
800 | 1170 #endif /* ERROR_CHECK_STRUCTURES */ |
771 | 1171 return event_chain_nth (new_chain, |
1172 event_chain_count (old_chain) - | |
1173 event_chain_count (pointer)); | |
1174 } | |
1175 | |
428 | 1176 |
771 | 1177 /************************************************************************/ |
1178 /* higher level functions */ | |
1179 /************************************************************************/ | |
428 | 1180 |
1181 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape, | |
1182 QKspace, QKdelete; | |
1183 | |
1184 int | |
1185 command_event_p (Lisp_Object event) | |
1186 { | |
1187 switch (XEVENT_TYPE (event)) | |
1188 { | |
1189 case key_press_event: | |
1190 case button_press_event: | |
1191 case button_release_event: | |
1192 case misc_user_event: | |
1193 return 1; | |
1194 default: | |
1195 return 0; | |
1196 } | |
1197 } | |
1198 | |
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1199 /* META_BEHAVIOR can be one of the following values, defined in events.h: |
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1200 |
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1201 high_bit_is_meta |
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1202 use_console_meta_flag |
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1203 latin_1_maps_to_itself |
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1204 |
1204 | 1205 DO_BACKSPACE_MAPPING means that if CON is a TTY, and C is a the TTY's |
1206 backspace character, the event will have keysym `backspace' instead of | |
1207 '(control h). It is clearly correct to do this conversion is the | |
1208 character was just read from a TTY, clearly incorrect inside of | |
1209 define-key, which must be able to handle all consoles. #### What about | |
1210 in other circumstances? #### Should the user have access to this flag? | |
1211 | |
1212 #### We need to go through and review all the flags in | |
1213 character_to_event() and event_to_character() and figure out exactly | |
1214 under what circumstances they should or should not be set, then go | |
1215 through and review all callers of character_to_event(), | |
1216 Fcharacter_to_event(), event_to_character(), and Fevent_to_character() | |
1217 and check that they are passing the correct flags in for their varied | |
1218 circumstances. | |
1219 | |
1220 #### Some of this garbage, and some of the flags, could go away if we | |
1221 implemented the suggestion, originally from event-Xt.c: | |
1222 | |
2828 | 1223 [[ The way that keysym correspondence to characters should work: |
1204 | 1224 - a Lisp_Event should contain a keysym AND a character slot. |
1225 - keybindings are tried with the keysym. If no binding can be found, | |
2828 | 1226 and there is a corresponding character, call self-insert-command. ]] |
1227 | |
1228 That's an X-specific way of thinking. All the other platforms--even | |
1229 the TTY, make sure you've done (set-input-mode t nil 1) and set your | |
1230 console coding system appropriately when checking--just use | |
1231 characters as emacs keysyms, and, together with defaulting to | |
1232 self-insert-command if an unbound key with a character correspondence | |
1233 is typed, that works fine for them. (Yes, this ignores GTK.) | |
1234 | |
1235 [[ [... snipping other suggestions which I've implemented.] | |
1236 Nuke the Qascii_character property. ]] | |
1204 | 1237 |
2828 | 1238 Well, we've renamed it anyway--it was badly named. |
1239 Qcharacter_of_keysym, here we go. It's really only with X11 that how | |
1240 to map between adiaeresis and (int-to-char #xE4), or ellipsis and | |
1241 whatever, becomes an issue, and IMO the property approach to this is | |
1242 fine. Aidan Kehoe, 2005-05-15. | |
1204 | 1243 |
2828 | 1244 [[ This would apparently solve a lot of different problems. ]] |
1245 | |
1246 I'd be interested to know what's left. Removing the allow-meta | |
1247 argument from event-to-character would be a Good Thing, IMO, but | |
1248 beyond that, I'm not sure what else there is to do wrt. key | |
1249 mappings. Of course, feedback from users of the Russian C-x facility | |
1250 is still needed. */ | |
428 | 1251 |
1252 void | |
867 | 1253 character_to_event (Ichar c, Lisp_Event *event, struct console *con, |
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1254 character_to_event_meta_behavior meta_behavior, |
2340 | 1255 int USED_IF_TTY (do_backspace_mapping)) |
428 | 1256 { |
1257 Lisp_Object k = Qnil; | |
442 | 1258 int m = 0; |
934 | 1259 if (EVENT_TYPE (event) == dead_event) |
563 | 1260 invalid_argument ("character-to-event called with a deallocated event!", Qunbound); |
428 | 1261 |
1262 #ifndef MULE | |
1263 c &= 255; | |
1264 #endif | |
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1265 if (meta_behavior != latin_1_maps_to_itself && c > 127 && c <= 255) |
428 | 1266 { |
1267 int meta_flag = 1; | |
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1268 if (meta_behavior == use_console_meta_flag && CONSOLE_TTY_P (con)) |
428 | 1269 meta_flag = TTY_FLAGS (con).meta_key; |
1270 switch (meta_flag) | |
1271 { | |
1272 case 0: /* ignore top bit; it's parity */ | |
1273 c -= 128; | |
1274 break; | |
1275 case 1: /* top bit is meta */ | |
1276 c -= 128; | |
442 | 1277 m = XEMACS_MOD_META; |
428 | 1278 break; |
1279 default: /* this is a real character */ | |
1280 break; | |
1281 } | |
1282 } | |
442 | 1283 if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL; |
1284 if (m & XEMACS_MOD_CONTROL) | |
428 | 1285 { |
1286 switch (c) | |
1287 { | |
442 | 1288 case 'I': k = QKtab; m &= ~XEMACS_MOD_CONTROL; break; |
1289 case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break; | |
1290 case 'M': k = QKreturn; m &= ~XEMACS_MOD_CONTROL; break; | |
1291 case '[': k = QKescape; m &= ~XEMACS_MOD_CONTROL; break; | |
428 | 1292 default: |
1204 | 1293 #if defined (HAVE_TTY) |
428 | 1294 if (do_backspace_mapping && |
1295 CHARP (con->tty_erase_char) && | |
1296 c - '@' == XCHAR (con->tty_erase_char)) | |
1297 { | |
1298 k = QKbackspace; | |
442 | 1299 m &= ~XEMACS_MOD_CONTROL; |
428 | 1300 } |
1204 | 1301 #endif /* defined (HAVE_TTY) */ |
428 | 1302 break; |
1303 } | |
1304 if (c >= 'A' && c <= 'Z') c -= 'A'-'a'; | |
1305 } | |
1204 | 1306 #if defined (HAVE_TTY) |
428 | 1307 else if (do_backspace_mapping && |
1308 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char)) | |
1309 k = QKbackspace; | |
1204 | 1310 #endif /* defined (HAVE_TTY) */ |
428 | 1311 else if (c == 127) |
1312 k = QKdelete; | |
1313 else if (c == ' ') | |
1314 k = QKspace; | |
1315 | |
934 | 1316 set_event_type (event, key_press_event); |
1317 SET_EVENT_TIMESTAMP_ZERO (event); /* #### */ | |
1318 SET_EVENT_CHANNEL (event, wrap_console (con)); | |
1204 | 1319 SET_EVENT_KEY_KEYSYM (event, (!NILP (k) ? k : make_char (c))); |
1320 SET_EVENT_KEY_MODIFIERS (event, m); | |
428 | 1321 } |
1322 | |
867 | 1323 Ichar |
1204 | 1324 event_to_character (Lisp_Object event, |
428 | 1325 int allow_extra_modifiers, |
2828 | 1326 int allow_meta) |
428 | 1327 { |
867 | 1328 Ichar c = 0; |
428 | 1329 Lisp_Object code; |
1330 | |
1204 | 1331 if (XEVENT_TYPE (event) != key_press_event) |
428 | 1332 { |
1204 | 1333 assert (XEVENT_TYPE (event) != dead_event); |
428 | 1334 return -1; |
1335 } | |
1336 if (!allow_extra_modifiers && | |
2828 | 1337 XEVENT_KEY_MODIFIERS (event) & |
1338 (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_MOD_ALT)) | |
428 | 1339 return -1; |
1204 | 1340 if (CHAR_OR_CHAR_INTP (XEVENT_KEY_KEYSYM (event))) |
1341 c = XCHAR_OR_CHAR_INT (XEVENT_KEY_KEYSYM (event)); | |
1342 else if (!SYMBOLP (XEVENT_KEY_KEYSYM (event))) | |
2500 | 1343 ABORT (); |
1204 | 1344 else if (CHAR_OR_CHAR_INTP (code = Fget (XEVENT_KEY_KEYSYM (event), |
2828 | 1345 Qcharacter_of_keysym, Qnil))) |
428 | 1346 c = XCHAR_OR_CHAR_INT (code); |
1347 else | |
2828 | 1348 { |
1349 Lisp_Object thekeysym = XEVENT_KEY_KEYSYM (event); | |
1350 | |
1351 if (CHAR_OR_CHAR_INTP (code = Fget (thekeysym, Qascii_character, Qnil))) | |
1352 { | |
1353 c = XCHAR_OR_CHAR_INT (code); | |
1354 warn_when_safe(Qkey_mapping, Qwarning, | |
1355 "Obsolete key binding technique.\n" | |
428 | 1356 |
2828 | 1357 "Some code you're using bound %s to `self-insert-command' and messed around\n" |
1358 "with its `ascii-character' property. Doing this is deprecated, and the code\n" | |
1359 "should be updated to use the `set-character-of-keysym' interface.\n" | |
1360 "If you're the one updating the code, first check if there's still a need\n" | |
1361 "for it; we support many more X11 keysyms out of the box now than we did\n" | |
1362 "in the past. ", XSTRING_DATA(XSYMBOL_NAME(thekeysym))); | |
1363 /* Only show the warning once for each keysym. */ | |
1364 Fput(thekeysym, Qcharacter_of_keysym, code); | |
1365 } | |
1366 else | |
1367 { | |
1368 return -1; | |
1369 } | |
1370 } | |
1204 | 1371 if (XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_CONTROL) |
428 | 1372 { |
1373 if (c >= 'a' && c <= 'z') | |
1374 c -= ('a' - 'A'); | |
1375 else | |
1376 /* reject Control-Shift- keys */ | |
1377 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers) | |
1378 return -1; | |
1379 | |
1380 if (c >= '@' && c <= '_') | |
1381 c -= '@'; | |
1382 else if (c == ' ') /* C-space and C-@ are the same. */ | |
1383 c = 0; | |
1384 else | |
1385 /* reject keys that can't take Control- modifiers */ | |
1386 if (! allow_extra_modifiers) return -1; | |
1387 } | |
1388 | |
1204 | 1389 if (XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_META) |
428 | 1390 { |
1391 if (! allow_meta) return -1; | |
1204 | 1392 if (c >= 128) return -1; /* don't allow M-oslash (overlap) */ |
428 | 1393 c |= 0200; |
1394 } | |
1395 return c; | |
1396 } | |
1397 | |
2862 | 1398 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /* |
2828 | 1399 Return the closest character approximation to the given event object. |
428 | 1400 If the event isn't a keypress, this returns nil. |
1401 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in | |
1402 its translation; it will ignore modifier keys other than control and meta, | |
1403 and will ignore the shift modifier on those characters which have no | |
1404 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to | |
1405 the same ASCII code as Control-A). | |
1406 If the ALLOW-META argument is non-nil, then the Meta modifier will be | |
1407 represented by turning on the high bit of the byte returned; otherwise, nil | |
1408 will be returned for events containing the Meta modifier. | |
1204 | 1409 Note that ALLOW-META may cause ambiguity between meta characters and |
1410 Latin-1 characters. | |
2862 | 1411 ALLOW-NON-ASCII is unused, and retained for compatibility. |
428 | 1412 */ |
2862 | 1413 (event, allow_extra_modifiers, allow_meta, UNUSED(allow_non_ascii))) |
428 | 1414 { |
867 | 1415 Ichar c; |
428 | 1416 CHECK_LIVE_EVENT (event); |
1204 | 1417 c = event_to_character (event, |
428 | 1418 !NILP (allow_extra_modifiers), |
2828 | 1419 !NILP (allow_meta)); |
428 | 1420 return c < 0 ? Qnil : make_char (c); |
1421 } | |
1422 | |
1423 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /* | |
444 | 1424 Convert KEY-DESCRIPTION into an event structure, replete with bucky bits. |
428 | 1425 |
444 | 1426 KEY-DESCRIPTION is the first argument, and the event to fill in is the |
1427 second. This function contains knowledge about what various kinds of | |
1428 arguments ``mean'' -- for example, the number 9 is converted to the | |
1429 character ``Tab'', not the distinct character ``Control-I''. | |
428 | 1430 |
3025 | 1431 KEY-DESCRIPTION can be an integer, a character, a symbol such as `clear', |
444 | 1432 or a list such as '(control backspace). |
1433 | |
1434 If the optional second argument EVENT is an event, it is modified and | |
1435 returned; otherwise, a new event object is created and returned. | |
428 | 1436 |
1437 Optional third arg CONSOLE is the console to store in the event, and | |
1438 defaults to the selected console. | |
1439 | |
444 | 1440 If KEY-DESCRIPTION is an integer or character, the high bit may be |
1204 | 1441 interpreted as the meta key. (This is done for backward compatibility in |
1442 lots of places -- specifically, because lots of Lisp code uses specs like | |
1443 ?\M-d and "\M-d" in key code, expecting this to work; yet these are in | |
1444 reality converted directly to 8-bit characters by the Lisp reader.) If | |
1445 USE-CONSOLE-META-FLAG is nil or CONSOLE is not a TTY, this will always be | |
1446 the case. If USE-CONSOLE-META-FLAG is non-nil and CONSOLE is a TTY, the | |
1447 `meta' flag for CONSOLE affects whether the high bit is interpreted as a | |
1448 meta key. (See `set-input-mode'.) Don't set this flag to non-nil unless | |
1449 you know what you're doing (more specifically, only if the character came | |
1450 directly from a TTY, not from the user). If you don't want this silly meta | |
1451 interpretation done, you should pass in a list containing the character. | |
428 | 1452 |
1453 Beware that character-to-event and event-to-character are not strictly | |
1454 inverse functions, since events contain much more information than the | |
444 | 1455 Lisp character object type can encode. |
428 | 1456 */ |
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1457 (keystroke, event, console, use_console_meta_flag_)) |
428 | 1458 { |
1459 struct console *con = decode_console (console); | |
1460 if (NILP (event)) | |
1461 event = Fmake_event (Qnil, Qnil); | |
1462 else | |
1463 CHECK_LIVE_EVENT (event); | |
444 | 1464 if (CONSP (keystroke) || SYMBOLP (keystroke)) |
1465 key_desc_list_to_event (keystroke, event, 1); | |
428 | 1466 else |
1467 { | |
444 | 1468 CHECK_CHAR_COERCE_INT (keystroke); |
1469 character_to_event (XCHAR (keystroke), XEVENT (event), con, | |
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1470 (NILP (use_console_meta_flag_) ? |
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1471 high_bit_is_meta : use_console_meta_flag), 1); |
428 | 1472 } |
1473 return event; | |
1474 } | |
1475 | |
1476 void | |
1477 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event) | |
1478 { | |
1479 assert (STRINGP (seq) || VECTORP (seq)); | |
1480 assert (n < XINT (Flength (seq))); | |
1481 | |
1482 if (STRINGP (seq)) | |
1483 { | |
867 | 1484 Ichar ch = string_ichar (seq, n); |
428 | 1485 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil); |
1486 } | |
1487 else | |
1488 { | |
1489 Lisp_Object keystroke = XVECTOR_DATA (seq)[n]; | |
1490 if (EVENTP (keystroke)) | |
1491 Fcopy_event (keystroke, event); | |
1492 else | |
1493 Fcharacter_to_event (keystroke, event, Qnil, Qnil); | |
1494 } | |
1495 } | |
1496 | |
1497 Lisp_Object | |
1498 key_sequence_to_event_chain (Lisp_Object seq) | |
1499 { | |
1500 int len = XINT (Flength (seq)); | |
1501 int i; | |
1502 Lisp_Object head = Qnil, tail = Qnil; | |
1503 | |
1504 for (i = 0; i < len; i++) | |
1505 { | |
1506 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
1507 nth_of_key_sequence_as_event (seq, i, event); | |
1508 enqueue_event (event, &head, &tail); | |
1509 } | |
1510 | |
1511 return head; | |
1512 } | |
1513 | |
934 | 1514 |
793 | 1515 /* Concatenate a string description of EVENT onto the end of BUF. If |
1516 BRIEF, use short forms for keys, e.g. C- instead of control-. */ | |
1517 | |
934 | 1518 void |
1519 format_event_object (Eistring *buf, Lisp_Object event, int brief) | |
428 | 1520 { |
1521 int mouse_p = 0; | |
1522 int mod = 0; | |
1523 Lisp_Object key; | |
1524 | |
1204 | 1525 switch (XEVENT_TYPE (event)) |
428 | 1526 { |
1527 case key_press_event: | |
1528 { | |
1204 | 1529 mod = XEVENT_KEY_MODIFIERS (event); |
1530 key = XEVENT_KEY_KEYSYM (event); | |
428 | 1531 /* Hack. */ |
1532 if (! brief && CHARP (key) && | |
793 | 1533 mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | |
1534 XEMACS_MOD_HYPER)) | |
428 | 1535 { |
1536 int k = XCHAR (key); | |
1537 if (k >= 'a' && k <= 'z') | |
1538 key = make_char (k - ('a' - 'A')); | |
1539 else if (k >= 'A' && k <= 'Z') | |
442 | 1540 mod |= XEMACS_MOD_SHIFT; |
428 | 1541 } |
1542 break; | |
1543 } | |
1544 case button_release_event: | |
1545 mouse_p++; | |
1546 /* Fall through */ | |
1547 case button_press_event: | |
1548 { | |
1549 mouse_p++; | |
1204 | 1550 mod = XEVENT_BUTTON_MODIFIERS (event); |
1551 key = make_char (XEVENT_BUTTON_BUTTON (event) + '0'); | |
428 | 1552 break; |
1553 } | |
1554 case magic_event: | |
1555 { | |
788 | 1556 Lisp_Object stream; |
1557 struct gcpro gcpro1; | |
1558 GCPRO1 (stream); | |
428 | 1559 |
788 | 1560 stream = make_resizing_buffer_output_stream (); |
1204 | 1561 event_stream_format_magic_event (XEVENT (event), stream); |
788 | 1562 Lstream_flush (XLSTREAM (stream)); |
793 | 1563 eicat_raw (buf, resizing_buffer_stream_ptr (XLSTREAM (stream)), |
1564 Lstream_byte_count (XLSTREAM (stream))); | |
788 | 1565 Lstream_delete (XLSTREAM (stream)); |
1566 UNGCPRO; | |
428 | 1567 return; |
1568 } | |
2421 | 1569 case magic_eval_event: eicat_ascii (buf, "magic-eval"); return; |
1570 case pointer_motion_event: eicat_ascii (buf, "motion"); return; | |
1571 case misc_user_event: eicat_ascii (buf, "misc-user"); return; | |
1572 case eval_event: eicat_ascii (buf, "eval"); return; | |
1573 case process_event: eicat_ascii (buf, "process"); return; | |
1574 case timeout_event: eicat_ascii (buf, "timeout"); return; | |
1575 case empty_event: eicat_ascii (buf, "empty"); return; | |
1576 case dead_event: eicat_ascii (buf, "DEAD-EVENT"); return; | |
428 | 1577 default: |
2500 | 1578 ABORT (); |
442 | 1579 return; |
428 | 1580 } |
793 | 1581 #define modprint(x,y) \ |
2421 | 1582 do { if (brief) eicat_ascii (buf, (y)); else eicat_ascii (buf, (x)); } while (0) |
442 | 1583 if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-"); |
1584 if (mod & XEMACS_MOD_META) modprint ("meta-", "M-"); | |
1585 if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-"); | |
1586 if (mod & XEMACS_MOD_HYPER) modprint ("hyper-", "H-"); | |
1587 if (mod & XEMACS_MOD_ALT) modprint ("alt-", "A-"); | |
1588 if (mod & XEMACS_MOD_SHIFT) modprint ("shift-", "Sh-"); | |
428 | 1589 if (mouse_p) |
1590 { | |
2421 | 1591 eicat_ascii (buf, "button"); |
428 | 1592 --mouse_p; |
1593 } | |
1594 | |
1595 #undef modprint | |
1596 | |
1597 if (CHARP (key)) | |
793 | 1598 eicat_ch (buf, XCHAR (key)); |
428 | 1599 else if (SYMBOLP (key)) |
1600 { | |
2367 | 1601 const Ascbyte *str = 0; |
428 | 1602 if (brief) |
1603 { | |
1604 if (EQ (key, QKlinefeed)) str = "LFD"; | |
1605 else if (EQ (key, QKtab)) str = "TAB"; | |
1606 else if (EQ (key, QKreturn)) str = "RET"; | |
1607 else if (EQ (key, QKescape)) str = "ESC"; | |
1608 else if (EQ (key, QKdelete)) str = "DEL"; | |
1609 else if (EQ (key, QKspace)) str = "SPC"; | |
1610 else if (EQ (key, QKbackspace)) str = "BS"; | |
1611 } | |
1612 if (str) | |
2421 | 1613 eicat_ascii (buf, str); |
428 | 1614 else |
793 | 1615 eicat_lstr (buf, XSYMBOL (key)->name); |
428 | 1616 } |
1617 else | |
2500 | 1618 ABORT (); |
428 | 1619 if (mouse_p) |
2421 | 1620 eicat_ascii (buf, "up"); |
428 | 1621 } |
1622 | |
1204 | 1623 void |
1624 upshift_event (Lisp_Object event) | |
1625 { | |
1626 Lisp_Object keysym = XEVENT_KEY_KEYSYM (event); | |
1627 Ichar c = 0; | |
1628 | |
1629 if (CHAR_OR_CHAR_INTP (keysym) | |
1630 && ((c = XCHAR_OR_CHAR_INT (keysym)), | |
1631 c >= 'a' && c <= 'z')) | |
1632 XSET_EVENT_KEY_KEYSYM (event, make_char (c + 'A' - 'a')); | |
1633 else | |
1634 if (!(XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_SHIFT)) | |
1635 XSET_EVENT_KEY_MODIFIERS | |
1636 (event, XEVENT_KEY_MODIFIERS (event) |= XEMACS_MOD_SHIFT); | |
1637 } | |
1638 | |
1639 void | |
1640 downshift_event (Lisp_Object event) | |
1641 { | |
1642 Lisp_Object keysym = XEVENT_KEY_KEYSYM (event); | |
1643 Ichar c = 0; | |
1644 | |
1645 if (XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_SHIFT) | |
1646 XSET_EVENT_KEY_MODIFIERS | |
1647 (event, XEVENT_KEY_MODIFIERS (event) & ~XEMACS_MOD_SHIFT); | |
1648 else if (CHAR_OR_CHAR_INTP (keysym) | |
1649 && ((c = XCHAR_OR_CHAR_INT (keysym)), | |
1650 c >= 'A' && c <= 'Z')) | |
1651 XSET_EVENT_KEY_KEYSYM (event, make_char (c + 'a' - 'A')); | |
1652 } | |
1653 | |
1654 int | |
1655 event_upshifted_p (Lisp_Object event) | |
1656 { | |
1657 Lisp_Object keysym = XEVENT_KEY_KEYSYM (event); | |
1658 Ichar c = 0; | |
1659 | |
1660 if ((XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_SHIFT) | |
1661 || (CHAR_OR_CHAR_INTP (keysym) | |
1662 && ((c = XCHAR_OR_CHAR_INT (keysym)), | |
1663 c >= 'A' && c <= 'Z'))) | |
1664 return 1; | |
1665 else | |
1666 return 0; | |
1667 } | |
934 | 1668 |
428 | 1669 DEFUN ("eventp", Feventp, 1, 1, 0, /* |
1670 True if OBJECT is an event object. | |
1671 */ | |
1672 (object)) | |
1673 { | |
1674 return EVENTP (object) ? Qt : Qnil; | |
1675 } | |
1676 | |
1677 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /* | |
1678 True if OBJECT is an event object that has not been deallocated. | |
1679 */ | |
1680 (object)) | |
1681 { | |
934 | 1682 return EVENTP (object) && XEVENT_TYPE (object) != dead_event ? |
1683 Qt : Qnil; | |
428 | 1684 } |
1685 | |
1686 #if 0 /* debugging functions */ | |
1687 | |
826 | 1688 DEFUN ("event-next", Fevent_next, 1, 1, 0, /* |
428 | 1689 Return the event object's `next' event, or nil if it has none. |
1690 The `next-event' field is changed by calling `set-next-event'. | |
1691 */ | |
1692 (event)) | |
1693 { | |
440 | 1694 Lisp_Event *e; |
428 | 1695 CHECK_LIVE_EVENT (event); |
1696 | |
1697 return XEVENT_NEXT (event); | |
1698 } | |
1699 | |
826 | 1700 DEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /* |
428 | 1701 Set the `next event' of EVENT to NEXT-EVENT. |
1702 NEXT-EVENT must be an event object or nil. | |
1703 */ | |
1704 (event, next_event)) | |
1705 { | |
1706 Lisp_Object ev; | |
1707 | |
1708 CHECK_LIVE_EVENT (event); | |
1709 if (NILP (next_event)) | |
1710 { | |
1711 XSET_EVENT_NEXT (event, Qnil); | |
1712 return Qnil; | |
1713 } | |
1714 | |
1715 CHECK_LIVE_EVENT (next_event); | |
1716 | |
1717 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event)) | |
1718 { | |
1719 QUIT; | |
1720 if (EQ (ev, event)) | |
563 | 1721 invalid_operation_2 ("Cyclic event-next", event, next_event); |
428 | 1722 } |
1723 XSET_EVENT_NEXT (event, next_event); | |
1724 return next_event; | |
1725 } | |
1726 | |
1727 #endif /* 0 */ | |
1728 | |
1729 DEFUN ("event-type", Fevent_type, 1, 1, 0, /* | |
1730 Return the type of EVENT. | |
1731 This will be a symbol; one of | |
1732 | |
1733 key-press A key was pressed. | |
1734 button-press A mouse button was pressed. | |
1735 button-release A mouse button was released. | |
1736 misc-user Some other user action happened; typically, this is | |
1737 a menu selection or scrollbar action. | |
1738 motion The mouse moved. | |
1739 process Input is available from a subprocess. | |
1740 timeout A timeout has expired. | |
1741 eval This causes a specified action to occur when dispatched. | |
1742 magic Some window-system-specific event has occurred. | |
1743 empty The event has been allocated but not assigned. | |
1744 | |
1745 */ | |
1746 (event)) | |
1747 { | |
1748 CHECK_LIVE_EVENT (event); | |
934 | 1749 switch (XEVENT_TYPE (event)) |
428 | 1750 { |
1751 case key_press_event: return Qkey_press; | |
1752 case button_press_event: return Qbutton_press; | |
1753 case button_release_event: return Qbutton_release; | |
1754 case misc_user_event: return Qmisc_user; | |
1755 case pointer_motion_event: return Qmotion; | |
1756 case process_event: return Qprocess; | |
1757 case timeout_event: return Qtimeout; | |
1758 case eval_event: return Qeval; | |
1759 case magic_event: | |
1760 case magic_eval_event: | |
1761 return Qmagic; | |
1762 | |
1763 case empty_event: | |
1764 return Qempty; | |
1765 | |
1766 default: | |
2500 | 1767 ABORT (); |
428 | 1768 return Qnil; |
1769 } | |
1770 } | |
1771 | |
1772 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /* | |
1773 Return the timestamp of the event object EVENT. | |
442 | 1774 Timestamps are measured in milliseconds since the start of the window system. |
1775 They are NOT related to any current time measurement. | |
1776 They should be compared with `event-timestamp<'. | |
1777 See also `current-event-timestamp'. | |
428 | 1778 */ |
1779 (event)) | |
1780 { | |
1781 CHECK_LIVE_EVENT (event); | |
1782 /* This junk is so that timestamps don't get to be negative, but contain | |
1783 as many bits as this particular emacs will allow. | |
1784 */ | |
2039 | 1785 return make_int (EMACS_INT_MAX & XEVENT_TIMESTAMP (event)); |
428 | 1786 } |
1787 | |
2039 | 1788 #define TIMESTAMP_HALFSPACE (1L << (INT_VALBITS - 2)) |
442 | 1789 |
1790 DEFUN ("event-timestamp<", Fevent_timestamp_lessp, 2, 2, 0, /* | |
1791 Return true if timestamp TIME1 is earlier than timestamp TIME2. | |
1792 This correctly handles timestamp wrap. | |
1793 See also `event-timestamp' and `current-event-timestamp'. | |
1794 */ | |
1795 (time1, time2)) | |
1796 { | |
1797 EMACS_INT t1, t2; | |
1798 | |
1799 CHECK_NATNUM (time1); | |
1800 CHECK_NATNUM (time2); | |
1801 t1 = XINT (time1); | |
1802 t2 = XINT (time2); | |
1803 | |
1804 if (t1 < t2) | |
1805 return t2 - t1 < TIMESTAMP_HALFSPACE ? Qt : Qnil; | |
1806 else | |
1807 return t1 - t2 < TIMESTAMP_HALFSPACE ? Qnil : Qt; | |
1808 } | |
1809 | |
934 | 1810 #define CHECK_EVENT_TYPE(e,t1,sym) do { \ |
1811 CHECK_LIVE_EVENT (e); \ | |
1812 if (XEVENT_TYPE (e) != (t1)) \ | |
1813 e = wrong_type_argument (sym,e); \ | |
1814 } while (0) | |
1815 | |
1816 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ | |
1817 CHECK_LIVE_EVENT (e); \ | |
1818 { \ | |
1819 emacs_event_type CET_type = XEVENT_TYPE (e); \ | |
1820 if (CET_type != (t1) && \ | |
1821 CET_type != (t2)) \ | |
1822 e = wrong_type_argument (sym,e); \ | |
1823 } \ | |
1824 } while (0) | |
1825 | |
1826 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \ | |
1827 CHECK_LIVE_EVENT (e); \ | |
1828 { \ | |
1829 emacs_event_type CET_type = XEVENT_TYPE (e); \ | |
1830 if (CET_type != (t1) && \ | |
1831 CET_type != (t2) && \ | |
1832 CET_type != (t3)) \ | |
1833 e = wrong_type_argument (sym,e); \ | |
1834 } \ | |
1835 } while (0) | |
428 | 1836 |
1837 DEFUN ("event-key", Fevent_key, 1, 1, 0, /* | |
1838 Return the Keysym of the key-press event EVENT. | |
1839 This will be a character if the event is associated with one, else a symbol. | |
1840 */ | |
1841 (event)) | |
1842 { | |
1843 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p); | |
1204 | 1844 return XEVENT_KEY_KEYSYM (event); |
428 | 1845 } |
1846 | |
1847 DEFUN ("event-button", Fevent_button, 1, 1, 0, /* | |
444 | 1848 Return the button-number of the button-press or button-release event EVENT. |
428 | 1849 */ |
1850 (event)) | |
1851 { | |
1852 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event, | |
1853 misc_user_event, Qbutton_event_p); | |
1854 #ifdef HAVE_WINDOW_SYSTEM | |
1204 | 1855 if (XEVENT_TYPE (event) == misc_user_event) |
1856 return make_int (XEVENT_MISC_USER_BUTTON (event)); | |
934 | 1857 else |
1204 | 1858 return make_int (XEVENT_BUTTON_BUTTON (event)); |
428 | 1859 #else /* !HAVE_WINDOW_SYSTEM */ |
1860 return Qzero; | |
1861 #endif /* !HAVE_WINDOW_SYSTEM */ | |
1862 } | |
1863 | |
1864 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /* | |
442 | 1865 Return a number representing the modifier keys and buttons which were down |
428 | 1866 when the given mouse or keyboard event was produced. |
442 | 1867 See also the function `event-modifiers'. |
428 | 1868 */ |
1869 (event)) | |
1870 { | |
1871 again: | |
1872 CHECK_LIVE_EVENT (event); | |
934 | 1873 switch (XEVENT_TYPE (event)) |
1874 { | |
1875 case key_press_event: | |
1204 | 1876 return make_int (XEVENT_KEY_MODIFIERS (event)); |
934 | 1877 case button_press_event: |
1878 case button_release_event: | |
1204 | 1879 return make_int (XEVENT_BUTTON_MODIFIERS (event)); |
934 | 1880 case pointer_motion_event: |
1204 | 1881 return make_int (XEVENT_MOTION_MODIFIERS (event)); |
934 | 1882 case misc_user_event: |
1204 | 1883 return make_int (XEVENT_MISC_USER_MODIFIERS (event)); |
934 | 1884 default: |
1885 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event); | |
1886 goto again; | |
1887 } | |
428 | 1888 } |
1889 | |
1890 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /* | |
442 | 1891 Return a list of symbols, the names of the modifier keys and buttons |
428 | 1892 which were down when the given mouse or keyboard event was produced. |
442 | 1893 See also the function `event-modifier-bits'. |
1894 | |
1895 The possible symbols in the list are | |
1896 | |
1897 `shift': The Shift key. Will not appear, in general, on key events | |
1898 where the keysym is an ASCII character, because using Shift | |
1899 on such a character converts it into another character rather | |
1900 than actually just adding a Shift modifier. | |
1901 | |
1902 `control': The Control key. | |
1903 | |
1904 `meta': The Meta key. On PC's and PC-style keyboards, this is generally | |
1905 labelled \"Alt\"; Meta is a holdover from early Lisp Machines and | |
1906 such, propagated through the X Window System. On Sun keyboards, | |
1907 this key is labelled with a diamond. | |
1908 | |
1909 `alt': The \"Alt\" key. Alt is in quotes because this does not refer | |
1910 to what it obviously should refer to, namely the Alt key on PC | |
1911 keyboards. Instead, it refers to the key labelled Alt on Sun | |
1912 keyboards, and to no key at all on PC keyboards. | |
1913 | |
1914 `super': The Super key. Most keyboards don't have any such key, but | |
1915 under X Windows using `xmodmap' you can assign any key (such as | |
1916 an underused right-shift, right-control, or right-alt key) to | |
1917 this key modifier. No support currently exists under MS Windows | |
1918 for generating these modifiers. | |
1919 | |
1920 `hyper': The Hyper key. Works just like the Super key. | |
1921 | |
1922 `button1': The mouse buttons. This means that the specified button was held | |
1923 `button2': down at the time the event occurred. NOTE: For button-press | |
1924 `button3': events, the button that was just pressed down does NOT appear in | |
1925 `button4': the modifiers. | |
1926 `button5': | |
1927 | |
1928 Button modifiers are currently ignored when defining and looking up key and | |
1929 mouse strokes in keymaps. This could be changed, which would allow a user to | |
1930 create button-chord actions, use a button as a key modifier and do other | |
1931 clever things. | |
428 | 1932 */ |
1933 (event)) | |
1934 { | |
1935 int mod = XINT (Fevent_modifier_bits (event)); | |
1936 Lisp_Object result = Qnil; | |
442 | 1937 struct gcpro gcpro1; |
1938 | |
1939 GCPRO1 (result); | |
1940 if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result); | |
1941 if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result); | |
1942 if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result); | |
1943 if (mod & XEMACS_MOD_SUPER) result = Fcons (Qsuper, result); | |
1944 if (mod & XEMACS_MOD_META) result = Fcons (Qmeta, result); | |
1945 if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result); | |
1946 if (mod & XEMACS_MOD_BUTTON1) result = Fcons (Qbutton1, result); | |
1947 if (mod & XEMACS_MOD_BUTTON2) result = Fcons (Qbutton2, result); | |
1948 if (mod & XEMACS_MOD_BUTTON3) result = Fcons (Qbutton3, result); | |
1949 if (mod & XEMACS_MOD_BUTTON4) result = Fcons (Qbutton4, result); | |
1950 if (mod & XEMACS_MOD_BUTTON5) result = Fcons (Qbutton5, result); | |
1951 RETURN_UNGCPRO (Fnreverse (result)); | |
428 | 1952 } |
1953 | |
1954 static int | |
1955 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative) | |
1956 { | |
1957 struct window *w; | |
1958 struct frame *f; | |
1959 | |
934 | 1960 if (XEVENT_TYPE (event) == pointer_motion_event) |
1961 { | |
1204 | 1962 *x = XEVENT_MOTION_X (event); |
1963 *y = XEVENT_MOTION_Y (event); | |
934 | 1964 } |
1965 else if (XEVENT_TYPE (event) == button_press_event || | |
1966 XEVENT_TYPE (event) == button_release_event) | |
1967 { | |
1204 | 1968 *x = XEVENT_BUTTON_X (event); |
1969 *y = XEVENT_BUTTON_Y (event); | |
934 | 1970 } |
1971 else if (XEVENT_TYPE (event) == misc_user_event) | |
1972 { | |
1204 | 1973 *x = XEVENT_MISC_USER_X (event); |
1974 *y = XEVENT_MISC_USER_Y (event); | |
934 | 1975 } |
1976 else | |
1977 return 0; | |
428 | 1978 f = XFRAME (EVENT_CHANNEL (XEVENT (event))); |
1979 | |
1980 if (relative) | |
1981 { | |
1982 w = find_window_by_pixel_pos (*x, *y, f->root_window); | |
1983 | |
1984 if (!w) | |
442 | 1985 return 1; /* #### What should really happen here? */ |
428 | 1986 |
1987 *x -= w->pixel_left; | |
1988 *y -= w->pixel_top; | |
1989 } | |
1990 else | |
1991 { | |
1992 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - | |
1993 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f); | |
1994 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - | |
1995 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f); | |
1996 } | |
1997 | |
1998 return 1; | |
1999 } | |
2000 | |
2001 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /* | |
2002 Return the X position in pixels of mouse event EVENT. | |
2003 The value returned is relative to the window the event occurred in. | |
2004 This will signal an error if the event is not a mouse event. | |
2005 See also `mouse-event-p' and `event-x-pixel'. | |
2006 */ | |
2007 (event)) | |
2008 { | |
2009 int x, y; | |
2010 | |
2011 CHECK_LIVE_EVENT (event); | |
2012 | |
2013 if (!event_x_y_pixel_internal (event, &x, &y, 1)) | |
2014 return wrong_type_argument (Qmouse_event_p, event); | |
2015 else | |
2016 return make_int (x); | |
2017 } | |
2018 | |
2019 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /* | |
2020 Return the Y position in pixels of mouse event EVENT. | |
2021 The value returned is relative to the window the event occurred in. | |
2022 This will signal an error if the event is not a mouse event. | |
2023 See also `mouse-event-p' and `event-y-pixel'. | |
2024 */ | |
2025 (event)) | |
2026 { | |
2027 int x, y; | |
2028 | |
2029 CHECK_LIVE_EVENT (event); | |
2030 | |
2031 if (!event_x_y_pixel_internal (event, &x, &y, 1)) | |
2032 return wrong_type_argument (Qmouse_event_p, event); | |
2033 else | |
2034 return make_int (y); | |
2035 } | |
2036 | |
2037 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /* | |
2038 Return the X position in pixels of mouse event EVENT. | |
2039 The value returned is relative to the frame the event occurred in. | |
2040 This will signal an error if the event is not a mouse event. | |
2041 See also `mouse-event-p' and `event-window-x-pixel'. | |
2042 */ | |
2043 (event)) | |
2044 { | |
2045 int x, y; | |
2046 | |
2047 CHECK_LIVE_EVENT (event); | |
2048 | |
2049 if (!event_x_y_pixel_internal (event, &x, &y, 0)) | |
2050 return wrong_type_argument (Qmouse_event_p, event); | |
2051 else | |
2052 return make_int (x); | |
2053 } | |
2054 | |
2055 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /* | |
2056 Return the Y position in pixels of mouse event EVENT. | |
2057 The value returned is relative to the frame the event occurred in. | |
2058 This will signal an error if the event is not a mouse event. | |
2059 See also `mouse-event-p' `event-window-y-pixel'. | |
2060 */ | |
2061 (event)) | |
2062 { | |
2063 int x, y; | |
2064 | |
2065 CHECK_LIVE_EVENT (event); | |
2066 | |
2067 if (!event_x_y_pixel_internal (event, &x, &y, 0)) | |
2068 return wrong_type_argument (Qmouse_event_p, event); | |
2069 else | |
2070 return make_int (y); | |
2071 } | |
2072 | |
2073 /* Given an event, return a value: | |
2074 | |
2075 OVER_TOOLBAR: over one of the 4 frame toolbars | |
2076 OVER_MODELINE: over a modeline | |
2077 OVER_BORDER: over an internal border | |
2078 OVER_NOTHING: over the text area, but not over text | |
2079 OVER_OUTSIDE: outside of the frame border | |
2080 OVER_TEXT: over text in the text area | |
2081 OVER_V_DIVIDER: over windows vertical divider | |
2082 | |
2083 and return: | |
2084 | |
2085 The X char position in CHAR_X, if not a null pointer. | |
2086 The Y char position in CHAR_Y, if not a null pointer. | |
2087 (These last two values are relative to the window the event is over.) | |
2088 The window it's over in W, if not a null pointer. | |
2089 The buffer position it's over in BUFP, if not a null pointer. | |
2090 The closest buffer position in CLOSEST, if not a null pointer. | |
2091 | |
2092 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation(). | |
2093 */ | |
2094 | |
2095 static int | |
2096 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y, | |
2097 int *obj_x, int *obj_y, | |
665 | 2098 struct window **w, Charbpos *bufp, Charbpos *closest, |
428 | 2099 Charcount *modeline_closest, |
2100 Lisp_Object *obj1, Lisp_Object *obj2) | |
2101 { | |
2102 int pix_x = 0; | |
2103 int pix_y = 0; | |
2104 int result; | |
2105 Lisp_Object frame; | |
2106 | |
2107 int ret_x, ret_y, ret_obj_x, ret_obj_y; | |
2108 struct window *ret_w; | |
665 | 2109 Charbpos ret_bufp, ret_closest; |
428 | 2110 Charcount ret_modeline_closest; |
2111 Lisp_Object ret_obj1, ret_obj2; | |
2112 | |
2113 CHECK_LIVE_EVENT (event); | |
934 | 2114 frame = XEVENT_CHANNEL (event); |
2115 switch (XEVENT_TYPE (event)) | |
2116 { | |
2117 case pointer_motion_event : | |
1204 | 2118 pix_x = XEVENT_MOTION_X (event); |
2119 pix_y = XEVENT_MOTION_Y (event); | |
934 | 2120 break; |
2121 case button_press_event : | |
2122 case button_release_event : | |
1204 | 2123 pix_x = XEVENT_BUTTON_X (event); |
2124 pix_y = XEVENT_BUTTON_Y (event); | |
934 | 2125 break; |
2126 case misc_user_event : | |
1204 | 2127 pix_x = XEVENT_MISC_USER_X (event); |
2128 pix_y = XEVENT_MISC_USER_Y (event); | |
934 | 2129 break; |
2130 default: | |
2131 dead_wrong_type_argument (Qmouse_event_p, event); | |
2132 } | |
428 | 2133 |
2134 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y, | |
2135 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y, | |
2136 &ret_w, &ret_bufp, &ret_closest, | |
2137 &ret_modeline_closest, | |
2138 &ret_obj1, &ret_obj2); | |
2139 | |
2140 if (result == OVER_NOTHING || result == OVER_OUTSIDE) | |
2141 ret_bufp = 0; | |
2142 else if (ret_w && NILP (ret_w->buffer)) | |
2143 /* Why does this happen? (Does it still happen?) | |
2144 I guess the window has gotten reused as a non-leaf... */ | |
2145 ret_w = 0; | |
2146 | |
2147 /* #### pixel_to_glyph_translation() sometimes returns garbage... | |
2148 The word has type Lisp_Type_Record (presumably meaning `extent') but the | |
2149 pointer points to random memory, often filled with 0, sometimes not. | |
2150 */ | |
2151 /* #### Chuck, do we still need this crap? */ | |
2152 if (!NILP (ret_obj1) && !(GLYPHP (ret_obj1) | |
2153 #ifdef HAVE_TOOLBARS | |
2154 || TOOLBAR_BUTTONP (ret_obj1) | |
2155 #endif | |
2156 )) | |
2500 | 2157 ABORT (); |
428 | 2158 if (!NILP (ret_obj2) && !(EXTENTP (ret_obj2) || CONSP (ret_obj2))) |
2500 | 2159 ABORT (); |
428 | 2160 |
2161 if (char_x) | |
2162 *char_x = ret_x; | |
2163 if (char_y) | |
2164 *char_y = ret_y; | |
2165 if (obj_x) | |
2166 *obj_x = ret_obj_x; | |
2167 if (obj_y) | |
2168 *obj_y = ret_obj_y; | |
2169 if (w) | |
2170 *w = ret_w; | |
2171 if (bufp) | |
2172 *bufp = ret_bufp; | |
2173 if (closest) | |
2174 *closest = ret_closest; | |
2175 if (modeline_closest) | |
2176 *modeline_closest = ret_modeline_closest; | |
2177 if (obj1) | |
2178 *obj1 = ret_obj1; | |
2179 if (obj2) | |
2180 *obj2 = ret_obj2; | |
2181 | |
2182 return result; | |
2183 } | |
2184 | |
2185 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /* | |
2186 Return t if the mouse event EVENT occurred over the text area of a window. | |
2187 The modeline is not considered to be part of the text area. | |
2188 */ | |
2189 (event)) | |
2190 { | |
2191 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
2192 | |
2193 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil; | |
2194 } | |
2195 | |
2196 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /* | |
2197 Return t if the mouse event EVENT occurred over the modeline of a window. | |
2198 */ | |
2199 (event)) | |
2200 { | |
2201 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
2202 | |
2203 return result == OVER_MODELINE ? Qt : Qnil; | |
2204 } | |
2205 | |
2206 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /* | |
2207 Return t if the mouse event EVENT occurred over an internal border. | |
2208 */ | |
2209 (event)) | |
2210 { | |
2211 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
2212 | |
2213 return result == OVER_BORDER ? Qt : Qnil; | |
2214 } | |
2215 | |
2216 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /* | |
2217 Return t if the mouse event EVENT occurred over a toolbar. | |
2218 */ | |
2219 (event)) | |
2220 { | |
2221 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
2222 | |
2223 return result == OVER_TOOLBAR ? Qt : Qnil; | |
2224 } | |
2225 | |
2226 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /* | |
2227 Return t if the mouse event EVENT occurred over a window divider. | |
2228 */ | |
2229 (event)) | |
2230 { | |
2231 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
2232 | |
2233 return result == OVER_V_DIVIDER ? Qt : Qnil; | |
2234 } | |
2235 | |
2236 struct console * | |
2237 event_console_or_selected (Lisp_Object event) | |
2238 { | |
2239 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event)); | |
2240 Lisp_Object console = CDFW_CONSOLE (channel); | |
2241 | |
2242 if (NILP (console)) | |
2243 console = Vselected_console; | |
2244 | |
2245 return XCONSOLE (console); | |
2246 } | |
2247 | |
2248 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /* | |
2249 Return the channel that the event EVENT occurred on. | |
2250 This will be a frame, device, console, or nil for some types | |
2251 of events (e.g. eval events). | |
2252 */ | |
2253 (event)) | |
2254 { | |
2255 CHECK_LIVE_EVENT (event); | |
2256 return EVENT_CHANNEL (XEVENT (event)); | |
2257 } | |
2258 | |
2259 DEFUN ("event-window", Fevent_window, 1, 1, 0, /* | |
2260 Return the window over which mouse event EVENT occurred. | |
2261 This may be nil if the event occurred in the border or over a toolbar. | |
2262 The modeline is considered to be within the window it describes. | |
2263 */ | |
2264 (event)) | |
2265 { | |
2266 struct window *w; | |
2267 | |
2268 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0); | |
2269 | |
2270 if (!w) | |
2271 return Qnil; | |
2272 else | |
2273 { | |
793 | 2274 return wrap_window (w); |
428 | 2275 } |
2276 } | |
2277 | |
2278 DEFUN ("event-point", Fevent_point, 1, 1, 0, /* | |
2279 Return the character position of the mouse event EVENT. | |
2280 If the event did not occur over a window, or did not occur over text, | |
2281 then this returns nil. Otherwise, it returns a position in the buffer | |
2282 visible in the event's window. | |
2283 */ | |
2284 (event)) | |
2285 { | |
665 | 2286 Charbpos bufp; |
428 | 2287 struct window *w; |
2288 | |
2289 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0); | |
2290 | |
2291 return w && bufp ? make_int (bufp) : Qnil; | |
2292 } | |
2293 | |
2294 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /* | |
2295 Return the character position closest to the mouse event EVENT. | |
2296 If the event did not occur over a window or over text, return the | |
2297 closest point to the location of the event. If the Y pixel position | |
2298 overlaps a window and the X pixel position is to the left of that | |
2299 window, the closest point is the beginning of the line containing the | |
2300 Y position. If the Y pixel position overlaps a window and the X pixel | |
2301 position is to the right of that window, the closest point is the end | |
2302 of the line containing the Y position. If the Y pixel position is | |
2303 above a window, return 0. If it is below the last character in a window, | |
2304 return the value of (window-end). | |
2305 */ | |
2306 (event)) | |
2307 { | |
665 | 2308 Charbpos bufp; |
428 | 2309 |
2310 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0); | |
2311 | |
2312 return bufp ? make_int (bufp) : Qnil; | |
2313 } | |
2314 | |
2315 DEFUN ("event-x", Fevent_x, 1, 1, 0, /* | |
2316 Return the X position of the mouse event EVENT in characters. | |
2317 This is relative to the window the event occurred over. | |
2318 */ | |
2319 (event)) | |
2320 { | |
2321 int char_x; | |
2322 | |
2323 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
2324 | |
2325 return make_int (char_x); | |
2326 } | |
2327 | |
2328 DEFUN ("event-y", Fevent_y, 1, 1, 0, /* | |
2329 Return the Y position of the mouse event EVENT in characters. | |
2330 This is relative to the window the event occurred over. | |
2331 */ | |
2332 (event)) | |
2333 { | |
2334 int char_y; | |
2335 | |
2336 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0); | |
2337 | |
2338 return make_int (char_y); | |
2339 } | |
2340 | |
2341 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /* | |
2342 Return the character position in the modeline that EVENT occurred over. | |
2343 EVENT should be a mouse event. If EVENT did not occur over a modeline, | |
2344 nil is returned. You can determine the actual character that the | |
2345 event occurred over by looking in `generated-modeline-string' at the | |
2346 returned character position. Note that `generated-modeline-string' | |
2347 is buffer-local, and you must use EVENT's buffer when retrieving | |
2348 `generated-modeline-string' in order to get accurate results. | |
2349 */ | |
2350 (event)) | |
2351 { | |
2352 Charcount mbufp; | |
2353 int where; | |
2354 | |
2355 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0); | |
2356 | |
2357 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp); | |
2358 } | |
2359 | |
2360 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /* | |
2361 Return the glyph that the mouse event EVENT occurred over, or nil. | |
2362 */ | |
2363 (event)) | |
2364 { | |
2365 Lisp_Object glyph; | |
2366 struct window *w; | |
2367 | |
2368 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0); | |
2369 | |
2370 return w && GLYPHP (glyph) ? glyph : Qnil; | |
2371 } | |
2372 | |
2373 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /* | |
2374 Return the extent of the glyph that the mouse event EVENT occurred over. | |
2375 If the event did not occur over a glyph, nil is returned. | |
2376 */ | |
2377 (event)) | |
2378 { | |
2379 Lisp_Object extent; | |
2380 struct window *w; | |
2381 | |
2382 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent); | |
2383 | |
2384 return w && EXTENTP (extent) ? extent : Qnil; | |
2385 } | |
2386 | |
2387 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /* | |
2388 Return the X pixel position of EVENT relative to the glyph it occurred over. | |
2389 EVENT should be a mouse event. If the event did not occur over a glyph, | |
2390 nil is returned. | |
2391 */ | |
2392 (event)) | |
2393 { | |
2394 Lisp_Object extent; | |
2395 struct window *w; | |
2396 int obj_x; | |
2397 | |
2398 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent); | |
2399 | |
2400 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil; | |
2401 } | |
2402 | |
2403 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /* | |
2404 Return the Y pixel position of EVENT relative to the glyph it occurred over. | |
2405 EVENT should be a mouse event. If the event did not occur over a glyph, | |
2406 nil is returned. | |
2407 */ | |
2408 (event)) | |
2409 { | |
2410 Lisp_Object extent; | |
2411 struct window *w; | |
2412 int obj_y; | |
2413 | |
2414 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent); | |
2415 | |
2416 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil; | |
2417 } | |
2418 | |
2419 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /* | |
2420 Return the toolbar button that the mouse event EVENT occurred over. | |
2421 If the event did not occur over a toolbar button, nil is returned. | |
2422 */ | |
2340 | 2423 (USED_IF_TOOLBARS (event))) |
428 | 2424 { |
2425 #ifdef HAVE_TOOLBARS | |
2426 Lisp_Object button; | |
2427 | |
2428 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0); | |
2429 | |
2430 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil; | |
2431 #else | |
2432 return Qnil; | |
2433 #endif | |
2434 } | |
2435 | |
2436 DEFUN ("event-process", Fevent_process, 1, 1, 0, /* | |
444 | 2437 Return the process of the process-output event EVENT. |
428 | 2438 */ |
2439 (event)) | |
2440 { | |
934 | 2441 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p); |
1204 | 2442 return XEVENT_PROCESS_PROCESS (event); |
428 | 2443 } |
2444 | |
2445 DEFUN ("event-function", Fevent_function, 1, 1, 0, /* | |
2446 Return the callback function of EVENT. | |
2447 EVENT should be a timeout, misc-user, or eval event. | |
2448 */ | |
2449 (event)) | |
2450 { | |
2451 again: | |
2452 CHECK_LIVE_EVENT (event); | |
934 | 2453 switch (XEVENT_TYPE (event)) |
2454 { | |
2455 case timeout_event: | |
1204 | 2456 return XEVENT_TIMEOUT_FUNCTION (event); |
934 | 2457 case misc_user_event: |
1204 | 2458 return XEVENT_MISC_USER_FUNCTION (event); |
934 | 2459 case eval_event: |
1204 | 2460 return XEVENT_EVAL_FUNCTION (event); |
934 | 2461 default: |
2462 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event); | |
2463 goto again; | |
2464 } | |
428 | 2465 } |
2466 | |
2467 DEFUN ("event-object", Fevent_object, 1, 1, 0, /* | |
2468 Return the callback function argument of EVENT. | |
2469 EVENT should be a timeout, misc-user, or eval event. | |
2470 */ | |
2471 (event)) | |
2472 { | |
2473 again: | |
2474 CHECK_LIVE_EVENT (event); | |
934 | 2475 switch (XEVENT_TYPE (event)) |
2476 { | |
2477 case timeout_event: | |
1204 | 2478 return XEVENT_TIMEOUT_OBJECT (event); |
934 | 2479 case misc_user_event: |
1204 | 2480 return XEVENT_MISC_USER_OBJECT (event); |
934 | 2481 case eval_event: |
1204 | 2482 return XEVENT_EVAL_OBJECT (event); |
934 | 2483 default: |
2484 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event); | |
2485 goto again; | |
2486 } | |
428 | 2487 } |
2488 | |
2489 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /* | |
2490 Return a list of all of the properties of EVENT. | |
2491 This is in the form of a property list (alternating keyword/value pairs). | |
2492 */ | |
2493 (event)) | |
2494 { | |
2495 Lisp_Object props = Qnil; | |
440 | 2496 Lisp_Event *e; |
428 | 2497 struct gcpro gcpro1; |
2498 | |
2499 CHECK_LIVE_EVENT (event); | |
2500 e = XEVENT (event); | |
2501 GCPRO1 (props); | |
2502 | |
2503 props = cons3 (Qtimestamp, Fevent_timestamp (event), props); | |
2504 | |
934 | 2505 switch (EVENT_TYPE (e)) |
428 | 2506 { |
2500 | 2507 default: ABORT (); |
428 | 2508 |
2509 case process_event: | |
1204 | 2510 props = cons3 (Qprocess, EVENT_PROCESS_PROCESS (e), props); |
428 | 2511 break; |
2512 | |
2513 case timeout_event: | |
2514 props = cons3 (Qobject, Fevent_object (event), props); | |
2515 props = cons3 (Qfunction, Fevent_function (event), props); | |
1204 | 2516 props = cons3 (Qid, make_int (EVENT_TIMEOUT_ID_NUMBER (e)), props); |
428 | 2517 break; |
2518 | |
2519 case key_press_event: | |
2520 props = cons3 (Qmodifiers, Fevent_modifiers (event), props); | |
2521 props = cons3 (Qkey, Fevent_key (event), props); | |
2522 break; | |
2523 | |
2524 case button_press_event: | |
2525 case button_release_event: | |
2526 props = cons3 (Qy, Fevent_y_pixel (event), props); | |
2527 props = cons3 (Qx, Fevent_x_pixel (event), props); | |
2528 props = cons3 (Qmodifiers, Fevent_modifiers (event), props); | |
2529 props = cons3 (Qbutton, Fevent_button (event), props); | |
2530 break; | |
2531 | |
2532 case pointer_motion_event: | |
2533 props = cons3 (Qmodifiers, Fevent_modifiers (event), props); | |
2534 props = cons3 (Qy, Fevent_y_pixel (event), props); | |
2535 props = cons3 (Qx, Fevent_x_pixel (event), props); | |
2536 break; | |
2537 | |
2538 case misc_user_event: | |
2539 props = cons3 (Qobject, Fevent_object (event), props); | |
2540 props = cons3 (Qfunction, Fevent_function (event), props); | |
2541 props = cons3 (Qy, Fevent_y_pixel (event), props); | |
2542 props = cons3 (Qx, Fevent_x_pixel (event), props); | |
2543 props = cons3 (Qmodifiers, Fevent_modifiers (event), props); | |
2544 props = cons3 (Qbutton, Fevent_button (event), props); | |
2545 break; | |
2546 | |
2547 case eval_event: | |
2548 props = cons3 (Qobject, Fevent_object (event), props); | |
2549 props = cons3 (Qfunction, Fevent_function (event), props); | |
2550 break; | |
2551 | |
2552 case magic_eval_event: | |
2553 case magic_event: | |
2554 break; | |
2555 | |
2556 case empty_event: | |
2557 RETURN_UNGCPRO (Qnil); | |
2558 break; | |
2559 } | |
2560 | |
2561 props = cons3 (Qchannel, Fevent_channel (event), props); | |
2562 UNGCPRO; | |
2563 | |
2564 return props; | |
2565 } | |
2566 | |
2567 | |
2568 /************************************************************************/ | |
2569 /* initialization */ | |
2570 /************************************************************************/ | |
2571 | |
2572 void | |
2573 syms_of_events (void) | |
2574 { | |
442 | 2575 INIT_LRECORD_IMPLEMENTATION (event); |
1204 | 2576 #ifdef EVENT_DATA_AS_OBJECTS |
934 | 2577 INIT_LRECORD_IMPLEMENTATION (key_data); |
2578 INIT_LRECORD_IMPLEMENTATION (button_data); | |
2579 INIT_LRECORD_IMPLEMENTATION (motion_data); | |
2580 INIT_LRECORD_IMPLEMENTATION (process_data); | |
2581 INIT_LRECORD_IMPLEMENTATION (timeout_data); | |
2582 INIT_LRECORD_IMPLEMENTATION (eval_data); | |
2583 INIT_LRECORD_IMPLEMENTATION (misc_user_data); | |
2584 INIT_LRECORD_IMPLEMENTATION (magic_eval_data); | |
2585 INIT_LRECORD_IMPLEMENTATION (magic_data); | |
1204 | 2586 #endif /* EVENT_DATA_AS_OBJECTS */ |
442 | 2587 |
428 | 2588 DEFSUBR (Fcharacter_to_event); |
2589 DEFSUBR (Fevent_to_character); | |
2590 | |
2591 DEFSUBR (Fmake_event); | |
2592 DEFSUBR (Fdeallocate_event); | |
2593 DEFSUBR (Fcopy_event); | |
2594 DEFSUBR (Feventp); | |
2595 DEFSUBR (Fevent_live_p); | |
2596 DEFSUBR (Fevent_type); | |
2597 DEFSUBR (Fevent_properties); | |
2598 | |
2599 DEFSUBR (Fevent_timestamp); | |
442 | 2600 DEFSUBR (Fevent_timestamp_lessp); |
428 | 2601 DEFSUBR (Fevent_key); |
2602 DEFSUBR (Fevent_button); | |
2603 DEFSUBR (Fevent_modifier_bits); | |
2604 DEFSUBR (Fevent_modifiers); | |
2605 DEFSUBR (Fevent_x_pixel); | |
2606 DEFSUBR (Fevent_y_pixel); | |
2607 DEFSUBR (Fevent_window_x_pixel); | |
2608 DEFSUBR (Fevent_window_y_pixel); | |
2609 DEFSUBR (Fevent_over_text_area_p); | |
2610 DEFSUBR (Fevent_over_modeline_p); | |
2611 DEFSUBR (Fevent_over_border_p); | |
2612 DEFSUBR (Fevent_over_toolbar_p); | |
2613 DEFSUBR (Fevent_over_vertical_divider_p); | |
2614 DEFSUBR (Fevent_channel); | |
2615 DEFSUBR (Fevent_window); | |
2616 DEFSUBR (Fevent_point); | |
2617 DEFSUBR (Fevent_closest_point); | |
2618 DEFSUBR (Fevent_x); | |
2619 DEFSUBR (Fevent_y); | |
2620 DEFSUBR (Fevent_modeline_position); | |
2621 DEFSUBR (Fevent_glyph); | |
2622 DEFSUBR (Fevent_glyph_extent); | |
2623 DEFSUBR (Fevent_glyph_x_pixel); | |
2624 DEFSUBR (Fevent_glyph_y_pixel); | |
2625 DEFSUBR (Fevent_toolbar_button); | |
2626 DEFSUBR (Fevent_process); | |
2627 DEFSUBR (Fevent_function); | |
2628 DEFSUBR (Fevent_object); | |
2629 | |
563 | 2630 DEFSYMBOL (Qeventp); |
2631 DEFSYMBOL (Qevent_live_p); | |
2632 DEFSYMBOL (Qkey_press_event_p); | |
2633 DEFSYMBOL (Qbutton_event_p); | |
2634 DEFSYMBOL (Qmouse_event_p); | |
2635 DEFSYMBOL (Qprocess_event_p); | |
2636 DEFSYMBOL (Qkey_press); | |
2637 DEFSYMBOL (Qbutton_press); | |
2638 DEFSYMBOL (Qbutton_release); | |
2639 DEFSYMBOL (Qmisc_user); | |
2828 | 2640 DEFSYMBOL (Qcharacter_of_keysym); |
563 | 2641 DEFSYMBOL (Qascii_character); |
428 | 2642 |
2643 defsymbol (&QKbackspace, "backspace"); | |
2644 defsymbol (&QKtab, "tab"); | |
2645 defsymbol (&QKlinefeed, "linefeed"); | |
2646 defsymbol (&QKreturn, "return"); | |
2647 defsymbol (&QKescape, "escape"); | |
2648 defsymbol (&QKspace, "space"); | |
2649 defsymbol (&QKdelete, "delete"); | |
2650 } | |
2651 | |
2652 | |
2653 void | |
2654 reinit_vars_of_events (void) | |
2655 { | |
2656 Vevent_resource = Qnil; | |
3092 | 2657 #ifdef NEW_GC |
2658 staticpro (&Vevent_resource); | |
2659 #endif /* NEW_GC */ | |
428 | 2660 } |
2661 | |
2662 void | |
2663 vars_of_events (void) | |
2664 { | |
2665 } |