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