Mercurial > hg > xemacs-beta
annotate src/keymap.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 | a98ca4640147 |
| children | 304aebb79cd3 |
| rev | line source |
|---|---|
| 428 | 1 /* Manipulation of keymaps |
| 2 Copyright (C) 1985, 1991-1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Board of Trustees, University of Illinois. | |
| 4 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 793 | 5 Copyright (C) 2001, 2002 Ben Wing. |
| 428 | 6 Totally redesigned by jwz in 1991. |
| 7 | |
| 8 This file is part of XEmacs. | |
| 9 | |
| 10 XEmacs is free software; you can redistribute it and/or modify it | |
| 11 under the terms of the GNU General Public License as published by the | |
| 12 Free Software Foundation; either version 2, or (at your option) any | |
| 13 later version. | |
| 14 | |
| 15 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 18 for more details. | |
| 19 | |
| 20 You should have received a copy of the GNU General Public License | |
| 21 along with XEmacs; see the file COPYING. If not, write to | |
| 22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 23 Boston, MA 02111-1307, USA. */ | |
| 24 | |
| 25 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially | |
| 26 different from FSF. */ | |
| 27 | |
| 28 | |
| 29 #include <config.h> | |
| 30 #include "lisp.h" | |
| 31 | |
| 32 #include "buffer.h" | |
| 33 #include "bytecode.h" | |
| 872 | 34 #include "console-impl.h" |
| 428 | 35 #include "elhash.h" |
| 36 #include "events.h" | |
| 872 | 37 #include "extents.h" |
| 428 | 38 #include "frame.h" |
| 39 #include "insdel.h" | |
| 40 #include "keymap.h" | |
| 41 #include "window.h" | |
| 42 | |
| 43 | |
| 44 /* A keymap contains six slots: | |
| 45 | |
| 46 parents Ordered list of keymaps to search after | |
| 47 this one if no match is found. | |
| 48 Keymaps can thus be arranged in a hierarchy. | |
| 49 | |
| 50 table A hash table, hashing keysyms to their bindings. | |
| 51 It will be one of the following: | |
| 52 | |
| 3025 | 53 -- a symbol, e.g. `home' |
| 428 | 54 -- a character, representing something printable |
| 55 (not ?\C-c meaning C-c, for instance) | |
| 56 -- an integer representing a modifier combination | |
| 57 | |
| 58 inverse_table A hash table, hashing bindings to the list of keysyms | |
| 59 in this keymap which are bound to them. This is to make | |
| 60 the Fwhere_is_internal() function be fast. It needs to be | |
| 61 fast because we want to be able to call it in realtime to | |
| 62 update the keyboard-equivalents on the pulldown menus. | |
| 63 Values of the table are either atoms (keysyms) | |
| 64 or a dotted list of keysyms. | |
| 65 | |
| 66 sub_maps_cache An alist; for each entry in this keymap whose binding is | |
| 67 a keymap (that is, Fkeymapp()) this alist associates that | |
| 68 keysym with that binding. This is used to optimize both | |
| 69 Fwhere_is_internal() and Faccessible_keymaps(). This slot | |
| 70 gets set to the symbol `t' every time a change is made to | |
| 71 this keymap, causing it to be recomputed when next needed. | |
| 72 | |
| 73 prompt See `set-keymap-prompt'. | |
| 74 | |
| 75 default_binding See `set-keymap-default-binding'. | |
| 76 | |
| 77 Sequences of keys are stored in the obvious way: if the sequence of keys | |
| 78 "abc" was bound to some command `foo', the hierarchy would look like | |
| 79 | |
| 80 keymap-1: associates "a" with keymap-2 | |
| 81 keymap-2: associates "b" with keymap-3 | |
| 82 keymap-3: associates "c" with foo | |
| 83 | |
| 84 However, bucky bits ("modifiers" to the X-minded) are represented in the | |
| 85 keymap hierarchy as well. (This lets us use EQable objects as hash keys.) | |
| 86 Each combination of modifiers (e.g. control-hyper) gets its own submap | |
| 87 off of the main map. The hash key for a modifier combination is | |
| 88 an integer, computed by MAKE_MODIFIER_HASH_KEY(). | |
| 89 | |
| 90 If the key `C-a' was bound to some command, the hierarchy would look like | |
| 91 | |
| 442 | 92 keymap-1: associates the integer XEMACS_MOD_CONTROL with keymap-2 |
| 428 | 93 keymap-2: associates "a" with the command |
| 94 | |
| 95 Similarly, if the key `C-H-a' was bound to some command, the hierarchy | |
| 96 would look like | |
| 97 | |
| 442 | 98 keymap-1: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER) |
| 428 | 99 with keymap-2 |
| 100 keymap-2: associates "a" with the command | |
| 101 | |
| 102 Note that a special exception is made for the meta modifier, in order | |
| 103 to deal with ESC/meta lossage. Any key combination containing the | |
| 104 meta modifier is first indexed off of the main map into the meta | |
| 442 | 105 submap (with hash key XEMACS_MOD_META) and then indexed off of the |
| 428 | 106 meta submap with the meta modifier removed from the key combination. |
| 107 For example, when associating a command with C-M-H-a, we'd have | |
| 108 | |
| 442 | 109 keymap-1: associates the integer XEMACS_MOD_META with keymap-2 |
| 110 keymap-2: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER) | |
| 428 | 111 with keymap-3 |
| 112 keymap-3: associates "a" with the command | |
| 113 | |
| 114 Note that keymap-2 might have normal bindings in it; these would be | |
| 115 for key combinations containing only the meta modifier, such as | |
| 116 M-y or meta-backspace. | |
| 117 | |
| 118 If the command that "a" was bound to in keymap-3 was itself a keymap, | |
| 119 then that would make the key "C-M-H-a" be a prefix character. | |
| 120 | |
| 121 Note that this new model of keymaps takes much of the magic away from | |
| 122 the Escape key: the value of the variable `esc-map' is no longer indexed | |
| 123 in the `global-map' under the ESC key. It's indexed under the integer | |
| 442 | 124 XEMACS_MOD_META. This is not user-visible, however; none of the "bucky" |
| 428 | 125 maps are. |
| 126 | |
| 127 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[") | |
| 128 and (define-key some-random-map "\^[" my-esc-map) work as before, for | |
| 129 compatibility. | |
| 130 | |
| 131 Since keymaps are opaque, the only way to extract information from them | |
| 132 is with the functions lookup-key, key-binding, local-key-binding, and | |
| 133 global-key-binding, which work just as before, and the new function | |
| 440 | 134 map-keymap, which is roughly analogous to maphash. |
| 428 | 135 |
| 136 Note that map-keymap perpetuates the illusion that the "bucky" submaps | |
| 137 don't exist: if you map over a keymap with bucky submaps, it will also | |
| 138 map over those submaps. It does not, however, map over other random | |
| 139 submaps of the keymap, just the bucky ones. | |
| 140 | |
| 141 One implication of this is that when you map over `global-map', you will | |
| 142 also map over `esc-map'. It is merely for compatibility that the esc-map | |
| 143 is accessible at all; I think that's a bad thing, since it blurs the | |
| 144 distinction between ESC and "meta" even more. "M-x" is no more a two- | |
| 145 key sequence than "C-x" is. | |
| 146 | |
| 147 */ | |
| 148 | |
| 440 | 149 struct Lisp_Keymap |
| 428 | 150 { |
| 3017 | 151 struct LCRECORD_HEADER header; |
| 440 | 152 Lisp_Object parents; /* Keymaps to be searched after this one. |
| 153 An ordered list */ | |
| 428 | 154 Lisp_Object prompt; /* Qnil or a string to print in the minibuffer |
| 440 | 155 when reading from this keymap */ |
| 428 | 156 Lisp_Object table; /* The contents of this keymap */ |
| 157 Lisp_Object inverse_table; /* The inverse mapping of the above */ | |
| 158 Lisp_Object default_binding; /* Use this if no other binding is found | |
| 440 | 159 (this overrides parent maps and the |
| 160 normal global-map lookup). */ | |
| 428 | 161 Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps; |
| 162 This holds an alist, of the key and the | |
| 163 maps, or the modifier bit and the map. | |
| 164 If this is the symbol t, then the cache | |
| 440 | 165 needs to be recomputed. */ |
| 428 | 166 Lisp_Object name; /* Just for debugging convenience */ |
| 440 | 167 }; |
| 428 | 168 |
| 169 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier) | |
| 170 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0) | |
| 171 | |
| 172 | |
| 173 | |
| 174 /* Actually allocate storage for these variables */ | |
| 175 | |
| 440 | 176 Lisp_Object Vcurrent_global_map; /* Always a keymap */ |
| 428 | 177 |
| 771 | 178 static Lisp_Object Vglobal_tty_map, Vglobal_window_system_map; |
| 179 | |
| 428 | 180 static Lisp_Object Vmouse_grabbed_buffer; |
| 181 | |
| 182 /* Alist of minor mode variables and keymaps. */ | |
| 183 static Lisp_Object Qminor_mode_map_alist; | |
| 184 | |
| 185 static Lisp_Object Voverriding_local_map; | |
| 186 | |
| 187 static Lisp_Object Vkey_translation_map; | |
| 188 | |
| 189 static Lisp_Object Vvertical_divider_map; | |
| 190 | |
| 191 /* This is incremented whenever a change is made to a keymap. This is | |
| 192 so that things which care (such as the menubar code) can recompute | |
| 193 privately-cached data when the user has changed keybindings. | |
| 194 */ | |
| 458 | 195 Fixnum keymap_tick; |
| 428 | 196 |
| 197 /* Prefixing a key with this character is the same as sending a meta bit. */ | |
| 198 Lisp_Object Vmeta_prefix_char; | |
| 199 | |
| 200 Lisp_Object Qkeymapp; | |
| 201 Lisp_Object Vsingle_space_string; | |
| 202 Lisp_Object Qsuppress_keymap; | |
| 203 Lisp_Object Qmodeline_map; | |
| 204 Lisp_Object Qtoolbar_map; | |
| 205 | |
| 206 EXFUN (Fkeymap_fullness, 1); | |
| 207 EXFUN (Fset_keymap_name, 2); | |
| 208 EXFUN (Fsingle_key_description, 1); | |
| 209 | |
| 210 static void describe_command (Lisp_Object definition, Lisp_Object buffer); | |
| 211 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, | |
| 212 void (*elt_describer) (Lisp_Object, Lisp_Object), | |
| 213 int partial, | |
| 214 Lisp_Object shadow, | |
| 215 int mice_only_p, | |
| 216 Lisp_Object buffer); | |
| 440 | 217 static Lisp_Object keymap_submaps (Lisp_Object keymap); |
| 428 | 218 |
| 219 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift; | |
| 4272 | 220 Lisp_Object Qbutton0; |
| 221 Lisp_Object Qbutton1, Qbutton2, Qbutton3, Qbutton4, Qbutton5; | |
| 222 Lisp_Object Qbutton6, Qbutton7, Qbutton8, Qbutton9, Qbutton10; | |
| 223 Lisp_Object Qbutton11, Qbutton12, Qbutton13, Qbutton14, Qbutton15; | |
| 224 Lisp_Object Qbutton16, Qbutton17, Qbutton18, Qbutton19, Qbutton20; | |
| 225 Lisp_Object Qbutton21, Qbutton22, Qbutton23, Qbutton24, Qbutton25; | |
| 226 Lisp_Object Qbutton26; | |
| 227 Lisp_Object Qbutton0up; | |
| 228 Lisp_Object Qbutton1up, Qbutton2up, Qbutton3up, Qbutton4up, Qbutton5up; | |
| 229 Lisp_Object Qbutton6up, Qbutton7up, Qbutton8up, Qbutton9up, Qbutton10up; | |
| 230 Lisp_Object Qbutton11up, Qbutton12up, Qbutton13up, Qbutton14up, Qbutton15up; | |
| 231 Lisp_Object Qbutton16up, Qbutton17up, Qbutton18up, Qbutton19up, Qbutton20up; | |
| 232 Lisp_Object Qbutton21up, Qbutton22up, Qbutton23up, Qbutton24up, Qbutton25up; | |
| 233 Lisp_Object Qbutton26up; | |
| 428 | 234 |
| 235 Lisp_Object Qmenu_selection; | |
| 236 /* Emacs compatibility */ | |
| 458 | 237 Lisp_Object Qdown_mouse_1, Qmouse_1; |
| 238 Lisp_Object Qdown_mouse_2, Qmouse_2; | |
| 239 Lisp_Object Qdown_mouse_3, Qmouse_3; | |
| 240 Lisp_Object Qdown_mouse_4, Qmouse_4; | |
| 241 Lisp_Object Qdown_mouse_5, Qmouse_5; | |
| 242 Lisp_Object Qdown_mouse_6, Qmouse_6; | |
| 243 Lisp_Object Qdown_mouse_7, Qmouse_7; | |
| 4272 | 244 Lisp_Object Qdown_mouse_8, Qmouse_8; |
| 245 Lisp_Object Qdown_mouse_9, Qmouse_9; | |
| 246 Lisp_Object Qdown_mouse_10, Qmouse_10; | |
| 247 Lisp_Object Qdown_mouse_11, Qmouse_11; | |
| 248 Lisp_Object Qdown_mouse_12, Qmouse_12; | |
| 249 Lisp_Object Qdown_mouse_13, Qmouse_13; | |
| 250 Lisp_Object Qdown_mouse_14, Qmouse_14; | |
| 251 Lisp_Object Qdown_mouse_15, Qmouse_15; | |
| 252 Lisp_Object Qdown_mouse_16, Qmouse_16; | |
| 253 Lisp_Object Qdown_mouse_17, Qmouse_17; | |
| 254 Lisp_Object Qdown_mouse_18, Qmouse_18; | |
| 255 Lisp_Object Qdown_mouse_19, Qmouse_19; | |
| 256 Lisp_Object Qdown_mouse_20, Qmouse_20; | |
| 257 Lisp_Object Qdown_mouse_21, Qmouse_21; | |
| 258 Lisp_Object Qdown_mouse_22, Qmouse_22; | |
| 259 Lisp_Object Qdown_mouse_23, Qmouse_23; | |
| 260 Lisp_Object Qdown_mouse_24, Qmouse_24; | |
| 261 Lisp_Object Qdown_mouse_25, Qmouse_25; | |
| 262 Lisp_Object Qdown_mouse_26, Qmouse_26; | |
| 428 | 263 |
| 264 /* Kludge kludge kludge */ | |
| 265 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS; | |
| 266 | |
| 267 | |
| 268 /************************************************************************/ | |
| 269 /* The keymap Lisp object */ | |
| 270 /************************************************************************/ | |
| 271 | |
| 272 static Lisp_Object | |
| 273 mark_keymap (Lisp_Object obj) | |
| 274 { | |
| 275 Lisp_Keymap *keymap = XKEYMAP (obj); | |
| 276 mark_object (keymap->parents); | |
| 277 mark_object (keymap->prompt); | |
| 278 mark_object (keymap->inverse_table); | |
| 279 mark_object (keymap->sub_maps_cache); | |
| 280 mark_object (keymap->default_binding); | |
| 281 mark_object (keymap->name); | |
| 282 return keymap->table; | |
| 283 } | |
| 284 | |
| 285 static void | |
| 2286 | 286 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, |
| 287 int UNUSED (escapeflag)) | |
| 428 | 288 { |
| 289 /* This function can GC */ | |
| 290 Lisp_Keymap *keymap = XKEYMAP (obj); | |
| 291 if (print_readably) | |
| 4846 | 292 printing_unreadable_lcrecord (obj, 0); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
293 write_ascstring (printcharfun, "#<keymap "); |
| 428 | 294 if (!NILP (keymap->name)) |
| 440 | 295 { |
| 800 | 296 write_fmt_string_lisp (printcharfun, "%S ", 1, keymap->name); |
| 440 | 297 } |
| 800 | 298 write_fmt_string (printcharfun, "size %ld 0x%x>", |
| 299 (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid); | |
| 428 | 300 } |
| 301 | |
| 1204 | 302 static const struct memory_description keymap_description[] = { |
| 440 | 303 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, parents) }, |
| 304 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, prompt) }, | |
| 305 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, table) }, | |
| 306 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, inverse_table) }, | |
| 307 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, default_binding) }, | |
| 308 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, sub_maps_cache) }, | |
| 309 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, name) }, | |
| 428 | 310 { XD_END } |
| 311 }; | |
| 312 | |
| 313 /* No need for keymap_equal #### Why not? */ | |
| 934 | 314 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap, |
| 315 1, /*dumpable-flag*/ | |
| 316 mark_keymap, print_keymap, 0, 0, 0, | |
| 317 keymap_description, | |
| 318 Lisp_Keymap); | |
| 428 | 319 |
| 320 /************************************************************************/ | |
| 321 /* Traversing keymaps and their parents */ | |
| 322 /************************************************************************/ | |
| 323 | |
| 324 static Lisp_Object | |
| 325 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents, | |
| 326 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg), | |
| 327 void *mapper_arg) | |
| 328 { | |
| 329 /* This function can GC */ | |
| 330 Lisp_Object keymap; | |
| 331 Lisp_Object tail = start_parents; | |
| 332 Lisp_Object malloc_sucks[10]; | |
| 333 Lisp_Object malloc_bites = Qnil; | |
| 334 int stack_depth = 0; | |
| 335 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 336 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail); | |
| 337 gcpro1.nvars = 0; | |
| 338 | |
| 339 start_keymap = get_keymap (start_keymap, 1, 1); | |
| 340 keymap = start_keymap; | |
| 341 /* Hack special-case parents at top-level */ | |
| 440 | 342 tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents; |
| 428 | 343 |
| 344 for (;;) | |
| 345 { | |
| 346 Lisp_Object result; | |
| 347 | |
| 348 QUIT; | |
| 440 | 349 result = mapper (keymap, mapper_arg); |
| 428 | 350 if (!NILP (result)) |
| 351 { | |
| 352 while (CONSP (malloc_bites)) | |
| 353 { | |
| 853 | 354 Lisp_Object victim = malloc_bites; |
| 355 malloc_bites = XCDR (victim); | |
| 428 | 356 free_cons (victim); |
| 357 } | |
| 358 UNGCPRO; | |
| 359 return result; | |
| 360 } | |
| 361 if (NILP (tail)) | |
| 362 { | |
| 363 if (stack_depth == 0) | |
| 364 { | |
| 365 UNGCPRO; | |
| 366 return Qnil; /* Nothing found */ | |
| 367 } | |
| 368 stack_depth--; | |
| 369 if (CONSP (malloc_bites)) | |
| 370 { | |
| 853 | 371 Lisp_Object victim = malloc_bites; |
| 372 tail = XCAR (victim); | |
| 373 malloc_bites = XCDR (victim); | |
| 428 | 374 free_cons (victim); |
| 375 } | |
| 376 else | |
| 377 { | |
| 378 tail = malloc_sucks[stack_depth]; | |
| 379 gcpro1.nvars = stack_depth; | |
| 380 } | |
| 381 keymap = XCAR (tail); | |
| 382 tail = XCDR (tail); | |
| 383 } | |
| 384 else | |
| 385 { | |
| 386 Lisp_Object parents; | |
| 387 | |
| 388 keymap = XCAR (tail); | |
| 389 tail = XCDR (tail); | |
| 390 parents = XKEYMAP (keymap)->parents; | |
| 391 if (!CONSP (parents)) | |
| 392 ; | |
| 393 else if (NILP (tail)) | |
| 394 /* Tail-recurse */ | |
| 395 tail = parents; | |
| 396 else | |
| 397 { | |
| 398 if (CONSP (malloc_bites)) | |
| 399 malloc_bites = noseeum_cons (tail, malloc_bites); | |
| 400 else if (stack_depth < countof (malloc_sucks)) | |
| 401 { | |
| 402 malloc_sucks[stack_depth++] = tail; | |
| 403 gcpro1.nvars = stack_depth; | |
| 404 } | |
| 405 else | |
| 406 { | |
| 407 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */ | |
| 408 int i; | |
| 409 for (i = 0, malloc_bites = Qnil; | |
| 410 i < countof (malloc_sucks); | |
| 411 i++) | |
| 412 malloc_bites = noseeum_cons (malloc_sucks[i], | |
| 413 malloc_bites); | |
| 414 gcpro1.nvars = 0; | |
| 415 } | |
| 416 tail = parents; | |
| 417 } | |
| 418 } | |
| 419 keymap = get_keymap (keymap, 1, 1); | |
| 420 if (EQ (keymap, start_keymap)) | |
| 421 { | |
| 563 | 422 invalid_argument ("Cyclic keymap indirection", start_keymap); |
| 428 | 423 } |
| 424 } | |
| 425 } | |
| 426 | |
| 427 | |
| 428 /************************************************************************/ | |
| 429 /* Some low-level functions */ | |
| 430 /************************************************************************/ | |
| 431 | |
| 442 | 432 static int |
| 428 | 433 bucky_sym_to_bucky_bit (Lisp_Object sym) |
| 434 { | |
| 442 | 435 if (EQ (sym, Qcontrol)) return XEMACS_MOD_CONTROL; |
| 436 if (EQ (sym, Qmeta)) return XEMACS_MOD_META; | |
| 437 if (EQ (sym, Qsuper)) return XEMACS_MOD_SUPER; | |
| 438 if (EQ (sym, Qhyper)) return XEMACS_MOD_HYPER; | |
| 439 if (EQ (sym, Qalt)) return XEMACS_MOD_ALT; | |
| 440 if (EQ (sym, Qsymbol)) return XEMACS_MOD_ALT; /* #### - reverse compat */ | |
| 441 if (EQ (sym, Qshift)) return XEMACS_MOD_SHIFT; | |
| 428 | 442 |
| 443 return 0; | |
| 444 } | |
| 445 | |
| 446 static Lisp_Object | |
| 442 | 447 control_meta_superify (Lisp_Object frob, int modifiers) |
| 428 | 448 { |
| 449 if (modifiers == 0) | |
| 450 return frob; | |
| 451 frob = Fcons (frob, Qnil); | |
| 442 | 452 if (modifiers & XEMACS_MOD_SHIFT) frob = Fcons (Qshift, frob); |
| 453 if (modifiers & XEMACS_MOD_ALT) frob = Fcons (Qalt, frob); | |
| 454 if (modifiers & XEMACS_MOD_HYPER) frob = Fcons (Qhyper, frob); | |
| 455 if (modifiers & XEMACS_MOD_SUPER) frob = Fcons (Qsuper, frob); | |
| 456 if (modifiers & XEMACS_MOD_CONTROL) frob = Fcons (Qcontrol, frob); | |
| 457 if (modifiers & XEMACS_MOD_META) frob = Fcons (Qmeta, frob); | |
| 428 | 458 return frob; |
| 459 } | |
| 460 | |
| 461 static Lisp_Object | |
| 934 | 462 make_key_description (const Lisp_Key_Data *key, int prettify) |
| 463 { | |
| 1204 | 464 Lisp_Object keysym = KEY_DATA_KEYSYM (key); |
| 934 | 465 int modifiers = KEY_DATA_MODIFIERS (key); |
| 428 | 466 if (prettify && CHARP (keysym)) |
| 467 { | |
| 468 /* This is a little slow, but (control a) is prettier than (control 65). | |
| 469 It's now ok to do this for digit-chars too, since we've fixed the | |
| 470 bug where \9 read as the integer 9 instead of as the symbol with | |
| 471 "9" as its name. | |
| 472 */ | |
| 473 /* !!#### I'm not sure how correct this is. */ | |
| 867 | 474 Ibyte str [1 + MAX_ICHAR_LEN]; |
| 475 Bytecount count = set_itext_ichar (str, XCHAR (keysym)); | |
| 428 | 476 str[count] = 0; |
| 771 | 477 keysym = intern_int (str); |
| 428 | 478 } |
| 479 return control_meta_superify (keysym, modifiers); | |
| 480 } | |
| 481 | |
| 482 | |
| 483 /************************************************************************/ | |
| 484 /* Low-level keymap-store functions */ | |
| 485 /************************************************************************/ | |
| 486 | |
| 487 static Lisp_Object | |
| 488 raw_lookup_key (Lisp_Object keymap, | |
| 934 | 489 const Lisp_Key_Data *raw_keys, int raw_keys_count, |
| 428 | 490 int keys_so_far, int accept_default); |
| 491 | |
| 492 /* Relies on caller to gc-protect args */ | |
| 493 static Lisp_Object | |
| 494 keymap_lookup_directly (Lisp_Object keymap, | |
| 442 | 495 Lisp_Object keysym, int modifiers) |
| 428 | 496 { |
| 497 Lisp_Keymap *k; | |
| 498 | |
| 442 | 499 modifiers &= ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3 |
| 4272 | 500 | XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5 | XEMACS_MOD_BUTTON6 |
| 501 | XEMACS_MOD_BUTTON7 | XEMACS_MOD_BUTTON8 | XEMACS_MOD_BUTTON9 | |
| 502 | XEMACS_MOD_BUTTON10 | XEMACS_MOD_BUTTON11 | XEMACS_MOD_BUTTON12 | |
| 503 | XEMACS_MOD_BUTTON13 | XEMACS_MOD_BUTTON14 | XEMACS_MOD_BUTTON15 | |
| 504 | XEMACS_MOD_BUTTON16 | XEMACS_MOD_BUTTON17 | XEMACS_MOD_BUTTON18 | |
| 505 | XEMACS_MOD_BUTTON19 | XEMACS_MOD_BUTTON20 | XEMACS_MOD_BUTTON21 | |
| 506 | XEMACS_MOD_BUTTON22 | XEMACS_MOD_BUTTON23 | XEMACS_MOD_BUTTON24 | |
| 507 | XEMACS_MOD_BUTTON25 | XEMACS_MOD_BUTTON26); | |
| 442 | 508 if ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER |
| 509 | XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) | |
| 510 != 0) | |
| 2500 | 511 ABORT (); |
| 428 | 512 |
| 513 k = XKEYMAP (keymap); | |
| 514 | |
| 515 /* If the keysym is a one-character symbol, use the char code instead. */ | |
| 826 | 516 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) |
| 428 | 517 { |
| 518 Lisp_Object i_fart_on_gcc = | |
| 867 | 519 make_char (string_ichar (XSYMBOL (keysym)->name, 0)); |
| 428 | 520 keysym = i_fart_on_gcc; |
| 521 } | |
| 522 | |
| 442 | 523 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */ |
| 428 | 524 { |
| 442 | 525 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 428 | 526 k->table, Qnil); |
| 527 if (NILP (submap)) | |
| 528 return Qnil; | |
| 529 k = XKEYMAP (submap); | |
| 442 | 530 modifiers &= ~XEMACS_MOD_META; |
| 428 | 531 } |
| 532 | |
| 533 if (modifiers != 0) | |
| 534 { | |
| 535 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers), | |
| 536 k->table, Qnil); | |
| 537 if (NILP (submap)) | |
| 538 return Qnil; | |
| 539 k = XKEYMAP (submap); | |
| 540 } | |
| 541 return Fgethash (keysym, k->table, Qnil); | |
| 542 } | |
| 543 | |
| 544 static void | |
| 545 keymap_store_inverse_internal (Lisp_Object inverse_table, | |
| 546 Lisp_Object keysym, | |
| 547 Lisp_Object value) | |
| 548 { | |
| 549 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound); | |
| 550 | |
| 551 if (UNBOUNDP (keys)) | |
| 552 { | |
| 553 keys = keysym; | |
| 554 /* Don't cons this unless necessary */ | |
| 555 /* keys = Fcons (keysym, Qnil); */ | |
| 556 Fputhash (value, keys, inverse_table); | |
| 557 } | |
| 558 else if (!CONSP (keys)) | |
| 559 { | |
| 560 /* Now it's necessary to cons */ | |
| 561 keys = Fcons (keys, keysym); | |
| 562 Fputhash (value, keys, inverse_table); | |
| 563 } | |
| 564 else | |
| 565 { | |
| 566 while (CONSP (XCDR (keys))) | |
| 567 keys = XCDR (keys); | |
| 568 XCDR (keys) = Fcons (XCDR (keys), keysym); | |
| 569 /* No need to call puthash because we've destructively | |
| 570 modified the list tail in place */ | |
| 571 } | |
| 572 } | |
| 573 | |
| 574 | |
| 575 static void | |
| 576 keymap_delete_inverse_internal (Lisp_Object inverse_table, | |
| 577 Lisp_Object keysym, | |
| 578 Lisp_Object value) | |
| 579 { | |
| 580 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound); | |
| 581 Lisp_Object new_keys = keys; | |
| 582 Lisp_Object tail; | |
| 583 Lisp_Object *prev; | |
| 584 | |
| 585 if (UNBOUNDP (keys)) | |
| 2500 | 586 ABORT (); |
| 428 | 587 |
| 588 for (prev = &new_keys, tail = new_keys; | |
| 589 ; | |
| 590 prev = &(XCDR (tail)), tail = XCDR (tail)) | |
| 591 { | |
| 592 if (EQ (tail, keysym)) | |
| 593 { | |
| 594 *prev = Qnil; | |
| 595 break; | |
| 596 } | |
| 597 else if (EQ (keysym, XCAR (tail))) | |
| 598 { | |
| 599 *prev = XCDR (tail); | |
| 600 break; | |
| 601 } | |
| 602 } | |
| 603 | |
| 604 if (NILP (new_keys)) | |
| 605 Fremhash (value, inverse_table); | |
| 606 else if (!EQ (keys, new_keys)) | |
| 607 /* Removed the first elt */ | |
| 608 Fputhash (value, new_keys, inverse_table); | |
| 609 /* else the list's tail has been modified, so we don't need to | |
| 610 touch the hash table again (the pointer in there is ok). | |
| 611 */ | |
| 612 } | |
| 613 | |
| 440 | 614 /* Prevent luser from shooting herself in the foot using something like |
| 615 (define-key ctl-x-4-map "p" global-map) */ | |
| 616 static void | |
| 617 check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap) | |
| 618 { | |
| 619 def = get_keymap (def, 0, 0); | |
| 620 | |
| 621 if (KEYMAPP (def)) | |
| 622 { | |
| 623 Lisp_Object maps; | |
| 624 | |
| 625 if (XKEYMAP (def) == to_keymap) | |
| 563 | 626 invalid_argument ("Cyclic keymap definition", def); |
| 440 | 627 |
| 628 for (maps = keymap_submaps (def); | |
| 629 CONSP (maps); | |
| 630 maps = XCDR (maps)) | |
| 631 check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap); | |
| 632 } | |
| 633 } | |
| 428 | 634 |
| 635 static void | |
| 636 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap, | |
| 440 | 637 Lisp_Object def) |
| 428 | 638 { |
| 440 | 639 Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil); |
| 640 | |
| 641 if (EQ (prev_def, def)) | |
| 428 | 642 return; |
| 440 | 643 |
| 644 check_keymap_definition_loop (def, keymap); | |
| 645 | |
| 646 if (!NILP (prev_def)) | |
| 428 | 647 keymap_delete_inverse_internal (keymap->inverse_table, |
| 440 | 648 keysym, prev_def); |
| 649 if (NILP (def)) | |
| 428 | 650 { |
| 651 Fremhash (keysym, keymap->table); | |
| 652 } | |
| 653 else | |
| 654 { | |
| 440 | 655 Fputhash (keysym, def, keymap->table); |
| 428 | 656 keymap_store_inverse_internal (keymap->inverse_table, |
| 440 | 657 keysym, def); |
| 428 | 658 } |
| 659 keymap_tick++; | |
| 660 } | |
| 661 | |
| 662 | |
| 663 static Lisp_Object | |
| 442 | 664 create_bucky_submap (Lisp_Keymap *k, int modifiers, |
| 428 | 665 Lisp_Object parent_for_debugging_info) |
| 666 { | |
| 667 Lisp_Object submap = Fmake_sparse_keymap (Qnil); | |
| 668 /* User won't see this, but it is nice for debugging Emacs */ | |
| 669 XKEYMAP (submap)->name | |
| 670 = control_meta_superify (parent_for_debugging_info, modifiers); | |
| 671 /* Invalidate cache */ | |
| 672 k->sub_maps_cache = Qt; | |
| 673 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap); | |
| 674 return submap; | |
| 675 } | |
| 676 | |
| 677 | |
| 678 /* Relies on caller to gc-protect keymap, keysym, value */ | |
| 679 static void | |
| 934 | 680 keymap_store (Lisp_Object keymap, const Lisp_Key_Data *key, |
| 428 | 681 Lisp_Object value) |
| 682 { | |
| 934 | 683 Lisp_Object keysym = KEY_DATA_KEYSYM (key); |
| 684 int modifiers = KEY_DATA_MODIFIERS (key); | |
| 440 | 685 Lisp_Keymap *k = XKEYMAP (keymap); |
| 686 | |
| 442 | 687 modifiers &= ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3 |
| 4272 | 688 | XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5 | XEMACS_MOD_BUTTON6 |
| 689 | XEMACS_MOD_BUTTON7 | XEMACS_MOD_BUTTON8 | XEMACS_MOD_BUTTON9 | |
| 690 | XEMACS_MOD_BUTTON10 | XEMACS_MOD_BUTTON11 | XEMACS_MOD_BUTTON12 | |
| 691 | XEMACS_MOD_BUTTON13 | XEMACS_MOD_BUTTON14 | XEMACS_MOD_BUTTON15 | |
| 692 | XEMACS_MOD_BUTTON16 | XEMACS_MOD_BUTTON17 | XEMACS_MOD_BUTTON18 | |
| 693 | XEMACS_MOD_BUTTON19 | XEMACS_MOD_BUTTON20 | XEMACS_MOD_BUTTON21 | |
| 694 | XEMACS_MOD_BUTTON22 | XEMACS_MOD_BUTTON23 | XEMACS_MOD_BUTTON24 | |
| 695 | XEMACS_MOD_BUTTON25 | XEMACS_MOD_BUTTON26); | |
| 442 | 696 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META |
| 697 | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER | |
| 698 | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0); | |
| 428 | 699 |
| 700 /* If the keysym is a one-character symbol, use the char code instead. */ | |
| 826 | 701 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1) |
| 867 | 702 keysym = make_char (string_ichar (XSYMBOL (keysym)->name, 0)); |
| 428 | 703 |
| 442 | 704 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */ |
| 428 | 705 { |
| 442 | 706 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 428 | 707 k->table, Qnil); |
| 708 if (NILP (submap)) | |
| 442 | 709 submap = create_bucky_submap (k, XEMACS_MOD_META, keymap); |
| 428 | 710 k = XKEYMAP (submap); |
| 442 | 711 modifiers &= ~XEMACS_MOD_META; |
| 428 | 712 } |
| 713 | |
| 714 if (modifiers != 0) | |
| 715 { | |
| 716 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers), | |
| 717 k->table, Qnil); | |
| 718 if (NILP (submap)) | |
| 719 submap = create_bucky_submap (k, modifiers, keymap); | |
| 720 k = XKEYMAP (submap); | |
| 721 } | |
| 722 k->sub_maps_cache = Qt; /* Invalidate cache */ | |
| 723 keymap_store_internal (keysym, k, value); | |
| 724 } | |
| 725 | |
| 726 | |
| 727 /************************************************************************/ | |
| 728 /* Listing the submaps of a keymap */ | |
| 729 /************************************************************************/ | |
| 730 | |
| 731 struct keymap_submaps_closure | |
| 732 { | |
| 733 Lisp_Object *result_locative; | |
| 734 }; | |
| 735 | |
| 736 static int | |
| 2286 | 737 keymap_submaps_mapper_0 (Lisp_Object UNUSED (key), Lisp_Object value, |
| 738 void *UNUSED (keymap_submaps_closure)) | |
| 428 | 739 { |
| 740 /* This function can GC */ | |
| 741 /* Perform any autoloads, etc */ | |
| 742 Fkeymapp (value); | |
| 743 return 0; | |
| 744 } | |
| 745 | |
| 746 static int | |
| 747 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value, | |
| 748 void *keymap_submaps_closure) | |
| 749 { | |
| 750 /* This function can GC */ | |
| 751 Lisp_Object *result_locative; | |
| 752 struct keymap_submaps_closure *cl = | |
| 753 (struct keymap_submaps_closure *) keymap_submaps_closure; | |
| 754 result_locative = cl->result_locative; | |
| 755 | |
| 756 if (!NILP (Fkeymapp (value))) | |
| 757 *result_locative = Fcons (Fcons (key, value), *result_locative); | |
| 758 return 0; | |
| 759 } | |
| 760 | |
| 761 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, | |
| 762 Lisp_Object pred); | |
| 763 | |
| 764 static Lisp_Object | |
| 765 keymap_submaps (Lisp_Object keymap) | |
| 766 { | |
| 767 /* This function can GC */ | |
| 768 Lisp_Keymap *k = XKEYMAP (keymap); | |
| 769 | |
| 770 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */ | |
| 771 { | |
| 772 Lisp_Object result = Qnil; | |
| 773 struct gcpro gcpro1, gcpro2; | |
| 774 struct keymap_submaps_closure keymap_submaps_closure; | |
| 775 | |
| 776 GCPRO2 (keymap, result); | |
| 777 keymap_submaps_closure.result_locative = &result; | |
| 778 /* Do this first pass to touch (and load) any autoloaded maps */ | |
| 779 elisp_maphash (keymap_submaps_mapper_0, k->table, | |
| 780 &keymap_submaps_closure); | |
| 781 result = Qnil; | |
| 782 elisp_maphash (keymap_submaps_mapper, k->table, | |
| 783 &keymap_submaps_closure); | |
| 784 /* keep it sorted so that the result of accessible-keymaps is ordered */ | |
| 785 k->sub_maps_cache = list_sort (result, | |
| 786 Qnil, | |
| 787 map_keymap_sort_predicate); | |
| 788 UNGCPRO; | |
| 789 } | |
| 790 return k->sub_maps_cache; | |
| 791 } | |
| 792 | |
| 793 | |
| 794 /************************************************************************/ | |
| 795 /* Basic operations on keymaps */ | |
| 796 /************************************************************************/ | |
| 797 | |
| 798 static Lisp_Object | |
| 665 | 799 make_keymap (Elemcount size) |
| 428 | 800 { |
| 801 Lisp_Object result; | |
| 3017 | 802 Lisp_Keymap *keymap = ALLOC_LCRECORD_TYPE (Lisp_Keymap, &lrecord_keymap); |
| 428 | 803 |
| 793 | 804 result = wrap_keymap (keymap); |
| 428 | 805 |
| 806 keymap->parents = Qnil; | |
| 807 keymap->prompt = Qnil; | |
| 808 keymap->table = Qnil; | |
| 809 keymap->inverse_table = Qnil; | |
| 810 keymap->default_binding = Qnil; | |
| 811 keymap->sub_maps_cache = Qnil; /* No possible submaps */ | |
| 812 keymap->name = Qnil; | |
| 813 | |
| 814 if (size != 0) /* hack for copy-keymap */ | |
| 815 { | |
| 816 keymap->table = | |
| 817 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); | |
| 818 /* Inverse table is often less dense because of duplicate key-bindings. | |
| 819 If not, it will grow anyway. */ | |
| 820 keymap->inverse_table = | |
| 647 | 821 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, |
| 822 HASH_TABLE_EQ); | |
| 428 | 823 } |
| 824 return result; | |
| 825 } | |
| 826 | |
| 827 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /* | |
| 828 Construct and return a new keymap object. | |
| 829 All entries in it are nil, meaning "command undefined". | |
| 830 | |
| 831 Optional argument NAME specifies a name to assign to the keymap, | |
| 832 as in `set-keymap-name'. This name is only a debugging convenience; | |
| 833 it is not used except when printing the keymap. | |
| 834 */ | |
| 835 (name)) | |
| 836 { | |
| 837 Lisp_Object keymap = make_keymap (60); | |
| 838 if (!NILP (name)) | |
| 839 Fset_keymap_name (keymap, name); | |
| 840 return keymap; | |
| 841 } | |
| 842 | |
| 843 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /* | |
| 844 Construct and return a new keymap object. | |
| 845 All entries in it are nil, meaning "command undefined". The only | |
| 444 | 846 difference between this function and `make-keymap' is that this function |
| 428 | 847 returns a "smaller" keymap (one that is expected to contain fewer |
| 444 | 848 entries). As keymaps dynamically resize, this distinction is not great. |
| 428 | 849 |
| 850 Optional argument NAME specifies a name to assign to the keymap, | |
| 851 as in `set-keymap-name'. This name is only a debugging convenience; | |
| 852 it is not used except when printing the keymap. | |
| 853 */ | |
| 854 (name)) | |
| 855 { | |
| 856 Lisp_Object keymap = make_keymap (8); | |
| 857 if (!NILP (name)) | |
| 858 Fset_keymap_name (keymap, name); | |
| 859 return keymap; | |
| 860 } | |
| 861 | |
| 862 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /* | |
| 863 Return the `parent' keymaps of KEYMAP, or nil. | |
| 864 The parents of a keymap are searched for keybindings when a key sequence | |
| 865 isn't bound in this one. `(current-global-map)' is the default parent | |
| 866 of all keymaps. | |
| 867 */ | |
| 868 (keymap)) | |
| 869 { | |
| 870 keymap = get_keymap (keymap, 1, 1); | |
| 871 return Fcopy_sequence (XKEYMAP (keymap)->parents); | |
| 872 } | |
| 873 | |
| 874 | |
| 875 | |
| 876 static Lisp_Object | |
| 2286 | 877 traverse_keymaps_noop (Lisp_Object UNUSED (keymap), void *UNUSED (arg)) |
| 428 | 878 { |
| 879 return Qnil; | |
| 880 } | |
| 881 | |
| 882 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /* | |
| 883 Set the `parent' keymaps of KEYMAP to PARENTS. | |
| 884 The parents of a keymap are searched for keybindings when a key sequence | |
| 885 isn't bound in this one. `(current-global-map)' is the default parent | |
| 886 of all keymaps. | |
| 887 */ | |
| 888 (keymap, parents)) | |
| 889 { | |
| 890 /* This function can GC */ | |
| 891 Lisp_Object k; | |
| 892 struct gcpro gcpro1, gcpro2; | |
| 893 | |
| 894 GCPRO2 (keymap, parents); | |
| 895 keymap = get_keymap (keymap, 1, 1); | |
| 896 | |
| 897 if (KEYMAPP (parents)) /* backwards-compatibility */ | |
| 898 parents = list1 (parents); | |
| 899 if (!NILP (parents)) | |
| 900 { | |
| 901 Lisp_Object tail = parents; | |
| 902 while (!NILP (tail)) | |
| 903 { | |
| 904 QUIT; | |
| 905 CHECK_CONS (tail); | |
| 906 k = XCAR (tail); | |
| 907 /* Require that it be an actual keymap object, rather than a symbol | |
| 908 with a (crockish) symbol-function which is a keymap */ | |
| 909 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */ | |
| 910 tail = XCDR (tail); | |
| 911 } | |
| 912 } | |
| 913 | |
| 914 /* Check for circularities */ | |
| 915 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0); | |
| 916 keymap_tick++; | |
| 917 XKEYMAP (keymap)->parents = Fcopy_sequence (parents); | |
| 918 UNGCPRO; | |
| 919 return parents; | |
| 920 } | |
| 921 | |
| 922 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /* | |
| 923 Set the `name' of the KEYMAP to NEW-NAME. | |
| 924 The name is only a debugging convenience; it is not used except | |
| 925 when printing the keymap. | |
| 926 */ | |
| 927 (keymap, new_name)) | |
| 928 { | |
| 929 keymap = get_keymap (keymap, 1, 1); | |
| 930 | |
| 931 XKEYMAP (keymap)->name = new_name; | |
| 932 return new_name; | |
| 933 } | |
| 934 | |
| 935 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /* | |
| 936 Return the `name' of KEYMAP. | |
| 937 The name is only a debugging convenience; it is not used except | |
| 938 when printing the keymap. | |
| 939 */ | |
| 940 (keymap)) | |
| 941 { | |
| 942 keymap = get_keymap (keymap, 1, 1); | |
| 943 | |
| 944 return XKEYMAP (keymap)->name; | |
| 945 } | |
| 946 | |
| 947 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /* | |
| 948 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil' | |
| 949 if no prompt is desired. The prompt is shown in the echo-area | |
| 950 when reading a key-sequence to be looked-up in this keymap. | |
| 951 */ | |
| 952 (keymap, new_prompt)) | |
| 953 { | |
| 954 keymap = get_keymap (keymap, 1, 1); | |
| 955 | |
| 956 if (!NILP (new_prompt)) | |
| 957 CHECK_STRING (new_prompt); | |
| 958 | |
| 959 XKEYMAP (keymap)->prompt = new_prompt; | |
| 960 return new_prompt; | |
| 961 } | |
| 962 | |
| 963 static Lisp_Object | |
| 2286 | 964 keymap_prompt_mapper (Lisp_Object keymap, void *UNUSED (arg)) |
| 428 | 965 { |
| 966 return XKEYMAP (keymap)->prompt; | |
| 967 } | |
| 968 | |
| 969 | |
| 970 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /* | |
| 971 Return the `prompt' of KEYMAP. | |
| 972 If non-nil, the prompt is shown in the echo-area | |
| 973 when reading a key-sequence to be looked-up in this keymap. | |
| 974 */ | |
| 975 (keymap, use_inherited)) | |
| 976 { | |
| 977 /* This function can GC */ | |
| 978 Lisp_Object prompt; | |
| 979 | |
| 980 keymap = get_keymap (keymap, 1, 1); | |
| 981 prompt = XKEYMAP (keymap)->prompt; | |
| 982 if (!NILP (prompt) || NILP (use_inherited)) | |
| 983 return prompt; | |
| 984 else | |
| 985 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0); | |
| 986 } | |
| 987 | |
| 988 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /* | |
| 989 Sets the default binding of KEYMAP to COMMAND, or `nil' | |
| 990 if no default is desired. The default-binding is returned when | |
| 991 no other binding for a key-sequence is found in the keymap. | |
| 992 If a keymap has a non-nil default-binding, neither the keymap's | |
| 993 parents nor the current global map are searched for key bindings. | |
| 994 */ | |
| 995 (keymap, command)) | |
| 996 { | |
| 997 /* This function can GC */ | |
| 998 keymap = get_keymap (keymap, 1, 1); | |
| 999 | |
| 1000 XKEYMAP (keymap)->default_binding = command; | |
| 1001 return command; | |
| 1002 } | |
| 1003 | |
| 1004 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /* | |
| 1005 Return the default binding of KEYMAP, or `nil' if it has none. | |
| 1006 The default-binding is returned when no other binding for a key-sequence | |
| 1007 is found in the keymap. | |
| 1008 If a keymap has a non-nil default-binding, neither the keymap's | |
| 1009 parents nor the current global map are searched for key bindings. | |
| 1010 */ | |
| 1011 (keymap)) | |
| 1012 { | |
| 1013 /* This function can GC */ | |
| 1014 keymap = get_keymap (keymap, 1, 1); | |
| 1015 return XKEYMAP (keymap)->default_binding; | |
| 1016 } | |
| 1017 | |
| 1018 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /* | |
| 444 | 1019 Return t if OBJECT is a keymap object. |
| 428 | 1020 The keymap may be autoloaded first if necessary. |
| 1021 */ | |
| 1022 (object)) | |
| 1023 { | |
| 1024 /* This function can GC */ | |
| 1025 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil; | |
| 1026 } | |
| 1027 | |
| 1028 /* Check that OBJECT is a keymap (after dereferencing through any | |
| 1029 symbols). If it is, return it. | |
| 1030 | |
| 1031 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value | |
| 1032 is an autoload form, do the autoload and try again. | |
| 1033 If AUTOLOAD is nonzero, callers must assume GC is possible. | |
| 1034 | |
| 1035 ERRORP controls how we respond if OBJECT isn't a keymap. | |
| 1036 If ERRORP is non-zero, signal an error; otherwise, just return Qnil. | |
| 1037 | |
| 1038 Note that most of the time, we don't want to pursue autoloads. | |
| 1039 Functions like Faccessible_keymaps which scan entire keymap trees | |
| 1040 shouldn't load every autoloaded keymap. I'm not sure about this, | |
| 1041 but it seems to me that only read_key_sequence, Flookup_key, and | |
| 1042 Fdefine_key should cause keymaps to be autoloaded. */ | |
| 1043 | |
| 1044 Lisp_Object | |
| 1045 get_keymap (Lisp_Object object, int errorp, int autoload) | |
| 1046 { | |
| 1047 /* This function can GC */ | |
| 1048 while (1) | |
| 1049 { | |
| 1050 Lisp_Object tem = indirect_function (object, 0); | |
| 1051 | |
| 1052 if (KEYMAPP (tem)) | |
| 1053 return tem; | |
| 1054 /* Should we do an autoload? */ | |
| 1055 else if (autoload | |
| 1056 /* (autoload "filename" doc nil keymap) */ | |
| 1057 && SYMBOLP (object) | |
| 1058 && CONSP (tem) | |
| 1059 && EQ (XCAR (tem), Qautoload) | |
| 1060 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap)) | |
| 1061 { | |
| 970 | 1062 /* do_autoload GCPROs both arguments */ |
| 428 | 1063 do_autoload (tem, object); |
| 1064 } | |
| 1065 else if (errorp) | |
| 1066 object = wrong_type_argument (Qkeymapp, object); | |
| 1067 else | |
| 1068 return Qnil; | |
| 1069 } | |
| 1070 } | |
| 1071 | |
| 1072 /* Given OBJECT which was found in a slot in a keymap, | |
| 1073 trace indirect definitions to get the actual definition of that slot. | |
| 1074 An indirect definition is a list of the form | |
| 1075 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one | |
| 1076 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS). | |
| 1077 */ | |
| 1078 static Lisp_Object | |
| 1079 get_keyelt (Lisp_Object object, int accept_default) | |
| 1080 { | |
| 1081 /* This function can GC */ | |
| 1082 Lisp_Object map; | |
| 1083 | |
| 1084 tail_recurse: | |
| 1085 if (!CONSP (object)) | |
| 1086 return object; | |
| 1087 | |
| 1088 { | |
| 1089 struct gcpro gcpro1; | |
| 1090 GCPRO1 (object); | |
| 1091 map = XCAR (object); | |
| 1092 map = get_keymap (map, 0, 1); | |
| 1093 UNGCPRO; | |
| 1094 } | |
| 1095 /* If the contents are (KEYMAP . ELEMENT), go indirect. */ | |
| 1096 if (!NILP (map)) | |
| 1097 { | |
| 1098 Lisp_Object idx = Fcdr (object); | |
| 934 | 1099 Lisp_Key_Data indirection; |
| 428 | 1100 if (CHARP (idx)) |
| 1101 { | |
| 934 | 1102 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 1103 struct gcpro gcpro1; | |
| 1104 GCPRO1 (event); | |
| 1105 character_to_event (XCHAR (idx), XEVENT (event), | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
1106 XCONSOLE (Vselected_console), |
|
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
1107 high_bit_is_meta, 0); |
| 1204 | 1108 indirection.keysym = XEVENT_KEY_KEYSYM (event); |
| 1109 indirection.modifiers = XEVENT_KEY_MODIFIERS (event); | |
| 1110 UNGCPRO; | |
| 428 | 1111 } |
| 1112 else if (CONSP (idx)) | |
| 1113 { | |
| 1114 if (!INTP (XCDR (idx))) | |
| 1115 return Qnil; | |
| 1116 indirection.keysym = XCAR (idx); | |
| 442 | 1117 indirection.modifiers = (unsigned char) XINT (XCDR (idx)); |
| 428 | 1118 } |
| 1119 else if (SYMBOLP (idx)) | |
| 1120 { | |
| 1121 indirection.keysym = idx; | |
| 934 | 1122 SET_KEY_DATA_MODIFIERS (&indirection, XINT (XCDR (idx))); |
| 428 | 1123 } |
| 1124 else | |
| 1125 { | |
| 1126 /* Random junk */ | |
| 1127 return Qnil; | |
| 1128 } | |
| 1129 return raw_lookup_key (map, &indirection, 1, 0, accept_default); | |
| 1130 } | |
| 1131 else if (STRINGP (XCAR (object))) | |
| 1132 { | |
| 1133 /* If the keymap contents looks like (STRING . DEFN), | |
| 1134 use DEFN. | |
| 1135 Keymap alist elements like (CHAR MENUSTRING . DEFN) | |
| 1136 will be used by HierarKey menus. */ | |
| 1137 object = XCDR (object); | |
| 1138 goto tail_recurse; | |
| 1139 } | |
| 1140 else | |
| 1141 { | |
| 1142 /* Anything else is really the value. */ | |
| 1143 return object; | |
| 1144 } | |
| 1145 } | |
| 1146 | |
| 1147 static Lisp_Object | |
| 934 | 1148 keymap_lookup_1 (Lisp_Object keymap, const Lisp_Key_Data *key, |
| 428 | 1149 int accept_default) |
| 1150 { | |
| 1151 /* This function can GC */ | |
| 934 | 1152 return get_keyelt (keymap_lookup_directly (keymap, |
| 1153 KEY_DATA_KEYSYM (key), | |
| 1154 KEY_DATA_MODIFIERS (key)), | |
| 1155 accept_default); | |
| 428 | 1156 } |
| 1157 | |
| 1158 | |
| 1159 /************************************************************************/ | |
| 1160 /* Copying keymaps */ | |
| 1161 /************************************************************************/ | |
| 1162 | |
| 1163 struct copy_keymap_inverse_closure | |
| 1164 { | |
| 1165 Lisp_Object inverse_table; | |
| 1166 }; | |
| 1167 | |
| 1168 static int | |
| 1169 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value, | |
| 1170 void *copy_keymap_inverse_closure) | |
| 1171 { | |
| 1172 struct copy_keymap_inverse_closure *closure = | |
| 1173 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure; | |
| 1174 | |
| 1175 /* copy-sequence deals with dotted lists. */ | |
| 1176 if (CONSP (value)) | |
| 1177 value = Fcopy_list (value); | |
| 1178 Fputhash (key, value, closure->inverse_table); | |
| 1179 | |
| 1180 return 0; | |
| 1181 } | |
| 1182 | |
| 1183 | |
| 1184 static Lisp_Object | |
| 1185 copy_keymap_internal (Lisp_Keymap *keymap) | |
| 1186 { | |
| 1187 Lisp_Object nkm = make_keymap (0); | |
| 1188 Lisp_Keymap *new_keymap = XKEYMAP (nkm); | |
| 1189 struct copy_keymap_inverse_closure copy_keymap_inverse_closure; | |
| 1190 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table; | |
| 1191 | |
| 1192 new_keymap->parents = Fcopy_sequence (keymap->parents); | |
| 1193 new_keymap->sub_maps_cache = Qnil; /* No submaps */ | |
| 1194 new_keymap->table = Fcopy_hash_table (keymap->table); | |
| 1195 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table); | |
| 1196 new_keymap->default_binding = keymap->default_binding; | |
| 1197 /* After copying the inverse map, we need to copy the conses which | |
| 1198 are its values, lest they be shared by the copy, and mangled. | |
| 1199 */ | |
| 1200 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table, | |
| 1201 ©_keymap_inverse_closure); | |
| 1202 return nkm; | |
| 1203 } | |
| 1204 | |
| 1205 | |
| 1206 static Lisp_Object copy_keymap (Lisp_Object keymap); | |
| 1207 | |
| 1208 struct copy_keymap_closure | |
| 1209 { | |
| 1210 Lisp_Keymap *self; | |
| 1211 }; | |
| 1212 | |
| 1213 static int | |
| 1214 copy_keymap_mapper (Lisp_Object key, Lisp_Object value, | |
| 1215 void *copy_keymap_closure) | |
| 1216 { | |
| 1217 /* This function can GC */ | |
| 1218 struct copy_keymap_closure *closure = | |
| 1219 (struct copy_keymap_closure *) copy_keymap_closure; | |
| 1220 | |
| 1221 /* When we encounter a keymap which is indirected through a | |
| 1222 symbol, we need to copy the sub-map. In v18, the form | |
| 1223 (lookup-key (copy-keymap global-map) "\C-x") | |
| 3025 | 1224 returned a new keymap, not the symbol `Control-X-prefix'. |
| 428 | 1225 */ |
| 1226 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */ | |
| 1227 if (KEYMAPP (value)) | |
| 1228 keymap_store_internal (key, closure->self, | |
| 1229 copy_keymap (value)); | |
| 1230 return 0; | |
| 1231 } | |
| 1232 | |
| 1233 static Lisp_Object | |
| 1234 copy_keymap (Lisp_Object keymap) | |
| 1235 { | |
| 1236 /* This function can GC */ | |
| 1237 struct copy_keymap_closure copy_keymap_closure; | |
| 1238 | |
| 1239 keymap = copy_keymap_internal (XKEYMAP (keymap)); | |
| 1240 copy_keymap_closure.self = XKEYMAP (keymap); | |
| 1241 elisp_maphash (copy_keymap_mapper, | |
| 1242 XKEYMAP (keymap)->table, | |
| 1243 ©_keymap_closure); | |
| 1244 return keymap; | |
| 1245 } | |
| 1246 | |
| 1247 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /* | |
| 1248 Return a copy of the keymap KEYMAP. | |
| 1249 The copy starts out with the same definitions of KEYMAP, | |
| 1250 but changing either the copy or KEYMAP does not affect the other. | |
| 1251 Any key definitions that are subkeymaps are recursively copied. | |
| 1252 */ | |
| 1253 (keymap)) | |
| 1254 { | |
| 1255 /* This function can GC */ | |
| 1256 keymap = get_keymap (keymap, 1, 1); | |
| 1257 return copy_keymap (keymap); | |
| 1258 } | |
| 1259 | |
| 1260 | |
| 1261 static int | |
| 1262 keymap_fullness (Lisp_Object keymap) | |
| 1263 { | |
| 1264 /* This function can GC */ | |
| 1265 int fullness; | |
| 1266 Lisp_Object sub_maps; | |
| 1267 struct gcpro gcpro1, gcpro2; | |
| 1268 | |
| 1269 keymap = get_keymap (keymap, 1, 1); | |
| 440 | 1270 fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table)); |
| 428 | 1271 GCPRO2 (keymap, sub_maps); |
| 440 | 1272 for (sub_maps = keymap_submaps (keymap); |
| 1273 !NILP (sub_maps); | |
| 1274 sub_maps = XCDR (sub_maps)) | |
| 428 | 1275 { |
| 1276 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0) | |
| 1277 { | |
| 440 | 1278 Lisp_Object bucky_map = XCDR (XCAR (sub_maps)); |
| 1279 fullness--; /* don't count bucky maps themselves. */ | |
| 1280 fullness += keymap_fullness (bucky_map); | |
| 428 | 1281 } |
| 1282 } | |
| 1283 UNGCPRO; | |
| 1284 return fullness; | |
| 1285 } | |
| 1286 | |
| 1287 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /* | |
| 1288 Return the number of bindings in the keymap. | |
| 1289 */ | |
| 1290 (keymap)) | |
| 1291 { | |
| 1292 /* This function can GC */ | |
| 1293 return make_int (keymap_fullness (get_keymap (keymap, 1, 1))); | |
| 1294 } | |
| 1295 | |
| 1296 | |
| 1297 /************************************************************************/ | |
| 1298 /* Defining keys in keymaps */ | |
| 1299 /************************************************************************/ | |
| 1300 | |
| 1301 /* Given a keysym (should be a symbol, int, char), make sure it's valid | |
| 1302 and perform any necessary canonicalization. */ | |
| 1303 | |
| 1304 static void | |
| 1305 define_key_check_and_coerce_keysym (Lisp_Object spec, | |
| 1306 Lisp_Object *keysym, | |
| 442 | 1307 int modifiers) |
| 428 | 1308 { |
| 1309 /* Now, check and massage the trailing keysym specifier. */ | |
| 1310 if (SYMBOLP (*keysym)) | |
| 1311 { | |
| 826 | 1312 if (string_char_length (XSYMBOL (*keysym)->name) == 1) |
| 428 | 1313 { |
| 1314 Lisp_Object ream_gcc_up_the_ass = | |
| 867 | 1315 make_char (string_ichar (XSYMBOL (*keysym)->name, 0)); |
| 428 | 1316 *keysym = ream_gcc_up_the_ass; |
| 1317 goto fixnum_keysym; | |
| 1318 } | |
| 1319 } | |
| 1320 else if (CHAR_OR_CHAR_INTP (*keysym)) | |
| 1321 { | |
| 1322 CHECK_CHAR_COERCE_INT (*keysym); | |
| 1323 fixnum_keysym: | |
| 1324 if (XCHAR (*keysym) < ' ' | |
| 1325 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */) | |
| 1326 /* yuck! Can't make the above restriction; too many compatibility | |
| 1327 problems ... */ | |
| 563 | 1328 invalid_argument ("keysym char must be printable", *keysym); |
| 428 | 1329 /* #### This bites! I want to be able to write (control shift a) */ |
| 442 | 1330 if (modifiers & XEMACS_MOD_SHIFT) |
| 563 | 1331 invalid_argument |
| 428 | 1332 ("The `shift' modifier may not be applied to ASCII keysyms", |
| 1333 spec); | |
| 1334 } | |
| 1335 else | |
| 1336 { | |
| 563 | 1337 invalid_argument ("Unknown keysym specifier", *keysym); |
| 428 | 1338 } |
| 1339 | |
| 1340 if (SYMBOLP (*keysym)) | |
| 1341 { | |
| 867 | 1342 Ibyte *name = XSTRING_DATA (XSYMBOL (*keysym)->name); |
| 428 | 1343 |
| 3025 | 1344 /* GNU Emacs uses symbols with the printed representation of keysyms in |
| 1345 their names, like `M-x', and we use the syntax '(meta x). So, to | |
| 1346 avoid confusion, notice the M-x syntax and signal an error - | |
| 1347 because otherwise it would be interpreted as a regular keysym, and | |
| 1348 would even show up in the list-buffers output, causing confusion | |
| 1349 to the naive. | |
| 428 | 1350 |
| 1351 We can get away with this because none of the X keysym names contain | |
| 1352 a hyphen (some contain underscore, however). | |
| 1353 | |
| 1354 It might be useful to reject keysyms which are not x-valid-keysym- | |
| 1355 name-p, but that would interfere with various tricks we do to | |
| 1356 sanitize the Sun keyboards, and would make it trickier to | |
| 1357 conditionalize a .emacs file for multiple X servers. | |
| 1358 */ | |
| 793 | 1359 if (((int) qxestrlen (name) >= 2 && name[1] == '-') |
| 428 | 1360 #if 1 |
| 1361 || | |
| 1362 /* Ok, this is a bit more dubious - prevent people from doing things | |
| 1363 like (global-set-key 'RET 'something) because that will have the | |
| 1364 same problem as above. (Gag!) Maybe we should just silently | |
| 1365 accept these as aliases for the "real" names? | |
| 1366 */ | |
| 793 | 1367 (XSTRING_LENGTH (XSYMBOL (*keysym)->name) <= 3 && |
| 2367 | 1368 (!qxestrcmp_ascii (name, "LFD") || |
| 1369 !qxestrcmp_ascii (name, "TAB") || | |
| 1370 !qxestrcmp_ascii (name, "RET") || | |
| 1371 !qxestrcmp_ascii (name, "ESC") || | |
| 1372 !qxestrcmp_ascii (name, "DEL") || | |
| 1373 !qxestrcmp_ascii (name, "SPC") || | |
| 1374 !qxestrcmp_ascii (name, "BS"))) | |
| 428 | 1375 #endif /* unused */ |
| 1376 ) | |
| 563 | 1377 invalid_argument |
| 3086 | 1378 ("Invalid (GNU Emacs) key format (see doc of define-key)", |
| 428 | 1379 *keysym); |
| 1380 | |
| 1381 /* #### Ok, this is a bit more dubious - make people not lose if they | |
| 1382 do things like (global-set-key 'RET 'something) because that would | |
| 1383 otherwise have the same problem as above. (Gag!) We silently | |
| 1384 accept these as aliases for the "real" names. | |
| 1385 */ | |
| 2367 | 1386 else if (!qxestrncmp_ascii (name, "kp_", 3)) |
| 793 | 1387 { |
| 1388 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */ | |
| 1389 DECLARE_EISTRING (temp); | |
| 1390 eicpy_raw (temp, name, qxestrlen (name)); | |
| 1391 eisetch_char (temp, 2, '-'); | |
|
4355
a2af1ff1761f
Provide a DEFAULT argument in #'intern-soft.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4272
diff
changeset
|
1392 *keysym = Fintern_soft (eimake_string (temp), Qnil, Qnil); |
| 793 | 1393 } |
| 1394 else if (EQ (*keysym, QLFD)) | |
| 428 | 1395 *keysym = QKlinefeed; |
| 1396 else if (EQ (*keysym, QTAB)) | |
| 1397 *keysym = QKtab; | |
| 1398 else if (EQ (*keysym, QRET)) | |
| 1399 *keysym = QKreturn; | |
| 1400 else if (EQ (*keysym, QESC)) | |
| 1401 *keysym = QKescape; | |
| 1402 else if (EQ (*keysym, QDEL)) | |
| 1403 *keysym = QKdelete; | |
| 1404 else if (EQ (*keysym, QSPC)) | |
| 1405 *keysym = QKspace; | |
| 1406 else if (EQ (*keysym, QBS)) | |
| 1407 *keysym = QKbackspace; | |
| 1408 /* Emacs compatibility */ | |
| 1409 else if (EQ(*keysym, Qdown_mouse_1)) | |
| 4272 | 1410 *keysym = Qbutton1; |
| 428 | 1411 else if (EQ(*keysym, Qdown_mouse_2)) |
| 1412 *keysym = Qbutton2; | |
| 1413 else if (EQ(*keysym, Qdown_mouse_3)) | |
| 1414 *keysym = Qbutton3; | |
| 1415 else if (EQ(*keysym, Qdown_mouse_4)) | |
| 1416 *keysym = Qbutton4; | |
| 1417 else if (EQ(*keysym, Qdown_mouse_5)) | |
| 1418 *keysym = Qbutton5; | |
| 458 | 1419 else if (EQ(*keysym, Qdown_mouse_6)) |
| 1420 *keysym = Qbutton6; | |
| 1421 else if (EQ(*keysym, Qdown_mouse_7)) | |
| 1422 *keysym = Qbutton7; | |
| 4272 | 1423 else if (EQ(*keysym, Qdown_mouse_8)) |
| 1424 *keysym = Qbutton8; | |
| 1425 else if (EQ(*keysym, Qdown_mouse_9)) | |
| 1426 *keysym = Qbutton9; | |
| 1427 else if (EQ(*keysym, Qdown_mouse_10)) | |
| 1428 *keysym = Qbutton10; | |
| 1429 else if (EQ(*keysym, Qdown_mouse_11)) | |
| 1430 *keysym = Qbutton11; | |
| 1431 else if (EQ(*keysym, Qdown_mouse_12)) | |
| 1432 *keysym = Qbutton12; | |
| 1433 else if (EQ(*keysym, Qdown_mouse_13)) | |
| 1434 *keysym = Qbutton13; | |
| 1435 else if (EQ(*keysym, Qdown_mouse_14)) | |
| 1436 *keysym = Qbutton14; | |
| 1437 else if (EQ(*keysym, Qdown_mouse_15)) | |
| 1438 *keysym = Qbutton15; | |
| 1439 else if (EQ(*keysym, Qdown_mouse_16)) | |
| 1440 *keysym = Qbutton16; | |
| 1441 else if (EQ(*keysym, Qdown_mouse_17)) | |
| 1442 *keysym = Qbutton17; | |
| 1443 else if (EQ(*keysym, Qdown_mouse_18)) | |
| 1444 *keysym = Qbutton18; | |
| 1445 else if (EQ(*keysym, Qdown_mouse_19)) | |
| 1446 *keysym = Qbutton19; | |
| 1447 else if (EQ(*keysym, Qdown_mouse_20)) | |
| 1448 *keysym = Qbutton20; | |
| 1449 else if (EQ(*keysym, Qdown_mouse_21)) | |
| 1450 *keysym = Qbutton21; | |
| 1451 else if (EQ(*keysym, Qdown_mouse_22)) | |
| 1452 *keysym = Qbutton22; | |
| 1453 else if (EQ(*keysym, Qdown_mouse_23)) | |
| 1454 *keysym = Qbutton23; | |
| 1455 else if (EQ(*keysym, Qdown_mouse_24)) | |
| 1456 *keysym = Qbutton24; | |
| 1457 else if (EQ(*keysym, Qdown_mouse_25)) | |
| 1458 *keysym = Qbutton25; | |
| 1459 else if (EQ(*keysym, Qdown_mouse_26)) | |
| 1460 *keysym = Qbutton26; | |
| 428 | 1461 else if (EQ(*keysym, Qmouse_1)) |
| 1462 *keysym = Qbutton1up; | |
| 1463 else if (EQ(*keysym, Qmouse_2)) | |
| 1464 *keysym = Qbutton2up; | |
| 1465 else if (EQ(*keysym, Qmouse_3)) | |
| 1466 *keysym = Qbutton3up; | |
| 1467 else if (EQ(*keysym, Qmouse_4)) | |
| 1468 *keysym = Qbutton4up; | |
| 1469 else if (EQ(*keysym, Qmouse_5)) | |
| 1470 *keysym = Qbutton5up; | |
| 458 | 1471 else if (EQ(*keysym, Qmouse_6)) |
| 1472 *keysym = Qbutton6up; | |
| 1473 else if (EQ(*keysym, Qmouse_7)) | |
| 1474 *keysym = Qbutton7up; | |
| 4272 | 1475 else if (EQ(*keysym, Qmouse_8)) |
| 1476 *keysym = Qbutton8up; | |
| 1477 else if (EQ(*keysym, Qmouse_9)) | |
| 1478 *keysym = Qbutton9up; | |
| 1479 else if (EQ(*keysym, Qmouse_10)) | |
| 1480 *keysym = Qbutton10up; | |
| 1481 else if (EQ(*keysym, Qmouse_11)) | |
| 1482 *keysym = Qbutton11up; | |
| 1483 else if (EQ(*keysym, Qmouse_12)) | |
| 1484 *keysym = Qbutton12up; | |
| 1485 else if (EQ(*keysym, Qmouse_13)) | |
| 1486 *keysym = Qbutton13up; | |
| 1487 else if (EQ(*keysym, Qmouse_14)) | |
| 1488 *keysym = Qbutton14up; | |
| 1489 else if (EQ(*keysym, Qmouse_15)) | |
| 1490 *keysym = Qbutton15up; | |
| 1491 else if (EQ(*keysym, Qmouse_16)) | |
| 1492 *keysym = Qbutton16up; | |
| 1493 else if (EQ(*keysym, Qmouse_17)) | |
| 1494 *keysym = Qbutton17up; | |
| 1495 else if (EQ(*keysym, Qmouse_18)) | |
| 1496 *keysym = Qbutton18up; | |
| 1497 else if (EQ(*keysym, Qmouse_19)) | |
| 1498 *keysym = Qbutton19up; | |
| 1499 else if (EQ(*keysym, Qmouse_20)) | |
| 1500 *keysym = Qbutton20up; | |
| 1501 else if (EQ(*keysym, Qmouse_21)) | |
| 1502 *keysym = Qbutton21up; | |
| 1503 else if (EQ(*keysym, Qmouse_22)) | |
| 1504 *keysym = Qbutton22up; | |
| 1505 else if (EQ(*keysym, Qmouse_23)) | |
| 1506 *keysym = Qbutton23up; | |
| 1507 else if (EQ(*keysym, Qmouse_24)) | |
| 1508 *keysym = Qbutton24up; | |
| 1509 else if (EQ(*keysym, Qmouse_25)) | |
| 1510 *keysym = Qbutton25up; | |
| 1511 else if (EQ(*keysym, Qmouse_26)) | |
| 1512 *keysym = Qbutton26up; | |
| 428 | 1513 } |
| 1514 } | |
| 1515 | |
| 1516 | |
| 1517 /* Given any kind of key-specifier, return a keysym and modifier mask. | |
| 1518 Proper canonicalization is performed: | |
| 1519 | |
| 1520 -- integers are converted into the equivalent characters. | |
| 1521 -- one-character strings are converted into the equivalent characters. | |
| 1522 */ | |
| 1523 | |
| 1524 static void | |
| 934 | 1525 define_key_parser (Lisp_Object spec, Lisp_Key_Data *returned_value) |
| 428 | 1526 { |
| 1527 if (CHAR_OR_CHAR_INTP (spec)) | |
| 1528 { | |
| 934 | 1529 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 1530 struct gcpro gcpro1; | |
| 1531 GCPRO1 (event); | |
| 1532 character_to_event (XCHAR_OR_CHAR_INT (spec), XEVENT (event), | |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
1533 XCONSOLE (Vselected_console), high_bit_is_meta, 0); |
| 1204 | 1534 SET_KEY_DATA_KEYSYM (returned_value, XEVENT_KEY_KEYSYM (event)); |
| 934 | 1535 SET_KEY_DATA_MODIFIERS (returned_value, |
| 1204 | 1536 XEVENT_KEY_MODIFIERS (event)); |
| 1537 UNGCPRO; | |
| 428 | 1538 } |
| 1539 else if (EVENTP (spec)) | |
| 1540 { | |
| 934 | 1541 switch (XEVENT_TYPE (spec)) |
| 428 | 1542 { |
| 1543 case key_press_event: | |
| 1544 { | |
| 1204 | 1545 SET_KEY_DATA_KEYSYM (returned_value, XEVENT_KEY_KEYSYM (spec)); |
| 1546 SET_KEY_DATA_MODIFIERS (returned_value, XEVENT_KEY_MODIFIERS (spec)); | |
| 428 | 1547 break; |
| 1548 } | |
| 1549 case button_press_event: | |
| 1550 case button_release_event: | |
| 1551 { | |
| 934 | 1552 int down = (XEVENT_TYPE (spec) == button_press_event); |
| 1204 | 1553 switch (XEVENT_BUTTON_BUTTON (spec)) |
| 934 | 1554 { |
| 1555 case 1: | |
| 1556 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton1 : Qbutton1up)); | |
| 1557 break; | |
| 1558 case 2: | |
| 1559 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton2 : Qbutton2up)); | |
| 1560 break; | |
| 1561 case 3: | |
| 1562 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton3 : Qbutton3up)); | |
| 1563 break; | |
| 1564 case 4: | |
| 1565 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton4 : Qbutton4up)); | |
| 1566 break; | |
| 1567 case 5: | |
| 1568 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton5 : Qbutton5up)); | |
| 1569 break; | |
| 1570 case 6: | |
| 1571 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton6 : Qbutton6up)); | |
| 1572 break; | |
| 1573 case 7: | |
| 1574 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton7 : Qbutton7up)); | |
| 1575 break; | |
| 4272 | 1576 case 8: |
| 1577 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton8 : Qbutton8up)); | |
| 1578 break; | |
| 1579 case 9: | |
| 1580 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton9 : Qbutton9up)); | |
| 1581 break; | |
| 1582 case 10: | |
| 1583 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton10 : Qbutton10up)); | |
| 1584 break; | |
| 1585 case 11: | |
| 1586 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton11 : Qbutton11up)); | |
| 1587 break; | |
| 1588 case 12: | |
| 1589 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton12 : Qbutton12up)); | |
| 1590 break; | |
| 1591 case 13: | |
| 1592 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton13 : Qbutton13up)); | |
| 1593 break; | |
| 1594 case 14: | |
| 1595 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton14 : Qbutton14up)); | |
| 1596 break; | |
| 1597 case 15: | |
| 1598 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton15 : Qbutton15up)); | |
| 1599 break; | |
| 1600 case 16: | |
| 1601 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton16 : Qbutton16up)); | |
| 1602 break; | |
| 1603 case 17: | |
| 1604 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton17 : Qbutton17up)); | |
| 1605 break; | |
| 1606 case 18: | |
| 1607 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton18 : Qbutton18up)); | |
| 1608 break; | |
| 1609 case 19: | |
| 1610 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton19 : Qbutton19up)); | |
| 1611 break; | |
| 1612 case 20: | |
| 1613 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton20 : Qbutton20up)); | |
| 1614 break; | |
| 1615 case 21: | |
| 1616 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton21 : Qbutton21up)); | |
| 1617 break; | |
| 1618 case 22: | |
| 1619 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton22 : Qbutton22up)); | |
| 1620 break; | |
| 1621 case 23: | |
| 1622 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton23 : Qbutton23up)); | |
| 1623 break; | |
| 1624 case 24: | |
| 1625 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton24 : Qbutton24up)); | |
| 1626 break; | |
| 1627 case 25: | |
| 1628 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton25 : Qbutton25up)); | |
| 1629 break; | |
| 1630 case 26: | |
| 1631 SET_KEY_DATA_KEYSYM(returned_value, (down ? Qbutton26 : Qbutton26up)); | |
| 1632 break; | |
| 934 | 1633 default: |
| 1634 SET_KEY_DATA_KEYSYM (returned_value, (down ? Qbutton0 : Qbutton0up)); | |
| 1635 break; | |
| 1636 } | |
| 1204 | 1637 SET_KEY_DATA_MODIFIERS (returned_value, XEVENT_BUTTON_MODIFIERS (spec)); |
| 428 | 1638 break; |
| 1639 } | |
| 1640 default: | |
| 563 | 1641 wtaerror ("unable to bind this type of event", spec); |
| 428 | 1642 } |
| 1643 } | |
| 1644 else if (SYMBOLP (spec)) | |
| 1645 { | |
| 1646 /* Be nice, allow = to mean (=) */ | |
| 1647 if (bucky_sym_to_bucky_bit (spec) != 0) | |
| 563 | 1648 invalid_argument ("Key is a modifier name", spec); |
| 428 | 1649 define_key_check_and_coerce_keysym (spec, &spec, 0); |
| 934 | 1650 SET_KEY_DATA_KEYSYM (returned_value, spec); |
| 1651 SET_KEY_DATA_MODIFIERS (returned_value, 0); | |
| 428 | 1652 } |
| 1653 else if (CONSP (spec)) | |
| 1654 { | |
| 442 | 1655 int modifiers = 0; |
| 428 | 1656 Lisp_Object keysym = Qnil; |
| 1657 Lisp_Object rest = spec; | |
| 1658 | |
| 1659 /* First, parse out the leading modifier symbols. */ | |
| 1660 while (CONSP (rest)) | |
| 1661 { | |
| 442 | 1662 int modifier; |
| 428 | 1663 |
| 1664 keysym = XCAR (rest); | |
| 1665 modifier = bucky_sym_to_bucky_bit (keysym); | |
| 1666 modifiers |= modifier; | |
| 1667 if (!NILP (XCDR (rest))) | |
| 1668 { | |
| 1669 if (! modifier) | |
| 563 | 1670 invalid_argument ("Unknown modifier", keysym); |
| 428 | 1671 } |
| 1672 else | |
| 1673 { | |
| 1674 if (modifier) | |
| 563 | 1675 sferror ("Nothing but modifiers here", |
| 428 | 1676 spec); |
| 1677 } | |
| 1678 rest = XCDR (rest); | |
| 1679 QUIT; | |
| 1680 } | |
| 1681 if (!NILP (rest)) | |
| 563 | 1682 signal_error (Qlist_formation_error, |
| 1683 "List must be nil-terminated", spec); | |
| 428 | 1684 |
| 1685 define_key_check_and_coerce_keysym (spec, &keysym, modifiers); | |
| 934 | 1686 SET_KEY_DATA_KEYSYM(returned_value, keysym); |
| 1687 SET_KEY_DATA_MODIFIERS (returned_value, modifiers); | |
| 428 | 1688 } |
| 1689 else | |
| 1690 { | |
| 563 | 1691 invalid_argument ("Unknown key-sequence specifier", |
| 428 | 1692 spec); |
| 1693 } | |
| 1694 } | |
| 1695 | |
| 1696 /* Used by character-to-event */ | |
| 1697 void | |
| 1698 key_desc_list_to_event (Lisp_Object list, Lisp_Object event, | |
| 1699 int allow_menu_events) | |
| 1700 { | |
| 934 | 1701 Lisp_Key_Data raw_key; |
| 428 | 1702 |
| 1703 if (allow_menu_events && | |
| 1704 CONSP (list) && | |
| 1705 /* #### where the hell does this come from? */ | |
| 1706 EQ (XCAR (list), Qmenu_selection)) | |
| 1707 { | |
| 1708 Lisp_Object fn, arg; | |
| 1709 if (! NILP (Fcdr (Fcdr (list)))) | |
| 563 | 1710 invalid_argument ("Invalid menu event desc", list); |
| 428 | 1711 arg = Fcar (Fcdr (list)); |
| 1712 if (SYMBOLP (arg)) | |
| 1713 fn = Qcall_interactively; | |
| 1714 else | |
| 1715 fn = Qeval; | |
| 934 | 1716 XSET_EVENT_TYPE (event, misc_user_event); |
| 1204 | 1717 XSET_EVENT_CHANNEL (event, wrap_frame (selected_frame ())); |
| 1718 XSET_EVENT_MISC_USER_FUNCTION (event, fn); | |
| 1719 XSET_EVENT_MISC_USER_OBJECT (event, arg); | |
| 428 | 1720 return; |
| 1721 } | |
| 1722 | |
| 1723 define_key_parser (list, &raw_key); | |
| 1724 | |
| 1725 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) || | |
| 1726 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) || | |
| 1727 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) || | |
| 1728 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) || | |
| 1729 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) || | |
| 1730 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) || | |
| 1731 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) || | |
| 4272 | 1732 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up) || |
| 1733 EQ (raw_key.keysym, Qbutton8) || EQ (raw_key.keysym, Qbutton8up) || | |
| 1734 EQ (raw_key.keysym, Qbutton9) || EQ (raw_key.keysym, Qbutton9up) || | |
| 1735 EQ (raw_key.keysym, Qbutton10) || EQ (raw_key.keysym, Qbutton10up) || | |
| 1736 EQ (raw_key.keysym, Qbutton11) || EQ (raw_key.keysym, Qbutton11up) || | |
| 1737 EQ (raw_key.keysym, Qbutton12) || EQ (raw_key.keysym, Qbutton12up) || | |
| 1738 EQ (raw_key.keysym, Qbutton13) || EQ (raw_key.keysym, Qbutton13up) || | |
| 1739 EQ (raw_key.keysym, Qbutton14) || EQ (raw_key.keysym, Qbutton14up) || | |
| 1740 EQ (raw_key.keysym, Qbutton15) || EQ (raw_key.keysym, Qbutton15up) || | |
| 1741 EQ (raw_key.keysym, Qbutton16) || EQ (raw_key.keysym, Qbutton16up) || | |
| 1742 EQ (raw_key.keysym, Qbutton17) || EQ (raw_key.keysym, Qbutton17up) || | |
| 1743 EQ (raw_key.keysym, Qbutton18) || EQ (raw_key.keysym, Qbutton18up) || | |
| 1744 EQ (raw_key.keysym, Qbutton19) || EQ (raw_key.keysym, Qbutton19up) || | |
| 1745 EQ (raw_key.keysym, Qbutton20) || EQ (raw_key.keysym, Qbutton20up) || | |
| 1746 EQ (raw_key.keysym, Qbutton21) || EQ (raw_key.keysym, Qbutton21up) || | |
| 1747 EQ (raw_key.keysym, Qbutton22) || EQ (raw_key.keysym, Qbutton22up) || | |
| 1748 EQ (raw_key.keysym, Qbutton23) || EQ (raw_key.keysym, Qbutton23up) || | |
| 1749 EQ (raw_key.keysym, Qbutton24) || EQ (raw_key.keysym, Qbutton24up) || | |
| 1750 EQ (raw_key.keysym, Qbutton25) || EQ (raw_key.keysym, Qbutton25up) || | |
| 1751 EQ (raw_key.keysym, Qbutton26) || EQ (raw_key.keysym, Qbutton26up)) | |
| 563 | 1752 invalid_operation ("Mouse-clicks can't appear in saved keyboard macros", |
| 1753 Qunbound); | |
| 428 | 1754 |
| 934 | 1755 XSET_EVENT_CHANNEL (event, Vselected_console); |
| 1756 XSET_EVENT_TYPE (event, key_press_event); | |
| 1204 | 1757 XSET_EVENT_KEY_KEYSYM (event, raw_key.keysym); |
| 1758 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (&raw_key)); | |
| 428 | 1759 } |
| 1760 | |
| 1761 | |
| 1762 int | |
| 1204 | 1763 event_matches_key_specifier_p (Lisp_Object event, Lisp_Object key_specifier) |
| 428 | 1764 { |
| 446 | 1765 Lisp_Object event2 = Qnil; |
| 428 | 1766 int retval; |
| 1767 struct gcpro gcpro1; | |
| 1768 | |
| 1204 | 1769 if (XEVENT_TYPE (event) != key_press_event || NILP (key_specifier) || |
| 428 | 1770 (INTP (key_specifier) && !CHAR_INTP (key_specifier))) |
| 1771 return 0; | |
| 1772 | |
| 1773 /* if the specifier is an integer such as 27, then it should match | |
| 3025 | 1774 both of the events `escape' and `control ['. Calling |
| 1775 Fcharacter_to_event() will only match `escape'. */ | |
| 428 | 1776 if (CHAR_OR_CHAR_INTP (key_specifier)) |
| 1777 return (XCHAR_OR_CHAR_INT (key_specifier) | |
| 2828 | 1778 == event_to_character (event, 0, 0)); |
| 428 | 1779 |
| 1780 /* Otherwise, we cannot call event_to_character() because we may | |
| 1781 be dealing with non-ASCII keystrokes. In any case, if I ask | |
| 3025 | 1782 for `control [' then I should get exactly that, and not |
| 1783 `escape'. | |
| 1784 | |
| 1785 However, we have to behave differently on TTY's, where `control [' | |
| 1786 is silently converted into `escape' by the keyboard driver. | |
| 428 | 1787 In this case, ASCII is the only thing we know about, so we have |
| 1788 to compare the ASCII values. */ | |
| 1789 | |
| 1790 GCPRO1 (event2); | |
| 1204 | 1791 if (EVENTP (key_specifier)) |
| 1792 event2 = Fcopy_event (key_specifier, Qnil); | |
| 1793 else | |
| 1794 event2 = Fcharacter_to_event (key_specifier, Qnil, Qnil, Qnil); | |
| 428 | 1795 if (XEVENT (event2)->event_type != key_press_event) |
| 1796 retval = 0; | |
| 1204 | 1797 else if (CONSOLE_TTY_P (XCONSOLE (XEVENT_CHANNEL (event)))) |
| 428 | 1798 { |
| 1799 int ch1, ch2; | |
| 1800 | |
| 2828 | 1801 ch1 = event_to_character (event, 0, 0); |
| 1802 ch2 = event_to_character (event2, 0, 0); | |
| 428 | 1803 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2); |
| 1804 } | |
| 1204 | 1805 else if (EQ (XEVENT_KEY_KEYSYM (event), XEVENT_KEY_KEYSYM (event2)) && |
| 1806 XEVENT_KEY_MODIFIERS (event) == XEVENT_KEY_MODIFIERS (event2)) | |
| 428 | 1807 retval = 1; |
| 1808 else | |
| 1809 retval = 0; | |
| 1810 Fdeallocate_event (event2); | |
| 1811 UNGCPRO; | |
| 1812 return retval; | |
| 1813 } | |
| 1814 | |
| 1815 static int | |
| 934 | 1816 meta_prefix_char_p (const Lisp_Key_Data *key) |
| 428 | 1817 { |
| 934 | 1818 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 1819 struct gcpro gcpro1; | |
| 1204 | 1820 int retval; |
| 1821 | |
| 934 | 1822 GCPRO1 (event); |
| 1823 | |
| 1824 XSET_EVENT_TYPE (event, key_press_event); | |
| 1825 XSET_EVENT_CHANNEL (event, Vselected_console); | |
| 1204 | 1826 XSET_EVENT_KEY_KEYSYM (event, KEY_DATA_KEYSYM (key)); |
| 1827 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (key)); | |
| 1828 retval = event_matches_key_specifier_p (event, Vmeta_prefix_char); | |
| 1829 UNGCPRO; | |
| 1830 return retval; | |
| 428 | 1831 } |
| 1832 | |
| 1833 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /* | |
| 1834 Return non-nil if EVENT matches KEY-SPECIFIER. | |
| 1835 This can be useful, e.g., to determine if the user pressed `help-char' or | |
| 1836 `quit-char'. | |
| 1204 | 1837 |
| 1838 KEY-SPECIFIER can be a character, integer, a symbol, a list of modifiers | |
| 1839 and symbols, or an event. | |
| 1840 | |
| 1841 What this actually happens is this: | |
| 1842 | |
| 1843 \(1) Return no, if EVENT is not a key press event or if KEY-SPECIFIER is nil | |
| 1844 or an integer that cannot be converted to a character. | |
| 1845 | |
| 1846 \(2) If KEY-SPECIFIER is a character or integer, | |
| 1847 (event-to-character EVENT nil nil nil) is called, and the characters are | |
| 1848 compared to get the result. The reason for special-casing this and doing | |
| 1849 it this way is to ensure that, e.g., a KEY-SPECIFIER of 27 matches both | |
| 1850 a key-press `escape' and a key-press `control ['. #### Think about META | |
| 1851 argument to event-to-character. | |
| 1852 | |
| 1853 \(3) If KEY-SPECIFIER is an event, fine; else, convert to an event using | |
| 1854 \(character-to-event KEY-SPECIFIER nil nil nil). If EVENT is not on a TTY, | |
| 1855 we just compare keysyms and modifiers and return yes if both are equal. | |
| 1856 For TTY, we do character-level comparison by converting both to a character | |
| 1857 with (event-to-character ... nil nil nil) and comparing the characters. | |
| 1858 | |
| 428 | 1859 */ |
| 1860 (event, key_specifier)) | |
| 1861 { | |
| 1862 CHECK_LIVE_EVENT (event); | |
| 1204 | 1863 return (event_matches_key_specifier_p (event, key_specifier) ? Qt : Qnil); |
| 428 | 1864 } |
| 1204 | 1865 #define MACROLET(k, m) do { \ |
| 1866 SET_KEY_DATA_KEYSYM (returned_value, k); \ | |
| 1867 SET_KEY_DATA_MODIFIERS (returned_value, m); \ | |
| 1868 RETURN_SANS_WARNINGS; \ | |
| 934 | 1869 } while (0) |
| 428 | 1870 /* ASCII grunge. |
| 1871 Given a keysym, return another keysym/modifier pair which could be | |
| 1872 considered the same key in an ASCII world. Backspace returns ^H, for | |
| 1873 example. | |
| 1874 */ | |
| 1875 static void | |
| 934 | 1876 define_key_alternate_name (Lisp_Key_Data *key, |
| 1877 Lisp_Key_Data *returned_value) | |
| 428 | 1878 { |
| 934 | 1879 Lisp_Object keysym = KEY_DATA_KEYSYM (key); |
| 1880 int modifiers = KEY_DATA_MODIFIERS (key); | |
| 442 | 1881 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL)); |
| 1882 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META)); | |
| 934 | 1883 SET_KEY_DATA_KEYSYM (returned_value, Qnil); /* By default, no "alternate" key */ |
| 1884 SET_KEY_DATA_MODIFIERS (returned_value, 0); | |
| 442 | 1885 if (modifiers_sans_meta == XEMACS_MOD_CONTROL) |
| 428 | 1886 { |
| 722 | 1887 if (EQ (keysym, QKspace)) |
| 428 | 1888 MACROLET (make_char ('@'), modifiers); |
| 1889 else if (!CHARP (keysym)) | |
| 1890 return; | |
| 1891 else switch (XCHAR (keysym)) | |
| 1892 { | |
| 1893 case '@': /* c-@ => c-space */ | |
| 1894 MACROLET (QKspace, modifiers); | |
| 1895 case 'h': /* c-h => backspace */ | |
| 1896 MACROLET (QKbackspace, modifiers_sans_control); | |
| 1897 case 'i': /* c-i => tab */ | |
| 1898 MACROLET (QKtab, modifiers_sans_control); | |
| 1899 case 'j': /* c-j => linefeed */ | |
| 1900 MACROLET (QKlinefeed, modifiers_sans_control); | |
| 1901 case 'm': /* c-m => return */ | |
| 1902 MACROLET (QKreturn, modifiers_sans_control); | |
| 1903 case '[': /* c-[ => escape */ | |
| 1904 MACROLET (QKescape, modifiers_sans_control); | |
| 1905 default: | |
| 1906 return; | |
| 1907 } | |
| 1908 } | |
| 1909 else if (modifiers_sans_meta != 0) | |
| 1910 return; | |
| 1911 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */ | |
| 442 | 1912 MACROLET (make_char ('h'), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1913 else if (EQ (keysym, QKtab)) /* tab => c-i */ |
| 442 | 1914 MACROLET (make_char ('i'), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1915 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */ |
| 442 | 1916 MACROLET (make_char ('j'), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1917 else if (EQ (keysym, QKreturn)) /* return => c-m */ |
| 442 | 1918 MACROLET (make_char ('m'), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1919 else if (EQ (keysym, QKescape)) /* escape => c-[ */ |
| 442 | 1920 MACROLET (make_char ('['), (modifiers | XEMACS_MOD_CONTROL)); |
| 428 | 1921 else |
| 1922 return; | |
| 1923 #undef MACROLET | |
| 1924 } | |
| 1925 | |
| 1926 static void | |
| 1927 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx, | |
| 1928 Lisp_Object keymap) | |
| 1929 { | |
| 1930 /* This function can GC */ | |
| 1931 Lisp_Object new_keys; | |
| 1932 int i; | |
| 1933 Lisp_Object mpc_binding; | |
| 934 | 1934 Lisp_Key_Data meta_key; |
| 428 | 1935 if (NILP (Vmeta_prefix_char) || |
| 1936 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char))) | |
| 1937 return; | |
| 1938 | |
| 1939 define_key_parser (Vmeta_prefix_char, &meta_key); | |
| 1940 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0); | |
| 1941 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding))) | |
| 1942 return; | |
| 1943 | |
| 1944 if (indx == 0) | |
| 1945 new_keys = keys; | |
| 1946 else if (STRINGP (keys)) | |
| 1947 new_keys = Fsubstring (keys, Qzero, make_int (indx)); | |
| 1948 else if (VECTORP (keys)) | |
| 1949 { | |
| 1950 new_keys = make_vector (indx, Qnil); | |
| 1951 for (i = 0; i < indx; i++) | |
| 1952 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i]; | |
| 1953 } | |
| 1954 else | |
| 442 | 1955 { |
| 1956 new_keys = Qnil; | |
| 2500 | 1957 ABORT (); |
| 442 | 1958 } |
| 428 | 1959 |
| 1960 if (EQ (keys, new_keys)) | |
| 563 | 1961 signal_ferror_with_frob (Qinvalid_operation, mpc_binding, |
| 1962 "can't bind %s: %s has a non-keymap binding", | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1963 (CIbyte *) XSTRING_DATA (Fkey_description (keys)), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1964 (CIbyte *) XSTRING_DATA (Fsingle_key_description |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1965 (Vmeta_prefix_char))); |
| 428 | 1966 else |
| 563 | 1967 signal_ferror_with_frob (Qinvalid_operation, mpc_binding, |
| 1968 "can't bind %s: %s %s has a non-keymap binding", | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1969 (CIbyte *) XSTRING_DATA (Fkey_description (keys)), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1970 (CIbyte *) XSTRING_DATA (Fkey_description |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1971 (new_keys)), |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1972 (CIbyte *) XSTRING_DATA (Fsingle_key_description |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1973 (Vmeta_prefix_char))); |
| 428 | 1974 } |
| 1975 | |
| 1976 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /* | |
| 1977 Define key sequence KEYS, in KEYMAP, as DEF. | |
| 1978 KEYMAP is a keymap object. | |
| 3086 | 1979 KEYS is the key sequence to bind, described below. |
| 428 | 1980 DEF is anything that can be a key's definition: |
| 1981 nil (means key is undefined in this keymap); | |
| 1982 a command (a Lisp function suitable for interactive calling); | |
| 1983 a string or key sequence vector (treated as a keyboard macro); | |
| 1984 a keymap (to define a prefix key); | |
| 1985 a symbol; when the key is looked up, the symbol will stand for its | |
| 1986 function definition, that should at that time be one of the above, | |
| 1987 or another symbol whose function definition is used, and so on. | |
| 1988 a cons (STRING . DEFN), meaning that DEFN is the definition | |
| 1989 (DEFN should be a valid definition in its own right); | |
| 1990 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP. | |
| 1991 | |
| 3086 | 1992 A `key sequence' is a vector of one or more keystrokes. |
| 1993 A `keystroke' is a list containing a key and zero or more modifiers. The | |
| 1994 key must be the last element of the list. | |
| 1995 A `key' is a symbol corresponding to a key on the keyboard, or to a mouse | |
| 1996 gesture. Mouse clicks are denoted by symbols prefixed with "button", | |
| 1997 followed by a digit for which button, and optionally "up". Thus `button1' | |
| 1998 means the down-stroke and `button1up' means the up-stroke when clicking | |
| 1999 mouse button 1. | |
| 2000 A `modifier' is a symbol naming a physical key which is only "noticed" by | |
| 2001 XEmacs when chorded with another key. The `shift' modifier is a special | |
| 2002 case. You cannot use `(meta shift a)' to mean `(meta A)', since for | |
| 2003 characters that have ASCII equivalents, the state of the shift key is | |
| 2004 implicit in the keysym (a vs. A). You also cannot say `(shift =)' to mean | |
| 2005 `+', as that correspondence varies from keyboard to keyboard. The shift | |
| 2006 modifier can only be applied to keys that do not have a second keysym on the | |
| 2007 same key, such as `backspace' and `tab'. A mouse click may be combined with | |
| 2008 modifiers to create a compound "keystroke". | |
| 2009 | |
| 2010 The keys, mouse gestures, and modifiers that are available depend on your | |
| 2011 console and its driver. At a minimum the ASCII graphic characters will be | |
| 2012 available as keys, and shift, control, and meta as modifiers. | |
| 2013 | |
| 2014 To find out programmatically what a key is bound to, use `key-binding' to | |
| 2015 check all applicable keymaps, or `lookup-key' to check a specific keymap. | |
| 2016 The documentation for `key-binding' also contains a description of which | |
| 2017 keymaps are applicable in various situations. `where-is-internal' does | |
| 2018 the opposite of `key-binding', i.e. searches keymaps for the keys that | |
| 2019 map to a particular binding. | |
| 2020 | |
| 2021 If you are confused about why a particular key sequence is generating a | |
| 2022 particular binding, and looking through the keymaps doesn't help, setting | |
| 2023 the variable `debug-emacs-events' may help. If not, try checking | |
| 2024 what's in `function-key-map' and `key-translation-map'. | |
| 2025 | |
| 2026 When running under a window system, typically the repertoire of keys is | |
| 2027 vastly expanded. XEmacs does its best to use the names defined on each | |
| 2028 platform. Also, when running under a window system, XEmacs can tell the | |
| 2029 difference between the keystrokes control-h, control-shift-h, and backspace. | |
| 2030 If the symbols differ, you can bind different actions to each. For mouse | |
| 2031 clicks, different commands may be bound to the up and down strokes, though | |
| 2032 that is probably not what you want, so be careful. | |
| 2033 | |
| 2034 Variant representations: | |
| 2035 | |
| 2036 Besides the canonical representation as a vector of lists of symbols, | |
| 2037 `define-key' also accepts a number of abbreviations, aliases, and variants | |
| 2038 for convenience, compatibility, and internal use. | |
| 2039 | |
| 2040 A keystroke may be represented by a key; this is treated as though it were a | |
| 2041 list containing that key as the only element. A keystroke may also be | |
| 2042 represented by an event object, as returned by the `next-command-event' and | |
| 2043 `read-key-sequence' functions. A key sequence may be represented by a | |
| 2044 single keystroke; this is treated as a vector containing that keystroke as | |
| 2045 its only element. | |
| 2046 | |
| 2047 A key may be represented by a character or its equivalent integer code, | |
| 2048 if and only if it is equivalent to a character with a code in the range | |
| 2049 32 - 255. | |
| 2050 | |
| 2051 For backward compatibility, a key sequence may also be represented by a | |
| 2052 string. In this case, it represents the key sequence(s) that would | |
| 2053 produce that sequence of ASCII characters in a purely ASCII world. An | |
| 2054 alternative string representation is keyboard macro notation, which can | |
| 2055 be translated to the canonical representation with `kbd'. | |
| 2056 | |
| 2057 Examples: | |
| 2058 | |
| 2059 The key sequence `A' (which invokes `self-insert-command') is represented | |
| 2060 by all of these forms: | |
| 428 | 2061 A ?A 65 (A) (?A) (65) |
| 2062 [A] [?A] [65] [(A)] [(?A)] [(65)] | |
| 2063 | |
| 3086 | 2064 The key sequence `control-a' is represented by these forms: |
| 428 | 2065 (control A) (control ?A) (control 65) |
| 2066 [(control A)] [(control ?A)] [(control 65)] | |
| 3086 | 2067 |
| 2068 The key sequence `control-c control-a' is represented by these forms: | |
| 428 | 2069 [(control c) (control a)] [(control ?c) (control ?a)] |
| 2070 [(control 99) (control 65)] etc. | |
| 2071 | |
| 3086 | 2072 The keystroke `control-b' *may not* be represented by the number 2 (the |
| 2073 ASCII code for ^B) or the character `?\^B'. | |
| 2074 | |
| 2075 The `break' key may be represented only by the symbol `break'. | |
| 2076 | |
| 428 | 2077 Mouse button clicks work just like keypresses: (control button1) means |
| 2078 pressing the left mouse button while holding down the control key. | |
| 3086 | 2079 |
| 2080 A string containing the ASCII backspace character, "\\^H", would represent | |
| 2081 two key sequences: `(control h)' and `backspace'. Binding a | |
| 428 | 2082 command to this will actually bind both of those key sequences. Likewise |
| 2083 for the following pairs: | |
| 2084 | |
| 2085 control h backspace | |
| 2086 control i tab | |
| 2087 control m return | |
| 2088 control j linefeed | |
| 2089 control [ escape | |
| 2090 control @ control space | |
| 2091 | |
| 2092 After binding a command to two key sequences with a form like | |
| 2093 | |
| 2094 (define-key global-map "\\^X\\^I" \'command-1) | |
| 2095 | |
| 2096 it is possible to redefine only one of those sequences like so: | |
| 2097 | |
| 2098 (define-key global-map [(control x) (control i)] \'command-2) | |
| 2099 (define-key global-map [(control x) tab] \'command-3) | |
| 2100 */ | |
| 2101 (keymap, keys, def)) | |
| 2102 { | |
| 2103 /* This function can GC */ | |
| 2104 int idx; | |
| 2105 int metized = 0; | |
| 2106 int len; | |
| 2107 int ascii_hack; | |
| 2108 struct gcpro gcpro1, gcpro2, gcpro3; | |
| 2109 | |
| 2110 if (VECTORP (keys)) | |
| 2111 len = XVECTOR_LENGTH (keys); | |
| 2112 else if (STRINGP (keys)) | |
| 826 | 2113 len = string_char_length (keys); |
| 428 | 2114 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys)) |
| 2115 { | |
| 2116 if (!CONSP (keys)) keys = list1 (keys); | |
| 2117 len = 1; | |
| 2118 keys = make_vector (1, keys); /* this is kinda sleazy. */ | |
| 2119 } | |
| 2120 else | |
| 2121 { | |
| 2122 keys = wrong_type_argument (Qsequencep, keys); | |
| 2123 len = XINT (Flength (keys)); | |
| 2124 } | |
| 2125 if (len == 0) | |
| 2126 return Qnil; | |
| 2127 | |
| 2128 GCPRO3 (keymap, keys, def); | |
| 2129 | |
| 2130 /* ASCII grunge. | |
| 2131 When the user defines a key which, in a strictly ASCII world, would be | |
| 2132 produced by two different keys (^J and linefeed, or ^H and backspace, | |
| 2133 for example) then the binding will be made for both keysyms. | |
| 2134 | |
| 2135 This is done if the user binds a command to a string, as in | |
| 3086 | 2136 (define-key map "\^H" 'something), but not when using the canonical |
| 2137 syntax (define-key map '(control h) 'something). | |
| 428 | 2138 */ |
| 2139 ascii_hack = (STRINGP (keys)); | |
| 2140 | |
| 2141 keymap = get_keymap (keymap, 1, 1); | |
| 2142 | |
| 2143 idx = 0; | |
| 2144 while (1) | |
| 2145 { | |
| 2146 Lisp_Object c; | |
| 934 | 2147 Lisp_Key_Data raw_key1; |
| 2148 Lisp_Key_Data raw_key2; | |
| 428 | 2149 if (STRINGP (keys)) |
| 867 | 2150 c = make_char (string_ichar (keys, idx)); |
| 428 | 2151 else |
| 2152 c = XVECTOR_DATA (keys) [idx]; | |
| 2153 | |
| 2154 define_key_parser (c, &raw_key1); | |
| 2155 | |
| 2156 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1)) | |
| 2157 { | |
| 2158 if (idx == (len - 1)) | |
| 2159 { | |
| 2160 /* This is a hack to prevent a binding for the meta-prefix-char | |
| 2161 from being made in a map which already has a non-empty "meta" | |
| 2162 submap. That is, we can't let both "escape" and "meta" have | |
| 2163 a binding in the same keymap. This implies that the idiom | |
| 2164 (define-key my-map "\e" my-escape-map) | |
| 2165 (define-key my-escape-map "a" 'my-command) | |
| 2166 no longer works. That's ok. Instead the luser should do | |
| 2167 (define-key my-map "\ea" 'my-command) | |
| 2168 or, more correctly | |
| 2169 (define-key my-map "\M-a" 'my-command) | |
| 2170 and then perhaps | |
| 2171 (defvar my-escape-map (lookup-key my-map "\e")) | |
| 2172 if the luser really wants the map in a variable. | |
| 2173 */ | |
| 440 | 2174 Lisp_Object meta_map; |
| 428 | 2175 struct gcpro ngcpro1; |
| 2176 | |
| 2177 NGCPRO1 (c); | |
| 442 | 2178 meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 440 | 2179 XKEYMAP (keymap)->table, Qnil); |
| 2180 if (!NILP (meta_map) | |
| 2181 && keymap_fullness (meta_map) != 0) | |
| 563 | 2182 invalid_operation_2 |
| 440 | 2183 ("Map contains meta-bindings, can't bind", |
| 2184 Fsingle_key_description (Vmeta_prefix_char), keymap); | |
| 428 | 2185 NUNGCPRO; |
| 2186 } | |
| 2187 else | |
| 2188 { | |
| 2189 metized = 1; | |
| 2190 idx++; | |
| 2191 continue; | |
| 2192 } | |
| 2193 } | |
| 2194 | |
| 2195 if (ascii_hack) | |
| 2196 define_key_alternate_name (&raw_key1, &raw_key2); | |
| 2197 else | |
| 2198 { | |
| 2199 raw_key2.keysym = Qnil; | |
| 2200 raw_key2.modifiers = 0; | |
| 2201 } | |
| 2202 | |
| 2203 if (metized) | |
| 2204 { | |
| 442 | 2205 raw_key1.modifiers |= XEMACS_MOD_META; |
| 2206 raw_key2.modifiers |= XEMACS_MOD_META; | |
| 428 | 2207 metized = 0; |
| 2208 } | |
| 2209 | |
| 2210 /* This crap is to make sure that someone doesn't bind something like | |
| 2211 "C-x M-a" while "C-x ESC" has a non-keymap binding. */ | |
| 442 | 2212 if (raw_key1.modifiers & XEMACS_MOD_META) |
| 428 | 2213 ensure_meta_prefix_char_keymapp (keys, idx, keymap); |
| 2214 | |
| 2215 if (++idx == len) | |
| 2216 { | |
| 2217 keymap_store (keymap, &raw_key1, def); | |
| 2218 if (ascii_hack && !NILP (raw_key2.keysym)) | |
| 2219 keymap_store (keymap, &raw_key2, def); | |
| 2220 UNGCPRO; | |
| 2221 return def; | |
| 2222 } | |
| 2223 | |
| 2224 { | |
| 2225 Lisp_Object cmd; | |
| 2226 struct gcpro ngcpro1; | |
| 2227 NGCPRO1 (c); | |
| 2228 | |
| 2229 cmd = keymap_lookup_1 (keymap, &raw_key1, 0); | |
| 2230 if (NILP (cmd)) | |
| 2231 { | |
| 2232 cmd = Fmake_sparse_keymap (Qnil); | |
| 2233 XKEYMAP (cmd)->name /* for debugging */ | |
| 2234 = list2 (make_key_description (&raw_key1, 1), keymap); | |
| 2235 keymap_store (keymap, &raw_key1, cmd); | |
| 2236 } | |
| 2237 if (NILP (Fkeymapp (cmd))) | |
| 563 | 2238 sferror_2 ("Invalid prefix keys in sequence", |
| 428 | 2239 c, keys); |
| 2240 | |
| 2241 if (ascii_hack && !NILP (raw_key2.keysym) && | |
| 2242 NILP (keymap_lookup_1 (keymap, &raw_key2, 0))) | |
| 2243 keymap_store (keymap, &raw_key2, cmd); | |
| 2244 | |
| 2245 keymap = get_keymap (cmd, 1, 1); | |
| 2246 NUNGCPRO; | |
| 2247 } | |
| 2248 } | |
| 2249 } | |
| 2250 | |
| 2251 | |
| 2252 /************************************************************************/ | |
| 2253 /* Looking up keys in keymaps */ | |
| 2254 /************************************************************************/ | |
| 2255 | |
| 2256 /* We need a very fast (i.e., non-consing) version of lookup-key in order | |
| 2257 to make where-is-internal really fly. */ | |
| 2258 | |
| 2259 struct raw_lookup_key_mapper_closure | |
| 2260 { | |
| 2261 int remaining; | |
| 934 | 2262 const Lisp_Key_Data *raw_keys; |
| 428 | 2263 int raw_keys_count; |
| 2264 int keys_so_far; | |
| 2265 int accept_default; | |
| 2266 }; | |
| 2267 | |
| 2268 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *); | |
| 2269 | |
| 2270 /* Caller should gc-protect args (keymaps may autoload) */ | |
| 2271 static Lisp_Object | |
| 2272 raw_lookup_key (Lisp_Object keymap, | |
| 934 | 2273 const Lisp_Key_Data *raw_keys, int raw_keys_count, |
| 428 | 2274 int keys_so_far, int accept_default) |
| 2275 { | |
| 2276 /* This function can GC */ | |
| 2277 struct raw_lookup_key_mapper_closure c; | |
| 2278 c.remaining = raw_keys_count - 1; | |
| 2279 c.raw_keys = raw_keys; | |
| 2280 c.raw_keys_count = raw_keys_count; | |
| 2281 c.keys_so_far = keys_so_far; | |
| 2282 c.accept_default = accept_default; | |
| 2283 | |
| 2284 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c); | |
| 2285 } | |
| 2286 | |
| 2287 static Lisp_Object | |
| 2288 raw_lookup_key_mapper (Lisp_Object k, void *arg) | |
| 2289 { | |
| 2290 /* This function can GC */ | |
| 2291 struct raw_lookup_key_mapper_closure *c = | |
| 2292 (struct raw_lookup_key_mapper_closure *) arg; | |
| 2293 int accept_default = c->accept_default; | |
| 2294 int remaining = c->remaining; | |
| 2295 int keys_so_far = c->keys_so_far; | |
| 934 | 2296 const Lisp_Key_Data *raw_keys = c->raw_keys; |
| 428 | 2297 Lisp_Object cmd; |
| 2298 | |
| 2299 if (! meta_prefix_char_p (&(raw_keys[0]))) | |
| 2300 { | |
| 2301 /* Normal case: every case except the meta-hack (see below). */ | |
| 2302 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); | |
| 2303 | |
| 2304 if (remaining == 0) | |
| 2305 /* Return whatever we found if we're out of keys */ | |
| 2306 ; | |
| 2307 else if (NILP (cmd)) | |
| 2308 /* Found nothing (though perhaps parent map may have binding) */ | |
| 2309 ; | |
| 2310 else if (NILP (Fkeymapp (cmd))) | |
| 2311 /* Didn't find a keymap, and we have more keys. | |
| 2312 * Return a fixnum to indicate that keys were too long. | |
| 2313 */ | |
| 2314 cmd = make_int (keys_so_far + 1); | |
| 2315 else | |
| 2316 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, | |
| 2317 keys_so_far + 1, accept_default); | |
| 2318 } | |
| 2319 else | |
| 2320 { | |
| 2321 /* This is a hack so that looking up a key-sequence whose last | |
| 2322 * element is the meta-prefix-char will return the keymap that | |
| 2323 * the "meta" keys are stored in, if there is no binding for | |
| 2324 * the meta-prefix-char (and if this map has a "meta" submap). | |
| 2325 * If this map doesn't have a "meta" submap, then the | |
| 2326 * meta-prefix-char is looked up just like any other key. | |
| 2327 */ | |
| 2328 if (remaining == 0) | |
| 2329 { | |
| 2330 /* First look for the prefix-char directly */ | |
| 2331 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); | |
| 2332 if (NILP (cmd)) | |
| 2333 { | |
| 2334 /* Do kludgy return of the meta-map */ | |
| 442 | 2335 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 428 | 2336 XKEYMAP (k)->table, Qnil); |
| 2337 } | |
| 2338 } | |
| 2339 else | |
| 2340 { | |
| 2341 /* Search for the prefix-char-prefixed sequence directly */ | |
| 2342 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default); | |
| 2343 cmd = get_keymap (cmd, 0, 1); | |
| 2344 if (!NILP (cmd)) | |
| 2345 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining, | |
| 2346 keys_so_far + 1, accept_default); | |
| 442 | 2347 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0) |
| 428 | 2348 { |
| 934 | 2349 Lisp_Key_Data metified; |
| 428 | 2350 metified.keysym = raw_keys[1].keysym; |
| 442 | 2351 metified.modifiers = raw_keys[1].modifiers | |
| 2352 (unsigned char) XEMACS_MOD_META; | |
| 428 | 2353 |
| 2354 /* Search for meta-next-char sequence directly */ | |
| 2355 cmd = keymap_lookup_1 (k, &metified, accept_default); | |
| 2356 if (remaining == 1) | |
| 2357 ; | |
| 2358 else | |
| 2359 { | |
| 2360 cmd = get_keymap (cmd, 0, 1); | |
| 2361 if (!NILP (cmd)) | |
| 2362 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1, | |
| 2363 keys_so_far + 2, | |
| 2364 accept_default); | |
| 2365 } | |
| 2366 } | |
| 2367 } | |
| 2368 } | |
| 2369 if (accept_default && NILP (cmd)) | |
| 2370 cmd = XKEYMAP (k)->default_binding; | |
| 2371 return cmd; | |
| 2372 } | |
| 2373 | |
| 2374 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/ | |
| 2375 /* Caller should gc-protect arguments */ | |
| 2376 static Lisp_Object | |
| 2377 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys, | |
| 2378 int accept_default) | |
| 2379 { | |
| 2380 /* This function can GC */ | |
| 934 | 2381 Lisp_Key_Data kkk[20]; |
| 2382 Lisp_Key_Data *raw_keys; | |
| 428 | 2383 int i; |
| 2384 | |
| 2385 if (nkeys == 0) | |
| 2386 return Qnil; | |
| 2387 | |
| 438 | 2388 if (nkeys < countof (kkk)) |
| 428 | 2389 raw_keys = kkk; |
| 2390 else | |
| 934 | 2391 raw_keys = alloca_array (Lisp_Key_Data, nkeys); |
| 428 | 2392 |
| 2393 for (i = 0; i < nkeys; i++) | |
| 2394 { | |
| 2395 define_key_parser (keys[i], &(raw_keys[i])); | |
| 2396 } | |
| 2397 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default); | |
| 2398 } | |
| 2399 | |
| 2400 static Lisp_Object | |
| 2401 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[], | |
| 2402 int accept_default) | |
| 2403 { | |
| 2404 /* This function can GC */ | |
| 934 | 2405 Lisp_Key_Data kkk[20]; |
| 428 | 2406 Lisp_Object event; |
| 2407 | |
| 2408 int nkeys; | |
| 934 | 2409 Lisp_Key_Data *raw_keys; |
| 428 | 2410 Lisp_Object tem = Qnil; |
| 2411 struct gcpro gcpro1, gcpro2; | |
| 2412 int iii; | |
| 2413 | |
| 2414 CHECK_LIVE_EVENT (event_head); | |
| 2415 | |
| 2416 nkeys = event_chain_count (event_head); | |
| 2417 | |
| 438 | 2418 if (nkeys < countof (kkk)) |
| 428 | 2419 raw_keys = kkk; |
| 2420 else | |
| 934 | 2421 raw_keys = alloca_array (Lisp_Key_Data, nkeys); |
| 428 | 2422 |
| 2423 nkeys = 0; | |
| 2424 EVENT_CHAIN_LOOP (event, event_head) | |
| 2425 define_key_parser (event, &(raw_keys[nkeys++])); | |
| 2426 GCPRO2 (keymaps[0], event_head); | |
| 2427 gcpro1.nvars = nmaps; | |
| 2428 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't) | |
| 2429 * on somebody else somewhere (obarray) having a pointer to all keysyms. */ | |
| 2430 for (iii = 0; iii < nmaps; iii++) | |
| 2431 { | |
| 2432 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0, | |
| 2433 accept_default); | |
| 2434 if (INTP (tem)) | |
| 2435 { | |
| 2436 /* Too long in some local map means don't look at global map */ | |
| 2437 tem = Qnil; | |
| 2438 break; | |
| 2439 } | |
| 2440 else if (!NILP (tem)) | |
| 2441 break; | |
| 2442 } | |
| 2443 UNGCPRO; | |
| 2444 return tem; | |
| 2445 } | |
| 2446 | |
| 2447 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /* | |
| 2448 In keymap KEYMAP, look up key-sequence KEYS. Return the definition. | |
| 2449 Nil is returned if KEYS is unbound. See documentation of `define-key' | |
| 2450 for valid key definitions and key-sequence specifications. | |
| 2451 A number is returned if KEYS is "too long"; that is, the leading | |
| 2452 characters fail to be a valid sequence of prefix characters in KEYMAP. | |
| 444 | 2453 The number is how many key strokes at the front of KEYS it takes to |
| 2454 reach a non-prefix command. | |
| 428 | 2455 */ |
| 2456 (keymap, keys, accept_default)) | |
| 2457 { | |
| 2458 /* This function can GC */ | |
| 2459 if (VECTORP (keys)) | |
| 2460 return lookup_keys (keymap, | |
| 2461 XVECTOR_LENGTH (keys), | |
| 2462 XVECTOR_DATA (keys), | |
| 2463 !NILP (accept_default)); | |
| 2464 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys)) | |
| 2465 return lookup_keys (keymap, 1, &keys, !NILP (accept_default)); | |
| 2466 else if (STRINGP (keys)) | |
| 2467 { | |
| 826 | 2468 int length = string_char_length (keys); |
| 428 | 2469 int i; |
| 934 | 2470 Lisp_Key_Data *raw_keys = alloca_array (Lisp_Key_Data, length); |
| 428 | 2471 if (length == 0) |
| 2472 return Qnil; | |
| 2473 | |
| 2474 for (i = 0; i < length; i++) | |
| 2475 { | |
| 867 | 2476 Ichar n = string_ichar (keys, i); |
| 428 | 2477 define_key_parser (make_char (n), &(raw_keys[i])); |
| 2478 } | |
| 2479 return raw_lookup_key (keymap, raw_keys, length, 0, | |
| 2480 !NILP (accept_default)); | |
| 2481 } | |
| 2482 else | |
| 2483 { | |
| 2484 keys = wrong_type_argument (Qsequencep, keys); | |
| 2485 return Flookup_key (keymap, keys, accept_default); | |
| 2486 } | |
| 2487 } | |
| 2488 | |
| 2489 /* Given a key sequence, returns a list of keymaps to search for bindings. | |
| 2490 Does all manner of semi-hairy heuristics, like looking in the current | |
| 2491 buffer's map before looking in the global map and looking in the local | |
| 2492 map of the buffer in which the mouse was clicked in event0 is a click. | |
| 2493 | |
| 2494 It would be kind of nice if this were in Lisp so that this semi-hairy | |
| 2495 semi-heuristic command-lookup behavior could be readily understood and | |
| 2496 customised. However, this needs to be pretty fast, or performance of | |
| 2497 keyboard macros goes to shit; putting this in lisp slows macros down | |
| 2498 2-3x. And they're already slower than v18 by 5-6x. | |
| 2499 */ | |
| 2500 | |
| 2501 struct relevant_maps | |
| 2502 { | |
| 2503 int nmaps; | |
| 647 | 2504 int max_maps; |
| 428 | 2505 Lisp_Object *maps; |
| 2506 struct gcpro *gcpro; | |
| 2507 }; | |
| 2508 | |
| 2509 static void get_relevant_extent_keymaps (Lisp_Object pos, | |
| 2510 Lisp_Object buffer_or_string, | |
| 2511 Lisp_Object glyph, | |
| 2512 struct relevant_maps *closure); | |
| 2513 static void get_relevant_minor_maps (Lisp_Object buffer, | |
| 2514 struct relevant_maps *closure); | |
| 2515 | |
| 2516 static void | |
| 2517 relevant_map_push (Lisp_Object map, struct relevant_maps *closure) | |
| 2518 { | |
| 647 | 2519 int nmaps = closure->nmaps; |
| 428 | 2520 |
| 2521 if (!KEYMAPP (map)) | |
| 2522 return; | |
| 2523 closure->nmaps = nmaps + 1; | |
| 2524 if (nmaps < closure->max_maps) | |
| 2525 { | |
| 2526 closure->maps[nmaps] = map; | |
| 2527 closure->gcpro->nvars = nmaps; | |
| 2528 } | |
| 2529 } | |
| 2530 | |
| 2531 static int | |
| 2532 get_relevant_keymaps (Lisp_Object keys, | |
| 2533 int max_maps, Lisp_Object maps[]) | |
| 2534 { | |
| 2535 /* This function can GC */ | |
| 2536 Lisp_Object terminal = Qnil; | |
| 2537 struct gcpro gcpro1; | |
| 2538 struct relevant_maps closure; | |
| 2539 struct console *con; | |
| 2540 | |
| 2541 GCPRO1 (*maps); | |
| 2542 gcpro1.nvars = 0; | |
| 2543 closure.nmaps = 0; | |
| 2544 closure.max_maps = max_maps; | |
| 2545 closure.maps = maps; | |
| 2546 closure.gcpro = &gcpro1; | |
| 2547 | |
| 2548 if (EVENTP (keys)) | |
| 2549 terminal = event_chain_tail (keys); | |
| 2550 else if (VECTORP (keys)) | |
| 2551 { | |
| 2552 int len = XVECTOR_LENGTH (keys); | |
| 2553 if (len > 0) | |
| 2554 terminal = XVECTOR_DATA (keys)[len - 1]; | |
| 2555 } | |
| 2556 | |
| 2557 if (EVENTP (terminal)) | |
| 2558 { | |
| 2559 CHECK_LIVE_EVENT (terminal); | |
| 2560 con = event_console_or_selected (terminal); | |
| 2561 } | |
| 2562 else | |
| 2563 con = XCONSOLE (Vselected_console); | |
| 2564 | |
| 2565 if (KEYMAPP (con->overriding_terminal_local_map) | |
| 2566 || KEYMAPP (Voverriding_local_map)) | |
| 2567 { | |
| 2568 if (KEYMAPP (con->overriding_terminal_local_map)) | |
| 2569 relevant_map_push (con->overriding_terminal_local_map, &closure); | |
| 2570 if (KEYMAPP (Voverriding_local_map)) | |
| 2571 relevant_map_push (Voverriding_local_map, &closure); | |
| 2572 } | |
| 2573 else if (!EVENTP (terminal) | |
| 2574 || (XEVENT (terminal)->event_type != button_press_event | |
| 2575 && XEVENT (terminal)->event_type != button_release_event)) | |
| 2576 { | |
| 793 | 2577 Lisp_Object tem = wrap_buffer (current_buffer); |
| 2578 | |
| 428 | 2579 /* It's not a mouse event; order of keymaps searched is: |
| 2580 o keymap of any/all extents under the mouse | |
| 2581 o minor-mode maps | |
| 2582 o local-map of current-buffer | |
| 771 | 2583 o global-tty-map or global-window-system-map |
| 428 | 2584 o global-map |
| 2585 */ | |
| 2586 /* The terminal element of the lookup may be nil or a keysym. | |
| 2587 In those cases we don't want to check for an extent | |
| 2588 keymap. */ | |
| 2589 if (EVENTP (terminal)) | |
| 2590 { | |
| 2591 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)), | |
| 2592 tem, Qnil, &closure); | |
| 2593 } | |
| 2594 get_relevant_minor_maps (tem, &closure); | |
| 2595 | |
| 2596 tem = current_buffer->keymap; | |
| 2597 if (!NILP (tem)) | |
| 2598 relevant_map_push (tem, &closure); | |
| 2599 } | |
| 2600 #ifdef HAVE_WINDOW_SYSTEM | |
| 2601 else | |
| 2602 { | |
| 2603 /* It's a mouse event; order of keymaps searched is: | |
| 2604 o vertical-divider-map, if event is over a divider | |
| 2605 o local-map of mouse-grabbed-buffer | |
| 2606 o keymap of any/all extents under the mouse | |
| 2607 if the mouse is over a modeline: | |
| 2608 o modeline-map of buffer corresponding to that modeline | |
| 2609 o else, local-map of buffer under the mouse | |
| 2610 o minor-mode maps | |
| 2611 o local-map of current-buffer | |
| 771 | 2612 o global-tty-map or global-window-system-map |
| 428 | 2613 o global-map |
| 2614 */ | |
| 2615 Lisp_Object window = Fevent_window (terminal); | |
| 2616 | |
| 2617 if (!NILP (Fevent_over_vertical_divider_p (terminal))) | |
| 2618 { | |
| 2619 if (KEYMAPP (Vvertical_divider_map)) | |
| 2620 relevant_map_push (Vvertical_divider_map, &closure); | |
| 2621 } | |
| 2622 | |
| 2623 if (BUFFERP (Vmouse_grabbed_buffer)) | |
| 2624 { | |
| 2625 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap; | |
| 2626 | |
| 2627 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure); | |
| 2628 if (!NILP (map)) | |
| 2629 relevant_map_push (map, &closure); | |
| 2630 } | |
| 2631 | |
| 2632 if (!NILP (window)) | |
| 2633 { | |
| 2634 Lisp_Object buffer = Fwindow_buffer (window); | |
| 2635 | |
| 2636 if (!NILP (buffer)) | |
| 2637 { | |
| 2638 if (!NILP (Fevent_over_modeline_p (terminal))) | |
| 2639 { | |
| 2640 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map, | |
| 2641 buffer); | |
| 2642 | |
| 2643 get_relevant_extent_keymaps | |
| 2644 (Fevent_modeline_position (terminal), | |
| 2645 XBUFFER (buffer)->generated_modeline_string, | |
| 438 | 2646 Fevent_glyph_extent (terminal), &closure); |
| 428 | 2647 |
| 2648 if (!UNBOUNDP (map) && !NILP (map)) | |
| 2649 relevant_map_push (get_keymap (map, 1, 1), &closure); | |
| 2650 } | |
| 2651 else | |
| 2652 { | |
| 2653 get_relevant_extent_keymaps (Fevent_point (terminal), buffer, | |
| 2654 Fevent_glyph_extent (terminal), | |
| 2655 &closure); | |
| 2656 } | |
| 2657 | |
| 2658 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */ | |
| 2659 { | |
| 2660 Lisp_Object map = XBUFFER (buffer)->keymap; | |
| 2661 | |
| 2662 get_relevant_minor_maps (buffer, &closure); | |
| 2663 if (!NILP(map)) | |
| 2664 relevant_map_push (map, &closure); | |
| 2665 } | |
| 2666 } | |
| 2667 } | |
| 2668 else if (!NILP (Fevent_over_toolbar_p (terminal))) | |
| 2669 { | |
| 2670 Lisp_Object map = Fsymbol_value (Qtoolbar_map); | |
| 2671 | |
| 2672 if (!UNBOUNDP (map) && !NILP (map)) | |
| 2673 relevant_map_push (map, &closure); | |
| 2674 } | |
| 2675 } | |
| 2676 #endif /* HAVE_WINDOW_SYSTEM */ | |
| 2677 | |
| 771 | 2678 if (CONSOLE_TTY_P (con)) |
| 2679 relevant_map_push (Vglobal_tty_map, &closure); | |
| 2680 else | |
| 2681 relevant_map_push (Vglobal_window_system_map, &closure); | |
| 2682 | |
| 428 | 2683 { |
| 2684 int nmaps = closure.nmaps; | |
| 2685 /* Silently truncate at 100 keymaps to prevent infinite lossage */ | |
| 2686 if (nmaps >= max_maps && max_maps > 0) | |
| 2687 maps[max_maps - 1] = Vcurrent_global_map; | |
| 2688 else | |
| 2689 maps[nmaps] = Vcurrent_global_map; | |
| 2690 UNGCPRO; | |
| 2691 return nmaps + 1; | |
| 2692 } | |
| 2693 } | |
| 2694 | |
| 2695 /* Returns a set of keymaps extracted from the extents at POS in | |
| 2696 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent | |
| 2697 to look for a keymap in, and if it has one, its keymap will be the | |
| 2698 first element in the list returned. This is so we can correctly | |
| 2699 search the keymaps associated with glyphs which may be physically | |
| 2700 disjoint from their extents: for example, if a glyph is out in the | |
| 2701 margin, we should still consult the keymap of that glyph's extent, | |
| 2702 which may not itself be under the mouse. | |
| 2703 */ | |
| 2704 | |
| 2705 static void | |
| 2706 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string, | |
| 2707 Lisp_Object glyph, | |
| 2708 struct relevant_maps *closure) | |
| 2709 { | |
| 2710 /* This function can GC */ | |
| 2711 /* the glyph keymap, if any, comes first. | |
| 2712 (Processing it twice is no big deal: noop.) */ | |
| 2713 if (!NILP (glyph)) | |
| 2714 { | |
| 2715 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil); | |
| 2716 if (!NILP (keymap)) | |
| 2717 relevant_map_push (get_keymap (keymap, 1, 1), closure); | |
| 2718 } | |
| 2719 | |
| 2720 /* Next check the extents at the text position, if any */ | |
| 2721 if (!NILP (pos)) | |
| 2722 { | |
| 2723 Lisp_Object extent; | |
| 2724 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil); | |
| 2725 !NILP (extent); | |
| 2726 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil)) | |
| 2727 { | |
| 2728 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil); | |
| 2729 if (!NILP (keymap)) | |
| 2730 relevant_map_push (get_keymap (keymap, 1, 1), closure); | |
| 2731 QUIT; | |
| 2732 } | |
| 2733 } | |
| 2734 } | |
| 2735 | |
| 2736 static Lisp_Object | |
| 2737 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer) | |
| 2738 { | |
| 2739 /* This function can GC */ | |
| 2740 if (CONSP (assoc)) | |
| 2741 { | |
| 2742 Lisp_Object sym = XCAR (assoc); | |
| 2743 if (SYMBOLP (sym)) | |
| 2744 { | |
| 2745 Lisp_Object val = symbol_value_in_buffer (sym, buffer); | |
| 2746 if (!NILP (val) && !UNBOUNDP (val)) | |
| 2747 { | |
| 793 | 2748 return get_keymap (XCDR (assoc), 0, 1); |
| 428 | 2749 } |
| 2750 } | |
| 2751 } | |
| 2752 return Qnil; | |
| 2753 } | |
| 2754 | |
| 2755 static void | |
| 2756 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure) | |
| 2757 { | |
| 2758 /* This function can GC */ | |
| 2759 Lisp_Object alist; | |
| 2760 | |
| 2761 /* Will you ever lose badly if you make this circular! */ | |
| 2762 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer); | |
| 2763 CONSP (alist); | |
| 2764 alist = XCDR (alist)) | |
| 2765 { | |
| 2766 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist), | |
| 2767 buffer); | |
| 2768 if (!NILP (m)) relevant_map_push (m, closure); | |
| 2769 QUIT; | |
| 2770 } | |
| 2771 } | |
| 2772 | |
| 2773 /* #### Would map-current-keymaps be a better thing?? */ | |
| 2774 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /* | |
| 2775 Return a list of the current keymaps that will be searched for bindings. | |
| 2776 This lists keymaps such as the current local map and the minor-mode maps, | |
| 2777 but does not list the parents of those keymaps. | |
| 2778 EVENT-OR-KEYS controls which keymaps will be listed. | |
| 2779 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a | |
| 2780 mouse event), the keymaps for that mouse event will be listed (see | |
| 2781 `key-binding'). Otherwise, the keymaps for key presses will be listed. | |
| 771 | 2782 See `key-binding' for a description of which keymaps are searched in |
| 2783 various situations. | |
| 428 | 2784 */ |
| 2785 (event_or_keys)) | |
| 2786 { | |
| 2787 /* This function can GC */ | |
| 2788 struct gcpro gcpro1; | |
| 2789 Lisp_Object maps[100]; | |
| 2790 Lisp_Object *gubbish = maps; | |
| 2791 int nmaps; | |
| 2792 | |
| 2793 GCPRO1 (event_or_keys); | |
| 2794 nmaps = get_relevant_keymaps (event_or_keys, countof (maps), | |
| 2795 gubbish); | |
| 2796 if (nmaps > countof (maps)) | |
| 2797 { | |
| 2798 gubbish = alloca_array (Lisp_Object, nmaps); | |
| 2799 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); | |
| 2800 } | |
| 2801 UNGCPRO; | |
| 2802 return Flist (nmaps, gubbish); | |
| 2803 } | |
| 2804 | |
| 2805 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /* | |
| 2806 Return the binding for command KEYS in current keymaps. | |
| 2807 KEYS is a string, a vector of events, or a vector of key-description lists | |
| 2808 as described in the documentation for the `define-key' function. | |
| 2809 The binding is probably a symbol with a function definition; see | |
| 2810 the documentation for `lookup-key' for more information. | |
| 2811 | |
| 2812 For key-presses, the order of keymaps searched is: | |
| 2813 - the `keymap' property of any extent(s) at point; | |
| 2814 - any applicable minor-mode maps; | |
| 444 | 2815 - the current local map of the current-buffer; |
| 771 | 2816 - either `global-tty-map' or `global-window-system-map', depending on |
| 2817 whether the current console is a TTY or non-TTY console; | |
| 428 | 2818 - the current global map. |
| 2819 | |
| 2820 For mouse-clicks, the order of keymaps searched is: | |
| 2821 - the current-local-map of the `mouse-grabbed-buffer' if any; | |
| 2822 - vertical-divider-map, if the event happened over a vertical divider | |
| 2823 - the `keymap' property of any extent(s) at the position of the click | |
| 2824 (this includes modeline extents); | |
| 2825 - the modeline-map of the buffer corresponding to the modeline under | |
| 2826 the mouse (if the click happened over a modeline); | |
| 444 | 2827 - the value of `toolbar-map' in the current-buffer (if the click |
| 428 | 2828 happened over a toolbar); |
| 444 | 2829 - the current local map of the buffer under the mouse (does not |
| 428 | 2830 apply to toolbar clicks); |
| 2831 - any applicable minor-mode maps; | |
| 771 | 2832 - either `global-tty-map' or `global-window-system-map', depending on |
| 2833 whether the current console is a TTY or non-TTY console; | |
| 428 | 2834 - the current global map. |
| 2835 | |
| 2836 Note that if `overriding-local-map' or `overriding-terminal-local-map' | |
| 2837 is non-nil, *only* those two maps and the current global map are searched. | |
| 771 | 2838 |
| 2839 Note also that key sequences actually received from the keyboard driver | |
| 2840 may be processed in various ways to generate the key sequence that is | |
| 2841 actually looked up in the keymaps. In particular: | |
| 2842 | |
| 2843 -- Keysyms are individually passed through `keyboard-translate-table' before | |
| 2844 any other processing. | |
| 2845 -- After this, key sequences as a whole are passed through | |
| 2846 `key-translation-map'. | |
| 2847 -- The resulting key sequence is actually looked up in the keymaps. | |
| 2848 -- If there's no binding found, the key sequence is passed through | |
| 2849 `function-key-map' and looked up again. | |
| 2850 -- If no binding is found and `retry-undefined-key-binding-unshifted' is | |
| 2851 set (it usually is) and the final keysym is an uppercase character, | |
| 2852 we lowercase it and start over from the `key-translation-map' stage. | |
| 2853 -- If no binding is found and we're on MS Windows and have international | |
| 2854 support, we successively remap the key sequence using the keyboard layouts | |
| 2855 of various default locales (current language environment, user default, | |
| 2856 system default, US ASCII) and try again. This makes (e.g.) sequences | |
| 2857 such as `C-x b' work in a Russian locale, where the alphabetic keys are | |
| 2858 actually generating Russian characters and not the Roman letters written | |
| 2859 on the keycaps. (Not yet implemented) | |
| 2860 -- Finally, if the last keystroke matches `help-char', we automatically | |
| 2861 generate and display a list of possible key sequences and bindings | |
| 2862 given the prefix so far generated. | |
| 428 | 2863 */ |
| 2864 (keys, accept_default)) | |
| 2865 { | |
| 2866 /* This function can GC */ | |
| 2867 int i; | |
| 2868 Lisp_Object maps[100]; | |
| 2869 int nmaps; | |
| 2870 struct gcpro gcpro1, gcpro2; | |
| 2871 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */ | |
| 2872 | |
| 2873 nmaps = get_relevant_keymaps (keys, countof (maps), maps); | |
| 2874 | |
| 2875 UNGCPRO; | |
| 2876 | |
| 2877 if (EVENTP (keys)) /* unadvertised "feature" for the future */ | |
| 2878 return lookup_events (keys, nmaps, maps, !NILP (accept_default)); | |
| 2879 | |
| 2880 for (i = 0; i < nmaps; i++) | |
| 2881 { | |
| 2882 Lisp_Object tem = Flookup_key (maps[i], keys, | |
| 2883 accept_default); | |
| 2884 if (INTP (tem)) | |
| 2885 { | |
| 2886 /* Too long in some local map means don't look at global map */ | |
| 2887 return Qnil; | |
| 2888 } | |
| 2889 else if (!NILP (tem)) | |
| 2890 return tem; | |
| 2891 } | |
| 2892 return Qnil; | |
| 2893 } | |
| 2894 | |
| 2895 static Lisp_Object | |
| 2896 process_event_binding_result (Lisp_Object result) | |
| 2897 { | |
| 2898 if (EQ (result, Qundefined)) | |
| 3025 | 2899 /* The suppress-keymap function binds keys to `undefined' - special-case |
| 428 | 2900 that here, so that being bound to that has the same error-behavior as |
| 2901 not being defined at all. | |
| 2902 */ | |
| 2903 result = Qnil; | |
| 2904 if (!NILP (result)) | |
| 2905 { | |
| 2906 Lisp_Object map; | |
| 2907 /* Snap out possible keymap indirections */ | |
| 2908 map = get_keymap (result, 0, 1); | |
| 2909 if (!NILP (map)) | |
| 2910 result = map; | |
| 2911 } | |
| 2912 | |
| 2913 return result; | |
| 2914 } | |
| 2915 | |
| 2916 /* Attempts to find a command corresponding to the event-sequence | |
| 2917 whose head is event0 (sequence is threaded though event_next). | |
| 2918 | |
| 2919 The return value will be | |
| 2920 | |
| 2921 -- nil (there is no binding; this will also be returned | |
| 2922 whenever the event chain is "too long", i.e. there | |
| 2923 is a non-nil, non-keymap binding for a prefix of | |
| 2924 the event chain) | |
| 2925 -- a keymap (part of a command has been specified) | |
| 2926 -- a command (anything that satisfies `commandp'; this includes | |
| 2927 some symbols, lists, subrs, strings, vectors, and | |
| 2928 compiled-function objects) */ | |
| 2929 Lisp_Object | |
| 2930 event_binding (Lisp_Object event0, int accept_default) | |
| 2931 { | |
| 2932 /* This function can GC */ | |
| 2933 Lisp_Object maps[100]; | |
| 2934 int nmaps; | |
| 2935 | |
| 2936 assert (EVENTP (event0)); | |
| 2937 | |
| 2938 nmaps = get_relevant_keymaps (event0, countof (maps), maps); | |
| 2939 if (nmaps > countof (maps)) | |
| 2940 nmaps = countof (maps); | |
| 2941 return process_event_binding_result (lookup_events (event0, nmaps, maps, | |
| 2942 accept_default)); | |
| 2943 } | |
| 2944 | |
| 2945 /* like event_binding, but specify a keymap to search */ | |
| 2946 | |
| 2947 Lisp_Object | |
| 2948 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default) | |
| 2949 { | |
| 2950 /* This function can GC */ | |
| 2951 if (!KEYMAPP (keymap)) | |
| 2952 return Qnil; | |
| 2953 | |
| 2954 return process_event_binding_result (lookup_events (event0, 1, &keymap, | |
| 2955 accept_default)); | |
| 2956 } | |
| 2957 | |
| 2958 /* Attempts to find a function key mapping corresponding to the | |
| 2959 event-sequence whose head is event0 (sequence is threaded through | |
| 2960 event_next). The return value will be the same as for event_binding(). */ | |
| 2961 Lisp_Object | |
| 2962 munging_key_map_event_binding (Lisp_Object event0, | |
| 2963 enum munge_me_out_the_door munge) | |
| 2964 { | |
| 2965 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ? | |
| 2966 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) : | |
| 2967 Vkey_translation_map; | |
| 2968 | |
| 2969 if (NILP (keymap)) | |
| 2970 return Qnil; | |
| 2971 | |
| 2972 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1)); | |
| 2973 } | |
| 2974 | |
| 2975 | |
| 2976 /************************************************************************/ | |
| 2977 /* Setting/querying the global and local maps */ | |
| 2978 /************************************************************************/ | |
| 2979 | |
| 2980 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /* | |
| 2981 Select KEYMAP as the global keymap. | |
| 2982 */ | |
| 2983 (keymap)) | |
| 2984 { | |
| 2985 /* This function can GC */ | |
| 2986 keymap = get_keymap (keymap, 1, 1); | |
| 2987 Vcurrent_global_map = keymap; | |
| 2988 return Qnil; | |
| 2989 } | |
| 2990 | |
| 2991 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /* | |
| 2992 Select KEYMAP as the local keymap in BUFFER. | |
| 2993 If KEYMAP is nil, that means no local keymap. | |
| 2994 If BUFFER is nil, the current buffer is assumed. | |
| 2995 */ | |
| 2996 (keymap, buffer)) | |
| 2997 { | |
| 2998 /* This function can GC */ | |
| 2999 struct buffer *b = decode_buffer (buffer, 0); | |
| 3000 if (!NILP (keymap)) | |
| 3001 keymap = get_keymap (keymap, 1, 1); | |
| 3002 | |
| 3003 b->keymap = keymap; | |
| 3004 | |
| 3005 return Qnil; | |
| 3006 } | |
| 3007 | |
| 3008 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /* | |
| 3009 Return BUFFER's local keymap, or nil if it has none. | |
| 3010 If BUFFER is nil, the current buffer is assumed. | |
| 3011 */ | |
| 3012 (buffer)) | |
| 3013 { | |
| 3014 struct buffer *b = decode_buffer (buffer, 0); | |
| 3015 return b->keymap; | |
| 3016 } | |
| 3017 | |
| 3018 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /* | |
| 3019 Return the current global keymap. | |
| 3020 */ | |
| 3021 ()) | |
| 3022 { | |
| 3023 return Vcurrent_global_map; | |
| 3024 } | |
| 3025 | |
| 3026 | |
| 3027 /************************************************************************/ | |
| 3028 /* Mapping over keymap elements */ | |
| 3029 /************************************************************************/ | |
| 3030 | |
| 3031 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or | |
| 3032 prefix key, it's not entirely obvious what map-keymap should do, but | |
| 3033 what it does is: map over all keys in this map; then recursively map | |
| 3034 over all submaps of this map that are "bucky" submaps. This means that, | |
| 3035 when mapping over a keymap, it appears that "x" and "C-x" are in the | |
| 3036 same map, although "C-x" is really in the "control" submap of this one. | |
| 3037 However, since we don't recursively descend the submaps that are bound | |
| 3038 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on | |
| 3039 those explicitly, if that's what they want. | |
| 3040 | |
| 3041 So the end result of this is that the bucky keymaps (the ones indexed | |
| 3042 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are | |
| 3043 invisible from elisp. They're just an implementation detail that code | |
| 3044 outside of this file doesn't need to know about. | |
| 3045 */ | |
| 3046 | |
| 3047 struct map_keymap_unsorted_closure | |
| 3048 { | |
| 934 | 3049 void (*fn) (const Lisp_Key_Data *, Lisp_Object binding, void *arg); |
| 428 | 3050 void *arg; |
| 442 | 3051 int modifiers; |
| 428 | 3052 }; |
| 3053 | |
| 3054 /* used by map_keymap() */ | |
| 3055 static int | |
| 3056 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value, | |
| 3057 void *map_keymap_unsorted_closure) | |
| 3058 { | |
| 3059 /* This function can GC */ | |
| 3060 struct map_keymap_unsorted_closure *closure = | |
| 3061 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure; | |
| 442 | 3062 int modifiers = closure->modifiers; |
| 3063 int mod_bit; | |
| 428 | 3064 mod_bit = MODIFIER_HASH_KEY_BITS (keysym); |
| 3065 if (mod_bit != 0) | |
| 3066 { | |
| 3067 int omod = modifiers; | |
| 3068 closure->modifiers = (modifiers | mod_bit); | |
| 3069 value = get_keymap (value, 1, 0); | |
| 3070 elisp_maphash (map_keymap_unsorted_mapper, | |
| 3071 XKEYMAP (value)->table, | |
| 3072 map_keymap_unsorted_closure); | |
| 3073 closure->modifiers = omod; | |
| 3074 } | |
| 3075 else | |
| 3076 { | |
| 934 | 3077 Lisp_Key_Data key; |
| 428 | 3078 key.keysym = keysym; |
| 3079 key.modifiers = modifiers; | |
| 3080 ((*closure->fn) (&key, value, closure->arg)); | |
| 3081 } | |
| 3082 return 0; | |
| 3083 } | |
| 3084 | |
| 3085 | |
| 3086 struct map_keymap_sorted_closure | |
| 3087 { | |
| 3088 Lisp_Object *result_locative; | |
| 3089 }; | |
| 3090 | |
| 3091 /* used by map_keymap_sorted() */ | |
| 3092 static int | |
| 3093 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value, | |
| 3094 void *map_keymap_sorted_closure) | |
| 3095 { | |
| 3096 struct map_keymap_sorted_closure *cl = | |
| 3097 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure; | |
| 3098 Lisp_Object *list = cl->result_locative; | |
| 3099 *list = Fcons (Fcons (key, value), *list); | |
| 3100 return 0; | |
| 3101 } | |
| 3102 | |
| 3103 | |
| 3104 /* used by map_keymap_sorted(), describe_map_sort_predicate(), | |
| 3105 and keymap_submaps(). | |
| 3106 */ | |
| 3107 static int | |
| 3108 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, | |
| 2286 | 3109 Lisp_Object UNUSED (pred)) |
| 428 | 3110 { |
| 3111 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored. | |
| 3112 */ | |
| 442 | 3113 int bit1, bit2; |
| 428 | 3114 int sym1_p = 0; |
| 3115 int sym2_p = 0; | |
| 2828 | 3116 extern Lisp_Object Qcharacter_of_keysym; |
| 3117 | |
| 428 | 3118 obj1 = XCAR (obj1); |
| 3119 obj2 = XCAR (obj2); | |
| 3120 | |
| 3121 if (EQ (obj1, obj2)) | |
| 3122 return -1; | |
| 3123 bit1 = MODIFIER_HASH_KEY_BITS (obj1); | |
| 3124 bit2 = MODIFIER_HASH_KEY_BITS (obj2); | |
| 3125 | |
| 2828 | 3126 /* If either is a symbol with a Qcharacter_of_keysym property, then sort it by |
| 428 | 3127 that code instead of alphabetically. |
| 3128 */ | |
| 3129 if (! bit1 && SYMBOLP (obj1)) | |
| 3130 { | |
| 2828 | 3131 Lisp_Object code = Fget (obj1, Qcharacter_of_keysym, Qnil); |
| 428 | 3132 if (CHAR_OR_CHAR_INTP (code)) |
| 3133 { | |
| 3134 obj1 = code; | |
| 3135 CHECK_CHAR_COERCE_INT (obj1); | |
| 3136 sym1_p = 1; | |
| 3137 } | |
| 3138 } | |
| 3139 if (! bit2 && SYMBOLP (obj2)) | |
| 3140 { | |
| 2828 | 3141 Lisp_Object code = Fget (obj2, Qcharacter_of_keysym, Qnil); |
| 428 | 3142 if (CHAR_OR_CHAR_INTP (code)) |
| 3143 { | |
| 3144 obj2 = code; | |
| 3145 CHECK_CHAR_COERCE_INT (obj2); | |
| 3146 sym2_p = 1; | |
| 3147 } | |
| 3148 } | |
| 3149 | |
| 3150 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */ | |
| 3151 if (XTYPE (obj1) != XTYPE (obj2)) | |
| 3152 return SYMBOLP (obj2) ? 1 : -1; | |
| 3153 | |
| 3154 if (! bit1 && CHARP (obj1)) /* they're both ASCII */ | |
| 3155 { | |
| 3156 int o1 = XCHAR (obj1); | |
| 3157 int o2 = XCHAR (obj2); | |
| 3158 if (o1 == o2 && /* If one started out as a symbol and the */ | |
| 3159 sym1_p != sym2_p) /* other didn't, the symbol comes last. */ | |
| 3160 return sym2_p ? 1 : -1; | |
| 3161 | |
| 3162 return o1 < o2 ? 1 : -1; /* else just compare them */ | |
| 3163 } | |
| 3164 | |
| 3165 /* else they're both symbols. If they're both buckys, then order them. */ | |
| 3166 if (bit1 && bit2) | |
| 3167 return bit1 < bit2 ? 1 : -1; | |
| 3168 | |
| 3169 /* if only one is a bucky, then it comes later */ | |
| 3170 if (bit1 || bit2) | |
| 3171 return bit2 ? 1 : -1; | |
| 3172 | |
| 3173 /* otherwise, string-sort them. */ | |
| 3174 { | |
| 867 | 3175 Ibyte *s1 = XSTRING_DATA (XSYMBOL (obj1)->name); |
| 3176 Ibyte *s2 = XSTRING_DATA (XSYMBOL (obj2)->name); | |
| 793 | 3177 return 0 > qxestrcmp (s1, s2) ? 1 : -1; |
| 428 | 3178 } |
| 3179 } | |
| 3180 | |
| 3181 | |
| 3182 /* used by map_keymap() */ | |
| 3183 static void | |
| 3184 map_keymap_sorted (Lisp_Object keymap_table, | |
| 442 | 3185 int modifiers, |
| 934 | 3186 void (*function) (const Lisp_Key_Data *key, |
| 428 | 3187 Lisp_Object binding, |
| 3188 void *map_keymap_sorted_closure), | |
| 3189 void *map_keymap_sorted_closure) | |
| 3190 { | |
| 3191 /* This function can GC */ | |
| 3192 struct gcpro gcpro1; | |
| 3193 Lisp_Object contents = Qnil; | |
| 3194 | |
| 3195 if (XINT (Fhash_table_count (keymap_table)) == 0) | |
| 3196 return; | |
| 3197 | |
| 3198 GCPRO1 (contents); | |
| 3199 | |
| 3200 { | |
| 3201 struct map_keymap_sorted_closure c1; | |
| 3202 c1.result_locative = &contents; | |
| 3203 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1); | |
| 3204 } | |
| 3205 contents = list_sort (contents, Qnil, map_keymap_sort_predicate); | |
| 3206 for (; !NILP (contents); contents = XCDR (contents)) | |
| 3207 { | |
| 3208 Lisp_Object keysym = XCAR (XCAR (contents)); | |
| 3209 Lisp_Object binding = XCDR (XCAR (contents)); | |
| 442 | 3210 int sub_bits = MODIFIER_HASH_KEY_BITS (keysym); |
| 428 | 3211 if (sub_bits != 0) |
| 3212 map_keymap_sorted (XKEYMAP (get_keymap (binding, | |
| 3213 1, 1))->table, | |
| 3214 (modifiers | sub_bits), | |
| 3215 function, | |
| 3216 map_keymap_sorted_closure); | |
| 3217 else | |
| 3218 { | |
| 934 | 3219 Lisp_Key_Data k; |
| 428 | 3220 k.keysym = keysym; |
| 3221 k.modifiers = modifiers; | |
| 3222 ((*function) (&k, binding, map_keymap_sorted_closure)); | |
| 3223 } | |
| 3224 } | |
| 3225 UNGCPRO; | |
| 3226 } | |
| 3227 | |
| 3228 | |
| 3229 /* used by Fmap_keymap() */ | |
| 3230 static void | |
| 934 | 3231 map_keymap_mapper (const Lisp_Key_Data *key, |
| 428 | 3232 Lisp_Object binding, |
| 3233 void *function) | |
| 3234 { | |
| 3235 /* This function can GC */ | |
| 3236 Lisp_Object fn; | |
| 826 | 3237 fn = VOID_TO_LISP (function); |
| 428 | 3238 call2 (fn, make_key_description (key, 1), binding); |
| 3239 } | |
| 3240 | |
| 3241 | |
| 3242 static void | |
| 3243 map_keymap (Lisp_Object keymap_table, int sort_first, | |
| 934 | 3244 void (*function) (const Lisp_Key_Data *key, |
| 428 | 3245 Lisp_Object binding, |
| 3246 void *fn_arg), | |
| 3247 void *fn_arg) | |
| 3248 { | |
| 3249 /* This function can GC */ | |
| 3250 if (sort_first) | |
| 3251 map_keymap_sorted (keymap_table, 0, function, fn_arg); | |
| 3252 else | |
| 3253 { | |
| 3254 struct map_keymap_unsorted_closure map_keymap_unsorted_closure; | |
| 3255 map_keymap_unsorted_closure.fn = function; | |
| 3256 map_keymap_unsorted_closure.arg = fn_arg; | |
| 3257 map_keymap_unsorted_closure.modifiers = 0; | |
| 3258 elisp_maphash (map_keymap_unsorted_mapper, keymap_table, | |
| 3259 &map_keymap_unsorted_closure); | |
| 3260 } | |
| 3261 } | |
| 3262 | |
| 3263 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /* | |
| 3264 Apply FUNCTION to each element of KEYMAP. | |
| 3265 FUNCTION will be called with two arguments: a key-description list, and | |
| 3266 the binding. The order in which the elements of the keymap are passed to | |
| 3267 the function is unspecified. If the function inserts new elements into | |
| 3268 the keymap, it may or may not be called with them later. No element of | |
| 3269 the keymap will ever be passed to the function more than once. | |
| 3270 | |
| 3271 The function will not be called on elements of this keymap's parents | |
| 3272 \(see the function `keymap-parents') or upon keymaps which are contained | |
| 3273 within this keymap (multi-character definitions). | |
| 3274 It will be called on "meta" characters since they are not really | |
| 3275 two-character sequences. | |
| 3276 | |
| 3277 If the optional third argument SORT-FIRST is non-nil, then the elements of | |
| 3278 the keymap will be passed to the mapper function in a canonical order. | |
| 3279 Otherwise, they will be passed in hash (that is, random) order, which is | |
| 3280 faster. | |
| 3281 */ | |
| 3282 (function, keymap, sort_first)) | |
| 3283 { | |
| 3284 /* This function can GC */ | |
| 489 | 3285 struct gcpro gcpro1, gcpro2; |
| 428 | 3286 |
| 3287 /* tolerate obviously transposed args */ | |
| 3288 if (!NILP (Fkeymapp (function))) | |
| 3289 { | |
| 3290 Lisp_Object tmp = function; | |
| 3291 function = keymap; | |
| 3292 keymap = tmp; | |
| 3293 } | |
| 489 | 3294 GCPRO2 (function, keymap); |
| 428 | 3295 keymap = get_keymap (keymap, 1, 1); |
| 489 | 3296 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first), |
| 428 | 3297 map_keymap_mapper, LISP_TO_VOID (function)); |
| 3298 UNGCPRO; | |
| 3299 return Qnil; | |
| 3300 } | |
| 3301 | |
| 3302 | |
| 3303 | |
| 3304 /************************************************************************/ | |
| 3305 /* Accessible keymaps */ | |
| 3306 /************************************************************************/ | |
| 3307 | |
| 3308 struct accessible_keymaps_closure | |
| 3309 { | |
| 3310 Lisp_Object tail; | |
| 3311 }; | |
| 3312 | |
| 3313 | |
| 3314 static void | |
| 3315 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents, | |
| 442 | 3316 int modifiers, |
| 428 | 3317 struct accessible_keymaps_closure *closure) |
| 3318 { | |
| 3319 /* This function can GC */ | |
| 442 | 3320 int subbits = MODIFIER_HASH_KEY_BITS (keysym); |
| 428 | 3321 |
| 3322 if (subbits != 0) | |
| 3323 { | |
| 3324 Lisp_Object submaps; | |
| 3325 | |
| 3326 contents = get_keymap (contents, 1, 1); | |
| 3327 submaps = keymap_submaps (contents); | |
| 3328 for (; !NILP (submaps); submaps = XCDR (submaps)) | |
| 3329 { | |
| 3330 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)), | |
| 3331 XCDR (XCAR (submaps)), | |
| 3332 (subbits | modifiers), | |
| 3333 closure); | |
| 3334 } | |
| 3335 } | |
| 3336 else | |
| 3337 { | |
| 3338 Lisp_Object thisseq = Fcar (Fcar (closure->tail)); | |
| 3339 Lisp_Object cmd = get_keyelt (contents, 1); | |
| 3340 Lisp_Object vec; | |
| 3341 int j; | |
| 3342 int len; | |
| 934 | 3343 Lisp_Key_Data key; |
| 428 | 3344 key.keysym = keysym; |
| 3345 key.modifiers = modifiers; | |
| 3346 | |
| 3347 if (NILP (cmd)) | |
| 2500 | 3348 ABORT (); |
| 428 | 3349 cmd = get_keymap (cmd, 0, 1); |
| 3350 if (!KEYMAPP (cmd)) | |
| 2500 | 3351 ABORT (); |
| 428 | 3352 |
| 3353 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil); | |
| 3354 len = XVECTOR_LENGTH (thisseq); | |
| 3355 for (j = 0; j < len; j++) | |
| 3356 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j]; | |
| 3357 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1); | |
| 3358 | |
| 3359 nconc2 (closure->tail, list1 (Fcons (vec, cmd))); | |
| 3360 } | |
| 3361 } | |
| 3362 | |
| 3363 | |
| 3364 static Lisp_Object | |
| 3365 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg) | |
| 3366 { | |
| 3367 /* This function can GC */ | |
| 3368 struct accessible_keymaps_closure *closure = | |
| 3369 (struct accessible_keymaps_closure *) arg; | |
| 3370 Lisp_Object submaps = keymap_submaps (thismap); | |
| 3371 | |
| 3372 for (; !NILP (submaps); submaps = XCDR (submaps)) | |
| 3373 { | |
| 3374 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)), | |
| 3375 XCDR (XCAR (submaps)), | |
| 3376 0, | |
| 3377 closure); | |
| 3378 } | |
| 3379 return Qnil; | |
| 3380 } | |
| 3381 | |
| 3382 | |
| 3383 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /* | |
| 3384 Find all keymaps accessible via prefix characters from KEYMAP. | |
| 3385 Returns a list of elements of the form (KEYS . MAP), where the sequence | |
| 3386 KEYS starting from KEYMAP gets you to MAP. These elements are ordered | |
| 3387 so that the KEYS increase in length. The first element is ([] . KEYMAP). | |
| 3388 An optional argument PREFIX, if non-nil, should be a key sequence; | |
| 3389 then the value includes only maps for prefixes that start with PREFIX. | |
| 3390 */ | |
| 3391 (keymap, prefix)) | |
| 3392 { | |
| 3393 /* This function can GC */ | |
| 3394 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 3395 Lisp_Object accessible_keymaps = Qnil; | |
| 3396 struct accessible_keymaps_closure c; | |
| 3397 c.tail = Qnil; | |
| 3398 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap); | |
| 3399 | |
| 440 | 3400 keymap = get_keymap (keymap, 1, 1); |
| 3401 | |
| 428 | 3402 retry: |
| 3403 if (NILP (prefix)) | |
| 3404 { | |
| 440 | 3405 prefix = make_vector (0, Qnil); |
| 428 | 3406 } |
| 440 | 3407 else if (VECTORP (prefix) || STRINGP (prefix)) |
| 428 | 3408 { |
| 3409 int len = XINT (Flength (prefix)); | |
| 440 | 3410 Lisp_Object def; |
| 428 | 3411 Lisp_Object p; |
| 3412 int iii; | |
| 3413 struct gcpro ngcpro1; | |
| 3414 | |
| 440 | 3415 if (len == 0) |
| 3416 { | |
| 3417 prefix = Qnil; | |
| 3418 goto retry; | |
| 3419 } | |
| 3420 | |
| 3421 def = Flookup_key (keymap, prefix, Qnil); | |
| 428 | 3422 def = get_keymap (def, 0, 1); |
| 3423 if (!KEYMAPP (def)) | |
| 3424 goto RETURN; | |
| 3425 | |
| 3426 keymap = def; | |
| 3427 p = make_vector (len, Qnil); | |
| 3428 NGCPRO1 (p); | |
| 3429 for (iii = 0; iii < len; iii++) | |
| 3430 { | |
| 934 | 3431 Lisp_Key_Data key; |
| 428 | 3432 define_key_parser (Faref (prefix, make_int (iii)), &key); |
| 3433 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1); | |
| 3434 } | |
| 3435 NUNGCPRO; | |
| 3436 prefix = p; | |
| 3437 } | |
| 440 | 3438 else |
| 3439 { | |
| 3440 prefix = wrong_type_argument (Qarrayp, prefix); | |
| 3441 goto retry; | |
| 3442 } | |
| 428 | 3443 |
| 3444 accessible_keymaps = list1 (Fcons (prefix, keymap)); | |
| 3445 | |
| 440 | 3446 /* For each map in the list maps, look at any other maps it points |
| 3447 to and stick them at the end if they are not already in the list */ | |
| 428 | 3448 |
| 3449 for (c.tail = accessible_keymaps; | |
| 3450 !NILP (c.tail); | |
| 3451 c.tail = XCDR (c.tail)) | |
| 3452 { | |
| 3453 Lisp_Object thismap = Fcdr (Fcar (c.tail)); | |
| 3454 CHECK_KEYMAP (thismap); | |
| 3455 traverse_keymaps (thismap, Qnil, | |
| 3456 accessible_keymaps_keymap_mapper, &c); | |
| 3457 } | |
| 3458 RETURN: | |
| 3459 UNGCPRO; | |
| 3460 return accessible_keymaps; | |
| 3461 } | |
| 3462 | |
| 3463 | |
| 3464 | |
| 3465 /************************************************************************/ | |
| 3466 /* Pretty descriptions of key sequences */ | |
| 3467 /************************************************************************/ | |
| 3468 | |
| 3469 DEFUN ("key-description", Fkey_description, 1, 1, 0, /* | |
| 3470 Return a pretty description of key-sequence KEYS. | |
| 3471 Control characters turn into "C-foo" sequences, meta into "M-foo", | |
| 3472 spaces are put between sequence elements, etc... | |
| 3473 */ | |
| 3474 (keys)) | |
| 3475 { | |
| 3476 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys) | |
| 3477 || EVENTP (keys)) | |
| 3478 { | |
| 3479 return Fsingle_key_description (keys); | |
| 3480 } | |
| 3481 else if (VECTORP (keys) || | |
| 3482 STRINGP (keys)) | |
| 3483 { | |
| 3484 Lisp_Object string = Qnil; | |
| 3485 /* Lisp_Object sep = Qnil; */ | |
| 3486 int size = XINT (Flength (keys)); | |
| 3487 int i; | |
| 3488 | |
| 3489 for (i = 0; i < size; i++) | |
| 3490 { | |
| 3491 Lisp_Object s2 = Fsingle_key_description | |
| 3492 (STRINGP (keys) | |
| 867 | 3493 ? make_char (string_ichar (keys, i)) |
| 428 | 3494 : XVECTOR_DATA (keys)[i]); |
| 3495 | |
| 3496 if (i == 0) | |
| 3497 string = s2; | |
| 3498 else | |
| 3499 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3500 /* if (NILP (sep)) Lisp_Object sep = build_ascstring (" ") */; |
| 428 | 3501 string = concat2 (string, concat2 (Vsingle_space_string, s2)); |
| 3502 } | |
| 3503 } | |
| 3504 return string; | |
| 3505 } | |
| 3506 return Fkey_description (wrong_type_argument (Qsequencep, keys)); | |
| 3507 } | |
| 3508 | |
| 3509 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /* | |
| 3510 Return a pretty description of command character KEY. | |
| 3511 Control characters turn into C-whatever, etc. | |
| 3512 This differs from `text-char-description' in that it returns a description | |
| 3513 of a key read from the user rather than a character from a buffer. | |
| 3514 */ | |
| 3515 (key)) | |
| 3516 { | |
| 3517 if (SYMBOLP (key)) | |
| 3518 key = Fcons (key, Qnil); /* sleaze sleaze */ | |
| 3519 | |
| 3520 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key)) | |
| 3521 { | |
| 793 | 3522 DECLARE_EISTRING_MALLOC (buf); |
| 3523 Lisp_Object str; | |
| 3524 | |
| 428 | 3525 if (!EVENTP (key)) |
| 3526 { | |
| 934 | 3527 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 3528 CHECK_CHAR_COERCE_INT (key); | |
| 1204 | 3529 character_to_event (XCHAR (key), XEVENT (event), |
|
4780
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3530 XCONSOLE (Vselected_console), |
|
2fd201d73a92
Call character_to_event on characters received from XIM, event-Xt.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4355
diff
changeset
|
3531 high_bit_is_meta, 1); |
| 934 | 3532 format_event_object (buf, event, 1); |
| 1204 | 3533 Fdeallocate_event (event); |
| 934 | 3534 } |
| 3535 else | |
| 3536 format_event_object (buf, key, 1); | |
| 793 | 3537 str = eimake_string (buf); |
| 3538 eifree (buf); | |
| 3539 return str; | |
| 428 | 3540 } |
| 3541 | |
| 3542 if (CONSP (key)) | |
| 3543 { | |
| 793 | 3544 DECLARE_EISTRING (bufp); |
| 3545 | |
| 428 | 3546 Lisp_Object rest; |
| 3547 LIST_LOOP (rest, key) | |
| 3548 { | |
| 3549 Lisp_Object keysym = XCAR (rest); | |
| 2421 | 3550 if (EQ (keysym, Qcontrol)) eicat_ascii (bufp, "C-"); |
| 3551 else if (EQ (keysym, Qctrl)) eicat_ascii (bufp, "C-"); | |
| 3552 else if (EQ (keysym, Qmeta)) eicat_ascii (bufp, "M-"); | |
| 3553 else if (EQ (keysym, Qsuper)) eicat_ascii (bufp, "S-"); | |
| 3554 else if (EQ (keysym, Qhyper)) eicat_ascii (bufp, "H-"); | |
| 3555 else if (EQ (keysym, Qalt)) eicat_ascii (bufp, "A-"); | |
| 3556 else if (EQ (keysym, Qshift)) eicat_ascii (bufp, "Sh-"); | |
| 428 | 3557 else if (CHAR_OR_CHAR_INTP (keysym)) |
| 793 | 3558 eicat_ch (bufp, XCHAR_OR_CHAR_INT (keysym)); |
| 428 | 3559 else |
| 3560 { | |
| 3561 CHECK_SYMBOL (keysym); | |
| 3562 #if 0 /* This is bogus */ | |
| 2421 | 3563 if (EQ (keysym, QKlinefeed)) eicat_ascii (bufp, "LFD"); |
| 3564 else if (EQ (keysym, QKtab)) eicat_ascii (bufp, "TAB"); | |
| 3565 else if (EQ (keysym, QKreturn)) eicat_ascii (bufp, "RET"); | |
| 3566 else if (EQ (keysym, QKescape)) eicat_ascii (bufp, "ESC"); | |
| 3567 else if (EQ (keysym, QKdelete)) eicat_ascii (bufp, "DEL"); | |
| 3568 else if (EQ (keysym, QKspace)) eicat_ascii (bufp, "SPC"); | |
| 3569 else if (EQ (keysym, QKbackspace)) eicat_ascii (bufp, "BS"); | |
| 428 | 3570 else |
| 3571 #endif | |
| 793 | 3572 eicat_lstr (bufp, XSYMBOL (keysym)->name); |
| 428 | 3573 if (!NILP (XCDR (rest))) |
| 793 | 3574 invalid_argument ("Invalid key description", key); |
| 428 | 3575 } |
| 3576 } | |
| 793 | 3577 return eimake_string (bufp); |
| 428 | 3578 } |
| 3579 return Fsingle_key_description | |
| 3580 (wrong_type_argument (intern ("char-or-event-p"), key)); | |
| 3581 } | |
| 3582 | |
| 3583 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /* | |
| 3584 Return a pretty description of file-character CHR. | |
| 3585 Unprintable characters turn into "^char" or \\NNN, depending on the value | |
| 3586 of the `ctl-arrow' variable. | |
| 3587 This differs from `single-key-description' in that it returns a description | |
| 3588 of a character from a buffer rather than a key read from the user. | |
| 3589 */ | |
| 3590 (chr)) | |
| 3591 { | |
| 867 | 3592 Ibyte buf[200]; |
| 3593 Ibyte *p; | |
| 3594 Ichar c; | |
| 428 | 3595 Lisp_Object ctl_arrow = current_buffer->ctl_arrow; |
| 3596 int ctl_p = !NILP (ctl_arrow); | |
| 867 | 3597 Ichar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow) |
| 428 | 3598 ? XCHAR_OR_CHAR_INT (ctl_arrow) |
| 3599 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow)) | |
| 3600 ? 256 : 160)); | |
| 3601 | |
| 3602 if (EVENTP (chr)) | |
| 3603 { | |
| 2862 | 3604 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qnil); |
| 428 | 3605 if (NILP (ch)) |
| 3606 return | |
| 563 | 3607 signal_continuable_error |
| 3608 (Qinvalid_argument, | |
| 2828 | 3609 "key has no character equivalent (that we know of)", |
| 3610 Fcopy_event (chr, Qnil)); | |
| 428 | 3611 chr = ch; |
| 3612 } | |
| 3613 | |
| 3614 CHECK_CHAR_COERCE_INT (chr); | |
| 3615 | |
| 3616 c = XCHAR (chr); | |
| 3617 p = buf; | |
| 3618 | |
| 3619 if (c >= printable_min) | |
| 3620 { | |
| 867 | 3621 p += set_itext_ichar (p, c); |
| 428 | 3622 } |
| 3623 else if (c < 040 && ctl_p) | |
| 3624 { | |
| 3625 *p++ = '^'; | |
| 3626 *p++ = c + 64; /* 'A' - 1 */ | |
| 3627 } | |
| 3628 else if (c == 0177) | |
| 3629 { | |
| 3630 *p++ = '^'; | |
| 3631 *p++ = '?'; | |
| 3632 } | |
| 3633 else if (c >= 0200 || c < 040) | |
| 3634 { | |
| 3635 *p++ = '\\'; | |
| 3636 #ifdef MULE | |
| 3637 /* !!#### This syntax is not readable. It will | |
| 3638 be interpreted as a 3-digit octal number rather | |
| 3639 than a 7-digit octal number. */ | |
| 3640 if (c >= 0400) | |
| 3641 { | |
| 3642 *p++ = '0' + ((c & 07000000) >> 18); | |
| 3643 *p++ = '0' + ((c & 0700000) >> 15); | |
| 3644 *p++ = '0' + ((c & 070000) >> 12); | |
| 3645 *p++ = '0' + ((c & 07000) >> 9); | |
| 3646 } | |
| 3647 #endif | |
| 3648 *p++ = '0' + ((c & 0700) >> 6); | |
| 3649 *p++ = '0' + ((c & 0070) >> 3); | |
| 3650 *p++ = '0' + ((c & 0007)); | |
| 3651 } | |
| 3652 else | |
| 3653 { | |
| 867 | 3654 p += set_itext_ichar (p, c); |
| 428 | 3655 } |
| 3656 | |
| 3657 *p = 0; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
3658 return build_intstring (buf); |
| 428 | 3659 } |
| 3660 | |
| 3661 | |
| 3662 /************************************************************************/ | |
| 3663 /* where-is (mapping bindings to keys) */ | |
| 3664 /************************************************************************/ | |
| 3665 | |
| 3666 static Lisp_Object | |
| 3667 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps, | |
| 793 | 3668 Lisp_Object firstonly, Eistring *target_buffer); |
| 428 | 3669 |
| 3670 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /* | |
| 3671 Return list of keys that invoke DEFINITION in KEYMAPS. | |
| 3672 KEYMAPS can be either a keymap (meaning search in that keymap and the | |
| 3673 current global keymap) or a list of keymaps (meaning search in exactly | |
| 3096 | 3674 those keymaps and no others). |
| 428 | 3675 |
| 3676 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing | |
| 3677 the first key sequence found, rather than a list of all possible key | |
| 3678 sequences. | |
| 3679 | |
| 3096 | 3680 Optional 4th argument NOINDIRECT is ignored. (GNU Emacs uses it to allow |
| 3681 searching for an indirect keymap by inhibiting following of indirections to | |
| 3682 keymaps or slots, but XEmacs doesn't need it because keymaps are a type.) | |
| 3683 | |
| 3684 If optional 5th argument EVENT-OR-KEYS is non-nil and KEYMAPS is nil, | |
| 3685 search in the currently applicable maps for EVENT-OR-KEYS (this is | |
| 3686 equivalent to specifying `(current-keymaps EVENT-OR-KEYS)' as the | |
| 3687 argument to KEYMAPS). | |
| 428 | 3688 */ |
| 2286 | 3689 (definition, keymaps, firstonly, UNUSED (noindirect), event_or_keys)) |
| 428 | 3690 { |
| 3691 /* This function can GC */ | |
| 3692 Lisp_Object maps[100]; | |
| 3693 Lisp_Object *gubbish = maps; | |
| 3694 int nmaps; | |
| 3695 | |
| 3696 /* Get keymaps as an array */ | |
| 3697 if (NILP (keymaps)) | |
| 3698 { | |
| 3699 nmaps = get_relevant_keymaps (event_or_keys, countof (maps), | |
| 3700 gubbish); | |
| 3701 if (nmaps > countof (maps)) | |
| 3702 { | |
| 3703 gubbish = alloca_array (Lisp_Object, nmaps); | |
| 3704 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish); | |
| 3705 } | |
| 3706 } | |
| 3707 else if (CONSP (keymaps)) | |
| 3708 { | |
| 3709 Lisp_Object rest; | |
| 3710 int i; | |
| 3711 | |
| 3712 nmaps = XINT (Flength (keymaps)); | |
| 3713 if (nmaps > countof (maps)) | |
| 3714 { | |
| 3715 gubbish = alloca_array (Lisp_Object, nmaps); | |
| 3716 } | |
| 3717 for (rest = keymaps, i = 0; !NILP (rest); | |
| 3718 rest = XCDR (keymaps), i++) | |
| 3719 { | |
| 3720 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1); | |
| 3721 } | |
| 3722 } | |
| 3723 else | |
| 3724 { | |
| 3725 nmaps = 1; | |
| 3726 gubbish[0] = get_keymap (keymaps, 1, 1); | |
| 3727 if (!EQ (gubbish[0], Vcurrent_global_map)) | |
| 3728 { | |
| 3729 gubbish[1] = Vcurrent_global_map; | |
| 3730 nmaps++; | |
| 3731 } | |
| 3732 } | |
| 3733 | |
| 3734 return where_is_internal (definition, gubbish, nmaps, firstonly, 0); | |
| 3735 } | |
| 3736 | |
| 3737 /* This function is like | |
| 3738 (key-description (where-is-internal definition nil t)) | |
| 3739 except that it writes its output into a (char *) buffer that you | |
| 3740 provide; it doesn't cons (or allocate memory) at all, so it's | |
| 3741 very fast. This is used by menubar.c. | |
| 3742 */ | |
| 3743 void | |
| 793 | 3744 where_is_to_char (Lisp_Object definition, Eistring *buffer) |
| 428 | 3745 { |
| 3746 /* This function can GC */ | |
| 3747 Lisp_Object maps[100]; | |
| 3748 Lisp_Object *gubbish = maps; | |
| 3749 int nmaps; | |
| 3750 | |
| 3751 /* Get keymaps as an array */ | |
| 3752 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish); | |
| 3753 if (nmaps > countof (maps)) | |
| 3754 { | |
| 3755 gubbish = alloca_array (Lisp_Object, nmaps); | |
| 3756 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish); | |
| 3757 } | |
| 3758 | |
| 3759 where_is_internal (definition, maps, nmaps, Qt, buffer); | |
| 3760 } | |
| 3761 | |
| 3762 | |
| 3763 static Lisp_Object | |
| 934 | 3764 raw_keys_to_keys (Lisp_Key_Data *keys, int count) |
| 428 | 3765 { |
| 3766 Lisp_Object result = make_vector (count, Qnil); | |
| 3767 while (count--) | |
| 3768 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1); | |
| 3769 return result; | |
| 3770 } | |
| 3771 | |
| 3772 | |
| 3773 static void | |
| 934 | 3774 format_raw_keys (Lisp_Key_Data *keys, int count, Eistring *buf) |
| 428 | 3775 { |
| 3776 int i; | |
| 934 | 3777 Lisp_Object event = Fmake_event (Qnil, Qnil); |
| 3778 XSET_EVENT_TYPE (event, key_press_event); | |
| 3779 XSET_EVENT_CHANNEL (event, Vselected_console); | |
| 428 | 3780 for (i = 0; i < count; i++) |
| 3781 { | |
| 1204 | 3782 XSET_EVENT_KEY_KEYSYM (event, keys[i].keysym); |
| 3783 XSET_EVENT_KEY_MODIFIERS (event, KEY_DATA_MODIFIERS (&keys[i])); | |
| 934 | 3784 format_event_object (buf, event, 1); |
| 793 | 3785 if (i < count - 1) |
| 2421 | 3786 eicat_ascii (buf, " "); |
| 428 | 3787 } |
| 1204 | 3788 Fdeallocate_event (event); |
| 428 | 3789 } |
| 3790 | |
| 3791 | |
| 3792 /* definition is the thing to look for. | |
| 3793 map is a keymap. | |
| 3794 shadow is an array of shadow_count keymaps; if there is a different | |
| 3795 binding in any of the keymaps of a key that we are considering | |
| 3796 returning, then we reconsider. | |
| 3797 firstonly means give up after finding the first match; | |
| 3798 keys_so_far and modifiers_so_far describe which map we're looking in; | |
| 3799 If we're in the "meta" submap of the map that "C-x 4" is bound to, | |
| 3800 then keys_so_far will be {(control x), \4}, and modifiers_so_far | |
| 442 | 3801 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we |
| 428 | 3802 have followed, and modifiers_so_far_so_far is the bits (partial keys) |
| 3803 beyond that. | |
| 3804 | |
| 3805 (keys_so_far is a global buffer and the keys_count arg says how much | |
| 3806 of it we're currently interested in.) | |
| 3807 | |
| 3808 If target_buffer is provided, then we write a key-description into it, | |
| 3809 to avoid consing a string. This only works with firstonly on. | |
| 3810 */ | |
| 3811 | |
| 3812 struct where_is_closure | |
| 3813 { | |
| 3814 Lisp_Object definition; | |
| 3815 Lisp_Object *shadow; | |
| 3816 int shadow_count; | |
| 3817 int firstonly; | |
| 3818 int keys_count; | |
| 442 | 3819 int modifiers_so_far; |
| 793 | 3820 Eistring *target_buffer; |
| 934 | 3821 Lisp_Key_Data *keys_so_far; |
| 428 | 3822 int keys_so_far_total_size; |
| 3823 int keys_so_far_malloced; | |
| 3824 }; | |
| 3825 | |
| 3826 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg); | |
| 3827 | |
| 3828 static Lisp_Object | |
| 3829 where_is_recursive_mapper (Lisp_Object map, void *arg) | |
| 3830 { | |
| 3831 /* This function can GC */ | |
| 3832 struct where_is_closure *c = (struct where_is_closure *) arg; | |
| 3833 Lisp_Object definition = c->definition; | |
| 442 | 3834 const int firstonly = c->firstonly; |
| 3835 const int keys_count = c->keys_count; | |
| 3836 const int modifiers_so_far = c->modifiers_so_far; | |
| 793 | 3837 Eistring *target_buffer = c->target_buffer; |
| 428 | 3838 Lisp_Object keys = Fgethash (definition, |
| 3839 XKEYMAP (map)->inverse_table, | |
| 3840 Qnil); | |
| 3841 Lisp_Object submaps; | |
| 3842 Lisp_Object result = Qnil; | |
| 3843 | |
| 3844 if (!NILP (keys)) | |
| 3845 { | |
| 3846 /* One or more keys in this map match the definition we're looking for. | |
| 3847 Verify that these bindings aren't shadowed by other bindings | |
| 3848 in the shadow maps. Either nil or number as value from | |
| 3849 raw_lookup_key() means undefined. */ | |
| 934 | 3850 Lisp_Key_Data *so_far = c->keys_so_far; |
| 428 | 3851 |
| 3852 for (;;) /* loop over all keys that match */ | |
| 3853 { | |
| 3854 Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys; | |
| 3855 int i; | |
| 3856 | |
| 3857 so_far [keys_count].keysym = k; | |
| 934 | 3858 SET_KEY_DATA_MODIFIERS (&so_far [keys_count], modifiers_so_far); |
| 428 | 3859 |
| 3860 /* now loop over all shadow maps */ | |
| 3861 for (i = 0; i < c->shadow_count; i++) | |
| 3862 { | |
| 3863 Lisp_Object shadowed = raw_lookup_key (c->shadow[i], | |
| 3864 so_far, | |
| 3865 keys_count + 1, | |
| 3866 0, 1); | |
| 3867 | |
| 3868 if (NILP (shadowed) || CHARP (shadowed) || | |
| 3869 EQ (shadowed, definition)) | |
| 3870 continue; /* we passed this test; it's not shadowed here. */ | |
| 3871 else | |
| 3872 /* ignore this key binding, since it actually has a | |
| 3873 different binding in a shadowing map */ | |
| 3874 goto c_doesnt_have_proper_loop_exit_statements; | |
| 3875 } | |
| 3876 | |
| 3877 /* OK, the key is for real */ | |
| 3878 if (target_buffer) | |
| 3879 { | |
| 2500 | 3880 if (!firstonly) ABORT (); |
| 428 | 3881 format_raw_keys (so_far, keys_count + 1, target_buffer); |
| 3882 return make_int (1); | |
| 3883 } | |
| 3884 else if (firstonly) | |
| 3885 return raw_keys_to_keys (so_far, keys_count + 1); | |
| 3886 else | |
| 3887 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1), | |
| 3888 result); | |
| 3889 | |
| 3890 c_doesnt_have_proper_loop_exit_statements: | |
| 3891 /* now on to the next matching key ... */ | |
| 3892 if (!CONSP (keys)) break; | |
| 3893 keys = XCDR (keys); | |
| 3894 } | |
| 3895 } | |
| 3896 | |
| 3897 /* Now search the sub-keymaps of this map. | |
| 3898 If we're in "firstonly" mode and have already found one, this | |
| 3899 point is not reached. If we get one from lower down, either | |
| 3900 return it immediately (in firstonly mode) or tack it onto the | |
| 3901 end of the ones we've gotten so far. | |
| 3902 */ | |
| 3903 for (submaps = keymap_submaps (map); | |
| 3904 !NILP (submaps); | |
| 3905 submaps = XCDR (submaps)) | |
| 3906 { | |
| 3907 Lisp_Object key = XCAR (XCAR (submaps)); | |
| 3908 Lisp_Object submap = XCDR (XCAR (submaps)); | |
| 442 | 3909 int lower_modifiers; |
| 428 | 3910 int lower_keys_count = keys_count; |
| 442 | 3911 int bucky; |
| 428 | 3912 |
| 3913 submap = get_keymap (submap, 0, 0); | |
| 3914 | |
| 3915 if (EQ (submap, map)) | |
| 3916 /* Arrgh! Some loser has introduced a loop... */ | |
| 3917 continue; | |
| 3918 | |
| 3919 /* If this is not a keymap, then that's probably because someone | |
| 3920 did an `fset' of a symbol that used to point to a map such that | |
| 3921 it no longer does. Sigh. Ignore this, and invalidate the cache | |
| 3922 so that it doesn't happen to us next time too. | |
| 3923 */ | |
| 3924 if (NILP (submap)) | |
| 3925 { | |
| 3926 XKEYMAP (map)->sub_maps_cache = Qt; | |
| 3927 continue; | |
| 3928 } | |
| 3929 | |
| 3930 /* If the map is a "bucky" map, then add a bit to the | |
| 3931 modifiers_so_far list. | |
| 3932 Otherwise, add a new raw_key onto the end of keys_so_far. | |
| 3933 */ | |
| 3934 bucky = MODIFIER_HASH_KEY_BITS (key); | |
| 3935 if (bucky != 0) | |
| 3936 lower_modifiers = (modifiers_so_far | bucky); | |
| 3937 else | |
| 3938 { | |
| 934 | 3939 Lisp_Key_Data *so_far = c->keys_so_far; |
| 428 | 3940 lower_modifiers = 0; |
| 3941 so_far [lower_keys_count].keysym = key; | |
| 934 | 3942 SET_KEY_DATA_MODIFIERS (&so_far [lower_keys_count], modifiers_so_far); |
| 428 | 3943 lower_keys_count++; |
| 3944 } | |
| 3945 | |
| 3946 if (lower_keys_count >= c->keys_so_far_total_size) | |
| 3947 { | |
| 3948 int size = lower_keys_count + 50; | |
| 3949 if (! c->keys_so_far_malloced) | |
| 3950 { | |
| 3025 | 3951 Lisp_Key_Data *new_ = xnew_array (Lisp_Key_Data, size); |
| 3952 memcpy ((void *)new_, (const void *)c->keys_so_far, | |
| 934 | 3953 c->keys_so_far_total_size * sizeof (Lisp_Key_Data)); |
| 3550 | 3954 xfree (c->keys_so_far, Lisp_Key_Data); |
| 3955 c->keys_so_far = new_; | |
| 428 | 3956 } |
| 3957 else | |
| 934 | 3958 XREALLOC_ARRAY (c->keys_so_far, Lisp_Key_Data, size); |
| 428 | 3959 |
| 3960 c->keys_so_far_total_size = size; | |
| 3961 c->keys_so_far_malloced = 1; | |
| 3962 } | |
| 3963 | |
| 3964 { | |
| 3965 Lisp_Object lower; | |
| 3966 | |
| 3967 c->keys_count = lower_keys_count; | |
| 3968 c->modifiers_so_far = lower_modifiers; | |
| 3969 | |
| 3970 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c); | |
| 3971 | |
| 3972 c->keys_count = keys_count; | |
| 3973 c->modifiers_so_far = modifiers_so_far; | |
| 3974 | |
| 3975 if (!firstonly) | |
| 3976 result = nconc2 (lower, result); | |
| 3977 else if (!NILP (lower)) | |
| 3978 return lower; | |
| 3979 } | |
| 3980 } | |
| 3981 return result; | |
| 3982 } | |
| 3983 | |
| 3984 | |
| 3985 static Lisp_Object | |
| 3986 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps, | |
| 793 | 3987 Lisp_Object firstonly, Eistring *target_buffer) |
| 428 | 3988 { |
| 3989 /* This function can GC */ | |
| 3990 Lisp_Object result = Qnil; | |
| 3991 int i; | |
| 934 | 3992 Lisp_Key_Data raw[20]; |
| 428 | 3993 struct where_is_closure c; |
| 3994 | |
| 3995 c.definition = definition; | |
| 3996 c.shadow = maps; | |
| 3997 c.firstonly = !NILP (firstonly); | |
| 3998 c.target_buffer = target_buffer; | |
| 3999 c.keys_so_far = raw; | |
| 4000 c.keys_so_far_total_size = countof (raw); | |
| 4001 c.keys_so_far_malloced = 0; | |
| 4002 | |
| 4003 /* Loop over each of the maps, accumulating the keys found. | |
| 4004 For each map searched, all previous maps shadow this one | |
| 4005 so that bogus keys aren't listed. */ | |
| 4006 for (i = 0; i < nmaps; i++) | |
| 4007 { | |
| 4008 Lisp_Object this_result; | |
| 4009 c.shadow_count = i; | |
| 4010 /* Reset the things set in each iteration */ | |
| 4011 c.keys_count = 0; | |
| 4012 c.modifiers_so_far = 0; | |
| 4013 | |
| 4014 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper, | |
| 4015 &c); | |
| 4016 if (!NILP (firstonly)) | |
| 4017 { | |
| 4018 result = this_result; | |
| 4019 if (!NILP (result)) | |
| 4020 break; | |
| 4021 } | |
| 4022 else | |
| 4023 result = nconc2 (this_result, result); | |
| 4024 } | |
| 4025 | |
| 4026 if (NILP (firstonly)) | |
| 4027 result = Fnreverse (result); | |
| 4028 | |
| 4029 if (c.keys_so_far_malloced) | |
| 1726 | 4030 xfree (c.keys_so_far, Lisp_Key_Data *); |
| 428 | 4031 return result; |
| 4032 } | |
| 4033 | |
| 4034 | |
| 4035 /************************************************************************/ | |
| 4036 /* Describing keymaps */ | |
| 4037 /************************************************************************/ | |
| 4038 | |
| 4039 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /* | |
| 4040 Insert a list of all defined keys and their definitions in MAP. | |
| 4041 Optional second argument ALL says whether to include even "uninteresting" | |
| 4042 definitions (ie symbols with a non-nil `suppress-keymap' property. | |
| 4043 Third argument SHADOW is a list of keymaps whose bindings shadow those | |
| 4044 of map; if a binding is present in any shadowing map, it is not printed. | |
| 4045 Fourth argument PREFIX, if non-nil, should be a key sequence; | |
| 4046 only bindings which start with that key sequence will be printed. | |
| 4047 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks. | |
| 4048 */ | |
| 4049 (map, all, shadow, prefix, mouse_only_p)) | |
| 4050 { | |
| 4051 /* This function can GC */ | |
| 4052 | |
| 4053 /* #### At some point, this function should be changed to accept a | |
| 4054 BUFFER argument. Currently, the BUFFER argument to | |
| 4055 describe_map_tree is being used only internally. */ | |
| 4056 describe_map_tree (map, NILP (all), shadow, prefix, | |
| 4057 !NILP (mouse_only_p), Fcurrent_buffer ()); | |
| 4058 return Qnil; | |
| 4059 } | |
| 4060 | |
| 4061 | |
| 4062 /* Insert a description of the key bindings in STARTMAP, | |
| 4063 followed by those of all maps reachable through STARTMAP. | |
| 4064 If PARTIAL is nonzero, omit certain "uninteresting" commands | |
| 4065 (such as `undefined'). | |
| 4066 If SHADOW is non-nil, it is a list of other maps; | |
| 4067 don't mention keys which would be shadowed by any of them | |
| 4068 If PREFIX is non-nil, only list bindings which start with those keys. | |
| 4069 */ | |
| 4070 | |
| 4071 void | |
| 4072 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow, | |
| 4073 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer) | |
| 4074 { | |
| 4075 /* This function can GC */ | |
| 4076 Lisp_Object maps = Qnil; | |
| 4077 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */ | |
| 4078 GCPRO2 (maps, shadow); | |
| 4079 | |
| 4080 maps = Faccessible_keymaps (startmap, prefix); | |
| 4081 | |
| 4082 for (; !NILP (maps); maps = Fcdr (maps)) | |
| 4083 { | |
| 4084 Lisp_Object sub_shadow = Qnil; | |
| 4085 Lisp_Object elt = Fcar (maps); | |
| 4086 Lisp_Object tail; | |
| 4087 int no_prefix = (VECTORP (Fcar (elt)) | |
| 4088 && XINT (Flength (Fcar (elt))) == 0); | |
| 4089 struct gcpro ngcpro1, ngcpro2, ngcpro3; | |
| 4090 NGCPRO3 (sub_shadow, elt, tail); | |
| 4091 | |
| 4092 for (tail = shadow; CONSP (tail); tail = XCDR (tail)) | |
| 4093 { | |
| 4094 Lisp_Object shmap = XCAR (tail); | |
| 4095 | |
| 4096 /* If the sequence by which we reach this keymap is zero-length, | |
| 4097 then the shadow maps for this keymap are just SHADOW. */ | |
| 4098 if (no_prefix) | |
| 4099 ; | |
| 4100 /* If the sequence by which we reach this keymap actually has | |
| 4101 some elements, then the sequence's definition in SHADOW is | |
| 4102 what we should use. */ | |
| 4103 else | |
| 4104 { | |
| 4105 shmap = Flookup_key (shmap, Fcar (elt), Qt); | |
| 4106 if (CHARP (shmap)) | |
| 4107 shmap = Qnil; | |
| 4108 } | |
| 4109 | |
| 4110 if (!NILP (shmap)) | |
| 4111 { | |
| 4112 Lisp_Object shm = get_keymap (shmap, 0, 1); | |
| 4113 /* If shmap is not nil and not a keymap, it completely | |
| 4114 shadows this map, so don't describe this map at all. */ | |
| 4115 if (!KEYMAPP (shm)) | |
| 4116 goto SKIP; | |
| 4117 sub_shadow = Fcons (shm, sub_shadow); | |
| 4118 } | |
| 4119 } | |
| 4120 | |
| 4121 { | |
| 4122 /* Describe the contents of map MAP, assuming that this map | |
| 4123 itself is reached by the sequence of prefix keys KEYS (a vector). | |
| 4124 PARTIAL and SHADOW are as in `describe_map_tree'. */ | |
| 4125 Lisp_Object keysdesc | |
| 4126 = ((!no_prefix) | |
| 4127 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string) | |
| 4128 : Qnil); | |
| 4129 describe_map (Fcdr (elt), keysdesc, | |
| 4130 describe_command, | |
| 4131 partial, | |
| 4132 sub_shadow, | |
| 4133 mice_only_p, | |
| 4134 buffer); | |
| 4135 } | |
| 4136 SKIP: | |
| 4137 NUNGCPRO; | |
| 4138 } | |
| 4139 UNGCPRO; | |
| 4140 } | |
| 4141 | |
| 4142 | |
| 4143 static void | |
| 4144 describe_command (Lisp_Object definition, Lisp_Object buffer) | |
| 4145 { | |
| 4146 /* This function can GC */ | |
| 4147 int keymapp = !NILP (Fkeymapp (definition)); | |
| 4148 struct gcpro gcpro1; | |
| 4149 GCPRO1 (definition); | |
| 4150 | |
| 4151 Findent_to (make_int (16), make_int (3), buffer); | |
| 4152 if (keymapp) | |
| 4153 buffer_insert_c_string (XBUFFER (buffer), "<< "); | |
| 4154 | |
| 4155 if (SYMBOLP (definition)) | |
| 4156 { | |
| 4157 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition)); | |
| 4158 } | |
| 4159 else if (STRINGP (definition) || VECTORP (definition)) | |
| 4160 { | |
| 4161 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: "); | |
| 4162 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition)); | |
| 4163 } | |
| 4164 else if (COMPILED_FUNCTIONP (definition)) | |
| 4165 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function"); | |
| 4166 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda)) | |
| 4167 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda"); | |
| 4168 else if (KEYMAPP (definition)) | |
| 4169 { | |
| 4170 Lisp_Object name = XKEYMAP (definition)->name; | |
| 4171 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name))) | |
| 4172 { | |
| 4173 buffer_insert_c_string (XBUFFER (buffer), "Prefix command "); | |
| 4174 if (SYMBOLP (name) | |
| 4175 && EQ (find_symbol_value (name), definition)) | |
| 4176 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name)); | |
| 4177 else | |
| 4178 { | |
| 4179 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil)); | |
| 4180 } | |
| 4181 } | |
| 4182 else | |
| 4183 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command"); | |
| 4184 } | |
| 4185 else | |
| 4186 buffer_insert_c_string (XBUFFER (buffer), "??"); | |
| 4187 | |
| 4188 if (keymapp) | |
| 4189 buffer_insert_c_string (XBUFFER (buffer), " >>"); | |
| 4190 buffer_insert_c_string (XBUFFER (buffer), "\n"); | |
| 4191 UNGCPRO; | |
| 4192 } | |
| 4193 | |
| 4194 struct describe_map_closure | |
| 4195 { | |
| 4196 Lisp_Object *list; /* pointer to the list to update */ | |
| 4197 Lisp_Object partial; /* whether to ignore suppressed commands */ | |
| 4198 Lisp_Object shadow; /* list of maps shadowing this one */ | |
| 4199 Lisp_Object self; /* this map */ | |
| 4200 Lisp_Object self_root; /* this map, or some map that has this map as | |
| 4201 a parent. this is the base of the tree */ | |
| 4202 int mice_only_p; /* whether we are to display only button bindings */ | |
| 4203 }; | |
| 4204 | |
| 4205 struct describe_map_shadow_closure | |
| 4206 { | |
| 934 | 4207 const Lisp_Key_Data *raw_key; |
| 428 | 4208 Lisp_Object self; |
| 4209 }; | |
| 4210 | |
| 4211 static Lisp_Object | |
| 4212 describe_map_mapper_shadow_search (Lisp_Object map, void *arg) | |
| 4213 { | |
| 4214 struct describe_map_shadow_closure *c = | |
| 4215 (struct describe_map_shadow_closure *) arg; | |
| 4216 | |
| 4217 if (EQ (map, c->self)) | |
| 4218 return Qzero; /* Not shadowed; terminate search */ | |
| 4219 | |
| 934 | 4220 return !NILP (keymap_lookup_directly (map, |
| 4221 KEY_DATA_KEYSYM (c->raw_key), | |
| 4222 KEY_DATA_MODIFIERS (c->raw_key))) | |
| 428 | 4223 ? Qt : Qnil; |
| 4224 } | |
| 4225 | |
| 4226 | |
| 4227 static Lisp_Object | |
| 4228 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg) | |
| 4229 { | |
| 934 | 4230 Lisp_Key_Data *k = (Lisp_Key_Data *) arg; |
| 4231 return keymap_lookup_directly (km, KEY_DATA_KEYSYM (k), KEY_DATA_MODIFIERS (k)); | |
| 428 | 4232 } |
| 4233 | |
| 4234 | |
| 4235 static void | |
| 934 | 4236 describe_map_mapper (const Lisp_Key_Data *key, |
| 428 | 4237 Lisp_Object binding, |
| 4238 void *describe_map_closure) | |
| 4239 { | |
| 4240 /* This function can GC */ | |
| 4241 struct describe_map_closure *closure = | |
| 4242 (struct describe_map_closure *) describe_map_closure; | |
| 934 | 4243 Lisp_Object keysym = KEY_DATA_KEYSYM (key); |
| 4244 int modifiers = KEY_DATA_MODIFIERS (key); | |
| 428 | 4245 |
| 4246 /* Don't mention suppressed commands. */ | |
| 4247 if (SYMBOLP (binding) | |
| 4248 && !NILP (closure->partial) | |
| 4249 && !NILP (Fget (binding, closure->partial, Qnil))) | |
| 4250 return; | |
| 4251 | |
| 4252 /* If we're only supposed to display mouse bindings and this isn't one, | |
| 4253 then bug out. */ | |
| 4254 if (closure->mice_only_p && | |
| 4255 (! (EQ (keysym, Qbutton0) || | |
| 4256 EQ (keysym, Qbutton1) || | |
| 4257 EQ (keysym, Qbutton2) || | |
| 4258 EQ (keysym, Qbutton3) || | |
| 4259 EQ (keysym, Qbutton4) || | |
| 4260 EQ (keysym, Qbutton5) || | |
| 4261 EQ (keysym, Qbutton6) || | |
| 4262 EQ (keysym, Qbutton7) || | |
| 4272 | 4263 EQ (keysym, Qbutton8) || |
| 4264 EQ (keysym, Qbutton9) || | |
| 4265 EQ (keysym, Qbutton10) || | |
| 4266 EQ (keysym, Qbutton11) || | |
| 4267 EQ (keysym, Qbutton12) || | |
| 4268 EQ (keysym, Qbutton13) || | |
| 4269 EQ (keysym, Qbutton14) || | |
| 4270 EQ (keysym, Qbutton15) || | |
| 4271 EQ (keysym, Qbutton16) || | |
| 4272 EQ (keysym, Qbutton17) || | |
| 4273 EQ (keysym, Qbutton18) || | |
| 4274 EQ (keysym, Qbutton19) || | |
| 4275 EQ (keysym, Qbutton20) || | |
| 4276 EQ (keysym, Qbutton21) || | |
| 4277 EQ (keysym, Qbutton22) || | |
| 4278 EQ (keysym, Qbutton23) || | |
| 4279 EQ (keysym, Qbutton24) || | |
| 4280 EQ (keysym, Qbutton25) || | |
| 4281 EQ (keysym, Qbutton26) || | |
| 428 | 4282 EQ (keysym, Qbutton0up) || |
| 4283 EQ (keysym, Qbutton1up) || | |
| 4284 EQ (keysym, Qbutton2up) || | |
| 4285 EQ (keysym, Qbutton3up) || | |
| 4286 EQ (keysym, Qbutton4up) || | |
| 4287 EQ (keysym, Qbutton5up) || | |
| 4272 | 4288 EQ (keysym, Qbutton6up) || |
| 4289 EQ (keysym, Qbutton7up) || | |
| 4290 EQ (keysym, Qbutton8up) || | |
| 4291 EQ (keysym, Qbutton9up) || | |
| 4292 EQ (keysym, Qbutton10up) || | |
| 4293 EQ (keysym, Qbutton11up) || | |
| 4294 EQ (keysym, Qbutton12up) || | |
| 4295 EQ (keysym, Qbutton13up) || | |
| 4296 EQ (keysym, Qbutton14up) || | |
| 4297 EQ (keysym, Qbutton15up) || | |
| 4298 EQ (keysym, Qbutton16up) || | |
| 4299 EQ (keysym, Qbutton17up) || | |
| 4300 EQ (keysym, Qbutton18up) || | |
| 4301 EQ (keysym, Qbutton19up) || | |
| 4302 EQ (keysym, Qbutton20up) || | |
| 4303 EQ (keysym, Qbutton21up) || | |
| 4304 EQ (keysym, Qbutton22up) || | |
| 4305 EQ (keysym, Qbutton23up) || | |
| 4306 EQ (keysym, Qbutton24up) || | |
| 4307 EQ (keysym, Qbutton25up) || | |
| 4308 EQ (keysym, Qbutton26up)))) | |
| 428 | 4309 return; |
| 4310 | |
| 4311 /* If this command in this map is shadowed by some other map, ignore it. */ | |
| 4312 { | |
| 4313 Lisp_Object tail; | |
| 4314 | |
| 4315 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail)) | |
| 4316 { | |
| 4317 QUIT; | |
| 4318 if (!NILP (traverse_keymaps (XCAR (tail), Qnil, | |
| 4319 keymap_lookup_inherited_mapper, | |
| 4320 /* Cast to discard `const' */ | |
| 4321 (void *)key))) | |
| 4322 return; | |
| 4323 } | |
| 4324 } | |
| 4325 | |
| 4326 /* If this key is in some map of which this map is a parent, then ignore | |
| 4327 it (in that case, it has been shadowed). | |
| 4328 */ | |
| 4329 { | |
| 4330 Lisp_Object sh; | |
| 4331 struct describe_map_shadow_closure c; | |
| 4332 c.raw_key = key; | |
| 4333 c.self = closure->self; | |
| 4334 | |
| 4335 sh = traverse_keymaps (closure->self_root, Qnil, | |
| 4336 describe_map_mapper_shadow_search, &c); | |
| 4337 if (!NILP (sh) && !ZEROP (sh)) | |
| 4338 return; | |
| 4339 } | |
| 4340 | |
| 4341 /* Otherwise add it to the list to be sorted. */ | |
| 4342 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)), | |
| 4343 binding), | |
| 4344 *(closure->list)); | |
| 4345 } | |
| 4346 | |
| 4347 | |
| 4348 static int | |
| 4349 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2, | |
| 4350 Lisp_Object pred) | |
| 4351 { | |
| 4352 /* obj1 and obj2 are conses of the form | |
| 4353 ( ( <keysym> . <modifiers> ) . <binding> ) | |
| 4354 keysym and modifiers are used, binding is ignored. | |
| 4355 */ | |
| 442 | 4356 int bit1, bit2; |
| 428 | 4357 obj1 = XCAR (obj1); |
| 4358 obj2 = XCAR (obj2); | |
| 4359 bit1 = XINT (XCDR (obj1)); | |
| 4360 bit2 = XINT (XCDR (obj2)); | |
| 4361 if (bit1 != bit2) | |
| 4362 return bit1 < bit2 ? 1 : -1; | |
| 4363 else | |
| 4364 return map_keymap_sort_predicate (obj1, obj2, pred); | |
| 4365 } | |
| 4366 | |
| 4367 /* Elide 2 or more consecutive numeric keysyms bound to the same thing, | |
| 4368 or 2 or more symbolic keysyms that are bound to the same thing and | |
| 4369 have consecutive character-set-properties. | |
| 4370 */ | |
| 4371 static int | |
| 4372 elide_next_two_p (Lisp_Object list) | |
| 4373 { | |
| 4374 Lisp_Object s1, s2; | |
| 2828 | 4375 extern Lisp_Object Qcharacter_of_keysym; |
| 428 | 4376 |
| 4377 if (NILP (XCDR (list))) | |
| 4378 return 0; | |
| 4379 | |
| 4380 /* next two bindings differ */ | |
| 4381 if (!EQ (XCDR (XCAR (list)), | |
| 4382 XCDR (XCAR (XCDR (list))))) | |
| 4383 return 0; | |
| 4384 | |
| 4385 /* next two modifier-sets differ */ | |
| 4386 if (!EQ (XCDR (XCAR (XCAR (list))), | |
| 4387 XCDR (XCAR (XCAR (XCDR (list)))))) | |
| 4388 return 0; | |
| 4389 | |
| 4390 s1 = XCAR (XCAR (XCAR (list))); | |
| 4391 s2 = XCAR (XCAR (XCAR (XCDR (list)))); | |
| 4392 | |
| 4393 if (SYMBOLP (s1)) | |
| 4394 { | |
| 2828 | 4395 Lisp_Object code = Fget (s1, Qcharacter_of_keysym, Qnil); |
| 428 | 4396 if (CHAR_OR_CHAR_INTP (code)) |
| 4397 { | |
| 4398 s1 = code; | |
| 4399 CHECK_CHAR_COERCE_INT (s1); | |
| 4400 } | |
| 4401 else return 0; | |
| 4402 } | |
| 4403 if (SYMBOLP (s2)) | |
| 4404 { | |
| 2828 | 4405 Lisp_Object code = Fget (s2, Qcharacter_of_keysym, Qnil); |
| 428 | 4406 if (CHAR_OR_CHAR_INTP (code)) |
| 4407 { | |
| 4408 s2 = code; | |
| 4409 CHECK_CHAR_COERCE_INT (s2); | |
| 4410 } | |
| 4411 else return 0; | |
| 4412 } | |
| 4413 | |
| 4414 return (XCHAR (s1) == XCHAR (s2) || | |
| 4415 XCHAR (s1) + 1 == XCHAR (s2)); | |
| 4416 } | |
| 4417 | |
| 4418 | |
| 4419 static Lisp_Object | |
| 4420 describe_map_parent_mapper (Lisp_Object keymap, void *arg) | |
| 4421 { | |
| 4422 /* This function can GC */ | |
| 4423 struct describe_map_closure *describe_map_closure = | |
| 4424 (struct describe_map_closure *) arg; | |
| 4425 describe_map_closure->self = keymap; | |
| 4426 map_keymap (XKEYMAP (keymap)->table, | |
| 4427 0, /* don't sort: we'll do it later */ | |
| 4428 describe_map_mapper, describe_map_closure); | |
| 4429 return Qnil; | |
| 4430 } | |
| 4431 | |
| 4432 | |
| 4433 /* Describe the contents of map MAP, assuming that this map itself is | |
| 4434 reached by the sequence of prefix keys KEYS (a string or vector). | |
| 4435 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */ | |
| 4436 | |
| 4437 static void | |
| 4438 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix, | |
| 4439 void (*elt_describer) (Lisp_Object, Lisp_Object), | |
| 4440 int partial, | |
| 4441 Lisp_Object shadow, | |
| 4442 int mice_only_p, | |
| 4443 Lisp_Object buffer) | |
| 4444 { | |
| 4445 /* This function can GC */ | |
| 4446 struct describe_map_closure describe_map_closure; | |
| 4447 Lisp_Object list = Qnil; | |
| 4448 struct buffer *buf = XBUFFER (buffer); | |
| 867 | 4449 Ichar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow) |
| 428 | 4450 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow) |
| 4451 : ((EQ (buf->ctl_arrow, Qt) | |
| 4452 || EQ (buf->ctl_arrow, Qnil)) | |
| 4453 ? 256 : 160)); | |
| 4454 int elided = 0; | |
| 4455 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; | |
| 2828 | 4456 extern Lisp_Object Qcharacter_of_keysym; |
| 428 | 4457 |
| 4458 keymap = get_keymap (keymap, 1, 1); | |
| 4459 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil); | |
| 4460 describe_map_closure.shadow = shadow; | |
| 4461 describe_map_closure.list = &list; | |
| 4462 describe_map_closure.self_root = keymap; | |
| 4463 describe_map_closure.mice_only_p = mice_only_p; | |
| 4464 | |
| 4465 GCPRO4 (keymap, elt_prefix, shadow, list); | |
| 4466 | |
| 4467 traverse_keymaps (keymap, Qnil, | |
| 4468 describe_map_parent_mapper, &describe_map_closure); | |
| 4469 | |
| 4470 if (!NILP (list)) | |
| 4471 { | |
| 4472 list = list_sort (list, Qnil, describe_map_sort_predicate); | |
| 4473 buffer_insert_c_string (buf, "\n"); | |
| 4474 while (!NILP (list)) | |
| 4475 { | |
| 4476 Lisp_Object elt = XCAR (XCAR (list)); | |
| 4477 Lisp_Object keysym = XCAR (elt); | |
| 442 | 4478 int modifiers = XINT (XCDR (elt)); |
| 428 | 4479 |
| 4480 if (!NILP (elt_prefix)) | |
| 4481 buffer_insert_lisp_string (buf, elt_prefix); | |
| 4482 | |
| 442 | 4483 if (modifiers & XEMACS_MOD_META) |
| 4484 buffer_insert_c_string (buf, "M-"); | |
| 4485 if (modifiers & XEMACS_MOD_CONTROL) | |
| 4486 buffer_insert_c_string (buf, "C-"); | |
| 4487 if (modifiers & XEMACS_MOD_SUPER) | |
| 4488 buffer_insert_c_string (buf, "S-"); | |
| 4489 if (modifiers & XEMACS_MOD_HYPER) | |
| 4490 buffer_insert_c_string (buf, "H-"); | |
| 4491 if (modifiers & XEMACS_MOD_ALT) | |
| 4492 buffer_insert_c_string (buf, "Alt-"); | |
| 4493 if (modifiers & XEMACS_MOD_SHIFT) | |
| 4494 buffer_insert_c_string (buf, "Sh-"); | |
| 428 | 4495 if (SYMBOLP (keysym)) |
| 4496 { | |
| 2828 | 4497 Lisp_Object code = Fget (keysym, Qcharacter_of_keysym, Qnil); |
| 867 | 4498 Ichar c = (CHAR_OR_CHAR_INTP (code) |
| 4499 ? XCHAR_OR_CHAR_INT (code) : (Ichar) -1); | |
| 428 | 4500 /* Calling Fsingle_key_description() would cons more */ |
| 4501 #if 0 /* This is bogus */ | |
| 4502 if (EQ (keysym, QKlinefeed)) | |
| 4503 buffer_insert_c_string (buf, "LFD"); | |
| 4504 else if (EQ (keysym, QKtab)) | |
| 4505 buffer_insert_c_string (buf, "TAB"); | |
| 4506 else if (EQ (keysym, QKreturn)) | |
| 4507 buffer_insert_c_string (buf, "RET"); | |
| 4508 else if (EQ (keysym, QKescape)) | |
| 4509 buffer_insert_c_string (buf, "ESC"); | |
| 4510 else if (EQ (keysym, QKdelete)) | |
| 4511 buffer_insert_c_string (buf, "DEL"); | |
| 4512 else if (EQ (keysym, QKspace)) | |
| 4513 buffer_insert_c_string (buf, "SPC"); | |
| 4514 else if (EQ (keysym, QKbackspace)) | |
| 4515 buffer_insert_c_string (buf, "BS"); | |
| 4516 else | |
| 4517 #endif | |
| 4518 if (c >= printable_min) | |
| 4519 buffer_insert_emacs_char (buf, c); | |
| 4520 else buffer_insert1 (buf, Fsymbol_name (keysym)); | |
| 4521 } | |
| 4522 else if (CHARP (keysym)) | |
| 4523 buffer_insert_emacs_char (buf, XCHAR (keysym)); | |
| 4524 else | |
| 4525 buffer_insert_c_string (buf, "---bad keysym---"); | |
| 4526 | |
| 4527 if (elided) | |
| 4528 elided = 0; | |
| 4529 else | |
| 4530 { | |
| 4531 int k = 0; | |
| 4532 | |
| 4533 while (elide_next_two_p (list)) | |
| 4534 { | |
| 4535 k++; | |
| 4536 list = XCDR (list); | |
| 4537 } | |
| 4538 if (k != 0) | |
| 4539 { | |
| 4540 if (k == 1) | |
| 4541 buffer_insert_c_string (buf, ", "); | |
| 4542 else | |
| 4543 buffer_insert_c_string (buf, " .. "); | |
| 4544 elided = 1; | |
| 4545 continue; | |
| 4546 } | |
| 4547 } | |
| 4548 | |
| 4549 /* Print a description of the definition of this character. */ | |
| 4550 (*elt_describer) (XCDR (XCAR (list)), buffer); | |
| 4551 list = XCDR (list); | |
| 4552 } | |
| 4553 } | |
| 4554 UNGCPRO; | |
| 4555 } | |
| 4556 | |
| 4557 | |
| 4558 void | |
| 4559 syms_of_keymap (void) | |
| 4560 { | |
| 442 | 4561 INIT_LRECORD_IMPLEMENTATION (keymap); |
| 4562 | |
| 502 | 4563 DEFSYMBOL (Qminor_mode_map_alist); |
| 4564 | |
| 4565 DEFSYMBOL (Qkeymapp); | |
| 4566 | |
| 4567 DEFSYMBOL (Qsuppress_keymap); | |
| 4568 | |
| 4569 DEFSYMBOL (Qmodeline_map); | |
| 4570 DEFSYMBOL (Qtoolbar_map); | |
| 428 | 4571 |
| 4572 DEFSUBR (Fkeymap_parents); | |
| 4573 DEFSUBR (Fset_keymap_parents); | |
| 4574 DEFSUBR (Fkeymap_name); | |
| 4575 DEFSUBR (Fset_keymap_name); | |
| 4576 DEFSUBR (Fkeymap_prompt); | |
| 4577 DEFSUBR (Fset_keymap_prompt); | |
| 4578 DEFSUBR (Fkeymap_default_binding); | |
| 4579 DEFSUBR (Fset_keymap_default_binding); | |
| 4580 | |
| 4581 DEFSUBR (Fkeymapp); | |
| 4582 DEFSUBR (Fmake_keymap); | |
| 4583 DEFSUBR (Fmake_sparse_keymap); | |
| 4584 | |
| 4585 DEFSUBR (Fcopy_keymap); | |
| 4586 DEFSUBR (Fkeymap_fullness); | |
| 4587 DEFSUBR (Fmap_keymap); | |
| 4588 DEFSUBR (Fevent_matches_key_specifier_p); | |
| 4589 DEFSUBR (Fdefine_key); | |
| 4590 DEFSUBR (Flookup_key); | |
| 4591 DEFSUBR (Fkey_binding); | |
| 4592 DEFSUBR (Fuse_global_map); | |
| 4593 DEFSUBR (Fuse_local_map); | |
| 4594 DEFSUBR (Fcurrent_local_map); | |
| 4595 DEFSUBR (Fcurrent_global_map); | |
| 4596 DEFSUBR (Fcurrent_keymaps); | |
| 4597 DEFSUBR (Faccessible_keymaps); | |
| 4598 DEFSUBR (Fkey_description); | |
| 4599 DEFSUBR (Fsingle_key_description); | |
| 4600 DEFSUBR (Fwhere_is_internal); | |
| 4601 DEFSUBR (Fdescribe_bindings_internal); | |
| 4602 | |
| 4603 DEFSUBR (Ftext_char_description); | |
| 4604 | |
| 502 | 4605 DEFSYMBOL (Qcontrol); |
| 4606 DEFSYMBOL (Qctrl); | |
| 4607 DEFSYMBOL (Qmeta); | |
| 4608 DEFSYMBOL (Qsuper); | |
| 4609 DEFSYMBOL (Qhyper); | |
| 4610 DEFSYMBOL (Qalt); | |
| 4611 DEFSYMBOL (Qshift); | |
| 4612 DEFSYMBOL (Qbutton0); | |
| 4613 DEFSYMBOL (Qbutton1); | |
| 4614 DEFSYMBOL (Qbutton2); | |
| 4615 DEFSYMBOL (Qbutton3); | |
| 4616 DEFSYMBOL (Qbutton4); | |
| 4617 DEFSYMBOL (Qbutton5); | |
| 4618 DEFSYMBOL (Qbutton6); | |
| 4619 DEFSYMBOL (Qbutton7); | |
| 4272 | 4620 DEFSYMBOL (Qbutton8); |
| 4621 DEFSYMBOL (Qbutton9); | |
| 4622 DEFSYMBOL (Qbutton10); | |
| 4623 DEFSYMBOL (Qbutton11); | |
| 4624 DEFSYMBOL (Qbutton12); | |
| 4625 DEFSYMBOL (Qbutton13); | |
| 4626 DEFSYMBOL (Qbutton14); | |
| 4627 DEFSYMBOL (Qbutton15); | |
| 4628 DEFSYMBOL (Qbutton16); | |
| 4629 DEFSYMBOL (Qbutton17); | |
| 4630 DEFSYMBOL (Qbutton18); | |
| 4631 DEFSYMBOL (Qbutton19); | |
| 4632 DEFSYMBOL (Qbutton20); | |
| 4633 DEFSYMBOL (Qbutton21); | |
| 4634 DEFSYMBOL (Qbutton22); | |
| 4635 DEFSYMBOL (Qbutton23); | |
| 4636 DEFSYMBOL (Qbutton24); | |
| 4637 DEFSYMBOL (Qbutton25); | |
| 4638 DEFSYMBOL (Qbutton26); | |
| 502 | 4639 DEFSYMBOL (Qbutton0up); |
| 4640 DEFSYMBOL (Qbutton1up); | |
| 4641 DEFSYMBOL (Qbutton2up); | |
| 4642 DEFSYMBOL (Qbutton3up); | |
| 4643 DEFSYMBOL (Qbutton4up); | |
| 4644 DEFSYMBOL (Qbutton5up); | |
| 4645 DEFSYMBOL (Qbutton6up); | |
| 4646 DEFSYMBOL (Qbutton7up); | |
| 4272 | 4647 DEFSYMBOL (Qbutton8up); |
| 4648 DEFSYMBOL (Qbutton9up); | |
| 4649 DEFSYMBOL (Qbutton10up); | |
| 4650 DEFSYMBOL (Qbutton11up); | |
| 4651 DEFSYMBOL (Qbutton12up); | |
| 4652 DEFSYMBOL (Qbutton13up); | |
| 4653 DEFSYMBOL (Qbutton14up); | |
| 4654 DEFSYMBOL (Qbutton15up); | |
| 4655 DEFSYMBOL (Qbutton16up); | |
| 4656 DEFSYMBOL (Qbutton17up); | |
| 4657 DEFSYMBOL (Qbutton18up); | |
| 4658 DEFSYMBOL (Qbutton19up); | |
| 4659 DEFSYMBOL (Qbutton20up); | |
| 4660 DEFSYMBOL (Qbutton21up); | |
| 4661 DEFSYMBOL (Qbutton22up); | |
| 4662 DEFSYMBOL (Qbutton23up); | |
| 4663 DEFSYMBOL (Qbutton24up); | |
| 4664 DEFSYMBOL (Qbutton25up); | |
| 4665 DEFSYMBOL (Qbutton26up); | |
| 502 | 4666 DEFSYMBOL (Qmouse_1); |
| 4667 DEFSYMBOL (Qmouse_2); | |
| 4668 DEFSYMBOL (Qmouse_3); | |
| 4669 DEFSYMBOL (Qmouse_4); | |
| 4670 DEFSYMBOL (Qmouse_5); | |
| 4671 DEFSYMBOL (Qmouse_6); | |
| 4672 DEFSYMBOL (Qmouse_7); | |
| 4272 | 4673 DEFSYMBOL (Qmouse_8); |
| 4674 DEFSYMBOL (Qmouse_9); | |
| 4675 DEFSYMBOL (Qmouse_10); | |
| 4676 DEFSYMBOL (Qmouse_11); | |
| 4677 DEFSYMBOL (Qmouse_12); | |
| 4678 DEFSYMBOL (Qmouse_13); | |
| 4679 DEFSYMBOL (Qmouse_14); | |
| 4680 DEFSYMBOL (Qmouse_15); | |
| 4681 DEFSYMBOL (Qmouse_16); | |
| 4682 DEFSYMBOL (Qmouse_17); | |
| 4683 DEFSYMBOL (Qmouse_18); | |
| 4684 DEFSYMBOL (Qmouse_19); | |
| 4685 DEFSYMBOL (Qmouse_20); | |
| 4686 DEFSYMBOL (Qmouse_21); | |
| 4687 DEFSYMBOL (Qmouse_22); | |
| 4688 DEFSYMBOL (Qmouse_23); | |
| 4689 DEFSYMBOL (Qmouse_24); | |
| 4690 DEFSYMBOL (Qmouse_25); | |
| 4691 DEFSYMBOL (Qmouse_26); | |
| 502 | 4692 DEFSYMBOL (Qdown_mouse_1); |
| 4693 DEFSYMBOL (Qdown_mouse_2); | |
| 4694 DEFSYMBOL (Qdown_mouse_3); | |
| 4695 DEFSYMBOL (Qdown_mouse_4); | |
| 4696 DEFSYMBOL (Qdown_mouse_5); | |
| 4697 DEFSYMBOL (Qdown_mouse_6); | |
| 4698 DEFSYMBOL (Qdown_mouse_7); | |
| 4272 | 4699 DEFSYMBOL (Qdown_mouse_8); |
| 4700 DEFSYMBOL (Qdown_mouse_9); | |
| 4701 DEFSYMBOL (Qdown_mouse_10); | |
| 4702 DEFSYMBOL (Qdown_mouse_11); | |
| 4703 DEFSYMBOL (Qdown_mouse_12); | |
| 4704 DEFSYMBOL (Qdown_mouse_13); | |
| 4705 DEFSYMBOL (Qdown_mouse_14); | |
| 4706 DEFSYMBOL (Qdown_mouse_15); | |
| 4707 DEFSYMBOL (Qdown_mouse_16); | |
| 4708 DEFSYMBOL (Qdown_mouse_17); | |
| 4709 DEFSYMBOL (Qdown_mouse_18); | |
| 4710 DEFSYMBOL (Qdown_mouse_19); | |
| 4711 DEFSYMBOL (Qdown_mouse_20); | |
| 4712 DEFSYMBOL (Qdown_mouse_21); | |
| 4713 DEFSYMBOL (Qdown_mouse_22); | |
| 4714 DEFSYMBOL (Qdown_mouse_23); | |
| 4715 DEFSYMBOL (Qdown_mouse_24); | |
| 4716 DEFSYMBOL (Qdown_mouse_25); | |
| 4717 DEFSYMBOL (Qdown_mouse_26); | |
| 502 | 4718 DEFSYMBOL (Qmenu_selection); |
| 4719 DEFSYMBOL (QLFD); | |
| 4720 DEFSYMBOL (QTAB); | |
| 4721 DEFSYMBOL (QRET); | |
| 4722 DEFSYMBOL (QESC); | |
| 4723 DEFSYMBOL (QDEL); | |
| 4724 DEFSYMBOL (QSPC); | |
| 4725 DEFSYMBOL (QBS); | |
| 428 | 4726 } |
| 4727 | |
| 4728 void | |
| 4729 vars_of_keymap (void) | |
| 4730 { | |
| 4731 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /* | |
| 4732 Meta-prefix character. | |
| 4733 This character followed by some character `foo' turns into `Meta-foo'. | |
| 4734 This can be any form recognized as a single key specifier. | |
| 4735 To disable the meta-prefix-char, set it to a negative number. | |
| 4736 */ ); | |
| 4737 Vmeta_prefix_char = make_char (033); | |
| 4738 | |
| 4739 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /* | |
| 4740 A buffer which should be consulted first for all mouse activity. | |
| 4741 When a mouse-click is processed, it will first be looked up in the | |
| 4742 local-map of this buffer, and then through the normal mechanism if there | |
| 4743 is no binding for that click. This buffer's value of `mode-motion-hook' | |
| 4744 will be consulted instead of the `mode-motion-hook' of the buffer of the | |
| 4745 window under the mouse. You should *bind* this, not set it. | |
| 4746 */ ); | |
| 4747 Vmouse_grabbed_buffer = Qnil; | |
| 4748 | |
| 4749 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /* | |
| 4750 Keymap that overrides all other local keymaps. | |
| 4751 If this variable is non-nil, it is used as a keymap instead of the | |
| 4752 buffer's local map, and the minor mode keymaps and extent-local keymaps. | |
| 4753 You should *bind* this, not set it. | |
| 4754 */ ); | |
| 4755 Voverriding_local_map = Qnil; | |
| 4756 | |
| 4757 Fset (Qminor_mode_map_alist, Qnil); | |
| 4758 | |
| 4759 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /* | |
| 4760 Keymap of key translations that can override keymaps. | |
| 2027 | 4761 |
| 4762 This keymap works like `function-key-map', but is searched before it, | |
| 428 | 4763 and applies even for keys that have ordinary bindings. |
| 2027 | 4764 |
| 4765 The `read-key-sequence' function replaces any subsequence bound by | |
| 4766 `key-translation-map' with its binding. More precisely, when the active | |
| 4767 keymaps have no binding for the current key sequence but | |
| 4768 `key-translation-map' binds a suffix of the sequence to a vector or string, | |
| 4769 `read-key-sequence' replaces the matching suffix with its binding, and | |
| 4770 continues with the new sequence. See `key-binding' for details. | |
| 4771 | |
| 4772 The events that come from bindings in `key-translation-map' are not | |
| 4773 themselves looked up in `key-translation-map'. | |
| 4774 | |
| 4775 #### FIXME: stolen from `function-key-map'; need better example. | |
| 4776 #### I guess you could implement a Dvorak keyboard with this? | |
| 4777 For example, suppose `key-translation-map' binds `ESC O P' to [f1]. | |
| 4778 Typing `ESC O P' to `read-key-sequence' would return | |
| 4779 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return | |
| 4780 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1] | |
| 4781 were a prefix key, typing `ESC O P x' would return | |
| 4782 \[#<keypress-event f1> #<keypress-event x>]. | |
| 428 | 4783 */ ); |
| 4784 Vkey_translation_map = Qnil; | |
| 4785 | |
| 771 | 4786 DEFVAR_LISP ("global-tty-map", &Vglobal_tty_map /* |
| 4787 Global keymap that applies only to TTY's. | |
| 4788 Key bindings are looked up in this map just before looking in the global map, | |
| 4789 but only when the current console is a TTY console. See also | |
| 4790 `global-window-system-map'. | |
| 4791 */ ); | |
| 4792 Vglobal_tty_map = Qnil; | |
| 4793 | |
| 4794 DEFVAR_LISP ("global-window-system-map", &Vglobal_window_system_map /* | |
| 4795 Global keymap that applies only to window systems. | |
| 4796 Key bindings are looked up in this map just before looking in the global map, | |
| 4797 but only when the current console is not a TTY console. See also | |
| 4798 `global-tty-map'. | |
| 4799 */ ); | |
| 4800 Vglobal_window_system_map = Qnil; | |
| 4801 | |
| 428 | 4802 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /* |
| 4803 Keymap which handles mouse clicks over vertical dividers. | |
| 4804 */ ); | |
| 4805 Vvertical_divider_map = Qnil; | |
| 4806 | |
| 4807 DEFVAR_INT ("keymap-tick", &keymap_tick /* | |
| 4808 Incremented for each change to any keymap. | |
| 4809 */ ); | |
| 4810 keymap_tick = 0; | |
| 4811 | |
| 4812 staticpro (&Vcurrent_global_map); | |
| 4813 | |
| 867 | 4814 Vsingle_space_string = make_string ((const Ibyte *) " ", 1); |
| 428 | 4815 staticpro (&Vsingle_space_string); |
| 4816 } | |
| 4817 | |
| 4818 void | |
| 4819 complex_vars_of_keymap (void) | |
| 4820 { | |
| 4821 /* This function can GC */ | |
| 4822 Lisp_Object ESC_prefix = intern ("ESC-prefix"); | |
| 4823 Lisp_Object meta_disgustitute; | |
| 4824 | |
| 4825 Vcurrent_global_map = Fmake_keymap (Qnil); | |
| 771 | 4826 Vglobal_tty_map = Fmake_keymap (intern ("global-tty-map")); |
| 4827 Vglobal_window_system_map = | |
| 4828 Fmake_keymap (intern ("global-window-system-map")); | |
| 428 | 4829 |
| 4830 meta_disgustitute = Fmake_keymap (Qnil); | |
| 4831 Ffset (ESC_prefix, meta_disgustitute); | |
| 4832 /* no need to protect meta_disgustitute, though */ | |
| 442 | 4833 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META), |
| 428 | 4834 XKEYMAP (Vcurrent_global_map), |
| 4835 meta_disgustitute); | |
| 4836 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt; | |
| 4837 | |
| 4838 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map")); | |
| 4839 } |