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