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 Totally redesigned by jwz in 1991.
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially
25 different from FSF. */
42 /* Hmm, under unix we want X modifiers, under NT we want X modifiers if
43 we are running X and Windows modifiers otherwise.
44 gak. This is a kludge until we support multiple native GUIs!
51 #include "events-mod.h"
54 /* A keymap contains six slots:
56 parents Ordered list of keymaps to search after
57 this one if no match is found.
58 Keymaps can thus be arranged in a hierarchy.
60 table A hash table, hashing keysyms to their bindings.
61 It will be one of the following:
63 -- a symbol, e.g. 'home
64 -- a character, representing something printable
65 (not ?\C-c meaning C-c, for instance)
66 -- an integer representing a modifier combination
68 inverse_table A hash table, hashing bindings to the list of keysyms
69 in this keymap which are bound to them. This is to make
70 the Fwhere_is_internal() function be fast. It needs to be
71 fast because we want to be able to call it in realtime to
72 update the keyboard-equivalents on the pulldown menus.
73 Values of the table are either atoms (keysyms)
74 or a dotted list of keysyms.
76 sub_maps_cache An alist; for each entry in this keymap whose binding is
77 a keymap (that is, Fkeymapp()) this alist associates that
78 keysym with that binding. This is used to optimize both
79 Fwhere_is_internal() and Faccessible_keymaps(). This slot
80 gets set to the symbol `t' every time a change is made to
81 this keymap, causing it to be recomputed when next needed.
83 prompt See `set-keymap-prompt'.
85 default_binding See `set-keymap-default-binding'.
87 Sequences of keys are stored in the obvious way: if the sequence of keys
88 "abc" was bound to some command `foo', the hierarchy would look like
90 keymap-1: associates "a" with keymap-2
91 keymap-2: associates "b" with keymap-3
92 keymap-3: associates "c" with foo
94 However, bucky bits ("modifiers" to the X-minded) are represented in the
95 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
96 Each combination of modifiers (e.g. control-hyper) gets its own submap
97 off of the main map. The hash key for a modifier combination is
98 an integer, computed by MAKE_MODIFIER_HASH_KEY().
100 If the key `C-a' was bound to some command, the hierarchy would look like
102 keymap-1: associates the integer MOD_CONTROL with keymap-2
103 keymap-2: associates "a" with the command
105 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
108 keymap-1: associates the integer (MOD_CONTROL | MOD_HYPER)
110 keymap-2: associates "a" with the command
112 Note that a special exception is made for the meta modifier, in order
113 to deal with ESC/meta lossage. Any key combination containing the
114 meta modifier is first indexed off of the main map into the meta
115 submap (with hash key MOD_META) and then indexed off of the
116 meta submap with the meta modifier removed from the key combination.
117 For example, when associating a command with C-M-H-a, we'd have
119 keymap-1: associates the integer MOD_META with keymap-2
120 keymap-2: associates the integer (MOD_CONTROL | MOD_HYPER)
122 keymap-3: associates "a" with the command
124 Note that keymap-2 might have normal bindings in it; these would be
125 for key combinations containing only the meta modifier, such as
126 M-y or meta-backspace.
128 If the command that "a" was bound to in keymap-3 was itself a keymap,
129 then that would make the key "C-M-H-a" be a prefix character.
131 Note that this new model of keymaps takes much of the magic away from
132 the Escape key: the value of the variable `esc-map' is no longer indexed
133 in the `global-map' under the ESC key. It's indexed under the integer
134 MOD_META. This is not user-visible, however; none of the "bucky"
137 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
138 and (define-key some-random-map "\^[" my-esc-map) work as before, for
141 Since keymaps are opaque, the only way to extract information from them
142 is with the functions lookup-key, key-binding, local-key-binding, and
143 global-key-binding, which work just as before, and the new function
144 map-keymap, which is roughly analagous to maphash.
146 Note that map-keymap perpetuates the illusion that the "bucky" submaps
147 don't exist: if you map over a keymap with bucky submaps, it will also
148 map over those submaps. It does not, however, map over other random
149 submaps of the keymap, just the bucky ones.
151 One implication of this is that when you map over `global-map', you will
152 also map over `esc-map'. It is merely for compatibility that the esc-map
153 is accessible at all; I think that's a bad thing, since it blurs the
154 distinction between ESC and "meta" even more. "M-x" is no more a two-
155 key sequence than "C-x" is.
159 typedef struct Lisp_Keymap
161 struct lcrecord_header header;
162 Lisp_Object parents; /* Keymaps to be searched after this one
164 Lisp_Object prompt; /* Qnil or a string to print in the minibuffer
165 * when reading from this keymap */
167 Lisp_Object table; /* The contents of this keymap */
168 Lisp_Object inverse_table; /* The inverse mapping of the above */
170 Lisp_Object default_binding; /* Use this if no other binding is found
171 * (this overrides parent maps and the
172 * normal global-map lookup). */
175 Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps;
176 This holds an alist, of the key and the
177 maps, or the modifier bit and the map.
178 If this is the symbol t, then the cache
179 needs to be recomputed.
181 int fullness; /* How many entries there are in this table.
182 This should be the same as the fullness
183 of the `table', but hash.c is broken. */
184 Lisp_Object name; /* Just for debugging convenience */
187 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
188 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
192 /* Actually allocate storage for these variables */
194 static Lisp_Object Vcurrent_global_map; /* Always a keymap */
196 static Lisp_Object Vmouse_grabbed_buffer;
198 /* Alist of minor mode variables and keymaps. */
199 static Lisp_Object Qminor_mode_map_alist;
201 static Lisp_Object Voverriding_local_map;
203 static Lisp_Object Vkey_translation_map;
205 static Lisp_Object Vvertical_divider_map;
207 /* This is incremented whenever a change is made to a keymap. This is
208 so that things which care (such as the menubar code) can recompute
209 privately-cached data when the user has changed keybindings.
213 /* Prefixing a key with this character is the same as sending a meta bit. */
214 Lisp_Object Vmeta_prefix_char;
216 Lisp_Object Qkeymapp;
217 Lisp_Object Vsingle_space_string;
218 Lisp_Object Qsuppress_keymap;
219 Lisp_Object Qmodeline_map;
220 Lisp_Object Qtoolbar_map;
222 EXFUN (Fkeymap_fullness, 1);
223 EXFUN (Fset_keymap_name, 2);
224 EXFUN (Fsingle_key_description, 1);
226 static void describe_command (Lisp_Object definition, Lisp_Object buffer);
227 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
228 void (*elt_describer) (Lisp_Object, Lisp_Object),
234 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
235 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3;
236 Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7;
237 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up;
238 Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up;
240 Lisp_Object Qmenu_selection;
241 /* Emacs compatibility */
242 Lisp_Object Qdown_mouse_1, Qdown_mouse_2, Qdown_mouse_3, Qdown_mouse_4,
244 Lisp_Object Qmouse_1, Qmouse_2, Qmouse_3, Qmouse_4, Qmouse_5;
246 /* Kludge kludge kludge */
247 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
250 /************************************************************************/
251 /* The keymap Lisp object */
252 /************************************************************************/
255 mark_keymap (Lisp_Object obj, void (*markobj) (Lisp_Object))
257 Lisp_Keymap *keymap = XKEYMAP (obj);
258 markobj (keymap->parents);
259 markobj (keymap->prompt);
260 markobj (keymap->inverse_table);
261 markobj (keymap->sub_maps_cache);
262 markobj (keymap->default_binding);
263 markobj (keymap->name);
264 return keymap->table;
268 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
270 /* This function can GC */
271 Lisp_Keymap *keymap = XKEYMAP (obj);
273 int size = XINT (Fkeymap_fullness (obj));
275 error ("printing unreadable object #<keymap 0x%x>", keymap->header.uid);
276 write_c_string ("#<keymap ", printcharfun);
277 if (!NILP (keymap->name))
278 print_internal (keymap->name, printcharfun, 1);
279 /* #### Yuck! This is no way to form plural! --hniksic */
280 sprintf (buf, "%s%d entr%s 0x%x>",
281 ((NILP (keymap->name)) ? "" : " "),
283 ((size == 1) ? "y" : "ies"),
285 write_c_string (buf, printcharfun);
288 static const struct lrecord_description keymap_description[] = {
289 { XD_LISP_OBJECT, offsetof(Lisp_Keymap, parents), 6 },
290 { XD_LISP_OBJECT, offsetof(Lisp_Keymap, name), 1 },
294 /* No need for keymap_equal #### Why not? */
295 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap,
296 mark_keymap, print_keymap, 0, 0, 0,
300 /************************************************************************/
301 /* Traversing keymaps and their parents */
302 /************************************************************************/
305 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents,
306 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg),
309 /* This function can GC */
311 Lisp_Object tail = start_parents;
312 Lisp_Object malloc_sucks[10];
313 Lisp_Object malloc_bites = Qnil;
315 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
316 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail);
319 start_keymap = get_keymap (start_keymap, 1, 1);
320 keymap = start_keymap;
321 /* Hack special-case parents at top-level */
322 tail = ((!NILP (tail)) ? tail : XKEYMAP (keymap)->parents);
329 result = ((mapper) (keymap, mapper_arg));
332 while (CONSP (malloc_bites))
334 struct Lisp_Cons *victim = XCONS (malloc_bites);
335 malloc_bites = victim->cdr;
343 if (stack_depth == 0)
346 return Qnil; /* Nothing found */
349 if (CONSP (malloc_bites))
351 struct Lisp_Cons *victim = XCONS (malloc_bites);
353 malloc_bites = victim->cdr;
358 tail = malloc_sucks[stack_depth];
359 gcpro1.nvars = stack_depth;
361 keymap = XCAR (tail);
368 keymap = XCAR (tail);
370 parents = XKEYMAP (keymap)->parents;
371 if (!CONSP (parents))
373 else if (NILP (tail))
378 if (CONSP (malloc_bites))
379 malloc_bites = noseeum_cons (tail, malloc_bites);
380 else if (stack_depth < countof (malloc_sucks))
382 malloc_sucks[stack_depth++] = tail;
383 gcpro1.nvars = stack_depth;
387 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */
389 for (i = 0, malloc_bites = Qnil;
390 i < countof (malloc_sucks);
392 malloc_bites = noseeum_cons (malloc_sucks[i],
399 keymap = get_keymap (keymap, 1, 1);
400 if (EQ (keymap, start_keymap))
402 signal_simple_error ("Cyclic keymap indirection",
409 /************************************************************************/
410 /* Some low-level functions */
411 /************************************************************************/
414 bucky_sym_to_bucky_bit (Lisp_Object sym)
416 if (EQ (sym, Qcontrol)) return MOD_CONTROL;
417 if (EQ (sym, Qmeta)) return MOD_META;
418 if (EQ (sym, Qsuper)) return MOD_SUPER;
419 if (EQ (sym, Qhyper)) return MOD_HYPER;
420 if (EQ (sym, Qalt)) return MOD_ALT;
421 if (EQ (sym, Qsymbol)) return MOD_ALT; /* #### - reverse compat */
422 if (EQ (sym, Qshift)) return MOD_SHIFT;
428 control_meta_superify (Lisp_Object frob, unsigned int modifiers)
432 frob = Fcons (frob, Qnil);
433 if (modifiers & MOD_SHIFT) frob = Fcons (Qshift, frob);
434 if (modifiers & MOD_ALT) frob = Fcons (Qalt, frob);
435 if (modifiers & MOD_HYPER) frob = Fcons (Qhyper, frob);
436 if (modifiers & MOD_SUPER) frob = Fcons (Qsuper, frob);
437 if (modifiers & MOD_CONTROL) frob = Fcons (Qcontrol, frob);
438 if (modifiers & MOD_META) frob = Fcons (Qmeta, frob);
443 make_key_description (CONST struct key_data *key, int prettify)
445 Lisp_Object keysym = key->keysym;
446 unsigned int modifiers = key->modifiers;
448 if (prettify && CHARP (keysym))
450 /* This is a little slow, but (control a) is prettier than (control 65).
451 It's now ok to do this for digit-chars too, since we've fixed the
452 bug where \9 read as the integer 9 instead of as the symbol with
455 /* !!#### I'm not sure how correct this is. */
456 Bufbyte str [1 + MAX_EMCHAR_LEN];
457 Bytecount count = set_charptr_emchar (str, XCHAR (keysym));
459 keysym = intern ((char *) str);
461 return control_meta_superify (keysym, modifiers);
465 /************************************************************************/
466 /* Low-level keymap-store functions */
467 /************************************************************************/
470 raw_lookup_key (Lisp_Object keymap,
471 CONST struct key_data *raw_keys, int raw_keys_count,
472 int keys_so_far, int accept_default);
474 /* Relies on caller to gc-protect args */
476 keymap_lookup_directly (Lisp_Object keymap,
477 Lisp_Object keysym, unsigned int modifiers)
481 if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
482 | MOD_ALT | MOD_SHIFT)) != 0)
485 k = XKEYMAP (keymap);
487 /* If the keysym is a one-character symbol, use the char code instead. */
488 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
490 Lisp_Object i_fart_on_gcc =
491 make_char (string_char (XSYMBOL (keysym)->name, 0));
492 keysym = i_fart_on_gcc;
495 if (modifiers & MOD_META) /* Utterly hateful ESC lossage */
497 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
501 k = XKEYMAP (submap);
502 modifiers &= ~MOD_META;
507 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
511 k = XKEYMAP (submap);
513 return Fgethash (keysym, k->table, Qnil);
517 keymap_store_inverse_internal (Lisp_Object inverse_table,
521 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
526 /* Don't cons this unless necessary */
527 /* keys = Fcons (keysym, Qnil); */
528 Fputhash (value, keys, inverse_table);
530 else if (!CONSP (keys))
532 /* Now it's necessary to cons */
533 keys = Fcons (keys, keysym);
534 Fputhash (value, keys, inverse_table);
538 while (CONSP (XCDR (keys)))
540 XCDR (keys) = Fcons (XCDR (keys), keysym);
541 /* No need to call puthash because we've destructively
542 modified the list tail in place */
548 keymap_delete_inverse_internal (Lisp_Object inverse_table,
552 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
553 Lisp_Object new_keys = keys;
560 for (prev = &new_keys, tail = new_keys;
562 prev = &(XCDR (tail)), tail = XCDR (tail))
564 if (EQ (tail, keysym))
569 else if (EQ (keysym, XCAR (tail)))
577 Fremhash (value, inverse_table);
578 else if (!EQ (keys, new_keys))
579 /* Removed the first elt */
580 Fputhash (value, new_keys, inverse_table);
581 /* else the list's tail has been modified, so we don't need to
582 touch the hash table again (the pointer in there is ok).
588 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
591 Lisp_Object prev_value = Fgethash (keysym, keymap->table, Qnil);
593 if (EQ (prev_value, value))
595 if (!NILP (prev_value))
596 keymap_delete_inverse_internal (keymap->inverse_table,
601 if (keymap->fullness < 0) abort ();
602 Fremhash (keysym, keymap->table);
606 if (NILP (prev_value))
608 Fputhash (keysym, value, keymap->table);
609 keymap_store_inverse_internal (keymap->inverse_table,
617 create_bucky_submap (Lisp_Keymap *k, unsigned int modifiers,
618 Lisp_Object parent_for_debugging_info)
620 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
621 /* User won't see this, but it is nice for debugging Emacs */
622 XKEYMAP (submap)->name
623 = control_meta_superify (parent_for_debugging_info, modifiers);
624 /* Invalidate cache */
625 k->sub_maps_cache = Qt;
626 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
631 /* Relies on caller to gc-protect keymap, keysym, value */
633 keymap_store (Lisp_Object keymap, CONST struct key_data *key,
636 Lisp_Object keysym = key->keysym;
637 unsigned int modifiers = key->modifiers;
640 if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
641 | MOD_ALT | MOD_SHIFT)) != 0)
644 k = XKEYMAP (keymap);
646 /* If the keysym is a one-character symbol, use the char code instead. */
647 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
649 Lisp_Object run_the_gcc_developers_over_with_a_steamroller =
650 make_char (string_char (XSYMBOL (keysym)->name, 0));
651 keysym = run_the_gcc_developers_over_with_a_steamroller;
654 if (modifiers & MOD_META) /* Utterly hateful ESC lossage */
656 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
659 submap = create_bucky_submap (k, MOD_META, keymap);
660 k = XKEYMAP (submap);
661 modifiers &= ~MOD_META;
666 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
669 submap = create_bucky_submap (k, modifiers, keymap);
670 k = XKEYMAP (submap);
672 k->sub_maps_cache = Qt; /* Invalidate cache */
673 keymap_store_internal (keysym, k, value);
677 /************************************************************************/
678 /* Listing the submaps of a keymap */
679 /************************************************************************/
681 struct keymap_submaps_closure
683 Lisp_Object *result_locative;
687 keymap_submaps_mapper_0 (Lisp_Object key, Lisp_Object value,
688 void *keymap_submaps_closure)
690 /* This function can GC */
691 /* Perform any autoloads, etc */
697 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value,
698 void *keymap_submaps_closure)
700 /* This function can GC */
701 Lisp_Object *result_locative;
702 struct keymap_submaps_closure *cl =
703 (struct keymap_submaps_closure *) keymap_submaps_closure;
704 result_locative = cl->result_locative;
706 if (!NILP (Fkeymapp (value)))
707 *result_locative = Fcons (Fcons (key, value), *result_locative);
711 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
715 keymap_submaps (Lisp_Object keymap)
717 /* This function can GC */
718 Lisp_Keymap *k = XKEYMAP (keymap);
720 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
722 Lisp_Object result = Qnil;
723 struct gcpro gcpro1, gcpro2;
724 struct keymap_submaps_closure keymap_submaps_closure;
726 GCPRO2 (keymap, result);
727 keymap_submaps_closure.result_locative = &result;
728 /* Do this first pass to touch (and load) any autoloaded maps */
729 elisp_maphash (keymap_submaps_mapper_0, k->table,
730 &keymap_submaps_closure);
732 elisp_maphash (keymap_submaps_mapper, k->table,
733 &keymap_submaps_closure);
734 /* keep it sorted so that the result of accessible-keymaps is ordered */
735 k->sub_maps_cache = list_sort (result,
737 map_keymap_sort_predicate);
740 return k->sub_maps_cache;
744 /************************************************************************/
745 /* Basic operations on keymaps */
746 /************************************************************************/
749 make_keymap (size_t size)
752 Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, &lrecord_keymap);
754 XSETKEYMAP (result, keymap);
756 keymap->parents = Qnil;
757 keymap->prompt = Qnil;
758 keymap->table = Qnil;
759 keymap->inverse_table = Qnil;
760 keymap->default_binding = Qnil;
761 keymap->sub_maps_cache = Qnil; /* No possible submaps */
762 keymap->fullness = 0;
765 if (size != 0) /* hack for copy-keymap */
768 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
769 /* Inverse table is often less dense because of duplicate key-bindings.
770 If not, it will grow anyway. */
771 keymap->inverse_table =
772 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
777 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
778 Construct and return a new keymap object.
779 All entries in it are nil, meaning "command undefined".
781 Optional argument NAME specifies a name to assign to the keymap,
782 as in `set-keymap-name'. This name is only a debugging convenience;
783 it is not used except when printing the keymap.
787 Lisp_Object keymap = make_keymap (60);
789 Fset_keymap_name (keymap, name);
793 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
794 Construct and return a new keymap object.
795 All entries in it are nil, meaning "command undefined". The only
796 difference between this function and make-keymap is that this function
797 returns a "smaller" keymap (one that is expected to contain fewer
798 entries). As keymaps dynamically resize, the distinction is not great.
800 Optional argument NAME specifies a name to assign to the keymap,
801 as in `set-keymap-name'. This name is only a debugging convenience;
802 it is not used except when printing the keymap.
806 Lisp_Object keymap = make_keymap (8);
808 Fset_keymap_name (keymap, name);
812 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
813 Return the `parent' keymaps of KEYMAP, or nil.
814 The parents of a keymap are searched for keybindings when a key sequence
815 isn't bound in this one. `(current-global-map)' is the default parent
820 keymap = get_keymap (keymap, 1, 1);
821 return Fcopy_sequence (XKEYMAP (keymap)->parents);
827 traverse_keymaps_noop (Lisp_Object keymap, void *arg)
832 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
833 Set the `parent' keymaps of KEYMAP to PARENTS.
834 The parents of a keymap are searched for keybindings when a key sequence
835 isn't bound in this one. `(current-global-map)' is the default parent
840 /* This function can GC */
842 struct gcpro gcpro1, gcpro2;
844 GCPRO2 (keymap, parents);
845 keymap = get_keymap (keymap, 1, 1);
847 if (KEYMAPP (parents)) /* backwards-compatibility */
848 parents = list1 (parents);
851 Lisp_Object tail = parents;
857 /* Require that it be an actual keymap object, rather than a symbol
858 with a (crockish) symbol-function which is a keymap */
859 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
864 /* Check for circularities */
865 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
867 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
872 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
873 Set the `name' of the KEYMAP to NEW-NAME.
874 The name is only a debugging convenience; it is not used except
875 when printing the keymap.
879 keymap = get_keymap (keymap, 1, 1);
881 XKEYMAP (keymap)->name = new_name;
885 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
886 Return the `name' of KEYMAP.
887 The name is only a debugging convenience; it is not used except
888 when printing the keymap.
892 keymap = get_keymap (keymap, 1, 1);
894 return XKEYMAP (keymap)->name;
897 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
898 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
899 if no prompt is desired. The prompt is shown in the echo-area
900 when reading a key-sequence to be looked-up in this keymap.
902 (keymap, new_prompt))
904 keymap = get_keymap (keymap, 1, 1);
906 if (!NILP (new_prompt))
907 CHECK_STRING (new_prompt);
909 XKEYMAP (keymap)->prompt = new_prompt;
914 keymap_prompt_mapper (Lisp_Object keymap, void *arg)
916 return XKEYMAP (keymap)->prompt;
920 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
921 Return the `prompt' of KEYMAP.
922 If non-nil, the prompt is shown in the echo-area
923 when reading a key-sequence to be looked-up in this keymap.
925 (keymap, use_inherited))
927 /* This function can GC */
930 keymap = get_keymap (keymap, 1, 1);
931 prompt = XKEYMAP (keymap)->prompt;
932 if (!NILP (prompt) || NILP (use_inherited))
935 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
938 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
939 Sets the default binding of KEYMAP to COMMAND, or `nil'
940 if no default is desired. The default-binding is returned when
941 no other binding for a key-sequence is found in the keymap.
942 If a keymap has a non-nil default-binding, neither the keymap's
943 parents nor the current global map are searched for key bindings.
947 /* This function can GC */
948 keymap = get_keymap (keymap, 1, 1);
950 XKEYMAP (keymap)->default_binding = command;
954 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
955 Return the default binding of KEYMAP, or `nil' if it has none.
956 The default-binding is returned when no other binding for a key-sequence
957 is found in the keymap.
958 If a keymap has a non-nil default-binding, neither the keymap's
959 parents nor the current global map are searched for key bindings.
963 /* This function can GC */
964 keymap = get_keymap (keymap, 1, 1);
965 return XKEYMAP (keymap)->default_binding;
968 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
969 Return t if ARG is a keymap object.
970 The keymap may be autoloaded first if necessary.
974 /* This function can GC */
975 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
978 /* Check that OBJECT is a keymap (after dereferencing through any
979 symbols). If it is, return it.
981 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
982 is an autoload form, do the autoload and try again.
983 If AUTOLOAD is nonzero, callers must assume GC is possible.
985 ERRORP controls how we respond if OBJECT isn't a keymap.
986 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
988 Note that most of the time, we don't want to pursue autoloads.
989 Functions like Faccessible_keymaps which scan entire keymap trees
990 shouldn't load every autoloaded keymap. I'm not sure about this,
991 but it seems to me that only read_key_sequence, Flookup_key, and
992 Fdefine_key should cause keymaps to be autoloaded. */
995 get_keymap (Lisp_Object object, int errorp, int autoload)
997 /* This function can GC */
1000 Lisp_Object tem = indirect_function (object, 0);
1004 /* Should we do an autoload? */
1006 /* (autoload "filename" doc nil keymap) */
1009 && EQ (XCAR (tem), Qautoload)
1010 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
1012 struct gcpro gcpro1, gcpro2;
1013 GCPRO2 (tem, object);
1014 do_autoload (tem, object);
1018 object = wrong_type_argument (Qkeymapp, object);
1024 /* Given OBJECT which was found in a slot in a keymap,
1025 trace indirect definitions to get the actual definition of that slot.
1026 An indirect definition is a list of the form
1027 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1028 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1031 get_keyelt (Lisp_Object object, int accept_default)
1033 /* This function can GC */
1037 if (!CONSP (object))
1041 struct gcpro gcpro1;
1043 map = XCAR (object);
1044 map = get_keymap (map, 0, 1);
1047 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1050 Lisp_Object idx = Fcdr (object);
1051 struct key_data indirection;
1054 struct Lisp_Event event;
1055 event.event_type = empty_event;
1056 character_to_event (XCHAR (idx), &event,
1057 XCONSOLE (Vselected_console), 0, 0);
1058 indirection = event.event.key;
1060 else if (CONSP (idx))
1062 if (!INTP (XCDR (idx)))
1064 indirection.keysym = XCAR (idx);
1065 indirection.modifiers = XINT (XCDR (idx));
1067 else if (SYMBOLP (idx))
1069 indirection.keysym = idx;
1070 indirection.modifiers = 0;
1077 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
1079 else if (STRINGP (XCAR (object)))
1081 /* If the keymap contents looks like (STRING . DEFN),
1083 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1084 will be used by HierarKey menus. */
1085 object = XCDR (object);
1090 /* Anything else is really the value. */
1096 keymap_lookup_1 (Lisp_Object keymap, CONST struct key_data *key,
1099 /* This function can GC */
1100 return get_keyelt (keymap_lookup_directly (keymap,
1101 key->keysym, key->modifiers),
1106 /************************************************************************/
1107 /* Copying keymaps */
1108 /************************************************************************/
1110 struct copy_keymap_inverse_closure
1112 Lisp_Object inverse_table;
1116 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value,
1117 void *copy_keymap_inverse_closure)
1119 struct copy_keymap_inverse_closure *closure =
1120 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
1122 /* copy-sequence deals with dotted lists. */
1124 value = Fcopy_list (value);
1125 Fputhash (key, value, closure->inverse_table);
1132 copy_keymap_internal (Lisp_Keymap *keymap)
1134 Lisp_Object nkm = make_keymap (0);
1135 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
1136 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1137 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1139 new_keymap->parents = Fcopy_sequence (keymap->parents);
1140 new_keymap->fullness = keymap->fullness;
1141 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1142 new_keymap->table = Fcopy_hash_table (keymap->table);
1143 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table);
1144 new_keymap->default_binding = keymap->default_binding;
1145 /* After copying the inverse map, we need to copy the conses which
1146 are its values, lest they be shared by the copy, and mangled.
1148 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
1149 ©_keymap_inverse_closure);
1154 static Lisp_Object copy_keymap (Lisp_Object keymap);
1156 struct copy_keymap_closure
1162 copy_keymap_mapper (Lisp_Object key, Lisp_Object value,
1163 void *copy_keymap_closure)
1165 /* This function can GC */
1166 struct copy_keymap_closure *closure =
1167 (struct copy_keymap_closure *) copy_keymap_closure;
1169 /* When we encounter a keymap which is indirected through a
1170 symbol, we need to copy the sub-map. In v18, the form
1171 (lookup-key (copy-keymap global-map) "\C-x")
1172 returned a new keymap, not the symbol 'Control-X-prefix.
1174 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */
1175 if (KEYMAPP (value))
1176 keymap_store_internal (key, closure->self,
1177 copy_keymap (value));
1182 copy_keymap (Lisp_Object keymap)
1184 /* This function can GC */
1185 struct copy_keymap_closure copy_keymap_closure;
1187 keymap = copy_keymap_internal (XKEYMAP (keymap));
1188 copy_keymap_closure.self = XKEYMAP (keymap);
1189 elisp_maphash (copy_keymap_mapper,
1190 XKEYMAP (keymap)->table,
1191 ©_keymap_closure);
1195 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1196 Return a copy of the keymap KEYMAP.
1197 The copy starts out with the same definitions of KEYMAP,
1198 but changing either the copy or KEYMAP does not affect the other.
1199 Any key definitions that are subkeymaps are recursively copied.
1203 /* This function can GC */
1204 keymap = get_keymap (keymap, 1, 1);
1205 return copy_keymap (keymap);
1210 keymap_fullness (Lisp_Object keymap)
1212 /* This function can GC */
1214 Lisp_Object sub_maps;
1215 struct gcpro gcpro1, gcpro2;
1217 keymap = get_keymap (keymap, 1, 1);
1218 fullness = XKEYMAP (keymap)->fullness;
1219 sub_maps = keymap_submaps (keymap);
1220 GCPRO2 (keymap, sub_maps);
1221 for (; !NILP (sub_maps); sub_maps = XCDR (sub_maps))
1223 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
1225 Lisp_Object sub_map = XCDR (XCAR (sub_maps));
1226 fullness--; /* don't count bucky maps */
1227 fullness += keymap_fullness (sub_map);
1234 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1235 Return the number of bindings in the keymap.
1239 /* This function can GC */
1240 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
1244 /************************************************************************/
1245 /* Defining keys in keymaps */
1246 /************************************************************************/
1248 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1249 and perform any necessary canonicalization. */
1252 define_key_check_and_coerce_keysym (Lisp_Object spec,
1253 Lisp_Object *keysym,
1254 unsigned int modifiers)
1256 /* Now, check and massage the trailing keysym specifier. */
1257 if (SYMBOLP (*keysym))
1259 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
1261 Lisp_Object ream_gcc_up_the_ass =
1262 make_char (string_char (XSYMBOL (*keysym)->name, 0));
1263 *keysym = ream_gcc_up_the_ass;
1267 else if (CHAR_OR_CHAR_INTP (*keysym))
1269 CHECK_CHAR_COERCE_INT (*keysym);
1271 if (XCHAR (*keysym) < ' '
1272 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
1273 /* yuck! Can't make the above restriction; too many compatibility
1275 signal_simple_error ("keysym char must be printable", *keysym);
1276 /* #### This bites! I want to be able to write (control shift a) */
1277 if (modifiers & MOD_SHIFT)
1279 ("The `shift' modifier may not be applied to ASCII keysyms",
1284 signal_simple_error ("Unknown keysym specifier",
1288 if (SYMBOLP (*keysym))
1290 char *name = (char *)
1291 string_data (XSYMBOL (*keysym)->name);
1293 /* FSFmacs uses symbols with the printed representation of keysyms in
1294 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1295 confusion, notice the M-x syntax and signal an error - because
1296 otherwise it would be interpreted as a regular keysym, and would even
1297 show up in the list-buffers output, causing confusion to the naive.
1299 We can get away with this because none of the X keysym names contain
1300 a hyphen (some contain underscore, however).
1302 It might be useful to reject keysyms which are not x-valid-keysym-
1303 name-p, but that would interfere with various tricks we do to
1304 sanitize the Sun keyboards, and would make it trickier to
1305 conditionalize a .emacs file for multiple X servers.
1307 if (((int) strlen (name) >= 2 && name[1] == '-')
1310 /* Ok, this is a bit more dubious - prevent people from doing things
1311 like (global-set-key 'RET 'something) because that will have the
1312 same problem as above. (Gag!) Maybe we should just silently
1313 accept these as aliases for the "real" names?
1315 (string_length (XSYMBOL (*keysym)->name) <= 3 &&
1316 (!strcmp (name, "LFD") ||
1317 !strcmp (name, "TAB") ||
1318 !strcmp (name, "RET") ||
1319 !strcmp (name, "ESC") ||
1320 !strcmp (name, "DEL") ||
1321 !strcmp (name, "SPC") ||
1322 !strcmp (name, "BS")))
1326 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1329 /* #### Ok, this is a bit more dubious - make people not lose if they
1330 do things like (global-set-key 'RET 'something) because that would
1331 otherwise have the same problem as above. (Gag!) We silently
1332 accept these as aliases for the "real" names.
1334 else if (!strncmp(name, "kp_", 3)) {
1335 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1338 strncpy(temp, name, sizeof (temp));
1339 temp[sizeof (temp) - 1] = '\0';
1341 *keysym = Fintern_soft(make_string((Bufbyte *)temp,
1344 } else if (EQ (*keysym, QLFD))
1345 *keysym = QKlinefeed;
1346 else if (EQ (*keysym, QTAB))
1348 else if (EQ (*keysym, QRET))
1350 else if (EQ (*keysym, QESC))
1352 else if (EQ (*keysym, QDEL))
1354 else if (EQ (*keysym, QBS))
1355 *keysym = QKbackspace;
1356 /* Emacs compatibility */
1357 else if (EQ(*keysym, Qdown_mouse_1))
1359 else if (EQ(*keysym, Qdown_mouse_2))
1361 else if (EQ(*keysym, Qdown_mouse_3))
1363 else if (EQ(*keysym, Qdown_mouse_4))
1365 else if (EQ(*keysym, Qdown_mouse_5))
1367 else if (EQ(*keysym, Qmouse_1))
1368 *keysym = Qbutton1up;
1369 else if (EQ(*keysym, Qmouse_2))
1370 *keysym = Qbutton2up;
1371 else if (EQ(*keysym, Qmouse_3))
1372 *keysym = Qbutton3up;
1373 else if (EQ(*keysym, Qmouse_4))
1374 *keysym = Qbutton4up;
1375 else if (EQ(*keysym, Qmouse_5))
1376 *keysym = Qbutton5up;
1381 /* Given any kind of key-specifier, return a keysym and modifier mask.
1382 Proper canonicalization is performed:
1384 -- integers are converted into the equivalent characters.
1385 -- one-character strings are converted into the equivalent characters.
1389 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
1391 if (CHAR_OR_CHAR_INTP (spec))
1393 struct Lisp_Event event;
1394 event.event_type = empty_event;
1395 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
1396 XCONSOLE (Vselected_console), 0, 0);
1397 returned_value->keysym = event.event.key.keysym;
1398 returned_value->modifiers = event.event.key.modifiers;
1400 else if (EVENTP (spec))
1402 switch (XEVENT (spec)->event_type)
1404 case key_press_event:
1406 returned_value->keysym = XEVENT (spec)->event.key.keysym;
1407 returned_value->modifiers = XEVENT (spec)->event.key.modifiers;
1410 case button_press_event:
1411 case button_release_event:
1413 int down = (XEVENT (spec)->event_type == button_press_event);
1414 switch (XEVENT (spec)->event.button.button)
1417 returned_value->keysym = (down ? Qbutton1 : Qbutton1up); break;
1419 returned_value->keysym = (down ? Qbutton2 : Qbutton2up); break;
1421 returned_value->keysym = (down ? Qbutton3 : Qbutton3up); break;
1423 returned_value->keysym = (down ? Qbutton4 : Qbutton4up); break;
1425 returned_value->keysym = (down ? Qbutton5 : Qbutton5up); break;
1427 returned_value->keysym = (down ? Qbutton6 : Qbutton6up); break;
1429 returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break;
1431 returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break;
1433 returned_value->modifiers = XEVENT (spec)->event.button.modifiers;
1437 signal_error (Qwrong_type_argument,
1438 list2 (build_translated_string
1439 ("unable to bind this type of event"),
1443 else if (SYMBOLP (spec))
1445 /* Be nice, allow = to mean (=) */
1446 if (bucky_sym_to_bucky_bit (spec) != 0)
1447 signal_simple_error ("Key is a modifier name", spec);
1448 define_key_check_and_coerce_keysym (spec, &spec, 0);
1449 returned_value->keysym = spec;
1450 returned_value->modifiers = 0;
1452 else if (CONSP (spec))
1454 unsigned int modifiers = 0;
1455 Lisp_Object keysym = Qnil;
1456 Lisp_Object rest = spec;
1458 /* First, parse out the leading modifier symbols. */
1459 while (CONSP (rest))
1461 unsigned int modifier;
1463 keysym = XCAR (rest);
1464 modifier = bucky_sym_to_bucky_bit (keysym);
1465 modifiers |= modifier;
1466 if (!NILP (XCDR (rest)))
1469 signal_simple_error ("Unknown modifier", keysym);
1474 signal_simple_error ("Nothing but modifiers here",
1481 signal_simple_error ("List must be nil-terminated", spec);
1483 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
1484 returned_value->keysym = keysym;
1485 returned_value->modifiers = modifiers;
1489 signal_simple_error ("Unknown key-sequence specifier",
1494 /* Used by character-to-event */
1496 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
1497 int allow_menu_events)
1499 struct key_data raw_key;
1501 if (allow_menu_events &&
1503 /* #### where the hell does this come from? */
1504 EQ (XCAR (list), Qmenu_selection))
1506 Lisp_Object fn, arg;
1507 if (! NILP (Fcdr (Fcdr (list))))
1508 signal_simple_error ("Invalid menu event desc", list);
1509 arg = Fcar (Fcdr (list));
1511 fn = Qcall_interactively;
1514 XSETFRAME (XEVENT (event)->channel, selected_frame ());
1515 XEVENT (event)->event_type = misc_user_event;
1516 XEVENT (event)->event.eval.function = fn;
1517 XEVENT (event)->event.eval.object = arg;
1521 define_key_parser (list, &raw_key);
1523 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) ||
1524 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) ||
1525 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) ||
1526 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) ||
1527 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) ||
1528 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) ||
1529 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) ||
1530 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up))
1531 error ("Mouse-clicks can't appear in saved keyboard macros.");
1533 XEVENT (event)->channel = Vselected_console;
1534 XEVENT (event)->event_type = key_press_event;
1535 XEVENT (event)->event.key.keysym = raw_key.keysym;
1536 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
1541 event_matches_key_specifier_p (struct Lisp_Event *event,
1542 Lisp_Object key_specifier)
1546 struct gcpro gcpro1;
1548 if (event->event_type != key_press_event || NILP (key_specifier) ||
1549 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
1552 /* if the specifier is an integer such as 27, then it should match
1553 both of the events 'escape' and 'control ['. Calling
1554 Fcharacter_to_event() will only match 'escape'. */
1555 if (CHAR_OR_CHAR_INTP (key_specifier))
1556 return (XCHAR_OR_CHAR_INT (key_specifier)
1557 == event_to_character (event, 0, 0, 0));
1559 /* Otherwise, we cannot call event_to_character() because we may
1560 be dealing with non-ASCII keystrokes. In any case, if I ask
1561 for 'control [' then I should get exactly that, and not
1564 However, we have to behave differently on TTY's, where 'control ['
1565 is silently converted into 'escape' by the keyboard driver.
1566 In this case, ASCII is the only thing we know about, so we have
1567 to compare the ASCII values. */
1570 event2 = Fmake_event (Qnil, Qnil);
1571 Fcharacter_to_event (key_specifier, event2, Qnil, Qnil);
1572 if (XEVENT (event2)->event_type != key_press_event)
1574 else if (CONSOLE_TTY_P (XCONSOLE (EVENT_CHANNEL (event))))
1578 ch1 = event_to_character (event, 0, 0, 0);
1579 ch2 = event_to_character (XEVENT (event2), 0, 0, 0);
1580 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1582 else if (EQ (event->event.key.keysym, XEVENT (event2)->event.key.keysym) &&
1583 event->event.key.modifiers == XEVENT (event2)->event.key.modifiers)
1587 Fdeallocate_event (event2);
1593 meta_prefix_char_p (CONST struct key_data *key)
1595 struct Lisp_Event event;
1597 event.event_type = key_press_event;
1598 event.channel = Vselected_console;
1599 event.event.key.keysym = key->keysym;
1600 event.event.key.modifiers = key->modifiers;
1601 return event_matches_key_specifier_p (&event, Vmeta_prefix_char);
1604 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1605 Return non-nil if EVENT matches KEY-SPECIFIER.
1606 This can be useful, e.g., to determine if the user pressed `help-char' or
1609 (event, key_specifier))
1611 CHECK_LIVE_EVENT (event);
1612 return (event_matches_key_specifier_p (XEVENT (event), key_specifier)
1616 #define MACROLET(k,m) do { \
1617 returned_value->keysym = (k); \
1618 returned_value->modifiers = (m); \
1619 RETURN_SANS_WARNINGS; \
1623 Given a keysym, return another keysym/modifier pair which could be
1624 considered the same key in an ASCII world. Backspace returns ^H, for
1628 define_key_alternate_name (struct key_data *key,
1629 struct key_data *returned_value)
1631 Lisp_Object keysym = key->keysym;
1632 unsigned int modifiers = key->modifiers;
1633 unsigned int modifiers_sans_control = (modifiers & (~MOD_CONTROL));
1634 unsigned int modifiers_sans_meta = (modifiers & (~MOD_META));
1635 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1636 returned_value->modifiers = 0;
1637 if (modifiers_sans_meta == MOD_CONTROL)
1639 if EQ (keysym, QKspace)
1640 MACROLET (make_char ('@'), modifiers);
1641 else if (!CHARP (keysym))
1643 else switch (XCHAR (keysym))
1645 case '@': /* c-@ => c-space */
1646 MACROLET (QKspace, modifiers);
1647 case 'h': /* c-h => backspace */
1648 MACROLET (QKbackspace, modifiers_sans_control);
1649 case 'i': /* c-i => tab */
1650 MACROLET (QKtab, modifiers_sans_control);
1651 case 'j': /* c-j => linefeed */
1652 MACROLET (QKlinefeed, modifiers_sans_control);
1653 case 'm': /* c-m => return */
1654 MACROLET (QKreturn, modifiers_sans_control);
1655 case '[': /* c-[ => escape */
1656 MACROLET (QKescape, modifiers_sans_control);
1661 else if (modifiers_sans_meta != 0)
1663 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
1664 MACROLET (make_char ('h'), (modifiers | MOD_CONTROL));
1665 else if (EQ (keysym, QKtab)) /* tab => c-i */
1666 MACROLET (make_char ('i'), (modifiers | MOD_CONTROL));
1667 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
1668 MACROLET (make_char ('j'), (modifiers | MOD_CONTROL));
1669 else if (EQ (keysym, QKreturn)) /* return => c-m */
1670 MACROLET (make_char ('m'), (modifiers | MOD_CONTROL));
1671 else if (EQ (keysym, QKescape)) /* escape => c-[ */
1672 MACROLET (make_char ('['), (modifiers | MOD_CONTROL));
1680 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
1683 /* This function can GC */
1684 Lisp_Object new_keys;
1686 Lisp_Object mpc_binding;
1687 struct key_data meta_key;
1689 if (NILP (Vmeta_prefix_char) ||
1690 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
1693 define_key_parser (Vmeta_prefix_char, &meta_key);
1694 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
1695 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
1700 else if (STRINGP (keys))
1701 new_keys = Fsubstring (keys, Qzero, make_int (indx));
1702 else if (VECTORP (keys))
1704 new_keys = make_vector (indx, Qnil);
1705 for (i = 0; i < indx; i++)
1706 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
1711 if (EQ (keys, new_keys))
1712 error_with_frob (mpc_binding,
1713 "can't bind %s: %s has a non-keymap binding",
1714 (char *) XSTRING_DATA (Fkey_description (keys)),
1715 (char *) XSTRING_DATA (Fsingle_key_description
1716 (Vmeta_prefix_char)));
1718 error_with_frob (mpc_binding,
1719 "can't bind %s: %s %s has a non-keymap binding",
1720 (char *) XSTRING_DATA (Fkey_description (keys)),
1721 (char *) XSTRING_DATA (Fkey_description (new_keys)),
1722 (char *) XSTRING_DATA (Fsingle_key_description
1723 (Vmeta_prefix_char)));
1726 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
1727 Define key sequence KEYS, in KEYMAP, as DEF.
1728 KEYMAP is a keymap object.
1729 KEYS is the sequence of keystrokes to bind, described below.
1730 DEF is anything that can be a key's definition:
1731 nil (means key is undefined in this keymap);
1732 a command (a Lisp function suitable for interactive calling);
1733 a string or key sequence vector (treated as a keyboard macro);
1734 a keymap (to define a prefix key);
1735 a symbol; when the key is looked up, the symbol will stand for its
1736 function definition, that should at that time be one of the above,
1737 or another symbol whose function definition is used, and so on.
1738 a cons (STRING . DEFN), meaning that DEFN is the definition
1739 (DEFN should be a valid definition in its own right);
1740 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1742 Contrary to popular belief, the world is not ASCII. When running under a
1743 window manager, XEmacs can tell the difference between, for example, the
1744 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1745 bind different commands to each of these.
1747 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1748 set of modifiers (such as control and meta). A `keysym' is what is printed
1749 on the keys on your keyboard.
1751 A keysym may be represented by a symbol, or (if and only if it is equivalent
1752 to an ASCII character in the range 32 - 255) by a character or its equivalent
1753 ASCII code. The `A' key may be represented by the symbol `A', the character
1754 `?A', or by the number 65. The `break' key may be represented only by the
1757 A keystroke may be represented by a list: the last element of the list
1758 is the key (a symbol, character, or number, as above) and the
1759 preceding elements are the symbolic names of modifier keys (control,
1760 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1761 represented by the forms `(control b)', `(control ?b)', and `(control
1762 98)'. A keystroke may also be represented by an event object, as
1763 returned by the `next-command-event' and `read-key-sequence'
1766 Note that in this context, the keystroke `control-b' is *not* represented
1767 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1769 The `shift' modifier is somewhat of a special case. You should not (and
1770 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1771 have ASCII equivalents, the state of the shift key is implicit in the
1772 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1773 sort of thing varies from keyboard to keyboard. The shift modifier is for
1774 use only with characters that do not have a second keysym on the same key,
1775 such as `backspace' and `tab'.
1777 A key sequence is a vector of keystrokes. As a degenerate case, elements
1778 of this vector may also be keysyms if they have no modifiers. That is,
1779 the `A' keystroke is represented by all of these forms:
1780 A ?A 65 (A) (?A) (65)
1781 [A] [?A] [65] [(A)] [(?A)] [(65)]
1783 the `control-a' keystroke is represented by these forms:
1784 (control A) (control ?A) (control 65)
1785 [(control A)] [(control ?A)] [(control 65)]
1786 the key sequence `control-c control-a' is represented by these forms:
1787 [(control c) (control a)] [(control ?c) (control ?a)]
1788 [(control 99) (control 65)] etc.
1790 Mouse button clicks work just like keypresses: (control button1) means
1791 pressing the left mouse button while holding down the control key.
1792 \[(control c) (shift button3)] means control-c, hold shift, click right.
1794 Commands may be bound to the mouse-button up-stroke rather than the down-
1795 stroke as well. `button1' means the down-stroke, and `button1up' means the
1796 up-stroke. Different commands may be bound to the up and down strokes,
1797 though that is probably not what you want, so be careful.
1799 For backward compatibility, a key sequence may also be represented by a
1800 string. In this case, it represents the key sequence(s) that would
1801 produce that sequence of ASCII characters in a purely ASCII world. For
1802 example, a string containing the ASCII backspace character, "\\^H", would
1803 represent two key sequences: `(control h)' and `backspace'. Binding a
1804 command to this will actually bind both of those key sequences. Likewise
1805 for the following pairs:
1812 control @ control space
1814 After binding a command to two key sequences with a form like
1816 (define-key global-map "\\^X\\^I" \'command-1)
1818 it is possible to redefine only one of those sequences like so:
1820 (define-key global-map [(control x) (control i)] \'command-2)
1821 (define-key global-map [(control x) tab] \'command-3)
1823 Of course, all of this applies only when running under a window system. If
1824 you're talking to XEmacs through a TTY connection, you don't get any of
1827 (keymap, keys, def))
1829 /* This function can GC */
1834 struct gcpro gcpro1, gcpro2, gcpro3;
1837 len = XVECTOR_LENGTH (keys);
1838 else if (STRINGP (keys))
1839 len = XSTRING_CHAR_LENGTH (keys);
1840 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
1842 if (!CONSP (keys)) keys = list1 (keys);
1844 keys = make_vector (1, keys); /* this is kinda sleazy. */
1848 keys = wrong_type_argument (Qsequencep, keys);
1849 len = XINT (Flength (keys));
1854 GCPRO3 (keymap, keys, def);
1857 When the user defines a key which, in a strictly ASCII world, would be
1858 produced by two different keys (^J and linefeed, or ^H and backspace,
1859 for example) then the binding will be made for both keysyms.
1861 This is done if the user binds a command to a string, as in
1862 (define-key map "\^H" 'something), but not when using one of the new
1863 syntaxes, like (define-key map '(control h) 'something).
1865 ascii_hack = (STRINGP (keys));
1867 keymap = get_keymap (keymap, 1, 1);
1873 struct key_data raw_key1;
1874 struct key_data raw_key2;
1877 c = make_char (string_char (XSTRING (keys), idx));
1879 c = XVECTOR_DATA (keys) [idx];
1881 define_key_parser (c, &raw_key1);
1883 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
1885 if (idx == (len - 1))
1887 /* This is a hack to prevent a binding for the meta-prefix-char
1888 from being made in a map which already has a non-empty "meta"
1889 submap. That is, we can't let both "escape" and "meta" have
1890 a binding in the same keymap. This implies that the idiom
1891 (define-key my-map "\e" my-escape-map)
1892 (define-key my-escape-map "a" 'my-command)
1893 no longer works. That's ok. Instead the luser should do
1894 (define-key my-map "\ea" 'my-command)
1896 (define-key my-map "\M-a" 'my-command)
1898 (defvar my-escape-map (lookup-key my-map "\e"))
1899 if the luser really wants the map in a variable.
1902 struct gcpro ngcpro1;
1905 mmap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
1906 XKEYMAP (keymap)->table, Qnil);
1908 && keymap_fullness (mmap) != 0)
1911 = Fsingle_key_description (Vmeta_prefix_char);
1912 signal_simple_error_2
1913 ("Map contains meta-bindings, can't bind", desc, keymap);
1926 define_key_alternate_name (&raw_key1, &raw_key2);
1929 raw_key2.keysym = Qnil;
1930 raw_key2.modifiers = 0;
1935 raw_key1.modifiers |= MOD_META;
1936 raw_key2.modifiers |= MOD_META;
1940 /* This crap is to make sure that someone doesn't bind something like
1941 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
1942 if (raw_key1.modifiers & MOD_META)
1943 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
1947 keymap_store (keymap, &raw_key1, def);
1948 if (ascii_hack && !NILP (raw_key2.keysym))
1949 keymap_store (keymap, &raw_key2, def);
1956 struct gcpro ngcpro1;
1959 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
1962 cmd = Fmake_sparse_keymap (Qnil);
1963 XKEYMAP (cmd)->name /* for debugging */
1964 = list2 (make_key_description (&raw_key1, 1), keymap);
1965 keymap_store (keymap, &raw_key1, cmd);
1967 if (NILP (Fkeymapp (cmd)))
1968 signal_simple_error_2 ("Invalid prefix keys in sequence",
1971 if (ascii_hack && !NILP (raw_key2.keysym) &&
1972 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
1973 keymap_store (keymap, &raw_key2, cmd);
1975 keymap = get_keymap (cmd, 1, 1);
1982 /************************************************************************/
1983 /* Looking up keys in keymaps */
1984 /************************************************************************/
1986 /* We need a very fast (i.e., non-consing) version of lookup-key in order
1987 to make where-is-internal really fly. */
1989 struct raw_lookup_key_mapper_closure
1992 CONST struct key_data *raw_keys;
1998 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
2000 /* Caller should gc-protect args (keymaps may autoload) */
2002 raw_lookup_key (Lisp_Object keymap,
2003 CONST struct key_data *raw_keys, int raw_keys_count,
2004 int keys_so_far, int accept_default)
2006 /* This function can GC */
2007 struct raw_lookup_key_mapper_closure c;
2008 c.remaining = raw_keys_count - 1;
2009 c.raw_keys = raw_keys;
2010 c.raw_keys_count = raw_keys_count;
2011 c.keys_so_far = keys_so_far;
2012 c.accept_default = accept_default;
2014 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
2018 raw_lookup_key_mapper (Lisp_Object k, void *arg)
2020 /* This function can GC */
2021 struct raw_lookup_key_mapper_closure *c =
2022 (struct raw_lookup_key_mapper_closure *) arg;
2023 int accept_default = c->accept_default;
2024 int remaining = c->remaining;
2025 int keys_so_far = c->keys_so_far;
2026 CONST struct key_data *raw_keys = c->raw_keys;
2029 if (! meta_prefix_char_p (&(raw_keys[0])))
2031 /* Normal case: every case except the meta-hack (see below). */
2032 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2035 /* Return whatever we found if we're out of keys */
2037 else if (NILP (cmd))
2038 /* Found nothing (though perhaps parent map may have binding) */
2040 else if (NILP (Fkeymapp (cmd)))
2041 /* Didn't find a keymap, and we have more keys.
2042 * Return a fixnum to indicate that keys were too long.
2044 cmd = make_int (keys_so_far + 1);
2046 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2047 keys_so_far + 1, accept_default);
2051 /* This is a hack so that looking up a key-sequence whose last
2052 * element is the meta-prefix-char will return the keymap that
2053 * the "meta" keys are stored in, if there is no binding for
2054 * the meta-prefix-char (and if this map has a "meta" submap).
2055 * If this map doesn't have a "meta" submap, then the
2056 * meta-prefix-char is looked up just like any other key.
2060 /* First look for the prefix-char directly */
2061 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2064 /* Do kludgy return of the meta-map */
2065 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
2066 XKEYMAP (k)->table, Qnil);
2071 /* Search for the prefix-char-prefixed sequence directly */
2072 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2073 cmd = get_keymap (cmd, 0, 1);
2075 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2076 keys_so_far + 1, accept_default);
2077 else if ((raw_keys[1].modifiers & MOD_META) == 0)
2079 struct key_data metified;
2080 metified.keysym = raw_keys[1].keysym;
2081 metified.modifiers = raw_keys[1].modifiers | MOD_META;
2083 /* Search for meta-next-char sequence directly */
2084 cmd = keymap_lookup_1 (k, &metified, accept_default);
2089 cmd = get_keymap (cmd, 0, 1);
2091 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
2098 if (accept_default && NILP (cmd))
2099 cmd = XKEYMAP (k)->default_binding;
2103 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2104 /* Caller should gc-protect arguments */
2106 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
2109 /* This function can GC */
2110 struct key_data kkk[20];
2111 struct key_data *raw_keys;
2117 if (nkeys < (countof (kkk)))
2120 raw_keys = alloca_array (struct key_data, nkeys);
2122 for (i = 0; i < nkeys; i++)
2124 define_key_parser (keys[i], &(raw_keys[i]));
2126 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
2130 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2133 /* This function can GC */
2134 struct key_data kkk[20];
2138 struct key_data *raw_keys;
2139 Lisp_Object tem = Qnil;
2140 struct gcpro gcpro1, gcpro2;
2143 CHECK_LIVE_EVENT (event_head);
2145 nkeys = event_chain_count (event_head);
2147 if (nkeys < (countof (kkk)))
2150 raw_keys = alloca_array (struct key_data, nkeys);
2153 EVENT_CHAIN_LOOP (event, event_head)
2154 define_key_parser (event, &(raw_keys[nkeys++]));
2155 GCPRO2 (keymaps[0], event_head);
2156 gcpro1.nvars = nmaps;
2157 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
2158 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
2159 for (iii = 0; iii < nmaps; iii++)
2161 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
2165 /* Too long in some local map means don't look at global map */
2169 else if (!NILP (tem))
2176 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
2177 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2178 Nil is returned if KEYS is unbound. See documentation of `define-key'
2179 for valid key definitions and key-sequence specifications.
2180 A number is returned if KEYS is "too long"; that is, the leading
2181 characters fail to be a valid sequence of prefix characters in KEYMAP.
2182 The number is how many characters at the front of KEYS
2183 it takes to reach a non-prefix command.
2185 (keymap, keys, accept_default))
2187 /* This function can GC */
2189 return lookup_keys (keymap,
2190 XVECTOR_LENGTH (keys),
2191 XVECTOR_DATA (keys),
2192 !NILP (accept_default));
2193 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
2194 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
2195 else if (STRINGP (keys))
2197 int length = XSTRING_CHAR_LENGTH (keys);
2199 struct key_data *raw_keys = alloca_array (struct key_data, length);
2203 for (i = 0; i < length; i++)
2205 Emchar n = string_char (XSTRING (keys), i);
2206 define_key_parser (make_char (n), &(raw_keys[i]));
2208 return raw_lookup_key (keymap, raw_keys, length, 0,
2209 !NILP (accept_default));
2213 keys = wrong_type_argument (Qsequencep, keys);
2214 return Flookup_key (keymap, keys, accept_default);
2218 /* Given a key sequence, returns a list of keymaps to search for bindings.
2219 Does all manner of semi-hairy heuristics, like looking in the current
2220 buffer's map before looking in the global map and looking in the local
2221 map of the buffer in which the mouse was clicked in event0 is a click.
2223 It would be kind of nice if this were in Lisp so that this semi-hairy
2224 semi-heuristic command-lookup behavior could be readily understood and
2225 customised. However, this needs to be pretty fast, or performance of
2226 keyboard macros goes to shit; putting this in lisp slows macros down
2227 2-3x. And they're already slower than v18 by 5-6x.
2230 struct relevant_maps
2233 unsigned int max_maps;
2235 struct gcpro *gcpro;
2238 static void get_relevant_extent_keymaps (Lisp_Object pos,
2239 Lisp_Object buffer_or_string,
2241 struct relevant_maps *closure);
2242 static void get_relevant_minor_maps (Lisp_Object buffer,
2243 struct relevant_maps *closure);
2246 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
2248 unsigned int nmaps = closure->nmaps;
2252 closure->nmaps = nmaps + 1;
2253 if (nmaps < closure->max_maps)
2255 closure->maps[nmaps] = map;
2256 closure->gcpro->nvars = nmaps;
2261 get_relevant_keymaps (Lisp_Object keys,
2262 int max_maps, Lisp_Object maps[])
2264 /* This function can GC */
2265 Lisp_Object terminal = Qnil;
2266 struct gcpro gcpro1;
2267 struct relevant_maps closure;
2268 struct console *con;
2273 closure.max_maps = max_maps;
2274 closure.maps = maps;
2275 closure.gcpro = &gcpro1;
2278 terminal = event_chain_tail (keys);
2279 else if (VECTORP (keys))
2281 int len = XVECTOR_LENGTH (keys);
2283 terminal = XVECTOR_DATA (keys)[len - 1];
2286 if (EVENTP (terminal))
2288 CHECK_LIVE_EVENT (terminal);
2289 con = event_console_or_selected (terminal);
2292 con = XCONSOLE (Vselected_console);
2294 if (KEYMAPP (con->overriding_terminal_local_map)
2295 || KEYMAPP (Voverriding_local_map))
2297 if (KEYMAPP (con->overriding_terminal_local_map))
2298 relevant_map_push (con->overriding_terminal_local_map, &closure);
2299 if (KEYMAPP (Voverriding_local_map))
2300 relevant_map_push (Voverriding_local_map, &closure);
2302 else if (!EVENTP (terminal)
2303 || (XEVENT (terminal)->event_type != button_press_event
2304 && XEVENT (terminal)->event_type != button_release_event))
2307 XSETBUFFER (tem, current_buffer);
2308 /* It's not a mouse event; order of keymaps searched is:
2309 o keymap of any/all extents under the mouse
2311 o local-map of current-buffer
2314 /* The terminal element of the lookup may be nil or a keysym.
2315 In those cases we don't want to check for an extent
2317 if (EVENTP (terminal))
2319 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
2320 tem, Qnil, &closure);
2322 get_relevant_minor_maps (tem, &closure);
2324 tem = current_buffer->keymap;
2326 relevant_map_push (tem, &closure);
2328 #ifdef HAVE_WINDOW_SYSTEM
2331 /* It's a mouse event; order of keymaps searched is:
2332 o vertical-divider-map, if event is over a divider
2333 o local-map of mouse-grabbed-buffer
2334 o keymap of any/all extents under the mouse
2335 if the mouse is over a modeline:
2336 o modeline-map of buffer corresponding to that modeline
2337 o else, local-map of buffer under the mouse
2339 o local-map of current-buffer
2342 Lisp_Object window = Fevent_window (terminal);
2344 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
2346 if (KEYMAPP (Vvertical_divider_map))
2347 relevant_map_push (Vvertical_divider_map, &closure);
2350 if (BUFFERP (Vmouse_grabbed_buffer))
2352 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
2354 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
2356 relevant_map_push (map, &closure);
2361 Lisp_Object buffer = Fwindow_buffer (window);
2365 if (!NILP (Fevent_over_modeline_p (terminal)))
2367 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
2370 get_relevant_extent_keymaps
2371 (Fevent_modeline_position (terminal),
2372 XBUFFER (buffer)->generated_modeline_string,
2373 /* #### third arg should maybe be a glyph. */
2376 if (!UNBOUNDP (map) && !NILP (map))
2377 relevant_map_push (get_keymap (map, 1, 1), &closure);
2381 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
2382 Fevent_glyph_extent (terminal),
2386 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
2388 Lisp_Object map = XBUFFER (buffer)->keymap;
2390 get_relevant_minor_maps (buffer, &closure);
2392 relevant_map_push (map, &closure);
2396 else if (!NILP (Fevent_over_toolbar_p (terminal)))
2398 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
2400 if (!UNBOUNDP (map) && !NILP (map))
2401 relevant_map_push (map, &closure);
2404 #endif /* HAVE_WINDOW_SYSTEM */
2407 int nmaps = closure.nmaps;
2408 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2409 if (nmaps >= max_maps && max_maps > 0)
2410 maps[max_maps - 1] = Vcurrent_global_map;
2412 maps[nmaps] = Vcurrent_global_map;
2418 /* Returns a set of keymaps extracted from the extents at POS in
2419 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2420 to look for a keymap in, and if it has one, its keymap will be the
2421 first element in the list returned. This is so we can correctly
2422 search the keymaps associated with glyphs which may be physically
2423 disjoint from their extents: for example, if a glyph is out in the
2424 margin, we should still consult the keymap of that glyph's extent,
2425 which may not itself be under the mouse.
2429 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
2431 struct relevant_maps *closure)
2433 /* This function can GC */
2434 /* the glyph keymap, if any, comes first.
2435 (Processing it twice is no big deal: noop.) */
2438 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
2440 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2443 /* Next check the extents at the text position, if any */
2447 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2449 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
2451 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
2453 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2460 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
2462 /* This function can GC */
2465 Lisp_Object sym = XCAR (assoc);
2468 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
2469 if (!NILP (val) && !UNBOUNDP (val))
2471 Lisp_Object map = get_keymap (XCDR (assoc), 0, 1);
2480 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
2482 /* This function can GC */
2485 /* Will you ever lose badly if you make this circular! */
2486 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
2488 alist = XCDR (alist))
2490 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
2492 if (!NILP (m)) relevant_map_push (m, closure);
2497 /* #### Would map-current-keymaps be a better thing?? */
2498 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2499 Return a list of the current keymaps that will be searched for bindings.
2500 This lists keymaps such as the current local map and the minor-mode maps,
2501 but does not list the parents of those keymaps.
2502 EVENT-OR-KEYS controls which keymaps will be listed.
2503 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2504 mouse event), the keymaps for that mouse event will be listed (see
2505 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2509 /* This function can GC */
2510 struct gcpro gcpro1;
2511 Lisp_Object maps[100];
2512 Lisp_Object *gubbish = maps;
2515 GCPRO1 (event_or_keys);
2516 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
2518 if (nmaps > countof (maps))
2520 gubbish = alloca_array (Lisp_Object, nmaps);
2521 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
2524 return Flist (nmaps, gubbish);
2527 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
2528 Return the binding for command KEYS in current keymaps.
2529 KEYS is a string, a vector of events, or a vector of key-description lists
2530 as described in the documentation for the `define-key' function.
2531 The binding is probably a symbol with a function definition; see
2532 the documentation for `lookup-key' for more information.
2534 For key-presses, the order of keymaps searched is:
2535 - the `keymap' property of any extent(s) at point;
2536 - any applicable minor-mode maps;
2537 - the current-local-map of the current-buffer;
2538 - the current global map.
2540 For mouse-clicks, the order of keymaps searched is:
2541 - the current-local-map of the `mouse-grabbed-buffer' if any;
2542 - vertical-divider-map, if the event happened over a vertical divider
2543 - the `keymap' property of any extent(s) at the position of the click
2544 (this includes modeline extents);
2545 - the modeline-map of the buffer corresponding to the modeline under
2546 the mouse (if the click happened over a modeline);
2547 - the value of toolbar-map in the current-buffer (if the click
2548 happened over a toolbar);
2549 - the current-local-map of the buffer under the mouse (does not
2550 apply to toolbar clicks);
2551 - any applicable minor-mode maps;
2552 - the current global map.
2554 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2555 is non-nil, *only* those two maps and the current global map are searched.
2557 (keys, accept_default))
2559 /* This function can GC */
2561 Lisp_Object maps[100];
2563 struct gcpro gcpro1, gcpro2;
2564 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
2566 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
2570 if (EVENTP (keys)) /* unadvertised "feature" for the future */
2571 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
2573 for (i = 0; i < nmaps; i++)
2575 Lisp_Object tem = Flookup_key (maps[i], keys,
2579 /* Too long in some local map means don't look at global map */
2582 else if (!NILP (tem))
2589 process_event_binding_result (Lisp_Object result)
2591 if (EQ (result, Qundefined))
2592 /* The suppress-keymap function binds keys to 'undefined - special-case
2593 that here, so that being bound to that has the same error-behavior as
2594 not being defined at all.
2600 /* Snap out possible keymap indirections */
2601 map = get_keymap (result, 0, 1);
2609 /* Attempts to find a command corresponding to the event-sequence
2610 whose head is event0 (sequence is threaded though event_next).
2612 The return value will be
2614 -- nil (there is no binding; this will also be returned
2615 whenever the event chain is "too long", i.e. there
2616 is a non-nil, non-keymap binding for a prefix of
2618 -- a keymap (part of a command has been specified)
2619 -- a command (anything that satisfies `commandp'; this includes
2620 some symbols, lists, subrs, strings, vectors, and
2621 compiled-function objects) */
2623 event_binding (Lisp_Object event0, int accept_default)
2625 /* This function can GC */
2626 Lisp_Object maps[100];
2629 assert (EVENTP (event0));
2631 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
2632 if (nmaps > countof (maps))
2633 nmaps = countof (maps);
2634 return process_event_binding_result (lookup_events (event0, nmaps, maps,
2638 /* like event_binding, but specify a keymap to search */
2641 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
2643 /* This function can GC */
2644 if (!KEYMAPP (keymap))
2647 return process_event_binding_result (lookup_events (event0, 1, &keymap,
2651 /* Attempts to find a function key mapping corresponding to the
2652 event-sequence whose head is event0 (sequence is threaded through
2653 event_next). The return value will be the same as for event_binding(). */
2655 munging_key_map_event_binding (Lisp_Object event0,
2656 enum munge_me_out_the_door munge)
2658 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2659 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
2660 Vkey_translation_map;
2665 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
2669 /************************************************************************/
2670 /* Setting/querying the global and local maps */
2671 /************************************************************************/
2673 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
2674 Select KEYMAP as the global keymap.
2678 /* This function can GC */
2679 keymap = get_keymap (keymap, 1, 1);
2680 Vcurrent_global_map = keymap;
2684 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
2685 Select KEYMAP as the local keymap in BUFFER.
2686 If KEYMAP is nil, that means no local keymap.
2687 If BUFFER is nil, the current buffer is assumed.
2691 /* This function can GC */
2692 struct buffer *b = decode_buffer (buffer, 0);
2694 keymap = get_keymap (keymap, 1, 1);
2701 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2702 Return BUFFER's local keymap, or nil if it has none.
2703 If BUFFER is nil, the current buffer is assumed.
2707 struct buffer *b = decode_buffer (buffer, 0);
2711 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2712 Return the current global keymap.
2716 return Vcurrent_global_map;
2720 /************************************************************************/
2721 /* Mapping over keymap elements */
2722 /************************************************************************/
2724 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2725 prefix key, it's not entirely obvious what map-keymap should do, but
2726 what it does is: map over all keys in this map; then recursively map
2727 over all submaps of this map that are "bucky" submaps. This means that,
2728 when mapping over a keymap, it appears that "x" and "C-x" are in the
2729 same map, although "C-x" is really in the "control" submap of this one.
2730 However, since we don't recursively descend the submaps that are bound
2731 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2732 those explicitly, if that's what they want.
2734 So the end result of this is that the bucky keymaps (the ones indexed
2735 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2736 invisible from elisp. They're just an implementation detail that code
2737 outside of this file doesn't need to know about.
2740 struct map_keymap_unsorted_closure
2742 void (*fn) (CONST struct key_data *, Lisp_Object binding, void *arg);
2744 unsigned int modifiers;
2747 /* used by map_keymap() */
2749 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value,
2750 void *map_keymap_unsorted_closure)
2752 /* This function can GC */
2753 struct map_keymap_unsorted_closure *closure =
2754 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
2755 unsigned int modifiers = closure->modifiers;
2756 unsigned int mod_bit;
2757 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
2760 int omod = modifiers;
2761 closure->modifiers = (modifiers | mod_bit);
2762 value = get_keymap (value, 1, 0);
2763 elisp_maphash (map_keymap_unsorted_mapper,
2764 XKEYMAP (value)->table,
2765 map_keymap_unsorted_closure);
2766 closure->modifiers = omod;
2770 struct key_data key;
2771 key.keysym = keysym;
2772 key.modifiers = modifiers;
2773 ((*closure->fn) (&key, value, closure->arg));
2779 struct map_keymap_sorted_closure
2781 Lisp_Object *result_locative;
2784 /* used by map_keymap_sorted() */
2786 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value,
2787 void *map_keymap_sorted_closure)
2789 struct map_keymap_sorted_closure *cl =
2790 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
2791 Lisp_Object *list = cl->result_locative;
2792 *list = Fcons (Fcons (key, value), *list);
2797 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2798 and keymap_submaps().
2801 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
2804 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2806 unsigned int bit1, bit2;
2812 if (EQ (obj1, obj2))
2814 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
2815 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
2817 /* If either is a symbol with a character-set-property, then sort it by
2818 that code instead of alphabetically.
2820 if (! bit1 && SYMBOLP (obj1))
2822 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
2823 if (CHAR_OR_CHAR_INTP (code))
2826 CHECK_CHAR_COERCE_INT (obj1);
2830 if (! bit2 && SYMBOLP (obj2))
2832 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
2833 if (CHAR_OR_CHAR_INTP (code))
2836 CHECK_CHAR_COERCE_INT (obj2);
2841 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2842 if (XTYPE (obj1) != XTYPE (obj2))
2843 return SYMBOLP (obj2) ? 1 : -1;
2845 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
2847 int o1 = XCHAR (obj1);
2848 int o2 = XCHAR (obj2);
2849 if (o1 == o2 && /* If one started out as a symbol and the */
2850 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
2851 return sym2_p ? 1 : -1;
2853 return o1 < o2 ? 1 : -1; /* else just compare them */
2856 /* else they're both symbols. If they're both buckys, then order them. */
2858 return bit1 < bit2 ? 1 : -1;
2860 /* if only one is a bucky, then it comes later */
2862 return bit2 ? 1 : -1;
2864 /* otherwise, string-sort them. */
2866 char *s1 = (char *) string_data (XSYMBOL (obj1)->name);
2867 char *s2 = (char *) string_data (XSYMBOL (obj2)->name);
2869 return 0 > strcoll (s1, s2) ? 1 : -1;
2871 return 0 > strcmp (s1, s2) ? 1 : -1;
2877 /* used by map_keymap() */
2879 map_keymap_sorted (Lisp_Object keymap_table,
2880 unsigned int modifiers,
2881 void (*function) (CONST struct key_data *key,
2882 Lisp_Object binding,
2883 void *map_keymap_sorted_closure),
2884 void *map_keymap_sorted_closure)
2886 /* This function can GC */
2887 struct gcpro gcpro1;
2888 Lisp_Object contents = Qnil;
2890 if (XINT (Fhash_table_count (keymap_table)) == 0)
2896 struct map_keymap_sorted_closure c1;
2897 c1.result_locative = &contents;
2898 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
2900 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
2901 for (; !NILP (contents); contents = XCDR (contents))
2903 Lisp_Object keysym = XCAR (XCAR (contents));
2904 Lisp_Object binding = XCDR (XCAR (contents));
2905 unsigned int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
2907 map_keymap_sorted (XKEYMAP (get_keymap (binding,
2909 (modifiers | sub_bits),
2911 map_keymap_sorted_closure);
2916 k.modifiers = modifiers;
2917 ((*function) (&k, binding, map_keymap_sorted_closure));
2924 /* used by Fmap_keymap() */
2926 map_keymap_mapper (CONST struct key_data *key,
2927 Lisp_Object binding,
2930 /* This function can GC */
2932 VOID_TO_LISP (fn, function);
2933 call2 (fn, make_key_description (key, 1), binding);
2938 map_keymap (Lisp_Object keymap_table, int sort_first,
2939 void (*function) (CONST struct key_data *key,
2940 Lisp_Object binding,
2944 /* This function can GC */
2946 map_keymap_sorted (keymap_table, 0, function, fn_arg);
2949 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
2950 map_keymap_unsorted_closure.fn = function;
2951 map_keymap_unsorted_closure.arg = fn_arg;
2952 map_keymap_unsorted_closure.modifiers = 0;
2953 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
2954 &map_keymap_unsorted_closure);
2958 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
2959 Apply FUNCTION to each element of KEYMAP.
2960 FUNCTION will be called with two arguments: a key-description list, and
2961 the binding. The order in which the elements of the keymap are passed to
2962 the function is unspecified. If the function inserts new elements into
2963 the keymap, it may or may not be called with them later. No element of
2964 the keymap will ever be passed to the function more than once.
2966 The function will not be called on elements of this keymap's parents
2967 \(see the function `keymap-parents') or upon keymaps which are contained
2968 within this keymap (multi-character definitions).
2969 It will be called on "meta" characters since they are not really
2970 two-character sequences.
2972 If the optional third argument SORT-FIRST is non-nil, then the elements of
2973 the keymap will be passed to the mapper function in a canonical order.
2974 Otherwise, they will be passed in hash (that is, random) order, which is
2977 (function, keymap, sort_first))
2979 /* This function can GC */
2980 struct gcpro gcpro1, gcpro2;
2982 /* tolerate obviously transposed args */
2983 if (!NILP (Fkeymapp (function)))
2985 Lisp_Object tmp = function;
2989 GCPRO2 (function, keymap);
2990 keymap = get_keymap (keymap, 1, 1);
2991 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
2992 map_keymap_mapper, LISP_TO_VOID (function));
2999 /************************************************************************/
3000 /* Accessible keymaps */
3001 /************************************************************************/
3003 struct accessible_keymaps_closure
3010 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
3011 unsigned int modifiers,
3012 struct accessible_keymaps_closure *closure)
3014 /* This function can GC */
3015 unsigned int subbits = MODIFIER_HASH_KEY_BITS (keysym);
3019 Lisp_Object submaps;
3021 contents = get_keymap (contents, 1, 1);
3022 submaps = keymap_submaps (contents);
3023 for (; !NILP (submaps); submaps = XCDR (submaps))
3025 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3026 XCDR (XCAR (submaps)),
3027 (subbits | modifiers),
3033 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3034 Lisp_Object cmd = get_keyelt (contents, 1);
3038 struct key_data key;
3039 key.keysym = keysym;
3040 key.modifiers = modifiers;
3044 cmd = get_keymap (cmd, 0, 1);
3048 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3049 len = XVECTOR_LENGTH (thisseq);
3050 for (j = 0; j < len; j++)
3051 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3052 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3054 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3060 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3062 /* This function can GC */
3063 struct accessible_keymaps_closure *closure =
3064 (struct accessible_keymaps_closure *) arg;
3065 Lisp_Object submaps = keymap_submaps (thismap);
3067 for (; !NILP (submaps); submaps = XCDR (submaps))
3069 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3070 XCDR (XCAR (submaps)),
3078 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3079 Find all keymaps accessible via prefix characters from KEYMAP.
3080 Returns a list of elements of the form (KEYS . MAP), where the sequence
3081 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3082 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3083 An optional argument PREFIX, if non-nil, should be a key sequence;
3084 then the value includes only maps for prefixes that start with PREFIX.
3088 /* This function can GC */
3089 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3090 Lisp_Object accessible_keymaps = Qnil;
3091 struct accessible_keymaps_closure c;
3093 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3096 keymap = get_keymap (keymap, 1, 1);
3098 prefix = make_vector (0, Qnil);
3099 else if (!VECTORP (prefix) || STRINGP (prefix))
3101 prefix = wrong_type_argument (Qarrayp, prefix);
3106 int len = XINT (Flength (prefix));
3107 Lisp_Object def = Flookup_key (keymap, prefix, Qnil);
3110 struct gcpro ngcpro1;
3112 def = get_keymap (def, 0, 1);
3117 p = make_vector (len, Qnil);
3119 for (iii = 0; iii < len; iii++)
3121 struct key_data key;
3122 define_key_parser (Faref (prefix, make_int (iii)), &key);
3123 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3129 accessible_keymaps = list1 (Fcons (prefix, keymap));
3131 /* For each map in the list maps,
3132 look at any other maps it points to
3133 and stick them at the end if they are not already in the list */
3135 for (c.tail = accessible_keymaps;
3137 c.tail = XCDR (c.tail))
3139 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3140 CHECK_KEYMAP (thismap);
3141 traverse_keymaps (thismap, Qnil,
3142 accessible_keymaps_keymap_mapper, &c);
3146 return accessible_keymaps;
3151 /************************************************************************/
3152 /* Pretty descriptions of key sequences */
3153 /************************************************************************/
3155 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3156 Return a pretty description of key-sequence KEYS.
3157 Control characters turn into "C-foo" sequences, meta into "M-foo",
3158 spaces are put between sequence elements, etc...
3162 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3165 return Fsingle_key_description (keys);
3167 else if (VECTORP (keys) ||
3170 Lisp_Object string = Qnil;
3171 /* Lisp_Object sep = Qnil; */
3172 int size = XINT (Flength (keys));
3175 for (i = 0; i < size; i++)
3177 Lisp_Object s2 = Fsingle_key_description
3179 ? make_char (string_char (XSTRING (keys), i))
3180 : XVECTOR_DATA (keys)[i]));
3186 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */;
3187 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3192 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3195 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3196 Return a pretty description of command character KEY.
3197 Control characters turn into C-whatever, etc.
3198 This differs from `text-char-description' in that it returns a description
3199 of a key read from the user rather than a character from a buffer.
3204 key = Fcons (key, Qnil); /* sleaze sleaze */
3206 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3211 struct Lisp_Event event;
3212 event.event_type = empty_event;
3213 CHECK_CHAR_COERCE_INT (key);
3214 character_to_event (XCHAR (key), &event,
3215 XCONSOLE (Vselected_console), 0, 1);
3216 format_event_object (buf, &event, 1);
3219 format_event_object (buf, XEVENT (key), 1);
3220 return build_string (buf);
3229 LIST_LOOP (rest, key)
3231 Lisp_Object keysym = XCAR (rest);
3232 if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2;
3233 else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2;
3234 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3235 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3236 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3237 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3238 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3239 else if (CHAR_OR_CHAR_INTP (keysym))
3241 bufp += set_charptr_emchar ((Bufbyte *) bufp,
3242 XCHAR_OR_CHAR_INT (keysym));
3247 CHECK_SYMBOL (keysym);
3248 #if 0 /* This is bogus */
3249 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3250 else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB");
3251 else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET");
3252 else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC");
3253 else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL");
3254 else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC");
3255 else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS");
3258 strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name));
3259 if (!NILP (XCDR (rest)))
3260 signal_simple_error ("Invalid key description",
3264 return build_string (buf);
3266 return Fsingle_key_description
3267 (wrong_type_argument (intern ("char-or-event-p"), key));
3270 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3271 Return a pretty description of file-character CHR.
3272 Unprintable characters turn into "^char" or \\NNN, depending on the value
3273 of the `ctl-arrow' variable.
3274 This differs from `single-key-description' in that it returns a description
3275 of a character from a buffer rather than a key read from the user.
3282 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3283 int ctl_p = !NILP (ctl_arrow);
3284 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3285 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3286 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3291 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3294 signal_simple_continuable_error
3295 ("character has no ASCII equivalent", Fcopy_event (chr, Qnil));
3299 CHECK_CHAR_COERCE_INT (chr);
3304 if (c >= printable_min)
3306 p += set_charptr_emchar (p, c);
3308 else if (c < 040 && ctl_p)
3311 *p++ = c + 64; /* 'A' - 1 */
3318 else if (c >= 0200 || c < 040)
3322 /* !!#### This syntax is not readable. It will
3323 be interpreted as a 3-digit octal number rather
3324 than a 7-digit octal number. */
3327 *p++ = '0' + ((c & 07000000) >> 18);
3328 *p++ = '0' + ((c & 0700000) >> 15);
3329 *p++ = '0' + ((c & 070000) >> 12);
3330 *p++ = '0' + ((c & 07000) >> 9);
3333 *p++ = '0' + ((c & 0700) >> 6);
3334 *p++ = '0' + ((c & 0070) >> 3);
3335 *p++ = '0' + ((c & 0007));
3339 p += set_charptr_emchar (p, c);
3343 return build_string ((char *) buf);
3347 /************************************************************************/
3348 /* where-is (mapping bindings to keys) */
3349 /************************************************************************/
3352 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3353 Lisp_Object firstonly, char *target_buffer);
3355 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3356 Return list of keys that invoke DEFINITION in KEYMAPS.
3357 KEYMAPS can be either a keymap (meaning search in that keymap and the
3358 current global keymap) or a list of keymaps (meaning search in exactly
3359 those keymaps and no others). If KEYMAPS is nil, search in the currently
3360 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3361 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3363 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3364 the first key sequence found, rather than a list of all possible key
3367 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3368 to other keymaps or slots. This makes it possible to search for an
3369 indirect definition itself.
3371 (definition, keymaps, firstonly, noindirect, event_or_keys))
3373 /* This function can GC */
3374 Lisp_Object maps[100];
3375 Lisp_Object *gubbish = maps;
3378 /* Get keymaps as an array */
3381 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3383 if (nmaps > countof (maps))
3385 gubbish = alloca_array (Lisp_Object, nmaps);
3386 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3389 else if (CONSP (keymaps))
3394 nmaps = XINT (Flength (keymaps));
3395 if (nmaps > countof (maps))
3397 gubbish = alloca_array (Lisp_Object, nmaps);
3399 for (rest = keymaps, i = 0; !NILP (rest);
3400 rest = XCDR (keymaps), i++)
3402 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3408 gubbish[0] = get_keymap (keymaps, 1, 1);
3409 if (!EQ (gubbish[0], Vcurrent_global_map))
3411 gubbish[1] = Vcurrent_global_map;
3416 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3419 /* This function is like
3420 (key-description (where-is-internal definition nil t))
3421 except that it writes its output into a (char *) buffer that you
3422 provide; it doesn't cons (or allocate memory) at all, so it's
3423 very fast. This is used by menubar.c.
3426 where_is_to_char (Lisp_Object definition, char *buffer)
3428 /* This function can GC */
3429 Lisp_Object maps[100];
3430 Lisp_Object *gubbish = maps;
3433 /* Get keymaps as an array */
3434 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3435 if (nmaps > countof (maps))
3437 gubbish = alloca_array (Lisp_Object, nmaps);
3438 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3442 where_is_internal (definition, maps, nmaps, Qt, buffer);
3447 raw_keys_to_keys (struct key_data *keys, int count)
3449 Lisp_Object result = make_vector (count, Qnil);
3451 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3457 format_raw_keys (struct key_data *keys, int count, char *buf)
3460 struct Lisp_Event event;
3461 event.event_type = key_press_event;
3462 event.channel = Vselected_console;
3463 for (i = 0; i < count; i++)
3465 event.event.key.keysym = keys[i].keysym;
3466 event.event.key.modifiers = keys[i].modifiers;
3467 format_event_object (buf, &event, 1);
3468 buf += strlen (buf);
3470 buf[0] = ' ', buf++;
3475 /* definition is the thing to look for.
3477 shadow is an array of shadow_count keymaps; if there is a different
3478 binding in any of the keymaps of a key that we are considering
3479 returning, then we reconsider.
3480 firstonly means give up after finding the first match;
3481 keys_so_far and modifiers_so_far describe which map we're looking in;
3482 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3483 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3484 will be MOD_META. That is, keys_so_far is the chain of keys that we
3485 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3488 (keys_so_far is a global buffer and the keys_count arg says how much
3489 of it we're currently interested in.)
3491 If target_buffer is provided, then we write a key-description into it,
3492 to avoid consing a string. This only works with firstonly on.
3495 struct where_is_closure
3497 Lisp_Object definition;
3498 Lisp_Object *shadow;
3502 unsigned int modifiers_so_far;
3503 char *target_buffer;
3504 struct key_data *keys_so_far;
3505 int keys_so_far_total_size;
3506 int keys_so_far_malloced;
3509 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3512 where_is_recursive_mapper (Lisp_Object map, void *arg)
3514 /* This function can GC */
3515 struct where_is_closure *c = (struct where_is_closure *) arg;
3516 Lisp_Object definition = c->definition;
3517 CONST int firstonly = c->firstonly;
3518 CONST unsigned int keys_count = c->keys_count;
3519 CONST unsigned int modifiers_so_far = c->modifiers_so_far;
3520 char *target_buffer = c->target_buffer;
3521 Lisp_Object keys = Fgethash (definition,
3522 XKEYMAP (map)->inverse_table,
3524 Lisp_Object submaps;
3525 Lisp_Object result = Qnil;
3529 /* One or more keys in this map match the definition we're looking for.
3530 Verify that these bindings aren't shadowed by other bindings
3531 in the shadow maps. Either nil or number as value from
3532 raw_lookup_key() means undefined. */
3533 struct key_data *so_far = c->keys_so_far;
3535 for (;;) /* loop over all keys that match */
3537 Lisp_Object k = ((CONSP (keys)) ? XCAR (keys) : keys);
3540 so_far [keys_count].keysym = k;
3541 so_far [keys_count].modifiers = modifiers_so_far;
3543 /* now loop over all shadow maps */
3544 for (i = 0; i < c->shadow_count; i++)
3546 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3551 if (NILP (shadowed) || CHARP (shadowed) ||
3552 EQ (shadowed, definition))
3553 continue; /* we passed this test; it's not shadowed here. */
3555 /* ignore this key binding, since it actually has a
3556 different binding in a shadowing map */
3557 goto c_doesnt_have_proper_loop_exit_statements;
3560 /* OK, the key is for real */
3563 if (!firstonly) abort ();
3564 format_raw_keys (so_far, keys_count + 1, target_buffer);
3565 return make_int (1);
3568 return raw_keys_to_keys (so_far, keys_count + 1);
3570 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3573 c_doesnt_have_proper_loop_exit_statements:
3574 /* now on to the next matching key ... */
3575 if (!CONSP (keys)) break;
3580 /* Now search the sub-keymaps of this map.
3581 If we're in "firstonly" mode and have already found one, this
3582 point is not reached. If we get one from lower down, either
3583 return it immediately (in firstonly mode) or tack it onto the
3584 end of the ones we've gotten so far.
3586 for (submaps = keymap_submaps (map);
3588 submaps = XCDR (submaps))
3590 Lisp_Object key = XCAR (XCAR (submaps));
3591 Lisp_Object submap = XCDR (XCAR (submaps));
3592 unsigned int lower_modifiers;
3593 int lower_keys_count = keys_count;
3596 submap = get_keymap (submap, 0, 0);
3598 if (EQ (submap, map))
3599 /* Arrgh! Some loser has introduced a loop... */
3602 /* If this is not a keymap, then that's probably because someone
3603 did an `fset' of a symbol that used to point to a map such that
3604 it no longer does. Sigh. Ignore this, and invalidate the cache
3605 so that it doesn't happen to us next time too.
3609 XKEYMAP (map)->sub_maps_cache = Qt;
3613 /* If the map is a "bucky" map, then add a bit to the
3614 modifiers_so_far list.
3615 Otherwise, add a new raw_key onto the end of keys_so_far.
3617 bucky = MODIFIER_HASH_KEY_BITS (key);
3619 lower_modifiers = (modifiers_so_far | bucky);
3622 struct key_data *so_far = c->keys_so_far;
3623 lower_modifiers = 0;
3624 so_far [lower_keys_count].keysym = key;
3625 so_far [lower_keys_count].modifiers = modifiers_so_far;
3629 if (lower_keys_count >= c->keys_so_far_total_size)
3631 int size = lower_keys_count + 50;
3632 if (! c->keys_so_far_malloced)
3634 struct key_data *new = xnew_array (struct key_data, size);
3635 memcpy ((void *)new, (CONST void *)c->keys_so_far,
3636 c->keys_so_far_total_size * sizeof (struct key_data));
3639 XREALLOC_ARRAY (c->keys_so_far, struct key_data, size);
3641 c->keys_so_far_total_size = size;
3642 c->keys_so_far_malloced = 1;
3648 c->keys_count = lower_keys_count;
3649 c->modifiers_so_far = lower_modifiers;
3651 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3653 c->keys_count = keys_count;
3654 c->modifiers_so_far = modifiers_so_far;
3657 result = nconc2 (lower, result);
3658 else if (!NILP (lower))
3667 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3668 Lisp_Object firstonly, char *target_buffer)
3670 /* This function can GC */
3671 Lisp_Object result = Qnil;
3673 struct key_data raw[20];
3674 struct where_is_closure c;
3676 c.definition = definition;
3678 c.firstonly = !NILP (firstonly);
3679 c.target_buffer = target_buffer;
3680 c.keys_so_far = raw;
3681 c.keys_so_far_total_size = countof (raw);
3682 c.keys_so_far_malloced = 0;
3684 /* Loop over each of the maps, accumulating the keys found.
3685 For each map searched, all previous maps shadow this one
3686 so that bogus keys aren't listed. */
3687 for (i = 0; i < nmaps; i++)
3689 Lisp_Object this_result;
3691 /* Reset the things set in each iteration */
3693 c.modifiers_so_far = 0;
3695 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3697 if (!NILP (firstonly))
3699 result = this_result;
3704 result = nconc2 (this_result, result);
3707 if (NILP (firstonly))
3708 result = Fnreverse (result);
3710 if (c.keys_so_far_malloced)
3711 xfree (c.keys_so_far);
3716 /************************************************************************/
3717 /* Describing keymaps */
3718 /************************************************************************/
3720 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3721 Insert a list of all defined keys and their definitions in MAP.
3722 Optional second argument ALL says whether to include even "uninteresting"
3723 definitions (ie symbols with a non-nil `suppress-keymap' property.
3724 Third argument SHADOW is a list of keymaps whose bindings shadow those
3725 of map; if a binding is present in any shadowing map, it is not printed.
3726 Fourth argument PREFIX, if non-nil, should be a key sequence;
3727 only bindings which start with that key sequence will be printed.
3728 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3730 (map, all, shadow, prefix, mouse_only_p))
3732 /* This function can GC */
3734 /* #### At some point, this function should be changed to accept a
3735 BUFFER argument. Currently, the BUFFER argument to
3736 describe_map_tree is being used only internally. */
3737 describe_map_tree (map, NILP (all), shadow, prefix,
3738 !NILP (mouse_only_p), Fcurrent_buffer ());
3743 /* Insert a description of the key bindings in STARTMAP,
3744 followed by those of all maps reachable through STARTMAP.
3745 If PARTIAL is nonzero, omit certain "uninteresting" commands
3746 (such as `undefined').
3747 If SHADOW is non-nil, it is a list of other maps;
3748 don't mention keys which would be shadowed by any of them
3749 If PREFIX is non-nil, only list bindings which start with those keys.
3753 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3754 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3756 /* This function can GC */
3757 Lisp_Object maps = Qnil;
3758 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3759 GCPRO2 (maps, shadow);
3761 maps = Faccessible_keymaps (startmap, prefix);
3763 for (; !NILP (maps); maps = Fcdr (maps))
3765 Lisp_Object sub_shadow = Qnil;
3766 Lisp_Object elt = Fcar (maps);
3768 int no_prefix = (VECTORP (Fcar (elt))
3769 && XINT (Flength (Fcar (elt))) == 0);
3770 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3771 NGCPRO3 (sub_shadow, elt, tail);
3773 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3775 Lisp_Object shmap = XCAR (tail);
3777 /* If the sequence by which we reach this keymap is zero-length,
3778 then the shadow maps for this keymap are just SHADOW. */
3781 /* If the sequence by which we reach this keymap actually has
3782 some elements, then the sequence's definition in SHADOW is
3783 what we should use. */
3786 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3793 Lisp_Object shm = get_keymap (shmap, 0, 1);
3794 /* If shmap is not nil and not a keymap, it completely
3795 shadows this map, so don't describe this map at all. */
3798 sub_shadow = Fcons (shm, sub_shadow);
3803 /* Describe the contents of map MAP, assuming that this map
3804 itself is reached by the sequence of prefix keys KEYS (a vector).
3805 PARTIAL and SHADOW are as in `describe_map_tree'. */
3806 Lisp_Object keysdesc
3808 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3810 describe_map (Fcdr (elt), keysdesc,
3825 describe_command (Lisp_Object definition, Lisp_Object buffer)
3827 /* This function can GC */
3828 int keymapp = !NILP (Fkeymapp (definition));
3829 struct gcpro gcpro1;
3830 GCPRO1 (definition);
3832 Findent_to (make_int (16), make_int (3), buffer);
3834 buffer_insert_c_string (XBUFFER (buffer), "<< ");
3836 if (SYMBOLP (definition))
3838 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3840 else if (STRINGP (definition) || VECTORP (definition))
3842 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: ");
3843 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3845 else if (COMPILED_FUNCTIONP (definition))
3846 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function");
3847 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
3848 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda");
3849 else if (KEYMAPP (definition))
3851 Lisp_Object name = XKEYMAP (definition)->name;
3852 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3854 buffer_insert_c_string (XBUFFER (buffer), "Prefix command ");
3856 && EQ (find_symbol_value (name), definition))
3857 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3860 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3864 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command");
3867 buffer_insert_c_string (XBUFFER (buffer), "??");
3870 buffer_insert_c_string (XBUFFER (buffer), " >>");
3871 buffer_insert_c_string (XBUFFER (buffer), "\n");
3875 struct describe_map_closure
3877 Lisp_Object *list; /* pointer to the list to update */
3878 Lisp_Object partial; /* whether to ignore suppressed commands */
3879 Lisp_Object shadow; /* list of maps shadowing this one */
3880 Lisp_Object self; /* this map */
3881 Lisp_Object self_root; /* this map, or some map that has this map as
3882 a parent. this is the base of the tree */
3883 int mice_only_p; /* whether we are to display only button bindings */
3886 struct describe_map_shadow_closure
3888 CONST struct key_data *raw_key;
3893 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3895 struct describe_map_shadow_closure *c =
3896 (struct describe_map_shadow_closure *) arg;
3898 if (EQ (map, c->self))
3899 return Qzero; /* Not shadowed; terminate search */
3901 return !NILP (keymap_lookup_directly (map,
3903 c->raw_key->modifiers))
3909 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3911 struct key_data *k = (struct key_data *) arg;
3912 return keymap_lookup_directly (km, k->keysym, k->modifiers);
3917 describe_map_mapper (CONST struct key_data *key,
3918 Lisp_Object binding,
3919 void *describe_map_closure)
3921 /* This function can GC */
3922 struct describe_map_closure *closure =
3923 (struct describe_map_closure *) describe_map_closure;
3924 Lisp_Object keysym = key->keysym;
3925 unsigned int modifiers = key->modifiers;
3927 /* Don't mention suppressed commands. */
3928 if (SYMBOLP (binding)
3929 && !NILP (closure->partial)
3930 && !NILP (Fget (binding, closure->partial, Qnil)))
3933 /* If we're only supposed to display mouse bindings and this isn't one,
3935 if (closure->mice_only_p &&
3936 (! (EQ (keysym, Qbutton0) ||
3937 EQ (keysym, Qbutton1) ||
3938 EQ (keysym, Qbutton2) ||
3939 EQ (keysym, Qbutton3) ||
3940 EQ (keysym, Qbutton4) ||
3941 EQ (keysym, Qbutton5) ||
3942 EQ (keysym, Qbutton6) ||
3943 EQ (keysym, Qbutton7) ||
3944 EQ (keysym, Qbutton0up) ||
3945 EQ (keysym, Qbutton1up) ||
3946 EQ (keysym, Qbutton2up) ||
3947 EQ (keysym, Qbutton3up) ||
3948 EQ (keysym, Qbutton4up) ||
3949 EQ (keysym, Qbutton5up) ||
3950 EQ (keysym, Qbutton6up) ||
3951 EQ (keysym, Qbutton7up))))
3954 /* If this command in this map is shadowed by some other map, ignore it. */
3958 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3961 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3962 keymap_lookup_inherited_mapper,
3963 /* Cast to discard `const' */
3969 /* If this key is in some map of which this map is a parent, then ignore
3970 it (in that case, it has been shadowed).
3974 struct describe_map_shadow_closure c;
3976 c.self = closure->self;
3978 sh = traverse_keymaps (closure->self_root, Qnil,
3979 describe_map_mapper_shadow_search, &c);
3980 if (!NILP (sh) && !ZEROP (sh))
3984 /* Otherwise add it to the list to be sorted. */
3985 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
3992 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
3995 /* obj1 and obj2 are conses of the form
3996 ( ( <keysym> . <modifiers> ) . <binding> )
3997 keysym and modifiers are used, binding is ignored.
3999 unsigned int bit1, bit2;
4002 bit1 = XINT (XCDR (obj1));
4003 bit2 = XINT (XCDR (obj2));
4005 return bit1 < bit2 ? 1 : -1;
4007 return map_keymap_sort_predicate (obj1, obj2, pred);
4010 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4011 or 2 or more symbolic keysyms that are bound to the same thing and
4012 have consecutive character-set-properties.
4015 elide_next_two_p (Lisp_Object list)
4019 if (NILP (XCDR (list)))
4022 /* next two bindings differ */
4023 if (!EQ (XCDR (XCAR (list)),
4024 XCDR (XCAR (XCDR (list)))))
4027 /* next two modifier-sets differ */
4028 if (!EQ (XCDR (XCAR (XCAR (list))),
4029 XCDR (XCAR (XCAR (XCDR (list))))))
4032 s1 = XCAR (XCAR (XCAR (list)));
4033 s2 = XCAR (XCAR (XCAR (XCDR (list))));
4037 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
4038 if (CHAR_OR_CHAR_INTP (code))
4041 CHECK_CHAR_COERCE_INT (s1);
4047 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
4048 if (CHAR_OR_CHAR_INTP (code))
4051 CHECK_CHAR_COERCE_INT (s2);
4056 return (XCHAR (s1) == XCHAR (s2) ||
4057 XCHAR (s1) + 1 == XCHAR (s2));
4062 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
4064 /* This function can GC */
4065 struct describe_map_closure *describe_map_closure =
4066 (struct describe_map_closure *) arg;
4067 describe_map_closure->self = keymap;
4068 map_keymap (XKEYMAP (keymap)->table,
4069 0, /* don't sort: we'll do it later */
4070 describe_map_mapper, describe_map_closure);
4075 /* Describe the contents of map MAP, assuming that this map itself is
4076 reached by the sequence of prefix keys KEYS (a string or vector).
4077 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4080 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
4081 void (*elt_describer) (Lisp_Object, Lisp_Object),
4087 /* This function can GC */
4088 struct describe_map_closure describe_map_closure;
4089 Lisp_Object list = Qnil;
4090 struct buffer *buf = XBUFFER (buffer);
4091 Emchar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
4092 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
4093 : ((EQ (buf->ctl_arrow, Qt)
4094 || EQ (buf->ctl_arrow, Qnil))
4097 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4099 keymap = get_keymap (keymap, 1, 1);
4100 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4101 describe_map_closure.shadow = shadow;
4102 describe_map_closure.list = &list;
4103 describe_map_closure.self_root = keymap;
4104 describe_map_closure.mice_only_p = mice_only_p;
4106 GCPRO4 (keymap, elt_prefix, shadow, list);
4108 traverse_keymaps (keymap, Qnil,
4109 describe_map_parent_mapper, &describe_map_closure);
4113 list = list_sort (list, Qnil, describe_map_sort_predicate);
4114 buffer_insert_c_string (buf, "\n");
4115 while (!NILP (list))
4117 Lisp_Object elt = XCAR (XCAR (list));
4118 Lisp_Object keysym = XCAR (elt);
4119 unsigned int modifiers = XINT (XCDR (elt));
4121 if (!NILP (elt_prefix))
4122 buffer_insert_lisp_string (buf, elt_prefix);
4124 if (modifiers & MOD_META) buffer_insert_c_string (buf, "M-");
4125 if (modifiers & MOD_CONTROL) buffer_insert_c_string (buf, "C-");
4126 if (modifiers & MOD_SUPER) buffer_insert_c_string (buf, "S-");
4127 if (modifiers & MOD_HYPER) buffer_insert_c_string (buf, "H-");
4128 if (modifiers & MOD_ALT) buffer_insert_c_string (buf, "Alt-");
4129 if (modifiers & MOD_SHIFT) buffer_insert_c_string (buf, "Sh-");
4130 if (SYMBOLP (keysym))
4132 Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil);
4133 Emchar c = (CHAR_OR_CHAR_INTP (code)
4134 ? XCHAR_OR_CHAR_INT (code) : (Emchar) -1);
4135 /* Calling Fsingle_key_description() would cons more */
4136 #if 0 /* This is bogus */
4137 if (EQ (keysym, QKlinefeed))
4138 buffer_insert_c_string (buf, "LFD");
4139 else if (EQ (keysym, QKtab))
4140 buffer_insert_c_string (buf, "TAB");
4141 else if (EQ (keysym, QKreturn))
4142 buffer_insert_c_string (buf, "RET");
4143 else if (EQ (keysym, QKescape))
4144 buffer_insert_c_string (buf, "ESC");
4145 else if (EQ (keysym, QKdelete))
4146 buffer_insert_c_string (buf, "DEL");
4147 else if (EQ (keysym, QKspace))
4148 buffer_insert_c_string (buf, "SPC");
4149 else if (EQ (keysym, QKbackspace))
4150 buffer_insert_c_string (buf, "BS");
4153 if (c >= printable_min)
4154 buffer_insert_emacs_char (buf, c);
4155 else buffer_insert1 (buf, Fsymbol_name (keysym));
4157 else if (CHARP (keysym))
4158 buffer_insert_emacs_char (buf, XCHAR (keysym));
4160 buffer_insert_c_string (buf, "---bad keysym---");
4168 while (elide_next_two_p (list))
4176 buffer_insert_c_string (buf, ", ");
4178 buffer_insert_c_string (buf, " .. ");
4184 /* Print a description of the definition of this character. */
4185 (*elt_describer) (XCDR (XCAR (list)), buffer);
4194 syms_of_keymap (void)
4196 defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist");
4198 defsymbol (&Qkeymapp, "keymapp");
4200 defsymbol (&Qsuppress_keymap, "suppress-keymap");
4202 defsymbol (&Qmodeline_map, "modeline-map");
4203 defsymbol (&Qtoolbar_map, "toolbar-map");
4205 DEFSUBR (Fkeymap_parents);
4206 DEFSUBR (Fset_keymap_parents);
4207 DEFSUBR (Fkeymap_name);
4208 DEFSUBR (Fset_keymap_name);
4209 DEFSUBR (Fkeymap_prompt);
4210 DEFSUBR (Fset_keymap_prompt);
4211 DEFSUBR (Fkeymap_default_binding);
4212 DEFSUBR (Fset_keymap_default_binding);
4215 DEFSUBR (Fmake_keymap);
4216 DEFSUBR (Fmake_sparse_keymap);
4218 DEFSUBR (Fcopy_keymap);
4219 DEFSUBR (Fkeymap_fullness);
4220 DEFSUBR (Fmap_keymap);
4221 DEFSUBR (Fevent_matches_key_specifier_p);
4222 DEFSUBR (Fdefine_key);
4223 DEFSUBR (Flookup_key);
4224 DEFSUBR (Fkey_binding);
4225 DEFSUBR (Fuse_global_map);
4226 DEFSUBR (Fuse_local_map);
4227 DEFSUBR (Fcurrent_local_map);
4228 DEFSUBR (Fcurrent_global_map);
4229 DEFSUBR (Fcurrent_keymaps);
4230 DEFSUBR (Faccessible_keymaps);
4231 DEFSUBR (Fkey_description);
4232 DEFSUBR (Fsingle_key_description);
4233 DEFSUBR (Fwhere_is_internal);
4234 DEFSUBR (Fdescribe_bindings_internal);
4236 DEFSUBR (Ftext_char_description);
4238 defsymbol (&Qcontrol, "control");
4239 defsymbol (&Qctrl, "ctrl");
4240 defsymbol (&Qmeta, "meta");
4241 defsymbol (&Qsuper, "super");
4242 defsymbol (&Qhyper, "hyper");
4243 defsymbol (&Qalt, "alt");
4244 defsymbol (&Qshift, "shift");
4245 defsymbol (&Qbutton0, "button0");
4246 defsymbol (&Qbutton1, "button1");
4247 defsymbol (&Qbutton2, "button2");
4248 defsymbol (&Qbutton3, "button3");
4249 defsymbol (&Qbutton4, "button4");
4250 defsymbol (&Qbutton5, "button5");
4251 defsymbol (&Qbutton6, "button6");
4252 defsymbol (&Qbutton7, "button7");
4253 defsymbol (&Qbutton0up, "button0up");
4254 defsymbol (&Qbutton1up, "button1up");
4255 defsymbol (&Qbutton2up, "button2up");
4256 defsymbol (&Qbutton3up, "button3up");
4257 defsymbol (&Qbutton4up, "button4up");
4258 defsymbol (&Qbutton5up, "button5up");
4259 defsymbol (&Qbutton6up, "button6up");
4260 defsymbol (&Qbutton7up, "button7up");
4261 defsymbol (&Qmouse_1, "mouse-1");
4262 defsymbol (&Qmouse_2, "mouse-2");
4263 defsymbol (&Qmouse_3, "mouse-3");
4264 defsymbol (&Qmouse_4, "mouse-4");
4265 defsymbol (&Qmouse_5, "mouse-5");
4266 defsymbol (&Qdown_mouse_1, "down-mouse-1");
4267 defsymbol (&Qdown_mouse_2, "down-mouse-2");
4268 defsymbol (&Qdown_mouse_3, "down-mouse-3");
4269 defsymbol (&Qdown_mouse_4, "down-mouse-4");
4270 defsymbol (&Qdown_mouse_5, "down-mouse-5");
4271 defsymbol (&Qmenu_selection, "menu-selection");
4272 defsymbol (&QLFD, "LFD");
4273 defsymbol (&QTAB, "TAB");
4274 defsymbol (&QRET, "RET");
4275 defsymbol (&QESC, "ESC");
4276 defsymbol (&QDEL, "DEL");
4277 defsymbol (&QBS, "BS");
4281 vars_of_keymap (void)
4283 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
4284 Meta-prefix character.
4285 This character followed by some character `foo' turns into `Meta-foo'.
4286 This can be any form recognized as a single key specifier.
4287 To disable the meta-prefix-char, set it to a negative number.
4289 Vmeta_prefix_char = make_char (033);
4291 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4292 A buffer which should be consulted first for all mouse activity.
4293 When a mouse-click is processed, it will first be looked up in the
4294 local-map of this buffer, and then through the normal mechanism if there
4295 is no binding for that click. This buffer's value of `mode-motion-hook'
4296 will be consulted instead of the `mode-motion-hook' of the buffer of the
4297 window under the mouse. You should *bind* this, not set it.
4299 Vmouse_grabbed_buffer = Qnil;
4301 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
4302 Keymap that overrides all other local keymaps.
4303 If this variable is non-nil, it is used as a keymap instead of the
4304 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4305 You should *bind* this, not set it.
4307 Voverriding_local_map = Qnil;
4309 Fset (Qminor_mode_map_alist, Qnil);
4311 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
4312 Keymap of key translations that can override keymaps.
4313 This keymap works like `function-key-map', but comes after that,
4314 and applies even for keys that have ordinary bindings.
4316 Vkey_translation_map = Qnil;
4318 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
4319 Keymap which handles mouse clicks over vertical dividers.
4321 Vvertical_divider_map = Qnil;
4323 DEFVAR_INT ("keymap-tick", &keymap_tick /*
4324 Incremented for each change to any keymap.
4328 staticpro (&Vcurrent_global_map);
4330 Vsingle_space_string = make_string_nocopy ((CONST Bufbyte *) " ", 1);
4331 staticpro (&Vsingle_space_string);
4335 complex_vars_of_keymap (void)
4337 /* This function can GC */
4338 Lisp_Object ESC_prefix = intern ("ESC-prefix");
4339 Lisp_Object meta_disgustitute;
4341 Vcurrent_global_map = Fmake_keymap (Qnil);
4343 meta_disgustitute = Fmake_keymap (Qnil);
4344 Ffset (ESC_prefix, meta_disgustitute);
4345 /* no need to protect meta_disgustitute, though */
4346 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (MOD_META),
4347 XKEYMAP (Vcurrent_global_map),
4349 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
4351 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));