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.
5 Copyright (C) 2007 Steve Youngs.
6 Totally redesigned by jwz in 1991.
8 This file is part of SXEmacs
10 SXEmacs is free software: you can redistribute it and/or modify
11 it under the terms of the GNU General Public License as published by
12 the Free Software Foundation, either version 3 of the License, or
13 (at your option) any later version.
15 SXEmacs is distributed in the hope that it will be useful,
16 but WITHOUT ANY WARRANTY; without even the implied warranty of
17 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 GNU General Public License for more details.
20 You should have received a copy of the GNU General Public License
21 along with this program. If not, see <http://www.gnu.org/licenses/>. */
24 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially
25 different from FSF. */
34 #define INCLUDE_EVENTS_H_PRIVATE_SPHERE
35 #include "events/events.h"
40 #include "events/events-mod.h"
42 /* A keymap contains six slots:
44 parents Ordered list of keymaps to search after
45 this one if no match is found.
46 Keymaps can thus be arranged in a hierarchy.
48 table A hash table, hashing keysyms to their bindings.
49 It will be one of the following:
51 -- a symbol, e.g. 'home
52 -- a character, representing something printable
53 (not ?\C-c meaning C-c, for instance)
54 -- an integer representing a modifier combination
56 inverse_table A hash table, hashing bindings to the list of keysyms
57 in this keymap which are bound to them. This is to make
58 the Fwhere_is_internal() function be fast. It needs to be
59 fast because we want to be able to call it in realtime to
60 update the keyboard-equivalents on the pulldown menus.
61 Values of the table are either atoms (keysyms)
62 or a dotted list of keysyms.
64 sub_maps_cache An alist; for each entry in this keymap whose binding is
65 a keymap (that is, Fkeymapp()) this alist associates that
66 keysym with that binding. This is used to optimize both
67 Fwhere_is_internal() and Faccessible_keymaps(). This slot
68 gets set to the symbol `t' every time a change is made to
69 this keymap, causing it to be recomputed when next needed.
71 prompt See `set-keymap-prompt'.
73 default_binding See `set-keymap-default-binding'.
75 Sequences of keys are stored in the obvious way: if the sequence of keys
76 "abc" was bound to some command `foo', the hierarchy would look like
78 keymap-1: associates "a" with keymap-2
79 keymap-2: associates "b" with keymap-3
80 keymap-3: associates "c" with foo
82 However, bucky bits ("modifiers" to the X-minded) are represented in the
83 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
84 Each combination of modifiers (e.g. control-hyper) gets its own submap
85 off of the main map. The hash key for a modifier combination is
86 an integer, computed by MAKE_MODIFIER_HASH_KEY().
88 If the key `C-a' was bound to some command, the hierarchy would look like
90 keymap-1: associates the integer XEMACS_MOD_CONTROL with keymap-2
91 keymap-2: associates "a" with the command
93 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
96 keymap-1: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
98 keymap-2: associates "a" with the command
100 Note that a special exception is made for the meta modifier, in order
101 to deal with ESC/meta lossage. Any key combination containing the
102 meta modifier is first indexed off of the main map into the meta
103 submap (with hash key XEMACS_MOD_META) and then indexed off of the
104 meta submap with the meta modifier removed from the key combination.
105 For example, when associating a command with C-M-H-a, we'd have
107 keymap-1: associates the integer XEMACS_MOD_META with keymap-2
108 keymap-2: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
110 keymap-3: associates "a" with the command
112 Note that keymap-2 might have normal bindings in it; these would be
113 for key combinations containing only the meta modifier, such as
114 M-y or meta-backspace.
116 If the command that "a" was bound to in keymap-3 was itself a keymap,
117 then that would make the key "C-M-H-a" be a prefix character.
119 Note that this new model of keymaps takes much of the magic away from
120 the Escape key: the value of the variable `esc-map' is no longer indexed
121 in the `global-map' under the ESC key. It's indexed under the integer
122 XEMACS_MOD_META. This is not user-visible, however; none of the "bucky"
125 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
126 and (define-key some-random-map "\^[" my-esc-map) work as before, for
129 Since keymaps are opaque, the only way to extract information from them
130 is with the functions lookup-key, key-binding, local-key-binding, and
131 global-key-binding, which work just as before, and the new function
132 map-keymap, which is roughly analogous to maphash.
134 Note that map-keymap perpetuates the illusion that the "bucky" submaps
135 don't exist: if you map over a keymap with bucky submaps, it will also
136 map over those submaps. It does not, however, map over other random
137 submaps of the keymap, just the bucky ones.
139 One implication of this is that when you map over `global-map', you will
140 also map over `esc-map'. It is merely for compatibility that the esc-map
141 is accessible at all; I think that's a bad thing, since it blurs the
142 distinction between ESC and "meta" even more. "M-x" is no more a two-
143 key sequence than "C-x" is.
148 struct lcrecord_header header;
149 Lisp_Object parents; /* Keymaps to be searched after this one.
151 Lisp_Object prompt; /* Qnil or a string to print in the minibuffer
152 when reading from this keymap */
153 Lisp_Object table; /* The contents of this keymap */
154 Lisp_Object inverse_table; /* The inverse mapping of the above */
155 Lisp_Object default_binding; /* Use this if no other binding is found
156 (this overrides parent maps and the
157 normal global-map lookup). */
158 Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps;
159 This holds an alist, of the key and the
160 maps, or the modifier bit and the map.
161 If this is the symbol t, then the cache
162 needs to be recomputed. */
163 Lisp_Object name; /* Just for debugging convenience */
166 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
167 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
169 /* Actually allocate storage for these variables */
171 Lisp_Object Vcurrent_global_map; /* Always a keymap */
173 static Lisp_Object Vglobal_tty_map, Vglobal_window_system_map;
175 static Lisp_Object Vmouse_grabbed_buffer;
177 /* Alist of minor mode variables and keymaps. */
178 static Lisp_Object Qminor_mode_map_alist;
180 static Lisp_Object Voverriding_local_map;
182 static Lisp_Object Vkey_translation_map;
184 static Lisp_Object Vvertical_divider_map;
186 /* This is incremented whenever a change is made to a keymap. This is
187 so that things which care (such as the menubar code) can recompute
188 privately-cached data when the user has changed keybindings.
192 /* Prefixing a key with this character is the same as sending a meta bit. */
193 Lisp_Object Vmeta_prefix_char;
195 Lisp_Object Qkeymapp;
196 Lisp_Object Vsingle_space_string;
197 Lisp_Object Qsuppress_keymap;
198 Lisp_Object Qmodeline_map;
199 Lisp_Object Qtoolbar_map;
201 EXFUN(Fkeymap_fullness, 1);
202 EXFUN(Fset_keymap_name, 2);
203 EXFUN(Fsingle_key_description, 1);
205 static void describe_command(Lisp_Object definition, Lisp_Object buffer);
206 static void describe_map(Lisp_Object keymap, Lisp_Object elt_prefix,
207 void (*elt_describer) (Lisp_Object, Lisp_Object),
210 int mice_only_p, Lisp_Object buffer);
211 static Lisp_Object keymap_submaps(Lisp_Object keymap);
213 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
214 Lisp_Object Qbutton0;
215 Lisp_Object Qbutton1, Qbutton2, Qbutton3, Qbutton4, Qbutton5;
216 Lisp_Object Qbutton6, Qbutton7, Qbutton8, Qbutton9, Qbutton10;
217 Lisp_Object Qbutton11, Qbutton12, Qbutton13, Qbutton14, Qbutton15;
218 Lisp_Object Qbutton16, Qbutton17, Qbutton18, Qbutton19, Qbutton20;
219 Lisp_Object Qbutton21, Qbutton22, Qbutton23, Qbutton24, Qbutton25;
220 Lisp_Object Qbutton26, Qbutton27, Qbutton28, Qbutton29, Qbutton30;
221 Lisp_Object Qbutton31, Qbutton32;
222 Lisp_Object Qbutton0up;
223 Lisp_Object Qbutton1up, Qbutton2up, Qbutton3up, Qbutton4up, Qbutton5up;
224 Lisp_Object Qbutton6up, Qbutton7up, Qbutton8up, Qbutton9up, Qbutton10up;
225 Lisp_Object Qbutton11up, Qbutton12up, Qbutton13up, Qbutton14up, Qbutton15up;
226 Lisp_Object Qbutton16up, Qbutton17up, Qbutton18up, Qbutton19up, Qbutton20up;
227 Lisp_Object Qbutton21up, Qbutton22up, Qbutton23up, Qbutton24up, Qbutton25up;
228 Lisp_Object Qbutton26up, Qbutton27up, Qbutton28up, Qbutton29up, Qbutton30up;
229 Lisp_Object Qbutton31up, Qbutton32up;
231 Lisp_Object Qmenu_selection;
232 /* Emacs compatibility */
233 Lisp_Object Qdown_mouse_1, Qmouse_1;
234 Lisp_Object Qdown_mouse_2, Qmouse_2;
235 Lisp_Object Qdown_mouse_3, Qmouse_3;
236 Lisp_Object Qdown_mouse_4, Qmouse_4;
237 Lisp_Object Qdown_mouse_5, Qmouse_5;
238 Lisp_Object Qdown_mouse_6, Qmouse_6;
239 Lisp_Object Qdown_mouse_7, Qmouse_7;
240 Lisp_Object Qdown_mouse_8, Qmouse_8;
241 Lisp_Object Qdown_mouse_9, Qmouse_9;
242 Lisp_Object Qdown_mouse_10, Qmouse_10;
243 Lisp_Object Qdown_mouse_11, Qmouse_11;
244 Lisp_Object Qdown_mouse_12, Qmouse_12;
245 Lisp_Object Qdown_mouse_13, Qmouse_13;
246 Lisp_Object Qdown_mouse_14, Qmouse_14;
247 Lisp_Object Qdown_mouse_15, Qmouse_15;
248 Lisp_Object Qdown_mouse_16, Qmouse_16;
249 Lisp_Object Qdown_mouse_17, Qmouse_17;
250 Lisp_Object Qdown_mouse_18, Qmouse_18;
251 Lisp_Object Qdown_mouse_19, Qmouse_19;
252 Lisp_Object Qdown_mouse_20, Qmouse_20;
253 Lisp_Object Qdown_mouse_21, Qmouse_21;
254 Lisp_Object Qdown_mouse_22, Qmouse_22;
255 Lisp_Object Qdown_mouse_23, Qmouse_23;
256 Lisp_Object Qdown_mouse_24, Qmouse_24;
257 Lisp_Object Qdown_mouse_25, Qmouse_25;
258 Lisp_Object Qdown_mouse_26, Qmouse_26;
259 Lisp_Object Qdown_mouse_27, Qmouse_27;
260 Lisp_Object Qdown_mouse_28, Qmouse_28;
261 Lisp_Object Qdown_mouse_29, Qmouse_29;
262 Lisp_Object Qdown_mouse_30, Qmouse_30;
263 Lisp_Object Qdown_mouse_31, Qmouse_31;
264 Lisp_Object Qdown_mouse_32, Qmouse_32;
266 /* Kludge kludge kludge */
267 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
269 /************************************************************************/
270 /* The keymap Lisp object */
271 /************************************************************************/
273 static Lisp_Object mark_keymap(Lisp_Object obj)
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;
286 print_keymap(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
288 /* This function can GC */
289 Lisp_Keymap *keymap = XKEYMAP(obj);
292 error("printing unreadable object #<keymap 0x%x>",
294 write_c_string("#<keymap ", printcharfun);
295 if (!NILP(keymap->name)) {
296 print_internal(keymap->name, printcharfun, 1);
297 write_c_string(" ", printcharfun);
299 sprintf(buf, "size %ld 0x%x>",
300 (long)XINT(Fkeymap_fullness(obj)), keymap->header.uid);
301 write_c_string(buf, printcharfun);
304 static const struct lrecord_description keymap_description[] = {
305 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, parents)},
306 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, prompt)},
307 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, table)},
308 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, inverse_table)},
309 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, default_binding)},
310 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, sub_maps_cache)},
311 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, name)},
315 /* No need for keymap_equal #### Why not? */
316 DEFINE_LRECORD_IMPLEMENTATION("keymap", keymap,
317 mark_keymap, print_keymap, 0, 0, 0,
318 keymap_description, Lisp_Keymap);
320 /************************************************************************/
321 /* Traversing keymaps and their parents */
322 /************************************************************************/
325 traverse_keymaps(Lisp_Object start_keymap, Lisp_Object start_parents,
326 Lisp_Object(*mapper)(Lisp_Object keymap, void*),
329 /* This function can GC */
331 Lisp_Object tail = start_parents;
332 Lisp_Object malloc_sucks[10] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
333 Lisp_Object malloc_bites = Qnil;
335 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
336 GCPRO3n(malloc_bites, start_keymap, tail,
337 malloc_sucks, countof(malloc_sucks));
339 start_keymap = get_keymap(start_keymap, 1, 1);
340 keymap = start_keymap;
341 /* Hack special-case parents at top-level */
342 tail = !NILP(tail) ? tail : XKEYMAP(keymap)->parents;
348 result = mapper(keymap, mapper_arg);
350 while (CONSP(malloc_bites)) {
351 Lisp_Cons *victim = XCONS(malloc_bites);
352 malloc_bites = victim->cdr;
359 if (stack_depth == 0) {
361 return Qnil; /* Nothing found */
364 if (CONSP(malloc_bites)) {
365 Lisp_Cons *victim = XCONS(malloc_bites);
367 malloc_bites = victim->cdr;
370 tail = malloc_sucks[stack_depth];
379 parents = XKEYMAP(keymap)->parents;
380 if (!CONSP(parents)) ;
385 if (CONSP(malloc_bites))
387 noseeum_cons(tail, malloc_bites);
388 else if (stack_depth < countof(malloc_sucks)) {
389 malloc_sucks[stack_depth++] = tail;
391 /* *&@##[*&^$ C. @#[$*&@# Unix.
394 for (i = 0, malloc_bites = Qnil;
395 i < countof(malloc_sucks); i++) {
397 noseeum_cons(malloc_sucks
405 keymap = get_keymap(keymap, 1, 1);
406 if (EQ(keymap, start_keymap)) {
407 signal_simple_error("Cyclic keymap indirection",
413 /************************************************************************/
414 /* Some low-level functions */
415 /************************************************************************/
417 static int bucky_sym_to_bucky_bit(Lisp_Object sym)
419 if (EQ(sym, Qcontrol))
420 return XEMACS_MOD_CONTROL;
422 return XEMACS_MOD_META;
424 return XEMACS_MOD_SUPER;
426 return XEMACS_MOD_HYPER;
428 return XEMACS_MOD_ALT;
429 if (EQ(sym, Qsymbol))
430 return XEMACS_MOD_ALT; /* #### - reverse compat */
432 return XEMACS_MOD_SHIFT;
437 static Lisp_Object control_meta_superify(Lisp_Object frob, int modifiers)
441 frob = Fcons(frob, Qnil);
442 if (modifiers & XEMACS_MOD_SHIFT)
443 frob = Fcons(Qshift, frob);
444 if (modifiers & XEMACS_MOD_ALT)
445 frob = Fcons(Qalt, frob);
446 if (modifiers & XEMACS_MOD_HYPER)
447 frob = Fcons(Qhyper, frob);
448 if (modifiers & XEMACS_MOD_SUPER)
449 frob = Fcons(Qsuper, frob);
450 if (modifiers & XEMACS_MOD_CONTROL)
451 frob = Fcons(Qcontrol, frob);
452 if (modifiers & XEMACS_MOD_META)
453 frob = Fcons(Qmeta, frob);
458 make_key_description(const struct key_data *key, int prettify)
460 Lisp_Object keysym = key->keysym;
461 int modifiers = key->modifiers;
463 if (prettify && CHARP(keysym)) {
464 /* This is a little slow, but (control a) is prettier than (control 65).
465 It's now ok to do this for digit-chars too, since we've fixed the
466 bug where \9 read as the integer 9 instead of as the symbol with
469 /* !!#### I'm not sure how correct this is. */
470 Bufbyte str[1 + MAX_EMCHAR_LEN];
471 Bytecount count = set_charptr_emchar(str, XCHAR(keysym));
473 keysym = intern((char *)str);
475 return control_meta_superify(keysym, modifiers);
478 /************************************************************************/
479 /* Low-level keymap-store functions */
480 /************************************************************************/
483 raw_lookup_key(Lisp_Object keymap,
484 const struct key_data *raw_keys, int raw_keys_count,
485 int keys_so_far, int accept_default);
487 /* Relies on caller to gc-protect args */
489 keymap_lookup_directly(Lisp_Object keymap, Lisp_Object keysym, int modifiers)
494 ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3 |
495 XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5 | XEMACS_MOD_BUTTON6 |
496 XEMACS_MOD_BUTTON7 | XEMACS_MOD_BUTTON8 | XEMACS_MOD_BUTTON9 |
497 XEMACS_MOD_BUTTON10 | XEMACS_MOD_BUTTON11 | XEMACS_MOD_BUTTON12 |
498 XEMACS_MOD_BUTTON13 | XEMACS_MOD_BUTTON14 | XEMACS_MOD_BUTTON15 |
499 XEMACS_MOD_BUTTON16 | XEMACS_MOD_BUTTON17 | XEMACS_MOD_BUTTON18 |
500 XEMACS_MOD_BUTTON19 | XEMACS_MOD_BUTTON20 | XEMACS_MOD_BUTTON21 |
501 XEMACS_MOD_BUTTON22 | XEMACS_MOD_BUTTON23 | XEMACS_MOD_BUTTON24 |
502 XEMACS_MOD_BUTTON25 | XEMACS_MOD_BUTTON26);
504 ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER |
505 XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT))
511 /* If the keysym is a one-character symbol, use the char code instead. */
512 if (SYMBOLP(keysym) && string_char_length(XSYMBOL(keysym)->name) == 1) {
513 Lisp_Object i_fart_on_gcc =
514 make_char(string_char(XSYMBOL(keysym)->name, 0));
515 keysym = i_fart_on_gcc;
518 if (modifiers & XEMACS_MOD_META) { /* Utterly hateful ESC lossage */
520 Fgethash(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
525 modifiers &= ~XEMACS_MOD_META;
528 if (modifiers != 0) {
529 Lisp_Object submap = Fgethash(MAKE_MODIFIER_HASH_KEY(modifiers),
535 return Fgethash(keysym, k->table, Qnil);
539 keymap_store_inverse_internal(Lisp_Object inverse_table,
540 Lisp_Object keysym, Lisp_Object value)
542 Lisp_Object keys = Fgethash(value, inverse_table, Qunbound);
544 if (UNBOUNDP(keys)) {
546 /* Don't cons this unless necessary */
547 /* keys = Fcons (keysym, Qnil); */
548 Fputhash(value, keys, inverse_table);
549 } else if (!CONSP(keys)) {
550 /* Now it's necessary to cons */
551 keys = Fcons(keys, keysym);
552 Fputhash(value, keys, inverse_table);
554 while (CONSP(XCDR(keys)))
556 XCDR(keys) = Fcons(XCDR(keys), keysym);
557 /* No need to call puthash because we've destructively
558 modified the list tail in place */
563 keymap_delete_inverse_internal(Lisp_Object inverse_table,
564 Lisp_Object keysym, Lisp_Object value)
566 Lisp_Object keys = Fgethash(value, inverse_table, Qunbound);
567 Lisp_Object new_keys = keys;
574 for (prev = &new_keys, tail = new_keys;;
575 prev = &(XCDR(tail)), tail = XCDR(tail)) {
576 if (EQ(tail, keysym)) {
579 } else if (EQ(keysym, XCAR(tail))) {
586 Fremhash(value, inverse_table);
587 else if (!EQ(keys, new_keys))
588 /* Removed the first elt */
589 Fputhash(value, new_keys, inverse_table);
590 /* else the list's tail has been modified, so we don't need to
591 touch the hash table again (the pointer in there is ok).
595 /* Prevent luser from shooting herself in the foot using something like
596 (define-key ctl-x-4-map "p" global-map) */
598 check_keymap_definition_loop(Lisp_Object def, Lisp_Keymap * to_keymap)
600 def = get_keymap(def, 0, 0);
605 if (XKEYMAP(def) == to_keymap)
606 signal_simple_error("Cyclic keymap definition", def);
608 for (maps = keymap_submaps(def); CONSP(maps); maps = XCDR(maps))
609 check_keymap_definition_loop(XCDR(XCAR(maps)),
615 keymap_store_internal(Lisp_Object keysym, Lisp_Keymap * keymap, Lisp_Object def)
617 Lisp_Object prev_def = Fgethash(keysym, keymap->table, Qnil);
619 if (EQ(prev_def, def))
622 check_keymap_definition_loop(def, keymap);
625 keymap_delete_inverse_internal(keymap->inverse_table,
628 Fremhash(keysym, keymap->table);
630 Fputhash(keysym, def, keymap->table);
631 keymap_store_inverse_internal(keymap->inverse_table,
638 create_bucky_submap(Lisp_Keymap * k, int modifiers,
639 Lisp_Object parent_for_debugging_info)
641 Lisp_Object submap = Fmake_sparse_keymap(Qnil);
642 /* User won't see this, but it is nice for debugging Emacs */
643 XKEYMAP(submap)->name
644 = control_meta_superify(parent_for_debugging_info, modifiers);
645 /* Invalidate cache */
646 k->sub_maps_cache = Qt;
647 keymap_store_internal(MAKE_MODIFIER_HASH_KEY(modifiers), k, submap);
651 /* Relies on caller to gc-protect keymap, keysym, value */
653 keymap_store(Lisp_Object keymap, const struct key_data *key, Lisp_Object value)
655 Lisp_Object keysym = key->keysym;
656 int modifiers = key->modifiers;
657 Lisp_Keymap *k = XKEYMAP(keymap);
660 ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3 |
661 XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5 | XEMACS_MOD_BUTTON6 |
662 XEMACS_MOD_BUTTON7 | XEMACS_MOD_BUTTON8 | XEMACS_MOD_BUTTON9 |
663 XEMACS_MOD_BUTTON10 | XEMACS_MOD_BUTTON11 | XEMACS_MOD_BUTTON12 |
664 XEMACS_MOD_BUTTON13 | XEMACS_MOD_BUTTON14 | XEMACS_MOD_BUTTON15 |
665 XEMACS_MOD_BUTTON16 | XEMACS_MOD_BUTTON17 | XEMACS_MOD_BUTTON18 |
666 XEMACS_MOD_BUTTON19 | XEMACS_MOD_BUTTON20 | XEMACS_MOD_BUTTON21 |
667 XEMACS_MOD_BUTTON22 | XEMACS_MOD_BUTTON23 | XEMACS_MOD_BUTTON24 |
668 XEMACS_MOD_BUTTON25 | XEMACS_MOD_BUTTON26);
670 ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER |
671 XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0);
673 /* If the keysym is a one-character symbol, use the char code instead. */
674 if (SYMBOLP(keysym) && string_char_length(XSYMBOL(keysym)->name) == 1)
675 keysym = make_char(string_char(XSYMBOL(keysym)->name, 0));
677 if (modifiers & XEMACS_MOD_META) { /* Utterly hateful ESC lossage */
679 Fgethash(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
683 create_bucky_submap(k, XEMACS_MOD_META, keymap);
685 modifiers &= ~XEMACS_MOD_META;
688 if (modifiers != 0) {
689 Lisp_Object submap = Fgethash(MAKE_MODIFIER_HASH_KEY(modifiers),
692 submap = create_bucky_submap(k, modifiers, keymap);
695 k->sub_maps_cache = Qt; /* Invalidate cache */
696 keymap_store_internal(keysym, k, value);
699 /************************************************************************/
700 /* Listing the submaps of a keymap */
701 /************************************************************************/
703 struct keymap_submaps_closure {
704 Lisp_Object *result_locative;
708 keymap_submaps_mapper_0(Lisp_Object key, Lisp_Object value,
709 void *keymap_submaps_closure)
711 /* This function can GC */
712 /* Perform any autoloads, etc */
718 keymap_submaps_mapper(Lisp_Object key, Lisp_Object value,
719 void *keymap_submaps_closure)
721 /* This function can GC */
722 Lisp_Object *result_locative;
723 struct keymap_submaps_closure *cl =
724 (struct keymap_submaps_closure *)keymap_submaps_closure;
725 result_locative = cl->result_locative;
727 if (!NILP(Fkeymapp(value)))
728 *result_locative = Fcons(Fcons(key, value), *result_locative);
732 static int map_keymap_sort_predicate(Lisp_Object obj1, Lisp_Object obj2,
735 static Lisp_Object keymap_submaps(Lisp_Object keymap)
737 /* This function can GC */
738 Lisp_Keymap *k = XKEYMAP(keymap);
740 if (EQ(k->sub_maps_cache, Qt)) { /* Unknown */
741 Lisp_Object result = Qnil;
742 struct gcpro gcpro1, gcpro2;
743 struct keymap_submaps_closure keymap_submaps_closure;
745 GCPRO2(keymap, result);
746 keymap_submaps_closure.result_locative = &result;
747 /* Do this first pass to touch (and load) any autoloaded maps */
748 elisp_maphash(keymap_submaps_mapper_0, k->table,
749 &keymap_submaps_closure);
751 elisp_maphash(keymap_submaps_mapper, k->table,
752 &keymap_submaps_closure);
753 /* keep it sorted so that the result of accessible-keymaps is ordered */
754 k->sub_maps_cache = list_sort(result,
755 Qnil, map_keymap_sort_predicate);
758 return k->sub_maps_cache;
761 /************************************************************************/
762 /* Basic operations on keymaps */
763 /************************************************************************/
765 static Lisp_Object make_keymap(size_t size)
768 Lisp_Keymap *keymap = alloc_lcrecord_type(Lisp_Keymap, &lrecord_keymap);
770 XSETKEYMAP(result, keymap);
772 keymap->parents = Qnil;
773 keymap->prompt = Qnil;
774 keymap->table = Qnil;
775 keymap->inverse_table = Qnil;
776 keymap->default_binding = Qnil;
777 keymap->sub_maps_cache = Qnil; /* No possible submaps */
780 if (size != 0) { /* hack for copy-keymap */
782 make_lisp_hash_table(size, HASH_TABLE_NON_WEAK,
784 /* Inverse table is often less dense because of duplicate key-bindings.
785 If not, it will grow anyway. */
786 keymap->inverse_table =
787 make_lisp_hash_table(size * 3 / 4, HASH_TABLE_NON_WEAK,
793 DEFUN("make-keymap", Fmake_keymap, 0, 1, 0, /*
794 Construct and return a new keymap object.
795 All entries in it are nil, meaning "command undefined".
797 Optional argument NAME specifies a name to assign to the keymap,
798 as in `set-keymap-name'. This name is only a debugging convenience;
799 it is not used except when printing the keymap.
803 Lisp_Object keymap = make_keymap(60);
805 Fset_keymap_name(keymap, name);
809 DEFUN("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
810 Construct and return a new keymap object.
811 All entries in it are nil, meaning "command undefined". The only
812 difference between this function and `make-keymap' is that this function
813 returns a "smaller" keymap (one that is expected to contain fewer
814 entries). As keymaps dynamically resize, this distinction is not great.
816 Optional argument NAME specifies a name to assign to the keymap,
817 as in `set-keymap-name'. This name is only a debugging convenience;
818 it is not used except when printing the keymap.
822 Lisp_Object keymap = make_keymap(8);
824 Fset_keymap_name(keymap, name);
828 DEFUN("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
829 Return the `parent' keymaps of KEYMAP, or nil.
830 The parents of a keymap are searched for keybindings when a key sequence
831 isn't bound in this one. `(current-global-map)' is the default parent
836 keymap = get_keymap(keymap, 1, 1);
837 return Fcopy_sequence(XKEYMAP(keymap)->parents);
841 traverse_keymaps_noop(Lisp_Object UNUSED(keymap), void *UNUSED(arg))
846 DEFUN("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
847 Set the `parent' keymaps of KEYMAP to PARENTS.
848 The parents of a keymap are searched for keybindings when a key sequence
849 isn't bound in this one. `(current-global-map)' is the default parent
854 /* This function can GC */
856 struct gcpro gcpro1, gcpro2;
858 GCPRO2(keymap, parents);
859 keymap = get_keymap(keymap, 1, 1);
861 if (KEYMAPP(parents)) /* backwards-compatibility */
862 parents = list1(parents);
863 if (!NILP(parents)) {
864 Lisp_Object tail = parents;
865 while (!NILP(tail)) {
869 /* Require that it be an actual keymap object, rather than a symbol
870 with a (crockish) symbol-function which is a keymap */
871 CHECK_KEYMAP(k); /* get_keymap (k, 1, 1); */
876 /* Check for circularities */
877 traverse_keymaps(keymap, parents, traverse_keymaps_noop, 0);
879 XKEYMAP(keymap)->parents = Fcopy_sequence(parents);
884 DEFUN("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
885 Set the `name' of the KEYMAP to NEW-NAME.
886 The name is only a debugging convenience; it is not used except
887 when printing the keymap.
891 keymap = get_keymap(keymap, 1, 1);
893 XKEYMAP(keymap)->name = new_name;
897 DEFUN("keymap-name", Fkeymap_name, 1, 1, 0, /*
898 Return the `name' of KEYMAP.
899 The name is only a debugging convenience; it is not used except
900 when printing the keymap.
904 keymap = get_keymap(keymap, 1, 1);
906 return XKEYMAP(keymap)->name;
909 DEFUN("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
910 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
911 if no prompt is desired. The prompt is shown in the echo-area
912 when reading a key-sequence to be looked-up in this keymap.
914 (keymap, new_prompt))
916 keymap = get_keymap(keymap, 1, 1);
918 if (!NILP(new_prompt))
919 CHECK_STRING(new_prompt);
921 XKEYMAP(keymap)->prompt = new_prompt;
926 keymap_prompt_mapper(Lisp_Object keymap, void *UNUSED(arg))
928 return XKEYMAP(keymap)->prompt;
931 DEFUN("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
932 Return the `prompt' of KEYMAP.
933 If non-nil, the prompt is shown in the echo-area
934 when reading a key-sequence to be looked-up in this keymap.
936 (keymap, use_inherited))
938 /* This function can GC */
941 keymap = get_keymap(keymap, 1, 1);
942 prompt = XKEYMAP(keymap)->prompt;
943 if (!NILP(prompt) || NILP(use_inherited)) {
946 return traverse_keymaps(keymap, Qnil, keymap_prompt_mapper, 0);
950 DEFUN("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
951 Sets the default binding of KEYMAP to COMMAND, or `nil'
952 if no default is desired. The default-binding is returned when
953 no other binding for a key-sequence is found in the keymap.
954 If a keymap has a non-nil default-binding, neither the keymap's
955 parents nor the current global map are searched for key bindings.
959 /* This function can GC */
960 keymap = get_keymap(keymap, 1, 1);
962 XKEYMAP(keymap)->default_binding = command;
966 DEFUN("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
967 Return the default binding of KEYMAP, or `nil' if it has none.
968 The default-binding is returned when no other binding for a key-sequence
969 is found in the keymap.
970 If a keymap has a non-nil default-binding, neither the keymap's
971 parents nor the current global map are searched for key bindings.
975 /* This function can GC */
976 keymap = get_keymap(keymap, 1, 1);
977 return XKEYMAP(keymap)->default_binding;
980 DEFUN("keymapp", Fkeymapp, 1, 1, 0, /*
981 Return t if OBJECT is a keymap object.
982 The keymap may be autoloaded first if necessary.
986 /* This function can GC */
987 Lisp_Object tmp = get_keymap(object, 0, 0);
988 return KEYMAPP(tmp) ? Qt : Qnil;
991 /* Check that OBJECT is a keymap (after dereferencing through any
992 symbols). If it is, return it.
994 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
995 is an autoload form, do the autoload and try again.
996 If AUTOLOAD is nonzero, callers must assume GC is possible.
998 ERRORP controls how we respond if OBJECT isn't a keymap.
999 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
1001 Note that most of the time, we don't want to pursue autoloads.
1002 Functions like Faccessible_keymaps which scan entire keymap trees
1003 shouldn't load every autoloaded keymap. I'm not sure about this,
1004 but it seems to me that only read_key_sequence, Flookup_key, and
1005 Fdefine_key should cause keymaps to be autoloaded. */
1007 Lisp_Object get_keymap(Lisp_Object object, int errorp, int autoload)
1009 /* This function can GC */
1011 Lisp_Object tem = indirect_function(object, 0);
1015 /* Should we do an autoload? */
1017 /* (autoload "filename" doc nil keymap) */
1020 && EQ(XCAR(tem), Qautoload)
1021 && EQ(Fcar(Fcdr(Fcdr(Fcdr(Fcdr(tem))))), Qkeymap)) {
1022 /* do_autoload GCPROs both arguments */
1023 do_autoload(tem, object);
1025 object = wrong_type_argument(Qkeymapp, object);
1031 /* Given OBJECT which was found in a slot in a keymap,
1032 trace indirect definitions to get the actual definition of that slot.
1033 An indirect definition is a list of the form
1034 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1035 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1037 static Lisp_Object get_keyelt(Lisp_Object object, int accept_default)
1039 /* This function can GC */
1047 struct gcpro gcpro1;
1050 map = get_keymap(map, 0, 1);
1053 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1055 Lisp_Object idx = Fcdr(object);
1056 struct key_data indirection;
1059 event.event_type = empty_event;
1060 character_to_event(XCHAR(idx), &event,
1061 XCONSOLE(Vselected_console), 0, 0);
1062 indirection = event.event.key;
1063 } else if (CONSP(idx)) {
1064 if (!INTP(XCDR(idx)))
1066 indirection.keysym = XCAR(idx);
1067 indirection.modifiers = (unsigned char)XINT(XCDR(idx));
1068 } else if (SYMBOLP(idx)) {
1069 indirection.keysym = idx;
1070 indirection.modifiers = 0;
1075 return raw_lookup_key(map, &indirection, 1, 0, accept_default);
1076 } else if (STRINGP(XCAR(object))) {
1077 /* If the keymap contents looks like (STRING . DEFN),
1079 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1080 will be used by HierarKey menus. */
1081 object = XCDR(object);
1084 /* Anything else is really the value. */
1090 keymap_lookup_1(Lisp_Object keymap, const struct key_data *key,
1093 /* This function can GC */
1094 return get_keyelt(keymap_lookup_directly(keymap,
1095 key->keysym, key->modifiers),
1099 /************************************************************************/
1100 /* Copying keymaps */
1101 /************************************************************************/
1103 struct copy_keymap_inverse_closure {
1104 Lisp_Object inverse_table;
1108 copy_keymap_inverse_mapper(Lisp_Object key, Lisp_Object value,
1109 void *copy_keymap_inverse_closure)
1111 struct copy_keymap_inverse_closure *closure =
1112 (struct copy_keymap_inverse_closure *)copy_keymap_inverse_closure;
1114 /* copy-sequence deals with dotted lists. */
1116 value = Fcopy_list(value);
1117 Fputhash(key, value, closure->inverse_table);
1122 static Lisp_Object copy_keymap_internal(Lisp_Keymap * keymap)
1124 Lisp_Object nkm = make_keymap(0);
1125 Lisp_Keymap *new_keymap = XKEYMAP(nkm);
1126 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1127 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1129 new_keymap->parents = Fcopy_sequence(keymap->parents);
1130 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1131 new_keymap->table = Fcopy_hash_table(keymap->table);
1132 new_keymap->inverse_table = Fcopy_hash_table(keymap->inverse_table);
1133 new_keymap->default_binding = keymap->default_binding;
1134 /* After copying the inverse map, we need to copy the conses which
1135 are its values, lest they be shared by the copy, and mangled.
1137 elisp_maphash(copy_keymap_inverse_mapper, keymap->inverse_table,
1138 ©_keymap_inverse_closure);
1142 static Lisp_Object copy_keymap(Lisp_Object keymap);
1144 struct copy_keymap_closure {
1149 copy_keymap_mapper(Lisp_Object key, Lisp_Object value,
1150 void *copy_keymap_closure)
1152 /* This function can GC */
1153 struct copy_keymap_closure *closure =
1154 (struct copy_keymap_closure *)copy_keymap_closure;
1156 /* When we encounter a keymap which is indirected through a
1157 symbol, we need to copy the sub-map. In v18, the form
1158 (lookup-key (copy-keymap global-map) "\C-x")
1159 returned a new keymap, not the symbol 'Control-X-prefix.
1161 value = get_keymap(value, 0, 1); /* #### autoload GC-safe here? */
1163 keymap_store_internal(key, closure->self, copy_keymap(value));
1167 static Lisp_Object copy_keymap(Lisp_Object keymap)
1169 /* This function can GC */
1170 struct copy_keymap_closure copy_keymap_closure;
1172 keymap = copy_keymap_internal(XKEYMAP(keymap));
1173 copy_keymap_closure.self = XKEYMAP(keymap);
1174 elisp_maphash(copy_keymap_mapper,
1175 XKEYMAP(keymap)->table, ©_keymap_closure);
1179 DEFUN("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1180 Return a copy of the keymap KEYMAP.
1181 The copy starts out with the same definitions of KEYMAP,
1182 but changing either the copy or KEYMAP does not affect the other.
1183 Any key definitions that are subkeymaps are recursively copied.
1187 /* This function can GC */
1188 keymap = get_keymap(keymap, 1, 1);
1189 return copy_keymap(keymap);
1192 static int keymap_fullness(Lisp_Object keymap)
1194 /* This function can GC */
1196 Lisp_Object sub_maps;
1197 struct gcpro gcpro1, gcpro2;
1199 keymap = get_keymap(keymap, 1, 1);
1200 fullness = XINT(Fhash_table_count(XKEYMAP(keymap)->table));
1201 GCPRO2(keymap, sub_maps);
1202 for (sub_maps = keymap_submaps(keymap);
1203 !NILP(sub_maps); sub_maps = XCDR(sub_maps)) {
1204 if (MODIFIER_HASH_KEY_BITS(XCAR(XCAR(sub_maps))) != 0) {
1205 Lisp_Object bucky_map = XCDR(XCAR(sub_maps));
1206 fullness--; /* don't count bucky maps themselves. */
1207 fullness += keymap_fullness(bucky_map);
1214 DEFUN("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1215 Return the number of bindings in the keymap.
1219 /* This function can GC */
1220 return make_int(keymap_fullness(get_keymap(keymap, 1, 1)));
1223 /************************************************************************/
1224 /* Defining keys in keymaps */
1225 /************************************************************************/
1227 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1228 and perform any necessary canonicalization. */
1231 define_key_check_and_coerce_keysym(Lisp_Object spec,
1232 Lisp_Object * keysym, int modifiers)
1234 /* Now, check and massage the trailing keysym specifier. */
1235 if (SYMBOLP(*keysym)) {
1236 if (string_char_length(XSYMBOL(*keysym)->name) == 1) {
1237 Lisp_Object ream_gcc_up_the_ass =
1238 make_char(string_char(XSYMBOL(*keysym)->name, 0));
1239 *keysym = ream_gcc_up_the_ass;
1242 } else if (CHAR_OR_CHAR_INTP(*keysym)) {
1243 CHECK_CHAR_COERCE_INT(*keysym);
1245 if (XCHAR(*keysym) < ' '
1246 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */ )
1247 /* yuck! Can't make the above restriction; too many compatibility
1249 signal_simple_error("keysym char must be printable",
1251 /* #### This bites! I want to be able to write (control shift a) */
1252 if (modifiers & XEMACS_MOD_SHIFT)
1254 ("The `shift' modifier may not be applied to ASCII keysyms",
1257 signal_simple_error("Unknown keysym specifier", *keysym);
1260 if (SYMBOLP(*keysym)) {
1261 char *name = (char *)string_data(XSYMBOL(*keysym)->name);
1263 /* FSFmacs uses symbols with the printed representation of keysyms in
1264 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1265 confusion, notice the M-x syntax and signal an error - because
1266 otherwise it would be interpreted as a regular keysym, and would even
1267 show up in the list-buffers output, causing confusion to the naive.
1269 We can get away with this because none of the X keysym names contain
1270 a hyphen (some contain underscore, however).
1272 It might be useful to reject keysyms which are not x-valid-keysym-
1273 name-p, but that would interfere with various tricks we do to
1274 sanitize the Sun keyboards, and would make it trickier to
1275 conditionalize a .emacs file for multiple X servers.
1277 if (((int)strlen(name) >= 2 && name[1] == '-')
1280 /* Ok, this is a bit more dubious - prevent people from doing things
1281 like (global-set-key 'RET 'something) because that will have the
1282 same problem as above. (Gag!) Maybe we should just silently
1283 accept these as aliases for the "real" names?
1285 (string_length(XSYMBOL(*keysym)->name) <= 3 &&
1286 (!strcmp(name, "LFD") ||
1287 !strcmp(name, "TAB") ||
1288 !strcmp(name, "RET") ||
1289 !strcmp(name, "ESC") ||
1290 !strcmp(name, "DEL") ||
1291 !strcmp(name, "SPC") || !strcmp(name, "BS")))
1295 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1298 /* #### Ok, this is a bit more dubious - make people not lose if they
1299 do things like (global-set-key 'RET 'something) because that would
1300 otherwise have the same problem as above. (Gag!) We silently
1301 accept these as aliases for the "real" names.
1303 else if (!strncmp(name, "kp_", 3)) {
1304 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1307 strncpy(temp, name, sizeof(temp));
1308 temp[sizeof(temp) - 1] = '\0';
1310 *keysym = Fintern_soft(make_string((Bufbyte *) temp,
1311 strlen(temp)), Qnil);
1312 } else if (EQ(*keysym, QLFD))
1313 *keysym = QKlinefeed;
1314 else if (EQ(*keysym, QTAB))
1316 else if (EQ(*keysym, QRET))
1318 else if (EQ(*keysym, QESC))
1320 else if (EQ(*keysym, QDEL))
1322 else if (EQ(*keysym, QSPC))
1324 else if (EQ(*keysym, QBS))
1325 *keysym = QKbackspace;
1326 /* Emacs compatibility */
1327 else if (EQ(*keysym, Qdown_mouse_1))
1329 else if (EQ(*keysym, Qdown_mouse_2))
1331 else if (EQ(*keysym, Qdown_mouse_3))
1333 else if (EQ(*keysym, Qdown_mouse_4))
1335 else if (EQ(*keysym, Qdown_mouse_5))
1337 else if (EQ(*keysym, Qdown_mouse_6))
1339 else if (EQ(*keysym, Qdown_mouse_7))
1341 else if (EQ(*keysym, Qdown_mouse_8))
1343 else if (EQ(*keysym, Qdown_mouse_9))
1345 else if (EQ(*keysym, Qdown_mouse_10))
1346 *keysym = Qbutton10;
1347 else if (EQ(*keysym, Qdown_mouse_11))
1348 *keysym = Qbutton11;
1349 else if (EQ(*keysym, Qdown_mouse_12))
1350 *keysym = Qbutton12;
1351 else if (EQ(*keysym, Qdown_mouse_13))
1352 *keysym = Qbutton13;
1353 else if (EQ(*keysym, Qdown_mouse_14))
1354 *keysym = Qbutton14;
1355 else if (EQ(*keysym, Qdown_mouse_15))
1356 *keysym = Qbutton15;
1357 else if (EQ(*keysym, Qdown_mouse_16))
1358 *keysym = Qbutton16;
1359 else if (EQ(*keysym, Qdown_mouse_17))
1360 *keysym = Qbutton17;
1361 else if (EQ(*keysym, Qdown_mouse_18))
1362 *keysym = Qbutton18;
1363 else if (EQ(*keysym, Qdown_mouse_19))
1364 *keysym = Qbutton19;
1365 else if (EQ(*keysym, Qdown_mouse_20))
1366 *keysym = Qbutton20;
1367 else if (EQ(*keysym, Qdown_mouse_21))
1368 *keysym = Qbutton21;
1369 else if (EQ(*keysym, Qdown_mouse_22))
1370 *keysym = Qbutton22;
1371 else if (EQ(*keysym, Qdown_mouse_23))
1372 *keysym = Qbutton23;
1373 else if (EQ(*keysym, Qdown_mouse_24))
1374 *keysym = Qbutton24;
1375 else if (EQ(*keysym, Qdown_mouse_25))
1376 *keysym = Qbutton25;
1377 else if (EQ(*keysym, Qdown_mouse_26))
1378 *keysym = Qbutton26;
1379 else if (EQ(*keysym, Qdown_mouse_27))
1380 *keysym = Qbutton27;
1381 else if (EQ(*keysym, Qdown_mouse_28))
1382 *keysym = Qbutton28;
1383 else if (EQ(*keysym, Qdown_mouse_29))
1384 *keysym = Qbutton29;
1385 else if (EQ(*keysym, Qdown_mouse_30))
1386 *keysym = Qbutton30;
1387 else if (EQ(*keysym, Qdown_mouse_31))
1388 *keysym = Qbutton31;
1389 else if (EQ(*keysym, Qdown_mouse_32))
1390 *keysym = Qbutton32;
1391 else if (EQ(*keysym, Qmouse_1))
1392 *keysym = Qbutton1up;
1393 else if (EQ(*keysym, Qmouse_2))
1394 *keysym = Qbutton2up;
1395 else if (EQ(*keysym, Qmouse_3))
1396 *keysym = Qbutton3up;
1397 else if (EQ(*keysym, Qmouse_4))
1398 *keysym = Qbutton4up;
1399 else if (EQ(*keysym, Qmouse_5))
1400 *keysym = Qbutton5up;
1401 else if (EQ(*keysym, Qmouse_6))
1402 *keysym = Qbutton6up;
1403 else if (EQ(*keysym, Qmouse_7))
1404 *keysym = Qbutton7up;
1405 else if (EQ(*keysym, Qmouse_8))
1406 *keysym = Qbutton8up;
1407 else if (EQ(*keysym, Qmouse_9))
1408 *keysym = Qbutton9up;
1409 else if (EQ(*keysym, Qmouse_10))
1410 *keysym = Qbutton10up;
1411 else if (EQ(*keysym, Qmouse_11))
1412 *keysym = Qbutton11up;
1413 else if (EQ(*keysym, Qmouse_12))
1414 *keysym = Qbutton12up;
1415 else if (EQ(*keysym, Qmouse_13))
1416 *keysym = Qbutton13up;
1417 else if (EQ(*keysym, Qmouse_14))
1418 *keysym = Qbutton14up;
1419 else if (EQ(*keysym, Qmouse_15))
1420 *keysym = Qbutton15up;
1421 else if (EQ(*keysym, Qmouse_16))
1422 *keysym = Qbutton16up;
1423 else if (EQ(*keysym, Qmouse_17))
1424 *keysym = Qbutton17up;
1425 else if (EQ(*keysym, Qmouse_18))
1426 *keysym = Qbutton18up;
1427 else if (EQ(*keysym, Qmouse_19))
1428 *keysym = Qbutton19up;
1429 else if (EQ(*keysym, Qmouse_20))
1430 *keysym = Qbutton20up;
1431 else if (EQ(*keysym, Qmouse_21))
1432 *keysym = Qbutton21up;
1433 else if (EQ(*keysym, Qmouse_22))
1434 *keysym = Qbutton22up;
1435 else if (EQ(*keysym, Qmouse_23))
1436 *keysym = Qbutton23up;
1437 else if (EQ(*keysym, Qmouse_24))
1438 *keysym = Qbutton24up;
1439 else if (EQ(*keysym, Qmouse_25))
1440 *keysym = Qbutton25up;
1441 else if (EQ(*keysym, Qmouse_26))
1442 *keysym = Qbutton26up;
1443 else if (EQ(*keysym, Qmouse_27))
1444 *keysym = Qbutton27up;
1445 else if (EQ(*keysym, Qmouse_28))
1446 *keysym = Qbutton28up;
1447 else if (EQ(*keysym, Qmouse_29))
1448 *keysym = Qbutton29up;
1449 else if (EQ(*keysym, Qmouse_30))
1450 *keysym = Qbutton30up;
1451 else if (EQ(*keysym, Qmouse_31))
1452 *keysym = Qbutton31up;
1453 else if (EQ(*keysym, Qmouse_32))
1454 *keysym = Qbutton32up;
1458 /* Given any kind of key-specifier, return a keysym and modifier mask.
1459 Proper canonicalization is performed:
1461 -- integers are converted into the equivalent characters.
1462 -- one-character strings are converted into the equivalent characters.
1465 static void define_key_parser(Lisp_Object spec, struct key_data *returned_value)
1467 if (CHAR_OR_CHAR_INTP(spec)) {
1469 event.event_type = empty_event;
1470 character_to_event(XCHAR_OR_CHAR_INT(spec), &event,
1471 XCONSOLE(Vselected_console), 0, 0);
1472 returned_value->keysym = event.event.key.keysym;
1473 returned_value->modifiers = event.event.key.modifiers;
1474 } else if (EVENTP(spec)) {
1475 switch (XEVENT(spec)->event_type) {
1476 case key_press_event: {
1477 returned_value->keysym =
1478 XEVENT(spec)->event.key.keysym;
1479 returned_value->modifiers =
1480 XEVENT(spec)->event.key.modifiers;
1483 case button_press_event:
1484 case button_release_event: {
1485 int down = (XEVENT(spec)->event_type ==
1486 button_press_event);
1487 switch (XEVENT(spec)->event.button.button) {
1489 returned_value->keysym =
1490 (down ? Qbutton1 : Qbutton1up);
1493 returned_value->keysym =
1494 (down ? Qbutton2 : Qbutton2up);
1497 returned_value->keysym =
1498 (down ? Qbutton3 : Qbutton3up);
1501 returned_value->keysym =
1502 (down ? Qbutton4 : Qbutton4up);
1505 returned_value->keysym =
1506 (down ? Qbutton5 : Qbutton5up);
1509 returned_value->keysym =
1510 (down ? Qbutton6 : Qbutton6up);
1513 returned_value->keysym =
1514 (down ? Qbutton7 : Qbutton7up);
1517 returned_value->keysym =
1518 (down ? Qbutton8 : Qbutton8up);
1521 returned_value->keysym =
1522 (down ? Qbutton9 : Qbutton9up);
1525 returned_value->keysym =
1526 (down ? Qbutton10 : Qbutton10up);
1529 returned_value->keysym =
1530 (down ? Qbutton11 : Qbutton11up);
1533 returned_value->keysym =
1534 (down ? Qbutton12 : Qbutton12up);
1537 returned_value->keysym =
1538 (down ? Qbutton13 : Qbutton13up);
1541 returned_value->keysym =
1542 (down ? Qbutton14 : Qbutton14up);
1545 returned_value->keysym =
1546 (down ? Qbutton15 : Qbutton15up);
1549 returned_value->keysym =
1550 (down ? Qbutton16 : Qbutton16up);
1553 returned_value->keysym =
1554 (down ? Qbutton17 : Qbutton17up);
1557 returned_value->keysym =
1558 (down ? Qbutton18 : Qbutton18up);
1561 returned_value->keysym =
1562 (down ? Qbutton19 : Qbutton19up);
1565 returned_value->keysym =
1566 (down ? Qbutton20 : Qbutton20up);
1569 returned_value->keysym =
1570 (down ? Qbutton21 : Qbutton21up);
1573 returned_value->keysym =
1574 (down ? Qbutton22 : Qbutton22up);
1577 returned_value->keysym =
1578 (down ? Qbutton23 : Qbutton23up);
1581 returned_value->keysym =
1582 (down ? Qbutton24 : Qbutton24up);
1585 returned_value->keysym =
1586 (down ? Qbutton25 : Qbutton25up);
1589 returned_value->keysym =
1590 (down ? Qbutton26 : Qbutton26up);
1593 returned_value->keysym =
1594 (down ? Qbutton27 : Qbutton27up);
1597 returned_value->keysym =
1598 (down ? Qbutton28 : Qbutton28up);
1601 returned_value->keysym =
1602 (down ? Qbutton29 : Qbutton29up);
1605 returned_value->keysym =
1606 (down ? Qbutton30 : Qbutton30up);
1609 returned_value->keysym =
1610 (down ? Qbutton31 : Qbutton31up);
1613 returned_value->keysym =
1614 (down ? Qbutton32 : Qbutton32up);
1617 returned_value->keysym =
1618 (down ? Qbutton0 : Qbutton0up);
1621 returned_value->modifiers =
1622 XEVENT(spec)->event.button.modifiers;
1627 case pointer_motion_event:
1631 case magic_eval_event:
1633 case misc_user_event:
1634 #ifdef EF_USE_ASYNEQ
1635 case eaten_myself_event:
1636 case work_started_event:
1637 case work_finished_event:
1638 #endif /* EF_USE_ASYNEQ */
1641 signal_error(Qwrong_type_argument,
1642 list2(build_translated_string(
1643 "unable to bind this "
1644 "type of event"), spec));
1646 } else if (SYMBOLP(spec)) {
1647 /* Be nice, allow = to mean (=) */
1648 if (bucky_sym_to_bucky_bit(spec) != 0)
1649 signal_simple_error("Key is a modifier name", spec);
1650 define_key_check_and_coerce_keysym(spec, &spec, 0);
1651 returned_value->keysym = spec;
1652 returned_value->modifiers = 0;
1653 } else if (CONSP(spec)) {
1655 Lisp_Object keysym = Qnil;
1656 Lisp_Object rest = spec;
1658 /* First, parse out the leading modifier symbols. */
1659 while (CONSP(rest)) {
1662 keysym = XCAR(rest);
1663 modifier = bucky_sym_to_bucky_bit(keysym);
1664 modifiers |= modifier;
1665 if (!NILP(XCDR(rest))) {
1667 signal_simple_error("Unknown modifier",
1672 ("Nothing but modifiers here",
1679 signal_simple_error("List must be nil-terminated",
1682 define_key_check_and_coerce_keysym(spec, &keysym, modifiers);
1683 returned_value->keysym = keysym;
1684 returned_value->modifiers = modifiers;
1686 signal_simple_error("Unknown key-sequence specifier", spec);
1690 /* Used by character-to-event */
1692 key_desc_list_to_event(Lisp_Object list, Lisp_Object event,
1693 int allow_menu_events)
1695 struct key_data raw_key;
1697 if (allow_menu_events && CONSP(list) &&
1698 /* #### where the hell does this come from? */
1699 EQ(XCAR(list), Qmenu_selection)) {
1700 Lisp_Object fn, arg;
1701 if (!NILP(Fcdr(Fcdr(list))))
1702 signal_simple_error("Invalid menu event desc", list);
1703 arg = Fcar(Fcdr(list));
1705 fn = Qcall_interactively;
1708 XSETFRAME(XEVENT(event)->channel, selected_frame());
1709 XEVENT(event)->event_type = misc_user_event;
1710 XEVENT(event)->event.eval.function = fn;
1711 XEVENT(event)->event.eval.object = arg;
1715 define_key_parser(list, &raw_key);
1717 if (EQ(raw_key.keysym, Qbutton0) || EQ(raw_key.keysym, Qbutton0up) ||
1718 EQ(raw_key.keysym, Qbutton1) || EQ(raw_key.keysym, Qbutton1up) ||
1719 EQ(raw_key.keysym, Qbutton2) || EQ(raw_key.keysym, Qbutton2up) ||
1720 EQ(raw_key.keysym, Qbutton3) || EQ(raw_key.keysym, Qbutton3up) ||
1721 EQ(raw_key.keysym, Qbutton4) || EQ(raw_key.keysym, Qbutton4up) ||
1722 EQ(raw_key.keysym, Qbutton5) || EQ(raw_key.keysym, Qbutton5up) ||
1723 EQ(raw_key.keysym, Qbutton6) || EQ(raw_key.keysym, Qbutton6up) ||
1724 EQ(raw_key.keysym, Qbutton7) || EQ(raw_key.keysym, Qbutton7up) ||
1725 EQ(raw_key.keysym, Qbutton8) || EQ(raw_key.keysym, Qbutton8up) ||
1726 EQ(raw_key.keysym, Qbutton9) || EQ(raw_key.keysym, Qbutton9up) ||
1727 EQ(raw_key.keysym, Qbutton10) || EQ(raw_key.keysym, Qbutton10up) ||
1728 EQ(raw_key.keysym, Qbutton11) || EQ(raw_key.keysym, Qbutton11up) ||
1729 EQ(raw_key.keysym, Qbutton12) || EQ(raw_key.keysym, Qbutton12up) ||
1730 EQ(raw_key.keysym, Qbutton13) || EQ(raw_key.keysym, Qbutton13up) ||
1731 EQ(raw_key.keysym, Qbutton14) || EQ(raw_key.keysym, Qbutton14up) ||
1732 EQ(raw_key.keysym, Qbutton15) || EQ(raw_key.keysym, Qbutton15up) ||
1733 EQ(raw_key.keysym, Qbutton16) || EQ(raw_key.keysym, Qbutton16up) ||
1734 EQ(raw_key.keysym, Qbutton17) || EQ(raw_key.keysym, Qbutton17up) ||
1735 EQ(raw_key.keysym, Qbutton18) || EQ(raw_key.keysym, Qbutton18up) ||
1736 EQ(raw_key.keysym, Qbutton19) || EQ(raw_key.keysym, Qbutton19up) ||
1737 EQ(raw_key.keysym, Qbutton20) || EQ(raw_key.keysym, Qbutton20up) ||
1738 EQ(raw_key.keysym, Qbutton21) || EQ(raw_key.keysym, Qbutton21up) ||
1739 EQ(raw_key.keysym, Qbutton22) || EQ(raw_key.keysym, Qbutton22up) ||
1740 EQ(raw_key.keysym, Qbutton23) || EQ(raw_key.keysym, Qbutton23up) ||
1741 EQ(raw_key.keysym, Qbutton24) || EQ(raw_key.keysym, Qbutton24up) ||
1742 EQ(raw_key.keysym, Qbutton25) || EQ(raw_key.keysym, Qbutton25up) ||
1743 EQ(raw_key.keysym, Qbutton26) || EQ(raw_key.keysym, Qbutton26up) ||
1744 EQ(raw_key.keysym, Qbutton27) || EQ(raw_key.keysym, Qbutton27up) ||
1745 EQ(raw_key.keysym, Qbutton28) || EQ(raw_key.keysym, Qbutton28up) ||
1746 EQ(raw_key.keysym, Qbutton29) || EQ(raw_key.keysym, Qbutton29up) ||
1747 EQ(raw_key.keysym, Qbutton30) || EQ(raw_key.keysym, Qbutton30up) ||
1748 EQ(raw_key.keysym, Qbutton31) || EQ(raw_key.keysym, Qbutton31up) ||
1749 EQ(raw_key.keysym, Qbutton32) || EQ(raw_key.keysym, Qbutton32up))
1750 error("Mouse-clicks can't appear in saved keyboard macros.");
1752 XEVENT(event)->channel = Vselected_console;
1753 XEVENT(event)->event_type = key_press_event;
1754 XEVENT(event)->event.key.keysym = raw_key.keysym;
1755 XEVENT(event)->event.key.modifiers = raw_key.modifiers;
1758 int event_matches_key_specifier_p(Lisp_Event * event, Lisp_Object key_specifier)
1760 Lisp_Object event2 = Qnil;
1762 struct gcpro gcpro1;
1764 if (event->event_type != key_press_event || NILP(key_specifier) ||
1765 (INTP(key_specifier) && !CHAR_INTP(key_specifier)))
1768 /* if the specifier is an integer such as 27, then it should match
1769 both of the events 'escape' and 'control ['. Calling
1770 Fcharacter_to_event() will only match 'escape'. */
1771 if (CHAR_OR_CHAR_INTP(key_specifier))
1772 return (XCHAR_OR_CHAR_INT(key_specifier)
1773 == event_to_character(event, 0, 0, 0));
1775 /* Otherwise, we cannot call event_to_character() because we may
1776 be dealing with non-ASCII keystrokes. In any case, if I ask
1777 for 'control [' then I should get exactly that, and not
1780 However, we have to behave differently on TTY's, where 'control ['
1781 is silently converted into 'escape' by the keyboard driver.
1782 In this case, ASCII is the only thing we know about, so we have
1783 to compare the ASCII values. */
1786 event2 = Fmake_event(Qnil, Qnil);
1787 Fcharacter_to_event(key_specifier, event2, Qnil, Qnil);
1788 if (XEVENT(event2)->event_type != key_press_event)
1790 else if (CONSOLE_TTY_P(XCONSOLE(EVENT_CHANNEL(event)))) {
1793 ch1 = event_to_character(event, 0, 0, 0);
1794 ch2 = event_to_character(XEVENT(event2), 0, 0, 0);
1795 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1796 } else if (EQ(event->event.key.keysym, XEVENT(event2)->event.key.keysym)
1797 && event->event.key.modifiers ==
1798 XEVENT(event2)->event.key.modifiers)
1802 Fdeallocate_event(event2);
1807 static int meta_prefix_char_p(const struct key_data *key)
1811 event.event_type = key_press_event;
1812 event.channel = Vselected_console;
1813 event.event.key.keysym = key->keysym;
1814 event.event.key.modifiers = key->modifiers;
1815 return event_matches_key_specifier_p(&event, Vmeta_prefix_char);
1818 DEFUN("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1819 Return non-nil if EVENT matches KEY-SPECIFIER.
1820 This can be useful, e.g., to determine if the user pressed `help-char' or
1823 (event, key_specifier))
1825 CHECK_LIVE_EVENT(event);
1826 return (event_matches_key_specifier_p(XEVENT(event), key_specifier)
1830 #define MACROLET(k,m) do { \
1831 returned_value->keysym = (k); \
1832 returned_value->modifiers = (m); \
1833 RETURN_SANS_WARNINGS; \
1837 Given a keysym, return another keysym/modifier pair which could be
1838 considered the same key in an ASCII world. Backspace returns ^H, for
1842 define_key_alternate_name(struct key_data *key, struct key_data *returned_value)
1844 Lisp_Object keysym = key->keysym;
1845 int modifiers = key->modifiers;
1846 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL));
1847 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META));
1848 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1849 returned_value->modifiers = 0;
1850 if (modifiers_sans_meta == XEMACS_MOD_CONTROL) {
1851 if (EQ(keysym, QKspace))
1852 MACROLET(make_char('@'), modifiers);
1853 else if (!CHARP(keysym))
1856 switch (XCHAR(keysym)) {
1857 case '@': /* c-@ => c-space */
1858 MACROLET(QKspace, modifiers);
1859 case 'h': /* c-h => backspace */
1860 MACROLET(QKbackspace, modifiers_sans_control);
1861 case 'i': /* c-i => tab */
1862 MACROLET(QKtab, modifiers_sans_control);
1863 case 'j': /* c-j => linefeed */
1864 MACROLET(QKlinefeed, modifiers_sans_control);
1865 case 'm': /* c-m => return */
1866 MACROLET(QKreturn, modifiers_sans_control);
1867 case '[': /* c-[ => escape */
1868 MACROLET(QKescape, modifiers_sans_control);
1872 } else if (modifiers_sans_meta != 0)
1874 else if (EQ(keysym, QKbackspace)) /* backspace => c-h */
1875 MACROLET(make_char('h'), (modifiers | XEMACS_MOD_CONTROL));
1876 else if (EQ(keysym, QKtab)) /* tab => c-i */
1877 MACROLET(make_char('i'), (modifiers | XEMACS_MOD_CONTROL));
1878 else if (EQ(keysym, QKlinefeed)) /* linefeed => c-j */
1879 MACROLET(make_char('j'), (modifiers | XEMACS_MOD_CONTROL));
1880 else if (EQ(keysym, QKreturn)) /* return => c-m */
1881 MACROLET(make_char('m'), (modifiers | XEMACS_MOD_CONTROL));
1882 else if (EQ(keysym, QKescape)) /* escape => c-[ */
1883 MACROLET(make_char('['), (modifiers | XEMACS_MOD_CONTROL));
1890 ensure_meta_prefix_char_keymapp(Lisp_Object keys, int indx, Lisp_Object keymap)
1892 /* This function can GC */
1893 Lisp_Object new_keys;
1895 Lisp_Object mpc_binding;
1896 struct key_data meta_key;
1898 if (NILP(Vmeta_prefix_char) ||
1899 (INTP(Vmeta_prefix_char) && !CHAR_INTP(Vmeta_prefix_char)))
1902 define_key_parser(Vmeta_prefix_char, &meta_key);
1903 mpc_binding = keymap_lookup_1(keymap, &meta_key, 0);
1904 if (NILP(mpc_binding) || !NILP(Fkeymapp(mpc_binding)))
1909 else if (STRINGP(keys))
1910 new_keys = Fsubstring(keys, Qzero, make_int(indx));
1911 else if (VECTORP(keys)) {
1912 new_keys = make_vector(indx, Qnil);
1913 for (i = 0; i < indx; i++)
1914 XVECTOR_DATA(new_keys)[i] = XVECTOR_DATA(keys)[i];
1920 if (EQ(keys, new_keys)) {
1921 Lisp_Object tmp1 = Fkey_description(keys);
1922 Lisp_Object tmp2 = Fsingle_key_description(Vmeta_prefix_char);
1923 error_with_frob(mpc_binding,
1924 "can't bind %s: %s has a non-keymap binding",
1925 (char *)XSTRING_DATA(tmp1),
1926 (char *)XSTRING_DATA(tmp2));
1928 Lisp_Object tmp1 = Fkey_description(keys);
1929 Lisp_Object tmp2 = Fkey_description(new_keys);
1930 Lisp_Object tmp3 = Fsingle_key_description(Vmeta_prefix_char);
1931 error_with_frob(mpc_binding,
1932 "can't bind %s: %s %s has a non-keymap binding",
1933 (char *)XSTRING_DATA(tmp1),
1934 (char *)XSTRING_DATA(tmp2),
1935 (char *)XSTRING_DATA(tmp3));
1939 DEFUN("define-key", Fdefine_key, 3, 3, 0, /*
1940 Define key sequence KEYS, in KEYMAP, as DEF.
1941 KEYMAP is a keymap object.
1942 KEYS is the sequence of keystrokes to bind, described below.
1943 DEF is anything that can be a key's definition:
1944 nil (means key is undefined in this keymap);
1945 a command (a Lisp function suitable for interactive calling);
1946 a string or key sequence vector (treated as a keyboard macro);
1947 a keymap (to define a prefix key);
1948 a symbol; when the key is looked up, the symbol will stand for its
1949 function definition, that should at that time be one of the above,
1950 or another symbol whose function definition is used, and so on.
1951 a cons (STRING . DEFN), meaning that DEFN is the definition
1952 (DEFN should be a valid definition in its own right);
1953 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1955 Contrary to popular belief, the world is not ASCII. When running under a
1956 window manager, SXEmacs can tell the difference between, for example, the
1957 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1958 bind different commands to each of these.
1960 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1961 set of modifiers (such as control and meta). A `keysym' is what is printed
1962 on the keys on your keyboard.
1964 A keysym may be represented by a symbol, or (if and only if it is equivalent
1965 to an ASCII character in the range 32 - 255) by a character or its equivalent
1966 ASCII code. The `A' key may be represented by the symbol `A', the character
1967 `?A', or by the number 65. The `break' key may be represented only by the
1970 A keystroke may be represented by a list: the last element of the list
1971 is the key (a symbol, character, or number, as above) and the
1972 preceding elements are the symbolic names of modifier keys (control,
1973 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1974 represented by the forms `(control b)', `(control ?b)', and `(control
1975 98)'. A keystroke may also be represented by an event object, as
1976 returned by the `next-command-event' and `read-key-sequence'
1979 Note that in this context, the keystroke `control-b' is *not* represented
1980 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1982 The `shift' modifier is somewhat of a special case. You should not (and
1983 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1984 have ASCII equivalents, the state of the shift key is implicit in the
1985 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1986 sort of thing varies from keyboard to keyboard. The shift modifier is for
1987 use only with characters that do not have a second keysym on the same key,
1988 such as `backspace' and `tab'.
1990 A key sequence is a vector of keystrokes. As a degenerate case, elements
1991 of this vector may also be keysyms if they have no modifiers. That is,
1992 the `A' keystroke is represented by all of these forms:
1993 A ?A 65 (A) (?A) (65)
1994 [A] [?A] [65] [(A)] [(?A)] [(65)]
1996 the `control-a' keystroke is represented by these forms:
1997 (control A) (control ?A) (control 65)
1998 [(control A)] [(control ?A)] [(control 65)]
1999 the key sequence `control-c control-a' is represented by these forms:
2000 [(control c) (control a)] [(control ?c) (control ?a)]
2001 [(control 99) (control 65)] etc.
2003 Mouse button clicks work just like keypresses: (control button1) means
2004 pressing the left mouse button while holding down the control key.
2005 \[(control c) (shift button3)] means control-c, hold shift, click right.
2007 Commands may be bound to the mouse-button up-stroke rather than the down-
2008 stroke as well. `button1' means the down-stroke, and `button1up' means the
2009 up-stroke. Different commands may be bound to the up and down strokes,
2010 though that is probably not what you want, so be careful.
2012 For backward compatibility, a key sequence may also be represented by a
2013 string. In this case, it represents the key sequence(s) that would
2014 produce that sequence of ASCII characters in a purely ASCII world. For
2015 example, a string containing the ASCII backspace character, "\\^H", would
2016 represent two key sequences: `(control h)' and `backspace'. Binding a
2017 command to this will actually bind both of those key sequences. Likewise
2018 for the following pairs:
2025 control @ control space
2027 After binding a command to two key sequences with a form like
2029 (define-key global-map "\\^X\\^I" \'command-1)
2031 it is possible to redefine only one of those sequences like so:
2033 (define-key global-map [(control x) (control i)] \'command-2)
2034 (define-key global-map [(control x) tab] \'command-3)
2036 Of course, all of this applies only when running under a window system. If
2037 you're talking to SXEmacs through a TTY connection, you don't get any of
2040 (keymap, keys, def))
2042 /* This function can GC */
2047 struct gcpro gcpro1, gcpro2, gcpro3;
2050 len = XVECTOR_LENGTH(keys);
2051 else if (STRINGP(keys))
2052 len = XSTRING_CHAR_LENGTH(keys);
2053 else if (CHAR_OR_CHAR_INTP(keys) || SYMBOLP(keys) || CONSP(keys)) {
2057 keys = make_vector(1, keys); /* this is kinda sleazy. */
2059 keys = wrong_type_argument(Qsequencep, keys);
2060 len = XINT(Flength(keys));
2065 GCPRO3(keymap, keys, def);
2068 When the user defines a key which, in a strictly ASCII world, would be
2069 produced by two different keys (^J and linefeed, or ^H and backspace,
2070 for example) then the binding will be made for both keysyms.
2072 This is done if the user binds a command to a string, as in
2073 (define-key map "\^H" 'something), but not when using one of the new
2074 syntaxes, like (define-key map '(control h) 'something).
2076 ascii_hack = (STRINGP(keys));
2078 keymap = get_keymap(keymap, 1, 1);
2083 struct key_data raw_key1;
2084 struct key_data raw_key2;
2087 c = make_char(string_char(XSTRING(keys), idx));
2089 c = XVECTOR_DATA(keys)[idx];
2091 define_key_parser(c, &raw_key1);
2093 if (!metized && ascii_hack && meta_prefix_char_p(&raw_key1)) {
2094 if (idx == (len - 1)) {
2095 /* This is a hack to prevent a binding for the meta-prefix-char
2096 from being made in a map which already has a non-empty "meta"
2097 submap. That is, we can't let both "escape" and "meta" have
2098 a binding in the same keymap. This implies that the idiom
2099 (define-key my-map "\e" my-escape-map)
2100 (define-key my-escape-map "a" 'my-command)
2101 no longer works. That's ok. Instead the luser should do
2102 (define-key my-map "\ea" 'my-command)
2104 (define-key my-map "\M-a" 'my-command)
2106 (defvar my-escape-map (lookup-key my-map "\e"))
2107 if the luser really wants the map in a variable.
2109 Lisp_Object meta_map;
2110 struct gcpro ngcpro1;
2114 Fgethash(MAKE_MODIFIER_HASH_KEY
2116 XKEYMAP(keymap)->table, Qnil);
2118 && keymap_fullness(meta_map) != 0)
2119 signal_simple_error_2
2120 ("Map contains meta-bindings, can't bind",
2121 Fsingle_key_description
2122 (Vmeta_prefix_char), keymap);
2132 define_key_alternate_name(&raw_key1, &raw_key2);
2134 raw_key2.keysym = Qnil;
2135 raw_key2.modifiers = 0;
2139 raw_key1.modifiers |= XEMACS_MOD_META;
2140 raw_key2.modifiers |= XEMACS_MOD_META;
2144 /* This crap is to make sure that someone doesn't bind something like
2145 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
2146 if (raw_key1.modifiers & XEMACS_MOD_META)
2147 ensure_meta_prefix_char_keymapp(keys, idx, keymap);
2150 keymap_store(keymap, &raw_key1, def);
2151 if (ascii_hack && !NILP(raw_key2.keysym))
2152 keymap_store(keymap, &raw_key2, def);
2159 struct gcpro ngcpro1;
2162 cmd = keymap_lookup_1(keymap, &raw_key1, 0);
2164 cmd = Fmake_sparse_keymap(Qnil);
2165 XKEYMAP(cmd)->name /* for debugging */
2166 = list2(make_key_description(&raw_key1, 1),
2168 keymap_store(keymap, &raw_key1, cmd);
2170 if (NILP(Fkeymapp(cmd)))
2171 signal_simple_error_2
2172 ("Invalid prefix keys in sequence", c,
2175 if (ascii_hack && !NILP(raw_key2.keysym) &&
2176 NILP(keymap_lookup_1(keymap, &raw_key2, 0)))
2177 keymap_store(keymap, &raw_key2, cmd);
2179 keymap = get_keymap(cmd, 1, 1);
2185 /************************************************************************/
2186 /* Looking up keys in keymaps */
2187 /************************************************************************/
2189 /* We need a very fast (i.e., non-consing) version of lookup-key in order
2190 to make where-is-internal really fly. */
2192 struct raw_lookup_key_mapper_closure {
2194 const struct key_data *raw_keys;
2200 static Lisp_Object raw_lookup_key_mapper(Lisp_Object k, void*);
2202 /* Caller should gc-protect args (keymaps may autoload) */
2204 raw_lookup_key(Lisp_Object keymap,
2205 const struct key_data *raw_keys, int raw_keys_count,
2206 int keys_so_far, int accept_default)
2208 /* This function can GC */
2209 struct raw_lookup_key_mapper_closure c;
2210 c.remaining = raw_keys_count - 1;
2211 c.raw_keys = raw_keys;
2212 c.raw_keys_count = raw_keys_count;
2213 c.keys_so_far = keys_so_far;
2214 c.accept_default = accept_default;
2216 return traverse_keymaps(keymap, Qnil, raw_lookup_key_mapper, &c);
2220 raw_lookup_key_mapper(Lisp_Object k, void *arg)
2222 /* This function can GC */
2223 const struct raw_lookup_key_mapper_closure *c =
2224 (const struct raw_lookup_key_mapper_closure*)arg;
2225 int accept_default = c->accept_default;
2226 int remaining = c->remaining;
2227 int keys_so_far = c->keys_so_far;
2228 const struct key_data *raw_keys = c->raw_keys;
2231 if (!meta_prefix_char_p(&(raw_keys[0]))) {
2232 /* Normal case: every case except the meta-hack (see below). */
2233 cmd = keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2236 /* Return whatever we found if we're out of keys */
2239 /* Found nothing (though perhaps parent map may have
2242 else if (NILP(Fkeymapp(cmd)))
2243 /* Didn't find a keymap, and we have more keys.
2244 * Return a fixnum to indicate that keys were too long.
2246 cmd = make_int(keys_so_far + 1);
2248 cmd = raw_lookup_key(cmd, raw_keys + 1, remaining,
2249 keys_so_far + 1, accept_default);
2251 /* This is a hack so that looking up a key-sequence whose last
2252 * element is the meta-prefix-char will return the keymap that
2253 * the "meta" keys are stored in, if there is no binding for
2254 * the meta-prefix-char (and if this map has a "meta" submap).
2255 * If this map doesn't have a "meta" submap, then the
2256 * meta-prefix-char is looked up just like any other key.
2258 if (remaining == 0) {
2259 /* First look for the prefix-char directly */
2261 keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2263 /* Do kludgy return of the meta-map */
2265 Fgethash(MAKE_MODIFIER_HASH_KEY
2267 XKEYMAP(k)->table, Qnil);
2270 /* Search for the prefix-char-prefixed sequence
2273 keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2274 cmd = get_keymap(cmd, 0, 1);
2277 raw_lookup_key(cmd, raw_keys + 1, remaining,
2280 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0) {
2281 struct key_data metified;
2282 metified.keysym = raw_keys[1].keysym;
2283 metified.modifiers = raw_keys[1].modifiers |
2284 (unsigned char)XEMACS_MOD_META;
2286 /* Search for meta-next-char sequence directly */
2288 keymap_lookup_1(k, &metified,
2290 if (remaining == 1) ;
2292 cmd = get_keymap(cmd, 0, 1);
2306 if (accept_default && NILP(cmd))
2307 cmd = XKEYMAP(k)->default_binding;
2311 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2312 /* Caller should gc-protect arguments */
2314 lookup_keys(Lisp_Object keymap, int nkeys, Lisp_Object * keys,
2317 /* This function can GC */
2318 struct key_data kkk[20];
2319 struct key_data *raw_keys;
2325 if (nkeys < countof(kkk))
2328 raw_keys = alloca_array(struct key_data, nkeys);
2330 for (i = 0; i < nkeys; i++) {
2331 define_key_parser(keys[i], &(raw_keys[i]));
2333 return raw_lookup_key(keymap, raw_keys, nkeys, 0, accept_default);
2337 lookup_events(Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2340 /* This function can GC */
2341 struct key_data kkk[20];
2345 struct key_data *raw_keys;
2346 Lisp_Object tem = Qnil;
2347 struct gcpro gcpro1, gcpro2;
2350 CHECK_LIVE_EVENT(event_head);
2352 nkeys = event_chain_count(event_head);
2354 if (nkeys < countof(kkk))
2357 raw_keys = alloca_array(struct key_data, nkeys);
2360 EVENT_CHAIN_LOOP(event, event_head)
2361 define_key_parser(event, &(raw_keys[nkeys++]));
2362 GCPRO1n(event_head, keymaps, nmaps);
2363 /* ####raw_keys[].keysym slots aren't gc-protected.
2364 * We rely (but shouldn't) on somebody else somewhere (obarray)
2365 * having a pointer to all keysyms. */
2366 for (iii = 0; iii < nmaps; iii++) {
2367 tem = raw_lookup_key(keymaps[iii], raw_keys, nkeys, 0,
2370 /* Too long in some local map means don't look at global map */
2373 } else if (!NILP(tem)) {
2381 DEFUN("lookup-key", Flookup_key, 2, 3, 0, /*
2382 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2383 Nil is returned if KEYS is unbound. See documentation of `define-key'
2384 for valid key definitions and key-sequence specifications.
2385 A number is returned if KEYS is "too long"; that is, the leading
2386 characters fail to be a valid sequence of prefix characters in KEYMAP.
2387 The number is how many key strokes at the front of KEYS it takes to
2388 reach a non-prefix command.
2390 (keymap, keys, accept_default))
2392 /* This function can GC */
2394 return lookup_keys(keymap,
2395 XVECTOR_LENGTH(keys),
2396 XVECTOR_DATA(keys), !NILP(accept_default));
2397 else if (SYMBOLP(keys) || CHAR_OR_CHAR_INTP(keys) || CONSP(keys))
2398 return lookup_keys(keymap, 1, &keys, !NILP(accept_default));
2399 else if (STRINGP(keys)) {
2400 int length = XSTRING_CHAR_LENGTH(keys);
2402 struct key_data *raw_keys =
2403 alloca_array(struct key_data, length);
2407 for (i = 0; i < length; i++) {
2408 Emchar n = string_char(XSTRING(keys), i);
2409 define_key_parser(make_char(n), &(raw_keys[i]));
2411 return raw_lookup_key(keymap, raw_keys, length, 0,
2412 !NILP(accept_default));
2414 keys = wrong_type_argument(Qsequencep, keys);
2415 return Flookup_key(keymap, keys, accept_default);
2419 /* Given a key sequence, returns a list of keymaps to search for bindings.
2420 Does all manner of semi-hairy heuristics, like looking in the current
2421 buffer's map before looking in the global map and looking in the local
2422 map of the buffer in which the mouse was clicked in event0 is a click.
2424 It would be kind of nice if this were in Lisp so that this semi-hairy
2425 semi-heuristic command-lookup behavior could be readily understood and
2426 customised. However, this needs to be pretty fast, or performance of
2427 keyboard macros goes to shit; putting this in lisp slows macros down
2428 2-3x. And they're already slower than v18 by 5-6x.
2431 struct relevant_maps {
2433 unsigned int max_maps;
2435 struct gcpro *gcpro;
2438 static void get_relevant_extent_keymaps(Lisp_Object pos,
2439 Lisp_Object buffer_or_string,
2441 struct relevant_maps *closure);
2442 static void get_relevant_minor_maps(Lisp_Object buffer,
2443 struct relevant_maps *closure);
2445 static void relevant_map_push(Lisp_Object map, struct relevant_maps *closure)
2447 unsigned int nmaps = closure->nmaps;
2451 closure->nmaps = nmaps + 1;
2452 if (nmaps < closure->max_maps) {
2453 closure->maps[nmaps] = map;
2454 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
2455 closure->gcpro->nvars = nmaps;
2461 get_relevant_keymaps(Lisp_Object keys, int max_maps, Lisp_Object maps[])
2463 /* This function can GC */
2464 Lisp_Object terminal = Qnil;
2465 struct gcpro gcpro1;
2466 struct relevant_maps closure;
2467 struct console *con;
2471 closure.max_maps = max_maps;
2472 closure.maps = maps;
2473 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
2474 closure.gcpro = NULL;
2476 closure.gcpro = &gcpro1;
2480 terminal = event_chain_tail(keys);
2481 } else if (VECTORP(keys)) {
2482 int len = XVECTOR_LENGTH(keys);
2484 terminal = XVECTOR_DATA(keys)[len - 1];
2488 if (EVENTP(terminal)) {
2489 CHECK_LIVE_EVENT(terminal);
2490 con = event_console_or_selected(terminal);
2492 con = XCONSOLE(Vselected_console);
2495 if (KEYMAPP(con->overriding_terminal_local_map)
2496 || KEYMAPP(Voverriding_local_map)) {
2497 if (KEYMAPP(con->overriding_terminal_local_map))
2498 relevant_map_push(con->overriding_terminal_local_map,
2500 if (KEYMAPP(Voverriding_local_map))
2501 relevant_map_push(Voverriding_local_map, &closure);
2502 } else if (!EVENTP(terminal) ||
2503 (XEVENT(terminal)->event_type != button_press_event
2504 && XEVENT(terminal)->event_type != button_release_event)) {
2506 XSETBUFFER(tem, current_buffer);
2507 /* It's not a mouse event; order of keymaps searched is:
2508 o keymap of any/all extents under the mouse
2510 o local-map of current-buffer
2513 /* The terminal element of the lookup may be nil or a keysym.
2514 In those cases we don't want to check for an extent
2516 if (EVENTP(terminal)) {
2517 get_relevant_extent_keymaps(make_int
2518 (BUF_PT(current_buffer)),
2519 tem, Qnil, &closure);
2521 get_relevant_minor_maps(tem, &closure);
2523 tem = current_buffer->keymap;
2525 relevant_map_push(tem, &closure);
2527 #ifdef HAVE_WINDOW_SYSTEM
2529 /* It's a mouse event; order of keymaps searched is:
2530 o vertical-divider-map, if event is over a divider
2531 o local-map of mouse-grabbed-buffer
2532 o keymap of any/all extents under the mouse
2533 if the mouse is over a modeline:
2534 o modeline-map of buffer corresponding to that modeline
2535 o else, local-map of buffer under the mouse
2537 o local-map of current-buffer
2540 Lisp_Object window = Fevent_window(terminal);
2542 if (!NILP(Fevent_over_vertical_divider_p(terminal))) {
2543 if (KEYMAPP(Vvertical_divider_map))
2544 relevant_map_push(Vvertical_divider_map,
2548 if (BUFFERP(Vmouse_grabbed_buffer)) {
2550 XBUFFER(Vmouse_grabbed_buffer)->keymap;
2552 get_relevant_minor_maps(Vmouse_grabbed_buffer,
2555 relevant_map_push(map, &closure);
2558 if (!NILP(window)) {
2559 Lisp_Object buffer = Fwindow_buffer(window);
2561 if (!NILP(buffer)) {
2562 if (!NILP(Fevent_over_modeline_p(terminal))) {
2564 symbol_value_in_buffer
2568 get_relevant_extent_keymaps
2569 (Fevent_modeline_position(terminal),
2571 generated_modeline_string,
2572 Fevent_glyph_extent(terminal),
2575 if (!UNBOUNDP(map) && !NILP(map))
2576 relevant_map_push(get_keymap
2580 get_relevant_extent_keymaps(Fevent_point
2588 if (!EQ(buffer, Vmouse_grabbed_buffer)) { /* already pushed */
2590 XBUFFER(buffer)->keymap;
2592 get_relevant_minor_maps(buffer,
2595 relevant_map_push(map,
2599 } else if (!NILP(Fevent_over_toolbar_p(terminal))) {
2600 Lisp_Object map = Fsymbol_value(Qtoolbar_map);
2602 if (!UNBOUNDP(map) && !NILP(map))
2603 relevant_map_push(map, &closure);
2606 #endif /* HAVE_WINDOW_SYSTEM */
2608 if (CONSOLE_TTY_P (con))
2609 relevant_map_push (Vglobal_tty_map, &closure);
2611 relevant_map_push (Vglobal_window_system_map, &closure);
2614 int nmaps = closure.nmaps;
2615 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2616 if (nmaps >= max_maps && max_maps > 0)
2617 maps[max_maps - 1] = Vcurrent_global_map;
2619 maps[nmaps] = Vcurrent_global_map;
2625 /* Returns a set of keymaps extracted from the extents at POS in
2626 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2627 to look for a keymap in, and if it has one, its keymap will be the
2628 first element in the list returned. This is so we can correctly
2629 search the keymaps associated with glyphs which may be physically
2630 disjoint from their extents: for example, if a glyph is out in the
2631 margin, we should still consult the keymap of that glyph's extent,
2632 which may not itself be under the mouse.
2636 get_relevant_extent_keymaps(Lisp_Object pos, Lisp_Object buffer_or_string,
2637 Lisp_Object glyph, struct relevant_maps *closure)
2639 /* This function can GC */
2640 /* the glyph keymap, if any, comes first.
2641 (Processing it twice is no big deal: noop.) */
2643 Lisp_Object keymap = Fextent_property(glyph, Qkeymap, Qnil);
2645 relevant_map_push(get_keymap(keymap, 1, 1), closure);
2648 /* Next check the extents at the text position, if any */
2652 Fextent_at(pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2655 Fextent_at(pos, buffer_or_string, Qkeymap, extent, Qnil)) {
2656 Lisp_Object keymap =
2657 Fextent_property(extent, Qkeymap, Qnil);
2659 relevant_map_push(get_keymap(keymap, 1, 1),
2667 minor_mode_keymap_predicate(Lisp_Object assoc, Lisp_Object buffer)
2669 /* This function can GC */
2671 Lisp_Object sym = XCAR(assoc);
2673 Lisp_Object val = symbol_value_in_buffer(sym, buffer);
2674 if (!NILP(val) && !UNBOUNDP(val)) {
2675 Lisp_Object map = get_keymap(XCDR(assoc), 0, 1);
2684 get_relevant_minor_maps(Lisp_Object buffer, struct relevant_maps *closure)
2686 /* This function can GC */
2689 /* Will you ever lose badly if you make this circular! */
2690 for (alist = symbol_value_in_buffer(Qminor_mode_map_alist, buffer);
2691 CONSP(alist); alist = XCDR(alist)) {
2692 Lisp_Object m = minor_mode_keymap_predicate(XCAR(alist),
2695 relevant_map_push(m, closure);
2700 /* #### Would map-current-keymaps be a better thing?? */
2701 DEFUN("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2702 Return a list of the current keymaps that will be searched for bindings.
2703 This lists keymaps such as the current local map and the minor-mode maps,
2704 but does not list the parents of those keymaps.
2705 EVENT-OR-KEYS controls which keymaps will be listed.
2706 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2707 mouse event), the keymaps for that mouse event will be listed (see
2708 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2712 /* This function can GC */
2713 struct gcpro gcpro1;
2714 Lisp_Object maps[100];
2715 Lisp_Object *gubbish = maps;
2718 GCPRO1(event_or_keys);
2719 nmaps = get_relevant_keymaps(event_or_keys, countof(maps), gubbish);
2720 if (nmaps > countof(maps)) {
2721 gubbish = alloca_array(Lisp_Object, nmaps);
2722 nmaps = get_relevant_keymaps(event_or_keys, nmaps, gubbish);
2725 return Flist(nmaps, gubbish);
2728 DEFUN("key-binding", Fkey_binding, 1, 2, 0, /*
2729 Return the binding for command KEYS in current keymaps.
2730 KEYS is a string, a vector of events, or a vector of key-description lists
2731 as described in the documentation for the `define-key' function.
2732 The binding is probably a symbol with a function definition; see
2733 the documentation for `lookup-key' for more information.
2735 For key-presses, the order of keymaps searched is:
2736 - the `keymap' property of any extent(s) at point;
2737 - any applicable minor-mode maps;
2738 - the current local map of the current-buffer;
2739 - the current global map.
2741 For mouse-clicks, the order of keymaps searched is:
2742 - the current-local-map of the `mouse-grabbed-buffer' if any;
2743 - vertical-divider-map, if the event happened over a vertical divider
2744 - the `keymap' property of any extent(s) at the position of the click
2745 (this includes modeline extents);
2746 - the modeline-map of the buffer corresponding to the modeline under
2747 the mouse (if the click happened over a modeline);
2748 - the value of `toolbar-map' in the current-buffer (if the click
2749 happened over a toolbar);
2750 - the current local map of the buffer under the mouse (does not
2751 apply to toolbar clicks);
2752 - any applicable minor-mode maps;
2753 - the current global map.
2755 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2756 is non-nil, *only* those two maps and the current global map are searched.
2758 (keys, accept_default))
2760 /* This function can GC */
2762 Lisp_Object maps[100];
2764 struct gcpro gcpro1, gcpro2;
2765 GCPRO2(keys, accept_default); /* get_relevant_keymaps may autoload */
2767 nmaps = get_relevant_keymaps(keys, countof(maps), maps);
2771 if (EVENTP(keys)) /* unadvertised "feature" for the future */
2772 return lookup_events(keys, nmaps, maps, !NILP(accept_default));
2774 for (i = 0; i < nmaps; i++) {
2775 Lisp_Object tem = Flookup_key(maps[i], keys,
2778 /* Too long in some local map means don't look at global map */
2780 } else if (!NILP(tem))
2786 static Lisp_Object process_event_binding_result(Lisp_Object result)
2788 if (EQ(result, Qundefined))
2789 /* The suppress-keymap function binds keys to 'undefined - special-case
2790 that here, so that being bound to that has the same error-behavior as
2791 not being defined at all.
2794 if (!NILP(result)) {
2796 /* Snap out possible keymap indirections */
2797 map = get_keymap(result, 0, 1);
2805 /* Attempts to find a command corresponding to the event-sequence
2806 whose head is event0 (sequence is threaded though event_next).
2808 The return value will be
2810 -- nil (there is no binding; this will also be returned
2811 whenever the event chain is "too long", i.e. there
2812 is a non-nil, non-keymap binding for a prefix of
2814 -- a keymap (part of a command has been specified)
2815 -- a command (anything that satisfies `commandp'; this includes
2816 some symbols, lists, subrs, strings, vectors, and
2817 compiled-function objects) */
2818 Lisp_Object event_binding(Lisp_Object event0, int accept_default)
2820 /* This function can GC */
2821 Lisp_Object maps[100];
2824 assert(EVENTP(event0));
2826 nmaps = get_relevant_keymaps(event0, countof(maps), maps);
2827 if (nmaps > countof(maps))
2828 nmaps = countof(maps);
2829 return process_event_binding_result(lookup_events(event0, nmaps, maps,
2833 /* like event_binding, but specify a keymap to search */
2836 event_binding_in(Lisp_Object event0, Lisp_Object keymap, int accept_default)
2838 /* This function can GC */
2839 if (!KEYMAPP(keymap))
2842 return process_event_binding_result(lookup_events(event0, 1, &keymap,
2846 /* Attempts to find a function key mapping corresponding to the
2847 event-sequence whose head is event0 (sequence is threaded through
2848 event_next). The return value will be the same as for event_binding(). */
2850 munging_key_map_event_binding(Lisp_Object event0,
2851 enum munge_me_out_the_door munge)
2853 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2854 CONSOLE_FUNCTION_KEY_MAP(event_console_or_selected(event0)) :
2855 Vkey_translation_map;
2861 process_event_binding_result(lookup_events(event0, 1, &keymap, 1));
2864 /************************************************************************/
2865 /* Setting/querying the global and local maps */
2866 /************************************************************************/
2868 DEFUN("use-global-map", Fuse_global_map, 1, 1, 0, /*
2869 Select KEYMAP as the global keymap.
2873 /* This function can GC */
2874 keymap = get_keymap(keymap, 1, 1);
2875 Vcurrent_global_map = keymap;
2879 DEFUN("use-local-map", Fuse_local_map, 1, 2, 0, /*
2880 Select KEYMAP as the local keymap in BUFFER.
2881 If KEYMAP is nil, that means no local keymap.
2882 If BUFFER is nil, the current buffer is assumed.
2886 /* This function can GC */
2887 struct buffer *b = decode_buffer(buffer, 0);
2889 keymap = get_keymap(keymap, 1, 1);
2896 DEFUN("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2897 Return BUFFER's local keymap, or nil if it has none.
2898 If BUFFER is nil, the current buffer is assumed.
2902 struct buffer *b = decode_buffer(buffer, 0);
2906 DEFUN("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2907 Return the current global keymap.
2911 return Vcurrent_global_map;
2914 /************************************************************************/
2915 /* Mapping over keymap elements */
2916 /************************************************************************/
2918 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2919 prefix key, it's not entirely obvious what map-keymap should do, but
2920 what it does is: map over all keys in this map; then recursively map
2921 over all submaps of this map that are "bucky" submaps. This means that,
2922 when mapping over a keymap, it appears that "x" and "C-x" are in the
2923 same map, although "C-x" is really in the "control" submap of this one.
2924 However, since we don't recursively descend the submaps that are bound
2925 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2926 those explicitly, if that's what they want.
2928 So the end result of this is that the bucky keymaps (the ones indexed
2929 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2930 invisible from elisp. They're just an implementation detail that code
2931 outside of this file doesn't need to know about.
2934 struct map_keymap_unsorted_closure {
2935 void (*fn) (const struct key_data *, Lisp_Object binding, void *arg);
2940 /* used by map_keymap() */
2942 map_keymap_unsorted_mapper(Lisp_Object keysym, Lisp_Object value,
2943 void *map_keymap_unsorted_closure)
2945 /* This function can GC */
2946 struct map_keymap_unsorted_closure *closure =
2947 (struct map_keymap_unsorted_closure *)map_keymap_unsorted_closure;
2948 int modifiers = closure->modifiers;
2950 mod_bit = MODIFIER_HASH_KEY_BITS(keysym);
2952 int omod = modifiers;
2953 closure->modifiers = (modifiers | mod_bit);
2954 value = get_keymap(value, 1, 0);
2955 elisp_maphash(map_keymap_unsorted_mapper,
2956 XKEYMAP(value)->table,
2957 map_keymap_unsorted_closure);
2958 closure->modifiers = omod;
2960 struct key_data key;
2961 key.keysym = keysym;
2962 key.modifiers = modifiers;
2963 ((*closure->fn) (&key, value, closure->arg));
2968 struct map_keymap_sorted_closure {
2969 Lisp_Object *result_locative;
2972 /* used by map_keymap_sorted() */
2974 map_keymap_sorted_mapper(Lisp_Object key, Lisp_Object value,
2975 void *map_keymap_sorted_closure)
2977 struct map_keymap_sorted_closure *cl =
2978 (struct map_keymap_sorted_closure *)map_keymap_sorted_closure;
2979 Lisp_Object *list = cl->result_locative;
2980 *list = Fcons(Fcons(key, value), *list);
2984 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2985 and keymap_submaps().
2988 map_keymap_sort_predicate(Lisp_Object obj1, Lisp_Object obj2, Lisp_Object pred)
2990 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
3000 bit1 = MODIFIER_HASH_KEY_BITS(obj1);
3001 bit2 = MODIFIER_HASH_KEY_BITS(obj2);
3003 /* If either is a symbol with a character-set-property, then sort it by
3004 that code instead of alphabetically.
3006 if (!bit1 && SYMBOLP(obj1)) {
3007 Lisp_Object code = Fget(obj1, Vcharacter_set_property, Qnil);
3008 if (CHAR_OR_CHAR_INTP(code)) {
3010 CHECK_CHAR_COERCE_INT(obj1);
3014 if (!bit2 && SYMBOLP(obj2)) {
3015 Lisp_Object code = Fget(obj2, Vcharacter_set_property, Qnil);
3016 if (CHAR_OR_CHAR_INTP(code)) {
3018 CHECK_CHAR_COERCE_INT(obj2);
3023 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
3024 if (XTYPE(obj1) != XTYPE(obj2))
3025 return SYMBOLP(obj2) ? 1 : -1;
3027 if (!bit1 && CHARP(obj1)) { /* they're both ASCII */
3028 int o1 = XCHAR(obj1);
3029 int o2 = XCHAR(obj2);
3030 if (o1 == o2 && /* If one started out as a symbol and the */
3031 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
3032 return sym2_p ? 1 : -1;
3034 return o1 < o2 ? 1 : -1; /* else just compare them */
3037 /* else they're both symbols. If they're both buckys, then order them. */
3039 return bit1 < bit2 ? 1 : -1;
3041 /* if only one is a bucky, then it comes later */
3043 return bit2 ? 1 : -1;
3045 /* otherwise, string-sort them. */
3047 char *s1 = (char *)string_data(XSYMBOL(obj1)->name);
3048 char *s2 = (char *)string_data(XSYMBOL(obj2)->name);
3050 return 0 > strcoll(s1, s2) ? 1 : -1;
3052 return 0 > strcmp(s1, s2) ? 1 : -1;
3057 /* used by map_keymap() */
3059 map_keymap_sorted(Lisp_Object keymap_table,
3061 void (*function) (const struct key_data * key,
3062 Lisp_Object binding,
3063 void *map_keymap_sorted_closure),
3064 void *map_keymap_sorted_closure)
3066 /* This function can GC */
3067 struct gcpro gcpro1;
3068 Lisp_Object contents = Qnil;
3070 if (XINT(Fhash_table_count(keymap_table)) == 0)
3076 struct map_keymap_sorted_closure c1;
3077 c1.result_locative = &contents;
3078 elisp_maphash(map_keymap_sorted_mapper, keymap_table, &c1);
3080 contents = list_sort(contents, Qnil, map_keymap_sort_predicate);
3081 for (; !NILP(contents); contents = XCDR(contents)) {
3082 Lisp_Object keysym = XCAR(XCAR(contents));
3083 Lisp_Object binding = XCDR(XCAR(contents));
3084 int sub_bits = MODIFIER_HASH_KEY_BITS(keysym);
3085 if (sub_bits != 0) {
3086 Lisp_Object tmp = get_keymap(binding, 1, 1);
3087 map_keymap_sorted(XKEYMAP(tmp)->table,
3088 (modifiers | sub_bits),
3089 function, map_keymap_sorted_closure);
3093 k.modifiers = modifiers;
3094 ((*function) (&k, binding, map_keymap_sorted_closure));
3100 /* used by Fmap_keymap() */
3102 map_keymap_mapper(const struct key_data *key,
3103 Lisp_Object binding, void *function)
3105 /* This function can GC */
3107 VOID_TO_LISP(fn, function);
3108 call2(fn, make_key_description(key, 1), binding);
3112 map_keymap(Lisp_Object keymap_table, int sort_first,
3113 void (*function) (const struct key_data * key,
3114 Lisp_Object binding, void *fn_arg), void *fn_arg)
3116 /* This function can GC */
3118 map_keymap_sorted(keymap_table, 0, function, fn_arg);
3120 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
3121 map_keymap_unsorted_closure.fn = function;
3122 map_keymap_unsorted_closure.arg = fn_arg;
3123 map_keymap_unsorted_closure.modifiers = 0;
3124 elisp_maphash(map_keymap_unsorted_mapper, keymap_table,
3125 &map_keymap_unsorted_closure);
3129 DEFUN("map-keymap", Fmap_keymap, 2, 3, 0, /*
3130 Apply FUNCTION to each element of KEYMAP.
3131 FUNCTION will be called with two arguments: a key-description list, and
3132 the binding. The order in which the elements of the keymap are passed to
3133 the function is unspecified. If the function inserts new elements into
3134 the keymap, it may or may not be called with them later. No element of
3135 the keymap will ever be passed to the function more than once.
3137 The function will not be called on elements of this keymap's parents
3138 \(see the function `keymap-parents') or upon keymaps which are contained
3139 within this keymap (multi-character definitions).
3140 It will be called on "meta" characters since they are not really
3141 two-character sequences.
3143 If the optional third argument SORT-FIRST is non-nil, then the elements of
3144 the keymap will be passed to the mapper function in a canonical order.
3145 Otherwise, they will be passed in hash (that is, random) order, which is
3148 (function, keymap, sort_first))
3150 /* This function can GC */
3151 struct gcpro gcpro1, gcpro2, gcpro3;
3152 Lisp_Object table = Qnil;
3154 /* tolerate obviously transposed args */
3155 if (!NILP(Fkeymapp(function))) {
3156 Lisp_Object tmp = function;
3161 GCPRO3(function, keymap, table);
3162 keymap = get_keymap(keymap, 1, 1);
3164 /* elisp_maphash does not allow mapping functions to modify the hash
3165 table being mapped over. Since map-keymap explicitly allows a
3166 mapping function to modify KEYMAP, we map over a copy of the hash
3168 table = Fcopy_hash_table(XKEYMAP(keymap)->table);
3170 map_keymap(table, !NILP(sort_first),
3171 map_keymap_mapper, LISP_TO_VOID(function));
3176 /************************************************************************/
3177 /* Accessible keymaps */
3178 /************************************************************************/
3180 struct accessible_keymaps_closure {
3185 accessible_keymaps_mapper_1(Lisp_Object keysym, Lisp_Object contents,
3187 const struct accessible_keymaps_closure *closure)
3189 /* This function can GC */
3190 int subbits = MODIFIER_HASH_KEY_BITS(keysym);
3193 Lisp_Object submaps;
3195 contents = get_keymap(contents, 1, 1);
3196 submaps = keymap_submaps(contents);
3197 for (; !NILP(submaps); submaps = XCDR(submaps)) {
3198 accessible_keymaps_mapper_1(XCAR(XCAR(submaps)),
3199 XCDR(XCAR(submaps)),
3200 (subbits | modifiers),
3204 Lisp_Object thisseq = Fcar(Fcar(closure->tail));
3205 Lisp_Object cmd = get_keyelt(contents, 1);
3209 struct key_data key;
3210 key.keysym = keysym;
3211 key.modifiers = modifiers;
3215 cmd = get_keymap(cmd, 0, 1);
3219 vec = make_vector(XVECTOR_LENGTH(thisseq) + 1, Qnil);
3220 len = XVECTOR_LENGTH(thisseq);
3221 for (j = 0; j < len; j++)
3222 XVECTOR_DATA(vec)[j] = XVECTOR_DATA(thisseq)[j];
3223 XVECTOR_DATA(vec)[j] = make_key_description(&key, 1);
3225 nconc2(closure->tail, list1(Fcons(vec, cmd)));
3230 accessible_keymaps_keymap_mapper(Lisp_Object thismap, void *arg)
3232 /* This function can GC */
3233 const struct accessible_keymaps_closure *closure =
3234 (const struct accessible_keymaps_closure*)arg;
3235 Lisp_Object submaps = keymap_submaps(thismap);
3237 for (; !NILP(submaps); submaps = XCDR(submaps)) {
3238 accessible_keymaps_mapper_1(XCAR(XCAR(submaps)),
3239 XCDR(XCAR(submaps)), 0, closure);
3244 DEFUN("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3245 Find all keymaps accessible via prefix characters from KEYMAP.
3246 Returns a list of elements of the form (KEYS . MAP), where the sequence
3247 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3248 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3249 An optional argument PREFIX, if non-nil, should be a key sequence;
3250 then the value includes only maps for prefixes that start with PREFIX.
3254 /* This function can GC */
3255 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3256 Lisp_Object accessible_keymaps = Qnil;
3257 struct accessible_keymaps_closure c;
3259 GCPRO4(accessible_keymaps, c.tail, prefix, keymap);
3261 keymap = get_keymap(keymap, 1, 1);
3265 prefix = make_vector(0, Qnil);
3266 } else if (VECTORP(prefix) || STRINGP(prefix)) {
3267 int len = XINT(Flength(prefix));
3271 struct gcpro ngcpro1;
3278 def = Flookup_key(keymap, prefix, Qnil);
3279 def = get_keymap(def, 0, 1);
3284 p = make_vector(len, Qnil);
3286 for (iii = 0; iii < len; iii++) {
3287 struct key_data key;
3288 define_key_parser(Faref(prefix, make_int(iii)), &key);
3289 XVECTOR_DATA(p)[iii] = make_key_description(&key, 1);
3294 prefix = wrong_type_argument(Qarrayp, prefix);
3298 accessible_keymaps = list1(Fcons(prefix, keymap));
3300 /* For each map in the list maps, look at any other maps it points
3301 to and stick them at the end if they are not already in the list */
3303 for (c.tail = accessible_keymaps; !NILP(c.tail); c.tail = XCDR(c.tail)) {
3304 Lisp_Object thismap = Fcdr(Fcar(c.tail));
3305 CHECK_KEYMAP(thismap);
3306 traverse_keymaps(thismap, Qnil,
3307 accessible_keymaps_keymap_mapper, &c);
3311 return accessible_keymaps;
3314 /************************************************************************/
3315 /* Pretty descriptions of key sequences */
3316 /************************************************************************/
3318 DEFUN("key-description", Fkey_description, 1, 1, 0, /*
3319 Return a pretty description of key-sequence KEYS.
3320 Control characters turn into "C-foo" sequences, meta into "M-foo",
3321 spaces are put between sequence elements, etc...
3325 if (CHAR_OR_CHAR_INTP(keys) || CONSP(keys) || SYMBOLP(keys)
3327 return Fsingle_key_description(keys);
3328 } else if (VECTORP(keys) || STRINGP(keys)) {
3329 Lisp_Object string = Qnil;
3330 /* Lisp_Object sep = Qnil; */
3331 int size = XINT(Flength(keys));
3334 for (i = 0; i < size; i++) {
3335 Lisp_Object s2 = Fsingle_key_description(STRINGP(keys)
3348 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */
3352 concat2(Vsingle_space_string, s2));
3357 return Fkey_description(wrong_type_argument(Qsequencep, keys));
3360 DEFUN("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3361 Return a pretty description of command character KEY.
3362 Control characters turn into C-whatever, etc.
3363 This differs from `text-char-description' in that it returns a description
3364 of a key read from the user rather than a character from a buffer.
3369 key = Fcons(key, Qnil); /* sleaze sleaze */
3371 if (EVENTP(key) || CHAR_OR_CHAR_INTP(key)) {
3375 event.event_type = empty_event;
3376 CHECK_CHAR_COERCE_INT(key);
3377 character_to_event(XCHAR(key), &event,
3378 XCONSOLE(Vselected_console), 0, 1);
3379 format_event_object(buf, &event, 1);
3381 format_event_object(buf, XEVENT(key), 1);
3382 return build_string(buf);
3389 buf[sizeof(buf)-1] = buf[0] = '\0';
3391 LIST_LOOP(rest, key) {
3392 Lisp_Object keysym = XCAR(rest);
3393 if (EQ(keysym, Qcontrol))
3394 strcpy(bufp, "C-"), bufp += 2;
3395 else if (EQ(keysym, Qctrl))
3396 strcpy(bufp, "C-"), bufp += 2;
3397 else if (EQ(keysym, Qmeta))
3398 strcpy(bufp, "M-"), bufp += 2;
3399 else if (EQ(keysym, Qsuper))
3400 strcpy(bufp, "S-"), bufp += 2;
3401 else if (EQ(keysym, Qhyper))
3402 strcpy(bufp, "H-"), bufp += 2;
3403 else if (EQ(keysym, Qalt))
3404 strcpy(bufp, "A-"), bufp += 2;
3405 else if (EQ(keysym, Qshift))
3406 strcpy(bufp, "Sh-"), bufp += 3;
3407 else if (CHAR_OR_CHAR_INTP(keysym)) {
3408 bufp += set_charptr_emchar((Bufbyte *) bufp,
3413 CHECK_SYMBOL(keysym);
3414 #if 0 /* This is bogus */
3415 if (EQ(keysym, QKlinefeed))
3416 strcpy(bufp, "LFD");
3417 else if (EQ(keysym, QKtab))
3418 strcpy(bufp, "TAB");
3419 else if (EQ(keysym, QKreturn))
3420 strcpy(bufp, "RET");
3421 else if (EQ(keysym, QKescape))
3422 strcpy(bufp, "ESC");
3423 else if (EQ(keysym, QKdelete))
3424 strcpy(bufp, "DEL");
3425 else if (EQ(keysym, QKspace))
3426 strcpy(bufp, "SPC");
3427 else if (EQ(keysym, QKbackspace))
3434 string_data(XSYMBOL(keysym)->
3436 sizeof(buf)-(bufp-buf)-1);
3437 /* bufp iterates over buf */
3438 buf[sizeof(buf)-1]='\0';
3440 if (!NILP(XCDR(rest)))
3442 ("Invalid key description", key);
3445 return build_string(buf);
3447 return Fsingle_key_description
3448 (wrong_type_argument(intern("char-or-event-p"), key));
3451 DEFUN("text-char-description", Ftext_char_description, 1, 1, 0, /*
3452 Return a pretty description of file-character CHR.
3453 Unprintable characters turn into "^char" or \\NNN, depending on the value
3454 of the `ctl-arrow' variable.
3455 This differs from `single-key-description' in that it returns a description
3456 of a character from a buffer rather than a key read from the user.
3463 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3464 int ctl_p = !NILP(ctl_arrow);
3465 Emchar printable_min = (CHAR_OR_CHAR_INTP(ctl_arrow)
3466 ? XCHAR_OR_CHAR_INT(ctl_arrow)
3467 : ((EQ(ctl_arrow, Qt) || NILP(ctl_arrow))
3471 Lisp_Object ch = Fevent_to_character(chr, Qnil, Qnil, Qt);
3474 signal_simple_continuable_error
3475 ("character has no ASCII equivalent",
3476 Fcopy_event(chr, Qnil));
3480 CHECK_CHAR_COERCE_INT(chr);
3485 if (c >= printable_min) {
3486 p += set_charptr_emchar(p, c);
3487 } else if (c < 040 && ctl_p) {
3489 *p++ = c + 64; /* 'A' - 1 */
3490 } else if (c == 0177) {
3493 } else if (c >= 0200 || c < 040) {
3496 /* !!#### This syntax is not readable. It will
3497 be interpreted as a 3-digit octal number rather
3498 than a 7-digit octal number. */
3500 *p++ = '0' + ((c & 07000000) >> 18);
3501 *p++ = '0' + ((c & 0700000) >> 15);
3502 *p++ = '0' + ((c & 070000) >> 12);
3503 *p++ = '0' + ((c & 07000) >> 9);
3506 *p++ = '0' + ((c & 0700) >> 6);
3507 *p++ = '0' + ((c & 0070) >> 3);
3508 *p++ = '0' + ((c & 0007));
3510 p += set_charptr_emchar(p, c);
3514 return build_string((char *)buf);
3517 /************************************************************************/
3518 /* where-is (mapping bindings to keys) */
3519 /************************************************************************/
3522 where_is_internal(Lisp_Object definition, Lisp_Object * maps, int nmaps,
3523 Lisp_Object firstonly, char *target_buffer);
3525 DEFUN("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3526 Return list of keys that invoke DEFINITION in KEYMAPS.
3527 KEYMAPS can be either a keymap (meaning search in that keymap and the
3528 current global keymap) or a list of keymaps (meaning search in exactly
3529 those keymaps and no others). If KEYMAPS is nil, search in the currently
3530 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3531 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3533 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3534 the first key sequence found, rather than a list of all possible key
3537 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3538 to other keymaps or slots. This makes it possible to search for an
3539 indirect definition itself.
3541 (definition, keymaps, firstonly, noindirect, event_or_keys))
3543 /* This function can GC */
3544 Lisp_Object maps[100];
3545 Lisp_Object *gubbish = maps;
3548 /* Get keymaps as an array */
3549 if (NILP(keymaps)) {
3550 nmaps = get_relevant_keymaps(event_or_keys, countof(maps),
3552 if (nmaps > countof(maps)) {
3553 gubbish = alloca_array(Lisp_Object, nmaps);
3555 get_relevant_keymaps(event_or_keys, nmaps, gubbish);
3557 } else if (CONSP(keymaps)) {
3561 nmaps = XINT(Flength(keymaps));
3562 if (nmaps > countof(maps)) {
3563 gubbish = alloca_array(Lisp_Object, nmaps);
3565 for (rest = keymaps, i = 0; !NILP(rest);
3566 rest = XCDR(keymaps), i++) {
3567 gubbish[i] = get_keymap(XCAR(keymaps), 1, 1);
3571 gubbish[0] = get_keymap(keymaps, 1, 1);
3572 if (!EQ(gubbish[0], Vcurrent_global_map)) {
3573 gubbish[1] = Vcurrent_global_map;
3578 return where_is_internal(definition, gubbish, nmaps, firstonly, 0);
3581 /* This function is like
3582 (key-description (where-is-internal definition nil t))
3583 except that it writes its output into a (char *) buffer that you
3584 provide; it doesn't cons (or allocate memory) at all, so it's
3585 very fast. This is used by menubar.c.
3587 void where_is_to_char(Lisp_Object definition, char *buffer)
3589 /* This function can GC */
3590 Lisp_Object maps[100];
3591 Lisp_Object *gubbish = maps;
3594 /* Get keymaps as an array */
3595 nmaps = get_relevant_keymaps(Qnil, countof(maps), gubbish);
3596 if (nmaps > countof(maps)) {
3597 gubbish = alloca_array(Lisp_Object, nmaps);
3598 nmaps = get_relevant_keymaps(Qnil, nmaps, gubbish);
3602 where_is_internal(definition, maps, nmaps, Qt, buffer);
3605 static Lisp_Object raw_keys_to_keys(struct key_data *keys, int count)
3607 Lisp_Object result = make_vector(count, Qnil);
3609 XVECTOR_DATA(result)[count] =
3610 make_key_description(&(keys[count]), 1);
3614 static void format_raw_keys(struct key_data *keys, int count, char *buf)
3618 event.event_type = key_press_event;
3619 event.channel = Vselected_console;
3620 for (i = 0; i < count; i++) {
3621 event.event.key.keysym = keys[i].keysym;
3622 event.event.key.modifiers = keys[i].modifiers;
3623 format_event_object(buf, &event, 1);
3626 buf[0] = ' ', buf++;
3630 /* definition is the thing to look for.
3632 shadow is an array of shadow_count keymaps; if there is a different
3633 binding in any of the keymaps of a key that we are considering
3634 returning, then we reconsider.
3635 firstonly means give up after finding the first match;
3636 keys_so_far and modifiers_so_far describe which map we're looking in;
3637 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3638 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3639 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we
3640 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3643 (keys_so_far is a global buffer and the keys_count arg says how much
3644 of it we're currently interested in.)
3646 If target_buffer is provided, then we write a key-description into it,
3647 to avoid consing a string. This only works with firstonly on.
3650 struct where_is_closure {
3651 Lisp_Object definition;
3652 Lisp_Object *shadow;
3656 int modifiers_so_far;
3657 char *target_buffer;
3658 struct key_data *keys_so_far;
3659 int keys_so_far_total_size;
3660 int keys_so_far_malloced;
3663 /* arg is modified, so cannot be const */
3664 static Lisp_Object where_is_recursive_mapper(Lisp_Object map, void *arg);
3666 static Lisp_Object where_is_recursive_mapper(Lisp_Object map, void *arg)
3668 /* This function can GC */
3669 /* inevitable warning, we must modify c */
3670 struct where_is_closure *c = (struct where_is_closure *)arg;
3671 Lisp_Object definition = c->definition;
3672 const int firstonly = c->firstonly;
3673 const int keys_count = c->keys_count;
3674 const int modifiers_so_far = c->modifiers_so_far;
3675 char *target_buffer = c->target_buffer;
3676 Lisp_Object keys = Fgethash(definition,
3677 XKEYMAP(map)->inverse_table,
3679 Lisp_Object submaps;
3680 Lisp_Object result = Qnil;
3683 /* One or more keys in this map match the definition we're looking for.
3684 Verify that these bindings aren't shadowed by other bindings
3685 in the shadow maps. Either nil or number as value from
3686 raw_lookup_key() means undefined. */
3687 struct key_data *so_far = c->keys_so_far;
3689 for (;;) { /* loop over all keys that match */
3690 Lisp_Object k = CONSP(keys) ? XCAR(keys) : keys;
3693 so_far[keys_count].keysym = k;
3694 so_far[keys_count].modifiers = modifiers_so_far;
3696 /* now loop over all shadow maps */
3697 for (i = 0; i < c->shadow_count; i++) {
3698 Lisp_Object shadowed =
3699 raw_lookup_key(c->shadow[i],
3704 if (NILP(shadowed) || CHARP(shadowed) ||
3705 EQ(shadowed, definition))
3706 continue; /* we passed this test; it's not shadowed here. */
3708 /* ignore this key binding, since it actually has a
3709 different binding in a shadowing map */
3710 goto c_doesnt_have_proper_loop_exit_statements;
3713 /* OK, the key is for real */
3714 if (target_buffer) {
3717 format_raw_keys(so_far, keys_count + 1,
3720 } else if (firstonly)
3721 return raw_keys_to_keys(so_far, keys_count + 1);
3724 Fcons(raw_keys_to_keys
3725 (so_far, keys_count + 1), result);
3727 c_doesnt_have_proper_loop_exit_statements:
3728 /* now on to the next matching key ... */
3735 /* Now search the sub-keymaps of this map.
3736 If we're in "firstonly" mode and have already found one, this
3737 point is not reached. If we get one from lower down, either
3738 return it immediately (in firstonly mode) or tack it onto the
3739 end of the ones we've gotten so far.
3741 for (submaps = keymap_submaps(map);
3742 !NILP(submaps); submaps = XCDR(submaps)) {
3743 Lisp_Object key = XCAR(XCAR(submaps));
3744 Lisp_Object submap = XCDR(XCAR(submaps));
3745 int lower_modifiers;
3746 int lower_keys_count = keys_count;
3749 submap = get_keymap(submap, 0, 0);
3751 if (EQ(submap, map))
3752 /* Arrgh! Some loser has introduced a loop... */
3755 /* If this is not a keymap, then that's probably because someone
3756 did an `fset' of a symbol that used to point to a map such that
3757 it no longer does. Sigh. Ignore this, and invalidate the cache
3758 so that it doesn't happen to us next time too.
3761 XKEYMAP(map)->sub_maps_cache = Qt;
3765 /* If the map is a "bucky" map, then add a bit to the
3766 modifiers_so_far list.
3767 Otherwise, add a new raw_key onto the end of keys_so_far.
3769 bucky = MODIFIER_HASH_KEY_BITS(key);
3771 lower_modifiers = (modifiers_so_far | bucky);
3773 struct key_data *so_far = c->keys_so_far;
3774 lower_modifiers = 0;
3775 so_far[lower_keys_count].keysym = key;
3776 so_far[lower_keys_count].modifiers = modifiers_so_far;
3780 if (lower_keys_count >= c->keys_so_far_total_size) {
3781 int size = lower_keys_count + 50;
3782 if (!c->keys_so_far_malloced) {
3783 struct key_data *new =
3784 xnew_array(struct key_data, size);
3786 (const void*)c->keys_so_far,
3787 c->keys_so_far_total_size *
3788 sizeof(struct key_data));
3789 xfree(c->keys_so_far);
3790 c->keys_so_far = new;
3792 XREALLOC_ARRAY(c->keys_so_far, struct key_data,
3795 c->keys_so_far_total_size = size;
3796 c->keys_so_far_malloced = 1;
3802 c->keys_count = lower_keys_count;
3803 c->modifiers_so_far = lower_modifiers;
3805 lower = traverse_keymaps(
3806 submap, Qnil, where_is_recursive_mapper, c);
3808 c->keys_count = keys_count;
3809 c->modifiers_so_far = modifiers_so_far;
3812 result = nconc2(lower, result);
3813 } else if (!NILP(lower)) {
3822 where_is_internal(Lisp_Object definition, Lisp_Object * maps, int nmaps,
3823 Lisp_Object firstonly, char *target_buffer)
3825 /* This function can GC */
3826 Lisp_Object result = Qnil;
3828 struct key_data raw[20];
3829 struct where_is_closure c;
3831 c.definition = definition;
3833 c.firstonly = !NILP(firstonly);
3834 c.target_buffer = target_buffer;
3835 c.keys_so_far = raw;
3836 c.keys_so_far_total_size = countof(raw);
3837 c.keys_so_far_malloced = 0;
3839 /* Loop over each of the maps, accumulating the keys found.
3840 For each map searched, all previous maps shadow this one
3841 so that bogus keys aren't listed. */
3842 for (i = 0; i < nmaps; i++) {
3843 Lisp_Object this_result;
3845 /* Reset the things set in each iteration */
3847 c.modifiers_so_far = 0;
3851 maps[i], Qnil, where_is_recursive_mapper, &c);
3852 if (!NILP(firstonly)) {
3853 result = this_result;
3854 if (!NILP(result)) {
3858 result = nconc2(this_result, result);
3862 if (NILP(firstonly)) {
3863 result = Fnreverse(result);
3865 if (c.keys_so_far_malloced) {
3866 xfree(c.keys_so_far);
3871 /************************************************************************/
3872 /* Describing keymaps */
3873 /************************************************************************/
3875 DEFUN("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3876 Insert a list of all defined keys and their definitions in MAP.
3877 Optional second argument ALL says whether to include even "uninteresting"
3878 definitions (ie symbols with a non-nil `suppress-keymap' property.
3879 Third argument SHADOW is a list of keymaps whose bindings shadow those
3880 of map; if a binding is present in any shadowing map, it is not printed.
3881 Fourth argument PREFIX, if non-nil, should be a key sequence;
3882 only bindings which start with that key sequence will be printed.
3883 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3885 (map, all, shadow, prefix, mouse_only_p))
3887 /* This function can GC */
3889 /* #### At some point, this function should be changed to accept a
3890 BUFFER argument. Currently, the BUFFER argument to
3891 describe_map_tree is being used only internally. */
3892 describe_map_tree(map, NILP(all), shadow, prefix,
3893 !NILP(mouse_only_p), Fcurrent_buffer());
3897 /* Insert a description of the key bindings in STARTMAP,
3898 followed by those of all maps reachable through STARTMAP.
3899 If PARTIAL is nonzero, omit certain "uninteresting" commands
3900 (such as `undefined').
3901 If SHADOW is non-nil, it is a list of other maps;
3902 don't mention keys which would be shadowed by any of them
3903 If PREFIX is non-nil, only list bindings which start with those keys.
3907 describe_map_tree(Lisp_Object startmap, int partial, Lisp_Object shadow,
3908 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3910 /* This function can GC */
3911 Lisp_Object maps = Qnil;
3912 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3913 GCPRO2(maps, shadow);
3915 maps = Faccessible_keymaps(startmap, prefix);
3917 for (; !NILP(maps); maps = Fcdr(maps)) {
3918 Lisp_Object sub_shadow = Qnil;
3919 Lisp_Object elt = Fcar(maps);
3921 Lisp_Object tmp = Fcar(elt);
3922 int no_prefix = (VECTORP(tmp) && XINT(Flength(tmp)) == 0);
3923 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3924 NGCPRO3(sub_shadow, elt, tail);
3926 for (tail = shadow; CONSP(tail); tail = XCDR(tail)) {
3927 Lisp_Object shmap = XCAR(tail);
3929 /* If the sequence by which we reach this keymap is zero-length,
3930 then the shadow maps for this keymap are just SHADOW. */
3932 /* If the sequence by which we reach this keymap actually has
3933 some elements, then the sequence's definition in SHADOW is
3934 what we should use. */
3936 shmap = Flookup_key(shmap, Fcar(elt), Qt);
3942 Lisp_Object shm = get_keymap(shmap, 0, 1);
3943 /* If shmap is not nil and not a keymap, it completely
3944 shadows this map, so don't describe this map at all. */
3947 sub_shadow = Fcons(shm, sub_shadow);
3952 /* Describe the contents of map MAP, assuming that this map
3953 itself is reached by the sequence of prefix keys KEYS (a vector).
3954 PARTIAL and SHADOW are as in `describe_map_tree'. */
3955 Lisp_Object keysdesc = ((!no_prefix)
3957 concat2(Fkey_description
3959 Vsingle_space_string)
3961 describe_map(Fcdr(elt), keysdesc,
3963 partial, sub_shadow, mice_only_p, buffer);
3971 static void describe_command(Lisp_Object definition, Lisp_Object buffer)
3973 /* This function can GC */
3974 int keymapp = !NILP(Fkeymapp(definition));
3975 struct gcpro gcpro1;
3978 Findent_to(make_int(16), make_int(3), buffer);
3980 buffer_insert_c_string(XBUFFER(buffer), "<< ");
3982 if (SYMBOLP(definition)) {
3983 buffer_insert1(XBUFFER(buffer), Fsymbol_name(definition));
3984 } else if (STRINGP(definition) || VECTORP(definition)) {
3985 buffer_insert_c_string(XBUFFER(buffer), "Kbd Macro: ");
3986 buffer_insert1(XBUFFER(buffer), Fkey_description(definition));
3987 } else if (COMPILED_FUNCTIONP(definition))
3988 buffer_insert_c_string(XBUFFER(buffer),
3989 "Anonymous Compiled Function");
3990 else if (CONSP(definition) && EQ(XCAR(definition), Qlambda))
3991 buffer_insert_c_string(XBUFFER(buffer), "Anonymous Lambda");
3992 else if (KEYMAPP(definition)) {
3993 Lisp_Object name = XKEYMAP(definition)->name;
3994 if (STRINGP(name) || (SYMBOLP(name) && !NILP(name))) {
3995 buffer_insert_c_string(XBUFFER(buffer),
3998 && EQ(find_symbol_value(name), definition))
3999 buffer_insert1(XBUFFER(buffer),
4000 Fsymbol_name(name));
4002 buffer_insert1(XBUFFER(buffer),
4003 Fprin1_to_string(name, Qnil));
4006 buffer_insert_c_string(XBUFFER(buffer),
4009 buffer_insert_c_string(XBUFFER(buffer), "??");
4012 buffer_insert_c_string(XBUFFER(buffer), " >>");
4013 buffer_insert_c_string(XBUFFER(buffer), "\n");
4017 struct describe_map_closure {
4018 Lisp_Object *list; /* pointer to the list to update */
4019 Lisp_Object partial; /* whether to ignore suppressed commands */
4020 Lisp_Object shadow; /* list of maps shadowing this one */
4021 Lisp_Object self; /* this map */
4022 Lisp_Object self_root; /* this map, or some map that has this map as
4023 a parent. this is the base of the tree */
4024 int mice_only_p; /* whether we are to display only button bindings */
4027 struct describe_map_shadow_closure {
4028 const struct key_data *raw_key;
4033 describe_map_mapper_shadow_search(Lisp_Object map, void *arg)
4035 const struct describe_map_shadow_closure *c =
4036 (const struct describe_map_shadow_closure *)arg;
4038 if (EQ(map, c->self)) {
4039 return Qzero; /* Not shadowed; terminate search */
4041 return !NILP(keymap_lookup_directly(
4042 map, c->raw_key->keysym, c->raw_key->modifiers))
4047 keymap_lookup_inherited_mapper(Lisp_Object km, void *arg)
4049 const struct key_data *k = (const struct key_data *)arg;
4050 return keymap_lookup_directly(km, k->keysym, k->modifiers);
4054 describe_map_mapper(struct key_data *key,
4055 Lisp_Object binding, const void *describe_map_closure)
4057 /* This function can GC */
4058 const struct describe_map_closure *closure =
4059 (const struct describe_map_closure *)describe_map_closure;
4060 Lisp_Object keysym = key->keysym;
4061 int modifiers = key->modifiers;
4063 /* Don't mention suppressed commands. */
4064 if (SYMBOLP(binding)
4065 && !NILP(closure->partial)
4066 && !NILP(Fget(binding, closure->partial, Qnil)))
4069 /* If we're only supposed to display mouse bindings and this isn't one,
4071 if (closure->mice_only_p &&
4072 (!(EQ(keysym, Qbutton0) ||
4073 EQ(keysym, Qbutton1) ||
4074 EQ(keysym, Qbutton2) ||
4075 EQ(keysym, Qbutton3) ||
4076 EQ(keysym, Qbutton4) ||
4077 EQ(keysym, Qbutton5) ||
4078 EQ(keysym, Qbutton6) ||
4079 EQ(keysym, Qbutton7) ||
4080 EQ(keysym, Qbutton8) ||
4081 EQ(keysym, Qbutton9) ||
4082 EQ(keysym, Qbutton10) ||
4083 EQ(keysym, Qbutton11) ||
4084 EQ(keysym, Qbutton12) ||
4085 EQ(keysym, Qbutton13) ||
4086 EQ(keysym, Qbutton14) ||
4087 EQ(keysym, Qbutton15) ||
4088 EQ(keysym, Qbutton16) ||
4089 EQ(keysym, Qbutton17) ||
4090 EQ(keysym, Qbutton18) ||
4091 EQ(keysym, Qbutton19) ||
4092 EQ(keysym, Qbutton20) ||
4093 EQ(keysym, Qbutton21) ||
4094 EQ(keysym, Qbutton22) ||
4095 EQ(keysym, Qbutton23) ||
4096 EQ(keysym, Qbutton24) ||
4097 EQ(keysym, Qbutton25) ||
4098 EQ(keysym, Qbutton26) ||
4099 EQ(keysym, Qbutton27) ||
4100 EQ(keysym, Qbutton28) ||
4101 EQ(keysym, Qbutton29) ||
4102 EQ(keysym, Qbutton30) ||
4103 EQ(keysym, Qbutton31) ||
4104 EQ(keysym, Qbutton32) ||
4105 EQ(keysym, Qbutton0up) ||
4106 EQ(keysym, Qbutton1up) ||
4107 EQ(keysym, Qbutton2up) ||
4108 EQ(keysym, Qbutton3up) ||
4109 EQ(keysym, Qbutton4up) ||
4110 EQ(keysym, Qbutton5up) ||
4111 EQ(keysym, Qbutton6up) ||
4112 EQ(keysym, Qbutton7up) ||
4113 EQ(keysym, Qbutton8up) ||
4114 EQ(keysym, Qbutton9up) ||
4115 EQ(keysym, Qbutton10up) ||
4116 EQ(keysym, Qbutton11up) ||
4117 EQ(keysym, Qbutton12up) ||
4118 EQ(keysym, Qbutton13up) ||
4119 EQ(keysym, Qbutton14up) ||
4120 EQ(keysym, Qbutton15up) ||
4121 EQ(keysym, Qbutton16up) ||
4122 EQ(keysym, Qbutton17up) ||
4123 EQ(keysym, Qbutton18up) ||
4124 EQ(keysym, Qbutton19up) ||
4125 EQ(keysym, Qbutton20up) ||
4126 EQ(keysym, Qbutton21up) ||
4127 EQ(keysym, Qbutton22up) ||
4128 EQ(keysym, Qbutton23up) ||
4129 EQ(keysym, Qbutton24up) ||
4130 EQ(keysym, Qbutton25up) ||
4131 EQ(keysym, Qbutton26up) ||
4132 EQ(keysym, Qbutton27up) ||
4133 EQ(keysym, Qbutton28up) ||
4134 EQ(keysym, Qbutton29up) ||
4135 EQ(keysym, Qbutton30up) ||
4136 EQ(keysym, Qbutton31up) ||
4137 EQ(keysym, Qbutton32up)))) {
4140 /* If this command in this map is shadowed by some other map, ignore
4145 for (tail = closure->shadow; CONSP(tail); tail = XCDR(tail)) {
4147 if (!NILP(traverse_keymaps(
4149 keymap_lookup_inherited_mapper,
4150 /* Cast to discard `const' */
4157 /* If this key is in some map of which this map is a parent, then ignore
4158 it (in that case, it has been shadowed).
4162 struct describe_map_shadow_closure c;
4164 c.self = closure->self;
4166 sh = traverse_keymaps(closure->self_root, Qnil,
4167 describe_map_mapper_shadow_search, &c);
4168 if (!NILP(sh) && !ZEROP(sh)) {
4173 /* Otherwise add it to the list to be sorted. */
4174 *(closure->list) = Fcons(Fcons(Fcons(keysym, make_int(modifiers)),
4175 binding), *(closure->list));
4179 describe_map_sort_predicate(Lisp_Object obj1, Lisp_Object obj2,
4182 /* obj1 and obj2 are conses of the form
4183 ( ( <keysym> . <modifiers> ) . <binding> )
4184 keysym and modifiers are used, binding is ignored.
4189 bit1 = XINT(XCDR(obj1));
4190 bit2 = XINT(XCDR(obj2));
4192 return bit1 < bit2 ? 1 : -1;
4194 return map_keymap_sort_predicate(obj1, obj2, pred);
4197 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4198 or 2 or more symbolic keysyms that are bound to the same thing and
4199 have consecutive character-set-properties.
4201 static int elide_next_two_p(Lisp_Object list)
4205 if (NILP(XCDR(list)))
4208 /* next two bindings differ */
4209 if (!EQ(XCDR(XCAR(list)), XCDR(XCAR(XCDR(list)))))
4212 /* next two modifier-sets differ */
4213 if (!EQ(XCDR(XCAR(XCAR(list))), XCDR(XCAR(XCAR(XCDR(list))))))
4216 s1 = XCAR(XCAR(XCAR(list)));
4217 s2 = XCAR(XCAR(XCAR(XCDR(list))));
4220 Lisp_Object code = Fget(s1, Vcharacter_set_property, Qnil);
4221 if (CHAR_OR_CHAR_INTP(code)) {
4223 CHECK_CHAR_COERCE_INT(s1);
4228 Lisp_Object code = Fget(s2, Vcharacter_set_property, Qnil);
4229 if (CHAR_OR_CHAR_INTP(code)) {
4231 CHECK_CHAR_COERCE_INT(s2);
4236 return (XCHAR(s1) == XCHAR(s2) || XCHAR(s1) + 1 == XCHAR(s2));
4240 describe_map_parent_mapper(Lisp_Object keymap, void *arg)
4242 /* This function can GC */
4243 struct describe_map_closure *describe_map_closure =
4244 (struct describe_map_closure *)arg;
4245 describe_map_closure->self = keymap;
4246 /* don't sort: we'll do it later */
4247 map_keymap(XKEYMAP(keymap)->table, 0,
4248 (void(*)(const struct key_data*, Lisp_Object, void*))
4249 describe_map_mapper, describe_map_closure);
4253 /* Describe the contents of map MAP, assuming that this map itself is
4254 reached by the sequence of prefix keys KEYS (a string or vector).
4255 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4258 describe_map(Lisp_Object keymap, Lisp_Object elt_prefix,
4259 void (*elt_describer) (Lisp_Object, Lisp_Object),
4261 Lisp_Object shadow, int mice_only_p, Lisp_Object buffer)
4263 /* This function can GC */
4264 struct describe_map_closure describe_map_closure;
4265 Lisp_Object list = Qnil;
4266 struct buffer *buf = XBUFFER(buffer);
4267 Emchar printable_min = (CHAR_OR_CHAR_INTP(buf->ctl_arrow)
4268 ? XCHAR_OR_CHAR_INT(buf->ctl_arrow)
4269 : ((EQ(buf->ctl_arrow, Qt)
4270 || EQ(buf->ctl_arrow, Qnil))
4273 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4275 keymap = get_keymap(keymap, 1, 1);
4276 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4277 describe_map_closure.shadow = shadow;
4278 describe_map_closure.list = &list;
4279 describe_map_closure.self_root = keymap;
4280 describe_map_closure.mice_only_p = mice_only_p;
4282 GCPRO4(keymap, elt_prefix, shadow, list);
4284 traverse_keymaps(keymap, Qnil,
4285 describe_map_parent_mapper, &describe_map_closure);
4288 list = list_sort(list, Qnil, describe_map_sort_predicate);
4289 buffer_insert_c_string(buf, "\n");
4290 while (!NILP(list)) {
4291 Lisp_Object elt = XCAR(XCAR(list));
4292 Lisp_Object keysym = XCAR(elt);
4293 int modifiers = XINT(XCDR(elt));
4295 if (!NILP(elt_prefix))
4296 buffer_insert_lisp_string(buf, elt_prefix);
4298 if (modifiers & XEMACS_MOD_META)
4299 buffer_insert_c_string(buf, "M-");
4300 if (modifiers & XEMACS_MOD_CONTROL)
4301 buffer_insert_c_string(buf, "C-");
4302 if (modifiers & XEMACS_MOD_SUPER)
4303 buffer_insert_c_string(buf, "S-");
4304 if (modifiers & XEMACS_MOD_HYPER)
4305 buffer_insert_c_string(buf, "H-");
4306 if (modifiers & XEMACS_MOD_ALT)
4307 buffer_insert_c_string(buf, "Alt-");
4308 if (modifiers & XEMACS_MOD_SHIFT)
4309 buffer_insert_c_string(buf, "Sh-");
4310 if (SYMBOLP(keysym)) {
4312 Fget(keysym, Vcharacter_set_property, Qnil);
4313 Emchar c = (CHAR_OR_CHAR_INTP(code)
4314 ? XCHAR_OR_CHAR_INT(code) : (Emchar)
4316 /* Calling Fsingle_key_description() would cons more */
4317 #if 0 /* This is bogus */
4318 if (EQ(keysym, QKlinefeed))
4319 buffer_insert_c_string(buf, "LFD");
4320 else if (EQ(keysym, QKtab))
4321 buffer_insert_c_string(buf, "TAB");
4322 else if (EQ(keysym, QKreturn))
4323 buffer_insert_c_string(buf, "RET");
4324 else if (EQ(keysym, QKescape))
4325 buffer_insert_c_string(buf, "ESC");
4326 else if (EQ(keysym, QKdelete))
4327 buffer_insert_c_string(buf, "DEL");
4328 else if (EQ(keysym, QKspace))
4329 buffer_insert_c_string(buf, "SPC");
4330 else if (EQ(keysym, QKbackspace))
4331 buffer_insert_c_string(buf, "BS");
4334 if (c >= printable_min)
4335 buffer_insert_emacs_char(buf, c);
4338 Fsymbol_name(keysym));
4339 } else if (CHARP(keysym))
4340 buffer_insert_emacs_char(buf, XCHAR(keysym));
4342 buffer_insert_c_string(buf, "---bad keysym---");
4349 while (elide_next_two_p(list)) {
4355 buffer_insert_c_string(buf,
4358 buffer_insert_c_string(buf,
4365 /* Print a description of the definition of this character. */
4366 (*elt_describer) (XCDR(XCAR(list)), buffer);
4373 void syms_of_keymap(void)
4375 INIT_LRECORD_IMPLEMENTATION(keymap);
4377 defsymbol(&Qminor_mode_map_alist, "minor-mode-map-alist");
4379 defsymbol(&Qkeymapp, "keymapp");
4381 defsymbol(&Qsuppress_keymap, "suppress-keymap");
4383 defsymbol(&Qmodeline_map, "modeline-map");
4384 defsymbol(&Qtoolbar_map, "toolbar-map");
4386 DEFSUBR(Fkeymap_parents);
4387 DEFSUBR(Fset_keymap_parents);
4388 DEFSUBR(Fkeymap_name);
4389 DEFSUBR(Fset_keymap_name);
4390 DEFSUBR(Fkeymap_prompt);
4391 DEFSUBR(Fset_keymap_prompt);
4392 DEFSUBR(Fkeymap_default_binding);
4393 DEFSUBR(Fset_keymap_default_binding);
4396 DEFSUBR(Fmake_keymap);
4397 DEFSUBR(Fmake_sparse_keymap);
4399 DEFSUBR(Fcopy_keymap);
4400 DEFSUBR(Fkeymap_fullness);
4401 DEFSUBR(Fmap_keymap);
4402 DEFSUBR(Fevent_matches_key_specifier_p);
4403 DEFSUBR(Fdefine_key);
4404 DEFSUBR(Flookup_key);
4405 DEFSUBR(Fkey_binding);
4406 DEFSUBR(Fuse_global_map);
4407 DEFSUBR(Fuse_local_map);
4408 DEFSUBR(Fcurrent_local_map);
4409 DEFSUBR(Fcurrent_global_map);
4410 DEFSUBR(Fcurrent_keymaps);
4411 DEFSUBR(Faccessible_keymaps);
4412 DEFSUBR(Fkey_description);
4413 DEFSUBR(Fsingle_key_description);
4414 DEFSUBR(Fwhere_is_internal);
4415 DEFSUBR(Fdescribe_bindings_internal);
4417 DEFSUBR(Ftext_char_description);
4419 defsymbol(&Qcontrol, "control");
4420 defsymbol(&Qctrl, "ctrl");
4421 defsymbol(&Qmeta, "meta");
4422 defsymbol(&Qsuper, "super");
4423 defsymbol(&Qhyper, "hyper");
4424 defsymbol(&Qalt, "alt");
4425 defsymbol(&Qshift, "shift");
4426 defsymbol(&Qbutton0, "button0");
4427 defsymbol(&Qbutton1, "button1");
4428 defsymbol(&Qbutton2, "button2");
4429 defsymbol(&Qbutton3, "button3");
4430 defsymbol(&Qbutton4, "button4");
4431 defsymbol(&Qbutton5, "button5");
4432 defsymbol(&Qbutton6, "button6");
4433 defsymbol(&Qbutton7, "button7");
4434 defsymbol(&Qbutton8, "button8");
4435 defsymbol(&Qbutton9, "button9");
4436 defsymbol(&Qbutton10, "button10");
4437 defsymbol(&Qbutton11, "button11");
4438 defsymbol(&Qbutton12, "button12");
4439 defsymbol(&Qbutton13, "button13");
4440 defsymbol(&Qbutton14, "button14");
4441 defsymbol(&Qbutton15, "button15");
4442 defsymbol(&Qbutton16, "button16");
4443 defsymbol(&Qbutton17, "button17");
4444 defsymbol(&Qbutton18, "button18");
4445 defsymbol(&Qbutton19, "button19");
4446 defsymbol(&Qbutton20, "button20");
4447 defsymbol(&Qbutton21, "button21");
4448 defsymbol(&Qbutton22, "button22");
4449 defsymbol(&Qbutton23, "button23");
4450 defsymbol(&Qbutton24, "button24");
4451 defsymbol(&Qbutton25, "button25");
4452 defsymbol(&Qbutton26, "button26");
4453 defsymbol(&Qbutton27, "button27");
4454 defsymbol(&Qbutton28, "button28");
4455 defsymbol(&Qbutton29, "button29");
4456 defsymbol(&Qbutton30, "button30");
4457 defsymbol(&Qbutton31, "button31");
4458 defsymbol(&Qbutton32, "button32");
4459 defsymbol(&Qbutton0up, "button0up");
4460 defsymbol(&Qbutton1up, "button1up");
4461 defsymbol(&Qbutton2up, "button2up");
4462 defsymbol(&Qbutton3up, "button3up");
4463 defsymbol(&Qbutton4up, "button4up");
4464 defsymbol(&Qbutton5up, "button5up");
4465 defsymbol(&Qbutton6up, "button6up");
4466 defsymbol(&Qbutton7up, "button7up");
4467 defsymbol(&Qbutton8up, "button8up");
4468 defsymbol(&Qbutton9up, "button9up");
4469 defsymbol(&Qbutton10up, "button10up");
4470 defsymbol(&Qbutton11up, "button11up");
4471 defsymbol(&Qbutton12up, "button12up");
4472 defsymbol(&Qbutton13up, "button13up");
4473 defsymbol(&Qbutton14up, "button14up");
4474 defsymbol(&Qbutton15up, "button15up");
4475 defsymbol(&Qbutton16up, "button16up");
4476 defsymbol(&Qbutton17up, "button17up");
4477 defsymbol(&Qbutton18up, "button18up");
4478 defsymbol(&Qbutton19up, "button19up");
4479 defsymbol(&Qbutton20up, "button20up");
4480 defsymbol(&Qbutton21up, "button21up");
4481 defsymbol(&Qbutton22up, "button22up");
4482 defsymbol(&Qbutton23up, "button23up");
4483 defsymbol(&Qbutton24up, "button24up");
4484 defsymbol(&Qbutton25up, "button25up");
4485 defsymbol(&Qbutton26up, "button26up");
4486 defsymbol(&Qbutton27up, "button27up");
4487 defsymbol(&Qbutton28up, "button28up");
4488 defsymbol(&Qbutton29up, "button29up");
4489 defsymbol(&Qbutton30up, "button30up");
4490 defsymbol(&Qbutton31up, "button31up");
4491 defsymbol(&Qbutton32up, "button32up");
4492 defsymbol(&Qmouse_1, "mouse-1");
4493 defsymbol(&Qmouse_2, "mouse-2");
4494 defsymbol(&Qmouse_3, "mouse-3");
4495 defsymbol(&Qmouse_4, "mouse-4");
4496 defsymbol(&Qmouse_5, "mouse-5");
4497 defsymbol(&Qmouse_6, "mouse-6");
4498 defsymbol(&Qmouse_7, "mouse-7");
4499 defsymbol(&Qmouse_8, "mouse-8");
4500 defsymbol(&Qmouse_9, "mouse-9");
4501 defsymbol(&Qmouse_10, "mouse-10");
4502 defsymbol(&Qmouse_11, "mouse-11");
4503 defsymbol(&Qmouse_12, "mouse-12");
4504 defsymbol(&Qmouse_13, "mouse-13");
4505 defsymbol(&Qmouse_14, "mouse-14");
4506 defsymbol(&Qmouse_15, "mouse-15");
4507 defsymbol(&Qmouse_16, "mouse-16");
4508 defsymbol(&Qmouse_17, "mouse-17");
4509 defsymbol(&Qmouse_18, "mouse-18");
4510 defsymbol(&Qmouse_19, "mouse-19");
4511 defsymbol(&Qmouse_20, "mouse-20");
4512 defsymbol(&Qmouse_21, "mouse-21");
4513 defsymbol(&Qmouse_22, "mouse-22");
4514 defsymbol(&Qmouse_23, "mouse-23");
4515 defsymbol(&Qmouse_24, "mouse-24");
4516 defsymbol(&Qmouse_25, "mouse-25");
4517 defsymbol(&Qmouse_26, "mouse-26");
4518 defsymbol(&Qmouse_27, "mouse-27");
4519 defsymbol(&Qmouse_28, "mouse-28");
4520 defsymbol(&Qmouse_29, "mouse-29");
4521 defsymbol(&Qmouse_30, "mouse-30");
4522 defsymbol(&Qmouse_31, "mouse-31");
4523 defsymbol(&Qmouse_32, "mouse-32");
4524 defsymbol(&Qdown_mouse_1, "down-mouse-1");
4525 defsymbol(&Qdown_mouse_2, "down-mouse-2");
4526 defsymbol(&Qdown_mouse_3, "down-mouse-3");
4527 defsymbol(&Qdown_mouse_4, "down-mouse-4");
4528 defsymbol(&Qdown_mouse_5, "down-mouse-5");
4529 defsymbol(&Qdown_mouse_6, "down-mouse-6");
4530 defsymbol(&Qdown_mouse_7, "down-mouse-7");
4531 defsymbol(&Qdown_mouse_8, "down-mouse-8");
4532 defsymbol(&Qdown_mouse_9, "down-mouse-9");
4533 defsymbol(&Qdown_mouse_10, "down-mouse-10");
4534 defsymbol(&Qdown_mouse_11, "down-mouse-11");
4535 defsymbol(&Qdown_mouse_12, "down-mouse-12");
4536 defsymbol(&Qdown_mouse_13, "down-mouse-13");
4537 defsymbol(&Qdown_mouse_14, "down-mouse-14");
4538 defsymbol(&Qdown_mouse_15, "down-mouse-15");
4539 defsymbol(&Qdown_mouse_16, "down-mouse-16");
4540 defsymbol(&Qdown_mouse_17, "down-mouse-17");
4541 defsymbol(&Qdown_mouse_18, "down-mouse-18");
4542 defsymbol(&Qdown_mouse_19, "down-mouse-19");
4543 defsymbol(&Qdown_mouse_20, "down-mouse-20");
4544 defsymbol(&Qdown_mouse_21, "down-mouse-21");
4545 defsymbol(&Qdown_mouse_22, "down-mouse-22");
4546 defsymbol(&Qdown_mouse_23, "down-mouse-23");
4547 defsymbol(&Qdown_mouse_24, "down-mouse-24");
4548 defsymbol(&Qdown_mouse_25, "down-mouse-25");
4549 defsymbol(&Qdown_mouse_26, "down-mouse-26");
4550 defsymbol(&Qdown_mouse_27, "down-mouse-27");
4551 defsymbol(&Qdown_mouse_28, "down-mouse-28");
4552 defsymbol(&Qdown_mouse_29, "down-mouse-29");
4553 defsymbol(&Qdown_mouse_30, "down-mouse-30");
4554 defsymbol(&Qdown_mouse_31, "down-mouse-31");
4555 defsymbol(&Qdown_mouse_32, "down-mouse-32");
4556 defsymbol(&Qmenu_selection, "menu-selection");
4557 defsymbol(&QLFD, "LFD");
4558 defsymbol(&QTAB, "TAB");
4559 defsymbol(&QRET, "RET");
4560 defsymbol(&QESC, "ESC");
4561 defsymbol(&QDEL, "DEL");
4562 defsymbol(&QSPC, "SPC");
4563 defsymbol(&QBS, "BS");
4566 void vars_of_keymap(void)
4568 DEFVAR_LISP("meta-prefix-char", &Vmeta_prefix_char /*
4569 Meta-prefix character.
4570 This character followed by some character `foo' turns into `Meta-foo'.
4571 This can be any form recognized as a single key specifier.
4572 To disable the meta-prefix-char, set it to a negative number.
4574 Vmeta_prefix_char = make_char(033);
4576 DEFVAR_LISP("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4577 A buffer which should be consulted first for all mouse activity.
4578 When a mouse-click is processed, it will first be looked up in the
4579 local-map of this buffer, and then through the normal mechanism if there
4580 is no binding for that click. This buffer's value of `mode-motion-hook'
4581 will be consulted instead of the `mode-motion-hook' of the buffer of the
4582 window under the mouse. You should *bind* this, not set it.
4584 Vmouse_grabbed_buffer = Qnil;
4586 DEFVAR_LISP("overriding-local-map", &Voverriding_local_map /*
4587 Keymap that overrides all other local keymaps.
4588 If this variable is non-nil, it is used as a keymap instead of the
4589 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4590 You should *bind* this, not set it.
4592 Voverriding_local_map = Qnil;
4594 Fset(Qminor_mode_map_alist, Qnil);
4596 DEFVAR_LISP("key-translation-map", &Vkey_translation_map /*
4597 Keymap of key translations that can override keymaps.
4599 This keymap works like `function-key-map', but is searched before it,
4600 and applies even for keys that have ordinary bindings.
4602 The `read-key-sequence' function replaces any subsequence bound by
4603 `key-translation-map' with its binding. More precisely, when the active
4604 keymaps have no binding for the current key sequence but
4605 `key-translation-map' binds a suffix of the sequence to a vector or string,
4606 `read-key-sequence' replaces the matching suffix with its binding, and
4607 continues with the new sequence. See `key-binding' for details.
4609 The events that come from bindings in `key-translation-map' are not
4610 themselves looked up in `key-translation-map'.
4612 #### FIXME: stolen from `function-key-map'; need better example.
4613 #### I guess you could implement a Dvorak keyboard with this?
4614 For example, suppose `key-translation-map' binds `ESC O P' to [f1].
4615 Typing `ESC O P' to `read-key-sequence' would return
4616 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return
4617 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1]
4618 were a prefix key, typing `ESC O P x' would return
4619 \[#<keypress-event f1> #<keypress-event x>].
4621 Vkey_translation_map = Qnil;
4623 DEFVAR_LISP ("global-tty-map", &Vglobal_tty_map /*
4624 Global keymap that applies only to TTY's.
4625 Key bindings are looked up in this map just before looking in the global map,
4626 but only when the current console is a TTY console. See also
4627 `global-window-system-map'.
4629 Vglobal_tty_map = Qnil;
4631 DEFVAR_LISP ("global-window-system-map", &Vglobal_window_system_map /*
4632 Global keymap that applies only to window systems.
4633 Key bindings are looked up in this map just before looking in the global map,
4634 but only when the current console is not a TTY console. See also
4637 Vglobal_window_system_map = Qnil;
4639 DEFVAR_LISP("vertical-divider-map", &Vvertical_divider_map /*
4640 Keymap which handles mouse clicks over vertical dividers.
4642 Vvertical_divider_map = Qnil;
4644 DEFVAR_INT("keymap-tick", &keymap_tick /*
4645 Incremented for each change to any keymap.
4649 staticpro(&Vcurrent_global_map);
4651 Vsingle_space_string = make_string((const Bufbyte *)" ", 1);
4652 staticpro(&Vsingle_space_string);
4655 void complex_vars_of_keymap(void)
4657 /* This function can GC */
4658 Lisp_Object ESC_prefix = intern("ESC-prefix");
4659 Lisp_Object meta_disgustitute;
4661 Vcurrent_global_map = Fmake_keymap(Qnil);
4662 Vglobal_tty_map = Fmake_keymap (intern ("global-tty-map"));
4663 Vglobal_window_system_map =
4664 Fmake_keymap (intern ("global-window-system-map"));
4666 meta_disgustitute = Fmake_keymap(Qnil);
4667 Ffset(ESC_prefix, meta_disgustitute);
4668 /* no need to protect meta_disgustitute, though */
4669 keymap_store_internal(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
4670 XKEYMAP(Vcurrent_global_map), meta_disgustitute);
4671 XKEYMAP(Vcurrent_global_map)->sub_maps_cache = Qt;
4673 Vkey_translation_map =
4674 Fmake_sparse_keymap(intern("key-translation-map"));