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);
291 error("printing unreadable object #<keymap 0x%x>",
293 write_c_string("#<keymap ", printcharfun);
294 if (!NILP(keymap->name)) {
295 print_internal(keymap->name, printcharfun, 1);
296 write_c_string(" ", printcharfun);
298 write_fmt_str(printcharfun, "size %ld 0x%x>",
299 (long)XINT(Fkeymap_fullness(obj)), keymap->header.uid);
302 static const struct lrecord_description keymap_description[] = {
303 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, parents)},
304 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, prompt)},
305 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, table)},
306 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, inverse_table)},
307 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, default_binding)},
308 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, sub_maps_cache)},
309 {XD_LISP_OBJECT, offsetof(Lisp_Keymap, name)},
313 /* No need for keymap_equal #### Why not? */
314 DEFINE_LRECORD_IMPLEMENTATION("keymap", keymap,
315 mark_keymap, print_keymap, 0, 0, 0,
316 keymap_description, Lisp_Keymap);
318 /************************************************************************/
319 /* Traversing keymaps and their parents */
320 /************************************************************************/
323 traverse_keymaps(Lisp_Object start_keymap, Lisp_Object start_parents,
324 Lisp_Object(*mapper)(Lisp_Object keymap, void*),
327 /* This function can GC */
329 Lisp_Object tail = start_parents;
330 Lisp_Object malloc_sucks[10] = {0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
331 Lisp_Object malloc_bites = Qnil;
333 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
334 GCPRO3n(malloc_bites, start_keymap, tail,
335 malloc_sucks, countof(malloc_sucks));
337 start_keymap = get_keymap(start_keymap, 1, 1);
338 keymap = start_keymap;
339 /* Hack special-case parents at top-level */
340 tail = !NILP(tail) ? tail : XKEYMAP(keymap)->parents;
346 result = mapper(keymap, mapper_arg);
348 while (CONSP(malloc_bites)) {
349 Lisp_Cons *victim = XCONS(malloc_bites);
350 malloc_bites = victim->cdr;
357 if (stack_depth == 0) {
359 return Qnil; /* Nothing found */
362 if (CONSP(malloc_bites)) {
363 Lisp_Cons *victim = XCONS(malloc_bites);
365 malloc_bites = victim->cdr;
368 tail = malloc_sucks[stack_depth];
377 parents = XKEYMAP(keymap)->parents;
378 if (!CONSP(parents)) ;
383 if (CONSP(malloc_bites))
385 noseeum_cons(tail, malloc_bites);
386 else if (stack_depth < countof(malloc_sucks)) {
387 malloc_sucks[stack_depth++] = tail;
389 /* *&@##[*&^$ C. @#[$*&@# Unix.
392 for (i = 0, malloc_bites = Qnil;
393 i < countof(malloc_sucks); i++) {
395 noseeum_cons(malloc_sucks
403 keymap = get_keymap(keymap, 1, 1);
404 if (EQ(keymap, start_keymap)) {
405 signal_simple_error("Cyclic keymap indirection",
411 /************************************************************************/
412 /* Some low-level functions */
413 /************************************************************************/
415 static int bucky_sym_to_bucky_bit(Lisp_Object sym)
417 if (EQ(sym, Qcontrol))
418 return XEMACS_MOD_CONTROL;
420 return XEMACS_MOD_META;
422 return XEMACS_MOD_SUPER;
424 return XEMACS_MOD_HYPER;
426 return XEMACS_MOD_ALT;
427 if (EQ(sym, Qsymbol))
428 return XEMACS_MOD_ALT; /* #### - reverse compat */
430 return XEMACS_MOD_SHIFT;
435 static Lisp_Object control_meta_superify(Lisp_Object frob, int modifiers)
439 frob = Fcons(frob, Qnil);
440 if (modifiers & XEMACS_MOD_SHIFT)
441 frob = Fcons(Qshift, frob);
442 if (modifiers & XEMACS_MOD_ALT)
443 frob = Fcons(Qalt, frob);
444 if (modifiers & XEMACS_MOD_HYPER)
445 frob = Fcons(Qhyper, frob);
446 if (modifiers & XEMACS_MOD_SUPER)
447 frob = Fcons(Qsuper, frob);
448 if (modifiers & XEMACS_MOD_CONTROL)
449 frob = Fcons(Qcontrol, frob);
450 if (modifiers & XEMACS_MOD_META)
451 frob = Fcons(Qmeta, frob);
456 make_key_description(const struct key_data *key, int prettify)
458 Lisp_Object keysym = key->keysym;
459 int modifiers = key->modifiers;
461 if (prettify && CHARP(keysym)) {
462 /* This is a little slow, but (control a) is prettier than (control 65).
463 It's now ok to do this for digit-chars too, since we've fixed the
464 bug where \9 read as the integer 9 instead of as the symbol with
467 /* !!#### I'm not sure how correct this is. */
468 Bufbyte str[1 + MAX_EMCHAR_LEN];
469 Bytecount count = set_charptr_emchar(str, XCHAR(keysym));
471 keysym = intern((char *)str);
473 return control_meta_superify(keysym, modifiers);
476 /************************************************************************/
477 /* Low-level keymap-store functions */
478 /************************************************************************/
481 raw_lookup_key(Lisp_Object keymap,
482 const struct key_data *raw_keys, int raw_keys_count,
483 int keys_so_far, int accept_default);
485 /* Relies on caller to gc-protect args */
487 keymap_lookup_directly(Lisp_Object keymap, Lisp_Object keysym, int modifiers)
492 ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3 |
493 XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5 | XEMACS_MOD_BUTTON6 |
494 XEMACS_MOD_BUTTON7 | XEMACS_MOD_BUTTON8 | XEMACS_MOD_BUTTON9 |
495 XEMACS_MOD_BUTTON10 | XEMACS_MOD_BUTTON11 | XEMACS_MOD_BUTTON12 |
496 XEMACS_MOD_BUTTON13 | XEMACS_MOD_BUTTON14 | XEMACS_MOD_BUTTON15 |
497 XEMACS_MOD_BUTTON16 | XEMACS_MOD_BUTTON17 | XEMACS_MOD_BUTTON18 |
498 XEMACS_MOD_BUTTON19 | XEMACS_MOD_BUTTON20 | XEMACS_MOD_BUTTON21 |
499 XEMACS_MOD_BUTTON22 | XEMACS_MOD_BUTTON23 | XEMACS_MOD_BUTTON24 |
500 XEMACS_MOD_BUTTON25 | XEMACS_MOD_BUTTON26);
502 ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER |
503 XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT))
509 /* If the keysym is a one-character symbol, use the char code instead. */
510 if (SYMBOLP(keysym) && string_char_length(XSYMBOL(keysym)->name) == 1) {
511 Lisp_Object i_fart_on_gcc =
512 make_char(string_char(XSYMBOL(keysym)->name, 0));
513 keysym = i_fart_on_gcc;
516 if (modifiers & XEMACS_MOD_META) { /* Utterly hateful ESC lossage */
518 Fgethash(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
523 modifiers &= ~XEMACS_MOD_META;
526 if (modifiers != 0) {
527 Lisp_Object submap = Fgethash(MAKE_MODIFIER_HASH_KEY(modifiers),
533 return Fgethash(keysym, k->table, Qnil);
537 keymap_store_inverse_internal(Lisp_Object inverse_table,
538 Lisp_Object keysym, Lisp_Object value)
540 Lisp_Object keys = Fgethash(value, inverse_table, Qunbound);
542 if (UNBOUNDP(keys)) {
544 /* Don't cons this unless necessary */
545 /* keys = Fcons (keysym, Qnil); */
546 Fputhash(value, keys, inverse_table);
547 } else if (!CONSP(keys)) {
548 /* Now it's necessary to cons */
549 keys = Fcons(keys, keysym);
550 Fputhash(value, keys, inverse_table);
552 while (CONSP(XCDR(keys)))
554 XCDR(keys) = Fcons(XCDR(keys), keysym);
555 /* No need to call puthash because we've destructively
556 modified the list tail in place */
561 keymap_delete_inverse_internal(Lisp_Object inverse_table,
562 Lisp_Object keysym, Lisp_Object value)
564 Lisp_Object keys = Fgethash(value, inverse_table, Qunbound);
565 Lisp_Object new_keys = keys;
572 for (prev = &new_keys, tail = new_keys;;
573 prev = &(XCDR(tail)), tail = XCDR(tail)) {
574 if (EQ(tail, keysym)) {
577 } else if (EQ(keysym, XCAR(tail))) {
584 Fremhash(value, inverse_table);
585 else if (!EQ(keys, new_keys))
586 /* Removed the first elt */
587 Fputhash(value, new_keys, inverse_table);
588 /* else the list's tail has been modified, so we don't need to
589 touch the hash table again (the pointer in there is ok).
593 /* Prevent luser from shooting herself in the foot using something like
594 (define-key ctl-x-4-map "p" global-map) */
596 check_keymap_definition_loop(Lisp_Object def, Lisp_Keymap * to_keymap)
598 def = get_keymap(def, 0, 0);
603 if (XKEYMAP(def) == to_keymap)
604 signal_simple_error("Cyclic keymap definition", def);
606 for (maps = keymap_submaps(def); CONSP(maps); maps = XCDR(maps))
607 check_keymap_definition_loop(XCDR(XCAR(maps)),
613 keymap_store_internal(Lisp_Object keysym, Lisp_Keymap * keymap, Lisp_Object def)
615 Lisp_Object prev_def = Fgethash(keysym, keymap->table, Qnil);
617 if (EQ(prev_def, def))
620 check_keymap_definition_loop(def, keymap);
623 keymap_delete_inverse_internal(keymap->inverse_table,
626 Fremhash(keysym, keymap->table);
628 Fputhash(keysym, def, keymap->table);
629 keymap_store_inverse_internal(keymap->inverse_table,
636 create_bucky_submap(Lisp_Keymap * k, int modifiers,
637 Lisp_Object parent_for_debugging_info)
639 Lisp_Object submap = Fmake_sparse_keymap(Qnil);
640 /* User won't see this, but it is nice for debugging Emacs */
641 XKEYMAP(submap)->name
642 = control_meta_superify(parent_for_debugging_info, modifiers);
643 /* Invalidate cache */
644 k->sub_maps_cache = Qt;
645 keymap_store_internal(MAKE_MODIFIER_HASH_KEY(modifiers), k, submap);
649 /* Relies on caller to gc-protect keymap, keysym, value */
651 keymap_store(Lisp_Object keymap, const struct key_data *key, Lisp_Object value)
653 Lisp_Object keysym = key->keysym;
654 int modifiers = key->modifiers;
655 Lisp_Keymap *k = XKEYMAP(keymap);
658 ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3 |
659 XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5 | XEMACS_MOD_BUTTON6 |
660 XEMACS_MOD_BUTTON7 | XEMACS_MOD_BUTTON8 | XEMACS_MOD_BUTTON9 |
661 XEMACS_MOD_BUTTON10 | XEMACS_MOD_BUTTON11 | XEMACS_MOD_BUTTON12 |
662 XEMACS_MOD_BUTTON13 | XEMACS_MOD_BUTTON14 | XEMACS_MOD_BUTTON15 |
663 XEMACS_MOD_BUTTON16 | XEMACS_MOD_BUTTON17 | XEMACS_MOD_BUTTON18 |
664 XEMACS_MOD_BUTTON19 | XEMACS_MOD_BUTTON20 | XEMACS_MOD_BUTTON21 |
665 XEMACS_MOD_BUTTON22 | XEMACS_MOD_BUTTON23 | XEMACS_MOD_BUTTON24 |
666 XEMACS_MOD_BUTTON25 | XEMACS_MOD_BUTTON26);
668 ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER |
669 XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0);
671 /* If the keysym is a one-character symbol, use the char code instead. */
672 if (SYMBOLP(keysym) && string_char_length(XSYMBOL(keysym)->name) == 1)
673 keysym = make_char(string_char(XSYMBOL(keysym)->name, 0));
675 if (modifiers & XEMACS_MOD_META) { /* Utterly hateful ESC lossage */
677 Fgethash(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
681 create_bucky_submap(k, XEMACS_MOD_META, keymap);
683 modifiers &= ~XEMACS_MOD_META;
686 if (modifiers != 0) {
687 Lisp_Object submap = Fgethash(MAKE_MODIFIER_HASH_KEY(modifiers),
690 submap = create_bucky_submap(k, modifiers, keymap);
693 k->sub_maps_cache = Qt; /* Invalidate cache */
694 keymap_store_internal(keysym, k, value);
697 /************************************************************************/
698 /* Listing the submaps of a keymap */
699 /************************************************************************/
701 struct keymap_submaps_closure {
702 Lisp_Object *result_locative;
706 keymap_submaps_mapper_0(Lisp_Object key, Lisp_Object value,
707 void *keymap_submaps_closure)
709 /* This function can GC */
710 /* Perform any autoloads, etc */
716 keymap_submaps_mapper(Lisp_Object key, Lisp_Object value,
717 void *keymap_submaps_closure)
719 /* This function can GC */
720 Lisp_Object *result_locative;
721 struct keymap_submaps_closure *cl =
722 (struct keymap_submaps_closure *)keymap_submaps_closure;
723 result_locative = cl->result_locative;
725 if (!NILP(Fkeymapp(value)))
726 *result_locative = Fcons(Fcons(key, value), *result_locative);
730 static int map_keymap_sort_predicate(Lisp_Object obj1, Lisp_Object obj2,
733 static Lisp_Object keymap_submaps(Lisp_Object keymap)
735 /* This function can GC */
736 Lisp_Keymap *k = XKEYMAP(keymap);
738 if (EQ(k->sub_maps_cache, Qt)) { /* Unknown */
739 Lisp_Object result = Qnil;
740 struct gcpro gcpro1, gcpro2;
741 struct keymap_submaps_closure keymap_submaps_closure;
743 GCPRO2(keymap, result);
744 keymap_submaps_closure.result_locative = &result;
745 /* Do this first pass to touch (and load) any autoloaded maps */
746 elisp_maphash(keymap_submaps_mapper_0, k->table,
747 &keymap_submaps_closure);
749 elisp_maphash(keymap_submaps_mapper, k->table,
750 &keymap_submaps_closure);
751 /* keep it sorted so that the result of accessible-keymaps is ordered */
752 k->sub_maps_cache = list_sort(result,
753 Qnil, map_keymap_sort_predicate);
756 return k->sub_maps_cache;
759 /************************************************************************/
760 /* Basic operations on keymaps */
761 /************************************************************************/
763 static Lisp_Object make_keymap(size_t size)
766 Lisp_Keymap *keymap = alloc_lcrecord_type(Lisp_Keymap, &lrecord_keymap);
768 XSETKEYMAP(result, keymap);
770 keymap->parents = Qnil;
771 keymap->prompt = Qnil;
772 keymap->table = Qnil;
773 keymap->inverse_table = Qnil;
774 keymap->default_binding = Qnil;
775 keymap->sub_maps_cache = Qnil; /* No possible submaps */
778 if (size != 0) { /* hack for copy-keymap */
780 make_lisp_hash_table(size, HASH_TABLE_NON_WEAK,
782 /* Inverse table is often less dense because of duplicate key-bindings.
783 If not, it will grow anyway. */
784 keymap->inverse_table =
785 make_lisp_hash_table(size * 3 / 4, HASH_TABLE_NON_WEAK,
791 DEFUN("make-keymap", Fmake_keymap, 0, 1, 0, /*
792 Construct and return a new keymap object.
793 All entries in it are nil, meaning "command undefined".
795 Optional argument NAME specifies a name to assign to the keymap,
796 as in `set-keymap-name'. This name is only a debugging convenience;
797 it is not used except when printing the keymap.
801 Lisp_Object keymap = make_keymap(60);
803 Fset_keymap_name(keymap, name);
807 DEFUN("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
808 Construct and return a new keymap object.
809 All entries in it are nil, meaning "command undefined". The only
810 difference between this function and `make-keymap' is that this function
811 returns a "smaller" keymap (one that is expected to contain fewer
812 entries). As keymaps dynamically resize, this distinction is not great.
814 Optional argument NAME specifies a name to assign to the keymap,
815 as in `set-keymap-name'. This name is only a debugging convenience;
816 it is not used except when printing the keymap.
820 Lisp_Object keymap = make_keymap(8);
822 Fset_keymap_name(keymap, name);
826 DEFUN("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
827 Return the `parent' keymaps of KEYMAP, or nil.
828 The parents of a keymap are searched for keybindings when a key sequence
829 isn't bound in this one. `(current-global-map)' is the default parent
834 keymap = get_keymap(keymap, 1, 1);
835 return Fcopy_sequence(XKEYMAP(keymap)->parents);
839 traverse_keymaps_noop(Lisp_Object SXE_UNUSED(keymap), void *SXE_UNUSED(arg))
844 DEFUN("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
845 Set the `parent' keymaps of KEYMAP to PARENTS.
846 The parents of a keymap are searched for keybindings when a key sequence
847 isn't bound in this one. `(current-global-map)' is the default parent
852 /* This function can GC */
854 struct gcpro gcpro1, gcpro2;
856 GCPRO2(keymap, parents);
857 keymap = get_keymap(keymap, 1, 1);
859 if (KEYMAPP(parents)) /* backwards-compatibility */
860 parents = list1(parents);
861 if (!NILP(parents)) {
862 Lisp_Object tail = parents;
863 while (!NILP(tail)) {
867 /* Require that it be an actual keymap object, rather than a symbol
868 with a (crockish) symbol-function which is a keymap */
869 CHECK_KEYMAP(k); /* get_keymap (k, 1, 1); */
874 /* Check for circularities */
875 traverse_keymaps(keymap, parents, traverse_keymaps_noop, 0);
877 XKEYMAP(keymap)->parents = Fcopy_sequence(parents);
882 DEFUN("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
883 Set the `name' of the KEYMAP to NEW-NAME.
884 The name is only a debugging convenience; it is not used except
885 when printing the keymap.
889 keymap = get_keymap(keymap, 1, 1);
891 XKEYMAP(keymap)->name = new_name;
895 DEFUN("keymap-name", Fkeymap_name, 1, 1, 0, /*
896 Return the `name' of KEYMAP.
897 The name is only a debugging convenience; it is not used except
898 when printing the keymap.
902 keymap = get_keymap(keymap, 1, 1);
904 return XKEYMAP(keymap)->name;
907 DEFUN("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
908 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
909 if no prompt is desired. The prompt is shown in the echo-area
910 when reading a key-sequence to be looked-up in this keymap.
912 (keymap, new_prompt))
914 keymap = get_keymap(keymap, 1, 1);
916 if (!NILP(new_prompt))
917 CHECK_STRING(new_prompt);
919 XKEYMAP(keymap)->prompt = new_prompt;
924 keymap_prompt_mapper(Lisp_Object keymap, void *SXE_UNUSED(arg))
926 return XKEYMAP(keymap)->prompt;
929 DEFUN("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
930 Return the `prompt' of KEYMAP.
931 If non-nil, the prompt is shown in the echo-area
932 when reading a key-sequence to be looked-up in this keymap.
934 (keymap, use_inherited))
936 /* This function can GC */
939 keymap = get_keymap(keymap, 1, 1);
940 prompt = XKEYMAP(keymap)->prompt;
941 if (!NILP(prompt) || NILP(use_inherited)) {
944 return traverse_keymaps(keymap, Qnil, keymap_prompt_mapper, 0);
948 DEFUN("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
949 Sets the default binding of KEYMAP to COMMAND, or `nil'
950 if no default is desired. The default-binding is returned when
951 no other binding for a key-sequence is found in the keymap.
952 If a keymap has a non-nil default-binding, neither the keymap's
953 parents nor the current global map are searched for key bindings.
957 /* This function can GC */
958 keymap = get_keymap(keymap, 1, 1);
960 XKEYMAP(keymap)->default_binding = command;
964 DEFUN("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
965 Return the default binding of KEYMAP, or `nil' if it has none.
966 The default-binding is returned when no other binding for a key-sequence
967 is found in the keymap.
968 If a keymap has a non-nil default-binding, neither the keymap's
969 parents nor the current global map are searched for key bindings.
973 /* This function can GC */
974 keymap = get_keymap(keymap, 1, 1);
975 return XKEYMAP(keymap)->default_binding;
978 DEFUN("keymapp", Fkeymapp, 1, 1, 0, /*
979 Return t if OBJECT is a keymap object.
980 The keymap may be autoloaded first if necessary.
984 /* This function can GC */
985 Lisp_Object tmp = get_keymap(object, 0, 0);
986 return KEYMAPP(tmp) ? Qt : Qnil;
989 /* Check that OBJECT is a keymap (after dereferencing through any
990 symbols). If it is, return it.
992 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
993 is an autoload form, do the autoload and try again.
994 If AUTOLOAD is nonzero, callers must assume GC is possible.
996 ERRORP controls how we respond if OBJECT isn't a keymap.
997 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
999 Note that most of the time, we don't want to pursue autoloads.
1000 Functions like Faccessible_keymaps which scan entire keymap trees
1001 shouldn't load every autoloaded keymap. I'm not sure about this,
1002 but it seems to me that only read_key_sequence, Flookup_key, and
1003 Fdefine_key should cause keymaps to be autoloaded. */
1005 Lisp_Object get_keymap(Lisp_Object object, int errorp, int autoload)
1007 /* This function can GC */
1009 Lisp_Object tem = indirect_function(object, 0);
1013 /* Should we do an autoload? */
1015 /* (autoload "filename" doc nil keymap) */
1018 && EQ(XCAR(tem), Qautoload)
1019 && EQ(Fcar(Fcdr(Fcdr(Fcdr(Fcdr(tem))))), Qkeymap)) {
1020 /* do_autoload GCPROs both arguments */
1021 do_autoload(tem, object);
1023 object = wrong_type_argument(Qkeymapp, object);
1029 /* Given OBJECT which was found in a slot in a keymap,
1030 trace indirect definitions to get the actual definition of that slot.
1031 An indirect definition is a list of the form
1032 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1033 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1035 static Lisp_Object get_keyelt(Lisp_Object object, int accept_default)
1037 /* This function can GC */
1045 struct gcpro gcpro1;
1048 map = get_keymap(map, 0, 1);
1051 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1053 Lisp_Object idx = Fcdr(object);
1054 struct key_data indirection;
1057 event.event_type = empty_event;
1058 character_to_event(XCHAR(idx), &event,
1059 XCONSOLE(Vselected_console), 0, 0);
1060 indirection = event.event.key;
1061 } else if (CONSP(idx)) {
1062 if (!INTP(XCDR(idx)))
1064 indirection.keysym = XCAR(idx);
1065 indirection.modifiers = (unsigned char)XINT(XCDR(idx));
1066 } else if (SYMBOLP(idx)) {
1067 indirection.keysym = idx;
1068 indirection.modifiers = 0;
1073 return raw_lookup_key(map, &indirection, 1, 0, accept_default);
1074 } else if (STRINGP(XCAR(object))) {
1075 /* If the keymap contents looks like (STRING . DEFN),
1077 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1078 will be used by HierarKey menus. */
1079 object = XCDR(object);
1082 /* Anything else is really the value. */
1088 keymap_lookup_1(Lisp_Object keymap, const struct key_data *key,
1091 /* This function can GC */
1092 return get_keyelt(keymap_lookup_directly(keymap,
1093 key->keysym, key->modifiers),
1097 /************************************************************************/
1098 /* Copying keymaps */
1099 /************************************************************************/
1101 struct copy_keymap_inverse_closure {
1102 Lisp_Object inverse_table;
1106 copy_keymap_inverse_mapper(Lisp_Object key, Lisp_Object value,
1107 void *copy_keymap_inverse_closure)
1109 struct copy_keymap_inverse_closure *closure =
1110 (struct copy_keymap_inverse_closure *)copy_keymap_inverse_closure;
1112 /* copy-sequence deals with dotted lists. */
1114 value = Fcopy_list(value);
1115 Fputhash(key, value, closure->inverse_table);
1120 static Lisp_Object copy_keymap_internal(Lisp_Keymap * keymap)
1122 Lisp_Object nkm = make_keymap(0);
1123 Lisp_Keymap *new_keymap = XKEYMAP(nkm);
1124 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1125 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1127 new_keymap->parents = Fcopy_sequence(keymap->parents);
1128 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1129 new_keymap->table = Fcopy_hash_table(keymap->table);
1130 new_keymap->inverse_table = Fcopy_hash_table(keymap->inverse_table);
1131 new_keymap->default_binding = keymap->default_binding;
1132 /* After copying the inverse map, we need to copy the conses which
1133 are its values, lest they be shared by the copy, and mangled.
1135 elisp_maphash(copy_keymap_inverse_mapper, keymap->inverse_table,
1136 ©_keymap_inverse_closure);
1140 static Lisp_Object copy_keymap(Lisp_Object keymap);
1142 struct copy_keymap_closure {
1147 copy_keymap_mapper(Lisp_Object key, Lisp_Object value,
1148 void *copy_keymap_closure)
1150 /* This function can GC */
1151 struct copy_keymap_closure *closure =
1152 (struct copy_keymap_closure *)copy_keymap_closure;
1154 /* When we encounter a keymap which is indirected through a
1155 symbol, we need to copy the sub-map. In v18, the form
1156 (lookup-key (copy-keymap global-map) "\C-x")
1157 returned a new keymap, not the symbol 'Control-X-prefix.
1159 value = get_keymap(value, 0, 1); /* #### autoload GC-safe here? */
1161 keymap_store_internal(key, closure->self, copy_keymap(value));
1165 static Lisp_Object copy_keymap(Lisp_Object keymap)
1167 /* This function can GC */
1168 struct copy_keymap_closure copy_keymap_closure;
1170 keymap = copy_keymap_internal(XKEYMAP(keymap));
1171 copy_keymap_closure.self = XKEYMAP(keymap);
1172 elisp_maphash(copy_keymap_mapper,
1173 XKEYMAP(keymap)->table, ©_keymap_closure);
1177 DEFUN("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1178 Return a copy of the keymap KEYMAP.
1179 The copy starts out with the same definitions of KEYMAP,
1180 but changing either the copy or KEYMAP does not affect the other.
1181 Any key definitions that are subkeymaps are recursively copied.
1185 /* This function can GC */
1186 keymap = get_keymap(keymap, 1, 1);
1187 return copy_keymap(keymap);
1190 static int keymap_fullness(Lisp_Object keymap)
1192 /* This function can GC */
1194 Lisp_Object sub_maps;
1195 struct gcpro gcpro1, gcpro2;
1197 keymap = get_keymap(keymap, 1, 1);
1198 fullness = XINT(Fhash_table_count(XKEYMAP(keymap)->table));
1199 GCPRO2(keymap, sub_maps);
1200 for (sub_maps = keymap_submaps(keymap);
1201 !NILP(sub_maps); sub_maps = XCDR(sub_maps)) {
1202 if (MODIFIER_HASH_KEY_BITS(XCAR(XCAR(sub_maps))) != 0) {
1203 Lisp_Object bucky_map = XCDR(XCAR(sub_maps));
1204 fullness--; /* don't count bucky maps themselves. */
1205 fullness += keymap_fullness(bucky_map);
1212 DEFUN("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1213 Return the number of bindings in the keymap.
1217 /* This function can GC */
1218 return make_int(keymap_fullness(get_keymap(keymap, 1, 1)));
1221 /************************************************************************/
1222 /* Defining keys in keymaps */
1223 /************************************************************************/
1225 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1226 and perform any necessary canonicalization. */
1229 define_key_check_and_coerce_keysym(Lisp_Object spec,
1230 Lisp_Object * keysym, int modifiers)
1232 /* Now, check and massage the trailing keysym specifier. */
1233 if (SYMBOLP(*keysym)) {
1234 if (string_char_length(XSYMBOL(*keysym)->name) == 1) {
1235 Lisp_Object ream_gcc_up_the_ass =
1236 make_char(string_char(XSYMBOL(*keysym)->name, 0));
1237 *keysym = ream_gcc_up_the_ass;
1240 } else if (CHAR_OR_CHAR_INTP(*keysym)) {
1241 CHECK_CHAR_COERCE_INT(*keysym);
1243 if (XCHAR(*keysym) < ' '
1244 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */ )
1245 /* yuck! Can't make the above restriction; too many compatibility
1247 signal_simple_error("keysym char must be printable",
1249 /* #### This bites! I want to be able to write (control shift a) */
1250 if (modifiers & XEMACS_MOD_SHIFT)
1252 ("The `shift' modifier may not be applied to ASCII keysyms",
1255 signal_simple_error("Unknown keysym specifier", *keysym);
1258 if (SYMBOLP(*keysym)) {
1259 char *name = (char *)string_data(XSYMBOL(*keysym)->name);
1261 /* FSFmacs uses symbols with the printed representation of keysyms in
1262 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1263 confusion, notice the M-x syntax and signal an error - because
1264 otherwise it would be interpreted as a regular keysym, and would even
1265 show up in the list-buffers output, causing confusion to the naive.
1267 We can get away with this because none of the X keysym names contain
1268 a hyphen (some contain underscore, however).
1270 It might be useful to reject keysyms which are not x-valid-keysym-
1271 name-p, but that would interfere with various tricks we do to
1272 sanitize the Sun keyboards, and would make it trickier to
1273 conditionalize a .emacs file for multiple X servers.
1275 if (((int)strlen(name) >= 2 && name[1] == '-')
1278 /* Ok, this is a bit more dubious - prevent people from doing things
1279 like (global-set-key 'RET 'something) because that will have the
1280 same problem as above. (Gag!) Maybe we should just silently
1281 accept these as aliases for the "real" names?
1283 (string_length(XSYMBOL(*keysym)->name) <= 3 &&
1284 (!strcmp(name, "LFD") ||
1285 !strcmp(name, "TAB") ||
1286 !strcmp(name, "RET") ||
1287 !strcmp(name, "ESC") ||
1288 !strcmp(name, "DEL") ||
1289 !strcmp(name, "SPC") || !strcmp(name, "BS")))
1293 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1296 /* #### Ok, this is a bit more dubious - make people not lose if they
1297 do things like (global-set-key 'RET 'something) because that would
1298 otherwise have the same problem as above. (Gag!) We silently
1299 accept these as aliases for the "real" names.
1301 else if (!strncmp(name, "kp_", 3)) {
1302 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1305 strncpy(temp, name, sizeof(temp));
1306 temp[sizeof(temp) - 1] = '\0';
1308 *keysym = Fintern_soft(make_string((Bufbyte *) temp,
1309 strlen(temp)), Qnil);
1310 } else if (EQ(*keysym, QLFD))
1311 *keysym = QKlinefeed;
1312 else if (EQ(*keysym, QTAB))
1314 else if (EQ(*keysym, QRET))
1316 else if (EQ(*keysym, QESC))
1318 else if (EQ(*keysym, QDEL))
1320 else if (EQ(*keysym, QSPC))
1322 else if (EQ(*keysym, QBS))
1323 *keysym = QKbackspace;
1324 /* Emacs compatibility */
1325 else if (EQ(*keysym, Qdown_mouse_1))
1327 else if (EQ(*keysym, Qdown_mouse_2))
1329 else if (EQ(*keysym, Qdown_mouse_3))
1331 else if (EQ(*keysym, Qdown_mouse_4))
1333 else if (EQ(*keysym, Qdown_mouse_5))
1335 else if (EQ(*keysym, Qdown_mouse_6))
1337 else if (EQ(*keysym, Qdown_mouse_7))
1339 else if (EQ(*keysym, Qdown_mouse_8))
1341 else if (EQ(*keysym, Qdown_mouse_9))
1343 else if (EQ(*keysym, Qdown_mouse_10))
1344 *keysym = Qbutton10;
1345 else if (EQ(*keysym, Qdown_mouse_11))
1346 *keysym = Qbutton11;
1347 else if (EQ(*keysym, Qdown_mouse_12))
1348 *keysym = Qbutton12;
1349 else if (EQ(*keysym, Qdown_mouse_13))
1350 *keysym = Qbutton13;
1351 else if (EQ(*keysym, Qdown_mouse_14))
1352 *keysym = Qbutton14;
1353 else if (EQ(*keysym, Qdown_mouse_15))
1354 *keysym = Qbutton15;
1355 else if (EQ(*keysym, Qdown_mouse_16))
1356 *keysym = Qbutton16;
1357 else if (EQ(*keysym, Qdown_mouse_17))
1358 *keysym = Qbutton17;
1359 else if (EQ(*keysym, Qdown_mouse_18))
1360 *keysym = Qbutton18;
1361 else if (EQ(*keysym, Qdown_mouse_19))
1362 *keysym = Qbutton19;
1363 else if (EQ(*keysym, Qdown_mouse_20))
1364 *keysym = Qbutton20;
1365 else if (EQ(*keysym, Qdown_mouse_21))
1366 *keysym = Qbutton21;
1367 else if (EQ(*keysym, Qdown_mouse_22))
1368 *keysym = Qbutton22;
1369 else if (EQ(*keysym, Qdown_mouse_23))
1370 *keysym = Qbutton23;
1371 else if (EQ(*keysym, Qdown_mouse_24))
1372 *keysym = Qbutton24;
1373 else if (EQ(*keysym, Qdown_mouse_25))
1374 *keysym = Qbutton25;
1375 else if (EQ(*keysym, Qdown_mouse_26))
1376 *keysym = Qbutton26;
1377 else if (EQ(*keysym, Qdown_mouse_27))
1378 *keysym = Qbutton27;
1379 else if (EQ(*keysym, Qdown_mouse_28))
1380 *keysym = Qbutton28;
1381 else if (EQ(*keysym, Qdown_mouse_29))
1382 *keysym = Qbutton29;
1383 else if (EQ(*keysym, Qdown_mouse_30))
1384 *keysym = Qbutton30;
1385 else if (EQ(*keysym, Qdown_mouse_31))
1386 *keysym = Qbutton31;
1387 else if (EQ(*keysym, Qdown_mouse_32))
1388 *keysym = Qbutton32;
1389 else if (EQ(*keysym, Qmouse_1))
1390 *keysym = Qbutton1up;
1391 else if (EQ(*keysym, Qmouse_2))
1392 *keysym = Qbutton2up;
1393 else if (EQ(*keysym, Qmouse_3))
1394 *keysym = Qbutton3up;
1395 else if (EQ(*keysym, Qmouse_4))
1396 *keysym = Qbutton4up;
1397 else if (EQ(*keysym, Qmouse_5))
1398 *keysym = Qbutton5up;
1399 else if (EQ(*keysym, Qmouse_6))
1400 *keysym = Qbutton6up;
1401 else if (EQ(*keysym, Qmouse_7))
1402 *keysym = Qbutton7up;
1403 else if (EQ(*keysym, Qmouse_8))
1404 *keysym = Qbutton8up;
1405 else if (EQ(*keysym, Qmouse_9))
1406 *keysym = Qbutton9up;
1407 else if (EQ(*keysym, Qmouse_10))
1408 *keysym = Qbutton10up;
1409 else if (EQ(*keysym, Qmouse_11))
1410 *keysym = Qbutton11up;
1411 else if (EQ(*keysym, Qmouse_12))
1412 *keysym = Qbutton12up;
1413 else if (EQ(*keysym, Qmouse_13))
1414 *keysym = Qbutton13up;
1415 else if (EQ(*keysym, Qmouse_14))
1416 *keysym = Qbutton14up;
1417 else if (EQ(*keysym, Qmouse_15))
1418 *keysym = Qbutton15up;
1419 else if (EQ(*keysym, Qmouse_16))
1420 *keysym = Qbutton16up;
1421 else if (EQ(*keysym, Qmouse_17))
1422 *keysym = Qbutton17up;
1423 else if (EQ(*keysym, Qmouse_18))
1424 *keysym = Qbutton18up;
1425 else if (EQ(*keysym, Qmouse_19))
1426 *keysym = Qbutton19up;
1427 else if (EQ(*keysym, Qmouse_20))
1428 *keysym = Qbutton20up;
1429 else if (EQ(*keysym, Qmouse_21))
1430 *keysym = Qbutton21up;
1431 else if (EQ(*keysym, Qmouse_22))
1432 *keysym = Qbutton22up;
1433 else if (EQ(*keysym, Qmouse_23))
1434 *keysym = Qbutton23up;
1435 else if (EQ(*keysym, Qmouse_24))
1436 *keysym = Qbutton24up;
1437 else if (EQ(*keysym, Qmouse_25))
1438 *keysym = Qbutton25up;
1439 else if (EQ(*keysym, Qmouse_26))
1440 *keysym = Qbutton26up;
1441 else if (EQ(*keysym, Qmouse_27))
1442 *keysym = Qbutton27up;
1443 else if (EQ(*keysym, Qmouse_28))
1444 *keysym = Qbutton28up;
1445 else if (EQ(*keysym, Qmouse_29))
1446 *keysym = Qbutton29up;
1447 else if (EQ(*keysym, Qmouse_30))
1448 *keysym = Qbutton30up;
1449 else if (EQ(*keysym, Qmouse_31))
1450 *keysym = Qbutton31up;
1451 else if (EQ(*keysym, Qmouse_32))
1452 *keysym = Qbutton32up;
1456 /* Given any kind of key-specifier, return a keysym and modifier mask.
1457 Proper canonicalization is performed:
1459 -- integers are converted into the equivalent characters.
1460 -- one-character strings are converted into the equivalent characters.
1463 static void define_key_parser(Lisp_Object spec, struct key_data *returned_value)
1465 if (CHAR_OR_CHAR_INTP(spec)) {
1467 event.event_type = empty_event;
1468 character_to_event(XCHAR_OR_CHAR_INT(spec), &event,
1469 XCONSOLE(Vselected_console), 0, 0);
1470 returned_value->keysym = event.event.key.keysym;
1471 returned_value->modifiers = event.event.key.modifiers;
1472 } else if (EVENTP(spec)) {
1473 switch (XEVENT(spec)->event_type) {
1474 case key_press_event: {
1475 returned_value->keysym =
1476 XEVENT(spec)->event.key.keysym;
1477 returned_value->modifiers =
1478 XEVENT(spec)->event.key.modifiers;
1481 case button_press_event:
1482 case button_release_event: {
1483 int down = (XEVENT(spec)->event_type ==
1484 button_press_event);
1485 switch (XEVENT(spec)->event.button.button) {
1487 returned_value->keysym =
1488 (down ? Qbutton1 : Qbutton1up);
1491 returned_value->keysym =
1492 (down ? Qbutton2 : Qbutton2up);
1495 returned_value->keysym =
1496 (down ? Qbutton3 : Qbutton3up);
1499 returned_value->keysym =
1500 (down ? Qbutton4 : Qbutton4up);
1503 returned_value->keysym =
1504 (down ? Qbutton5 : Qbutton5up);
1507 returned_value->keysym =
1508 (down ? Qbutton6 : Qbutton6up);
1511 returned_value->keysym =
1512 (down ? Qbutton7 : Qbutton7up);
1515 returned_value->keysym =
1516 (down ? Qbutton8 : Qbutton8up);
1519 returned_value->keysym =
1520 (down ? Qbutton9 : Qbutton9up);
1523 returned_value->keysym =
1524 (down ? Qbutton10 : Qbutton10up);
1527 returned_value->keysym =
1528 (down ? Qbutton11 : Qbutton11up);
1531 returned_value->keysym =
1532 (down ? Qbutton12 : Qbutton12up);
1535 returned_value->keysym =
1536 (down ? Qbutton13 : Qbutton13up);
1539 returned_value->keysym =
1540 (down ? Qbutton14 : Qbutton14up);
1543 returned_value->keysym =
1544 (down ? Qbutton15 : Qbutton15up);
1547 returned_value->keysym =
1548 (down ? Qbutton16 : Qbutton16up);
1551 returned_value->keysym =
1552 (down ? Qbutton17 : Qbutton17up);
1555 returned_value->keysym =
1556 (down ? Qbutton18 : Qbutton18up);
1559 returned_value->keysym =
1560 (down ? Qbutton19 : Qbutton19up);
1563 returned_value->keysym =
1564 (down ? Qbutton20 : Qbutton20up);
1567 returned_value->keysym =
1568 (down ? Qbutton21 : Qbutton21up);
1571 returned_value->keysym =
1572 (down ? Qbutton22 : Qbutton22up);
1575 returned_value->keysym =
1576 (down ? Qbutton23 : Qbutton23up);
1579 returned_value->keysym =
1580 (down ? Qbutton24 : Qbutton24up);
1583 returned_value->keysym =
1584 (down ? Qbutton25 : Qbutton25up);
1587 returned_value->keysym =
1588 (down ? Qbutton26 : Qbutton26up);
1591 returned_value->keysym =
1592 (down ? Qbutton27 : Qbutton27up);
1595 returned_value->keysym =
1596 (down ? Qbutton28 : Qbutton28up);
1599 returned_value->keysym =
1600 (down ? Qbutton29 : Qbutton29up);
1603 returned_value->keysym =
1604 (down ? Qbutton30 : Qbutton30up);
1607 returned_value->keysym =
1608 (down ? Qbutton31 : Qbutton31up);
1611 returned_value->keysym =
1612 (down ? Qbutton32 : Qbutton32up);
1615 returned_value->keysym =
1616 (down ? Qbutton0 : Qbutton0up);
1619 returned_value->modifiers =
1620 XEVENT(spec)->event.button.modifiers;
1625 case pointer_motion_event:
1629 case magic_eval_event:
1631 case misc_user_event:
1632 #ifdef EF_USE_ASYNEQ
1633 case eaten_myself_event:
1634 case work_started_event:
1635 case work_finished_event:
1636 #endif /* EF_USE_ASYNEQ */
1639 signal_error(Qwrong_type_argument,
1640 list2(build_translated_string(
1641 "unable to bind this "
1642 "type of event"), spec));
1644 } else if (SYMBOLP(spec)) {
1645 /* Be nice, allow = to mean (=) */
1646 if (bucky_sym_to_bucky_bit(spec) != 0)
1647 signal_simple_error("Key is a modifier name", spec);
1648 define_key_check_and_coerce_keysym(spec, &spec, 0);
1649 returned_value->keysym = spec;
1650 returned_value->modifiers = 0;
1651 } else if (CONSP(spec)) {
1653 Lisp_Object keysym = Qnil;
1654 Lisp_Object rest = spec;
1656 /* First, parse out the leading modifier symbols. */
1657 while (CONSP(rest)) {
1660 keysym = XCAR(rest);
1661 modifier = bucky_sym_to_bucky_bit(keysym);
1662 modifiers |= modifier;
1663 if (!NILP(XCDR(rest))) {
1665 signal_simple_error("Unknown modifier",
1670 ("Nothing but modifiers here",
1677 signal_simple_error("List must be nil-terminated",
1680 define_key_check_and_coerce_keysym(spec, &keysym, modifiers);
1681 returned_value->keysym = keysym;
1682 returned_value->modifiers = modifiers;
1684 signal_simple_error("Unknown key-sequence specifier", spec);
1688 /* Used by character-to-event */
1690 key_desc_list_to_event(Lisp_Object list, Lisp_Object event,
1691 int allow_menu_events)
1693 struct key_data raw_key;
1695 if (allow_menu_events && CONSP(list) &&
1696 /* #### where the hell does this come from? */
1697 EQ(XCAR(list), Qmenu_selection)) {
1698 Lisp_Object fn, arg;
1699 if (!NILP(Fcdr(Fcdr(list))))
1700 signal_simple_error("Invalid menu event desc", list);
1701 arg = Fcar(Fcdr(list));
1703 fn = Qcall_interactively;
1706 XSETFRAME(XEVENT(event)->channel, selected_frame());
1707 XEVENT(event)->event_type = misc_user_event;
1708 XEVENT(event)->event.eval.function = fn;
1709 XEVENT(event)->event.eval.object = arg;
1713 define_key_parser(list, &raw_key);
1715 if (EQ(raw_key.keysym, Qbutton0) || EQ(raw_key.keysym, Qbutton0up) ||
1716 EQ(raw_key.keysym, Qbutton1) || EQ(raw_key.keysym, Qbutton1up) ||
1717 EQ(raw_key.keysym, Qbutton2) || EQ(raw_key.keysym, Qbutton2up) ||
1718 EQ(raw_key.keysym, Qbutton3) || EQ(raw_key.keysym, Qbutton3up) ||
1719 EQ(raw_key.keysym, Qbutton4) || EQ(raw_key.keysym, Qbutton4up) ||
1720 EQ(raw_key.keysym, Qbutton5) || EQ(raw_key.keysym, Qbutton5up) ||
1721 EQ(raw_key.keysym, Qbutton6) || EQ(raw_key.keysym, Qbutton6up) ||
1722 EQ(raw_key.keysym, Qbutton7) || EQ(raw_key.keysym, Qbutton7up) ||
1723 EQ(raw_key.keysym, Qbutton8) || EQ(raw_key.keysym, Qbutton8up) ||
1724 EQ(raw_key.keysym, Qbutton9) || EQ(raw_key.keysym, Qbutton9up) ||
1725 EQ(raw_key.keysym, Qbutton10) || EQ(raw_key.keysym, Qbutton10up) ||
1726 EQ(raw_key.keysym, Qbutton11) || EQ(raw_key.keysym, Qbutton11up) ||
1727 EQ(raw_key.keysym, Qbutton12) || EQ(raw_key.keysym, Qbutton12up) ||
1728 EQ(raw_key.keysym, Qbutton13) || EQ(raw_key.keysym, Qbutton13up) ||
1729 EQ(raw_key.keysym, Qbutton14) || EQ(raw_key.keysym, Qbutton14up) ||
1730 EQ(raw_key.keysym, Qbutton15) || EQ(raw_key.keysym, Qbutton15up) ||
1731 EQ(raw_key.keysym, Qbutton16) || EQ(raw_key.keysym, Qbutton16up) ||
1732 EQ(raw_key.keysym, Qbutton17) || EQ(raw_key.keysym, Qbutton17up) ||
1733 EQ(raw_key.keysym, Qbutton18) || EQ(raw_key.keysym, Qbutton18up) ||
1734 EQ(raw_key.keysym, Qbutton19) || EQ(raw_key.keysym, Qbutton19up) ||
1735 EQ(raw_key.keysym, Qbutton20) || EQ(raw_key.keysym, Qbutton20up) ||
1736 EQ(raw_key.keysym, Qbutton21) || EQ(raw_key.keysym, Qbutton21up) ||
1737 EQ(raw_key.keysym, Qbutton22) || EQ(raw_key.keysym, Qbutton22up) ||
1738 EQ(raw_key.keysym, Qbutton23) || EQ(raw_key.keysym, Qbutton23up) ||
1739 EQ(raw_key.keysym, Qbutton24) || EQ(raw_key.keysym, Qbutton24up) ||
1740 EQ(raw_key.keysym, Qbutton25) || EQ(raw_key.keysym, Qbutton25up) ||
1741 EQ(raw_key.keysym, Qbutton26) || EQ(raw_key.keysym, Qbutton26up) ||
1742 EQ(raw_key.keysym, Qbutton27) || EQ(raw_key.keysym, Qbutton27up) ||
1743 EQ(raw_key.keysym, Qbutton28) || EQ(raw_key.keysym, Qbutton28up) ||
1744 EQ(raw_key.keysym, Qbutton29) || EQ(raw_key.keysym, Qbutton29up) ||
1745 EQ(raw_key.keysym, Qbutton30) || EQ(raw_key.keysym, Qbutton30up) ||
1746 EQ(raw_key.keysym, Qbutton31) || EQ(raw_key.keysym, Qbutton31up) ||
1747 EQ(raw_key.keysym, Qbutton32) || EQ(raw_key.keysym, Qbutton32up))
1748 error("Mouse-clicks can't appear in saved keyboard macros.");
1750 XEVENT(event)->channel = Vselected_console;
1751 XEVENT(event)->event_type = key_press_event;
1752 XEVENT(event)->event.key.keysym = raw_key.keysym;
1753 XEVENT(event)->event.key.modifiers = raw_key.modifiers;
1756 int event_matches_key_specifier_p(Lisp_Event * event, Lisp_Object key_specifier)
1758 Lisp_Object event2 = Qnil;
1760 struct gcpro gcpro1;
1762 if (event->event_type != key_press_event || NILP(key_specifier) ||
1763 (INTP(key_specifier) && !CHAR_INTP(key_specifier)))
1766 /* if the specifier is an integer such as 27, then it should match
1767 both of the events 'escape' and 'control ['. Calling
1768 Fcharacter_to_event() will only match 'escape'. */
1769 if (CHAR_OR_CHAR_INTP(key_specifier))
1770 return (XCHAR_OR_CHAR_INT(key_specifier)
1771 == event_to_character(event, 0, 0, 0));
1773 /* Otherwise, we cannot call event_to_character() because we may
1774 be dealing with non-ASCII keystrokes. In any case, if I ask
1775 for 'control [' then I should get exactly that, and not
1778 However, we have to behave differently on TTY's, where 'control ['
1779 is silently converted into 'escape' by the keyboard driver.
1780 In this case, ASCII is the only thing we know about, so we have
1781 to compare the ASCII values. */
1784 event2 = Fmake_event(Qnil, Qnil);
1785 Fcharacter_to_event(key_specifier, event2, Qnil, Qnil);
1786 if (XEVENT(event2)->event_type != key_press_event)
1788 else if (CONSOLE_TTY_P(XCONSOLE(EVENT_CHANNEL(event)))) {
1791 ch1 = event_to_character(event, 0, 0, 0);
1792 ch2 = event_to_character(XEVENT(event2), 0, 0, 0);
1793 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1794 } else if (EQ(event->event.key.keysym, XEVENT(event2)->event.key.keysym)
1795 && event->event.key.modifiers ==
1796 XEVENT(event2)->event.key.modifiers)
1800 Fdeallocate_event(event2);
1805 static int meta_prefix_char_p(const struct key_data *key)
1809 event.event_type = key_press_event;
1810 event.channel = Vselected_console;
1811 event.event.key.keysym = key->keysym;
1812 event.event.key.modifiers = key->modifiers;
1813 return event_matches_key_specifier_p(&event, Vmeta_prefix_char);
1816 DEFUN("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1817 Return non-nil if EVENT matches KEY-SPECIFIER.
1818 This can be useful, e.g., to determine if the user pressed `help-char' or
1821 (event, key_specifier))
1823 CHECK_LIVE_EVENT(event);
1824 return (event_matches_key_specifier_p(XEVENT(event), key_specifier)
1828 #define MACROLET(k,m) do { \
1829 returned_value->keysym = (k); \
1830 returned_value->modifiers = (m); \
1831 RETURN_SANS_WARNINGS; \
1835 Given a keysym, return another keysym/modifier pair which could be
1836 considered the same key in an ASCII world. Backspace returns ^H, for
1840 define_key_alternate_name(struct key_data *key, struct key_data *returned_value)
1842 Lisp_Object keysym = key->keysym;
1843 int modifiers = key->modifiers;
1844 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL));
1845 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META));
1846 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1847 returned_value->modifiers = 0;
1848 if (modifiers_sans_meta == XEMACS_MOD_CONTROL) {
1849 if (EQ(keysym, QKspace))
1850 MACROLET(make_char('@'), modifiers);
1851 else if (!CHARP(keysym))
1854 switch (XCHAR(keysym)) {
1855 case '@': /* c-@ => c-space */
1856 MACROLET(QKspace, modifiers);
1857 case 'h': /* c-h => backspace */
1858 MACROLET(QKbackspace, modifiers_sans_control);
1859 case 'i': /* c-i => tab */
1860 MACROLET(QKtab, modifiers_sans_control);
1861 case 'j': /* c-j => linefeed */
1862 MACROLET(QKlinefeed, modifiers_sans_control);
1863 case 'm': /* c-m => return */
1864 MACROLET(QKreturn, modifiers_sans_control);
1865 case '[': /* c-[ => escape */
1866 MACROLET(QKescape, modifiers_sans_control);
1870 } else if (modifiers_sans_meta != 0)
1872 else if (EQ(keysym, QKbackspace)) /* backspace => c-h */
1873 MACROLET(make_char('h'), (modifiers | XEMACS_MOD_CONTROL));
1874 else if (EQ(keysym, QKtab)) /* tab => c-i */
1875 MACROLET(make_char('i'), (modifiers | XEMACS_MOD_CONTROL));
1876 else if (EQ(keysym, QKlinefeed)) /* linefeed => c-j */
1877 MACROLET(make_char('j'), (modifiers | XEMACS_MOD_CONTROL));
1878 else if (EQ(keysym, QKreturn)) /* return => c-m */
1879 MACROLET(make_char('m'), (modifiers | XEMACS_MOD_CONTROL));
1880 else if (EQ(keysym, QKescape)) /* escape => c-[ */
1881 MACROLET(make_char('['), (modifiers | XEMACS_MOD_CONTROL));
1888 ensure_meta_prefix_char_keymapp(Lisp_Object keys, int indx, Lisp_Object keymap)
1890 /* This function can GC */
1891 Lisp_Object new_keys;
1893 Lisp_Object mpc_binding;
1894 struct key_data meta_key;
1896 if (NILP(Vmeta_prefix_char) ||
1897 (INTP(Vmeta_prefix_char) && !CHAR_INTP(Vmeta_prefix_char)))
1900 define_key_parser(Vmeta_prefix_char, &meta_key);
1901 mpc_binding = keymap_lookup_1(keymap, &meta_key, 0);
1902 if (NILP(mpc_binding) || !NILP(Fkeymapp(mpc_binding)))
1907 else if (STRINGP(keys))
1908 new_keys = Fsubstring(keys, Qzero, make_int(indx));
1909 else if (VECTORP(keys)) {
1910 new_keys = make_vector(indx, Qnil);
1911 for (i = 0; i < indx; i++)
1912 XVECTOR_DATA(new_keys)[i] = XVECTOR_DATA(keys)[i];
1918 if (EQ(keys, new_keys)) {
1919 Lisp_Object tmp1 = Fkey_description(keys);
1920 Lisp_Object tmp2 = Fsingle_key_description(Vmeta_prefix_char);
1921 error_with_frob(mpc_binding,
1922 "can't bind %s: %s has a non-keymap binding",
1923 (char *)XSTRING_DATA(tmp1),
1924 (char *)XSTRING_DATA(tmp2));
1926 Lisp_Object tmp1 = Fkey_description(keys);
1927 Lisp_Object tmp2 = Fkey_description(new_keys);
1928 Lisp_Object tmp3 = Fsingle_key_description(Vmeta_prefix_char);
1929 error_with_frob(mpc_binding,
1930 "can't bind %s: %s %s has a non-keymap binding",
1931 (char *)XSTRING_DATA(tmp1),
1932 (char *)XSTRING_DATA(tmp2),
1933 (char *)XSTRING_DATA(tmp3));
1937 DEFUN("define-key", Fdefine_key, 3, 3, 0, /*
1938 Define key sequence KEYS, in KEYMAP, as DEF.
1939 KEYMAP is a keymap object.
1940 KEYS is the sequence of keystrokes to bind, described below.
1941 DEF is anything that can be a key's definition:
1942 nil (means key is undefined in this keymap);
1943 a command (a Lisp function suitable for interactive calling);
1944 a string or key sequence vector (treated as a keyboard macro);
1945 a keymap (to define a prefix key);
1946 a symbol; when the key is looked up, the symbol will stand for its
1947 function definition, that should at that time be one of the above,
1948 or another symbol whose function definition is used, and so on.
1949 a cons (STRING . DEFN), meaning that DEFN is the definition
1950 (DEFN should be a valid definition in its own right);
1951 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1953 Contrary to popular belief, the world is not ASCII. When running under a
1954 window manager, SXEmacs can tell the difference between, for example, the
1955 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1956 bind different commands to each of these.
1958 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1959 set of modifiers (such as control and meta). A `keysym' is what is printed
1960 on the keys on your keyboard.
1962 A keysym may be represented by a symbol, or (if and only if it is equivalent
1963 to an ASCII character in the range 32 - 255) by a character or its equivalent
1964 ASCII code. The `A' key may be represented by the symbol `A', the character
1965 `?A', or by the number 65. The `break' key may be represented only by the
1968 A keystroke may be represented by a list: the last element of the list
1969 is the key (a symbol, character, or number, as above) and the
1970 preceding elements are the symbolic names of modifier keys (control,
1971 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1972 represented by the forms `(control b)', `(control ?b)', and `(control
1973 98)'. A keystroke may also be represented by an event object, as
1974 returned by the `next-command-event' and `read-key-sequence'
1977 Note that in this context, the keystroke `control-b' is *not* represented
1978 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1980 The `shift' modifier is somewhat of a special case. You should not (and
1981 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1982 have ASCII equivalents, the state of the shift key is implicit in the
1983 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1984 sort of thing varies from keyboard to keyboard. The shift modifier is for
1985 use only with characters that do not have a second keysym on the same key,
1986 such as `backspace' and `tab'.
1988 A key sequence is a vector of keystrokes. As a degenerate case, elements
1989 of this vector may also be keysyms if they have no modifiers. That is,
1990 the `A' keystroke is represented by all of these forms:
1991 A ?A 65 (A) (?A) (65)
1992 [A] [?A] [65] [(A)] [(?A)] [(65)]
1994 the `control-a' keystroke is represented by these forms:
1995 (control A) (control ?A) (control 65)
1996 [(control A)] [(control ?A)] [(control 65)]
1997 the key sequence `control-c control-a' is represented by these forms:
1998 [(control c) (control a)] [(control ?c) (control ?a)]
1999 [(control 99) (control 65)] etc.
2001 Mouse button clicks work just like keypresses: (control button1) means
2002 pressing the left mouse button while holding down the control key.
2003 \[(control c) (shift button3)] means control-c, hold shift, click right.
2005 Commands may be bound to the mouse-button up-stroke rather than the down-
2006 stroke as well. `button1' means the down-stroke, and `button1up' means the
2007 up-stroke. Different commands may be bound to the up and down strokes,
2008 though that is probably not what you want, so be careful.
2010 For backward compatibility, a key sequence may also be represented by a
2011 string. In this case, it represents the key sequence(s) that would
2012 produce that sequence of ASCII characters in a purely ASCII world. For
2013 example, a string containing the ASCII backspace character, "\\^H", would
2014 represent two key sequences: `(control h)' and `backspace'. Binding a
2015 command to this will actually bind both of those key sequences. Likewise
2016 for the following pairs:
2023 control @ control space
2025 After binding a command to two key sequences with a form like
2027 (define-key global-map "\\^X\\^I" \'command-1)
2029 it is possible to redefine only one of those sequences like so:
2031 (define-key global-map [(control x) (control i)] \'command-2)
2032 (define-key global-map [(control x) tab] \'command-3)
2034 Of course, all of this applies only when running under a window system. If
2035 you're talking to SXEmacs through a TTY connection, you don't get any of
2038 (keymap, keys, def))
2040 /* This function can GC */
2045 struct gcpro gcpro1, gcpro2, gcpro3;
2048 len = XVECTOR_LENGTH(keys);
2049 else if (STRINGP(keys))
2050 len = XSTRING_CHAR_LENGTH(keys);
2051 else if (CHAR_OR_CHAR_INTP(keys) || SYMBOLP(keys) || CONSP(keys)) {
2055 keys = make_vector(1, keys); /* this is kinda sleazy. */
2057 keys = wrong_type_argument(Qsequencep, keys);
2058 len = XINT(Flength(keys));
2063 GCPRO3(keymap, keys, def);
2066 When the user defines a key which, in a strictly ASCII world, would be
2067 produced by two different keys (^J and linefeed, or ^H and backspace,
2068 for example) then the binding will be made for both keysyms.
2070 This is done if the user binds a command to a string, as in
2071 (define-key map "\^H" 'something), but not when using one of the new
2072 syntaxes, like (define-key map '(control h) 'something).
2074 ascii_hack = (STRINGP(keys));
2076 keymap = get_keymap(keymap, 1, 1);
2081 struct key_data raw_key1;
2082 struct key_data raw_key2;
2085 c = make_char(string_char(XSTRING(keys), idx));
2087 c = XVECTOR_DATA(keys)[idx];
2089 define_key_parser(c, &raw_key1);
2091 if (!metized && ascii_hack && meta_prefix_char_p(&raw_key1)) {
2092 if (idx == (len - 1)) {
2093 /* This is a hack to prevent a binding for the meta-prefix-char
2094 from being made in a map which already has a non-empty "meta"
2095 submap. That is, we can't let both "escape" and "meta" have
2096 a binding in the same keymap. This implies that the idiom
2097 (define-key my-map "\e" my-escape-map)
2098 (define-key my-escape-map "a" 'my-command)
2099 no longer works. That's ok. Instead the luser should do
2100 (define-key my-map "\ea" 'my-command)
2102 (define-key my-map "\M-a" 'my-command)
2104 (defvar my-escape-map (lookup-key my-map "\e"))
2105 if the luser really wants the map in a variable.
2107 Lisp_Object meta_map;
2108 struct gcpro ngcpro1;
2112 Fgethash(MAKE_MODIFIER_HASH_KEY
2114 XKEYMAP(keymap)->table, Qnil);
2116 && keymap_fullness(meta_map) != 0)
2117 signal_simple_error_2
2118 ("Map contains meta-bindings, can't bind",
2119 Fsingle_key_description
2120 (Vmeta_prefix_char), keymap);
2130 define_key_alternate_name(&raw_key1, &raw_key2);
2132 raw_key2.keysym = Qnil;
2133 raw_key2.modifiers = 0;
2137 raw_key1.modifiers |= XEMACS_MOD_META;
2138 raw_key2.modifiers |= XEMACS_MOD_META;
2142 /* This crap is to make sure that someone doesn't bind something like
2143 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
2144 if (raw_key1.modifiers & XEMACS_MOD_META)
2145 ensure_meta_prefix_char_keymapp(keys, idx, keymap);
2148 keymap_store(keymap, &raw_key1, def);
2149 if (ascii_hack && !NILP(raw_key2.keysym))
2150 keymap_store(keymap, &raw_key2, def);
2157 struct gcpro ngcpro1;
2160 cmd = keymap_lookup_1(keymap, &raw_key1, 0);
2162 cmd = Fmake_sparse_keymap(Qnil);
2163 XKEYMAP(cmd)->name /* for debugging */
2164 = list2(make_key_description(&raw_key1, 1),
2166 keymap_store(keymap, &raw_key1, cmd);
2168 if (NILP(Fkeymapp(cmd)))
2169 signal_simple_error_2
2170 ("Invalid prefix keys in sequence", c,
2173 if (ascii_hack && !NILP(raw_key2.keysym) &&
2174 NILP(keymap_lookup_1(keymap, &raw_key2, 0)))
2175 keymap_store(keymap, &raw_key2, cmd);
2177 keymap = get_keymap(cmd, 1, 1);
2183 /************************************************************************/
2184 /* Looking up keys in keymaps */
2185 /************************************************************************/
2187 /* We need a very fast (i.e., non-consing) version of lookup-key in order
2188 to make where-is-internal really fly. */
2190 struct raw_lookup_key_mapper_closure {
2192 const struct key_data *raw_keys;
2198 static Lisp_Object raw_lookup_key_mapper(Lisp_Object k, void*);
2200 /* Caller should gc-protect args (keymaps may autoload) */
2202 raw_lookup_key(Lisp_Object keymap,
2203 const struct key_data *raw_keys, int raw_keys_count,
2204 int keys_so_far, int accept_default)
2206 /* This function can GC */
2207 struct raw_lookup_key_mapper_closure c;
2208 c.remaining = raw_keys_count - 1;
2209 c.raw_keys = raw_keys;
2210 c.raw_keys_count = raw_keys_count;
2211 c.keys_so_far = keys_so_far;
2212 c.accept_default = accept_default;
2214 return traverse_keymaps(keymap, Qnil, raw_lookup_key_mapper, &c);
2218 raw_lookup_key_mapper(Lisp_Object k, void *arg)
2220 /* This function can GC */
2221 const struct raw_lookup_key_mapper_closure *c =
2222 (const struct raw_lookup_key_mapper_closure*)arg;
2223 int accept_default = c->accept_default;
2224 int remaining = c->remaining;
2225 int keys_so_far = c->keys_so_far;
2226 const struct key_data *raw_keys = c->raw_keys;
2229 if (!meta_prefix_char_p(&(raw_keys[0]))) {
2230 /* Normal case: every case except the meta-hack (see below). */
2231 cmd = keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2234 /* Return whatever we found if we're out of keys */
2237 /* Found nothing (though perhaps parent map may have
2240 else if (NILP(Fkeymapp(cmd)))
2241 /* Didn't find a keymap, and we have more keys.
2242 * Return a fixnum to indicate that keys were too long.
2244 cmd = make_int(keys_so_far + 1);
2246 cmd = raw_lookup_key(cmd, raw_keys + 1, remaining,
2247 keys_so_far + 1, accept_default);
2249 /* This is a hack so that looking up a key-sequence whose last
2250 * element is the meta-prefix-char will return the keymap that
2251 * the "meta" keys are stored in, if there is no binding for
2252 * the meta-prefix-char (and if this map has a "meta" submap).
2253 * If this map doesn't have a "meta" submap, then the
2254 * meta-prefix-char is looked up just like any other key.
2256 if (remaining == 0) {
2257 /* First look for the prefix-char directly */
2259 keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2261 /* Do kludgy return of the meta-map */
2263 Fgethash(MAKE_MODIFIER_HASH_KEY
2265 XKEYMAP(k)->table, Qnil);
2268 /* Search for the prefix-char-prefixed sequence
2271 keymap_lookup_1(k, &(raw_keys[0]), accept_default);
2272 cmd = get_keymap(cmd, 0, 1);
2275 raw_lookup_key(cmd, raw_keys + 1, remaining,
2278 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0) {
2279 struct key_data metified;
2280 metified.keysym = raw_keys[1].keysym;
2281 metified.modifiers = raw_keys[1].modifiers |
2282 (unsigned char)XEMACS_MOD_META;
2284 /* Search for meta-next-char sequence directly */
2286 keymap_lookup_1(k, &metified,
2288 if (remaining == 1) ;
2290 cmd = get_keymap(cmd, 0, 1);
2304 if (accept_default && NILP(cmd))
2305 cmd = XKEYMAP(k)->default_binding;
2309 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2310 /* Caller should gc-protect arguments */
2312 lookup_keys(Lisp_Object keymap, int nkeys, Lisp_Object * keys,
2315 /* This function can GC */
2316 struct key_data kkk[20];
2317 struct key_data *raw_keys;
2323 if (nkeys < countof(kkk))
2326 raw_keys = alloca_array(struct key_data, nkeys);
2328 for (i = 0; i < nkeys; i++) {
2329 define_key_parser(keys[i], &(raw_keys[i]));
2331 return raw_lookup_key(keymap, raw_keys, nkeys, 0, accept_default);
2335 lookup_events(Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2338 /* This function can GC */
2339 struct key_data kkk[20];
2343 struct key_data *raw_keys;
2344 Lisp_Object tem = Qnil;
2345 struct gcpro gcpro1, gcpro2;
2348 CHECK_LIVE_EVENT(event_head);
2350 nkeys = event_chain_count(event_head);
2352 if (nkeys < countof(kkk))
2355 raw_keys = alloca_array(struct key_data, nkeys);
2358 EVENT_CHAIN_LOOP(event, event_head)
2359 define_key_parser(event, &(raw_keys[nkeys++]));
2360 GCPRO1n(event_head, keymaps, nmaps);
2361 /* ####raw_keys[].keysym slots aren't gc-protected.
2362 * We rely (but shouldn't) on somebody else somewhere (obarray)
2363 * having a pointer to all keysyms. */
2364 for (iii = 0; iii < nmaps; iii++) {
2365 tem = raw_lookup_key(keymaps[iii], raw_keys, nkeys, 0,
2368 /* Too long in some local map means don't look at global map */
2371 } else if (!NILP(tem)) {
2379 DEFUN("lookup-key", Flookup_key, 2, 3, 0, /*
2380 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2381 Nil is returned if KEYS is unbound. See documentation of `define-key'
2382 for valid key definitions and key-sequence specifications.
2383 A number is returned if KEYS is "too long"; that is, the leading
2384 characters fail to be a valid sequence of prefix characters in KEYMAP.
2385 The number is how many key strokes at the front of KEYS it takes to
2386 reach a non-prefix command.
2388 (keymap, keys, accept_default))
2390 /* This function can GC */
2392 return lookup_keys(keymap,
2393 XVECTOR_LENGTH(keys),
2394 XVECTOR_DATA(keys), !NILP(accept_default));
2395 else if (SYMBOLP(keys) || CHAR_OR_CHAR_INTP(keys) || CONSP(keys))
2396 return lookup_keys(keymap, 1, &keys, !NILP(accept_default));
2397 else if (STRINGP(keys)) {
2398 int length = XSTRING_CHAR_LENGTH(keys);
2400 struct key_data *raw_keys =
2401 alloca_array(struct key_data, length);
2405 for (i = 0; i < length; i++) {
2406 Emchar n = string_char(XSTRING(keys), i);
2407 define_key_parser(make_char(n), &(raw_keys[i]));
2409 return raw_lookup_key(keymap, raw_keys, length, 0,
2410 !NILP(accept_default));
2412 keys = wrong_type_argument(Qsequencep, keys);
2413 return Flookup_key(keymap, keys, accept_default);
2417 /* Given a key sequence, returns a list of keymaps to search for bindings.
2418 Does all manner of semi-hairy heuristics, like looking in the current
2419 buffer's map before looking in the global map and looking in the local
2420 map of the buffer in which the mouse was clicked in event0 is a click.
2422 It would be kind of nice if this were in Lisp so that this semi-hairy
2423 semi-heuristic command-lookup behavior could be readily understood and
2424 customised. However, this needs to be pretty fast, or performance of
2425 keyboard macros goes to shit; putting this in lisp slows macros down
2426 2-3x. And they're already slower than v18 by 5-6x.
2429 struct relevant_maps {
2431 unsigned int max_maps;
2433 struct gcpro *gcpro;
2436 static void get_relevant_extent_keymaps(Lisp_Object pos,
2437 Lisp_Object buffer_or_string,
2439 struct relevant_maps *closure);
2440 static void get_relevant_minor_maps(Lisp_Object buffer,
2441 struct relevant_maps *closure);
2443 static void relevant_map_push(Lisp_Object map, struct relevant_maps *closure)
2445 unsigned int nmaps = closure->nmaps;
2449 closure->nmaps = nmaps + 1;
2450 if (nmaps < closure->max_maps) {
2451 closure->maps[nmaps] = map;
2452 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
2453 closure->gcpro->nvars = nmaps;
2459 get_relevant_keymaps(Lisp_Object keys, int max_maps, Lisp_Object maps[])
2461 /* This function can GC */
2462 Lisp_Object terminal = Qnil;
2463 struct gcpro gcpro1;
2464 struct relevant_maps closure;
2465 struct console *con;
2469 closure.max_maps = max_maps;
2470 closure.maps = maps;
2471 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
2472 closure.gcpro = NULL;
2474 closure.gcpro = &gcpro1;
2478 terminal = event_chain_tail(keys);
2479 } else if (VECTORP(keys)) {
2480 int len = XVECTOR_LENGTH(keys);
2482 terminal = XVECTOR_DATA(keys)[len - 1];
2486 if (EVENTP(terminal)) {
2487 CHECK_LIVE_EVENT(terminal);
2488 con = event_console_or_selected(terminal);
2490 con = XCONSOLE(Vselected_console);
2493 if (KEYMAPP(con->overriding_terminal_local_map)
2494 || KEYMAPP(Voverriding_local_map)) {
2495 if (KEYMAPP(con->overriding_terminal_local_map))
2496 relevant_map_push(con->overriding_terminal_local_map,
2498 if (KEYMAPP(Voverriding_local_map))
2499 relevant_map_push(Voverriding_local_map, &closure);
2500 } else if (!EVENTP(terminal) ||
2501 (XEVENT(terminal)->event_type != button_press_event
2502 && XEVENT(terminal)->event_type != button_release_event)) {
2504 XSETBUFFER(tem, current_buffer);
2505 /* It's not a mouse event; order of keymaps searched is:
2506 o keymap of any/all extents under the mouse
2508 o local-map of current-buffer
2511 /* The terminal element of the lookup may be nil or a keysym.
2512 In those cases we don't want to check for an extent
2514 if (EVENTP(terminal)) {
2515 get_relevant_extent_keymaps(make_int
2516 (BUF_PT(current_buffer)),
2517 tem, Qnil, &closure);
2519 get_relevant_minor_maps(tem, &closure);
2521 tem = current_buffer->keymap;
2523 relevant_map_push(tem, &closure);
2525 #ifdef HAVE_WINDOW_SYSTEM
2527 /* It's a mouse event; order of keymaps searched is:
2528 o vertical-divider-map, if event is over a divider
2529 o local-map of mouse-grabbed-buffer
2530 o keymap of any/all extents under the mouse
2531 if the mouse is over a modeline:
2532 o modeline-map of buffer corresponding to that modeline
2533 o else, local-map of buffer under the mouse
2535 o local-map of current-buffer
2538 Lisp_Object window = Fevent_window(terminal);
2540 if (!NILP(Fevent_over_vertical_divider_p(terminal))) {
2541 if (KEYMAPP(Vvertical_divider_map))
2542 relevant_map_push(Vvertical_divider_map,
2546 if (BUFFERP(Vmouse_grabbed_buffer)) {
2548 XBUFFER(Vmouse_grabbed_buffer)->keymap;
2550 get_relevant_minor_maps(Vmouse_grabbed_buffer,
2553 relevant_map_push(map, &closure);
2556 if (!NILP(window)) {
2557 Lisp_Object buffer = Fwindow_buffer(window);
2559 if (!NILP(buffer)) {
2560 if (!NILP(Fevent_over_modeline_p(terminal))) {
2562 symbol_value_in_buffer
2566 get_relevant_extent_keymaps
2567 (Fevent_modeline_position(terminal),
2569 generated_modeline_string,
2570 Fevent_glyph_extent(terminal),
2573 if (!UNBOUNDP(map) && !NILP(map))
2574 relevant_map_push(get_keymap
2578 get_relevant_extent_keymaps(Fevent_point
2586 if (!EQ(buffer, Vmouse_grabbed_buffer)) { /* already pushed */
2588 XBUFFER(buffer)->keymap;
2590 get_relevant_minor_maps(buffer,
2593 relevant_map_push(map,
2597 } else if (!NILP(Fevent_over_toolbar_p(terminal))) {
2598 Lisp_Object map = Fsymbol_value(Qtoolbar_map);
2600 if (!UNBOUNDP(map) && !NILP(map))
2601 relevant_map_push(map, &closure);
2604 #endif /* HAVE_WINDOW_SYSTEM */
2606 if (CONSOLE_TTY_P (con))
2607 relevant_map_push (Vglobal_tty_map, &closure);
2609 relevant_map_push (Vglobal_window_system_map, &closure);
2612 int nmaps = closure.nmaps;
2613 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2614 if (nmaps >= max_maps && max_maps > 0)
2615 maps[max_maps - 1] = Vcurrent_global_map;
2617 maps[nmaps] = Vcurrent_global_map;
2623 /* Returns a set of keymaps extracted from the extents at POS in
2624 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2625 to look for a keymap in, and if it has one, its keymap will be the
2626 first element in the list returned. This is so we can correctly
2627 search the keymaps associated with glyphs which may be physically
2628 disjoint from their extents: for example, if a glyph is out in the
2629 margin, we should still consult the keymap of that glyph's extent,
2630 which may not itself be under the mouse.
2634 get_relevant_extent_keymaps(Lisp_Object pos, Lisp_Object buffer_or_string,
2635 Lisp_Object glyph, struct relevant_maps *closure)
2637 /* This function can GC */
2638 /* the glyph keymap, if any, comes first.
2639 (Processing it twice is no big deal: noop.) */
2641 Lisp_Object keymap = Fextent_property(glyph, Qkeymap, Qnil);
2643 relevant_map_push(get_keymap(keymap, 1, 1), closure);
2646 /* Next check the extents at the text position, if any */
2650 Fextent_at(pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2653 Fextent_at(pos, buffer_or_string, Qkeymap, extent, Qnil)) {
2654 Lisp_Object keymap =
2655 Fextent_property(extent, Qkeymap, Qnil);
2657 relevant_map_push(get_keymap(keymap, 1, 1),
2665 minor_mode_keymap_predicate(Lisp_Object assoc, Lisp_Object buffer)
2667 /* This function can GC */
2669 Lisp_Object sym = XCAR(assoc);
2671 Lisp_Object val = symbol_value_in_buffer(sym, buffer);
2672 if (!NILP(val) && !UNBOUNDP(val)) {
2673 Lisp_Object map = get_keymap(XCDR(assoc), 0, 1);
2682 get_relevant_minor_maps(Lisp_Object buffer, struct relevant_maps *closure)
2684 /* This function can GC */
2687 /* Will you ever lose badly if you make this circular! */
2688 for (alist = symbol_value_in_buffer(Qminor_mode_map_alist, buffer);
2689 CONSP(alist); alist = XCDR(alist)) {
2690 Lisp_Object m = minor_mode_keymap_predicate(XCAR(alist),
2693 relevant_map_push(m, closure);
2698 /* #### Would map-current-keymaps be a better thing?? */
2699 DEFUN("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2700 Return a list of the current keymaps that will be searched for bindings.
2701 This lists keymaps such as the current local map and the minor-mode maps,
2702 but does not list the parents of those keymaps.
2703 EVENT-OR-KEYS controls which keymaps will be listed.
2704 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2705 mouse event), the keymaps for that mouse event will be listed (see
2706 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2710 /* This function can GC */
2711 struct gcpro gcpro1;
2712 Lisp_Object maps[100];
2713 Lisp_Object *gubbish = maps;
2716 GCPRO1(event_or_keys);
2717 nmaps = get_relevant_keymaps(event_or_keys, countof(maps), gubbish);
2718 if (nmaps > countof(maps)) {
2719 gubbish = alloca_array(Lisp_Object, nmaps);
2720 nmaps = get_relevant_keymaps(event_or_keys, nmaps, gubbish);
2723 return Flist(nmaps, gubbish);
2726 DEFUN("key-binding", Fkey_binding, 1, 2, 0, /*
2727 Return the binding for command KEYS in current keymaps.
2728 KEYS is a string, a vector of events, or a vector of key-description lists
2729 as described in the documentation for the `define-key' function.
2730 The binding is probably a symbol with a function definition; see
2731 the documentation for `lookup-key' for more information.
2733 For key-presses, the order of keymaps searched is:
2734 - the `keymap' property of any extent(s) at point;
2735 - any applicable minor-mode maps;
2736 - the current local map of the current-buffer;
2737 - the current global map.
2739 For mouse-clicks, the order of keymaps searched is:
2740 - the current-local-map of the `mouse-grabbed-buffer' if any;
2741 - vertical-divider-map, if the event happened over a vertical divider
2742 - the `keymap' property of any extent(s) at the position of the click
2743 (this includes modeline extents);
2744 - the modeline-map of the buffer corresponding to the modeline under
2745 the mouse (if the click happened over a modeline);
2746 - the value of `toolbar-map' in the current-buffer (if the click
2747 happened over a toolbar);
2748 - the current local map of the buffer under the mouse (does not
2749 apply to toolbar clicks);
2750 - any applicable minor-mode maps;
2751 - the current global map.
2753 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2754 is non-nil, *only* those two maps and the current global map are searched.
2756 (keys, accept_default))
2758 /* This function can GC */
2760 Lisp_Object maps[100];
2762 struct gcpro gcpro1, gcpro2;
2763 GCPRO2(keys, accept_default); /* get_relevant_keymaps may autoload */
2765 nmaps = get_relevant_keymaps(keys, countof(maps), maps);
2769 if (EVENTP(keys)) /* unadvertised "feature" for the future */
2770 return lookup_events(keys, nmaps, maps, !NILP(accept_default));
2772 for (i = 0; i < nmaps; i++) {
2773 Lisp_Object tem = Flookup_key(maps[i], keys,
2776 /* Too long in some local map means don't look at global map */
2778 } else if (!NILP(tem))
2784 static Lisp_Object process_event_binding_result(Lisp_Object result)
2786 if (EQ(result, Qundefined))
2787 /* The suppress-keymap function binds keys to 'undefined - special-case
2788 that here, so that being bound to that has the same error-behavior as
2789 not being defined at all.
2792 if (!NILP(result)) {
2794 /* Snap out possible keymap indirections */
2795 map = get_keymap(result, 0, 1);
2803 /* Attempts to find a command corresponding to the event-sequence
2804 whose head is event0 (sequence is threaded though event_next).
2806 The return value will be
2808 -- nil (there is no binding; this will also be returned
2809 whenever the event chain is "too long", i.e. there
2810 is a non-nil, non-keymap binding for a prefix of
2812 -- a keymap (part of a command has been specified)
2813 -- a command (anything that satisfies `commandp'; this includes
2814 some symbols, lists, subrs, strings, vectors, and
2815 compiled-function objects) */
2816 Lisp_Object event_binding(Lisp_Object event0, int accept_default)
2818 /* This function can GC */
2819 Lisp_Object maps[100];
2822 assert(EVENTP(event0));
2824 nmaps = get_relevant_keymaps(event0, countof(maps), maps);
2825 if (nmaps > countof(maps))
2826 nmaps = countof(maps);
2827 return process_event_binding_result(lookup_events(event0, nmaps, maps,
2831 /* like event_binding, but specify a keymap to search */
2834 event_binding_in(Lisp_Object event0, Lisp_Object keymap, int accept_default)
2836 /* This function can GC */
2837 if (!KEYMAPP(keymap))
2840 return process_event_binding_result(lookup_events(event0, 1, &keymap,
2844 /* Attempts to find a function key mapping corresponding to the
2845 event-sequence whose head is event0 (sequence is threaded through
2846 event_next). The return value will be the same as for event_binding(). */
2848 munging_key_map_event_binding(Lisp_Object event0,
2849 enum munge_me_out_the_door munge)
2851 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2852 CONSOLE_FUNCTION_KEY_MAP(event_console_or_selected(event0)) :
2853 Vkey_translation_map;
2859 process_event_binding_result(lookup_events(event0, 1, &keymap, 1));
2862 /************************************************************************/
2863 /* Setting/querying the global and local maps */
2864 /************************************************************************/
2866 DEFUN("use-global-map", Fuse_global_map, 1, 1, 0, /*
2867 Select KEYMAP as the global keymap.
2871 /* This function can GC */
2872 keymap = get_keymap(keymap, 1, 1);
2873 Vcurrent_global_map = keymap;
2877 DEFUN("use-local-map", Fuse_local_map, 1, 2, 0, /*
2878 Select KEYMAP as the local keymap in BUFFER.
2879 If KEYMAP is nil, that means no local keymap.
2880 If BUFFER is nil, the current buffer is assumed.
2884 /* This function can GC */
2885 struct buffer *b = decode_buffer(buffer, 0);
2887 keymap = get_keymap(keymap, 1, 1);
2894 DEFUN("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2895 Return BUFFER's local keymap, or nil if it has none.
2896 If BUFFER is nil, the current buffer is assumed.
2900 struct buffer *b = decode_buffer(buffer, 0);
2904 DEFUN("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2905 Return the current global keymap.
2909 return Vcurrent_global_map;
2912 /************************************************************************/
2913 /* Mapping over keymap elements */
2914 /************************************************************************/
2916 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2917 prefix key, it's not entirely obvious what map-keymap should do, but
2918 what it does is: map over all keys in this map; then recursively map
2919 over all submaps of this map that are "bucky" submaps. This means that,
2920 when mapping over a keymap, it appears that "x" and "C-x" are in the
2921 same map, although "C-x" is really in the "control" submap of this one.
2922 However, since we don't recursively descend the submaps that are bound
2923 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2924 those explicitly, if that's what they want.
2926 So the end result of this is that the bucky keymaps (the ones indexed
2927 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2928 invisible from elisp. They're just an implementation detail that code
2929 outside of this file doesn't need to know about.
2932 struct map_keymap_unsorted_closure {
2933 void (*fn) (const struct key_data *, Lisp_Object binding, void *arg);
2938 /* used by map_keymap() */
2940 map_keymap_unsorted_mapper(Lisp_Object keysym, Lisp_Object value,
2941 void *map_keymap_unsorted_closure)
2943 /* This function can GC */
2944 struct map_keymap_unsorted_closure *closure =
2945 (struct map_keymap_unsorted_closure *)map_keymap_unsorted_closure;
2946 int modifiers = closure->modifiers;
2948 mod_bit = MODIFIER_HASH_KEY_BITS(keysym);
2950 int omod = modifiers;
2951 closure->modifiers = (modifiers | mod_bit);
2952 value = get_keymap(value, 1, 0);
2953 elisp_maphash(map_keymap_unsorted_mapper,
2954 XKEYMAP(value)->table,
2955 map_keymap_unsorted_closure);
2956 closure->modifiers = omod;
2958 struct key_data key;
2959 key.keysym = keysym;
2960 key.modifiers = modifiers;
2961 ((*closure->fn) (&key, value, closure->arg));
2966 struct map_keymap_sorted_closure {
2967 Lisp_Object *result_locative;
2970 /* used by map_keymap_sorted() */
2972 map_keymap_sorted_mapper(Lisp_Object key, Lisp_Object value,
2973 void *map_keymap_sorted_closure)
2975 struct map_keymap_sorted_closure *cl =
2976 (struct map_keymap_sorted_closure *)map_keymap_sorted_closure;
2977 Lisp_Object *list = cl->result_locative;
2978 *list = Fcons(Fcons(key, value), *list);
2982 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2983 and keymap_submaps().
2986 map_keymap_sort_predicate(Lisp_Object obj1, Lisp_Object obj2, Lisp_Object pred)
2988 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2998 bit1 = MODIFIER_HASH_KEY_BITS(obj1);
2999 bit2 = MODIFIER_HASH_KEY_BITS(obj2);
3001 /* If either is a symbol with a character-set-property, then sort it by
3002 that code instead of alphabetically.
3004 if (!bit1 && SYMBOLP(obj1)) {
3005 Lisp_Object code = Fget(obj1, Vcharacter_set_property, Qnil);
3006 if (CHAR_OR_CHAR_INTP(code)) {
3008 CHECK_CHAR_COERCE_INT(obj1);
3012 if (!bit2 && SYMBOLP(obj2)) {
3013 Lisp_Object code = Fget(obj2, Vcharacter_set_property, Qnil);
3014 if (CHAR_OR_CHAR_INTP(code)) {
3016 CHECK_CHAR_COERCE_INT(obj2);
3021 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
3022 if (XTYPE(obj1) != XTYPE(obj2))
3023 return SYMBOLP(obj2) ? 1 : -1;
3025 if (!bit1 && CHARP(obj1)) { /* they're both ASCII */
3026 int o1 = XCHAR(obj1);
3027 int o2 = XCHAR(obj2);
3028 if (o1 == o2 && /* If one started out as a symbol and the */
3029 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
3030 return sym2_p ? 1 : -1;
3032 return o1 < o2 ? 1 : -1; /* else just compare them */
3035 /* else they're both symbols. If they're both buckys, then order them. */
3037 return bit1 < bit2 ? 1 : -1;
3039 /* if only one is a bucky, then it comes later */
3041 return bit2 ? 1 : -1;
3043 /* otherwise, string-sort them. */
3045 char *s1 = (char *)string_data(XSYMBOL(obj1)->name);
3046 char *s2 = (char *)string_data(XSYMBOL(obj2)->name);
3048 return 0 > strcoll(s1, s2) ? 1 : -1;
3050 return 0 > strcmp(s1, s2) ? 1 : -1;
3055 /* used by map_keymap() */
3057 map_keymap_sorted(Lisp_Object keymap_table,
3059 void (*function) (const struct key_data * key,
3060 Lisp_Object binding,
3061 void *map_keymap_sorted_closure),
3062 void *map_keymap_sorted_closure)
3064 /* This function can GC */
3065 struct gcpro gcpro1;
3066 Lisp_Object contents = Qnil;
3068 if (XINT(Fhash_table_count(keymap_table)) == 0)
3074 struct map_keymap_sorted_closure c1;
3075 c1.result_locative = &contents;
3076 elisp_maphash(map_keymap_sorted_mapper, keymap_table, &c1);
3078 contents = list_sort(contents, Qnil, map_keymap_sort_predicate);
3079 for (; !NILP(contents); contents = XCDR(contents)) {
3080 Lisp_Object keysym = XCAR(XCAR(contents));
3081 Lisp_Object binding = XCDR(XCAR(contents));
3082 int sub_bits = MODIFIER_HASH_KEY_BITS(keysym);
3083 if (sub_bits != 0) {
3084 Lisp_Object tmp = get_keymap(binding, 1, 1);
3085 map_keymap_sorted(XKEYMAP(tmp)->table,
3086 (modifiers | sub_bits),
3087 function, map_keymap_sorted_closure);
3091 k.modifiers = modifiers;
3092 ((*function) (&k, binding, map_keymap_sorted_closure));
3098 /* used by Fmap_keymap() */
3100 map_keymap_mapper(const struct key_data *key,
3101 Lisp_Object binding, void *function)
3103 /* This function can GC */
3105 VOID_TO_LISP(fn, function);
3106 call2(fn, make_key_description(key, 1), binding);
3110 map_keymap(Lisp_Object keymap_table, int sort_first,
3111 void (*function) (const struct key_data * key,
3112 Lisp_Object binding, void *fn_arg), void *fn_arg)
3114 /* This function can GC */
3116 map_keymap_sorted(keymap_table, 0, function, fn_arg);
3118 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
3119 map_keymap_unsorted_closure.fn = function;
3120 map_keymap_unsorted_closure.arg = fn_arg;
3121 map_keymap_unsorted_closure.modifiers = 0;
3122 elisp_maphash(map_keymap_unsorted_mapper, keymap_table,
3123 &map_keymap_unsorted_closure);
3127 DEFUN("map-keymap", Fmap_keymap, 2, 3, 0, /*
3128 Apply FUNCTION to each element of KEYMAP.
3129 FUNCTION will be called with two arguments: a key-description list, and
3130 the binding. The order in which the elements of the keymap are passed to
3131 the function is unspecified. If the function inserts new elements into
3132 the keymap, it may or may not be called with them later. No element of
3133 the keymap will ever be passed to the function more than once.
3135 The function will not be called on elements of this keymap's parents
3136 \(see the function `keymap-parents') or upon keymaps which are contained
3137 within this keymap (multi-character definitions).
3138 It will be called on "meta" characters since they are not really
3139 two-character sequences.
3141 If the optional third argument SORT-FIRST is non-nil, then the elements of
3142 the keymap will be passed to the mapper function in a canonical order.
3143 Otherwise, they will be passed in hash (that is, random) order, which is
3146 (function, keymap, sort_first))
3148 /* This function can GC */
3149 struct gcpro gcpro1, gcpro2, gcpro3;
3150 Lisp_Object table = Qnil;
3152 /* tolerate obviously transposed args */
3153 if (!NILP(Fkeymapp(function))) {
3154 Lisp_Object tmp = function;
3159 GCPRO3(function, keymap, table);
3160 keymap = get_keymap(keymap, 1, 1);
3162 /* elisp_maphash does not allow mapping functions to modify the hash
3163 table being mapped over. Since map-keymap explicitly allows a
3164 mapping function to modify KEYMAP, we map over a copy of the hash
3166 table = Fcopy_hash_table(XKEYMAP(keymap)->table);
3168 map_keymap(table, !NILP(sort_first),
3169 map_keymap_mapper, LISP_TO_VOID(function));
3174 /************************************************************************/
3175 /* Accessible keymaps */
3176 /************************************************************************/
3178 struct accessible_keymaps_closure {
3183 accessible_keymaps_mapper_1(Lisp_Object keysym, Lisp_Object contents,
3185 const struct accessible_keymaps_closure *closure)
3187 /* This function can GC */
3188 int subbits = MODIFIER_HASH_KEY_BITS(keysym);
3191 Lisp_Object submaps;
3193 contents = get_keymap(contents, 1, 1);
3194 submaps = keymap_submaps(contents);
3195 for (; !NILP(submaps); submaps = XCDR(submaps)) {
3196 accessible_keymaps_mapper_1(XCAR(XCAR(submaps)),
3197 XCDR(XCAR(submaps)),
3198 (subbits | modifiers),
3202 Lisp_Object thisseq = Fcar(Fcar(closure->tail));
3203 Lisp_Object cmd = get_keyelt(contents, 1);
3207 struct key_data key;
3208 key.keysym = keysym;
3209 key.modifiers = modifiers;
3213 cmd = get_keymap(cmd, 0, 1);
3217 vec = make_vector(XVECTOR_LENGTH(thisseq) + 1, Qnil);
3218 len = XVECTOR_LENGTH(thisseq);
3219 for (j = 0; j < len; j++)
3220 XVECTOR_DATA(vec)[j] = XVECTOR_DATA(thisseq)[j];
3221 XVECTOR_DATA(vec)[j] = make_key_description(&key, 1);
3223 nconc2(closure->tail, list1(Fcons(vec, cmd)));
3228 accessible_keymaps_keymap_mapper(Lisp_Object thismap, void *arg)
3230 /* This function can GC */
3231 const struct accessible_keymaps_closure *closure =
3232 (const struct accessible_keymaps_closure*)arg;
3233 Lisp_Object submaps = keymap_submaps(thismap);
3235 for (; !NILP(submaps); submaps = XCDR(submaps)) {
3236 accessible_keymaps_mapper_1(XCAR(XCAR(submaps)),
3237 XCDR(XCAR(submaps)), 0, closure);
3242 DEFUN("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3243 Find all keymaps accessible via prefix characters from KEYMAP.
3244 Returns a list of elements of the form (KEYS . MAP), where the sequence
3245 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3246 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3247 An optional argument PREFIX, if non-nil, should be a key sequence;
3248 then the value includes only maps for prefixes that start with PREFIX.
3252 /* This function can GC */
3253 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3254 Lisp_Object accessible_keymaps = Qnil;
3255 struct accessible_keymaps_closure c;
3257 GCPRO4(accessible_keymaps, c.tail, prefix, keymap);
3259 keymap = get_keymap(keymap, 1, 1);
3263 prefix = make_vector(0, Qnil);
3264 } else if (VECTORP(prefix) || STRINGP(prefix)) {
3265 int len = XINT(Flength(prefix));
3269 struct gcpro ngcpro1;
3276 def = Flookup_key(keymap, prefix, Qnil);
3277 def = get_keymap(def, 0, 1);
3282 p = make_vector(len, Qnil);
3284 for (iii = 0; iii < len; iii++) {
3285 struct key_data key;
3286 define_key_parser(Faref(prefix, make_int(iii)), &key);
3287 XVECTOR_DATA(p)[iii] = make_key_description(&key, 1);
3292 prefix = wrong_type_argument(Qarrayp, prefix);
3296 accessible_keymaps = list1(Fcons(prefix, keymap));
3298 /* For each map in the list maps, look at any other maps it points
3299 to and stick them at the end if they are not already in the list */
3301 for (c.tail = accessible_keymaps; !NILP(c.tail); c.tail = XCDR(c.tail)) {
3302 Lisp_Object thismap = Fcdr(Fcar(c.tail));
3303 CHECK_KEYMAP(thismap);
3304 traverse_keymaps(thismap, Qnil,
3305 accessible_keymaps_keymap_mapper, &c);
3309 return accessible_keymaps;
3312 /************************************************************************/
3313 /* Pretty descriptions of key sequences */
3314 /************************************************************************/
3316 DEFUN("key-description", Fkey_description, 1, 1, 0, /*
3317 Return a pretty description of key-sequence KEYS.
3318 Control characters turn into "C-foo" sequences, meta into "M-foo",
3319 spaces are put between sequence elements, etc...
3323 if (CHAR_OR_CHAR_INTP(keys) || CONSP(keys) || SYMBOLP(keys)
3325 return Fsingle_key_description(keys);
3326 } else if (VECTORP(keys) || STRINGP(keys)) {
3327 Lisp_Object string = Qnil;
3328 /* Lisp_Object sep = Qnil; */
3329 int size = XINT(Flength(keys));
3332 for (i = 0; i < size; i++) {
3333 Lisp_Object s2 = Fsingle_key_description(STRINGP(keys)
3346 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */
3350 concat2(Vsingle_space_string, s2));
3355 return Fkey_description(wrong_type_argument(Qsequencep, keys));
3358 DEFUN("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3359 Return a pretty description of command character KEY.
3360 Control characters turn into C-whatever, etc.
3361 This differs from `text-char-description' in that it returns a description
3362 of a key read from the user rather than a character from a buffer.
3367 key = Fcons(key, Qnil); /* sleaze sleaze */
3369 if (EVENTP(key) || CHAR_OR_CHAR_INTP(key)) {
3373 event.event_type = empty_event;
3374 CHECK_CHAR_COERCE_INT(key);
3375 character_to_event(XCHAR(key), &event,
3376 XCONSOLE(Vselected_console), 0, 1);
3377 format_event_object(buf, &event, 1);
3379 format_event_object(buf, XEVENT(key), 1);
3380 return build_string(buf);
3387 buf[sizeof(buf)-1] = buf[0] = '\0';
3389 LIST_LOOP(rest, key) {
3390 Lisp_Object keysym = XCAR(rest);
3391 if (EQ(keysym, Qcontrol))
3392 strcpy(bufp, "C-"), bufp += 2;
3393 else if (EQ(keysym, Qctrl))
3394 strcpy(bufp, "C-"), bufp += 2;
3395 else if (EQ(keysym, Qmeta))
3396 strcpy(bufp, "M-"), bufp += 2;
3397 else if (EQ(keysym, Qsuper))
3398 strcpy(bufp, "S-"), bufp += 2;
3399 else if (EQ(keysym, Qhyper))
3400 strcpy(bufp, "H-"), bufp += 2;
3401 else if (EQ(keysym, Qalt))
3402 strcpy(bufp, "A-"), bufp += 2;
3403 else if (EQ(keysym, Qshift))
3404 strcpy(bufp, "Sh-"), bufp += 3;
3405 else if (CHAR_OR_CHAR_INTP(keysym)) {
3406 bufp += set_charptr_emchar((Bufbyte *) bufp,
3411 CHECK_SYMBOL(keysym);
3412 #if 0 /* This is bogus */
3413 if (EQ(keysym, QKlinefeed))
3414 strcpy(bufp, "LFD");
3415 else if (EQ(keysym, QKtab))
3416 strcpy(bufp, "TAB");
3417 else if (EQ(keysym, QKreturn))
3418 strcpy(bufp, "RET");
3419 else if (EQ(keysym, QKescape))
3420 strcpy(bufp, "ESC");
3421 else if (EQ(keysym, QKdelete))
3422 strcpy(bufp, "DEL");
3423 else if (EQ(keysym, QKspace))
3424 strcpy(bufp, "SPC");
3425 else if (EQ(keysym, QKbackspace))
3432 string_data(XSYMBOL(keysym)->
3434 sizeof(buf)-(bufp-buf)-1);
3435 /* bufp iterates over buf */
3436 buf[sizeof(buf)-1]='\0';
3438 if (!NILP(XCDR(rest)))
3440 ("Invalid key description", key);
3443 return build_string(buf);
3445 return Fsingle_key_description
3446 (wrong_type_argument(intern("char-or-event-p"), key));
3449 DEFUN("text-char-description", Ftext_char_description, 1, 1, 0, /*
3450 Return a pretty description of file-character CHR.
3451 Unprintable characters turn into "^char" or \\NNN, depending on the value
3452 of the `ctl-arrow' variable.
3453 This differs from `single-key-description' in that it returns a description
3454 of a character from a buffer rather than a key read from the user.
3461 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3462 int ctl_p = !NILP(ctl_arrow);
3463 Emchar printable_min = (CHAR_OR_CHAR_INTP(ctl_arrow)
3464 ? XCHAR_OR_CHAR_INT(ctl_arrow)
3465 : ((EQ(ctl_arrow, Qt) || NILP(ctl_arrow))
3469 Lisp_Object ch = Fevent_to_character(chr, Qnil, Qnil, Qt);
3472 signal_simple_continuable_error
3473 ("character has no ASCII equivalent",
3474 Fcopy_event(chr, Qnil));
3478 CHECK_CHAR_COERCE_INT(chr);
3483 if (c >= printable_min) {
3484 p += set_charptr_emchar(p, c);
3485 } else if (c < 040 && ctl_p) {
3487 *p++ = c + 64; /* 'A' - 1 */
3488 } else if (c == 0177) {
3491 } else if (c >= 0200 || c < 040) {
3494 /* !!#### This syntax is not readable. It will
3495 be interpreted as a 3-digit octal number rather
3496 than a 7-digit octal number. */
3498 *p++ = '0' + ((c & 07000000) >> 18);
3499 *p++ = '0' + ((c & 0700000) >> 15);
3500 *p++ = '0' + ((c & 070000) >> 12);
3501 *p++ = '0' + ((c & 07000) >> 9);
3504 *p++ = '0' + ((c & 0700) >> 6);
3505 *p++ = '0' + ((c & 0070) >> 3);
3506 *p++ = '0' + ((c & 0007));
3508 p += set_charptr_emchar(p, c);
3512 return build_string((char *)buf);
3515 /************************************************************************/
3516 /* where-is (mapping bindings to keys) */
3517 /************************************************************************/
3520 where_is_internal(Lisp_Object definition, Lisp_Object * maps, int nmaps,
3521 Lisp_Object firstonly, char *target_buffer);
3523 DEFUN("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3524 Return list of keys that invoke DEFINITION in KEYMAPS.
3525 KEYMAPS can be either a keymap (meaning search in that keymap and the
3526 current global keymap) or a list of keymaps (meaning search in exactly
3527 those keymaps and no others). If KEYMAPS is nil, search in the currently
3528 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3529 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3531 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3532 the first key sequence found, rather than a list of all possible key
3535 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3536 to other keymaps or slots. This makes it possible to search for an
3537 indirect definition itself.
3539 (definition, keymaps, firstonly, noindirect, event_or_keys))
3541 /* This function can GC */
3542 Lisp_Object maps[100];
3543 Lisp_Object *gubbish = maps;
3546 /* Get keymaps as an array */
3547 if (NILP(keymaps)) {
3548 nmaps = get_relevant_keymaps(event_or_keys, countof(maps),
3550 if (nmaps > countof(maps)) {
3551 gubbish = alloca_array(Lisp_Object, nmaps);
3553 get_relevant_keymaps(event_or_keys, nmaps, gubbish);
3555 } else if (CONSP(keymaps)) {
3559 nmaps = XINT(Flength(keymaps));
3560 if (nmaps > countof(maps)) {
3561 gubbish = alloca_array(Lisp_Object, nmaps);
3563 for (rest = keymaps, i = 0; !NILP(rest);
3564 rest = XCDR(keymaps), i++) {
3565 gubbish[i] = get_keymap(XCAR(keymaps), 1, 1);
3569 gubbish[0] = get_keymap(keymaps, 1, 1);
3570 if (!EQ(gubbish[0], Vcurrent_global_map)) {
3571 gubbish[1] = Vcurrent_global_map;
3576 return where_is_internal(definition, gubbish, nmaps, firstonly, 0);
3579 /* This function is like
3580 (key-description (where-is-internal definition nil t))
3581 except that it writes its output into a (char *) buffer that you
3582 provide; it doesn't cons (or allocate memory) at all, so it's
3583 very fast. This is used by menubar.c.
3585 void where_is_to_char(Lisp_Object definition, char *buffer)
3587 /* This function can GC */
3588 Lisp_Object maps[100];
3589 Lisp_Object *gubbish = maps;
3592 /* Get keymaps as an array */
3593 nmaps = get_relevant_keymaps(Qnil, countof(maps), gubbish);
3594 if (nmaps > countof(maps)) {
3595 gubbish = alloca_array(Lisp_Object, nmaps);
3596 nmaps = get_relevant_keymaps(Qnil, nmaps, gubbish);
3600 where_is_internal(definition, maps, nmaps, Qt, buffer);
3603 static Lisp_Object raw_keys_to_keys(struct key_data *keys, int count)
3605 Lisp_Object result = make_vector(count, Qnil);
3607 XVECTOR_DATA(result)[count] =
3608 make_key_description(&(keys[count]), 1);
3612 static void format_raw_keys(struct key_data *keys, int count, char *buf)
3616 event.event_type = key_press_event;
3617 event.channel = Vselected_console;
3618 for (i = 0; i < count; i++) {
3619 event.event.key.keysym = keys[i].keysym;
3620 event.event.key.modifiers = keys[i].modifiers;
3621 format_event_object(buf, &event, 1);
3624 buf[0] = ' ', buf++;
3628 /* definition is the thing to look for.
3630 shadow is an array of shadow_count keymaps; if there is a different
3631 binding in any of the keymaps of a key that we are considering
3632 returning, then we reconsider.
3633 firstonly means give up after finding the first match;
3634 keys_so_far and modifiers_so_far describe which map we're looking in;
3635 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3636 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3637 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we
3638 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3641 (keys_so_far is a global buffer and the keys_count arg says how much
3642 of it we're currently interested in.)
3644 If target_buffer is provided, then we write a key-description into it,
3645 to avoid consing a string. This only works with firstonly on.
3648 struct where_is_closure {
3649 Lisp_Object definition;
3650 Lisp_Object *shadow;
3654 int modifiers_so_far;
3655 char *target_buffer;
3656 struct key_data *keys_so_far;
3657 int keys_so_far_total_size;
3658 int keys_so_far_malloced;
3661 /* arg is modified, so cannot be const */
3662 static Lisp_Object where_is_recursive_mapper(Lisp_Object map, void *arg);
3664 static Lisp_Object where_is_recursive_mapper(Lisp_Object map, void *arg)
3666 /* This function can GC */
3667 /* inevitable warning, we must modify c */
3668 struct where_is_closure *c = (struct where_is_closure *)arg;
3669 Lisp_Object definition = c->definition;
3670 const int firstonly = c->firstonly;
3671 const int keys_count = c->keys_count;
3672 const int modifiers_so_far = c->modifiers_so_far;
3673 char *target_buffer = c->target_buffer;
3674 Lisp_Object keys = Fgethash(definition,
3675 XKEYMAP(map)->inverse_table,
3677 Lisp_Object submaps;
3678 Lisp_Object result = Qnil;
3681 /* One or more keys in this map match the definition we're looking for.
3682 Verify that these bindings aren't shadowed by other bindings
3683 in the shadow maps. Either nil or number as value from
3684 raw_lookup_key() means undefined. */
3685 struct key_data *so_far = c->keys_so_far;
3687 for (;;) { /* loop over all keys that match */
3688 Lisp_Object k = CONSP(keys) ? XCAR(keys) : keys;
3691 so_far[keys_count].keysym = k;
3692 so_far[keys_count].modifiers = modifiers_so_far;
3694 /* now loop over all shadow maps */
3695 for (i = 0; i < c->shadow_count; i++) {
3696 Lisp_Object shadowed =
3697 raw_lookup_key(c->shadow[i],
3702 if (NILP(shadowed) || CHARP(shadowed) ||
3703 EQ(shadowed, definition))
3704 continue; /* we passed this test; it's not shadowed here. */
3706 /* ignore this key binding, since it actually has a
3707 different binding in a shadowing map */
3708 goto c_doesnt_have_proper_loop_exit_statements;
3711 /* OK, the key is for real */
3712 if (target_buffer) {
3715 format_raw_keys(so_far, keys_count + 1,
3718 } else if (firstonly)
3719 return raw_keys_to_keys(so_far, keys_count + 1);
3722 Fcons(raw_keys_to_keys
3723 (so_far, keys_count + 1), result);
3725 c_doesnt_have_proper_loop_exit_statements:
3726 /* now on to the next matching key ... */
3733 /* Now search the sub-keymaps of this map.
3734 If we're in "firstonly" mode and have already found one, this
3735 point is not reached. If we get one from lower down, either
3736 return it immediately (in firstonly mode) or tack it onto the
3737 end of the ones we've gotten so far.
3739 for (submaps = keymap_submaps(map);
3740 !NILP(submaps); submaps = XCDR(submaps)) {
3741 Lisp_Object key = XCAR(XCAR(submaps));
3742 Lisp_Object submap = XCDR(XCAR(submaps));
3743 int lower_modifiers;
3744 int lower_keys_count = keys_count;
3747 submap = get_keymap(submap, 0, 0);
3749 if (EQ(submap, map))
3750 /* Arrgh! Some loser has introduced a loop... */
3753 /* If this is not a keymap, then that's probably because someone
3754 did an `fset' of a symbol that used to point to a map such that
3755 it no longer does. Sigh. Ignore this, and invalidate the cache
3756 so that it doesn't happen to us next time too.
3759 XKEYMAP(map)->sub_maps_cache = Qt;
3763 /* If the map is a "bucky" map, then add a bit to the
3764 modifiers_so_far list.
3765 Otherwise, add a new raw_key onto the end of keys_so_far.
3767 bucky = MODIFIER_HASH_KEY_BITS(key);
3769 lower_modifiers = (modifiers_so_far | bucky);
3771 struct key_data *so_far = c->keys_so_far;
3772 lower_modifiers = 0;
3773 so_far[lower_keys_count].keysym = key;
3774 so_far[lower_keys_count].modifiers = modifiers_so_far;
3778 if (lower_keys_count >= c->keys_so_far_total_size) {
3779 int size = lower_keys_count + 50;
3780 if (!c->keys_so_far_malloced) {
3781 struct key_data *new =
3782 xnew_array(struct key_data, size);
3784 (const void*)c->keys_so_far,
3785 c->keys_so_far_total_size *
3786 sizeof(struct key_data));
3787 xfree(c->keys_so_far);
3788 c->keys_so_far = new;
3790 XREALLOC_ARRAY(c->keys_so_far, struct key_data,
3793 c->keys_so_far_total_size = size;
3794 c->keys_so_far_malloced = 1;
3800 c->keys_count = lower_keys_count;
3801 c->modifiers_so_far = lower_modifiers;
3803 lower = traverse_keymaps(
3804 submap, Qnil, where_is_recursive_mapper, c);
3806 c->keys_count = keys_count;
3807 c->modifiers_so_far = modifiers_so_far;
3810 result = nconc2(lower, result);
3811 } else if (!NILP(lower)) {
3820 where_is_internal(Lisp_Object definition, Lisp_Object * maps, int nmaps,
3821 Lisp_Object firstonly, char *target_buffer)
3823 /* This function can GC */
3824 Lisp_Object result = Qnil;
3826 struct key_data raw[20];
3827 struct where_is_closure c;
3829 c.definition = definition;
3831 c.firstonly = !NILP(firstonly);
3832 c.target_buffer = target_buffer;
3833 c.keys_so_far = raw;
3834 c.keys_so_far_total_size = countof(raw);
3835 c.keys_so_far_malloced = 0;
3837 /* Loop over each of the maps, accumulating the keys found.
3838 For each map searched, all previous maps shadow this one
3839 so that bogus keys aren't listed. */
3840 for (i = 0; i < nmaps; i++) {
3841 Lisp_Object this_result;
3843 /* Reset the things set in each iteration */
3845 c.modifiers_so_far = 0;
3849 maps[i], Qnil, where_is_recursive_mapper, &c);
3850 if (!NILP(firstonly)) {
3851 result = this_result;
3852 if (!NILP(result)) {
3856 result = nconc2(this_result, result);
3860 if (NILP(firstonly)) {
3861 result = Fnreverse(result);
3863 if (c.keys_so_far_malloced) {
3864 xfree(c.keys_so_far);
3869 /************************************************************************/
3870 /* Describing keymaps */
3871 /************************************************************************/
3873 DEFUN("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3874 Insert a list of all defined keys and their definitions in MAP.
3875 Optional second argument ALL says whether to include even "uninteresting"
3876 definitions (ie symbols with a non-nil `suppress-keymap' property.
3877 Third argument SHADOW is a list of keymaps whose bindings shadow those
3878 of map; if a binding is present in any shadowing map, it is not printed.
3879 Fourth argument PREFIX, if non-nil, should be a key sequence;
3880 only bindings which start with that key sequence will be printed.
3881 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3883 (map, all, shadow, prefix, mouse_only_p))
3885 /* This function can GC */
3887 /* #### At some point, this function should be changed to accept a
3888 BUFFER argument. Currently, the BUFFER argument to
3889 describe_map_tree is being used only internally. */
3890 describe_map_tree(map, NILP(all), shadow, prefix,
3891 !NILP(mouse_only_p), Fcurrent_buffer());
3895 /* Insert a description of the key bindings in STARTMAP,
3896 followed by those of all maps reachable through STARTMAP.
3897 If PARTIAL is nonzero, omit certain "uninteresting" commands
3898 (such as `undefined').
3899 If SHADOW is non-nil, it is a list of other maps;
3900 don't mention keys which would be shadowed by any of them
3901 If PREFIX is non-nil, only list bindings which start with those keys.
3905 describe_map_tree(Lisp_Object startmap, int partial, Lisp_Object shadow,
3906 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3908 /* This function can GC */
3909 Lisp_Object maps = Qnil;
3910 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3911 GCPRO2(maps, shadow);
3913 maps = Faccessible_keymaps(startmap, prefix);
3915 for (; !NILP(maps); maps = Fcdr(maps)) {
3916 Lisp_Object sub_shadow = Qnil;
3917 Lisp_Object elt = Fcar(maps);
3919 Lisp_Object tmp = Fcar(elt);
3920 int no_prefix = (VECTORP(tmp) && XINT(Flength(tmp)) == 0);
3921 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3922 NGCPRO3(sub_shadow, elt, tail);
3924 for (tail = shadow; CONSP(tail); tail = XCDR(tail)) {
3925 Lisp_Object shmap = XCAR(tail);
3927 /* If the sequence by which we reach this keymap is zero-length,
3928 then the shadow maps for this keymap are just SHADOW. */
3930 /* If the sequence by which we reach this keymap actually has
3931 some elements, then the sequence's definition in SHADOW is
3932 what we should use. */
3934 shmap = Flookup_key(shmap, Fcar(elt), Qt);
3940 Lisp_Object shm = get_keymap(shmap, 0, 1);
3941 /* If shmap is not nil and not a keymap, it completely
3942 shadows this map, so don't describe this map at all. */
3945 sub_shadow = Fcons(shm, sub_shadow);
3950 /* Describe the contents of map MAP, assuming that this map
3951 itself is reached by the sequence of prefix keys KEYS (a vector).
3952 PARTIAL and SHADOW are as in `describe_map_tree'. */
3953 Lisp_Object keysdesc = ((!no_prefix)
3955 concat2(Fkey_description
3957 Vsingle_space_string)
3959 describe_map(Fcdr(elt), keysdesc,
3961 partial, sub_shadow, mice_only_p, buffer);
3969 static void describe_command(Lisp_Object definition, Lisp_Object buffer)
3971 /* This function can GC */
3972 int keymapp = !NILP(Fkeymapp(definition));
3973 struct gcpro gcpro1;
3976 Findent_to(make_int(16), make_int(3), buffer);
3978 buffer_insert_c_string(XBUFFER(buffer), "<< ");
3980 if (SYMBOLP(definition)) {
3981 buffer_insert1(XBUFFER(buffer), Fsymbol_name(definition));
3982 } else if (STRINGP(definition) || VECTORP(definition)) {
3983 buffer_insert_c_string(XBUFFER(buffer), "Kbd Macro: ");
3984 buffer_insert1(XBUFFER(buffer), Fkey_description(definition));
3985 } else if (COMPILED_FUNCTIONP(definition))
3986 buffer_insert_c_string(XBUFFER(buffer),
3987 "Anonymous Compiled Function");
3988 else if (CONSP(definition) && EQ(XCAR(definition), Qlambda))
3989 buffer_insert_c_string(XBUFFER(buffer), "Anonymous Lambda");
3990 else if (KEYMAPP(definition)) {
3991 Lisp_Object name = XKEYMAP(definition)->name;
3992 if (STRINGP(name) || (SYMBOLP(name) && !NILP(name))) {
3993 buffer_insert_c_string(XBUFFER(buffer),
3996 && EQ(find_symbol_value(name), definition))
3997 buffer_insert1(XBUFFER(buffer),
3998 Fsymbol_name(name));
4000 buffer_insert1(XBUFFER(buffer),
4001 Fprin1_to_string(name, Qnil));
4004 buffer_insert_c_string(XBUFFER(buffer),
4007 buffer_insert_c_string(XBUFFER(buffer), "??");
4010 buffer_insert_c_string(XBUFFER(buffer), " >>");
4011 buffer_insert_c_string(XBUFFER(buffer), "\n");
4015 struct describe_map_closure {
4016 Lisp_Object *list; /* pointer to the list to update */
4017 Lisp_Object partial; /* whether to ignore suppressed commands */
4018 Lisp_Object shadow; /* list of maps shadowing this one */
4019 Lisp_Object self; /* this map */
4020 Lisp_Object self_root; /* this map, or some map that has this map as
4021 a parent. this is the base of the tree */
4022 int mice_only_p; /* whether we are to display only button bindings */
4025 struct describe_map_shadow_closure {
4026 const struct key_data *raw_key;
4031 describe_map_mapper_shadow_search(Lisp_Object map, void *arg)
4033 const struct describe_map_shadow_closure *c =
4034 (const struct describe_map_shadow_closure *)arg;
4036 if (EQ(map, c->self)) {
4037 return Qzero; /* Not shadowed; terminate search */
4039 return !NILP(keymap_lookup_directly(
4040 map, c->raw_key->keysym, c->raw_key->modifiers))
4045 keymap_lookup_inherited_mapper(Lisp_Object km, void *arg)
4047 const struct key_data *k = (const struct key_data *)arg;
4048 return keymap_lookup_directly(km, k->keysym, k->modifiers);
4052 describe_map_mapper(struct key_data *key,
4053 Lisp_Object binding, const void *describe_map_closure)
4055 /* This function can GC */
4056 const struct describe_map_closure *closure =
4057 (const struct describe_map_closure *)describe_map_closure;
4058 Lisp_Object keysym = key->keysym;
4059 int modifiers = key->modifiers;
4061 /* Don't mention suppressed commands. */
4062 if (SYMBOLP(binding)
4063 && !NILP(closure->partial)
4064 && !NILP(Fget(binding, closure->partial, Qnil)))
4067 /* If we're only supposed to display mouse bindings and this isn't one,
4069 if (closure->mice_only_p &&
4070 (!(EQ(keysym, Qbutton0) ||
4071 EQ(keysym, Qbutton1) ||
4072 EQ(keysym, Qbutton2) ||
4073 EQ(keysym, Qbutton3) ||
4074 EQ(keysym, Qbutton4) ||
4075 EQ(keysym, Qbutton5) ||
4076 EQ(keysym, Qbutton6) ||
4077 EQ(keysym, Qbutton7) ||
4078 EQ(keysym, Qbutton8) ||
4079 EQ(keysym, Qbutton9) ||
4080 EQ(keysym, Qbutton10) ||
4081 EQ(keysym, Qbutton11) ||
4082 EQ(keysym, Qbutton12) ||
4083 EQ(keysym, Qbutton13) ||
4084 EQ(keysym, Qbutton14) ||
4085 EQ(keysym, Qbutton15) ||
4086 EQ(keysym, Qbutton16) ||
4087 EQ(keysym, Qbutton17) ||
4088 EQ(keysym, Qbutton18) ||
4089 EQ(keysym, Qbutton19) ||
4090 EQ(keysym, Qbutton20) ||
4091 EQ(keysym, Qbutton21) ||
4092 EQ(keysym, Qbutton22) ||
4093 EQ(keysym, Qbutton23) ||
4094 EQ(keysym, Qbutton24) ||
4095 EQ(keysym, Qbutton25) ||
4096 EQ(keysym, Qbutton26) ||
4097 EQ(keysym, Qbutton27) ||
4098 EQ(keysym, Qbutton28) ||
4099 EQ(keysym, Qbutton29) ||
4100 EQ(keysym, Qbutton30) ||
4101 EQ(keysym, Qbutton31) ||
4102 EQ(keysym, Qbutton32) ||
4103 EQ(keysym, Qbutton0up) ||
4104 EQ(keysym, Qbutton1up) ||
4105 EQ(keysym, Qbutton2up) ||
4106 EQ(keysym, Qbutton3up) ||
4107 EQ(keysym, Qbutton4up) ||
4108 EQ(keysym, Qbutton5up) ||
4109 EQ(keysym, Qbutton6up) ||
4110 EQ(keysym, Qbutton7up) ||
4111 EQ(keysym, Qbutton8up) ||
4112 EQ(keysym, Qbutton9up) ||
4113 EQ(keysym, Qbutton10up) ||
4114 EQ(keysym, Qbutton11up) ||
4115 EQ(keysym, Qbutton12up) ||
4116 EQ(keysym, Qbutton13up) ||
4117 EQ(keysym, Qbutton14up) ||
4118 EQ(keysym, Qbutton15up) ||
4119 EQ(keysym, Qbutton16up) ||
4120 EQ(keysym, Qbutton17up) ||
4121 EQ(keysym, Qbutton18up) ||
4122 EQ(keysym, Qbutton19up) ||
4123 EQ(keysym, Qbutton20up) ||
4124 EQ(keysym, Qbutton21up) ||
4125 EQ(keysym, Qbutton22up) ||
4126 EQ(keysym, Qbutton23up) ||
4127 EQ(keysym, Qbutton24up) ||
4128 EQ(keysym, Qbutton25up) ||
4129 EQ(keysym, Qbutton26up) ||
4130 EQ(keysym, Qbutton27up) ||
4131 EQ(keysym, Qbutton28up) ||
4132 EQ(keysym, Qbutton29up) ||
4133 EQ(keysym, Qbutton30up) ||
4134 EQ(keysym, Qbutton31up) ||
4135 EQ(keysym, Qbutton32up)))) {
4138 /* If this command in this map is shadowed by some other map, ignore
4143 for (tail = closure->shadow; CONSP(tail); tail = XCDR(tail)) {
4145 if (!NILP(traverse_keymaps(
4147 keymap_lookup_inherited_mapper,
4148 /* Cast to discard `const' */
4155 /* If this key is in some map of which this map is a parent, then ignore
4156 it (in that case, it has been shadowed).
4160 struct describe_map_shadow_closure c;
4162 c.self = closure->self;
4164 sh = traverse_keymaps(closure->self_root, Qnil,
4165 describe_map_mapper_shadow_search, &c);
4166 if (!NILP(sh) && !ZEROP(sh)) {
4171 /* Otherwise add it to the list to be sorted. */
4172 *(closure->list) = Fcons(Fcons(Fcons(keysym, make_int(modifiers)),
4173 binding), *(closure->list));
4177 describe_map_sort_predicate(Lisp_Object obj1, Lisp_Object obj2,
4180 /* obj1 and obj2 are conses of the form
4181 ( ( <keysym> . <modifiers> ) . <binding> )
4182 keysym and modifiers are used, binding is ignored.
4187 bit1 = XINT(XCDR(obj1));
4188 bit2 = XINT(XCDR(obj2));
4190 return bit1 < bit2 ? 1 : -1;
4192 return map_keymap_sort_predicate(obj1, obj2, pred);
4195 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4196 or 2 or more symbolic keysyms that are bound to the same thing and
4197 have consecutive character-set-properties.
4199 static int elide_next_two_p(Lisp_Object list)
4203 if (NILP(XCDR(list)))
4206 /* next two bindings differ */
4207 if (!EQ(XCDR(XCAR(list)), XCDR(XCAR(XCDR(list)))))
4210 /* next two modifier-sets differ */
4211 if (!EQ(XCDR(XCAR(XCAR(list))), XCDR(XCAR(XCAR(XCDR(list))))))
4214 s1 = XCAR(XCAR(XCAR(list)));
4215 s2 = XCAR(XCAR(XCAR(XCDR(list))));
4218 Lisp_Object code = Fget(s1, Vcharacter_set_property, Qnil);
4219 if (CHAR_OR_CHAR_INTP(code)) {
4221 CHECK_CHAR_COERCE_INT(s1);
4226 Lisp_Object code = Fget(s2, Vcharacter_set_property, Qnil);
4227 if (CHAR_OR_CHAR_INTP(code)) {
4229 CHECK_CHAR_COERCE_INT(s2);
4234 return (XCHAR(s1) == XCHAR(s2) || XCHAR(s1) + 1 == XCHAR(s2));
4238 describe_map_parent_mapper(Lisp_Object keymap, void *arg)
4240 /* This function can GC */
4241 struct describe_map_closure *describe_map_closure =
4242 (struct describe_map_closure *)arg;
4243 describe_map_closure->self = keymap;
4244 /* don't sort: we'll do it later */
4245 map_keymap(XKEYMAP(keymap)->table, 0,
4246 (void(*)(const struct key_data*, Lisp_Object, void*))
4247 describe_map_mapper, describe_map_closure);
4251 /* Describe the contents of map MAP, assuming that this map itself is
4252 reached by the sequence of prefix keys KEYS (a string or vector).
4253 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4256 describe_map(Lisp_Object keymap, Lisp_Object elt_prefix,
4257 void (*elt_describer) (Lisp_Object, Lisp_Object),
4259 Lisp_Object shadow, int mice_only_p, Lisp_Object buffer)
4261 /* This function can GC */
4262 struct describe_map_closure describe_map_closure;
4263 Lisp_Object list = Qnil;
4264 struct buffer *buf = XBUFFER(buffer);
4265 Emchar printable_min = (CHAR_OR_CHAR_INTP(buf->ctl_arrow)
4266 ? XCHAR_OR_CHAR_INT(buf->ctl_arrow)
4267 : ((EQ(buf->ctl_arrow, Qt)
4268 || EQ(buf->ctl_arrow, Qnil))
4271 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4273 keymap = get_keymap(keymap, 1, 1);
4274 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4275 describe_map_closure.shadow = shadow;
4276 describe_map_closure.list = &list;
4277 describe_map_closure.self_root = keymap;
4278 describe_map_closure.mice_only_p = mice_only_p;
4280 GCPRO4(keymap, elt_prefix, shadow, list);
4282 traverse_keymaps(keymap, Qnil,
4283 describe_map_parent_mapper, &describe_map_closure);
4286 list = list_sort(list, Qnil, describe_map_sort_predicate);
4287 buffer_insert_c_string(buf, "\n");
4288 while (!NILP(list)) {
4289 Lisp_Object elt = XCAR(XCAR(list));
4290 Lisp_Object keysym = XCAR(elt);
4291 int modifiers = XINT(XCDR(elt));
4293 if (!NILP(elt_prefix))
4294 buffer_insert_lisp_string(buf, elt_prefix);
4296 if (modifiers & XEMACS_MOD_META)
4297 buffer_insert_c_string(buf, "M-");
4298 if (modifiers & XEMACS_MOD_CONTROL)
4299 buffer_insert_c_string(buf, "C-");
4300 if (modifiers & XEMACS_MOD_SUPER)
4301 buffer_insert_c_string(buf, "S-");
4302 if (modifiers & XEMACS_MOD_HYPER)
4303 buffer_insert_c_string(buf, "H-");
4304 if (modifiers & XEMACS_MOD_ALT)
4305 buffer_insert_c_string(buf, "Alt-");
4306 if (modifiers & XEMACS_MOD_SHIFT)
4307 buffer_insert_c_string(buf, "Sh-");
4308 if (SYMBOLP(keysym)) {
4310 Fget(keysym, Vcharacter_set_property, Qnil);
4311 Emchar c = (CHAR_OR_CHAR_INTP(code)
4312 ? XCHAR_OR_CHAR_INT(code) : (Emchar)
4314 /* Calling Fsingle_key_description() would cons more */
4315 #if 0 /* This is bogus */
4316 if (EQ(keysym, QKlinefeed))
4317 buffer_insert_c_string(buf, "LFD");
4318 else if (EQ(keysym, QKtab))
4319 buffer_insert_c_string(buf, "TAB");
4320 else if (EQ(keysym, QKreturn))
4321 buffer_insert_c_string(buf, "RET");
4322 else if (EQ(keysym, QKescape))
4323 buffer_insert_c_string(buf, "ESC");
4324 else if (EQ(keysym, QKdelete))
4325 buffer_insert_c_string(buf, "DEL");
4326 else if (EQ(keysym, QKspace))
4327 buffer_insert_c_string(buf, "SPC");
4328 else if (EQ(keysym, QKbackspace))
4329 buffer_insert_c_string(buf, "BS");
4332 if (c >= printable_min)
4333 buffer_insert_emacs_char(buf, c);
4336 Fsymbol_name(keysym));
4337 } else if (CHARP(keysym))
4338 buffer_insert_emacs_char(buf, XCHAR(keysym));
4340 buffer_insert_c_string(buf, "---bad keysym---");
4347 while (elide_next_two_p(list)) {
4353 buffer_insert_c_string(buf,
4356 buffer_insert_c_string(buf,
4363 /* Print a description of the definition of this character. */
4364 (*elt_describer) (XCDR(XCAR(list)), buffer);
4371 void syms_of_keymap(void)
4373 INIT_LRECORD_IMPLEMENTATION(keymap);
4375 defsymbol(&Qminor_mode_map_alist, "minor-mode-map-alist");
4377 defsymbol(&Qkeymapp, "keymapp");
4379 defsymbol(&Qsuppress_keymap, "suppress-keymap");
4381 defsymbol(&Qmodeline_map, "modeline-map");
4382 defsymbol(&Qtoolbar_map, "toolbar-map");
4384 DEFSUBR(Fkeymap_parents);
4385 DEFSUBR(Fset_keymap_parents);
4386 DEFSUBR(Fkeymap_name);
4387 DEFSUBR(Fset_keymap_name);
4388 DEFSUBR(Fkeymap_prompt);
4389 DEFSUBR(Fset_keymap_prompt);
4390 DEFSUBR(Fkeymap_default_binding);
4391 DEFSUBR(Fset_keymap_default_binding);
4394 DEFSUBR(Fmake_keymap);
4395 DEFSUBR(Fmake_sparse_keymap);
4397 DEFSUBR(Fcopy_keymap);
4398 DEFSUBR(Fkeymap_fullness);
4399 DEFSUBR(Fmap_keymap);
4400 DEFSUBR(Fevent_matches_key_specifier_p);
4401 DEFSUBR(Fdefine_key);
4402 DEFSUBR(Flookup_key);
4403 DEFSUBR(Fkey_binding);
4404 DEFSUBR(Fuse_global_map);
4405 DEFSUBR(Fuse_local_map);
4406 DEFSUBR(Fcurrent_local_map);
4407 DEFSUBR(Fcurrent_global_map);
4408 DEFSUBR(Fcurrent_keymaps);
4409 DEFSUBR(Faccessible_keymaps);
4410 DEFSUBR(Fkey_description);
4411 DEFSUBR(Fsingle_key_description);
4412 DEFSUBR(Fwhere_is_internal);
4413 DEFSUBR(Fdescribe_bindings_internal);
4415 DEFSUBR(Ftext_char_description);
4417 defsymbol(&Qcontrol, "control");
4418 defsymbol(&Qctrl, "ctrl");
4419 defsymbol(&Qmeta, "meta");
4420 defsymbol(&Qsuper, "super");
4421 defsymbol(&Qhyper, "hyper");
4422 defsymbol(&Qalt, "alt");
4423 defsymbol(&Qshift, "shift");
4424 defsymbol(&Qbutton0, "button0");
4425 defsymbol(&Qbutton1, "button1");
4426 defsymbol(&Qbutton2, "button2");
4427 defsymbol(&Qbutton3, "button3");
4428 defsymbol(&Qbutton4, "button4");
4429 defsymbol(&Qbutton5, "button5");
4430 defsymbol(&Qbutton6, "button6");
4431 defsymbol(&Qbutton7, "button7");
4432 defsymbol(&Qbutton8, "button8");
4433 defsymbol(&Qbutton9, "button9");
4434 defsymbol(&Qbutton10, "button10");
4435 defsymbol(&Qbutton11, "button11");
4436 defsymbol(&Qbutton12, "button12");
4437 defsymbol(&Qbutton13, "button13");
4438 defsymbol(&Qbutton14, "button14");
4439 defsymbol(&Qbutton15, "button15");
4440 defsymbol(&Qbutton16, "button16");
4441 defsymbol(&Qbutton17, "button17");
4442 defsymbol(&Qbutton18, "button18");
4443 defsymbol(&Qbutton19, "button19");
4444 defsymbol(&Qbutton20, "button20");
4445 defsymbol(&Qbutton21, "button21");
4446 defsymbol(&Qbutton22, "button22");
4447 defsymbol(&Qbutton23, "button23");
4448 defsymbol(&Qbutton24, "button24");
4449 defsymbol(&Qbutton25, "button25");
4450 defsymbol(&Qbutton26, "button26");
4451 defsymbol(&Qbutton27, "button27");
4452 defsymbol(&Qbutton28, "button28");
4453 defsymbol(&Qbutton29, "button29");
4454 defsymbol(&Qbutton30, "button30");
4455 defsymbol(&Qbutton31, "button31");
4456 defsymbol(&Qbutton32, "button32");
4457 defsymbol(&Qbutton0up, "button0up");
4458 defsymbol(&Qbutton1up, "button1up");
4459 defsymbol(&Qbutton2up, "button2up");
4460 defsymbol(&Qbutton3up, "button3up");
4461 defsymbol(&Qbutton4up, "button4up");
4462 defsymbol(&Qbutton5up, "button5up");
4463 defsymbol(&Qbutton6up, "button6up");
4464 defsymbol(&Qbutton7up, "button7up");
4465 defsymbol(&Qbutton8up, "button8up");
4466 defsymbol(&Qbutton9up, "button9up");
4467 defsymbol(&Qbutton10up, "button10up");
4468 defsymbol(&Qbutton11up, "button11up");
4469 defsymbol(&Qbutton12up, "button12up");
4470 defsymbol(&Qbutton13up, "button13up");
4471 defsymbol(&Qbutton14up, "button14up");
4472 defsymbol(&Qbutton15up, "button15up");
4473 defsymbol(&Qbutton16up, "button16up");
4474 defsymbol(&Qbutton17up, "button17up");
4475 defsymbol(&Qbutton18up, "button18up");
4476 defsymbol(&Qbutton19up, "button19up");
4477 defsymbol(&Qbutton20up, "button20up");
4478 defsymbol(&Qbutton21up, "button21up");
4479 defsymbol(&Qbutton22up, "button22up");
4480 defsymbol(&Qbutton23up, "button23up");
4481 defsymbol(&Qbutton24up, "button24up");
4482 defsymbol(&Qbutton25up, "button25up");
4483 defsymbol(&Qbutton26up, "button26up");
4484 defsymbol(&Qbutton27up, "button27up");
4485 defsymbol(&Qbutton28up, "button28up");
4486 defsymbol(&Qbutton29up, "button29up");
4487 defsymbol(&Qbutton30up, "button30up");
4488 defsymbol(&Qbutton31up, "button31up");
4489 defsymbol(&Qbutton32up, "button32up");
4490 defsymbol(&Qmouse_1, "mouse-1");
4491 defsymbol(&Qmouse_2, "mouse-2");
4492 defsymbol(&Qmouse_3, "mouse-3");
4493 defsymbol(&Qmouse_4, "mouse-4");
4494 defsymbol(&Qmouse_5, "mouse-5");
4495 defsymbol(&Qmouse_6, "mouse-6");
4496 defsymbol(&Qmouse_7, "mouse-7");
4497 defsymbol(&Qmouse_8, "mouse-8");
4498 defsymbol(&Qmouse_9, "mouse-9");
4499 defsymbol(&Qmouse_10, "mouse-10");
4500 defsymbol(&Qmouse_11, "mouse-11");
4501 defsymbol(&Qmouse_12, "mouse-12");
4502 defsymbol(&Qmouse_13, "mouse-13");
4503 defsymbol(&Qmouse_14, "mouse-14");
4504 defsymbol(&Qmouse_15, "mouse-15");
4505 defsymbol(&Qmouse_16, "mouse-16");
4506 defsymbol(&Qmouse_17, "mouse-17");
4507 defsymbol(&Qmouse_18, "mouse-18");
4508 defsymbol(&Qmouse_19, "mouse-19");
4509 defsymbol(&Qmouse_20, "mouse-20");
4510 defsymbol(&Qmouse_21, "mouse-21");
4511 defsymbol(&Qmouse_22, "mouse-22");
4512 defsymbol(&Qmouse_23, "mouse-23");
4513 defsymbol(&Qmouse_24, "mouse-24");
4514 defsymbol(&Qmouse_25, "mouse-25");
4515 defsymbol(&Qmouse_26, "mouse-26");
4516 defsymbol(&Qmouse_27, "mouse-27");
4517 defsymbol(&Qmouse_28, "mouse-28");
4518 defsymbol(&Qmouse_29, "mouse-29");
4519 defsymbol(&Qmouse_30, "mouse-30");
4520 defsymbol(&Qmouse_31, "mouse-31");
4521 defsymbol(&Qmouse_32, "mouse-32");
4522 defsymbol(&Qdown_mouse_1, "down-mouse-1");
4523 defsymbol(&Qdown_mouse_2, "down-mouse-2");
4524 defsymbol(&Qdown_mouse_3, "down-mouse-3");
4525 defsymbol(&Qdown_mouse_4, "down-mouse-4");
4526 defsymbol(&Qdown_mouse_5, "down-mouse-5");
4527 defsymbol(&Qdown_mouse_6, "down-mouse-6");
4528 defsymbol(&Qdown_mouse_7, "down-mouse-7");
4529 defsymbol(&Qdown_mouse_8, "down-mouse-8");
4530 defsymbol(&Qdown_mouse_9, "down-mouse-9");
4531 defsymbol(&Qdown_mouse_10, "down-mouse-10");
4532 defsymbol(&Qdown_mouse_11, "down-mouse-11");
4533 defsymbol(&Qdown_mouse_12, "down-mouse-12");
4534 defsymbol(&Qdown_mouse_13, "down-mouse-13");
4535 defsymbol(&Qdown_mouse_14, "down-mouse-14");
4536 defsymbol(&Qdown_mouse_15, "down-mouse-15");
4537 defsymbol(&Qdown_mouse_16, "down-mouse-16");
4538 defsymbol(&Qdown_mouse_17, "down-mouse-17");
4539 defsymbol(&Qdown_mouse_18, "down-mouse-18");
4540 defsymbol(&Qdown_mouse_19, "down-mouse-19");
4541 defsymbol(&Qdown_mouse_20, "down-mouse-20");
4542 defsymbol(&Qdown_mouse_21, "down-mouse-21");
4543 defsymbol(&Qdown_mouse_22, "down-mouse-22");
4544 defsymbol(&Qdown_mouse_23, "down-mouse-23");
4545 defsymbol(&Qdown_mouse_24, "down-mouse-24");
4546 defsymbol(&Qdown_mouse_25, "down-mouse-25");
4547 defsymbol(&Qdown_mouse_26, "down-mouse-26");
4548 defsymbol(&Qdown_mouse_27, "down-mouse-27");
4549 defsymbol(&Qdown_mouse_28, "down-mouse-28");
4550 defsymbol(&Qdown_mouse_29, "down-mouse-29");
4551 defsymbol(&Qdown_mouse_30, "down-mouse-30");
4552 defsymbol(&Qdown_mouse_31, "down-mouse-31");
4553 defsymbol(&Qdown_mouse_32, "down-mouse-32");
4554 defsymbol(&Qmenu_selection, "menu-selection");
4555 defsymbol(&QLFD, "LFD");
4556 defsymbol(&QTAB, "TAB");
4557 defsymbol(&QRET, "RET");
4558 defsymbol(&QESC, "ESC");
4559 defsymbol(&QDEL, "DEL");
4560 defsymbol(&QSPC, "SPC");
4561 defsymbol(&QBS, "BS");
4564 void vars_of_keymap(void)
4566 DEFVAR_LISP("meta-prefix-char", &Vmeta_prefix_char /*
4567 Meta-prefix character.
4568 This character followed by some character `foo' turns into `Meta-foo'.
4569 This can be any form recognized as a single key specifier.
4570 To disable the meta-prefix-char, set it to a negative number.
4572 Vmeta_prefix_char = make_char(033);
4574 DEFVAR_LISP("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4575 A buffer which should be consulted first for all mouse activity.
4576 When a mouse-click is processed, it will first be looked up in the
4577 local-map of this buffer, and then through the normal mechanism if there
4578 is no binding for that click. This buffer's value of `mode-motion-hook'
4579 will be consulted instead of the `mode-motion-hook' of the buffer of the
4580 window under the mouse. You should *bind* this, not set it.
4582 Vmouse_grabbed_buffer = Qnil;
4584 DEFVAR_LISP("overriding-local-map", &Voverriding_local_map /*
4585 Keymap that overrides all other local keymaps.
4586 If this variable is non-nil, it is used as a keymap instead of the
4587 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4588 You should *bind* this, not set it.
4590 Voverriding_local_map = Qnil;
4592 Fset(Qminor_mode_map_alist, Qnil);
4594 DEFVAR_LISP("key-translation-map", &Vkey_translation_map /*
4595 Keymap of key translations that can override keymaps.
4597 This keymap works like `function-key-map', but is searched before it,
4598 and applies even for keys that have ordinary bindings.
4600 The `read-key-sequence' function replaces any subsequence bound by
4601 `key-translation-map' with its binding. More precisely, when the active
4602 keymaps have no binding for the current key sequence but
4603 `key-translation-map' binds a suffix of the sequence to a vector or string,
4604 `read-key-sequence' replaces the matching suffix with its binding, and
4605 continues with the new sequence. See `key-binding' for details.
4607 The events that come from bindings in `key-translation-map' are not
4608 themselves looked up in `key-translation-map'.
4610 #### FIXME: stolen from `function-key-map'; need better example.
4611 #### I guess you could implement a Dvorak keyboard with this?
4612 For example, suppose `key-translation-map' binds `ESC O P' to [f1].
4613 Typing `ESC O P' to `read-key-sequence' would return
4614 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return
4615 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1]
4616 were a prefix key, typing `ESC O P x' would return
4617 \[#<keypress-event f1> #<keypress-event x>].
4619 Vkey_translation_map = Qnil;
4621 DEFVAR_LISP ("global-tty-map", &Vglobal_tty_map /*
4622 Global keymap that applies only to TTY's.
4623 Key bindings are looked up in this map just before looking in the global map,
4624 but only when the current console is a TTY console. See also
4625 `global-window-system-map'.
4627 Vglobal_tty_map = Qnil;
4629 DEFVAR_LISP ("global-window-system-map", &Vglobal_window_system_map /*
4630 Global keymap that applies only to window systems.
4631 Key bindings are looked up in this map just before looking in the global map,
4632 but only when the current console is not a TTY console. See also
4635 Vglobal_window_system_map = Qnil;
4637 DEFVAR_LISP("vertical-divider-map", &Vvertical_divider_map /*
4638 Keymap which handles mouse clicks over vertical dividers.
4640 Vvertical_divider_map = Qnil;
4642 DEFVAR_INT("keymap-tick", &keymap_tick /*
4643 Incremented for each change to any keymap.
4647 staticpro(&Vcurrent_global_map);
4649 Vsingle_space_string = make_string((const Bufbyte *)" ", 1);
4650 staticpro(&Vsingle_space_string);
4653 void complex_vars_of_keymap(void)
4655 /* This function can GC */
4656 Lisp_Object ESC_prefix = intern("ESC-prefix");
4657 Lisp_Object meta_disgustitute;
4659 Vcurrent_global_map = Fmake_keymap(Qnil);
4660 Vglobal_tty_map = Fmake_keymap (intern ("global-tty-map"));
4661 Vglobal_window_system_map =
4662 Fmake_keymap (intern ("global-window-system-map"));
4664 meta_disgustitute = Fmake_keymap(Qnil);
4665 Ffset(ESC_prefix, meta_disgustitute);
4666 /* no need to protect meta_disgustitute, though */
4667 keymap_store_internal(MAKE_MODIFIER_HASH_KEY(XEMACS_MOD_META),
4668 XKEYMAP(Vcurrent_global_map), meta_disgustitute);
4669 XKEYMAP(Vcurrent_global_map)->sub_maps_cache = Qt;
4671 Vkey_translation_map =
4672 Fmake_sparse_keymap(intern("key-translation-map"));