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. */
43 /* Hmm, under unix we want X modifiers, under NT we want X modifiers if
44 we are running X and Windows modifiers otherwise.
45 gak. This is a kludge until we support multiple native GUIs!
52 #include "events-mod.h"
55 /* A keymap contains six slots:
57 parents Ordered list of keymaps to search after
58 this one if no match is found.
59 Keymaps can thus be arranged in a hierarchy.
61 table A hash table, hashing keysyms to their bindings.
62 It will be one of the following:
64 -- a symbol, e.g. 'home
65 -- a character, representing something printable
66 (not ?\C-c meaning C-c, for instance)
67 -- an integer representing a modifier combination
69 inverse_table A hash table, hashing bindings to the list of keysyms
70 in this keymap which are bound to them. This is to make
71 the Fwhere_is_internal() function be fast. It needs to be
72 fast because we want to be able to call it in realtime to
73 update the keyboard-equivalents on the pulldown menus.
74 Values of the table are either atoms (keysyms)
75 or a dotted list of keysyms.
77 sub_maps_cache An alist; for each entry in this keymap whose binding is
78 a keymap (that is, Fkeymapp()) this alist associates that
79 keysym with that binding. This is used to optimize both
80 Fwhere_is_internal() and Faccessible_keymaps(). This slot
81 gets set to the symbol `t' every time a change is made to
82 this keymap, causing it to be recomputed when next needed.
84 prompt See `set-keymap-prompt'.
86 default_binding See `set-keymap-default-binding'.
88 Sequences of keys are stored in the obvious way: if the sequence of keys
89 "abc" was bound to some command `foo', the hierarchy would look like
91 keymap-1: associates "a" with keymap-2
92 keymap-2: associates "b" with keymap-3
93 keymap-3: associates "c" with foo
95 However, bucky bits ("modifiers" to the X-minded) are represented in the
96 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
97 Each combination of modifiers (e.g. control-hyper) gets its own submap
98 off of the main map. The hash key for a modifier combination is
99 an integer, computed by MAKE_MODIFIER_HASH_KEY().
101 If the key `C-a' was bound to some command, the hierarchy would look like
103 keymap-1: associates the integer MOD_CONTROL with keymap-2
104 keymap-2: associates "a" with the command
106 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
109 keymap-1: associates the integer (MOD_CONTROL | MOD_HYPER)
111 keymap-2: associates "a" with the command
113 Note that a special exception is made for the meta modifier, in order
114 to deal with ESC/meta lossage. Any key combination containing the
115 meta modifier is first indexed off of the main map into the meta
116 submap (with hash key MOD_META) and then indexed off of the
117 meta submap with the meta modifier removed from the key combination.
118 For example, when associating a command with C-M-H-a, we'd have
120 keymap-1: associates the integer MOD_META with keymap-2
121 keymap-2: associates the integer (MOD_CONTROL | MOD_HYPER)
123 keymap-3: associates "a" with the command
125 Note that keymap-2 might have normal bindings in it; these would be
126 for key combinations containing only the meta modifier, such as
127 M-y or meta-backspace.
129 If the command that "a" was bound to in keymap-3 was itself a keymap,
130 then that would make the key "C-M-H-a" be a prefix character.
132 Note that this new model of keymaps takes much of the magic away from
133 the Escape key: the value of the variable `esc-map' is no longer indexed
134 in the `global-map' under the ESC key. It's indexed under the integer
135 MOD_META. This is not user-visible, however; none of the "bucky"
138 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
139 and (define-key some-random-map "\^[" my-esc-map) work as before, for
142 Since keymaps are opaque, the only way to extract information from them
143 is with the functions lookup-key, key-binding, local-key-binding, and
144 global-key-binding, which work just as before, and the new function
145 map-keymap, which is roughly analagous to maphash.
147 Note that map-keymap perpetuates the illusion that the "bucky" submaps
148 don't exist: if you map over a keymap with bucky submaps, it will also
149 map over those submaps. It does not, however, map over other random
150 submaps of the keymap, just the bucky ones.
152 One implication of this is that when you map over `global-map', you will
153 also map over `esc-map'. It is merely for compatibility that the esc-map
154 is accessible at all; I think that's a bad thing, since it blurs the
155 distinction between ESC and "meta" even more. "M-x" is no more a two-
156 key sequence than "C-x" is.
162 struct lcrecord_header header;
163 Lisp_Object parents; /* Keymaps to be searched after this one
165 Lisp_Object prompt; /* Qnil or a string to print in the minibuffer
166 * when reading from this keymap */
168 Lisp_Object table; /* The contents of this keymap */
169 Lisp_Object inverse_table; /* The inverse mapping of the above */
171 Lisp_Object default_binding; /* Use this if no other binding is found
172 * (this overrides parent maps and the
173 * normal global-map lookup). */
176 Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps;
177 This holds an alist, of the key and the
178 maps, or the modifier bit and the map.
179 If this is the symbol t, then the cache
180 needs to be recomputed.
182 int fullness; /* How many entries there are in this table.
183 This should be the same as the fullness
184 of the `table', but hash.c is broken. */
185 Lisp_Object name; /* Just for debugging convenience */
188 #define XKEYMAP(x) XRECORD (x, keymap, struct keymap)
189 #define XSETKEYMAP(x, p) XSETRECORD (x, p, keymap)
190 #define KEYMAPP(x) RECORDP (x, keymap)
191 #define CHECK_KEYMAP(x) CHECK_RECORD (x, keymap)
193 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
194 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
198 /* Actually allocate storage for these variables */
200 static Lisp_Object Vcurrent_global_map; /* Always a keymap */
202 static Lisp_Object Vmouse_grabbed_buffer;
204 /* Alist of minor mode variables and keymaps. */
205 static Lisp_Object Qminor_mode_map_alist;
207 static Lisp_Object Voverriding_local_map;
209 static Lisp_Object Vkey_translation_map;
211 static Lisp_Object Vvertical_divider_map;
213 /* This is incremented whenever a change is made to a keymap. This is
214 so that things which care (such as the menubar code) can recompute
215 privately-cached data when the user has changed keybindings.
219 /* Prefixing a key with this character is the same as sending a meta bit. */
220 Lisp_Object Vmeta_prefix_char;
222 Lisp_Object Qkeymapp;
223 Lisp_Object Vsingle_space_string;
224 Lisp_Object Qsuppress_keymap;
225 Lisp_Object Qmodeline_map;
226 Lisp_Object Qtoolbar_map;
228 EXFUN (Fkeymap_fullness, 1);
229 EXFUN (Fset_keymap_name, 2);
230 EXFUN (Fsingle_key_description, 1);
232 static void describe_command (Lisp_Object definition, Lisp_Object buffer);
233 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
234 void (*elt_describer) (Lisp_Object, Lisp_Object),
240 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
241 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3;
242 Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7;
243 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up;
244 Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up;
246 Lisp_Object Qmenu_selection;
247 /* Emacs compatibility */
248 Lisp_Object Qdown_mouse_1, Qdown_mouse_2, Qdown_mouse_3, Qdown_mouse_4,
250 Lisp_Object Qmouse_1, Qmouse_2, Qmouse_3, Qmouse_4, Qmouse_5;
252 /* Kludge kludge kludge */
253 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
256 /************************************************************************/
257 /* The keymap Lisp object */
258 /************************************************************************/
261 mark_keymap (Lisp_Object obj, void (*markobj) (Lisp_Object))
263 struct keymap *keymap = XKEYMAP (obj);
264 ((markobj) (keymap->parents));
265 ((markobj) (keymap->prompt));
266 ((markobj) (keymap->inverse_table));
267 ((markobj) (keymap->sub_maps_cache));
268 ((markobj) (keymap->default_binding));
269 ((markobj) (keymap->name));
270 return keymap->table;
274 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
276 /* This function can GC */
277 struct keymap *keymap = XKEYMAP (obj);
279 int size = XINT (Fkeymap_fullness (obj));
281 error ("printing unreadable object #<keymap 0x%x>", keymap->header.uid);
282 write_c_string ("#<keymap ", printcharfun);
283 if (!NILP (keymap->name))
284 print_internal (keymap->name, printcharfun, 1);
285 /* #### Yuck! This is no way to form plural! --hniksic */
286 sprintf (buf, "%s%d entr%s 0x%x>",
287 ((NILP (keymap->name)) ? "" : " "),
289 ((size == 1) ? "y" : "ies"),
291 write_c_string (buf, printcharfun);
294 /* No need for keymap_equal #### Why not? */
295 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap,
296 mark_keymap, print_keymap, 0, 0, 0,
299 /************************************************************************/
300 /* Traversing keymaps and their parents */
301 /************************************************************************/
304 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents,
305 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg),
308 /* This function can GC */
310 Lisp_Object tail = start_parents;
311 Lisp_Object malloc_sucks[10];
312 Lisp_Object malloc_bites = Qnil;
314 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
315 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail);
318 start_keymap = get_keymap (start_keymap, 1, 1);
319 keymap = start_keymap;
320 /* Hack special-case parents at top-level */
321 tail = ((!NILP (tail)) ? tail : XKEYMAP (keymap)->parents);
328 result = ((mapper) (keymap, mapper_arg));
331 while (CONSP (malloc_bites))
333 struct Lisp_Cons *victim = XCONS (malloc_bites);
334 malloc_bites = victim->cdr;
342 if (stack_depth == 0)
345 return Qnil; /* Nothing found */
348 if (CONSP (malloc_bites))
350 struct Lisp_Cons *victim = XCONS (malloc_bites);
352 malloc_bites = victim->cdr;
357 tail = malloc_sucks[stack_depth];
358 gcpro1.nvars = stack_depth;
360 keymap = XCAR (tail);
367 keymap = XCAR (tail);
369 parents = XKEYMAP (keymap)->parents;
370 if (!CONSP (parents))
372 else if (NILP (tail))
377 if (CONSP (malloc_bites))
378 malloc_bites = noseeum_cons (tail, malloc_bites);
379 else if (stack_depth < countof (malloc_sucks))
381 malloc_sucks[stack_depth++] = tail;
382 gcpro1.nvars = stack_depth;
386 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */
388 for (i = 0, malloc_bites = Qnil;
389 i < countof (malloc_sucks);
391 malloc_bites = noseeum_cons (malloc_sucks[i],
398 keymap = get_keymap (keymap, 1, 1);
399 if (EQ (keymap, start_keymap))
401 signal_simple_error ("Cyclic keymap indirection",
408 /************************************************************************/
409 /* Some low-level functions */
410 /************************************************************************/
413 bucky_sym_to_bucky_bit (Lisp_Object sym)
415 if (EQ (sym, Qcontrol)) return MOD_CONTROL;
416 if (EQ (sym, Qmeta)) return MOD_META;
417 if (EQ (sym, Qsuper)) return MOD_SUPER;
418 if (EQ (sym, Qhyper)) return MOD_HYPER;
419 if (EQ (sym, Qalt)) return MOD_ALT;
420 if (EQ (sym, Qsymbol)) return MOD_ALT; /* #### - reverse compat */
421 if (EQ (sym, Qshift)) return MOD_SHIFT;
427 control_meta_superify (Lisp_Object frob, unsigned int modifiers)
431 frob = Fcons (frob, Qnil);
432 if (modifiers & MOD_SHIFT) frob = Fcons (Qshift, frob);
433 if (modifiers & MOD_ALT) frob = Fcons (Qalt, frob);
434 if (modifiers & MOD_HYPER) frob = Fcons (Qhyper, frob);
435 if (modifiers & MOD_SUPER) frob = Fcons (Qsuper, frob);
436 if (modifiers & MOD_CONTROL) frob = Fcons (Qcontrol, frob);
437 if (modifiers & MOD_META) frob = Fcons (Qmeta, frob);
442 make_key_description (CONST struct key_data *key, int prettify)
444 Lisp_Object keysym = key->keysym;
445 unsigned int modifiers = key->modifiers;
447 if (prettify && CHARP (keysym))
449 /* This is a little slow, but (control a) is prettier than (control 65).
450 It's now ok to do this for digit-chars too, since we've fixed the
451 bug where \9 read as the integer 9 instead of as the symbol with
454 /* !!#### I'm not sure how correct this is. */
455 Bufbyte str [1 + MAX_EMCHAR_LEN];
456 Bytecount count = set_charptr_emchar (str, XCHAR (keysym));
458 keysym = intern ((char *) str);
460 return control_meta_superify (keysym, modifiers);
464 /************************************************************************/
465 /* Low-level keymap-store functions */
466 /************************************************************************/
469 raw_lookup_key (Lisp_Object keymap,
470 CONST struct key_data *raw_keys, int raw_keys_count,
471 int keys_so_far, int accept_default);
473 /* Relies on caller to gc-protect args */
475 keymap_lookup_directly (Lisp_Object keymap,
476 Lisp_Object keysym, unsigned int modifiers)
480 if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
481 | MOD_ALT | MOD_SHIFT)) != 0)
484 k = XKEYMAP (keymap);
486 /* If the keysym is a one-character symbol, use the char code instead. */
487 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
489 Lisp_Object i_fart_on_gcc =
490 make_char (string_char (XSYMBOL (keysym)->name, 0));
491 keysym = i_fart_on_gcc;
494 if (modifiers & MOD_META) /* Utterly hateful ESC lossage */
496 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
500 k = XKEYMAP (submap);
501 modifiers &= ~MOD_META;
506 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
510 k = XKEYMAP (submap);
512 return Fgethash (keysym, k->table, Qnil);
516 keymap_store_inverse_internal (Lisp_Object inverse_table,
520 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
525 /* Don't cons this unless necessary */
526 /* keys = Fcons (keysym, Qnil); */
527 Fputhash (value, keys, inverse_table);
529 else if (!CONSP (keys))
531 /* Now it's necessary to cons */
532 keys = Fcons (keys, keysym);
533 Fputhash (value, keys, inverse_table);
537 while (CONSP (Fcdr (keys)))
539 XCDR (keys) = Fcons (XCDR (keys), keysym);
540 /* No need to call puthash because we've destructively
541 modified the list tail in place */
547 keymap_delete_inverse_internal (Lisp_Object inverse_table,
551 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
552 Lisp_Object new_keys = keys;
559 for (prev = &new_keys, tail = new_keys;
561 prev = &(XCDR (tail)), tail = XCDR (tail))
563 if (EQ (tail, keysym))
568 else if (EQ (keysym, XCAR (tail)))
576 Fremhash (value, inverse_table);
577 else if (!EQ (keys, new_keys))
578 /* Removed the first elt */
579 Fputhash (value, new_keys, inverse_table);
580 /* else the list's tail has been modified, so we don't need to
581 touch the hash table again (the pointer in there is ok).
587 keymap_store_internal (Lisp_Object keysym, struct keymap *keymap,
590 Lisp_Object prev_value = Fgethash (keysym, keymap->table, Qnil);
592 if (EQ (prev_value, value))
594 if (!NILP (prev_value))
595 keymap_delete_inverse_internal (keymap->inverse_table,
600 if (keymap->fullness < 0) abort ();
601 Fremhash (keysym, keymap->table);
605 if (NILP (prev_value))
607 Fputhash (keysym, value, keymap->table);
608 keymap_store_inverse_internal (keymap->inverse_table,
616 create_bucky_submap (struct keymap *k, unsigned int modifiers,
617 Lisp_Object parent_for_debugging_info)
619 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
620 /* User won't see this, but it is nice for debugging Emacs */
621 XKEYMAP (submap)->name
622 = control_meta_superify (parent_for_debugging_info, modifiers);
623 /* Invalidate cache */
624 k->sub_maps_cache = Qt;
625 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
630 /* Relies on caller to gc-protect keymap, keysym, value */
632 keymap_store (Lisp_Object keymap, CONST struct key_data *key,
635 Lisp_Object keysym = key->keysym;
636 unsigned int modifiers = key->modifiers;
639 if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
640 | MOD_ALT | MOD_SHIFT)) != 0)
643 k = XKEYMAP (keymap);
645 /* If the keysym is a one-character symbol, use the char code instead. */
646 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
648 Lisp_Object run_the_gcc_developers_over_with_a_steamroller =
649 make_char (string_char (XSYMBOL (keysym)->name, 0));
650 keysym = run_the_gcc_developers_over_with_a_steamroller;
653 if (modifiers & MOD_META) /* Utterly hateful ESC lossage */
655 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
658 submap = create_bucky_submap (k, MOD_META, keymap);
659 k = XKEYMAP (submap);
660 modifiers &= ~MOD_META;
665 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
668 submap = create_bucky_submap (k, modifiers, keymap);
669 k = XKEYMAP (submap);
671 k->sub_maps_cache = Qt; /* Invalidate cache */
672 keymap_store_internal (keysym, k, value);
676 /************************************************************************/
677 /* Listing the submaps of a keymap */
678 /************************************************************************/
680 struct keymap_submaps_closure
682 Lisp_Object *result_locative;
686 keymap_submaps_mapper_0 (CONST void *hash_key, void *hash_contents,
687 void *keymap_submaps_closure)
689 /* This function can GC */
690 Lisp_Object contents;
691 VOID_TO_LISP (contents, hash_contents);
692 /* Perform any autoloads, etc */
698 keymap_submaps_mapper (CONST void *hash_key, void *hash_contents,
699 void *keymap_submaps_closure)
701 /* This function can GC */
702 Lisp_Object key, contents;
703 Lisp_Object *result_locative;
704 struct keymap_submaps_closure *cl =
705 (struct keymap_submaps_closure *) keymap_submaps_closure;
706 CVOID_TO_LISP (key, hash_key);
707 VOID_TO_LISP (contents, hash_contents);
708 result_locative = cl->result_locative;
710 if (!NILP (Fkeymapp (contents)))
711 *result_locative = Fcons (Fcons (key, contents), *result_locative);
715 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
719 keymap_submaps (Lisp_Object keymap)
721 /* This function can GC */
722 struct keymap *k = XKEYMAP (keymap);
724 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
726 Lisp_Object result = Qnil;
727 struct gcpro gcpro1, gcpro2;
728 struct keymap_submaps_closure keymap_submaps_closure;
730 GCPRO2 (keymap, result);
731 keymap_submaps_closure.result_locative = &result;
732 /* Do this first pass to touch (and load) any autoloaded maps */
733 elisp_maphash (keymap_submaps_mapper_0, k->table,
734 &keymap_submaps_closure);
736 elisp_maphash (keymap_submaps_mapper, k->table,
737 &keymap_submaps_closure);
738 /* keep it sorted so that the result of accessible-keymaps is ordered */
739 k->sub_maps_cache = list_sort (result,
741 map_keymap_sort_predicate);
744 return k->sub_maps_cache;
748 /************************************************************************/
749 /* Basic operations on keymaps */
750 /************************************************************************/
753 make_keymap (int size)
756 struct keymap *keymap = alloc_lcrecord_type (struct keymap, lrecord_keymap);
758 XSETKEYMAP (result, keymap);
760 keymap->parents = Qnil;
761 keymap->table = Qnil;
762 keymap->prompt = Qnil;
763 keymap->default_binding = Qnil;
764 keymap->inverse_table = Qnil;
765 keymap->sub_maps_cache = Qnil; /* No possible submaps */
766 keymap->fullness = 0;
767 if (size != 0) /* hack for copy-keymap */
769 keymap->table = Fmake_hashtable (make_int (size), Qnil);
770 /* Inverse table is often less dense because of duplicate key-bindings.
771 If not, it will grow anyway. */
772 keymap->inverse_table = Fmake_hashtable (make_int (size * 3 / 4), Qnil);
778 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
779 Construct and return a new keymap object.
780 All entries in it are nil, meaning "command undefined".
782 Optional argument NAME specifies a name to assign to the keymap,
783 as in `set-keymap-name'. This name is only a debugging convenience;
784 it is not used except when printing the keymap.
788 Lisp_Object keymap = make_keymap (60);
790 Fset_keymap_name (keymap, name);
794 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
795 Construct and return a new keymap object.
796 All entries in it are nil, meaning "command undefined". The only
797 difference between this function and make-keymap is that this function
798 returns a "smaller" keymap (one that is expected to contain fewer
799 entries). As keymaps dynamically resize, the distinction is not great.
801 Optional argument NAME specifies a name to assign to the keymap,
802 as in `set-keymap-name'. This name is only a debugging convenience;
803 it is not used except when printing the keymap.
807 Lisp_Object keymap = make_keymap (8);
809 Fset_keymap_name (keymap, name);
813 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
814 Return the `parent' keymaps of KEYMAP, or nil.
815 The parents of a keymap are searched for keybindings when a key sequence
816 isn't bound in this one. `(current-global-map)' is the default parent
821 keymap = get_keymap (keymap, 1, 1);
822 return Fcopy_sequence (XKEYMAP (keymap)->parents);
828 traverse_keymaps_noop (Lisp_Object keymap, void *arg)
833 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
834 Set the `parent' keymaps of KEYMAP to PARENTS.
835 The parents of a keymap are searched for keybindings when a key sequence
836 isn't bound in this one. `(current-global-map)' is the default parent
841 /* This function can GC */
843 struct gcpro gcpro1, gcpro2;
845 GCPRO2 (keymap, parents);
846 keymap = get_keymap (keymap, 1, 1);
848 if (KEYMAPP (parents)) /* backwards-compatibility */
849 parents = list1 (parents);
852 Lisp_Object tail = parents;
858 /* Require that it be an actual keymap object, rather than a symbol
859 with a (crockish) symbol-function which is a keymap */
860 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
865 /* Check for circularities */
866 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
868 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
873 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
874 Set the `name' of the KEYMAP to NEW-NAME.
875 The name is only a debugging convenience; it is not used except
876 when printing the keymap.
880 keymap = get_keymap (keymap, 1, 1);
882 XKEYMAP (keymap)->name = new_name;
886 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
887 Return the `name' of KEYMAP.
888 The name is only a debugging convenience; it is not used except
889 when printing the keymap.
893 keymap = get_keymap (keymap, 1, 1);
895 return XKEYMAP (keymap)->name;
898 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
899 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
900 if no prompt is desired. The prompt is shown in the echo-area
901 when reading a key-sequence to be looked-up in this keymap.
903 (keymap, new_prompt))
905 keymap = get_keymap (keymap, 1, 1);
907 if (!NILP (new_prompt))
908 CHECK_STRING (new_prompt);
910 XKEYMAP (keymap)->prompt = new_prompt;
915 keymap_prompt_mapper (Lisp_Object keymap, void *arg)
917 return XKEYMAP (keymap)->prompt;
921 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
922 Return the `prompt' of KEYMAP.
923 If non-nil, the prompt is shown in the echo-area
924 when reading a key-sequence to be looked-up in this keymap.
926 (keymap, use_inherited))
928 /* This function can GC */
931 keymap = get_keymap (keymap, 1, 1);
932 prompt = XKEYMAP (keymap)->prompt;
933 if (!NILP (prompt) || NILP (use_inherited))
936 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
939 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
940 Sets the default binding of KEYMAP to COMMAND, or `nil'
941 if no default is desired. The default-binding is returned when
942 no other binding for a key-sequence is found in the keymap.
943 If a keymap has a non-nil default-binding, neither the keymap's
944 parents nor the current global map are searched for key bindings.
948 /* This function can GC */
949 keymap = get_keymap (keymap, 1, 1);
951 XKEYMAP (keymap)->default_binding = command;
955 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
956 Return the default binding of KEYMAP, or `nil' if it has none.
957 The default-binding is returned when no other binding for a key-sequence
958 is found in the keymap.
959 If a keymap has a non-nil default-binding, neither the keymap's
960 parents nor the current global map are searched for key bindings.
964 /* This function can GC */
965 keymap = get_keymap (keymap, 1, 1);
966 return XKEYMAP (keymap)->default_binding;
969 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
970 Return t if ARG is a keymap object.
971 The keymap may be autoloaded first if necessary.
975 /* This function can GC */
976 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
979 /* Check that OBJECT is a keymap (after dereferencing through any
980 symbols). If it is, return it.
982 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
983 is an autoload form, do the autoload and try again.
984 If AUTOLOAD is nonzero, callers must assume GC is possible.
986 ERRORP controls how we respond if OBJECT isn't a keymap.
987 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
989 Note that most of the time, we don't want to pursue autoloads.
990 Functions like Faccessible_keymaps which scan entire keymap trees
991 shouldn't load every autoloaded keymap. I'm not sure about this,
992 but it seems to me that only read_key_sequence, Flookup_key, and
993 Fdefine_key should cause keymaps to be autoloaded. */
996 get_keymap (Lisp_Object object, int errorp, int autoload)
998 /* This function can GC */
1001 Lisp_Object tem = indirect_function (object, 0);
1005 /* Should we do an autoload? */
1007 /* (autoload "filename" doc nil keymap) */
1010 && EQ (XCAR (tem), Qautoload)
1011 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
1013 struct gcpro gcpro1, gcpro2;
1014 GCPRO2 (tem, object);
1015 do_autoload (tem, object);
1019 object = wrong_type_argument (Qkeymapp, object);
1025 /* Given OBJECT which was found in a slot in a keymap,
1026 trace indirect definitions to get the actual definition of that slot.
1027 An indirect definition is a list of the form
1028 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1029 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1032 get_keyelt (Lisp_Object object, int accept_default)
1034 /* This function can GC */
1038 if (!CONSP (object))
1042 struct gcpro gcpro1;
1044 map = XCAR (object);
1045 map = get_keymap (map, 0, 1);
1048 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1051 Lisp_Object idx = Fcdr (object);
1052 struct key_data indirection;
1055 struct Lisp_Event event;
1056 event.event_type = empty_event;
1057 character_to_event (XCHAR (idx), &event,
1058 XCONSOLE (Vselected_console), 0, 0);
1059 indirection = event.event.key;
1061 else if (CONSP (idx))
1063 if (!INTP (XCDR (idx)))
1065 indirection.keysym = XCAR (idx);
1066 indirection.modifiers = XINT (XCDR (idx));
1068 else if (SYMBOLP (idx))
1070 indirection.keysym = idx;
1071 indirection.modifiers = 0;
1078 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
1080 else if (STRINGP (XCAR (object)))
1082 /* If the keymap contents looks like (STRING . DEFN),
1084 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1085 will be used by HierarKey menus. */
1086 object = XCDR (object);
1091 /* Anything else is really the value. */
1097 keymap_lookup_1 (Lisp_Object keymap, CONST struct key_data *key,
1100 /* This function can GC */
1101 return get_keyelt (keymap_lookup_directly (keymap,
1102 key->keysym, key->modifiers),
1107 /************************************************************************/
1108 /* Copying keymaps */
1109 /************************************************************************/
1111 struct copy_keymap_inverse_closure
1113 Lisp_Object inverse_table;
1117 copy_keymap_inverse_mapper (CONST void *hash_key, void *hash_contents,
1118 void *copy_keymap_inverse_closure)
1120 Lisp_Object key, inverse_table, inverse_contents;
1121 struct copy_keymap_inverse_closure *closure =
1122 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
1124 VOID_TO_LISP (inverse_table, closure);
1125 VOID_TO_LISP (inverse_contents, hash_contents);
1126 CVOID_TO_LISP (key, hash_key);
1127 /* copy-sequence deals with dotted lists. */
1128 if (CONSP (inverse_contents))
1129 inverse_contents = Fcopy_sequence (inverse_contents);
1130 Fputhash (key, inverse_contents, closure->inverse_table);
1137 copy_keymap_internal (struct keymap *keymap)
1139 Lisp_Object nkm = make_keymap (0);
1140 struct keymap *new_keymap = XKEYMAP (nkm);
1141 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1142 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1144 new_keymap->parents = Fcopy_sequence (keymap->parents);
1145 new_keymap->fullness = keymap->fullness;
1146 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1147 new_keymap->table = Fcopy_hashtable (keymap->table);
1148 new_keymap->inverse_table = Fcopy_hashtable (keymap->inverse_table);
1149 /* After copying the inverse map, we need to copy the conses which
1150 are its values, lest they be shared by the copy, and mangled.
1152 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
1153 ©_keymap_inverse_closure);
1158 static Lisp_Object copy_keymap (Lisp_Object keymap);
1160 struct copy_keymap_closure
1162 struct keymap *self;
1166 copy_keymap_mapper (CONST void *hash_key, void *hash_contents,
1167 void *copy_keymap_closure)
1169 /* This function can GC */
1170 Lisp_Object key, contents;
1171 struct copy_keymap_closure *closure =
1172 (struct copy_keymap_closure *) copy_keymap_closure;
1174 CVOID_TO_LISP (key, hash_key);
1175 VOID_TO_LISP (contents, hash_contents);
1176 /* When we encounter a keymap which is indirected through a
1177 symbol, we need to copy the sub-map. In v18, the form
1178 (lookup-key (copy-keymap global-map) "\C-x")
1179 returned a new keymap, not the symbol 'Control-X-prefix.
1181 contents = get_keymap (contents,
1182 0, 1); /* #### autoload GC-safe here? */
1183 if (KEYMAPP (contents))
1184 keymap_store_internal (key, closure->self,
1185 copy_keymap (contents));
1190 copy_keymap (Lisp_Object keymap)
1192 /* This function can GC */
1193 struct copy_keymap_closure copy_keymap_closure;
1195 keymap = copy_keymap_internal (XKEYMAP (keymap));
1196 copy_keymap_closure.self = XKEYMAP (keymap);
1197 elisp_maphash (copy_keymap_mapper,
1198 XKEYMAP (keymap)->table,
1199 ©_keymap_closure);
1203 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1204 Return a copy of the keymap KEYMAP.
1205 The copy starts out with the same definitions of KEYMAP,
1206 but changing either the copy or KEYMAP does not affect the other.
1207 Any key definitions that are subkeymaps are recursively copied.
1211 /* This function can GC */
1212 keymap = get_keymap (keymap, 1, 1);
1213 return copy_keymap (keymap);
1218 keymap_fullness (Lisp_Object keymap)
1220 /* This function can GC */
1222 Lisp_Object sub_maps;
1223 struct gcpro gcpro1, gcpro2;
1225 keymap = get_keymap (keymap, 1, 1);
1226 fullness = XKEYMAP (keymap)->fullness;
1227 sub_maps = keymap_submaps (keymap);
1228 GCPRO2 (keymap, sub_maps);
1229 for (; !NILP (sub_maps); sub_maps = XCDR (sub_maps))
1231 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
1233 Lisp_Object sub_map = XCDR (XCAR (sub_maps));
1234 fullness--; /* don't count bucky maps */
1235 fullness += keymap_fullness (sub_map);
1242 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1243 Return the number of bindings in the keymap.
1247 /* This function can GC */
1248 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
1252 /************************************************************************/
1253 /* Defining keys in keymaps */
1254 /************************************************************************/
1256 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1257 and perform any necessary canonicalization. */
1260 define_key_check_and_coerce_keysym (Lisp_Object spec,
1261 Lisp_Object *keysym,
1262 unsigned int modifiers)
1264 /* Now, check and massage the trailing keysym specifier. */
1265 if (SYMBOLP (*keysym))
1267 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
1269 Lisp_Object ream_gcc_up_the_ass =
1270 make_char (string_char (XSYMBOL (*keysym)->name, 0));
1271 *keysym = ream_gcc_up_the_ass;
1275 else if (CHAR_OR_CHAR_INTP (*keysym))
1277 CHECK_CHAR_COERCE_INT (*keysym);
1279 if (XCHAR (*keysym) < ' '
1280 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
1281 /* yuck! Can't make the above restriction; too many compatibility
1283 signal_simple_error ("keysym char must be printable", *keysym);
1284 /* #### This bites! I want to be able to write (control shift a) */
1285 if (modifiers & MOD_SHIFT)
1287 ("the `shift' modifier may not be applied to ASCII keysyms",
1292 signal_simple_error ("unknown keysym specifier",
1296 if (SYMBOLP (*keysym))
1298 char *name = (char *)
1299 string_data (XSYMBOL (*keysym)->name);
1301 /* FSFmacs uses symbols with the printed representation of keysyms in
1302 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1303 confusion, notice the M-x syntax and signal an error - because
1304 otherwise it would be interpreted as a regular keysym, and would even
1305 show up in the list-buffers output, causing confusion to the naive.
1307 We can get away with this because none of the X keysym names contain
1308 a hyphen (some contain underscore, however).
1310 It might be useful to reject keysyms which are not x-valid-keysym-
1311 name-p, but that would interfere with various tricks we do to
1312 sanitize the Sun keyboards, and would make it trickier to
1313 conditionalize a .emacs file for multiple X servers.
1315 if (((int) strlen (name) >= 2 && name[1] == '-')
1318 /* Ok, this is a bit more dubious - prevent people from doing things
1319 like (global-set-key 'RET 'something) because that will have the
1320 same problem as above. (Gag!) Maybe we should just silently
1321 accept these as aliases for the "real" names?
1323 (string_length (XSYMBOL (*keysym)->name) <= 3 &&
1324 (!strcmp (name, "LFD") ||
1325 !strcmp (name, "TAB") ||
1326 !strcmp (name, "RET") ||
1327 !strcmp (name, "ESC") ||
1328 !strcmp (name, "DEL") ||
1329 !strcmp (name, "SPC") ||
1330 !strcmp (name, "BS")))
1334 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1337 /* #### Ok, this is a bit more dubious - make people not lose if they
1338 do things like (global-set-key 'RET 'something) because that would
1339 otherwise have the same problem as above. (Gag!) We silently
1340 accept these as aliases for the "real" names.
1342 else if (!strncmp(name, "kp_", 3)) {
1343 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1346 strncpy(temp, name, sizeof (temp));
1347 temp[sizeof (temp) - 1] = '\0';
1349 *keysym = Fintern_soft(make_string((Bufbyte *)temp,
1352 } else if (EQ (*keysym, QLFD))
1353 *keysym = QKlinefeed;
1354 else if (EQ (*keysym, QTAB))
1356 else if (EQ (*keysym, QRET))
1358 else if (EQ (*keysym, QESC))
1360 else if (EQ (*keysym, QDEL))
1362 else if (EQ (*keysym, QBS))
1363 *keysym = QKbackspace;
1364 /* Emacs compatibility */
1365 else if (EQ(*keysym, Qdown_mouse_1))
1367 else if (EQ(*keysym, Qdown_mouse_2))
1369 else if (EQ(*keysym, Qdown_mouse_3))
1371 else if (EQ(*keysym, Qdown_mouse_4))
1373 else if (EQ(*keysym, Qdown_mouse_5))
1375 else if (EQ(*keysym, Qmouse_1))
1376 *keysym = Qbutton1up;
1377 else if (EQ(*keysym, Qmouse_2))
1378 *keysym = Qbutton2up;
1379 else if (EQ(*keysym, Qmouse_3))
1380 *keysym = Qbutton3up;
1381 else if (EQ(*keysym, Qmouse_4))
1382 *keysym = Qbutton4up;
1383 else if (EQ(*keysym, Qmouse_5))
1384 *keysym = Qbutton5up;
1389 /* Given any kind of key-specifier, return a keysym and modifier mask.
1390 Proper canonicalization is performed:
1392 -- integers are converted into the equivalent characters.
1393 -- one-character strings are converted into the equivalent characters.
1397 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
1399 if (CHAR_OR_CHAR_INTP (spec))
1401 struct Lisp_Event event;
1402 event.event_type = empty_event;
1403 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
1404 XCONSOLE (Vselected_console), 0, 0);
1405 returned_value->keysym = event.event.key.keysym;
1406 returned_value->modifiers = event.event.key.modifiers;
1408 else if (EVENTP (spec))
1410 switch (XEVENT (spec)->event_type)
1412 case key_press_event:
1414 returned_value->keysym = XEVENT (spec)->event.key.keysym;
1415 returned_value->modifiers = XEVENT (spec)->event.key.modifiers;
1418 case button_press_event:
1419 case button_release_event:
1421 int down = (XEVENT (spec)->event_type == button_press_event);
1422 switch (XEVENT (spec)->event.button.button)
1425 returned_value->keysym = (down ? Qbutton1 : Qbutton1up); break;
1427 returned_value->keysym = (down ? Qbutton2 : Qbutton2up); break;
1429 returned_value->keysym = (down ? Qbutton3 : Qbutton3up); break;
1431 returned_value->keysym = (down ? Qbutton4 : Qbutton4up); break;
1433 returned_value->keysym = (down ? Qbutton5 : Qbutton5up); break;
1435 returned_value->keysym = (down ? Qbutton6 : Qbutton6up); break;
1437 returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break;
1439 returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break;
1441 returned_value->modifiers = XEVENT (spec)->event.button.modifiers;
1445 signal_error (Qwrong_type_argument,
1446 list2 (build_translated_string
1447 ("unable to bind this type of event"),
1451 else if (SYMBOLP (spec))
1453 /* Be nice, allow = to mean (=) */
1454 if (bucky_sym_to_bucky_bit (spec) != 0)
1455 signal_simple_error ("Key is a modifier name", spec);
1456 define_key_check_and_coerce_keysym (spec, &spec, 0);
1457 returned_value->keysym = spec;
1458 returned_value->modifiers = 0;
1460 else if (CONSP (spec))
1462 unsigned int modifiers = 0;
1463 Lisp_Object keysym = Qnil;
1464 Lisp_Object rest = spec;
1466 /* First, parse out the leading modifier symbols. */
1467 while (CONSP (rest))
1469 unsigned int modifier;
1471 keysym = XCAR (rest);
1472 modifier = bucky_sym_to_bucky_bit (keysym);
1473 modifiers |= modifier;
1474 if (!NILP (XCDR (rest)))
1477 signal_simple_error ("unknown modifier", keysym);
1482 signal_simple_error ("nothing but modifiers here",
1489 signal_simple_error ("dotted list", spec);
1491 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
1492 returned_value->keysym = keysym;
1493 returned_value->modifiers = modifiers;
1497 signal_simple_error ("unknown key-sequence specifier",
1502 /* Used by character-to-event */
1504 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
1505 int allow_menu_events)
1507 struct key_data raw_key;
1509 if (allow_menu_events &&
1511 /* #### where the hell does this come from? */
1512 EQ (XCAR (list), Qmenu_selection))
1514 Lisp_Object fn, arg;
1515 if (! NILP (Fcdr (Fcdr (list))))
1516 signal_simple_error ("invalid menu event desc", list);
1517 arg = Fcar (Fcdr (list));
1519 fn = Qcall_interactively;
1522 XSETFRAME (XEVENT (event)->channel, selected_frame ());
1523 XEVENT (event)->event_type = misc_user_event;
1524 XEVENT (event)->event.eval.function = fn;
1525 XEVENT (event)->event.eval.object = arg;
1529 define_key_parser (list, &raw_key);
1531 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) ||
1532 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) ||
1533 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) ||
1534 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) ||
1535 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) ||
1536 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) ||
1537 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) ||
1538 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up))
1539 error ("Mouse-clicks can't appear in saved keyboard macros.");
1541 XEVENT (event)->channel = Vselected_console;
1542 XEVENT (event)->event_type = key_press_event;
1543 XEVENT (event)->event.key.keysym = raw_key.keysym;
1544 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
1549 event_matches_key_specifier_p (struct Lisp_Event *event,
1550 Lisp_Object key_specifier)
1554 struct gcpro gcpro1;
1556 if (event->event_type != key_press_event || NILP (key_specifier) ||
1557 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
1560 /* if the specifier is an integer such as 27, then it should match
1561 both of the events 'escape' and 'control ['. Calling
1562 Fcharacter_to_event() will only match 'escape'. */
1563 if (CHAR_OR_CHAR_INTP (key_specifier))
1564 return (XCHAR_OR_CHAR_INT (key_specifier)
1565 == event_to_character (event, 0, 0, 0));
1567 /* Otherwise, we cannot call event_to_character() because we may
1568 be dealing with non-ASCII keystrokes. In any case, if I ask
1569 for 'control [' then I should get exactly that, and not
1572 However, we have to behave differently on TTY's, where 'control ['
1573 is silently converted into 'escape' by the keyboard driver.
1574 In this case, ASCII is the only thing we know about, so we have
1575 to compare the ASCII values. */
1578 event2 = Fmake_event (Qnil, Qnil);
1579 Fcharacter_to_event (key_specifier, event2, Qnil, Qnil);
1580 if (XEVENT (event2)->event_type != key_press_event)
1582 else if (CONSOLE_TTY_P (XCONSOLE (EVENT_CHANNEL (event))))
1586 ch1 = event_to_character (event, 0, 0, 0);
1587 ch2 = event_to_character (XEVENT (event2), 0, 0, 0);
1588 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1590 else if (EQ (event->event.key.keysym, XEVENT (event2)->event.key.keysym) &&
1591 event->event.key.modifiers == XEVENT (event2)->event.key.modifiers)
1595 Fdeallocate_event (event2);
1601 meta_prefix_char_p (CONST struct key_data *key)
1603 struct Lisp_Event event;
1605 event.event_type = key_press_event;
1606 event.channel = Vselected_console;
1607 event.event.key.keysym = key->keysym;
1608 event.event.key.modifiers = key->modifiers;
1609 return event_matches_key_specifier_p (&event, Vmeta_prefix_char);
1612 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1613 Return non-nil if EVENT matches KEY-SPECIFIER.
1614 This can be useful, e.g., to determine if the user pressed `help-char' or
1617 (event, key_specifier))
1619 CHECK_LIVE_EVENT (event);
1620 return (event_matches_key_specifier_p (XEVENT (event), key_specifier)
1625 Given a keysym, return another keysym/modifier pair which could be
1626 considered the same key in an ASCII world. Backspace returns ^H, for
1630 define_key_alternate_name (struct key_data *key,
1631 struct key_data *returned_value)
1633 Lisp_Object keysym = key->keysym;
1634 unsigned int modifiers = key->modifiers;
1635 unsigned int modifiers_sans_control = (modifiers & (~MOD_CONTROL));
1636 unsigned int modifiers_sans_meta = (modifiers & (~MOD_META));
1637 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1638 returned_value->modifiers = 0;
1639 #define MACROLET(k,m) do { returned_value->keysym = (k); \
1640 returned_value->modifiers = (m); \
1641 RETURN__; } while (0)
1642 if (modifiers_sans_meta == MOD_CONTROL)
1644 if EQ (keysym, QKspace)
1645 MACROLET (make_char ('@'), modifiers);
1646 else if (!CHARP (keysym))
1648 else switch (XCHAR (keysym))
1650 case '@': /* c-@ => c-space */
1651 MACROLET (QKspace, modifiers);
1652 case 'h': /* c-h => backspace */
1653 MACROLET (QKbackspace, modifiers_sans_control);
1654 case 'i': /* c-i => tab */
1655 MACROLET (QKtab, modifiers_sans_control);
1656 case 'j': /* c-j => linefeed */
1657 MACROLET (QKlinefeed, modifiers_sans_control);
1658 case 'm': /* c-m => return */
1659 MACROLET (QKreturn, modifiers_sans_control);
1660 case '[': /* c-[ => escape */
1661 MACROLET (QKescape, modifiers_sans_control);
1666 else if (modifiers_sans_meta != 0)
1668 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
1669 MACROLET (make_char ('h'), (modifiers | MOD_CONTROL));
1670 else if (EQ (keysym, QKtab)) /* tab => c-i */
1671 MACROLET (make_char ('i'), (modifiers | MOD_CONTROL));
1672 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
1673 MACROLET (make_char ('j'), (modifiers | MOD_CONTROL));
1674 else if (EQ (keysym, QKreturn)) /* return => c-m */
1675 MACROLET (make_char ('m'), (modifiers | MOD_CONTROL));
1676 else if (EQ (keysym, QKescape)) /* escape => c-[ */
1677 MACROLET (make_char ('['), (modifiers | MOD_CONTROL));
1685 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
1688 /* This function can GC */
1689 Lisp_Object new_keys;
1691 Lisp_Object mpc_binding;
1692 struct key_data meta_key;
1694 if (NILP (Vmeta_prefix_char) ||
1695 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
1698 define_key_parser (Vmeta_prefix_char, &meta_key);
1699 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
1700 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
1705 else if (STRINGP (keys))
1706 new_keys = Fsubstring (keys, Qzero, make_int (indx));
1707 else if (VECTORP (keys))
1709 new_keys = make_vector (indx, Qnil);
1710 for (i = 0; i < indx; i++)
1711 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
1716 if (EQ (keys, new_keys))
1717 error_with_frob (mpc_binding,
1718 "can't bind %s: %s has a non-keymap binding",
1719 (char *) XSTRING_DATA (Fkey_description (keys)),
1720 (char *) XSTRING_DATA (Fsingle_key_description
1721 (Vmeta_prefix_char)));
1723 error_with_frob (mpc_binding,
1724 "can't bind %s: %s %s has a non-keymap binding",
1725 (char *) XSTRING_DATA (Fkey_description (keys)),
1726 (char *) XSTRING_DATA (Fkey_description (new_keys)),
1727 (char *) XSTRING_DATA (Fsingle_key_description
1728 (Vmeta_prefix_char)));
1731 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
1732 Define key sequence KEYS, in KEYMAP, as DEF.
1733 KEYMAP is a keymap object.
1734 KEYS is the sequence of keystrokes to bind, described below.
1735 DEF is anything that can be a key's definition:
1736 nil (means key is undefined in this keymap);
1737 a command (a Lisp function suitable for interactive calling);
1738 a string or key sequence vector (treated as a keyboard macro);
1739 a keymap (to define a prefix key);
1740 a symbol; when the key is looked up, the symbol will stand for its
1741 function definition, that should at that time be one of the above,
1742 or another symbol whose function definition is used, and so on.
1743 a cons (STRING . DEFN), meaning that DEFN is the definition
1744 (DEFN should be a valid definition in its own right);
1745 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1747 Contrary to popular belief, the world is not ASCII. When running under a
1748 window manager, XEmacs can tell the difference between, for example, the
1749 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1750 bind different commands to each of these.
1752 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1753 set of modifiers (such as control and meta). A `keysym' is what is printed
1754 on the keys on your keyboard.
1756 A keysym may be represented by a symbol, or (if and only if it is equivalent
1757 to an ASCII character in the range 32 - 255) by a character or its equivalent
1758 ASCII code. The `A' key may be represented by the symbol `A', the character
1759 `?A', or by the number 65. The `break' key may be represented only by the
1762 A keystroke may be represented by a list: the last element of the list
1763 is the key (a symbol, character, or number, as above) and the
1764 preceding elements are the symbolic names of modifier keys (control,
1765 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1766 represented by the forms `(control b)', `(control ?b)', and `(control
1767 98)'. A keystroke may also be represented by an event object, as
1768 returned by the `next-command-event' and `read-key-sequence'
1771 Note that in this context, the keystroke `control-b' is *not* represented
1772 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1774 The `shift' modifier is somewhat of a special case. You should not (and
1775 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1776 have ASCII equivalents, the state of the shift key is implicit in the
1777 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1778 sort of thing varies from keyboard to keyboard. The shift modifier is for
1779 use only with characters that do not have a second keysym on the same key,
1780 such as `backspace' and `tab'.
1782 A key sequence is a vector of keystrokes. As a degenerate case, elements
1783 of this vector may also be keysyms if they have no modifiers. That is,
1784 the `A' keystroke is represented by all of these forms:
1785 A ?A 65 (A) (?A) (65)
1786 [A] [?A] [65] [(A)] [(?A)] [(65)]
1788 the `control-a' keystroke is represented by these forms:
1789 (control A) (control ?A) (control 65)
1790 [(control A)] [(control ?A)] [(control 65)]
1791 the key sequence `control-c control-a' is represented by these forms:
1792 [(control c) (control a)] [(control ?c) (control ?a)]
1793 [(control 99) (control 65)] etc.
1795 Mouse button clicks work just like keypresses: (control button1) means
1796 pressing the left mouse button while holding down the control key.
1797 \[(control c) (shift button3)] means control-c, hold shift, click right.
1799 Commands may be bound to the mouse-button up-stroke rather than the down-
1800 stroke as well. `button1' means the down-stroke, and `button1up' means the
1801 up-stroke. Different commands may be bound to the up and down strokes,
1802 though that is probably not what you want, so be careful.
1804 For backward compatibility, a key sequence may also be represented by a
1805 string. In this case, it represents the key sequence(s) that would
1806 produce that sequence of ASCII characters in a purely ASCII world. For
1807 example, a string containing the ASCII backspace character, "\\^H", would
1808 represent two key sequences: `(control h)' and `backspace'. Binding a
1809 command to this will actually bind both of those key sequences. Likewise
1810 for the following pairs:
1817 control @ control space
1819 After binding a command to two key sequences with a form like
1821 (define-key global-map "\\^X\\^I" \'command-1)
1823 it is possible to redefine only one of those sequences like so:
1825 (define-key global-map [(control x) (control i)] \'command-2)
1826 (define-key global-map [(control x) tab] \'command-3)
1828 Of course, all of this applies only when running under a window system. If
1829 you're talking to XEmacs through a TTY connection, you don't get any of
1832 (keymap, keys, def))
1834 /* This function can GC */
1839 struct gcpro gcpro1, gcpro2, gcpro3;
1842 len = XVECTOR_LENGTH (keys);
1843 else if (STRINGP (keys))
1844 len = XSTRING_CHAR_LENGTH (keys);
1845 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
1847 if (!CONSP (keys)) keys = list1 (keys);
1849 keys = make_vector (1, keys); /* this is kinda sleazy. */
1853 keys = wrong_type_argument (Qsequencep, keys);
1854 len = XINT (Flength (keys));
1859 GCPRO3 (keymap, keys, def);
1862 When the user defines a key which, in a strictly ASCII world, would be
1863 produced by two different keys (^J and linefeed, or ^H and backspace,
1864 for example) then the binding will be made for both keysyms.
1866 This is done if the user binds a command to a string, as in
1867 (define-key map "\^H" 'something), but not when using one of the new
1868 syntaxes, like (define-key map '(control h) 'something).
1870 ascii_hack = (STRINGP (keys));
1872 keymap = get_keymap (keymap, 1, 1);
1878 struct key_data raw_key1;
1879 struct key_data raw_key2;
1882 c = make_char (string_char (XSTRING (keys), idx));
1884 c = XVECTOR_DATA (keys) [idx];
1886 define_key_parser (c, &raw_key1);
1888 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
1890 if (idx == (len - 1))
1892 /* This is a hack to prevent a binding for the meta-prefix-char
1893 from being made in a map which already has a non-empty "meta"
1894 submap. That is, we can't let both "escape" and "meta" have
1895 a binding in the same keymap. This implies that the idiom
1896 (define-key my-map "\e" my-escape-map)
1897 (define-key my-escape-map "a" 'my-command)
1898 no longer works. That's ok. Instead the luser should do
1899 (define-key my-map "\ea" 'my-command)
1901 (define-key my-map "\M-a" 'my-command)
1903 (defvar my-escape-map (lookup-key my-map "\e"))
1904 if the luser really wants the map in a variable.
1907 struct gcpro ngcpro1;
1910 mmap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
1911 XKEYMAP (keymap)->table, Qnil);
1913 && keymap_fullness (mmap) != 0)
1916 = Fsingle_key_description (Vmeta_prefix_char);
1917 signal_simple_error_2
1918 ("Map contains meta-bindings, can't bind", desc, keymap);
1931 define_key_alternate_name (&raw_key1, &raw_key2);
1934 raw_key2.keysym = Qnil;
1935 raw_key2.modifiers = 0;
1940 raw_key1.modifiers |= MOD_META;
1941 raw_key2.modifiers |= MOD_META;
1945 /* This crap is to make sure that someone doesn't bind something like
1946 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
1947 if (raw_key1.modifiers & MOD_META)
1948 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
1952 keymap_store (keymap, &raw_key1, def);
1953 if (ascii_hack && !NILP (raw_key2.keysym))
1954 keymap_store (keymap, &raw_key2, def);
1961 struct gcpro ngcpro1;
1964 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
1967 cmd = Fmake_sparse_keymap (Qnil);
1968 XKEYMAP (cmd)->name /* for debugging */
1969 = list2 (make_key_description (&raw_key1, 1), keymap);
1970 keymap_store (keymap, &raw_key1, cmd);
1972 if (NILP (Fkeymapp (cmd)))
1973 signal_simple_error_2 ("invalid prefix keys in sequence",
1976 if (ascii_hack && !NILP (raw_key2.keysym) &&
1977 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
1978 keymap_store (keymap, &raw_key2, cmd);
1980 keymap = get_keymap (cmd, 1, 1);
1987 /************************************************************************/
1988 /* Looking up keys in keymaps */
1989 /************************************************************************/
1991 /* We need a very fast (i.e., non-consing) version of lookup-key in order
1992 to make where-is-internal really fly. */
1994 struct raw_lookup_key_mapper_closure
1997 CONST struct key_data *raw_keys;
2003 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
2005 /* Caller should gc-protect args (keymaps may autoload) */
2007 raw_lookup_key (Lisp_Object keymap,
2008 CONST struct key_data *raw_keys, int raw_keys_count,
2009 int keys_so_far, int accept_default)
2011 /* This function can GC */
2012 struct raw_lookup_key_mapper_closure c;
2013 c.remaining = raw_keys_count - 1;
2014 c.raw_keys = raw_keys;
2015 c.raw_keys_count = raw_keys_count;
2016 c.keys_so_far = keys_so_far;
2017 c.accept_default = accept_default;
2019 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
2023 raw_lookup_key_mapper (Lisp_Object k, void *arg)
2025 /* This function can GC */
2026 struct raw_lookup_key_mapper_closure *c =
2027 (struct raw_lookup_key_mapper_closure *) arg;
2028 int accept_default = c->accept_default;
2029 int remaining = c->remaining;
2030 int keys_so_far = c->keys_so_far;
2031 CONST struct key_data *raw_keys = c->raw_keys;
2034 if (! meta_prefix_char_p (&(raw_keys[0])))
2036 /* Normal case: every case except the meta-hack (see below). */
2037 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2040 /* Return whatever we found if we're out of keys */
2042 else if (NILP (cmd))
2043 /* Found nothing (though perhaps parent map may have binding) */
2045 else if (NILP (Fkeymapp (cmd)))
2046 /* Didn't find a keymap, and we have more keys.
2047 * Return a fixnum to indicate that keys were too long.
2049 cmd = make_int (keys_so_far + 1);
2051 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2052 keys_so_far + 1, accept_default);
2056 /* This is a hack so that looking up a key-sequence whose last
2057 * element is the meta-prefix-char will return the keymap that
2058 * the "meta" keys are stored in, if there is no binding for
2059 * the meta-prefix-char (and if this map has a "meta" submap).
2060 * If this map doesnt have a "meta" submap, then the
2061 * meta-prefix-char is looked up just like any other key.
2065 /* First look for the prefix-char directly */
2066 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2069 /* Do kludgy return of the meta-map */
2070 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
2071 XKEYMAP (k)->table, Qnil);
2076 /* Search for the prefix-char-prefixed sequence directly */
2077 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2078 cmd = get_keymap (cmd, 0, 1);
2080 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2081 keys_so_far + 1, accept_default);
2082 else if ((raw_keys[1].modifiers & MOD_META) == 0)
2084 struct key_data metified;
2085 metified.keysym = raw_keys[1].keysym;
2086 metified.modifiers = raw_keys[1].modifiers | MOD_META;
2088 /* Search for meta-next-char sequence directly */
2089 cmd = keymap_lookup_1 (k, &metified, accept_default);
2094 cmd = get_keymap (cmd, 0, 1);
2096 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
2103 if (accept_default && NILP (cmd))
2104 cmd = XKEYMAP (k)->default_binding;
2108 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2109 /* Caller should gc-protect arguments */
2111 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
2114 /* This function can GC */
2115 struct key_data kkk[20];
2116 struct key_data *raw_keys;
2122 if (nkeys < (countof (kkk)))
2125 raw_keys = alloca_array (struct key_data, nkeys);
2127 for (i = 0; i < nkeys; i++)
2129 define_key_parser (keys[i], &(raw_keys[i]));
2131 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
2135 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2138 /* This function can GC */
2139 struct key_data kkk[20];
2143 struct key_data *raw_keys;
2144 Lisp_Object tem = Qnil;
2145 struct gcpro gcpro1, gcpro2;
2148 CHECK_LIVE_EVENT (event_head);
2150 nkeys = event_chain_count (event_head);
2152 if (nkeys < (countof (kkk)))
2155 raw_keys = alloca_array (struct key_data, nkeys);
2158 EVENT_CHAIN_LOOP (event, event_head)
2159 define_key_parser (event, &(raw_keys[nkeys++]));
2160 GCPRO2 (keymaps[0], event_head);
2161 gcpro1.nvars = nmaps;
2162 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
2163 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
2164 for (iii = 0; iii < nmaps; iii++)
2166 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
2170 /* Too long in some local map means don't look at global map */
2174 else if (!NILP (tem))
2181 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
2182 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2183 Nil is returned if KEYS is unbound. See documentation of `define-key'
2184 for valid key definitions and key-sequence specifications.
2185 A number is returned if KEYS is "too long"; that is, the leading
2186 characters fail to be a valid sequence of prefix characters in KEYMAP.
2187 The number is how many characters at the front of KEYS
2188 it takes to reach a non-prefix command.
2190 (keymap, keys, accept_default))
2192 /* This function can GC */
2194 return lookup_keys (keymap,
2195 XVECTOR_LENGTH (keys),
2196 XVECTOR_DATA (keys),
2197 !NILP (accept_default));
2198 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
2199 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
2200 else if (STRINGP (keys))
2202 int length = XSTRING_CHAR_LENGTH (keys);
2204 struct key_data *raw_keys = alloca_array (struct key_data, length);
2208 for (i = 0; i < length; i++)
2210 Emchar n = string_char (XSTRING (keys), i);
2211 define_key_parser (make_char (n), &(raw_keys[i]));
2213 return raw_lookup_key (keymap, raw_keys, length, 0,
2214 !NILP (accept_default));
2218 keys = wrong_type_argument (Qsequencep, keys);
2219 return Flookup_key (keymap, keys, accept_default);
2223 /* Given a key sequence, returns a list of keymaps to search for bindings.
2224 Does all manner of semi-hairy heuristics, like looking in the current
2225 buffer's map before looking in the global map and looking in the local
2226 map of the buffer in which the mouse was clicked in event0 is a click.
2228 It would be kind of nice if this were in Lisp so that this semi-hairy
2229 semi-heuristic command-lookup behaviour could be readily understood and
2230 customised. However, this needs to be pretty fast, or performance of
2231 keyboard macros goes to shit; putting this in lisp slows macros down
2232 2-3x. And they're already slower than v18 by 5-6x.
2235 struct relevant_maps
2238 unsigned int max_maps;
2240 struct gcpro *gcpro;
2243 static void get_relevant_extent_keymaps (Lisp_Object pos,
2244 Lisp_Object buffer_or_string,
2246 struct relevant_maps *closure);
2247 static void get_relevant_minor_maps (Lisp_Object buffer,
2248 struct relevant_maps *closure);
2251 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
2253 unsigned int nmaps = closure->nmaps;
2257 closure->nmaps = nmaps + 1;
2258 if (nmaps < closure->max_maps)
2260 closure->maps[nmaps] = map;
2261 closure->gcpro->nvars = nmaps;
2266 get_relevant_keymaps (Lisp_Object keys,
2267 int max_maps, Lisp_Object maps[])
2269 /* This function can GC */
2270 Lisp_Object terminal = Qnil;
2271 struct gcpro gcpro1;
2272 struct relevant_maps closure;
2273 struct console *con;
2278 closure.max_maps = max_maps;
2279 closure.maps = maps;
2280 closure.gcpro = &gcpro1;
2283 terminal = event_chain_tail (keys);
2284 else if (VECTORP (keys))
2286 int len = XVECTOR_LENGTH (keys);
2288 terminal = XVECTOR_DATA (keys)[len - 1];
2291 if (EVENTP (terminal))
2293 CHECK_LIVE_EVENT (terminal);
2294 con = event_console_or_selected (terminal);
2297 con = XCONSOLE (Vselected_console);
2299 if (KEYMAPP (con->overriding_terminal_local_map)
2300 || KEYMAPP (Voverriding_local_map))
2302 if (KEYMAPP (con->overriding_terminal_local_map))
2303 relevant_map_push (con->overriding_terminal_local_map, &closure);
2304 if (KEYMAPP (Voverriding_local_map))
2305 relevant_map_push (Voverriding_local_map, &closure);
2307 else if (!EVENTP (terminal)
2308 || (XEVENT (terminal)->event_type != button_press_event
2309 && XEVENT (terminal)->event_type != button_release_event))
2312 XSETBUFFER (tem, current_buffer);
2313 /* It's not a mouse event; order of keymaps searched is:
2314 o keymap of any/all extents under the mouse
2316 o local-map of current-buffer
2319 /* The terminal element of the lookup may be nil or a keysym.
2320 In those cases we don't want to check for an extent
2322 if (EVENTP (terminal))
2324 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
2325 tem, Qnil, &closure);
2327 get_relevant_minor_maps (tem, &closure);
2329 tem = current_buffer->keymap;
2331 relevant_map_push (tem, &closure);
2333 #ifdef HAVE_WINDOW_SYSTEM
2336 /* It's a mouse event; order of keymaps searched is:
2337 o vertical-divider-map, if event is over a divider
2338 o local-map of mouse-grabbed-buffer
2339 o keymap of any/all extents under the mouse
2340 if the mouse is over a modeline:
2341 o modeline-map of buffer corresponding to that modeline
2342 o else, local-map of buffer under the mouse
2344 o local-map of current-buffer
2347 Lisp_Object window = Fevent_window (terminal);
2349 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
2351 if (KEYMAPP (Vvertical_divider_map))
2352 relevant_map_push (Vvertical_divider_map, &closure);
2355 if (BUFFERP (Vmouse_grabbed_buffer))
2357 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
2359 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
2361 relevant_map_push (map, &closure);
2366 Lisp_Object buffer = Fwindow_buffer (window);
2370 if (!NILP (Fevent_over_modeline_p (terminal)))
2372 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
2375 get_relevant_extent_keymaps
2376 (Fevent_modeline_position (terminal),
2377 XBUFFER (buffer)->generated_modeline_string,
2378 /* #### third arg should maybe be a glyph. */
2381 if (!UNBOUNDP (map) && !NILP (map))
2382 relevant_map_push (get_keymap (map, 1, 1), &closure);
2386 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
2387 Fevent_glyph_extent (terminal),
2391 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
2393 Lisp_Object map = XBUFFER (buffer)->keymap;
2395 get_relevant_minor_maps (buffer, &closure);
2397 relevant_map_push (map, &closure);
2401 else if (!NILP (Fevent_over_toolbar_p (terminal)))
2403 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
2405 if (!UNBOUNDP (map) && !NILP (map))
2406 relevant_map_push (map, &closure);
2409 #endif /* HAVE_WINDOW_SYSTEM */
2412 int nmaps = closure.nmaps;
2413 /* Silently truncate at 100 keymaps to prevent infinite losssage */
2414 if (nmaps >= max_maps && max_maps > 0)
2415 maps[max_maps - 1] = Vcurrent_global_map;
2417 maps[nmaps] = Vcurrent_global_map;
2423 /* Returns a set of keymaps extracted from the extents at POS in
2424 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2425 to look for a keymap in, and if it has one, its keymap will be the
2426 first element in the list returned. This is so we can correctly
2427 search the keymaps associated with glyphs which may be physically
2428 disjoint from their extents: for example, if a glyph is out in the
2429 margin, we should still consult the kemyap of that glyph's extent,
2430 which may not itself be under the mouse.
2434 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
2436 struct relevant_maps *closure)
2438 /* This function can GC */
2439 /* the glyph keymap, if any, comes first.
2440 (Processing it twice is no big deal: noop.) */
2443 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
2445 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2448 /* Next check the extents at the text position, if any */
2452 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2454 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
2456 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
2458 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2465 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
2467 /* This function can GC */
2470 Lisp_Object sym = XCAR (assoc);
2473 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
2474 if (!NILP (val) && !UNBOUNDP (val))
2476 Lisp_Object map = get_keymap (XCDR (assoc), 0, 1);
2485 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
2487 /* This function can GC */
2490 /* Will you ever lose badly if you make this circular! */
2491 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
2493 alist = XCDR (alist))
2495 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
2497 if (!NILP (m)) relevant_map_push (m, closure);
2502 /* #### Would map-current-keymaps be a better thing?? */
2503 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2504 Return a list of the current keymaps that will be searched for bindings.
2505 This lists keymaps such as the current local map and the minor-mode maps,
2506 but does not list the parents of those keymaps.
2507 EVENT-OR-KEYS controls which keymaps will be listed.
2508 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2509 mouse event), the keymaps for that mouse event will be listed (see
2510 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2514 /* This function can GC */
2515 struct gcpro gcpro1;
2516 Lisp_Object maps[100];
2517 Lisp_Object *gubbish = maps;
2520 GCPRO1 (event_or_keys);
2521 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
2523 if (nmaps > countof (maps))
2525 gubbish = alloca_array (Lisp_Object, nmaps);
2526 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
2529 return Flist (nmaps, gubbish);
2532 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
2533 Return the binding for command KEYS in current keymaps.
2534 KEYS is a string, a vector of events, or a vector of key-description lists
2535 as described in the documentation for the `define-key' function.
2536 The binding is probably a symbol with a function definition; see
2537 the documentation for `lookup-key' for more information.
2539 For key-presses, the order of keymaps searched is:
2540 - the `keymap' property of any extent(s) at point;
2541 - any applicable minor-mode maps;
2542 - the current-local-map of the current-buffer;
2543 - the current global map.
2545 For mouse-clicks, the order of keymaps searched is:
2546 - the current-local-map of the `mouse-grabbed-buffer' if any;
2547 - vertical-divider-map, if the event happened over a vertical divider
2548 - the `keymap' property of any extent(s) at the position of the click
2549 (this includes modeline extents);
2550 - the modeline-map of the buffer corresponding to the modeline under
2551 the mouse (if the click happened over a modeline);
2552 - the value of toolbar-map in the current-buffer (if the click
2553 happened over a toolbar);
2554 - the current-local-map of the buffer under the mouse (does not
2555 apply to toolbar clicks);
2556 - any applicable minor-mode maps;
2557 - the current global map.
2559 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2560 is non-nil, *only* those two maps and the current global map are searched.
2562 (keys, accept_default))
2564 /* This function can GC */
2566 Lisp_Object maps[100];
2568 struct gcpro gcpro1, gcpro2;
2569 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
2571 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
2575 if (EVENTP (keys)) /* unadvertised "feature" for the future */
2576 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
2578 for (i = 0; i < nmaps; i++)
2580 Lisp_Object tem = Flookup_key (maps[i], keys,
2584 /* Too long in some local map means don't look at global map */
2587 else if (!NILP (tem))
2594 process_event_binding_result (Lisp_Object result)
2596 if (EQ (result, Qundefined))
2597 /* The suppress-keymap function binds keys to 'undefined - special-case
2598 that here, so that being bound to that has the same error-behavior as
2599 not being defined at all.
2605 /* Snap out possible keymap indirections */
2606 map = get_keymap (result, 0, 1);
2614 /* Attempts to find a command corresponding to the event-sequence
2615 whose head is event0 (sequence is threaded though event_next).
2617 The return value will be
2619 -- nil (there is no binding; this will also be returned
2620 whenever the event chain is "too long", i.e. there
2621 is a non-nil, non-keymap binding for a prefix of
2623 -- a keymap (part of a command has been specified)
2624 -- a command (anything that satisfies `commandp'; this includes
2625 some symbols, lists, subrs, strings, vectors, and
2626 compiled-function objects) */
2628 event_binding (Lisp_Object event0, int accept_default)
2630 /* This function can GC */
2631 Lisp_Object maps[100];
2634 assert (EVENTP (event0));
2636 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
2637 if (nmaps > countof (maps))
2638 nmaps = countof (maps);
2639 return process_event_binding_result (lookup_events (event0, nmaps, maps,
2643 /* like event_binding, but specify a keymap to search */
2646 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
2648 /* This function can GC */
2649 if (!KEYMAPP (keymap))
2652 return process_event_binding_result (lookup_events (event0, 1, &keymap,
2656 /* Attempts to find a function key mapping corresponding to the
2657 event-sequence whose head is event0 (sequence is threaded through
2658 event_next). The return value will be the same as for event_binding(). */
2660 munging_key_map_event_binding (Lisp_Object event0,
2661 enum munge_me_out_the_door munge)
2663 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2664 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
2665 Vkey_translation_map;
2670 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
2674 /************************************************************************/
2675 /* Setting/querying the global and local maps */
2676 /************************************************************************/
2678 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
2679 Select KEYMAP as the global keymap.
2683 /* This function can GC */
2684 keymap = get_keymap (keymap, 1, 1);
2685 Vcurrent_global_map = keymap;
2689 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
2690 Select KEYMAP as the local keymap in BUFFER.
2691 If KEYMAP is nil, that means no local keymap.
2692 If BUFFER is nil, the current buffer is assumed.
2696 /* This function can GC */
2697 struct buffer *b = decode_buffer (buffer, 0);
2699 keymap = get_keymap (keymap, 1, 1);
2706 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2707 Return BUFFER's local keymap, or nil if it has none.
2708 If BUFFER is nil, the current buffer is assumed.
2712 struct buffer *b = decode_buffer (buffer, 0);
2716 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2717 Return the current global keymap.
2721 return Vcurrent_global_map;
2725 /************************************************************************/
2726 /* Mapping over keymap elements */
2727 /************************************************************************/
2729 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2730 prefix key, it's not entirely obvious what map-keymap should do, but
2731 what it does is: map over all keys in this map; then recursively map
2732 over all submaps of this map that are "bucky" submaps. This means that,
2733 when mapping over a keymap, it appears that "x" and "C-x" are in the
2734 same map, although "C-x" is really in the "control" submap of this one.
2735 However, since we don't recursively descend the submaps that are bound
2736 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2737 those explicitly, if that's what they want.
2739 So the end result of this is that the bucky keymaps (the ones indexed
2740 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2741 invisible from elisp. They're just an implementation detail that code
2742 outside of this file doesn't need to know about.
2745 struct map_keymap_unsorted_closure
2747 void (*fn) (CONST struct key_data *, Lisp_Object binding, void *arg);
2749 unsigned int modifiers;
2752 /* used by map_keymap() */
2754 map_keymap_unsorted_mapper (CONST void *hash_key, void *hash_contents,
2755 void *map_keymap_unsorted_closure)
2757 /* This function can GC */
2759 Lisp_Object contents;
2760 struct map_keymap_unsorted_closure *closure =
2761 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
2762 unsigned int modifiers = closure->modifiers;
2763 unsigned int mod_bit;
2764 CVOID_TO_LISP (keysym, hash_key);
2765 VOID_TO_LISP (contents, hash_contents);
2766 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
2769 int omod = modifiers;
2770 closure->modifiers = (modifiers | mod_bit);
2771 contents = get_keymap (contents, 1, 0);
2772 elisp_maphash (map_keymap_unsorted_mapper,
2773 XKEYMAP (contents)->table,
2774 map_keymap_unsorted_closure);
2775 closure->modifiers = omod;
2779 struct key_data key;
2780 key.keysym = keysym;
2781 key.modifiers = modifiers;
2782 ((*closure->fn) (&key, contents, closure->arg));
2788 struct map_keymap_sorted_closure
2790 Lisp_Object *result_locative;
2793 /* used by map_keymap_sorted() */
2795 map_keymap_sorted_mapper (CONST void *hash_key, void *hash_contents,
2796 void *map_keymap_sorted_closure)
2798 struct map_keymap_sorted_closure *cl =
2799 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
2800 Lisp_Object key, contents;
2801 Lisp_Object *list = cl->result_locative;
2802 CVOID_TO_LISP (key, hash_key);
2803 VOID_TO_LISP (contents, hash_contents);
2804 *list = Fcons (Fcons (key, contents), *list);
2809 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2810 and keymap_submaps().
2813 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
2816 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2818 unsigned int bit1, bit2;
2824 if (EQ (obj1, obj2))
2826 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
2827 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
2829 /* If either is a symbol with a character-set-property, then sort it by
2830 that code instead of alphabetically.
2832 if (! bit1 && SYMBOLP (obj1))
2834 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
2835 if (CHAR_OR_CHAR_INTP (code))
2838 CHECK_CHAR_COERCE_INT (obj1);
2842 if (! bit2 && SYMBOLP (obj2))
2844 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
2845 if (CHAR_OR_CHAR_INTP (code))
2848 CHECK_CHAR_COERCE_INT (obj2);
2853 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2854 if (XTYPE (obj1) != XTYPE (obj2))
2855 return SYMBOLP (obj2) ? 1 : -1;
2857 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
2859 int o1 = XCHAR (obj1);
2860 int o2 = XCHAR (obj2);
2861 if (o1 == o2 && /* If one started out as a symbol and the */
2862 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
2863 return sym2_p ? 1 : -1;
2865 return o1 < o2 ? 1 : -1; /* else just compare them */
2868 /* else they're both symbols. If they're both buckys, then order them. */
2870 return bit1 < bit2 ? 1 : -1;
2872 /* if only one is a bucky, then it comes later */
2874 return bit2 ? 1 : -1;
2876 /* otherwise, string-sort them. */
2878 char *s1 = (char *) string_data (XSYMBOL (obj1)->name);
2879 char *s2 = (char *) string_data (XSYMBOL (obj2)->name);
2881 return 0 > strcoll (s1, s2) ? 1 : -1;
2883 return 0 > strcmp (s1, s2) ? 1 : -1;
2889 /* used by map_keymap() */
2891 map_keymap_sorted (Lisp_Object keymap_table,
2892 unsigned int modifiers,
2893 void (*function) (CONST struct key_data *key,
2894 Lisp_Object binding,
2895 void *map_keymap_sorted_closure),
2896 void *map_keymap_sorted_closure)
2898 /* This function can GC */
2899 struct gcpro gcpro1;
2900 Lisp_Object contents = Qnil;
2902 if (XINT (Fhashtable_fullness (keymap_table)) == 0)
2908 struct map_keymap_sorted_closure c1;
2909 c1.result_locative = &contents;
2910 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
2912 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
2913 for (; !NILP (contents); contents = XCDR (contents))
2915 Lisp_Object keysym = XCAR (XCAR (contents));
2916 Lisp_Object binding = XCDR (XCAR (contents));
2917 unsigned int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
2919 map_keymap_sorted (XKEYMAP (get_keymap (binding,
2921 (modifiers | sub_bits),
2923 map_keymap_sorted_closure);
2928 k.modifiers = modifiers;
2929 ((*function) (&k, binding, map_keymap_sorted_closure));
2936 /* used by Fmap_keymap() */
2938 map_keymap_mapper (CONST struct key_data *key,
2939 Lisp_Object binding,
2942 /* This function can GC */
2944 VOID_TO_LISP (fn, function);
2945 call2 (fn, make_key_description (key, 1), binding);
2950 map_keymap (Lisp_Object keymap_table, int sort_first,
2951 void (*function) (CONST struct key_data *key,
2952 Lisp_Object binding,
2956 /* This function can GC */
2958 map_keymap_sorted (keymap_table, 0, function, fn_arg);
2961 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
2962 map_keymap_unsorted_closure.fn = function;
2963 map_keymap_unsorted_closure.arg = fn_arg;
2964 map_keymap_unsorted_closure.modifiers = 0;
2965 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
2966 &map_keymap_unsorted_closure);
2970 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
2971 Apply FUNCTION to each element of KEYMAP.
2972 FUNCTION will be called with two arguments: a key-description list, and
2973 the binding. The order in which the elements of the keymap are passed to
2974 the function is unspecified. If the function inserts new elements into
2975 the keymap, it may or may not be called with them later. No element of
2976 the keymap will ever be passed to the function more than once.
2978 The function will not be called on elements of this keymap's parents
2979 \(see the function `keymap-parents') or upon keymaps which are contained
2980 within this keymap (multi-character definitions).
2981 It will be called on "meta" characters since they are not really
2982 two-character sequences.
2984 If the optional third argument SORT-FIRST is non-nil, then the elements of
2985 the keymap will be passed to the mapper function in a canonical order.
2986 Otherwise, they will be passed in hash (that is, random) order, which is
2989 (function, keymap, sort_first))
2991 /* This function can GC */
2992 struct gcpro gcpro1, gcpro2;
2994 /* tolerate obviously transposed args */
2995 if (!NILP (Fkeymapp (function)))
2997 Lisp_Object tmp = function;
3001 GCPRO2 (function, keymap);
3002 keymap = get_keymap (keymap, 1, 1);
3003 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
3004 map_keymap_mapper, LISP_TO_VOID (function));
3011 /************************************************************************/
3012 /* Accessible keymaps */
3013 /************************************************************************/
3015 struct accessible_keymaps_closure
3022 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
3023 unsigned int modifiers,
3024 struct accessible_keymaps_closure *closure)
3026 /* This function can GC */
3027 unsigned int subbits = MODIFIER_HASH_KEY_BITS (keysym);
3031 Lisp_Object submaps;
3033 contents = get_keymap (contents, 1, 1);
3034 submaps = keymap_submaps (contents);
3035 for (; !NILP (submaps); submaps = XCDR (submaps))
3037 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3038 XCDR (XCAR (submaps)),
3039 (subbits | modifiers),
3045 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3046 Lisp_Object cmd = get_keyelt (contents, 1);
3050 struct key_data key;
3051 key.keysym = keysym;
3052 key.modifiers = modifiers;
3056 cmd = get_keymap (cmd, 0, 1);
3060 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3061 len = XVECTOR_LENGTH (thisseq);
3062 for (j = 0; j < len; j++)
3063 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3064 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3066 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3072 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3074 /* This function can GC */
3075 struct accessible_keymaps_closure *closure =
3076 (struct accessible_keymaps_closure *) arg;
3077 Lisp_Object submaps = keymap_submaps (thismap);
3079 for (; !NILP (submaps); submaps = XCDR (submaps))
3081 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3082 XCDR (XCAR (submaps)),
3090 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3091 Find all keymaps accessible via prefix characters from KEYMAP.
3092 Returns a list of elements of the form (KEYS . MAP), where the sequence
3093 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3094 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3095 An optional argument PREFIX, if non-nil, should be a key sequence;
3096 then the value includes only maps for prefixes that start with PREFIX.
3100 /* This function can GC */
3101 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3102 Lisp_Object accessible_keymaps = Qnil;
3103 struct accessible_keymaps_closure c;
3105 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3108 keymap = get_keymap (keymap, 1, 1);
3110 prefix = make_vector (0, Qnil);
3111 else if (!VECTORP (prefix) || STRINGP (prefix))
3113 prefix = wrong_type_argument (Qarrayp, prefix);
3118 int len = XINT (Flength (prefix));
3119 Lisp_Object def = Flookup_key (keymap, prefix, Qnil);
3122 struct gcpro ngcpro1;
3124 def = get_keymap (def, 0, 1);
3129 p = make_vector (len, Qnil);
3131 for (iii = 0; iii < len; iii++)
3133 struct key_data key;
3134 define_key_parser (Faref (prefix, make_int (iii)), &key);
3135 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3141 accessible_keymaps = list1 (Fcons (prefix, keymap));
3143 /* For each map in the list maps,
3144 look at any other maps it points to
3145 and stick them at the end if they are not already in the list */
3147 for (c.tail = accessible_keymaps;
3149 c.tail = XCDR (c.tail))
3151 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3152 CHECK_KEYMAP (thismap);
3153 traverse_keymaps (thismap, Qnil,
3154 accessible_keymaps_keymap_mapper, &c);
3158 return accessible_keymaps;
3163 /************************************************************************/
3164 /* Pretty descriptions of key sequences */
3165 /************************************************************************/
3167 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3168 Return a pretty description of key-sequence KEYS.
3169 Control characters turn into "C-foo" sequences, meta into "M-foo",
3170 spaces are put between sequence elements, etc...
3174 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3177 return Fsingle_key_description (keys);
3179 else if (VECTORP (keys) ||
3182 Lisp_Object string = Qnil;
3183 /* Lisp_Object sep = Qnil; */
3184 int size = XINT (Flength (keys));
3187 for (i = 0; i < size; i++)
3189 Lisp_Object s2 = Fsingle_key_description
3191 ? make_char (string_char (XSTRING (keys), i))
3192 : XVECTOR_DATA (keys)[i]));
3198 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */;
3199 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3204 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3207 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3208 Return a pretty description of command character KEY.
3209 Control characters turn into C-whatever, etc.
3210 This differs from `text-char-description' in that it returns a description
3211 of a key read from the user rather than a character from a buffer.
3216 key = Fcons (key, Qnil); /* sleaze sleaze */
3218 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3223 struct Lisp_Event event;
3224 event.event_type = empty_event;
3225 CHECK_CHAR_COERCE_INT (key);
3226 character_to_event (XCHAR (key), &event,
3227 XCONSOLE (Vselected_console), 0, 1);
3228 format_event_object (buf, &event, 1);
3231 format_event_object (buf, XEVENT (key), 1);
3232 return build_string (buf);
3241 LIST_LOOP (rest, key)
3243 Lisp_Object keysym = XCAR (rest);
3244 if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2;
3245 else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2;
3246 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3247 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3248 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3249 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3250 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3251 else if (CHAR_OR_CHAR_INTP (keysym))
3253 bufp += set_charptr_emchar ((Bufbyte *) bufp,
3254 XCHAR_OR_CHAR_INT (keysym));
3259 CHECK_SYMBOL (keysym);
3260 #if 0 /* This is bogus */
3261 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3262 else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB");
3263 else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET");
3264 else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC");
3265 else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL");
3266 else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC");
3267 else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS");
3270 strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name));
3271 if (!NILP (XCDR (rest)))
3272 signal_simple_error ("invalid key description",
3276 return build_string (buf);
3278 return Fsingle_key_description
3279 (wrong_type_argument (intern ("char-or-event-p"), key));
3282 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3283 Return a pretty description of file-character CHR.
3284 Unprintable characters turn into "^char" or \\NNN, depending on the value
3285 of the `ctl-arrow' variable.
3286 This differs from `single-key-description' in that it returns a description
3287 of a character from a buffer rather than a key read from the user.
3294 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3295 int ctl_p = !NILP (ctl_arrow);
3296 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3297 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3298 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3303 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3306 signal_simple_continuable_error
3307 ("character has no ASCII equivalent", Fcopy_event (chr, Qnil));
3311 CHECK_CHAR_COERCE_INT (chr);
3316 if (c >= printable_min)
3318 p += set_charptr_emchar (p, c);
3320 else if (c < 040 && ctl_p)
3323 *p++ = c + 64; /* 'A' - 1 */
3330 else if (c >= 0200 || c < 040)
3334 /* !!#### This syntax is not readable. It will
3335 be interpreted as a 3-digit octal number rather
3336 than a 7-digit octal number. */
3339 *p++ = '0' + ((c & 07000000) >> 18);
3340 *p++ = '0' + ((c & 0700000) >> 15);
3341 *p++ = '0' + ((c & 070000) >> 12);
3342 *p++ = '0' + ((c & 07000) >> 9);
3345 *p++ = '0' + ((c & 0700) >> 6);
3346 *p++ = '0' + ((c & 0070) >> 3);
3347 *p++ = '0' + ((c & 0007));
3351 p += set_charptr_emchar (p, c);
3355 return build_string ((char *) buf);
3359 /************************************************************************/
3360 /* where-is (mapping bindings to keys) */
3361 /************************************************************************/
3364 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3365 Lisp_Object firstonly, char *target_buffer);
3367 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3368 Return list of keys that invoke DEFINITION in KEYMAPS.
3369 KEYMAPS can be either a keymap (meaning search in that keymap and the
3370 current global keymap) or a list of keymaps (meaning search in exactly
3371 those keymaps and no others). If KEYMAPS is nil, search in the currently
3372 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3373 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3375 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3376 the first key sequence found, rather than a list of all possible key
3379 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3380 to other keymaps or slots. This makes it possible to search for an
3381 indirect definition itself.
3383 (definition, keymaps, firstonly, noindirect, event_or_keys))
3385 /* This function can GC */
3386 Lisp_Object maps[100];
3387 Lisp_Object *gubbish = maps;
3390 /* Get keymaps as an array */
3393 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3395 if (nmaps > countof (maps))
3397 gubbish = alloca_array (Lisp_Object, nmaps);
3398 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3401 else if (CONSP (keymaps))
3406 nmaps = XINT (Flength (keymaps));
3407 if (nmaps > countof (maps))
3409 gubbish = alloca_array (Lisp_Object, nmaps);
3411 for (rest = keymaps, i = 0; !NILP (rest);
3412 rest = XCDR (keymaps), i++)
3414 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3420 gubbish[0] = get_keymap (keymaps, 1, 1);
3421 if (!EQ (gubbish[0], Vcurrent_global_map))
3423 gubbish[1] = Vcurrent_global_map;
3428 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3431 /* This function is like
3432 (key-description (where-is-internal definition nil t))
3433 except that it writes its output into a (char *) buffer that you
3434 provide; it doesn't cons (or allocate memory) at all, so it's
3435 very fast. This is used by menubar.c.
3438 where_is_to_char (Lisp_Object definition, char *buffer)
3440 /* This function can GC */
3441 Lisp_Object maps[100];
3442 Lisp_Object *gubbish = maps;
3445 /* Get keymaps as an array */
3446 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3447 if (nmaps > countof (maps))
3449 gubbish = alloca_array (Lisp_Object, nmaps);
3450 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3454 where_is_internal (definition, maps, nmaps, Qt, buffer);
3459 raw_keys_to_keys (struct key_data *keys, int count)
3461 Lisp_Object result = make_vector (count, Qnil);
3463 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3469 format_raw_keys (struct key_data *keys, int count, char *buf)
3472 struct Lisp_Event event;
3473 event.event_type = key_press_event;
3474 event.channel = Vselected_console;
3475 for (i = 0; i < count; i++)
3477 event.event.key.keysym = keys[i].keysym;
3478 event.event.key.modifiers = keys[i].modifiers;
3479 format_event_object (buf, &event, 1);
3480 buf += strlen (buf);
3482 buf[0] = ' ', buf++;
3487 /* definition is the thing to look for.
3489 shadow is an array of shadow_count keymaps; if there is a different
3490 binding in any of the keymaps of a key that we are considering
3491 returning, then we reconsider.
3492 firstonly means give up after finding the first match;
3493 keys_so_far and modifiers_so_far describe which map we're looking in;
3494 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3495 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3496 will be MOD_META. That is, keys_so_far is the chain of keys that we
3497 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3500 (keys_so_far is a global buffer and the keys_count arg says how much
3501 of it we're currently interested in.)
3503 If target_buffer is provided, then we write a key-description into it,
3504 to avoid consing a string. This only works with firstonly on.
3507 struct where_is_closure
3509 Lisp_Object definition;
3510 Lisp_Object *shadow;
3514 unsigned int modifiers_so_far;
3515 char *target_buffer;
3516 struct key_data *keys_so_far;
3517 int keys_so_far_total_size;
3518 int keys_so_far_malloced;
3521 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3524 where_is_recursive_mapper (Lisp_Object map, void *arg)
3526 /* This function can GC */
3527 struct where_is_closure *c = (struct where_is_closure *) arg;
3528 Lisp_Object definition = c->definition;
3529 CONST int firstonly = c->firstonly;
3530 CONST unsigned int keys_count = c->keys_count;
3531 CONST unsigned int modifiers_so_far = c->modifiers_so_far;
3532 char *target_buffer = c->target_buffer;
3533 Lisp_Object keys = Fgethash (definition,
3534 XKEYMAP (map)->inverse_table,
3536 Lisp_Object submaps;
3537 Lisp_Object result = Qnil;
3541 /* One or more keys in this map match the definition we're looking for.
3542 Verify that these bindings aren't shadowed by other bindings
3543 in the shadow maps. Either nil or number as value from
3544 raw_lookup_key() means undefined. */
3545 struct key_data *so_far = c->keys_so_far;
3547 for (;;) /* loop over all keys that match */
3549 Lisp_Object k = ((CONSP (keys)) ? XCAR (keys) : keys);
3552 so_far [keys_count].keysym = k;
3553 so_far [keys_count].modifiers = modifiers_so_far;
3555 /* now loop over all shadow maps */
3556 for (i = 0; i < c->shadow_count; i++)
3558 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3563 if (NILP (shadowed) || CHARP (shadowed) ||
3564 EQ (shadowed, definition))
3565 continue; /* we passed this test; it's not shadowed here. */
3567 /* ignore this key binding, since it actually has a
3568 different binding in a shadowing map */
3569 goto c_doesnt_have_proper_loop_exit_statements;
3572 /* OK, the key is for real */
3575 if (!firstonly) abort ();
3576 format_raw_keys (so_far, keys_count + 1, target_buffer);
3577 return make_int (1);
3580 return raw_keys_to_keys (so_far, keys_count + 1);
3582 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3585 c_doesnt_have_proper_loop_exit_statements:
3586 /* now on to the next matching key ... */
3587 if (!CONSP (keys)) break;
3592 /* Now search the sub-keymaps of this map.
3593 If we're in "firstonly" mode and have already found one, this
3594 point is not reached. If we get one from lower down, either
3595 return it immediately (in firstonly mode) or tack it onto the
3596 end of the ones we've gotten so far.
3598 for (submaps = keymap_submaps (map);
3600 submaps = XCDR (submaps))
3602 Lisp_Object key = XCAR (XCAR (submaps));
3603 Lisp_Object submap = XCDR (XCAR (submaps));
3604 unsigned int lower_modifiers;
3605 int lower_keys_count = keys_count;
3608 submap = get_keymap (submap, 0, 0);
3610 if (EQ (submap, map))
3611 /* Arrgh! Some loser has introduced a loop... */
3614 /* If this is not a keymap, then that's probably because someone
3615 did an `fset' of a symbol that used to point to a map such that
3616 it no longer does. Sigh. Ignore this, and invalidate the cache
3617 so that it doesn't happen to us next time too.
3621 XKEYMAP (map)->sub_maps_cache = Qt;
3625 /* If the map is a "bucky" map, then add a bit to the
3626 modifiers_so_far list.
3627 Otherwise, add a new raw_key onto the end of keys_so_far.
3629 bucky = MODIFIER_HASH_KEY_BITS (key);
3631 lower_modifiers = (modifiers_so_far | bucky);
3634 struct key_data *so_far = c->keys_so_far;
3635 lower_modifiers = 0;
3636 so_far [lower_keys_count].keysym = key;
3637 so_far [lower_keys_count].modifiers = modifiers_so_far;
3641 if (lower_keys_count >= c->keys_so_far_total_size)
3643 int size = lower_keys_count + 50;
3644 if (! c->keys_so_far_malloced)
3646 struct key_data *new = xnew_array (struct key_data, size);
3647 memcpy ((void *)new, (CONST void *)c->keys_so_far,
3648 c->keys_so_far_total_size * sizeof (struct key_data));
3651 XREALLOC_ARRAY (c->keys_so_far, struct key_data, size);
3653 c->keys_so_far_total_size = size;
3654 c->keys_so_far_malloced = 1;
3660 c->keys_count = lower_keys_count;
3661 c->modifiers_so_far = lower_modifiers;
3663 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3665 c->keys_count = keys_count;
3666 c->modifiers_so_far = modifiers_so_far;
3669 result = nconc2 (lower, result);
3670 else if (!NILP (lower))
3679 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3680 Lisp_Object firstonly, char *target_buffer)
3682 /* This function can GC */
3683 Lisp_Object result = Qnil;
3685 struct key_data raw[20];
3686 struct where_is_closure c;
3688 c.definition = definition;
3690 c.firstonly = !NILP (firstonly);
3691 c.target_buffer = target_buffer;
3692 c.keys_so_far = raw;
3693 c.keys_so_far_total_size = countof (raw);
3694 c.keys_so_far_malloced = 0;
3696 /* Loop over each of the maps, accumulating the keys found.
3697 For each map searched, all previous maps shadow this one
3698 so that bogus keys aren't listed. */
3699 for (i = 0; i < nmaps; i++)
3701 Lisp_Object this_result;
3703 /* Reset the things set in each iteration */
3705 c.modifiers_so_far = 0;
3707 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3709 if (!NILP (firstonly))
3711 result = this_result;
3716 result = nconc2 (this_result, result);
3719 if (NILP (firstonly))
3720 result = Fnreverse (result);
3722 if (c.keys_so_far_malloced)
3723 xfree (c.keys_so_far);
3728 /************************************************************************/
3729 /* Describing keymaps */
3730 /************************************************************************/
3732 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3733 Insert a list of all defined keys and their definitions in MAP.
3734 Optional second argument ALL says whether to include even "uninteresting"
3735 definitions (ie symbols with a non-nil `suppress-keymap' property.
3736 Third argument SHADOW is a list of keymaps whose bindings shadow those
3737 of map; if a binding is present in any shadowing map, it is not printed.
3738 Fourth argument PREFIX, if non-nil, should be a key sequence;
3739 only bindings which start with that key sequence will be printed.
3740 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3742 (map, all, shadow, prefix, mouse_only_p))
3744 /* This function can GC */
3746 /* #### At some point, this function should be changed to accept a
3747 BUFFER argument. Currently, the BUFFER argument to
3748 describe_map_tree is being used only internally. */
3749 describe_map_tree (map, NILP (all), shadow, prefix,
3750 !NILP (mouse_only_p), Fcurrent_buffer ());
3755 /* Insert a desription of the key bindings in STARTMAP,
3756 followed by those of all maps reachable through STARTMAP.
3757 If PARTIAL is nonzero, omit certain "uninteresting" commands
3758 (such as `undefined').
3759 If SHADOW is non-nil, it is a list of other maps;
3760 don't mention keys which would be shadowed by any of them
3761 If PREFIX is non-nil, only list bindings which start with those keys.
3765 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3766 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3768 /* This function can GC */
3769 Lisp_Object maps = Qnil;
3770 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3771 GCPRO2 (maps, shadow);
3773 maps = Faccessible_keymaps (startmap, prefix);
3775 for (; !NILP (maps); maps = Fcdr (maps))
3777 Lisp_Object sub_shadow = Qnil;
3778 Lisp_Object elt = Fcar (maps);
3780 int no_prefix = (VECTORP (Fcar (elt))
3781 && XINT (Flength (Fcar (elt))) == 0);
3782 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3783 NGCPRO3 (sub_shadow, elt, tail);
3785 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3787 Lisp_Object shmap = XCAR (tail);
3789 /* If the sequence by which we reach this keymap is zero-length,
3790 then the shadow maps for this keymap are just SHADOW. */
3793 /* If the sequence by which we reach this keymap actually has
3794 some elements, then the sequence's definition in SHADOW is
3795 what we should use. */
3798 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3805 Lisp_Object shm = get_keymap (shmap, 0, 1);
3806 /* If shmap is not nil and not a keymap, it completely
3807 shadows this map, so don't describe this map at all. */
3810 sub_shadow = Fcons (shm, sub_shadow);
3815 /* Describe the contents of map MAP, assuming that this map
3816 itself is reached by the sequence of prefix keys KEYS (a vector).
3817 PARTIAL and SHADOW are as in `describe_map_tree'. */
3818 Lisp_Object keysdesc
3820 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3822 describe_map (Fcdr (elt), keysdesc,
3837 describe_command (Lisp_Object definition, Lisp_Object buffer)
3839 /* This function can GC */
3840 int keymapp = !NILP (Fkeymapp (definition));
3841 struct gcpro gcpro1;
3842 GCPRO1 (definition);
3844 Findent_to (make_int (16), make_int (3), buffer);
3846 buffer_insert_c_string (XBUFFER (buffer), "<< ");
3848 if (SYMBOLP (definition))
3850 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3852 else if (STRINGP (definition) || VECTORP (definition))
3854 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: ");
3855 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3857 else if (COMPILED_FUNCTIONP (definition))
3858 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function");
3859 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
3860 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda");
3861 else if (KEYMAPP (definition))
3863 Lisp_Object name = XKEYMAP (definition)->name;
3864 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3866 buffer_insert_c_string (XBUFFER (buffer), "Prefix command ");
3868 && EQ (find_symbol_value (name), definition))
3869 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3872 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3876 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command");
3879 buffer_insert_c_string (XBUFFER (buffer), "??");
3882 buffer_insert_c_string (XBUFFER (buffer), " >>");
3883 buffer_insert_c_string (XBUFFER (buffer), "\n");
3887 struct describe_map_closure
3889 Lisp_Object *list; /* pointer to the list to update */
3890 Lisp_Object partial; /* whether to ignore suppressed commands */
3891 Lisp_Object shadow; /* list of maps shadowing this one */
3892 Lisp_Object self; /* this map */
3893 Lisp_Object self_root; /* this map, or some map that has this map as
3894 a parent. this is the base of the tree */
3895 int mice_only_p; /* whether we are to display only button bindings */
3898 struct describe_map_shadow_closure
3900 CONST struct key_data *raw_key;
3905 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3907 struct describe_map_shadow_closure *c =
3908 (struct describe_map_shadow_closure *) arg;
3910 if (EQ (map, c->self))
3911 return Qzero; /* Not shadowed; terminate search */
3913 return !NILP (keymap_lookup_directly (map,
3915 c->raw_key->modifiers))
3921 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3923 struct key_data *k = (struct key_data *) arg;
3924 return keymap_lookup_directly (km, k->keysym, k->modifiers);
3929 describe_map_mapper (CONST struct key_data *key,
3930 Lisp_Object binding,
3931 void *describe_map_closure)
3933 /* This function can GC */
3934 struct describe_map_closure *closure =
3935 (struct describe_map_closure *) describe_map_closure;
3936 Lisp_Object keysym = key->keysym;
3937 unsigned int modifiers = key->modifiers;
3939 /* Dont mention suppressed commands. */
3940 if (SYMBOLP (binding)
3941 && !NILP (closure->partial)
3942 && !NILP (Fget (binding, closure->partial, Qnil)))
3945 /* If we're only supposed to display mouse bindings and this isn't one,
3947 if (closure->mice_only_p &&
3948 (! (EQ (keysym, Qbutton0) ||
3949 EQ (keysym, Qbutton1) ||
3950 EQ (keysym, Qbutton2) ||
3951 EQ (keysym, Qbutton3) ||
3952 EQ (keysym, Qbutton4) ||
3953 EQ (keysym, Qbutton5) ||
3954 EQ (keysym, Qbutton6) ||
3955 EQ (keysym, Qbutton7) ||
3956 EQ (keysym, Qbutton0up) ||
3957 EQ (keysym, Qbutton1up) ||
3958 EQ (keysym, Qbutton2up) ||
3959 EQ (keysym, Qbutton3up) ||
3960 EQ (keysym, Qbutton4up) ||
3961 EQ (keysym, Qbutton5up) ||
3962 EQ (keysym, Qbutton6up) ||
3963 EQ (keysym, Qbutton7up))))
3966 /* If this command in this map is shadowed by some other map, ignore it. */
3970 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3973 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3974 keymap_lookup_inherited_mapper,
3975 /* Cast to discard `const' */
3981 /* If this key is in some map of which this map is a parent, then ignore
3982 it (in that case, it has been shadowed).
3986 struct describe_map_shadow_closure c;
3988 c.self = closure->self;
3990 sh = traverse_keymaps (closure->self_root, Qnil,
3991 describe_map_mapper_shadow_search, &c);
3992 if (!NILP (sh) && !ZEROP (sh))
3996 /* Otherwise add it to the list to be sorted. */
3997 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
4004 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
4007 /* obj1 and obj2 are conses of the form
4008 ( ( <keysym> . <modifiers> ) . <binding> )
4009 keysym and modifiers are used, binding is ignored.
4011 unsigned int bit1, bit2;
4014 bit1 = XINT (XCDR (obj1));
4015 bit2 = XINT (XCDR (obj2));
4017 return bit1 < bit2 ? 1 : -1;
4019 return map_keymap_sort_predicate (obj1, obj2, pred);
4022 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4023 or 2 or more symbolic keysyms that are bound to the same thing and
4024 have consecutive character-set-properties.
4027 elide_next_two_p (Lisp_Object list)
4031 if (NILP (XCDR (list)))
4034 /* next two bindings differ */
4035 if (!EQ (XCDR (XCAR (list)),
4036 XCDR (XCAR (XCDR (list)))))
4039 /* next two modifier-sets differ */
4040 if (!EQ (XCDR (XCAR (XCAR (list))),
4041 XCDR (XCAR (XCAR (XCDR (list))))))
4044 s1 = XCAR (XCAR (XCAR (list)));
4045 s2 = XCAR (XCAR (XCAR (XCDR (list))));
4049 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
4050 if (CHAR_OR_CHAR_INTP (code))
4053 CHECK_CHAR_COERCE_INT (s1);
4059 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
4060 if (CHAR_OR_CHAR_INTP (code))
4063 CHECK_CHAR_COERCE_INT (s2);
4068 return (XCHAR (s1) == XCHAR (s2) ||
4069 XCHAR (s1) + 1 == XCHAR (s2));
4074 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
4076 /* This function can GC */
4077 struct describe_map_closure *describe_map_closure =
4078 (struct describe_map_closure *) arg;
4079 describe_map_closure->self = keymap;
4080 map_keymap (XKEYMAP (keymap)->table,
4081 0, /* don't sort: we'll do it later */
4082 describe_map_mapper, describe_map_closure);
4087 /* Describe the contents of map MAP, assuming that this map itself is
4088 reached by the sequence of prefix keys KEYS (a string or vector).
4089 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4092 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
4093 void (*elt_describer) (Lisp_Object, Lisp_Object),
4099 /* This function can GC */
4100 struct describe_map_closure describe_map_closure;
4101 Lisp_Object list = Qnil;
4102 struct buffer *buf = XBUFFER (buffer);
4103 Emchar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
4104 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
4105 : ((EQ (buf->ctl_arrow, Qt)
4106 || EQ (buf->ctl_arrow, Qnil))
4109 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4111 keymap = get_keymap (keymap, 1, 1);
4112 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4113 describe_map_closure.shadow = shadow;
4114 describe_map_closure.list = &list;
4115 describe_map_closure.self_root = keymap;
4116 describe_map_closure.mice_only_p = mice_only_p;
4118 GCPRO4 (keymap, elt_prefix, shadow, list);
4120 traverse_keymaps (keymap, Qnil,
4121 describe_map_parent_mapper, &describe_map_closure);
4125 list = list_sort (list, Qnil, describe_map_sort_predicate);
4126 buffer_insert_c_string (buf, "\n");
4127 while (!NILP (list))
4129 Lisp_Object elt = XCAR (XCAR (list));
4130 Lisp_Object keysym = XCAR (elt);
4131 unsigned int modifiers = XINT (XCDR (elt));
4133 if (!NILP (elt_prefix))
4134 buffer_insert_lisp_string (buf, elt_prefix);
4136 if (modifiers & MOD_META) buffer_insert_c_string (buf, "M-");
4137 if (modifiers & MOD_CONTROL) buffer_insert_c_string (buf, "C-");
4138 if (modifiers & MOD_SUPER) buffer_insert_c_string (buf, "S-");
4139 if (modifiers & MOD_HYPER) buffer_insert_c_string (buf, "H-");
4140 if (modifiers & MOD_ALT) buffer_insert_c_string (buf, "Alt-");
4141 if (modifiers & MOD_SHIFT) buffer_insert_c_string (buf, "Sh-");
4142 if (SYMBOLP (keysym))
4144 Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil);
4145 Emchar c = (CHAR_OR_CHAR_INTP (code)
4146 ? XCHAR_OR_CHAR_INT (code) : -1);
4147 /* Calling Fsingle_key_description() would cons more */
4148 #if 0 /* This is bogus */
4149 if (EQ (keysym, QKlinefeed))
4150 buffer_insert_c_string (buf, "LFD");
4151 else if (EQ (keysym, QKtab))
4152 buffer_insert_c_string (buf, "TAB");
4153 else if (EQ (keysym, QKreturn))
4154 buffer_insert_c_string (buf, "RET");
4155 else if (EQ (keysym, QKescape))
4156 buffer_insert_c_string (buf, "ESC");
4157 else if (EQ (keysym, QKdelete))
4158 buffer_insert_c_string (buf, "DEL");
4159 else if (EQ (keysym, QKspace))
4160 buffer_insert_c_string (buf, "SPC");
4161 else if (EQ (keysym, QKbackspace))
4162 buffer_insert_c_string (buf, "BS");
4165 if (c >= printable_min)
4166 buffer_insert_emacs_char (buf, c);
4167 else buffer_insert1 (buf, Fsymbol_name (keysym));
4169 else if (CHARP (keysym))
4170 buffer_insert_emacs_char (buf, XCHAR (keysym));
4172 buffer_insert_c_string (buf, "---bad keysym---");
4180 while (elide_next_two_p (list))
4188 buffer_insert_c_string (buf, ", ");
4190 buffer_insert_c_string (buf, " .. ");
4196 /* Print a description of the definition of this character. */
4197 (*elt_describer) (XCDR (XCAR (list)), buffer);
4206 syms_of_keymap (void)
4208 defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist");
4210 defsymbol (&Qkeymapp, "keymapp");
4212 defsymbol (&Qsuppress_keymap, "suppress-keymap");
4214 defsymbol (&Qmodeline_map, "modeline-map");
4215 defsymbol (&Qtoolbar_map, "toolbar-map");
4217 DEFSUBR (Fkeymap_parents);
4218 DEFSUBR (Fset_keymap_parents);
4219 DEFSUBR (Fkeymap_name);
4220 DEFSUBR (Fset_keymap_name);
4221 DEFSUBR (Fkeymap_prompt);
4222 DEFSUBR (Fset_keymap_prompt);
4223 DEFSUBR (Fkeymap_default_binding);
4224 DEFSUBR (Fset_keymap_default_binding);
4227 DEFSUBR (Fmake_keymap);
4228 DEFSUBR (Fmake_sparse_keymap);
4230 DEFSUBR (Fcopy_keymap);
4231 DEFSUBR (Fkeymap_fullness);
4232 DEFSUBR (Fmap_keymap);
4233 DEFSUBR (Fevent_matches_key_specifier_p);
4234 DEFSUBR (Fdefine_key);
4235 DEFSUBR (Flookup_key);
4236 DEFSUBR (Fkey_binding);
4237 DEFSUBR (Fuse_global_map);
4238 DEFSUBR (Fuse_local_map);
4239 DEFSUBR (Fcurrent_local_map);
4240 DEFSUBR (Fcurrent_global_map);
4241 DEFSUBR (Fcurrent_keymaps);
4242 DEFSUBR (Faccessible_keymaps);
4243 DEFSUBR (Fkey_description);
4244 DEFSUBR (Fsingle_key_description);
4245 DEFSUBR (Fwhere_is_internal);
4246 DEFSUBR (Fdescribe_bindings_internal);
4248 DEFSUBR (Ftext_char_description);
4250 defsymbol (&Qcontrol, "control");
4251 defsymbol (&Qctrl, "ctrl");
4252 defsymbol (&Qmeta, "meta");
4253 defsymbol (&Qsuper, "super");
4254 defsymbol (&Qhyper, "hyper");
4255 defsymbol (&Qalt, "alt");
4256 defsymbol (&Qshift, "shift");
4257 defsymbol (&Qbutton0, "button0");
4258 defsymbol (&Qbutton1, "button1");
4259 defsymbol (&Qbutton2, "button2");
4260 defsymbol (&Qbutton3, "button3");
4261 defsymbol (&Qbutton4, "button4");
4262 defsymbol (&Qbutton5, "button5");
4263 defsymbol (&Qbutton6, "button6");
4264 defsymbol (&Qbutton7, "button7");
4265 defsymbol (&Qbutton0up, "button0up");
4266 defsymbol (&Qbutton1up, "button1up");
4267 defsymbol (&Qbutton2up, "button2up");
4268 defsymbol (&Qbutton3up, "button3up");
4269 defsymbol (&Qbutton4up, "button4up");
4270 defsymbol (&Qbutton5up, "button5up");
4271 defsymbol (&Qbutton6up, "button6up");
4272 defsymbol (&Qbutton7up, "button7up");
4273 defsymbol (&Qmouse_1, "mouse-1");
4274 defsymbol (&Qmouse_2, "mouse-2");
4275 defsymbol (&Qmouse_3, "mouse-3");
4276 defsymbol (&Qmouse_4, "mouse-4");
4277 defsymbol (&Qmouse_5, "mouse-5");
4278 defsymbol (&Qdown_mouse_1, "down-mouse-1");
4279 defsymbol (&Qdown_mouse_2, "down-mouse-2");
4280 defsymbol (&Qdown_mouse_3, "down-mouse-3");
4281 defsymbol (&Qdown_mouse_4, "down-mouse-4");
4282 defsymbol (&Qdown_mouse_5, "down-mouse-5");
4283 defsymbol (&Qmenu_selection, "menu-selection");
4284 defsymbol (&QLFD, "LFD");
4285 defsymbol (&QTAB, "TAB");
4286 defsymbol (&QRET, "RET");
4287 defsymbol (&QESC, "ESC");
4288 defsymbol (&QDEL, "DEL");
4289 defsymbol (&QBS, "BS");
4293 vars_of_keymap (void)
4295 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
4296 Meta-prefix character.
4297 This character followed by some character `foo' turns into `Meta-foo'.
4298 This can be any form recognized as a single key specifier.
4299 To disable the meta-prefix-char, set it to a negative number.
4301 Vmeta_prefix_char = make_char (033);
4303 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4304 A buffer which should be consulted first for all mouse activity.
4305 When a mouse-click is processed, it will first be looked up in the
4306 local-map of this buffer, and then through the normal mechanism if there
4307 is no binding for that click. This buffer's value of `mode-motion-hook'
4308 will be consulted instead of the `mode-motion-hook' of the buffer of the
4309 window under the mouse. You should *bind* this, not set it.
4311 Vmouse_grabbed_buffer = Qnil;
4313 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
4314 Keymap that overrides all other local keymaps.
4315 If this variable is non-nil, it is used as a keymap instead of the
4316 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4317 You should *bind* this, not set it.
4319 Voverriding_local_map = Qnil;
4321 Fset (Qminor_mode_map_alist, Qnil);
4323 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
4324 Keymap of key translations that can override keymaps.
4325 This keymap works like `function-key-map', but comes after that,
4326 and applies even for keys that have ordinary bindings.
4328 Vkey_translation_map = Qnil;
4330 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
4331 Keymap which handles mouse clicks over vertical dividers.
4333 Vvertical_divider_map = Qnil;
4335 DEFVAR_INT ("keymap-tick", &keymap_tick /*
4336 Incremented for each change to any keymap.
4340 staticpro (&Vcurrent_global_map);
4342 Vsingle_space_string = make_pure_string ((CONST Bufbyte *) " ", 1, Qnil, 1);
4343 staticpro (&Vsingle_space_string);
4347 complex_vars_of_keymap (void)
4349 /* This function can GC */
4350 Lisp_Object ESC_prefix = intern ("ESC-prefix");
4351 Lisp_Object meta_disgustitute;
4353 Vcurrent_global_map = Fmake_keymap (Qnil);
4355 meta_disgustitute = Fmake_keymap (Qnil);
4356 Ffset (ESC_prefix, meta_disgustitute);
4357 /* no need to protect meta_disgustitute, though */
4358 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (MOD_META),
4359 XKEYMAP (Vcurrent_global_map),
4361 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
4363 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));