Mercurial > hg > xemacs-beta
annotate src/events.c @ 5050:6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
-------------------- ChangeLog entries follow: --------------------
ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* configure.ac (XE_COMPLEX_ARG):
Correct doc of --quick-build: It also doesn't check for Lisp shadows.
src/ChangeLog addition:
2010-02-20 Ben Wing <ben@xemacs.org>
* EmacsFrame.c:
* EmacsFrame.c (EmacsFrameRecomputeCellSize):
* alloca.c (i00afunc):
* buffer.c:
* buffer.c (MARKED_SLOT):
* buffer.c (complex_vars_of_buffer):
* cm.c:
* cm.c (cmcheckmagic):
* console.c:
* console.c (MARKED_SLOT):
* device-x.c:
* device-x.c (x_get_visual_depth):
* emacs.c (sort_args):
* eval.c (throw_or_bomb_out):
* event-stream.c:
* event-stream.c (Fadd_timeout):
* event-stream.c (Fadd_async_timeout):
* event-stream.c (Frecent_keys):
* events.c:
* events.c (Fdeallocate_event):
* events.c (event_pixel_translation):
* extents.c:
* extents.c (process_extents_for_insertion_mapper):
* fns.c (Fbase64_encode_region):
* fns.c (Fbase64_encode_string):
* fns.c (Fbase64_decode_region):
* fns.c (Fbase64_decode_string):
* font-lock.c:
* font-lock.c (find_context):
* frame-x.c:
* frame-x.c (x_wm_mark_shell_size_user_specified):
* frame-x.c (x_wm_mark_shell_position_user_specified):
* frame-x.c (x_wm_set_shell_iconic_p):
* frame-x.c (x_wm_set_cell_size):
* frame-x.c (x_wm_set_variable_size):
* frame-x.c (x_wm_store_class_hints):
* frame-x.c (x_wm_maybe_store_wm_command):
* frame-x.c (x_initialize_frame_size):
* frame.c (delete_frame_internal):
* frame.c (change_frame_size_1):
* free-hook.c (check_free):
* free-hook.c (note_block_input):
* free-hook.c (log_gcpro):
* gccache-gtk.c (gc_cache_lookup):
* gccache-x.c:
* gccache-x.c (gc_cache_lookup):
* glyphs-gtk.c:
* glyphs-gtk.c (init_image_instance_from_gdk_pixmap):
* glyphs-x.c:
* glyphs-x.c (extract_xpm_color_names):
* insdel.c:
* insdel.c (move_gap):
* keymap.c:
* keymap.c (keymap_lookup_directly):
* keymap.c (keymap_delete_inverse_internal):
* keymap.c (accessible_keymaps_mapper_1):
* keymap.c (where_is_recursive_mapper):
* lisp.h:
* lstream.c (make_lisp_buffer_stream_1):
* macros.c:
* macros.c (pop_kbd_macro_event):
* mc-alloc.c (remove_page_from_used_list):
* menubar-x.c:
* menubar-x.c (set_frame_menubar):
* ralloc.c:
* ralloc.c (obtain):
* ralloc.c (relinquish):
* ralloc.c (relocate_blocs):
* ralloc.c (resize_bloc):
* ralloc.c (r_alloc_free):
* ralloc.c (r_re_alloc):
* ralloc.c (r_alloc_thaw):
* ralloc.c (init_ralloc):
* ralloc.c (Free_Addr_Block):
* scrollbar-x.c:
* scrollbar-x.c (x_update_scrollbar_instance_status):
* sunplay.c (init_device):
* unexnt.c:
* unexnt.c (read_in_bss):
* unexnt.c (map_in_heap):
* window.c:
* window.c (real_window):
* window.c (window_display_lines):
* window.c (window_display_buffer):
* window.c (set_window_display_buffer):
* window.c (unshow_buffer):
* window.c (Fget_lru_window):
if (...) ABORT(); ---> assert();
More specifically:
if (x == y) ABORT (); --> assert (x != y);
if (x != y) ABORT (); --> assert (x == y);
if (x > y) ABORT (); --> assert (x <= y);
etc.
if (!x) ABORT (); --> assert (x);
if (x) ABORT (); --> assert (!x);
DeMorgan's Law's applied and manually simplified:
if (x && !y) ABORT (); --> assert (!x || y);
if (!x || y >= z) ABORT (); --> assert (x && y < z);
Checked to make sure that assert() of an expression with side
effects ensures that the side effects get executed even when
asserts are disabled, and add a comment about this being a
requirement of any "disabled assert" expression.
* depend:
* make-src-depend:
* make-src-depend (PrintDeps):
Fix broken code in make-src-depend so it does what it was always
supposed to do, which was separate out config.h and lisp.h and
all the files they include into separate variables in the
depend part of Makefile so that quick-build can turn off the
lisp.h/config.h/text.h/etc. dependencies of the source files, to
speed up recompilation.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Sat, 20 Feb 2010 05:05:54 -0600 |
| parents | e813cf16c015 |
| children | 92dc90c0bb40 |
| 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. | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
4 Copyright (C) 2001, 2002, 2005, 2010 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 | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
892 assert (!(EQ (event, Vlast_command_event) || |
|
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
893 EQ (event, Vlast_input_event) || |
|
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
894 EQ (event, Vunread_command_event))); |
| 428 | 895 |
| 896 len = XVECTOR_LENGTH (Vthis_command_keys); | |
| 897 for (i = 0; i < len; i++) | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
898 assert (!EQ (event, XVECTOR_DATA (Vthis_command_keys) [i])); |
| 428 | 899 if (!NILP (Vrecent_keys_ring)) |
| 900 { | |
| 901 int recent_ring_len = XVECTOR_LENGTH (Vrecent_keys_ring); | |
| 902 for (i = 0; i < recent_ring_len; i++) | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
903 assert (!EQ (event, XVECTOR_DATA (Vrecent_keys_ring) [i])); |
| 428 | 904 } |
| 905 } | |
| 906 #endif /* 0 */ | |
| 907 | |
| 908 assert (!EQ (event, Vevent_resource)); | |
| 909 deinitialize_event (event); | |
| 910 #ifndef ALLOC_NO_POOLS | |
| 911 XSET_EVENT_NEXT (event, Vevent_resource); | |
| 912 Vevent_resource = event; | |
| 913 #endif | |
| 914 return Qnil; | |
| 915 } | |
| 916 | |
| 917 DEFUN ("copy-event", Fcopy_event, 1, 2, 0, /* | |
| 444 | 918 Make a copy of the event object EVENT1. |
| 919 If a second event argument EVENT2 is given, EVENT1 is copied into | |
| 920 EVENT2 and EVENT2 is returned. If EVENT2 is not supplied (or is nil) | |
| 921 then a new event will be made as with `make-event'. See also the | |
| 922 function `deallocate-event'. | |
| 428 | 923 */ |
| 924 (event1, event2)) | |
| 925 { | |
| 926 CHECK_LIVE_EVENT (event1); | |
| 927 if (NILP (event2)) | |
| 928 event2 = Fmake_event (Qnil, Qnil); | |
| 430 | 929 else |
| 930 { | |
| 931 CHECK_LIVE_EVENT (event2); | |
| 932 if (EQ (event1, event2)) | |
| 563 | 933 return signal_continuable_error_2 |
| 934 (Qinvalid_argument, | |
| 935 "copy-event called with `eq' events", event1, event2); | |
| 430 | 936 } |
| 428 | 937 |
| 938 assert (XEVENT_TYPE (event1) <= last_event_type); | |
| 939 assert (XEVENT_TYPE (event2) <= last_event_type); | |
| 940 | |
| 934 | 941 XSET_EVENT_TYPE (event2, XEVENT_TYPE (event1)); |
| 942 XSET_EVENT_CHANNEL (event2, XEVENT_CHANNEL (event1)); | |
| 943 XSET_EVENT_TIMESTAMP (event2, XEVENT_TIMESTAMP (event1)); | |
| 1204 | 944 |
| 945 #ifdef EVENT_DATA_AS_OBJECTS | |
| 946 copy_lisp_object (XEVENT_DATA (event2), XEVENT_DATA (event1)); | |
| 947 #else | |
| 948 XEVENT (event2)->event = XEVENT (event1)->event; | |
| 949 #endif | |
| 934 | 950 return event2; |
| 428 | 951 } |
| 952 | |
| 953 | |
| 771 | 954 /************************************************************************/ |
| 955 /* event chain functions */ | |
| 956 /************************************************************************/ | |
| 428 | 957 |
| 958 /* Given a chain of events (or possibly nil), deallocate them all. */ | |
| 959 | |
| 960 void | |
| 961 deallocate_event_chain (Lisp_Object event_chain) | |
| 962 { | |
| 963 while (!NILP (event_chain)) | |
| 964 { | |
| 965 Lisp_Object next = XEVENT_NEXT (event_chain); | |
| 966 Fdeallocate_event (event_chain); | |
| 967 event_chain = next; | |
| 968 } | |
| 969 } | |
| 970 | |
| 971 /* Return the last event in a chain. | |
| 972 NOTE: You cannot pass nil as a value here! The routine will | |
| 973 abort if you do. */ | |
| 974 | |
| 975 Lisp_Object | |
| 976 event_chain_tail (Lisp_Object event_chain) | |
| 977 { | |
| 978 while (1) | |
| 979 { | |
| 980 Lisp_Object next = XEVENT_NEXT (event_chain); | |
| 981 if (NILP (next)) | |
| 982 return event_chain; | |
| 983 event_chain = next; | |
| 984 } | |
| 985 } | |
| 986 | |
| 987 /* Enqueue a single event onto the end of a chain of events. | |
| 988 HEAD points to the first event in the chain, TAIL to the last event. | |
| 989 If the chain is empty, both values should be nil. */ | |
| 990 | |
| 991 void | |
| 992 enqueue_event (Lisp_Object event, Lisp_Object *head, Lisp_Object *tail) | |
| 993 { | |
| 994 assert (NILP (XEVENT_NEXT (event))); | |
| 995 assert (!EQ (*tail, event)); | |
| 996 | |
| 997 if (!NILP (*tail)) | |
| 998 XSET_EVENT_NEXT (*tail, event); | |
| 999 else | |
| 1000 *head = event; | |
| 1001 *tail = event; | |
| 1002 | |
| 1003 assert (!EQ (event, XEVENT_NEXT (event))); | |
| 1004 } | |
| 1005 | |
| 1006 /* Remove an event off the head of a chain of events and return it. | |
| 1007 HEAD points to the first event in the chain, TAIL to the last event. */ | |
| 1008 | |
| 1009 Lisp_Object | |
| 1010 dequeue_event (Lisp_Object *head, Lisp_Object *tail) | |
| 1011 { | |
| 1012 Lisp_Object event; | |
| 1013 | |
| 1014 event = *head; | |
| 1015 *head = XEVENT_NEXT (event); | |
| 1016 XSET_EVENT_NEXT (event, Qnil); | |
| 1017 if (NILP (*head)) | |
| 1018 *tail = Qnil; | |
| 1019 return event; | |
| 1020 } | |
| 1021 | |
| 1022 /* Enqueue a chain of events (or possibly nil) onto the end of another | |
| 1023 chain of events. HEAD points to the first event in the chain being | |
| 1024 queued onto, TAIL to the last event. If the chain is empty, both values | |
| 1025 should be nil. */ | |
| 1026 | |
| 1027 void | |
| 1028 enqueue_event_chain (Lisp_Object event_chain, Lisp_Object *head, | |
| 1029 Lisp_Object *tail) | |
| 1030 { | |
| 1031 if (NILP (event_chain)) | |
| 1032 return; | |
| 1033 | |
| 1034 if (NILP (*head)) | |
| 1035 { | |
| 1036 *head = event_chain; | |
| 1037 *tail = event_chain; | |
| 1038 } | |
| 1039 else | |
| 1040 { | |
| 1041 XSET_EVENT_NEXT (*tail, event_chain); | |
| 1042 *tail = event_chain_tail (event_chain); | |
| 1043 } | |
| 1044 } | |
| 1045 | |
| 1204 | 1046 /* Map a function over each event in the chain. If the function returns |
| 1047 non-zero, remove the event just processed. Return the total number of | |
| 1048 items removed. | |
| 1049 | |
| 1050 NOTE: | |
| 1051 | |
| 1052 If you want a simple mapping over an event chain, with no intention to | |
| 1053 add or remove items, just use EVENT_CHAIN_LOOP(). | |
| 1054 */ | |
| 1055 | |
| 1056 int | |
| 1057 map_event_chain_remove (int (*fn) (Lisp_Object ev, void *user_data), | |
| 1058 Lisp_Object *head, Lisp_Object *tail, | |
| 1059 void *user_data, int flags) | |
| 1060 { | |
| 1061 Lisp_Object event; | |
| 1062 Lisp_Object previous_event = Qnil; | |
| 1063 int count = 0; | |
| 1064 | |
| 1065 EVENT_CHAIN_LOOP (event, *head) | |
| 1066 { | |
| 1067 if (fn (event, user_data)) | |
| 1068 { | |
| 1069 if (NILP (previous_event)) | |
| 1070 dequeue_event (head, tail); | |
| 1071 else | |
| 1072 { | |
| 1073 XSET_EVENT_NEXT (previous_event, XEVENT_NEXT (event)); | |
| 1074 if (EQ (*tail, event)) | |
| 1075 *tail = previous_event; | |
| 1076 } | |
| 1077 | |
| 1078 if (flags & MECR_DEALLOCATE_EVENT) | |
| 1079 Fdeallocate_event (event); | |
| 1080 count++; | |
| 1081 } | |
| 1082 else | |
| 1083 previous_event = event; | |
| 1084 } | |
| 1085 return count; | |
| 1086 } | |
| 1087 | |
| 428 | 1088 /* Return the number of events (possibly 0) on an event chain. */ |
| 1089 | |
| 1090 int | |
| 1091 event_chain_count (Lisp_Object event_chain) | |
| 1092 { | |
| 1093 Lisp_Object event; | |
| 1094 int n = 0; | |
| 1095 | |
| 1096 EVENT_CHAIN_LOOP (event, event_chain) | |
| 1097 n++; | |
| 1098 | |
| 1099 return n; | |
| 1100 } | |
| 1101 | |
| 1102 /* Find the event before EVENT in an event chain. This aborts | |
| 1103 if the event is not in the chain. */ | |
| 1104 | |
| 1105 Lisp_Object | |
| 1106 event_chain_find_previous (Lisp_Object event_chain, Lisp_Object event) | |
| 1107 { | |
| 1108 Lisp_Object previous = Qnil; | |
| 1109 | |
| 1110 while (!NILP (event_chain)) | |
| 1111 { | |
| 1112 if (EQ (event_chain, event)) | |
| 1113 return previous; | |
| 1114 previous = event_chain; | |
| 1115 event_chain = XEVENT_NEXT (event_chain); | |
| 1116 } | |
| 1117 | |
| 2500 | 1118 ABORT (); |
| 428 | 1119 return Qnil; |
| 1120 } | |
| 1121 | |
| 1122 Lisp_Object | |
| 1123 event_chain_nth (Lisp_Object event_chain, int n) | |
| 1124 { | |
| 1125 Lisp_Object event; | |
| 1126 EVENT_CHAIN_LOOP (event, event_chain) | |
| 1127 { | |
| 1128 if (!n) | |
| 1129 return event; | |
| 1130 n--; | |
| 1131 } | |
| 1132 return Qnil; | |
| 1133 } | |
| 1134 | |
| 771 | 1135 /* Return a freshly allocated copy of all events in the given chain. */ |
| 1136 | |
| 428 | 1137 Lisp_Object |
| 1138 copy_event_chain (Lisp_Object event_chain) | |
| 1139 { | |
| 1140 Lisp_Object new_chain = Qnil; | |
| 1141 Lisp_Object new_chain_tail = Qnil; | |
| 1142 Lisp_Object event; | |
| 1143 | |
| 1144 EVENT_CHAIN_LOOP (event, event_chain) | |
| 1145 { | |
| 1146 Lisp_Object copy = Fcopy_event (event, Qnil); | |
| 1147 enqueue_event (copy, &new_chain, &new_chain_tail); | |
| 1148 } | |
| 1149 | |
| 1150 return new_chain; | |
| 1151 } | |
| 1152 | |
| 771 | 1153 /* Given a pointer (maybe nil) into an old chain (also maybe nil, if |
| 1154 pointer is nil) and a new chain which is a copy of the old, return | |
| 1155 the corresponding new pointer. */ | |
| 1156 Lisp_Object | |
| 1157 transfer_event_chain_pointer (Lisp_Object pointer, Lisp_Object old_chain, | |
| 1158 Lisp_Object new_chain) | |
| 1159 { | |
| 1160 if (NILP (pointer)) | |
| 1161 return Qnil; | |
| 1162 assert (!NILP (old_chain)); | |
| 800 | 1163 #ifdef ERROR_CHECK_STRUCTURES |
| 771 | 1164 /* make sure we're actually in the chain */ |
| 1165 event_chain_find_previous (old_chain, pointer); | |
| 1166 assert (event_chain_count (old_chain) == event_chain_count (new_chain)); | |
| 800 | 1167 #endif /* ERROR_CHECK_STRUCTURES */ |
| 771 | 1168 return event_chain_nth (new_chain, |
| 1169 event_chain_count (old_chain) - | |
| 1170 event_chain_count (pointer)); | |
| 1171 } | |
| 1172 | |
| 428 | 1173 |
| 771 | 1174 /************************************************************************/ |
| 1175 /* higher level functions */ | |
| 1176 /************************************************************************/ | |
| 428 | 1177 |
| 1178 Lisp_Object QKbackspace, QKtab, QKlinefeed, QKreturn, QKescape, | |
| 1179 QKspace, QKdelete; | |
| 1180 | |
| 1181 int | |
| 1182 command_event_p (Lisp_Object event) | |
| 1183 { | |
| 1184 switch (XEVENT_TYPE (event)) | |
| 1185 { | |
| 1186 case key_press_event: | |
| 1187 case button_press_event: | |
| 1188 case button_release_event: | |
| 1189 case misc_user_event: | |
| 1190 return 1; | |
| 1191 default: | |
| 1192 return 0; | |
| 1193 } | |
| 1194 } | |
| 1195 | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1196 /* 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
|
1197 |
|
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1198 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
|
1199 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
|
1200 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
|
1201 |
| 1204 | 1202 DO_BACKSPACE_MAPPING means that if CON is a TTY, and C is a the TTY's |
| 1203 backspace character, the event will have keysym `backspace' instead of | |
| 1204 '(control h). It is clearly correct to do this conversion is the | |
| 1205 character was just read from a TTY, clearly incorrect inside of | |
| 1206 define-key, which must be able to handle all consoles. #### What about | |
| 1207 in other circumstances? #### Should the user have access to this flag? | |
| 1208 | |
| 1209 #### We need to go through and review all the flags in | |
| 1210 character_to_event() and event_to_character() and figure out exactly | |
| 1211 under what circumstances they should or should not be set, then go | |
| 1212 through and review all callers of character_to_event(), | |
| 1213 Fcharacter_to_event(), event_to_character(), and Fevent_to_character() | |
| 1214 and check that they are passing the correct flags in for their varied | |
| 1215 circumstances. | |
| 1216 | |
| 1217 #### Some of this garbage, and some of the flags, could go away if we | |
| 1218 implemented the suggestion, originally from event-Xt.c: | |
| 1219 | |
| 2828 | 1220 [[ The way that keysym correspondence to characters should work: |
| 1204 | 1221 - a Lisp_Event should contain a keysym AND a character slot. |
| 1222 - keybindings are tried with the keysym. If no binding can be found, | |
| 2828 | 1223 and there is a corresponding character, call self-insert-command. ]] |
| 1224 | |
| 1225 That's an X-specific way of thinking. All the other platforms--even | |
| 1226 the TTY, make sure you've done (set-input-mode t nil 1) and set your | |
| 1227 console coding system appropriately when checking--just use | |
| 1228 characters as emacs keysyms, and, together with defaulting to | |
| 1229 self-insert-command if an unbound key with a character correspondence | |
| 1230 is typed, that works fine for them. (Yes, this ignores GTK.) | |
| 1231 | |
| 1232 [[ [... snipping other suggestions which I've implemented.] | |
| 1233 Nuke the Qascii_character property. ]] | |
| 1204 | 1234 |
| 2828 | 1235 Well, we've renamed it anyway--it was badly named. |
| 1236 Qcharacter_of_keysym, here we go. It's really only with X11 that how | |
| 1237 to map between adiaeresis and (int-to-char #xE4), or ellipsis and | |
| 1238 whatever, becomes an issue, and IMO the property approach to this is | |
| 1239 fine. Aidan Kehoe, 2005-05-15. | |
| 1204 | 1240 |
| 2828 | 1241 [[ This would apparently solve a lot of different problems. ]] |
| 1242 | |
| 1243 I'd be interested to know what's left. Removing the allow-meta | |
| 1244 argument from event-to-character would be a Good Thing, IMO, but | |
| 1245 beyond that, I'm not sure what else there is to do wrt. key | |
| 1246 mappings. Of course, feedback from users of the Russian C-x facility | |
| 1247 is still needed. */ | |
| 428 | 1248 |
| 1249 void | |
| 867 | 1250 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
|
1251 character_to_event_meta_behavior meta_behavior, |
| 2340 | 1252 int USED_IF_TTY (do_backspace_mapping)) |
| 428 | 1253 { |
| 1254 Lisp_Object k = Qnil; | |
| 442 | 1255 int m = 0; |
| 934 | 1256 if (EVENT_TYPE (event) == dead_event) |
| 563 | 1257 invalid_argument ("character-to-event called with a deallocated event!", Qunbound); |
| 428 | 1258 |
| 1259 #ifndef MULE | |
| 1260 c &= 255; | |
| 1261 #endif | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1262 if (meta_behavior != latin_1_maps_to_itself && c > 127 && c <= 255) |
| 428 | 1263 { |
| 1264 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
|
1265 if (meta_behavior == use_console_meta_flag && CONSOLE_TTY_P (con)) |
| 428 | 1266 meta_flag = TTY_FLAGS (con).meta_key; |
| 1267 switch (meta_flag) | |
| 1268 { | |
| 1269 case 0: /* ignore top bit; it's parity */ | |
| 1270 c -= 128; | |
| 1271 break; | |
| 1272 case 1: /* top bit is meta */ | |
| 1273 c -= 128; | |
| 442 | 1274 m = XEMACS_MOD_META; |
| 428 | 1275 break; |
| 1276 default: /* this is a real character */ | |
| 1277 break; | |
| 1278 } | |
| 1279 } | |
| 442 | 1280 if (c < ' ') c += '@', m |= XEMACS_MOD_CONTROL; |
| 1281 if (m & XEMACS_MOD_CONTROL) | |
| 428 | 1282 { |
| 1283 switch (c) | |
| 1284 { | |
| 442 | 1285 case 'I': k = QKtab; m &= ~XEMACS_MOD_CONTROL; break; |
| 1286 case 'J': k = QKlinefeed; m &= ~XEMACS_MOD_CONTROL; break; | |
| 1287 case 'M': k = QKreturn; m &= ~XEMACS_MOD_CONTROL; break; | |
| 1288 case '[': k = QKescape; m &= ~XEMACS_MOD_CONTROL; break; | |
| 428 | 1289 default: |
| 1204 | 1290 #if defined (HAVE_TTY) |
| 428 | 1291 if (do_backspace_mapping && |
| 1292 CHARP (con->tty_erase_char) && | |
| 1293 c - '@' == XCHAR (con->tty_erase_char)) | |
| 1294 { | |
| 1295 k = QKbackspace; | |
| 442 | 1296 m &= ~XEMACS_MOD_CONTROL; |
| 428 | 1297 } |
| 1204 | 1298 #endif /* defined (HAVE_TTY) */ |
| 428 | 1299 break; |
| 1300 } | |
| 1301 if (c >= 'A' && c <= 'Z') c -= 'A'-'a'; | |
| 1302 } | |
| 1204 | 1303 #if defined (HAVE_TTY) |
| 428 | 1304 else if (do_backspace_mapping && |
| 1305 CHARP (con->tty_erase_char) && c == XCHAR (con->tty_erase_char)) | |
| 1306 k = QKbackspace; | |
| 1204 | 1307 #endif /* defined (HAVE_TTY) */ |
| 428 | 1308 else if (c == 127) |
| 1309 k = QKdelete; | |
| 1310 else if (c == ' ') | |
| 1311 k = QKspace; | |
| 1312 | |
| 934 | 1313 set_event_type (event, key_press_event); |
| 1314 SET_EVENT_TIMESTAMP_ZERO (event); /* #### */ | |
| 1315 SET_EVENT_CHANNEL (event, wrap_console (con)); | |
| 1204 | 1316 SET_EVENT_KEY_KEYSYM (event, (!NILP (k) ? k : make_char (c))); |
| 1317 SET_EVENT_KEY_MODIFIERS (event, m); | |
| 428 | 1318 } |
| 1319 | |
| 867 | 1320 Ichar |
| 1204 | 1321 event_to_character (Lisp_Object event, |
| 428 | 1322 int allow_extra_modifiers, |
| 2828 | 1323 int allow_meta) |
| 428 | 1324 { |
| 867 | 1325 Ichar c = 0; |
| 428 | 1326 Lisp_Object code; |
| 1327 | |
| 1204 | 1328 if (XEVENT_TYPE (event) != key_press_event) |
| 428 | 1329 { |
| 1204 | 1330 assert (XEVENT_TYPE (event) != dead_event); |
| 428 | 1331 return -1; |
| 1332 } | |
| 1333 if (!allow_extra_modifiers && | |
| 2828 | 1334 XEVENT_KEY_MODIFIERS (event) & |
| 1335 (XEMACS_MOD_SUPER|XEMACS_MOD_HYPER|XEMACS_MOD_ALT)) | |
| 428 | 1336 return -1; |
| 1204 | 1337 if (CHAR_OR_CHAR_INTP (XEVENT_KEY_KEYSYM (event))) |
| 1338 c = XCHAR_OR_CHAR_INT (XEVENT_KEY_KEYSYM (event)); | |
| 1339 else if (!SYMBOLP (XEVENT_KEY_KEYSYM (event))) | |
| 2500 | 1340 ABORT (); |
| 1204 | 1341 else if (CHAR_OR_CHAR_INTP (code = Fget (XEVENT_KEY_KEYSYM (event), |
| 2828 | 1342 Qcharacter_of_keysym, Qnil))) |
| 428 | 1343 c = XCHAR_OR_CHAR_INT (code); |
| 1344 else | |
| 2828 | 1345 { |
| 1346 Lisp_Object thekeysym = XEVENT_KEY_KEYSYM (event); | |
| 1347 | |
| 1348 if (CHAR_OR_CHAR_INTP (code = Fget (thekeysym, Qascii_character, Qnil))) | |
| 1349 { | |
| 1350 c = XCHAR_OR_CHAR_INT (code); | |
| 1351 warn_when_safe(Qkey_mapping, Qwarning, | |
| 1352 "Obsolete key binding technique.\n" | |
| 428 | 1353 |
| 2828 | 1354 "Some code you're using bound %s to `self-insert-command' and messed around\n" |
| 1355 "with its `ascii-character' property. Doing this is deprecated, and the code\n" | |
| 1356 "should be updated to use the `set-character-of-keysym' interface.\n" | |
| 1357 "If you're the one updating the code, first check if there's still a need\n" | |
| 1358 "for it; we support many more X11 keysyms out of the box now than we did\n" | |
| 1359 "in the past. ", XSTRING_DATA(XSYMBOL_NAME(thekeysym))); | |
| 1360 /* Only show the warning once for each keysym. */ | |
| 1361 Fput(thekeysym, Qcharacter_of_keysym, code); | |
| 1362 } | |
| 1363 else | |
| 1364 { | |
| 1365 return -1; | |
| 1366 } | |
| 1367 } | |
| 1204 | 1368 if (XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_CONTROL) |
| 428 | 1369 { |
| 1370 if (c >= 'a' && c <= 'z') | |
| 1371 c -= ('a' - 'A'); | |
| 1372 else | |
| 1373 /* reject Control-Shift- keys */ | |
| 1374 if (c >= 'A' && c <= 'Z' && !allow_extra_modifiers) | |
| 1375 return -1; | |
| 1376 | |
| 1377 if (c >= '@' && c <= '_') | |
| 1378 c -= '@'; | |
| 1379 else if (c == ' ') /* C-space and C-@ are the same. */ | |
| 1380 c = 0; | |
| 1381 else | |
| 1382 /* reject keys that can't take Control- modifiers */ | |
| 1383 if (! allow_extra_modifiers) return -1; | |
| 1384 } | |
| 1385 | |
| 1204 | 1386 if (XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_META) |
| 428 | 1387 { |
| 1388 if (! allow_meta) return -1; | |
| 1204 | 1389 if (c >= 128) return -1; /* don't allow M-oslash (overlap) */ |
| 428 | 1390 c |= 0200; |
| 1391 } | |
| 1392 return c; | |
| 1393 } | |
| 1394 | |
| 2862 | 1395 DEFUN ("event-to-character", Fevent_to_character, 1, 4, 0, /* |
| 2828 | 1396 Return the closest character approximation to the given event object. |
| 428 | 1397 If the event isn't a keypress, this returns nil. |
| 1398 If the ALLOW-EXTRA-MODIFIERS argument is non-nil, then this is lenient in | |
| 1399 its translation; it will ignore modifier keys other than control and meta, | |
| 1400 and will ignore the shift modifier on those characters which have no | |
| 1401 shifted ASCII equivalent (Control-Shift-A for example, will be mapped to | |
| 1402 the same ASCII code as Control-A). | |
| 1403 If the ALLOW-META argument is non-nil, then the Meta modifier will be | |
| 1404 represented by turning on the high bit of the byte returned; otherwise, nil | |
| 1405 will be returned for events containing the Meta modifier. | |
| 1204 | 1406 Note that ALLOW-META may cause ambiguity between meta characters and |
| 1407 Latin-1 characters. | |
| 2862 | 1408 ALLOW-NON-ASCII is unused, and retained for compatibility. |
| 428 | 1409 */ |
| 2862 | 1410 (event, allow_extra_modifiers, allow_meta, UNUSED(allow_non_ascii))) |
| 428 | 1411 { |
| 867 | 1412 Ichar c; |
| 428 | 1413 CHECK_LIVE_EVENT (event); |
| 1204 | 1414 c = event_to_character (event, |
| 428 | 1415 !NILP (allow_extra_modifiers), |
| 2828 | 1416 !NILP (allow_meta)); |
| 428 | 1417 return c < 0 ? Qnil : make_char (c); |
| 1418 } | |
| 1419 | |
| 1420 DEFUN ("character-to-event", Fcharacter_to_event, 1, 4, 0, /* | |
| 444 | 1421 Convert KEY-DESCRIPTION into an event structure, replete with bucky bits. |
| 428 | 1422 |
| 444 | 1423 KEY-DESCRIPTION is the first argument, and the event to fill in is the |
| 1424 second. This function contains knowledge about what various kinds of | |
| 1425 arguments ``mean'' -- for example, the number 9 is converted to the | |
| 1426 character ``Tab'', not the distinct character ``Control-I''. | |
| 428 | 1427 |
| 3025 | 1428 KEY-DESCRIPTION can be an integer, a character, a symbol such as `clear', |
| 444 | 1429 or a list such as '(control backspace). |
| 1430 | |
| 1431 If the optional second argument EVENT is an event, it is modified and | |
| 1432 returned; otherwise, a new event object is created and returned. | |
| 428 | 1433 |
| 1434 Optional third arg CONSOLE is the console to store in the event, and | |
| 1435 defaults to the selected console. | |
| 1436 | |
| 444 | 1437 If KEY-DESCRIPTION is an integer or character, the high bit may be |
| 1204 | 1438 interpreted as the meta key. (This is done for backward compatibility in |
| 1439 lots of places -- specifically, because lots of Lisp code uses specs like | |
| 1440 ?\M-d and "\M-d" in key code, expecting this to work; yet these are in | |
| 1441 reality converted directly to 8-bit characters by the Lisp reader.) If | |
| 1442 USE-CONSOLE-META-FLAG is nil or CONSOLE is not a TTY, this will always be | |
| 1443 the case. If USE-CONSOLE-META-FLAG is non-nil and CONSOLE is a TTY, the | |
| 1444 `meta' flag for CONSOLE affects whether the high bit is interpreted as a | |
| 1445 meta key. (See `set-input-mode'.) Don't set this flag to non-nil unless | |
| 1446 you know what you're doing (more specifically, only if the character came | |
| 1447 directly from a TTY, not from the user). If you don't want this silly meta | |
| 1448 interpretation done, you should pass in a list containing the character. | |
| 428 | 1449 |
| 1450 Beware that character-to-event and event-to-character are not strictly | |
| 1451 inverse functions, since events contain much more information than the | |
| 444 | 1452 Lisp character object type can encode. |
| 428 | 1453 */ |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
3092
diff
changeset
|
1454 (keystroke, event, console, use_console_meta_flag_)) |
| 428 | 1455 { |
| 1456 struct console *con = decode_console (console); | |
| 1457 if (NILP (event)) | |
| 1458 event = Fmake_event (Qnil, Qnil); | |
| 1459 else | |
| 1460 CHECK_LIVE_EVENT (event); | |
| 444 | 1461 if (CONSP (keystroke) || SYMBOLP (keystroke)) |
| 1462 key_desc_list_to_event (keystroke, event, 1); | |
| 428 | 1463 else |
| 1464 { | |
| 444 | 1465 CHECK_CHAR_COERCE_INT (keystroke); |
| 1466 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
|
1467 (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
|
1468 high_bit_is_meta : use_console_meta_flag), 1); |
| 428 | 1469 } |
| 1470 return event; | |
| 1471 } | |
| 1472 | |
| 1473 void | |
| 1474 nth_of_key_sequence_as_event (Lisp_Object seq, int n, Lisp_Object event) | |
| 1475 { | |
| 1476 assert (STRINGP (seq) || VECTORP (seq)); | |
| 1477 assert (n < XINT (Flength (seq))); | |
| 1478 | |
| 1479 if (STRINGP (seq)) | |
| 1480 { | |
| 867 | 1481 Ichar ch = string_ichar (seq, n); |
| 428 | 1482 Fcharacter_to_event (make_char (ch), event, Qnil, Qnil); |
| 1483 } | |
| 1484 else | |
| 1485 { | |
| 1486 Lisp_Object keystroke = XVECTOR_DATA (seq)[n]; | |
| 1487 if (EVENTP (keystroke)) | |
| 1488 Fcopy_event (keystroke, event); | |
| 1489 else | |
| 1490 Fcharacter_to_event (keystroke, event, Qnil, Qnil); | |
| 1491 } | |
| 1492 } | |
| 1493 | |
| 1494 Lisp_Object | |
| 1495 key_sequence_to_event_chain (Lisp_Object seq) | |
| 1496 { | |
| 1497 int len = XINT (Flength (seq)); | |
| 1498 int i; | |
| 1499 Lisp_Object head = Qnil, tail = Qnil; | |
| 1500 | |
| 1501 for (i = 0; i < len; i++) | |
| 1502 { | |
| 1503 Lisp_Object event = Fmake_event (Qnil, Qnil); | |
| 1504 nth_of_key_sequence_as_event (seq, i, event); | |
| 1505 enqueue_event (event, &head, &tail); | |
| 1506 } | |
| 1507 | |
| 1508 return head; | |
| 1509 } | |
| 1510 | |
| 934 | 1511 |
| 793 | 1512 /* Concatenate a string description of EVENT onto the end of BUF. If |
| 1513 BRIEF, use short forms for keys, e.g. C- instead of control-. */ | |
| 1514 | |
| 934 | 1515 void |
| 1516 format_event_object (Eistring *buf, Lisp_Object event, int brief) | |
| 428 | 1517 { |
| 1518 int mouse_p = 0; | |
| 1519 int mod = 0; | |
| 1520 Lisp_Object key; | |
| 1521 | |
| 1204 | 1522 switch (XEVENT_TYPE (event)) |
| 428 | 1523 { |
| 1524 case key_press_event: | |
| 1525 { | |
| 1204 | 1526 mod = XEVENT_KEY_MODIFIERS (event); |
| 1527 key = XEVENT_KEY_KEYSYM (event); | |
| 428 | 1528 /* Hack. */ |
| 1529 if (! brief && CHARP (key) && | |
| 793 | 1530 mod & (XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | |
| 1531 XEMACS_MOD_HYPER)) | |
| 428 | 1532 { |
| 1533 int k = XCHAR (key); | |
| 1534 if (k >= 'a' && k <= 'z') | |
| 1535 key = make_char (k - ('a' - 'A')); | |
| 1536 else if (k >= 'A' && k <= 'Z') | |
| 442 | 1537 mod |= XEMACS_MOD_SHIFT; |
| 428 | 1538 } |
| 1539 break; | |
| 1540 } | |
| 1541 case button_release_event: | |
| 1542 mouse_p++; | |
| 1543 /* Fall through */ | |
| 1544 case button_press_event: | |
| 1545 { | |
| 1546 mouse_p++; | |
| 1204 | 1547 mod = XEVENT_BUTTON_MODIFIERS (event); |
| 1548 key = make_char (XEVENT_BUTTON_BUTTON (event) + '0'); | |
| 428 | 1549 break; |
| 1550 } | |
| 1551 case magic_event: | |
| 1552 { | |
| 788 | 1553 Lisp_Object stream; |
| 1554 struct gcpro gcpro1; | |
| 1555 GCPRO1 (stream); | |
| 428 | 1556 |
| 788 | 1557 stream = make_resizing_buffer_output_stream (); |
| 1204 | 1558 event_stream_format_magic_event (XEVENT (event), stream); |
| 788 | 1559 Lstream_flush (XLSTREAM (stream)); |
| 793 | 1560 eicat_raw (buf, resizing_buffer_stream_ptr (XLSTREAM (stream)), |
| 1561 Lstream_byte_count (XLSTREAM (stream))); | |
| 788 | 1562 Lstream_delete (XLSTREAM (stream)); |
| 1563 UNGCPRO; | |
| 428 | 1564 return; |
| 1565 } | |
| 2421 | 1566 case magic_eval_event: eicat_ascii (buf, "magic-eval"); return; |
| 1567 case pointer_motion_event: eicat_ascii (buf, "motion"); return; | |
| 1568 case misc_user_event: eicat_ascii (buf, "misc-user"); return; | |
| 1569 case eval_event: eicat_ascii (buf, "eval"); return; | |
| 1570 case process_event: eicat_ascii (buf, "process"); return; | |
| 1571 case timeout_event: eicat_ascii (buf, "timeout"); return; | |
| 1572 case empty_event: eicat_ascii (buf, "empty"); return; | |
| 1573 case dead_event: eicat_ascii (buf, "DEAD-EVENT"); return; | |
| 428 | 1574 default: |
| 2500 | 1575 ABORT (); |
| 442 | 1576 return; |
| 428 | 1577 } |
| 793 | 1578 #define modprint(x,y) \ |
| 2421 | 1579 do { if (brief) eicat_ascii (buf, (y)); else eicat_ascii (buf, (x)); } while (0) |
| 442 | 1580 if (mod & XEMACS_MOD_CONTROL) modprint ("control-", "C-"); |
| 1581 if (mod & XEMACS_MOD_META) modprint ("meta-", "M-"); | |
| 1582 if (mod & XEMACS_MOD_SUPER) modprint ("super-", "S-"); | |
| 1583 if (mod & XEMACS_MOD_HYPER) modprint ("hyper-", "H-"); | |
| 1584 if (mod & XEMACS_MOD_ALT) modprint ("alt-", "A-"); | |
| 1585 if (mod & XEMACS_MOD_SHIFT) modprint ("shift-", "Sh-"); | |
| 428 | 1586 if (mouse_p) |
| 1587 { | |
| 2421 | 1588 eicat_ascii (buf, "button"); |
| 428 | 1589 --mouse_p; |
| 1590 } | |
| 1591 | |
| 1592 #undef modprint | |
| 1593 | |
| 1594 if (CHARP (key)) | |
| 793 | 1595 eicat_ch (buf, XCHAR (key)); |
| 428 | 1596 else if (SYMBOLP (key)) |
| 1597 { | |
| 2367 | 1598 const Ascbyte *str = 0; |
| 428 | 1599 if (brief) |
| 1600 { | |
| 1601 if (EQ (key, QKlinefeed)) str = "LFD"; | |
| 1602 else if (EQ (key, QKtab)) str = "TAB"; | |
| 1603 else if (EQ (key, QKreturn)) str = "RET"; | |
| 1604 else if (EQ (key, QKescape)) str = "ESC"; | |
| 1605 else if (EQ (key, QKdelete)) str = "DEL"; | |
| 1606 else if (EQ (key, QKspace)) str = "SPC"; | |
| 1607 else if (EQ (key, QKbackspace)) str = "BS"; | |
| 1608 } | |
| 1609 if (str) | |
| 2421 | 1610 eicat_ascii (buf, str); |
| 428 | 1611 else |
| 793 | 1612 eicat_lstr (buf, XSYMBOL (key)->name); |
| 428 | 1613 } |
| 1614 else | |
| 2500 | 1615 ABORT (); |
| 428 | 1616 if (mouse_p) |
| 2421 | 1617 eicat_ascii (buf, "up"); |
| 428 | 1618 } |
| 1619 | |
| 1204 | 1620 void |
| 1621 upshift_event (Lisp_Object event) | |
| 1622 { | |
| 1623 Lisp_Object keysym = XEVENT_KEY_KEYSYM (event); | |
| 1624 Ichar c = 0; | |
| 1625 | |
| 1626 if (CHAR_OR_CHAR_INTP (keysym) | |
| 1627 && ((c = XCHAR_OR_CHAR_INT (keysym)), | |
| 1628 c >= 'a' && c <= 'z')) | |
| 1629 XSET_EVENT_KEY_KEYSYM (event, make_char (c + 'A' - 'a')); | |
| 1630 else | |
| 1631 if (!(XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_SHIFT)) | |
| 1632 XSET_EVENT_KEY_MODIFIERS | |
| 1633 (event, XEVENT_KEY_MODIFIERS (event) |= XEMACS_MOD_SHIFT); | |
| 1634 } | |
| 1635 | |
| 1636 void | |
| 1637 downshift_event (Lisp_Object event) | |
| 1638 { | |
| 1639 Lisp_Object keysym = XEVENT_KEY_KEYSYM (event); | |
| 1640 Ichar c = 0; | |
| 1641 | |
| 1642 if (XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_SHIFT) | |
| 1643 XSET_EVENT_KEY_MODIFIERS | |
| 1644 (event, XEVENT_KEY_MODIFIERS (event) & ~XEMACS_MOD_SHIFT); | |
| 1645 else if (CHAR_OR_CHAR_INTP (keysym) | |
| 1646 && ((c = XCHAR_OR_CHAR_INT (keysym)), | |
| 1647 c >= 'A' && c <= 'Z')) | |
| 1648 XSET_EVENT_KEY_KEYSYM (event, make_char (c + 'a' - 'A')); | |
| 1649 } | |
| 1650 | |
| 1651 int | |
| 1652 event_upshifted_p (Lisp_Object event) | |
| 1653 { | |
| 1654 Lisp_Object keysym = XEVENT_KEY_KEYSYM (event); | |
| 1655 Ichar c = 0; | |
| 1656 | |
| 1657 if ((XEVENT_KEY_MODIFIERS (event) & XEMACS_MOD_SHIFT) | |
| 1658 || (CHAR_OR_CHAR_INTP (keysym) | |
| 1659 && ((c = XCHAR_OR_CHAR_INT (keysym)), | |
| 1660 c >= 'A' && c <= 'Z'))) | |
| 1661 return 1; | |
| 1662 else | |
| 1663 return 0; | |
| 1664 } | |
| 934 | 1665 |
| 428 | 1666 DEFUN ("eventp", Feventp, 1, 1, 0, /* |
| 1667 True if OBJECT is an event object. | |
| 1668 */ | |
| 1669 (object)) | |
| 1670 { | |
| 1671 return EVENTP (object) ? Qt : Qnil; | |
| 1672 } | |
| 1673 | |
| 1674 DEFUN ("event-live-p", Fevent_live_p, 1, 1, 0, /* | |
| 1675 True if OBJECT is an event object that has not been deallocated. | |
| 1676 */ | |
| 1677 (object)) | |
| 1678 { | |
| 934 | 1679 return EVENTP (object) && XEVENT_TYPE (object) != dead_event ? |
| 1680 Qt : Qnil; | |
| 428 | 1681 } |
| 1682 | |
| 1683 #if 0 /* debugging functions */ | |
| 1684 | |
| 826 | 1685 DEFUN ("event-next", Fevent_next, 1, 1, 0, /* |
| 428 | 1686 Return the event object's `next' event, or nil if it has none. |
| 1687 The `next-event' field is changed by calling `set-next-event'. | |
| 1688 */ | |
| 1689 (event)) | |
| 1690 { | |
| 440 | 1691 Lisp_Event *e; |
| 428 | 1692 CHECK_LIVE_EVENT (event); |
| 1693 | |
| 1694 return XEVENT_NEXT (event); | |
| 1695 } | |
| 1696 | |
| 826 | 1697 DEFUN ("set-event-next", Fset_event_next, 2, 2, 0, /* |
| 428 | 1698 Set the `next event' of EVENT to NEXT-EVENT. |
| 1699 NEXT-EVENT must be an event object or nil. | |
| 1700 */ | |
| 1701 (event, next_event)) | |
| 1702 { | |
| 1703 Lisp_Object ev; | |
| 1704 | |
| 1705 CHECK_LIVE_EVENT (event); | |
| 1706 if (NILP (next_event)) | |
| 1707 { | |
| 1708 XSET_EVENT_NEXT (event, Qnil); | |
| 1709 return Qnil; | |
| 1710 } | |
| 1711 | |
| 1712 CHECK_LIVE_EVENT (next_event); | |
| 1713 | |
| 1714 EVENT_CHAIN_LOOP (ev, XEVENT_NEXT (event)) | |
| 1715 { | |
| 1716 QUIT; | |
| 1717 if (EQ (ev, event)) | |
| 563 | 1718 invalid_operation_2 ("Cyclic event-next", event, next_event); |
| 428 | 1719 } |
| 1720 XSET_EVENT_NEXT (event, next_event); | |
| 1721 return next_event; | |
| 1722 } | |
| 1723 | |
| 1724 #endif /* 0 */ | |
| 1725 | |
| 1726 DEFUN ("event-type", Fevent_type, 1, 1, 0, /* | |
| 1727 Return the type of EVENT. | |
| 1728 This will be a symbol; one of | |
| 1729 | |
| 1730 key-press A key was pressed. | |
| 1731 button-press A mouse button was pressed. | |
| 1732 button-release A mouse button was released. | |
| 1733 misc-user Some other user action happened; typically, this is | |
| 1734 a menu selection or scrollbar action. | |
| 1735 motion The mouse moved. | |
| 1736 process Input is available from a subprocess. | |
| 1737 timeout A timeout has expired. | |
| 1738 eval This causes a specified action to occur when dispatched. | |
| 1739 magic Some window-system-specific event has occurred. | |
| 1740 empty The event has been allocated but not assigned. | |
| 1741 | |
| 1742 */ | |
| 1743 (event)) | |
| 1744 { | |
| 1745 CHECK_LIVE_EVENT (event); | |
| 934 | 1746 switch (XEVENT_TYPE (event)) |
| 428 | 1747 { |
| 1748 case key_press_event: return Qkey_press; | |
| 1749 case button_press_event: return Qbutton_press; | |
| 1750 case button_release_event: return Qbutton_release; | |
| 1751 case misc_user_event: return Qmisc_user; | |
| 1752 case pointer_motion_event: return Qmotion; | |
| 1753 case process_event: return Qprocess; | |
| 1754 case timeout_event: return Qtimeout; | |
| 1755 case eval_event: return Qeval; | |
| 1756 case magic_event: | |
| 1757 case magic_eval_event: | |
| 1758 return Qmagic; | |
| 1759 | |
| 1760 case empty_event: | |
| 1761 return Qempty; | |
| 1762 | |
| 1763 default: | |
| 2500 | 1764 ABORT (); |
| 428 | 1765 return Qnil; |
| 1766 } | |
| 1767 } | |
| 1768 | |
| 1769 DEFUN ("event-timestamp", Fevent_timestamp, 1, 1, 0, /* | |
| 1770 Return the timestamp of the event object EVENT. | |
| 442 | 1771 Timestamps are measured in milliseconds since the start of the window system. |
| 1772 They are NOT related to any current time measurement. | |
| 1773 They should be compared with `event-timestamp<'. | |
| 1774 See also `current-event-timestamp'. | |
| 428 | 1775 */ |
| 1776 (event)) | |
| 1777 { | |
| 1778 CHECK_LIVE_EVENT (event); | |
| 1779 /* This junk is so that timestamps don't get to be negative, but contain | |
| 1780 as many bits as this particular emacs will allow. | |
| 1781 */ | |
| 2039 | 1782 return make_int (EMACS_INT_MAX & XEVENT_TIMESTAMP (event)); |
| 428 | 1783 } |
| 1784 | |
| 2039 | 1785 #define TIMESTAMP_HALFSPACE (1L << (INT_VALBITS - 2)) |
| 442 | 1786 |
| 1787 DEFUN ("event-timestamp<", Fevent_timestamp_lessp, 2, 2, 0, /* | |
| 1788 Return true if timestamp TIME1 is earlier than timestamp TIME2. | |
| 1789 This correctly handles timestamp wrap. | |
| 1790 See also `event-timestamp' and `current-event-timestamp'. | |
| 1791 */ | |
| 1792 (time1, time2)) | |
| 1793 { | |
| 1794 EMACS_INT t1, t2; | |
| 1795 | |
| 1796 CHECK_NATNUM (time1); | |
| 1797 CHECK_NATNUM (time2); | |
| 1798 t1 = XINT (time1); | |
| 1799 t2 = XINT (time2); | |
| 1800 | |
| 1801 if (t1 < t2) | |
| 1802 return t2 - t1 < TIMESTAMP_HALFSPACE ? Qt : Qnil; | |
| 1803 else | |
| 1804 return t1 - t2 < TIMESTAMP_HALFSPACE ? Qnil : Qt; | |
| 1805 } | |
| 1806 | |
| 934 | 1807 #define CHECK_EVENT_TYPE(e,t1,sym) do { \ |
| 1808 CHECK_LIVE_EVENT (e); \ | |
| 1809 if (XEVENT_TYPE (e) != (t1)) \ | |
| 1810 e = wrong_type_argument (sym,e); \ | |
| 1811 } while (0) | |
| 1812 | |
| 1813 #define CHECK_EVENT_TYPE2(e,t1,t2,sym) do { \ | |
| 1814 CHECK_LIVE_EVENT (e); \ | |
| 1815 { \ | |
| 1816 emacs_event_type CET_type = XEVENT_TYPE (e); \ | |
| 1817 if (CET_type != (t1) && \ | |
| 1818 CET_type != (t2)) \ | |
| 1819 e = wrong_type_argument (sym,e); \ | |
| 1820 } \ | |
| 1821 } while (0) | |
| 1822 | |
| 1823 #define CHECK_EVENT_TYPE3(e,t1,t2,t3,sym) do { \ | |
| 1824 CHECK_LIVE_EVENT (e); \ | |
| 1825 { \ | |
| 1826 emacs_event_type CET_type = XEVENT_TYPE (e); \ | |
| 1827 if (CET_type != (t1) && \ | |
| 1828 CET_type != (t2) && \ | |
| 1829 CET_type != (t3)) \ | |
| 1830 e = wrong_type_argument (sym,e); \ | |
| 1831 } \ | |
| 1832 } while (0) | |
| 428 | 1833 |
| 1834 DEFUN ("event-key", Fevent_key, 1, 1, 0, /* | |
| 1835 Return the Keysym of the key-press event EVENT. | |
| 1836 This will be a character if the event is associated with one, else a symbol. | |
| 1837 */ | |
| 1838 (event)) | |
| 1839 { | |
| 1840 CHECK_EVENT_TYPE (event, key_press_event, Qkey_press_event_p); | |
| 1204 | 1841 return XEVENT_KEY_KEYSYM (event); |
| 428 | 1842 } |
| 1843 | |
| 1844 DEFUN ("event-button", Fevent_button, 1, 1, 0, /* | |
| 444 | 1845 Return the button-number of the button-press or button-release event EVENT. |
| 428 | 1846 */ |
| 1847 (event)) | |
| 1848 { | |
| 1849 CHECK_EVENT_TYPE3 (event, button_press_event, button_release_event, | |
| 1850 misc_user_event, Qbutton_event_p); | |
| 1851 #ifdef HAVE_WINDOW_SYSTEM | |
| 1204 | 1852 if (XEVENT_TYPE (event) == misc_user_event) |
| 1853 return make_int (XEVENT_MISC_USER_BUTTON (event)); | |
| 934 | 1854 else |
| 1204 | 1855 return make_int (XEVENT_BUTTON_BUTTON (event)); |
| 428 | 1856 #else /* !HAVE_WINDOW_SYSTEM */ |
| 1857 return Qzero; | |
| 1858 #endif /* !HAVE_WINDOW_SYSTEM */ | |
| 1859 } | |
| 1860 | |
| 1861 DEFUN ("event-modifier-bits", Fevent_modifier_bits, 1, 1, 0, /* | |
| 442 | 1862 Return a number representing the modifier keys and buttons which were down |
| 428 | 1863 when the given mouse or keyboard event was produced. |
| 442 | 1864 See also the function `event-modifiers'. |
| 428 | 1865 */ |
| 1866 (event)) | |
| 1867 { | |
| 1868 again: | |
| 1869 CHECK_LIVE_EVENT (event); | |
| 934 | 1870 switch (XEVENT_TYPE (event)) |
| 1871 { | |
| 1872 case key_press_event: | |
| 1204 | 1873 return make_int (XEVENT_KEY_MODIFIERS (event)); |
| 934 | 1874 case button_press_event: |
| 1875 case button_release_event: | |
| 1204 | 1876 return make_int (XEVENT_BUTTON_MODIFIERS (event)); |
| 934 | 1877 case pointer_motion_event: |
| 1204 | 1878 return make_int (XEVENT_MOTION_MODIFIERS (event)); |
| 934 | 1879 case misc_user_event: |
| 1204 | 1880 return make_int (XEVENT_MISC_USER_MODIFIERS (event)); |
| 934 | 1881 default: |
| 1882 event = wrong_type_argument (intern ("key-or-mouse-event-p"), event); | |
| 1883 goto again; | |
| 1884 } | |
| 428 | 1885 } |
| 1886 | |
| 1887 DEFUN ("event-modifiers", Fevent_modifiers, 1, 1, 0, /* | |
| 442 | 1888 Return a list of symbols, the names of the modifier keys and buttons |
| 428 | 1889 which were down when the given mouse or keyboard event was produced. |
| 442 | 1890 See also the function `event-modifier-bits'. |
| 1891 | |
| 1892 The possible symbols in the list are | |
| 1893 | |
| 1894 `shift': The Shift key. Will not appear, in general, on key events | |
| 1895 where the keysym is an ASCII character, because using Shift | |
| 1896 on such a character converts it into another character rather | |
| 1897 than actually just adding a Shift modifier. | |
| 1898 | |
| 1899 `control': The Control key. | |
| 1900 | |
| 1901 `meta': The Meta key. On PC's and PC-style keyboards, this is generally | |
| 1902 labelled \"Alt\"; Meta is a holdover from early Lisp Machines and | |
| 1903 such, propagated through the X Window System. On Sun keyboards, | |
| 1904 this key is labelled with a diamond. | |
| 1905 | |
| 1906 `alt': The \"Alt\" key. Alt is in quotes because this does not refer | |
| 1907 to what it obviously should refer to, namely the Alt key on PC | |
| 1908 keyboards. Instead, it refers to the key labelled Alt on Sun | |
| 1909 keyboards, and to no key at all on PC keyboards. | |
| 1910 | |
| 1911 `super': The Super key. Most keyboards don't have any such key, but | |
| 1912 under X Windows using `xmodmap' you can assign any key (such as | |
| 1913 an underused right-shift, right-control, or right-alt key) to | |
| 1914 this key modifier. No support currently exists under MS Windows | |
| 1915 for generating these modifiers. | |
| 1916 | |
| 1917 `hyper': The Hyper key. Works just like the Super key. | |
| 1918 | |
| 1919 `button1': The mouse buttons. This means that the specified button was held | |
| 1920 `button2': down at the time the event occurred. NOTE: For button-press | |
| 1921 `button3': events, the button that was just pressed down does NOT appear in | |
| 1922 `button4': the modifiers. | |
| 1923 `button5': | |
| 1924 | |
| 1925 Button modifiers are currently ignored when defining and looking up key and | |
| 1926 mouse strokes in keymaps. This could be changed, which would allow a user to | |
| 1927 create button-chord actions, use a button as a key modifier and do other | |
| 1928 clever things. | |
| 428 | 1929 */ |
| 1930 (event)) | |
| 1931 { | |
| 1932 int mod = XINT (Fevent_modifier_bits (event)); | |
| 1933 Lisp_Object result = Qnil; | |
| 442 | 1934 struct gcpro gcpro1; |
| 1935 | |
| 1936 GCPRO1 (result); | |
| 1937 if (mod & XEMACS_MOD_SHIFT) result = Fcons (Qshift, result); | |
| 1938 if (mod & XEMACS_MOD_ALT) result = Fcons (Qalt, result); | |
| 1939 if (mod & XEMACS_MOD_HYPER) result = Fcons (Qhyper, result); | |
| 1940 if (mod & XEMACS_MOD_SUPER) result = Fcons (Qsuper, result); | |
| 1941 if (mod & XEMACS_MOD_META) result = Fcons (Qmeta, result); | |
| 1942 if (mod & XEMACS_MOD_CONTROL) result = Fcons (Qcontrol, result); | |
| 1943 if (mod & XEMACS_MOD_BUTTON1) result = Fcons (Qbutton1, result); | |
| 1944 if (mod & XEMACS_MOD_BUTTON2) result = Fcons (Qbutton2, result); | |
| 1945 if (mod & XEMACS_MOD_BUTTON3) result = Fcons (Qbutton3, result); | |
| 1946 if (mod & XEMACS_MOD_BUTTON4) result = Fcons (Qbutton4, result); | |
| 1947 if (mod & XEMACS_MOD_BUTTON5) result = Fcons (Qbutton5, result); | |
| 1948 RETURN_UNGCPRO (Fnreverse (result)); | |
| 428 | 1949 } |
| 1950 | |
| 1951 static int | |
| 1952 event_x_y_pixel_internal (Lisp_Object event, int *x, int *y, int relative) | |
| 1953 { | |
| 1954 struct window *w; | |
| 1955 struct frame *f; | |
| 1956 | |
| 934 | 1957 if (XEVENT_TYPE (event) == pointer_motion_event) |
| 1958 { | |
| 1204 | 1959 *x = XEVENT_MOTION_X (event); |
| 1960 *y = XEVENT_MOTION_Y (event); | |
| 934 | 1961 } |
| 1962 else if (XEVENT_TYPE (event) == button_press_event || | |
| 1963 XEVENT_TYPE (event) == button_release_event) | |
| 1964 { | |
| 1204 | 1965 *x = XEVENT_BUTTON_X (event); |
| 1966 *y = XEVENT_BUTTON_Y (event); | |
| 934 | 1967 } |
| 1968 else if (XEVENT_TYPE (event) == misc_user_event) | |
| 1969 { | |
| 1204 | 1970 *x = XEVENT_MISC_USER_X (event); |
| 1971 *y = XEVENT_MISC_USER_Y (event); | |
| 934 | 1972 } |
| 1973 else | |
| 1974 return 0; | |
| 428 | 1975 f = XFRAME (EVENT_CHANNEL (XEVENT (event))); |
| 1976 | |
| 1977 if (relative) | |
| 1978 { | |
| 1979 w = find_window_by_pixel_pos (*x, *y, f->root_window); | |
| 1980 | |
| 1981 if (!w) | |
| 442 | 1982 return 1; /* #### What should really happen here? */ |
| 428 | 1983 |
| 1984 *x -= w->pixel_left; | |
| 1985 *y -= w->pixel_top; | |
| 1986 } | |
| 1987 else | |
| 1988 { | |
| 1989 *y -= FRAME_REAL_TOP_TOOLBAR_HEIGHT (f) - | |
| 1990 FRAME_REAL_TOP_TOOLBAR_BORDER_WIDTH (f); | |
| 1991 *x -= FRAME_REAL_LEFT_TOOLBAR_WIDTH (f) - | |
| 1992 FRAME_REAL_LEFT_TOOLBAR_BORDER_WIDTH (f); | |
| 1993 } | |
| 1994 | |
| 1995 return 1; | |
| 1996 } | |
| 1997 | |
| 1998 DEFUN ("event-window-x-pixel", Fevent_window_x_pixel, 1, 1, 0, /* | |
| 1999 Return the X position in pixels of mouse event EVENT. | |
| 2000 The value returned is relative to the window the event occurred in. | |
| 2001 This will signal an error if the event is not a mouse event. | |
| 2002 See also `mouse-event-p' and `event-x-pixel'. | |
| 2003 */ | |
| 2004 (event)) | |
| 2005 { | |
| 2006 int x, y; | |
| 2007 | |
| 2008 CHECK_LIVE_EVENT (event); | |
| 2009 | |
| 2010 if (!event_x_y_pixel_internal (event, &x, &y, 1)) | |
| 2011 return wrong_type_argument (Qmouse_event_p, event); | |
| 2012 else | |
| 2013 return make_int (x); | |
| 2014 } | |
| 2015 | |
| 2016 DEFUN ("event-window-y-pixel", Fevent_window_y_pixel, 1, 1, 0, /* | |
| 2017 Return the Y position in pixels of mouse event EVENT. | |
| 2018 The value returned is relative to the window the event occurred in. | |
| 2019 This will signal an error if the event is not a mouse event. | |
| 2020 See also `mouse-event-p' and `event-y-pixel'. | |
| 2021 */ | |
| 2022 (event)) | |
| 2023 { | |
| 2024 int x, y; | |
| 2025 | |
| 2026 CHECK_LIVE_EVENT (event); | |
| 2027 | |
| 2028 if (!event_x_y_pixel_internal (event, &x, &y, 1)) | |
| 2029 return wrong_type_argument (Qmouse_event_p, event); | |
| 2030 else | |
| 2031 return make_int (y); | |
| 2032 } | |
| 2033 | |
| 2034 DEFUN ("event-x-pixel", Fevent_x_pixel, 1, 1, 0, /* | |
| 2035 Return the X position in pixels of mouse event EVENT. | |
| 2036 The value returned is relative to the frame the event occurred in. | |
| 2037 This will signal an error if the event is not a mouse event. | |
| 2038 See also `mouse-event-p' and `event-window-x-pixel'. | |
| 2039 */ | |
| 2040 (event)) | |
| 2041 { | |
| 2042 int x, y; | |
| 2043 | |
| 2044 CHECK_LIVE_EVENT (event); | |
| 2045 | |
| 2046 if (!event_x_y_pixel_internal (event, &x, &y, 0)) | |
| 2047 return wrong_type_argument (Qmouse_event_p, event); | |
| 2048 else | |
| 2049 return make_int (x); | |
| 2050 } | |
| 2051 | |
| 2052 DEFUN ("event-y-pixel", Fevent_y_pixel, 1, 1, 0, /* | |
| 2053 Return the Y position in pixels of mouse event EVENT. | |
| 2054 The value returned is relative to the frame the event occurred in. | |
| 2055 This will signal an error if the event is not a mouse event. | |
| 2056 See also `mouse-event-p' `event-window-y-pixel'. | |
| 2057 */ | |
| 2058 (event)) | |
| 2059 { | |
| 2060 int x, y; | |
| 2061 | |
| 2062 CHECK_LIVE_EVENT (event); | |
| 2063 | |
| 2064 if (!event_x_y_pixel_internal (event, &x, &y, 0)) | |
| 2065 return wrong_type_argument (Qmouse_event_p, event); | |
| 2066 else | |
| 2067 return make_int (y); | |
| 2068 } | |
| 2069 | |
| 2070 /* Given an event, return a value: | |
| 2071 | |
| 2072 OVER_TOOLBAR: over one of the 4 frame toolbars | |
| 2073 OVER_MODELINE: over a modeline | |
| 2074 OVER_BORDER: over an internal border | |
| 2075 OVER_NOTHING: over the text area, but not over text | |
| 2076 OVER_OUTSIDE: outside of the frame border | |
| 2077 OVER_TEXT: over text in the text area | |
| 2078 OVER_V_DIVIDER: over windows vertical divider | |
| 2079 | |
| 2080 and return: | |
| 2081 | |
| 2082 The X char position in CHAR_X, if not a null pointer. | |
| 2083 The Y char position in CHAR_Y, if not a null pointer. | |
| 2084 (These last two values are relative to the window the event is over.) | |
| 2085 The window it's over in W, if not a null pointer. | |
| 2086 The buffer position it's over in BUFP, if not a null pointer. | |
| 2087 The closest buffer position in CLOSEST, if not a null pointer. | |
| 2088 | |
| 2089 OBJ_X, OBJ_Y, OBJ1, and OBJ2 are as in pixel_to_glyph_translation(). | |
| 2090 */ | |
| 2091 | |
| 2092 static int | |
| 2093 event_pixel_translation (Lisp_Object event, int *char_x, int *char_y, | |
| 2094 int *obj_x, int *obj_y, | |
| 665 | 2095 struct window **w, Charbpos *bufp, Charbpos *closest, |
| 428 | 2096 Charcount *modeline_closest, |
| 2097 Lisp_Object *obj1, Lisp_Object *obj2) | |
| 2098 { | |
| 2099 int pix_x = 0; | |
| 2100 int pix_y = 0; | |
| 2101 int result; | |
| 2102 Lisp_Object frame; | |
| 2103 | |
| 2104 int ret_x, ret_y, ret_obj_x, ret_obj_y; | |
| 2105 struct window *ret_w; | |
| 665 | 2106 Charbpos ret_bufp, ret_closest; |
| 428 | 2107 Charcount ret_modeline_closest; |
| 2108 Lisp_Object ret_obj1, ret_obj2; | |
| 2109 | |
| 2110 CHECK_LIVE_EVENT (event); | |
| 934 | 2111 frame = XEVENT_CHANNEL (event); |
| 2112 switch (XEVENT_TYPE (event)) | |
| 2113 { | |
| 2114 case pointer_motion_event : | |
| 1204 | 2115 pix_x = XEVENT_MOTION_X (event); |
| 2116 pix_y = XEVENT_MOTION_Y (event); | |
| 934 | 2117 break; |
| 2118 case button_press_event : | |
| 2119 case button_release_event : | |
| 1204 | 2120 pix_x = XEVENT_BUTTON_X (event); |
| 2121 pix_y = XEVENT_BUTTON_Y (event); | |
| 934 | 2122 break; |
| 2123 case misc_user_event : | |
| 1204 | 2124 pix_x = XEVENT_MISC_USER_X (event); |
| 2125 pix_y = XEVENT_MISC_USER_Y (event); | |
| 934 | 2126 break; |
| 2127 default: | |
| 2128 dead_wrong_type_argument (Qmouse_event_p, event); | |
| 2129 } | |
| 428 | 2130 |
| 2131 result = pixel_to_glyph_translation (XFRAME (frame), pix_x, pix_y, | |
| 2132 &ret_x, &ret_y, &ret_obj_x, &ret_obj_y, | |
| 2133 &ret_w, &ret_bufp, &ret_closest, | |
| 2134 &ret_modeline_closest, | |
| 2135 &ret_obj1, &ret_obj2); | |
| 2136 | |
| 2137 if (result == OVER_NOTHING || result == OVER_OUTSIDE) | |
| 2138 ret_bufp = 0; | |
| 2139 else if (ret_w && NILP (ret_w->buffer)) | |
| 2140 /* Why does this happen? (Does it still happen?) | |
| 2141 I guess the window has gotten reused as a non-leaf... */ | |
| 2142 ret_w = 0; | |
| 2143 | |
| 2144 /* #### pixel_to_glyph_translation() sometimes returns garbage... | |
| 2145 The word has type Lisp_Type_Record (presumably meaning `extent') but the | |
| 2146 pointer points to random memory, often filled with 0, sometimes not. | |
| 2147 */ | |
| 2148 /* #### Chuck, do we still need this crap? */ | |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
2149 assert (NILP (ret_obj1) || GLYPHP (ret_obj1) |
| 428 | 2150 #ifdef HAVE_TOOLBARS |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
2151 || TOOLBAR_BUTTONP (ret_obj1) |
| 428 | 2152 #endif |
|
5050
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
2153 ); |
|
6f2158fa75ed
Fix quick-build, use asserts() in place of ABORT()
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
2154 assert (NILP (ret_obj2) || EXTENTP (ret_obj2) || CONSP (ret_obj2)); |
| 428 | 2155 |
| 2156 if (char_x) | |
| 2157 *char_x = ret_x; | |
| 2158 if (char_y) | |
| 2159 *char_y = ret_y; | |
| 2160 if (obj_x) | |
| 2161 *obj_x = ret_obj_x; | |
| 2162 if (obj_y) | |
| 2163 *obj_y = ret_obj_y; | |
| 2164 if (w) | |
| 2165 *w = ret_w; | |
| 2166 if (bufp) | |
| 2167 *bufp = ret_bufp; | |
| 2168 if (closest) | |
| 2169 *closest = ret_closest; | |
| 2170 if (modeline_closest) | |
| 2171 *modeline_closest = ret_modeline_closest; | |
| 2172 if (obj1) | |
| 2173 *obj1 = ret_obj1; | |
| 2174 if (obj2) | |
| 2175 *obj2 = ret_obj2; | |
| 2176 | |
| 2177 return result; | |
| 2178 } | |
| 2179 | |
| 2180 DEFUN ("event-over-text-area-p", Fevent_over_text_area_p, 1, 1, 0, /* | |
| 2181 Return t if the mouse event EVENT occurred over the text area of a window. | |
| 2182 The modeline is not considered to be part of the text area. | |
| 2183 */ | |
| 2184 (event)) | |
| 2185 { | |
| 2186 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
| 2187 | |
| 2188 return result == OVER_TEXT || result == OVER_NOTHING ? Qt : Qnil; | |
| 2189 } | |
| 2190 | |
| 2191 DEFUN ("event-over-modeline-p", Fevent_over_modeline_p, 1, 1, 0, /* | |
| 2192 Return t if the mouse event EVENT occurred over the modeline of a window. | |
| 2193 */ | |
| 2194 (event)) | |
| 2195 { | |
| 2196 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
| 2197 | |
| 2198 return result == OVER_MODELINE ? Qt : Qnil; | |
| 2199 } | |
| 2200 | |
| 2201 DEFUN ("event-over-border-p", Fevent_over_border_p, 1, 1, 0, /* | |
| 2202 Return t if the mouse event EVENT occurred over an internal border. | |
| 2203 */ | |
| 2204 (event)) | |
| 2205 { | |
| 2206 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
| 2207 | |
| 2208 return result == OVER_BORDER ? Qt : Qnil; | |
| 2209 } | |
| 2210 | |
| 2211 DEFUN ("event-over-toolbar-p", Fevent_over_toolbar_p, 1, 1, 0, /* | |
| 2212 Return t if the mouse event EVENT occurred over a toolbar. | |
| 2213 */ | |
| 2214 (event)) | |
| 2215 { | |
| 2216 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
| 2217 | |
| 2218 return result == OVER_TOOLBAR ? Qt : Qnil; | |
| 2219 } | |
| 2220 | |
| 2221 DEFUN ("event-over-vertical-divider-p", Fevent_over_vertical_divider_p, 1, 1, 0, /* | |
| 2222 Return t if the mouse event EVENT occurred over a window divider. | |
| 2223 */ | |
| 2224 (event)) | |
| 2225 { | |
| 2226 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
| 2227 | |
| 2228 return result == OVER_V_DIVIDER ? Qt : Qnil; | |
| 2229 } | |
| 2230 | |
| 2231 struct console * | |
| 2232 event_console_or_selected (Lisp_Object event) | |
| 2233 { | |
| 2234 Lisp_Object channel = EVENT_CHANNEL (XEVENT (event)); | |
| 2235 Lisp_Object console = CDFW_CONSOLE (channel); | |
| 2236 | |
| 2237 if (NILP (console)) | |
| 2238 console = Vselected_console; | |
| 2239 | |
| 2240 return XCONSOLE (console); | |
| 2241 } | |
| 2242 | |
| 2243 DEFUN ("event-channel", Fevent_channel, 1, 1, 0, /* | |
| 2244 Return the channel that the event EVENT occurred on. | |
| 2245 This will be a frame, device, console, or nil for some types | |
| 2246 of events (e.g. eval events). | |
| 2247 */ | |
| 2248 (event)) | |
| 2249 { | |
| 2250 CHECK_LIVE_EVENT (event); | |
| 2251 return EVENT_CHANNEL (XEVENT (event)); | |
| 2252 } | |
| 2253 | |
| 2254 DEFUN ("event-window", Fevent_window, 1, 1, 0, /* | |
| 2255 Return the window over which mouse event EVENT occurred. | |
| 2256 This may be nil if the event occurred in the border or over a toolbar. | |
| 2257 The modeline is considered to be within the window it describes. | |
| 2258 */ | |
| 2259 (event)) | |
| 2260 { | |
| 2261 struct window *w; | |
| 2262 | |
| 2263 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, 0); | |
| 2264 | |
| 2265 if (!w) | |
| 2266 return Qnil; | |
| 2267 else | |
| 2268 { | |
| 793 | 2269 return wrap_window (w); |
| 428 | 2270 } |
| 2271 } | |
| 2272 | |
| 2273 DEFUN ("event-point", Fevent_point, 1, 1, 0, /* | |
| 2274 Return the character position of the mouse event EVENT. | |
| 2275 If the event did not occur over a window, or did not occur over text, | |
| 2276 then this returns nil. Otherwise, it returns a position in the buffer | |
| 2277 visible in the event's window. | |
| 2278 */ | |
| 2279 (event)) | |
| 2280 { | |
| 665 | 2281 Charbpos bufp; |
| 428 | 2282 struct window *w; |
| 2283 | |
| 2284 event_pixel_translation (event, 0, 0, 0, 0, &w, &bufp, 0, 0, 0, 0); | |
| 2285 | |
| 2286 return w && bufp ? make_int (bufp) : Qnil; | |
| 2287 } | |
| 2288 | |
| 2289 DEFUN ("event-closest-point", Fevent_closest_point, 1, 1, 0, /* | |
| 2290 Return the character position closest to the mouse event EVENT. | |
| 2291 If the event did not occur over a window or over text, return the | |
| 2292 closest point to the location of the event. If the Y pixel position | |
| 2293 overlaps a window and the X pixel position is to the left of that | |
| 2294 window, the closest point is the beginning of the line containing the | |
| 2295 Y position. If the Y pixel position overlaps a window and the X pixel | |
| 2296 position is to the right of that window, the closest point is the end | |
| 2297 of the line containing the Y position. If the Y pixel position is | |
| 2298 above a window, return 0. If it is below the last character in a window, | |
| 2299 return the value of (window-end). | |
| 2300 */ | |
| 2301 (event)) | |
| 2302 { | |
| 665 | 2303 Charbpos bufp; |
| 428 | 2304 |
| 2305 event_pixel_translation (event, 0, 0, 0, 0, 0, 0, &bufp, 0, 0, 0); | |
| 2306 | |
| 2307 return bufp ? make_int (bufp) : Qnil; | |
| 2308 } | |
| 2309 | |
| 2310 DEFUN ("event-x", Fevent_x, 1, 1, 0, /* | |
| 2311 Return the X position of the mouse event EVENT in characters. | |
| 2312 This is relative to the window the event occurred over. | |
| 2313 */ | |
| 2314 (event)) | |
| 2315 { | |
| 2316 int char_x; | |
| 2317 | |
| 2318 event_pixel_translation (event, &char_x, 0, 0, 0, 0, 0, 0, 0, 0, 0); | |
| 2319 | |
| 2320 return make_int (char_x); | |
| 2321 } | |
| 2322 | |
| 2323 DEFUN ("event-y", Fevent_y, 1, 1, 0, /* | |
| 2324 Return the Y position of the mouse event EVENT in characters. | |
| 2325 This is relative to the window the event occurred over. | |
| 2326 */ | |
| 2327 (event)) | |
| 2328 { | |
| 2329 int char_y; | |
| 2330 | |
| 2331 event_pixel_translation (event, 0, &char_y, 0, 0, 0, 0, 0, 0, 0, 0); | |
| 2332 | |
| 2333 return make_int (char_y); | |
| 2334 } | |
| 2335 | |
| 2336 DEFUN ("event-modeline-position", Fevent_modeline_position, 1, 1, 0, /* | |
| 2337 Return the character position in the modeline that EVENT occurred over. | |
| 2338 EVENT should be a mouse event. If EVENT did not occur over a modeline, | |
| 2339 nil is returned. You can determine the actual character that the | |
| 2340 event occurred over by looking in `generated-modeline-string' at the | |
| 2341 returned character position. Note that `generated-modeline-string' | |
| 2342 is buffer-local, and you must use EVENT's buffer when retrieving | |
| 2343 `generated-modeline-string' in order to get accurate results. | |
| 2344 */ | |
| 2345 (event)) | |
| 2346 { | |
| 2347 Charcount mbufp; | |
| 2348 int where; | |
| 2349 | |
| 2350 where = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, &mbufp, 0, 0); | |
| 2351 | |
| 2352 return (mbufp < 0 || where != OVER_MODELINE) ? Qnil : make_int (mbufp); | |
| 2353 } | |
| 2354 | |
| 2355 DEFUN ("event-glyph", Fevent_glyph, 1, 1, 0, /* | |
| 2356 Return the glyph that the mouse event EVENT occurred over, or nil. | |
| 2357 */ | |
| 2358 (event)) | |
| 2359 { | |
| 2360 Lisp_Object glyph; | |
| 2361 struct window *w; | |
| 2362 | |
| 2363 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, &glyph, 0); | |
| 2364 | |
| 2365 return w && GLYPHP (glyph) ? glyph : Qnil; | |
| 2366 } | |
| 2367 | |
| 2368 DEFUN ("event-glyph-extent", Fevent_glyph_extent, 1, 1, 0, /* | |
| 2369 Return the extent of the glyph that the mouse event EVENT occurred over. | |
| 2370 If the event did not occur over a glyph, nil is returned. | |
| 2371 */ | |
| 2372 (event)) | |
| 2373 { | |
| 2374 Lisp_Object extent; | |
| 2375 struct window *w; | |
| 2376 | |
| 2377 event_pixel_translation (event, 0, 0, 0, 0, &w, 0, 0, 0, 0, &extent); | |
| 2378 | |
| 2379 return w && EXTENTP (extent) ? extent : Qnil; | |
| 2380 } | |
| 2381 | |
| 2382 DEFUN ("event-glyph-x-pixel", Fevent_glyph_x_pixel, 1, 1, 0, /* | |
| 2383 Return the X pixel position of EVENT relative to the glyph it occurred over. | |
| 2384 EVENT should be a mouse event. If the event did not occur over a glyph, | |
| 2385 nil is returned. | |
| 2386 */ | |
| 2387 (event)) | |
| 2388 { | |
| 2389 Lisp_Object extent; | |
| 2390 struct window *w; | |
| 2391 int obj_x; | |
| 2392 | |
| 2393 event_pixel_translation (event, 0, 0, &obj_x, 0, &w, 0, 0, 0, 0, &extent); | |
| 2394 | |
| 2395 return w && EXTENTP (extent) ? make_int (obj_x) : Qnil; | |
| 2396 } | |
| 2397 | |
| 2398 DEFUN ("event-glyph-y-pixel", Fevent_glyph_y_pixel, 1, 1, 0, /* | |
| 2399 Return the Y pixel position of EVENT relative to the glyph it occurred over. | |
| 2400 EVENT should be a mouse event. If the event did not occur over a glyph, | |
| 2401 nil is returned. | |
| 2402 */ | |
| 2403 (event)) | |
| 2404 { | |
| 2405 Lisp_Object extent; | |
| 2406 struct window *w; | |
| 2407 int obj_y; | |
| 2408 | |
| 2409 event_pixel_translation (event, 0, 0, 0, &obj_y, &w, 0, 0, 0, 0, &extent); | |
| 2410 | |
| 2411 return w && EXTENTP (extent) ? make_int (obj_y) : Qnil; | |
| 2412 } | |
| 2413 | |
| 2414 DEFUN ("event-toolbar-button", Fevent_toolbar_button, 1, 1, 0, /* | |
| 2415 Return the toolbar button that the mouse event EVENT occurred over. | |
| 2416 If the event did not occur over a toolbar button, nil is returned. | |
| 2417 */ | |
| 2340 | 2418 (USED_IF_TOOLBARS (event))) |
| 428 | 2419 { |
| 2420 #ifdef HAVE_TOOLBARS | |
| 2421 Lisp_Object button; | |
| 2422 | |
| 2423 int result = event_pixel_translation (event, 0, 0, 0, 0, 0, 0, 0, 0, &button, 0); | |
| 2424 | |
| 2425 return result == OVER_TOOLBAR && TOOLBAR_BUTTONP (button) ? button : Qnil; | |
| 2426 #else | |
| 2427 return Qnil; | |
| 2428 #endif | |
| 2429 } | |
| 2430 | |
| 2431 DEFUN ("event-process", Fevent_process, 1, 1, 0, /* | |
| 444 | 2432 Return the process of the process-output event EVENT. |
| 428 | 2433 */ |
| 2434 (event)) | |
| 2435 { | |
| 934 | 2436 CHECK_EVENT_TYPE (event, process_event, Qprocess_event_p); |
| 1204 | 2437 return XEVENT_PROCESS_PROCESS (event); |
| 428 | 2438 } |
| 2439 | |
| 2440 DEFUN ("event-function", Fevent_function, 1, 1, 0, /* | |
| 2441 Return the callback function of EVENT. | |
| 2442 EVENT should be a timeout, misc-user, or eval event. | |
| 2443 */ | |
| 2444 (event)) | |
| 2445 { | |
| 2446 again: | |
| 2447 CHECK_LIVE_EVENT (event); | |
| 934 | 2448 switch (XEVENT_TYPE (event)) |
| 2449 { | |
| 2450 case timeout_event: | |
| 1204 | 2451 return XEVENT_TIMEOUT_FUNCTION (event); |
| 934 | 2452 case misc_user_event: |
| 1204 | 2453 return XEVENT_MISC_USER_FUNCTION (event); |
| 934 | 2454 case eval_event: |
| 1204 | 2455 return XEVENT_EVAL_FUNCTION (event); |
| 934 | 2456 default: |
| 2457 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event); | |
| 2458 goto again; | |
| 2459 } | |
| 428 | 2460 } |
| 2461 | |
| 2462 DEFUN ("event-object", Fevent_object, 1, 1, 0, /* | |
| 2463 Return the callback function argument of EVENT. | |
| 2464 EVENT should be a timeout, misc-user, or eval event. | |
| 2465 */ | |
| 2466 (event)) | |
| 2467 { | |
| 2468 again: | |
| 2469 CHECK_LIVE_EVENT (event); | |
| 934 | 2470 switch (XEVENT_TYPE (event)) |
| 2471 { | |
| 2472 case timeout_event: | |
| 1204 | 2473 return XEVENT_TIMEOUT_OBJECT (event); |
| 934 | 2474 case misc_user_event: |
| 1204 | 2475 return XEVENT_MISC_USER_OBJECT (event); |
| 934 | 2476 case eval_event: |
| 1204 | 2477 return XEVENT_EVAL_OBJECT (event); |
| 934 | 2478 default: |
| 2479 event = wrong_type_argument (intern ("timeout-or-eval-event-p"), event); | |
| 2480 goto again; | |
| 2481 } | |
| 428 | 2482 } |
| 2483 | |
| 2484 DEFUN ("event-properties", Fevent_properties, 1, 1, 0, /* | |
| 2485 Return a list of all of the properties of EVENT. | |
| 2486 This is in the form of a property list (alternating keyword/value pairs). | |
| 2487 */ | |
| 2488 (event)) | |
| 2489 { | |
| 2490 Lisp_Object props = Qnil; | |
| 440 | 2491 Lisp_Event *e; |
| 428 | 2492 struct gcpro gcpro1; |
| 2493 | |
| 2494 CHECK_LIVE_EVENT (event); | |
| 2495 e = XEVENT (event); | |
| 2496 GCPRO1 (props); | |
| 2497 | |
| 2498 props = cons3 (Qtimestamp, Fevent_timestamp (event), props); | |
| 2499 | |
| 934 | 2500 switch (EVENT_TYPE (e)) |
| 428 | 2501 { |
| 2500 | 2502 default: ABORT (); |
| 428 | 2503 |
| 2504 case process_event: | |
| 1204 | 2505 props = cons3 (Qprocess, EVENT_PROCESS_PROCESS (e), props); |
| 428 | 2506 break; |
| 2507 | |
| 2508 case timeout_event: | |
| 2509 props = cons3 (Qobject, Fevent_object (event), props); | |
| 2510 props = cons3 (Qfunction, Fevent_function (event), props); | |
| 1204 | 2511 props = cons3 (Qid, make_int (EVENT_TIMEOUT_ID_NUMBER (e)), props); |
| 428 | 2512 break; |
| 2513 | |
| 2514 case key_press_event: | |
| 2515 props = cons3 (Qmodifiers, Fevent_modifiers (event), props); | |
| 2516 props = cons3 (Qkey, Fevent_key (event), props); | |
| 2517 break; | |
| 2518 | |
| 2519 case button_press_event: | |
| 2520 case button_release_event: | |
| 2521 props = cons3 (Qy, Fevent_y_pixel (event), props); | |
| 2522 props = cons3 (Qx, Fevent_x_pixel (event), props); | |
| 2523 props = cons3 (Qmodifiers, Fevent_modifiers (event), props); | |
| 2524 props = cons3 (Qbutton, Fevent_button (event), props); | |
| 2525 break; | |
| 2526 | |
| 2527 case pointer_motion_event: | |
| 2528 props = cons3 (Qmodifiers, Fevent_modifiers (event), props); | |
| 2529 props = cons3 (Qy, Fevent_y_pixel (event), props); | |
| 2530 props = cons3 (Qx, Fevent_x_pixel (event), props); | |
| 2531 break; | |
| 2532 | |
| 2533 case misc_user_event: | |
| 2534 props = cons3 (Qobject, Fevent_object (event), props); | |
| 2535 props = cons3 (Qfunction, Fevent_function (event), props); | |
| 2536 props = cons3 (Qy, Fevent_y_pixel (event), props); | |
| 2537 props = cons3 (Qx, Fevent_x_pixel (event), props); | |
| 2538 props = cons3 (Qmodifiers, Fevent_modifiers (event), props); | |
| 2539 props = cons3 (Qbutton, Fevent_button (event), props); | |
| 2540 break; | |
| 2541 | |
| 2542 case eval_event: | |
| 2543 props = cons3 (Qobject, Fevent_object (event), props); | |
| 2544 props = cons3 (Qfunction, Fevent_function (event), props); | |
| 2545 break; | |
| 2546 | |
| 2547 case magic_eval_event: | |
| 2548 case magic_event: | |
| 2549 break; | |
| 2550 | |
| 2551 case empty_event: | |
| 2552 RETURN_UNGCPRO (Qnil); | |
| 2553 break; | |
| 2554 } | |
| 2555 | |
| 2556 props = cons3 (Qchannel, Fevent_channel (event), props); | |
| 2557 UNGCPRO; | |
| 2558 | |
| 2559 return props; | |
| 2560 } | |
| 2561 | |
| 2562 | |
| 2563 /************************************************************************/ | |
| 2564 /* initialization */ | |
| 2565 /************************************************************************/ | |
| 2566 | |
| 2567 void | |
| 2568 syms_of_events (void) | |
| 2569 { | |
| 442 | 2570 INIT_LRECORD_IMPLEMENTATION (event); |
| 1204 | 2571 #ifdef EVENT_DATA_AS_OBJECTS |
| 934 | 2572 INIT_LRECORD_IMPLEMENTATION (key_data); |
| 2573 INIT_LRECORD_IMPLEMENTATION (button_data); | |
| 2574 INIT_LRECORD_IMPLEMENTATION (motion_data); | |
| 2575 INIT_LRECORD_IMPLEMENTATION (process_data); | |
| 2576 INIT_LRECORD_IMPLEMENTATION (timeout_data); | |
| 2577 INIT_LRECORD_IMPLEMENTATION (eval_data); | |
| 2578 INIT_LRECORD_IMPLEMENTATION (misc_user_data); | |
| 2579 INIT_LRECORD_IMPLEMENTATION (magic_eval_data); | |
| 2580 INIT_LRECORD_IMPLEMENTATION (magic_data); | |
| 1204 | 2581 #endif /* EVENT_DATA_AS_OBJECTS */ |
| 442 | 2582 |
| 428 | 2583 DEFSUBR (Fcharacter_to_event); |
| 2584 DEFSUBR (Fevent_to_character); | |
| 2585 | |
| 2586 DEFSUBR (Fmake_event); | |
| 2587 DEFSUBR (Fdeallocate_event); | |
| 2588 DEFSUBR (Fcopy_event); | |
| 2589 DEFSUBR (Feventp); | |
| 2590 DEFSUBR (Fevent_live_p); | |
| 2591 DEFSUBR (Fevent_type); | |
| 2592 DEFSUBR (Fevent_properties); | |
| 2593 | |
| 2594 DEFSUBR (Fevent_timestamp); | |
| 442 | 2595 DEFSUBR (Fevent_timestamp_lessp); |
| 428 | 2596 DEFSUBR (Fevent_key); |
| 2597 DEFSUBR (Fevent_button); | |
| 2598 DEFSUBR (Fevent_modifier_bits); | |
| 2599 DEFSUBR (Fevent_modifiers); | |
| 2600 DEFSUBR (Fevent_x_pixel); | |
| 2601 DEFSUBR (Fevent_y_pixel); | |
| 2602 DEFSUBR (Fevent_window_x_pixel); | |
| 2603 DEFSUBR (Fevent_window_y_pixel); | |
| 2604 DEFSUBR (Fevent_over_text_area_p); | |
| 2605 DEFSUBR (Fevent_over_modeline_p); | |
| 2606 DEFSUBR (Fevent_over_border_p); | |
| 2607 DEFSUBR (Fevent_over_toolbar_p); | |
| 2608 DEFSUBR (Fevent_over_vertical_divider_p); | |
| 2609 DEFSUBR (Fevent_channel); | |
| 2610 DEFSUBR (Fevent_window); | |
| 2611 DEFSUBR (Fevent_point); | |
| 2612 DEFSUBR (Fevent_closest_point); | |
| 2613 DEFSUBR (Fevent_x); | |
| 2614 DEFSUBR (Fevent_y); | |
| 2615 DEFSUBR (Fevent_modeline_position); | |
| 2616 DEFSUBR (Fevent_glyph); | |
| 2617 DEFSUBR (Fevent_glyph_extent); | |
| 2618 DEFSUBR (Fevent_glyph_x_pixel); | |
| 2619 DEFSUBR (Fevent_glyph_y_pixel); | |
| 2620 DEFSUBR (Fevent_toolbar_button); | |
| 2621 DEFSUBR (Fevent_process); | |
| 2622 DEFSUBR (Fevent_function); | |
| 2623 DEFSUBR (Fevent_object); | |
| 2624 | |
| 563 | 2625 DEFSYMBOL (Qeventp); |
| 2626 DEFSYMBOL (Qevent_live_p); | |
| 2627 DEFSYMBOL (Qkey_press_event_p); | |
| 2628 DEFSYMBOL (Qbutton_event_p); | |
| 2629 DEFSYMBOL (Qmouse_event_p); | |
| 2630 DEFSYMBOL (Qprocess_event_p); | |
| 2631 DEFSYMBOL (Qkey_press); | |
| 2632 DEFSYMBOL (Qbutton_press); | |
| 2633 DEFSYMBOL (Qbutton_release); | |
| 2634 DEFSYMBOL (Qmisc_user); | |
| 2828 | 2635 DEFSYMBOL (Qcharacter_of_keysym); |
| 563 | 2636 DEFSYMBOL (Qascii_character); |
| 428 | 2637 |
| 2638 defsymbol (&QKbackspace, "backspace"); | |
| 2639 defsymbol (&QKtab, "tab"); | |
| 2640 defsymbol (&QKlinefeed, "linefeed"); | |
| 2641 defsymbol (&QKreturn, "return"); | |
| 2642 defsymbol (&QKescape, "escape"); | |
| 2643 defsymbol (&QKspace, "space"); | |
| 2644 defsymbol (&QKdelete, "delete"); | |
| 2645 } | |
| 2646 | |
| 2647 | |
| 2648 void | |
| 2649 reinit_vars_of_events (void) | |
| 2650 { | |
| 2651 Vevent_resource = Qnil; | |
| 3092 | 2652 #ifdef NEW_GC |
| 2653 staticpro (&Vevent_resource); | |
| 2654 #endif /* NEW_GC */ | |
| 428 | 2655 } |
| 2656 | |
| 2657 void | |
| 2658 vars_of_events (void) | |
| 2659 { | |
| 2660 } |