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