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