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