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