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