1 /* Manipulation of keymaps
2 Copyright (C) 1985, 1991-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Totally redesigned by jwz in 1991.
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially
25 different from FSF. */
42 /* Hmm, under unix we want X modifiers, under NT we want X modifiers if
43 we are running X and Windows modifiers otherwise.
44 gak. This is a kludge until we support multiple native GUIs!
51 #include "events-mod.h"
54 /* A keymap contains six slots:
56 parents Ordered list of keymaps to search after
57 this one if no match is found.
58 Keymaps can thus be arranged in a hierarchy.
60 table A hash table, hashing keysyms to their bindings.
61 It will be one of the following:
63 -- a symbol, e.g. 'home
64 -- a character, representing something printable
65 (not ?\C-c meaning C-c, for instance)
66 -- an integer representing a modifier combination
68 inverse_table A hash table, hashing bindings to the list of keysyms
69 in this keymap which are bound to them. This is to make
70 the Fwhere_is_internal() function be fast. It needs to be
71 fast because we want to be able to call it in realtime to
72 update the keyboard-equivalents on the pulldown menus.
73 Values of the table are either atoms (keysyms)
74 or a dotted list of keysyms.
76 sub_maps_cache An alist; for each entry in this keymap whose binding is
77 a keymap (that is, Fkeymapp()) this alist associates that
78 keysym with that binding. This is used to optimize both
79 Fwhere_is_internal() and Faccessible_keymaps(). This slot
80 gets set to the symbol `t' every time a change is made to
81 this keymap, causing it to be recomputed when next needed.
83 prompt See `set-keymap-prompt'.
85 default_binding See `set-keymap-default-binding'.
87 Sequences of keys are stored in the obvious way: if the sequence of keys
88 "abc" was bound to some command `foo', the hierarchy would look like
90 keymap-1: associates "a" with keymap-2
91 keymap-2: associates "b" with keymap-3
92 keymap-3: associates "c" with foo
94 However, bucky bits ("modifiers" to the X-minded) are represented in the
95 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
96 Each combination of modifiers (e.g. control-hyper) gets its own submap
97 off of the main map. The hash key for a modifier combination is
98 an integer, computed by MAKE_MODIFIER_HASH_KEY().
100 If the key `C-a' was bound to some command, the hierarchy would look like
102 keymap-1: associates the integer MOD_CONTROL with keymap-2
103 keymap-2: associates "a" with the command
105 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
108 keymap-1: associates the integer (MOD_CONTROL | MOD_HYPER)
110 keymap-2: associates "a" with the command
112 Note that a special exception is made for the meta modifier, in order
113 to deal with ESC/meta lossage. Any key combination containing the
114 meta modifier is first indexed off of the main map into the meta
115 submap (with hash key MOD_META) and then indexed off of the
116 meta submap with the meta modifier removed from the key combination.
117 For example, when associating a command with C-M-H-a, we'd have
119 keymap-1: associates the integer MOD_META with keymap-2
120 keymap-2: associates the integer (MOD_CONTROL | MOD_HYPER)
122 keymap-3: associates "a" with the command
124 Note that keymap-2 might have normal bindings in it; these would be
125 for key combinations containing only the meta modifier, such as
126 M-y or meta-backspace.
128 If the command that "a" was bound to in keymap-3 was itself a keymap,
129 then that would make the key "C-M-H-a" be a prefix character.
131 Note that this new model of keymaps takes much of the magic away from
132 the Escape key: the value of the variable `esc-map' is no longer indexed
133 in the `global-map' under the ESC key. It's indexed under the integer
134 MOD_META. This is not user-visible, however; none of the "bucky"
137 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
138 and (define-key some-random-map "\^[" my-esc-map) work as before, for
141 Since keymaps are opaque, the only way to extract information from them
142 is with the functions lookup-key, key-binding, local-key-binding, and
143 global-key-binding, which work just as before, and the new function
144 map-keymap, which is roughly analogous to maphash.
146 Note that map-keymap perpetuates the illusion that the "bucky" submaps
147 don't exist: if you map over a keymap with bucky submaps, it will also
148 map over those submaps. It does not, however, map over other random
149 submaps of the keymap, just the bucky ones.
151 One implication of this is that when you map over `global-map', you will
152 also map over `esc-map'. It is merely for compatibility that the esc-map
153 is accessible at all; I think that's a bad thing, since it blurs the
154 distinction between ESC and "meta" even more. "M-x" is no more a two-
155 key sequence than "C-x" is.
161 struct lcrecord_header header;
162 Lisp_Object parents; /* Keymaps to be searched after this one.
164 Lisp_Object prompt; /* Qnil or a string to print in the minibuffer
165 when reading from this keymap */
166 Lisp_Object table; /* The contents of this keymap */
167 Lisp_Object inverse_table; /* The inverse mapping of the above */
168 Lisp_Object default_binding; /* Use this if no other binding is found
169 (this overrides parent maps and the
170 normal global-map lookup). */
171 Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps;
172 This holds an alist, of the key and the
173 maps, or the modifier bit and the map.
174 If this is the symbol t, then the cache
175 needs to be recomputed. */
176 Lisp_Object name; /* Just for debugging convenience */
179 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
180 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
184 /* Actually allocate storage for these variables */
186 Lisp_Object Vcurrent_global_map; /* Always a keymap */
188 static Lisp_Object Vmouse_grabbed_buffer;
190 /* Alist of minor mode variables and keymaps. */
191 static Lisp_Object Qminor_mode_map_alist;
193 static Lisp_Object Voverriding_local_map;
195 static Lisp_Object Vkey_translation_map;
197 static Lisp_Object Vvertical_divider_map;
199 /* This is incremented whenever a change is made to a keymap. This is
200 so that things which care (such as the menubar code) can recompute
201 privately-cached data when the user has changed keybindings.
205 /* Prefixing a key with this character is the same as sending a meta bit. */
206 Lisp_Object Vmeta_prefix_char;
208 Lisp_Object Qkeymapp;
209 Lisp_Object Vsingle_space_string;
210 Lisp_Object Qsuppress_keymap;
211 Lisp_Object Qmodeline_map;
212 Lisp_Object Qtoolbar_map;
214 EXFUN (Fkeymap_fullness, 1);
215 EXFUN (Fset_keymap_name, 2);
216 EXFUN (Fsingle_key_description, 1);
218 static void describe_command (Lisp_Object definition, Lisp_Object buffer);
219 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
220 void (*elt_describer) (Lisp_Object, Lisp_Object),
225 static Lisp_Object keymap_submaps (Lisp_Object keymap);
227 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
228 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3;
229 Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7;
230 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up;
231 Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up;
233 Lisp_Object Qmenu_selection;
234 /* Emacs compatibility */
235 Lisp_Object Qdown_mouse_1, Qdown_mouse_2, Qdown_mouse_3, Qdown_mouse_4,
237 Lisp_Object Qmouse_1, Qmouse_2, Qmouse_3, Qmouse_4, Qmouse_5;
239 /* Kludge kludge kludge */
240 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
243 /************************************************************************/
244 /* The keymap Lisp object */
245 /************************************************************************/
248 mark_keymap (Lisp_Object obj)
250 Lisp_Keymap *keymap = XKEYMAP (obj);
251 mark_object (keymap->parents);
252 mark_object (keymap->prompt);
253 mark_object (keymap->inverse_table);
254 mark_object (keymap->sub_maps_cache);
255 mark_object (keymap->default_binding);
256 mark_object (keymap->name);
257 return keymap->table;
261 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
263 /* This function can GC */
264 Lisp_Keymap *keymap = XKEYMAP (obj);
267 error ("printing unreadable object #<keymap 0x%x>", keymap->header.uid);
268 write_c_string ("#<keymap ", printcharfun);
269 if (!NILP (keymap->name))
271 print_internal (keymap->name, printcharfun, 1);
272 write_c_string (" ", printcharfun);
274 sprintf (buf, "size %ld 0x%x>",
275 (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid);
276 write_c_string (buf, printcharfun);
279 static const struct lrecord_description keymap_description[] = {
280 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, parents) },
281 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, prompt) },
282 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, table) },
283 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, inverse_table) },
284 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, default_binding) },
285 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, sub_maps_cache) },
286 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, name) },
290 /* No need for keymap_equal #### Why not? */
291 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap,
292 mark_keymap, print_keymap, 0, 0, 0,
296 /************************************************************************/
297 /* Traversing keymaps and their parents */
298 /************************************************************************/
301 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents,
302 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg),
305 /* This function can GC */
307 Lisp_Object tail = start_parents;
308 Lisp_Object malloc_sucks[10];
309 Lisp_Object malloc_bites = Qnil;
311 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
312 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail);
315 start_keymap = get_keymap (start_keymap, 1, 1);
316 keymap = start_keymap;
317 /* Hack special-case parents at top-level */
318 tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents;
325 result = mapper (keymap, mapper_arg);
328 while (CONSP (malloc_bites))
330 Lisp_Cons *victim = XCONS (malloc_bites);
331 malloc_bites = victim->cdr;
339 if (stack_depth == 0)
342 return Qnil; /* Nothing found */
345 if (CONSP (malloc_bites))
347 Lisp_Cons *victim = XCONS (malloc_bites);
349 malloc_bites = victim->cdr;
354 tail = malloc_sucks[stack_depth];
355 gcpro1.nvars = stack_depth;
357 keymap = XCAR (tail);
364 keymap = XCAR (tail);
366 parents = XKEYMAP (keymap)->parents;
367 if (!CONSP (parents))
369 else if (NILP (tail))
374 if (CONSP (malloc_bites))
375 malloc_bites = noseeum_cons (tail, malloc_bites);
376 else if (stack_depth < countof (malloc_sucks))
378 malloc_sucks[stack_depth++] = tail;
379 gcpro1.nvars = stack_depth;
383 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */
385 for (i = 0, malloc_bites = Qnil;
386 i < countof (malloc_sucks);
388 malloc_bites = noseeum_cons (malloc_sucks[i],
395 keymap = get_keymap (keymap, 1, 1);
396 if (EQ (keymap, start_keymap))
398 signal_simple_error ("Cyclic keymap indirection",
405 /************************************************************************/
406 /* Some low-level functions */
407 /************************************************************************/
410 bucky_sym_to_bucky_bit (Lisp_Object sym)
412 if (EQ (sym, Qcontrol)) return MOD_CONTROL;
413 if (EQ (sym, Qmeta)) return MOD_META;
414 if (EQ (sym, Qsuper)) return MOD_SUPER;
415 if (EQ (sym, Qhyper)) return MOD_HYPER;
416 if (EQ (sym, Qalt)) return MOD_ALT;
417 if (EQ (sym, Qsymbol)) return MOD_ALT; /* #### - reverse compat */
418 if (EQ (sym, Qshift)) return MOD_SHIFT;
424 control_meta_superify (Lisp_Object frob, unsigned int modifiers)
428 frob = Fcons (frob, Qnil);
429 if (modifiers & MOD_SHIFT) frob = Fcons (Qshift, frob);
430 if (modifiers & MOD_ALT) frob = Fcons (Qalt, frob);
431 if (modifiers & MOD_HYPER) frob = Fcons (Qhyper, frob);
432 if (modifiers & MOD_SUPER) frob = Fcons (Qsuper, frob);
433 if (modifiers & MOD_CONTROL) frob = Fcons (Qcontrol, frob);
434 if (modifiers & MOD_META) frob = Fcons (Qmeta, frob);
439 make_key_description (const struct key_data *key, int prettify)
441 Lisp_Object keysym = key->keysym;
442 unsigned int modifiers = key->modifiers;
444 if (prettify && CHARP (keysym))
446 /* This is a little slow, but (control a) is prettier than (control 65).
447 It's now ok to do this for digit-chars too, since we've fixed the
448 bug where \9 read as the integer 9 instead of as the symbol with
451 /* !!#### I'm not sure how correct this is. */
452 Bufbyte str [1 + MAX_EMCHAR_LEN];
453 Bytecount count = set_charptr_emchar (str, XCHAR (keysym));
455 keysym = intern ((char *) str);
457 return control_meta_superify (keysym, modifiers);
461 /************************************************************************/
462 /* Low-level keymap-store functions */
463 /************************************************************************/
466 raw_lookup_key (Lisp_Object keymap,
467 const struct key_data *raw_keys, int raw_keys_count,
468 int keys_so_far, int accept_default);
470 /* Relies on caller to gc-protect args */
472 keymap_lookup_directly (Lisp_Object keymap,
473 Lisp_Object keysym, unsigned int modifiers)
477 if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
478 | MOD_ALT | MOD_SHIFT)) != 0)
481 k = XKEYMAP (keymap);
483 /* If the keysym is a one-character symbol, use the char code instead. */
484 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
486 Lisp_Object i_fart_on_gcc =
487 make_char (string_char (XSYMBOL (keysym)->name, 0));
488 keysym = i_fart_on_gcc;
491 if (modifiers & MOD_META) /* Utterly hateful ESC lossage */
493 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
497 k = XKEYMAP (submap);
498 modifiers &= ~MOD_META;
503 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
507 k = XKEYMAP (submap);
509 return Fgethash (keysym, k->table, Qnil);
513 keymap_store_inverse_internal (Lisp_Object inverse_table,
517 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
522 /* Don't cons this unless necessary */
523 /* keys = Fcons (keysym, Qnil); */
524 Fputhash (value, keys, inverse_table);
526 else if (!CONSP (keys))
528 /* Now it's necessary to cons */
529 keys = Fcons (keys, keysym);
530 Fputhash (value, keys, inverse_table);
534 while (CONSP (XCDR (keys)))
536 XCDR (keys) = Fcons (XCDR (keys), keysym);
537 /* No need to call puthash because we've destructively
538 modified the list tail in place */
544 keymap_delete_inverse_internal (Lisp_Object inverse_table,
548 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
549 Lisp_Object new_keys = keys;
556 for (prev = &new_keys, tail = new_keys;
558 prev = &(XCDR (tail)), tail = XCDR (tail))
560 if (EQ (tail, keysym))
565 else if (EQ (keysym, XCAR (tail)))
573 Fremhash (value, inverse_table);
574 else if (!EQ (keys, new_keys))
575 /* Removed the first elt */
576 Fputhash (value, new_keys, inverse_table);
577 /* else the list's tail has been modified, so we don't need to
578 touch the hash table again (the pointer in there is ok).
582 /* Prevent luser from shooting herself in the foot using something like
583 (define-key ctl-x-4-map "p" global-map) */
585 check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap)
587 def = get_keymap (def, 0, 0);
593 if (XKEYMAP (def) == to_keymap)
594 signal_simple_error ("Cyclic keymap definition", def);
596 for (maps = keymap_submaps (def);
599 check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap);
604 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
607 Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil);
609 if (EQ (prev_def, def))
612 check_keymap_definition_loop (def, keymap);
614 if (!NILP (prev_def))
615 keymap_delete_inverse_internal (keymap->inverse_table,
619 Fremhash (keysym, keymap->table);
623 Fputhash (keysym, def, keymap->table);
624 keymap_store_inverse_internal (keymap->inverse_table,
632 create_bucky_submap (Lisp_Keymap *k, unsigned int modifiers,
633 Lisp_Object parent_for_debugging_info)
635 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
636 /* User won't see this, but it is nice for debugging Emacs */
637 XKEYMAP (submap)->name
638 = control_meta_superify (parent_for_debugging_info, modifiers);
639 /* Invalidate cache */
640 k->sub_maps_cache = Qt;
641 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
646 /* Relies on caller to gc-protect keymap, keysym, value */
648 keymap_store (Lisp_Object keymap, const struct key_data *key,
651 Lisp_Object keysym = key->keysym;
652 unsigned int modifiers = key->modifiers;
653 Lisp_Keymap *k = XKEYMAP (keymap);
655 assert ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
656 | MOD_ALT | MOD_SHIFT)) == 0);
658 /* If the keysym is a one-character symbol, use the char code instead. */
659 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
660 keysym = make_char (string_char (XSYMBOL (keysym)->name, 0));
662 if (modifiers & MOD_META) /* Utterly hateful ESC lossage */
664 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
667 submap = create_bucky_submap (k, MOD_META, keymap);
668 k = XKEYMAP (submap);
669 modifiers &= ~MOD_META;
674 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
677 submap = create_bucky_submap (k, modifiers, keymap);
678 k = XKEYMAP (submap);
680 k->sub_maps_cache = Qt; /* Invalidate cache */
681 keymap_store_internal (keysym, k, value);
685 /************************************************************************/
686 /* Listing the submaps of a keymap */
687 /************************************************************************/
689 struct keymap_submaps_closure
691 Lisp_Object *result_locative;
695 keymap_submaps_mapper_0 (Lisp_Object key, Lisp_Object value,
696 void *keymap_submaps_closure)
698 /* This function can GC */
699 /* Perform any autoloads, etc */
705 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value,
706 void *keymap_submaps_closure)
708 /* This function can GC */
709 Lisp_Object *result_locative;
710 struct keymap_submaps_closure *cl =
711 (struct keymap_submaps_closure *) keymap_submaps_closure;
712 result_locative = cl->result_locative;
714 if (!NILP (Fkeymapp (value)))
715 *result_locative = Fcons (Fcons (key, value), *result_locative);
719 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
723 keymap_submaps (Lisp_Object keymap)
725 /* This function can GC */
726 Lisp_Keymap *k = XKEYMAP (keymap);
728 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
730 Lisp_Object result = Qnil;
731 struct gcpro gcpro1, gcpro2;
732 struct keymap_submaps_closure keymap_submaps_closure;
734 GCPRO2 (keymap, result);
735 keymap_submaps_closure.result_locative = &result;
736 /* Do this first pass to touch (and load) any autoloaded maps */
737 elisp_maphash (keymap_submaps_mapper_0, k->table,
738 &keymap_submaps_closure);
740 elisp_maphash (keymap_submaps_mapper, k->table,
741 &keymap_submaps_closure);
742 /* keep it sorted so that the result of accessible-keymaps is ordered */
743 k->sub_maps_cache = list_sort (result,
745 map_keymap_sort_predicate);
748 return k->sub_maps_cache;
752 /************************************************************************/
753 /* Basic operations on keymaps */
754 /************************************************************************/
757 make_keymap (size_t size)
760 Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, &lrecord_keymap);
762 XSETKEYMAP (result, keymap);
764 keymap->parents = Qnil;
765 keymap->prompt = Qnil;
766 keymap->table = Qnil;
767 keymap->inverse_table = Qnil;
768 keymap->default_binding = Qnil;
769 keymap->sub_maps_cache = Qnil; /* No possible submaps */
772 if (size != 0) /* hack for copy-keymap */
775 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
776 /* Inverse table is often less dense because of duplicate key-bindings.
777 If not, it will grow anyway. */
778 keymap->inverse_table =
779 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
784 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
785 Construct and return a new keymap object.
786 All entries in it are nil, meaning "command undefined".
788 Optional argument NAME specifies a name to assign to the keymap,
789 as in `set-keymap-name'. This name is only a debugging convenience;
790 it is not used except when printing the keymap.
794 Lisp_Object keymap = make_keymap (60);
796 Fset_keymap_name (keymap, name);
800 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
801 Construct and return a new keymap object.
802 All entries in it are nil, meaning "command undefined". The only
803 difference between this function and make-keymap is that this function
804 returns a "smaller" keymap (one that is expected to contain fewer
805 entries). As keymaps dynamically resize, the distinction is not great.
807 Optional argument NAME specifies a name to assign to the keymap,
808 as in `set-keymap-name'. This name is only a debugging convenience;
809 it is not used except when printing the keymap.
813 Lisp_Object keymap = make_keymap (8);
815 Fset_keymap_name (keymap, name);
819 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
820 Return the `parent' keymaps of KEYMAP, or nil.
821 The parents of a keymap are searched for keybindings when a key sequence
822 isn't bound in this one. `(current-global-map)' is the default parent
827 keymap = get_keymap (keymap, 1, 1);
828 return Fcopy_sequence (XKEYMAP (keymap)->parents);
834 traverse_keymaps_noop (Lisp_Object keymap, void *arg)
839 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
840 Set the `parent' keymaps of KEYMAP to PARENTS.
841 The parents of a keymap are searched for keybindings when a key sequence
842 isn't bound in this one. `(current-global-map)' is the default parent
847 /* This function can GC */
849 struct gcpro gcpro1, gcpro2;
851 GCPRO2 (keymap, parents);
852 keymap = get_keymap (keymap, 1, 1);
854 if (KEYMAPP (parents)) /* backwards-compatibility */
855 parents = list1 (parents);
858 Lisp_Object tail = parents;
864 /* Require that it be an actual keymap object, rather than a symbol
865 with a (crockish) symbol-function which is a keymap */
866 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
871 /* Check for circularities */
872 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
874 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
879 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
880 Set the `name' of the KEYMAP to NEW-NAME.
881 The name is only a debugging convenience; it is not used except
882 when printing the keymap.
886 keymap = get_keymap (keymap, 1, 1);
888 XKEYMAP (keymap)->name = new_name;
892 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
893 Return the `name' of KEYMAP.
894 The name is only a debugging convenience; it is not used except
895 when printing the keymap.
899 keymap = get_keymap (keymap, 1, 1);
901 return XKEYMAP (keymap)->name;
904 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
905 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
906 if no prompt is desired. The prompt is shown in the echo-area
907 when reading a key-sequence to be looked-up in this keymap.
909 (keymap, new_prompt))
911 keymap = get_keymap (keymap, 1, 1);
913 if (!NILP (new_prompt))
914 CHECK_STRING (new_prompt);
916 XKEYMAP (keymap)->prompt = new_prompt;
921 keymap_prompt_mapper (Lisp_Object keymap, void *arg)
923 return XKEYMAP (keymap)->prompt;
927 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
928 Return the `prompt' of KEYMAP.
929 If non-nil, the prompt is shown in the echo-area
930 when reading a key-sequence to be looked-up in this keymap.
932 (keymap, use_inherited))
934 /* This function can GC */
937 keymap = get_keymap (keymap, 1, 1);
938 prompt = XKEYMAP (keymap)->prompt;
939 if (!NILP (prompt) || NILP (use_inherited))
942 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
945 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
946 Sets the default binding of KEYMAP to COMMAND, or `nil'
947 if no default is desired. The default-binding is returned when
948 no other binding for a key-sequence is found in the keymap.
949 If a keymap has a non-nil default-binding, neither the keymap's
950 parents nor the current global map are searched for key bindings.
954 /* This function can GC */
955 keymap = get_keymap (keymap, 1, 1);
957 XKEYMAP (keymap)->default_binding = command;
961 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
962 Return the default binding of KEYMAP, or `nil' if it has none.
963 The default-binding is returned when no other binding for a key-sequence
964 is found in the keymap.
965 If a keymap has a non-nil default-binding, neither the keymap's
966 parents nor the current global map are searched for key bindings.
970 /* This function can GC */
971 keymap = get_keymap (keymap, 1, 1);
972 return XKEYMAP (keymap)->default_binding;
975 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
976 Return t if ARG is a keymap object.
977 The keymap may be autoloaded first if necessary.
981 /* This function can GC */
982 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
985 /* Check that OBJECT is a keymap (after dereferencing through any
986 symbols). If it is, return it.
988 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
989 is an autoload form, do the autoload and try again.
990 If AUTOLOAD is nonzero, callers must assume GC is possible.
992 ERRORP controls how we respond if OBJECT isn't a keymap.
993 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
995 Note that most of the time, we don't want to pursue autoloads.
996 Functions like Faccessible_keymaps which scan entire keymap trees
997 shouldn't load every autoloaded keymap. I'm not sure about this,
998 but it seems to me that only read_key_sequence, Flookup_key, and
999 Fdefine_key should cause keymaps to be autoloaded. */
1002 get_keymap (Lisp_Object object, int errorp, int autoload)
1004 /* This function can GC */
1007 Lisp_Object tem = indirect_function (object, 0);
1011 /* Should we do an autoload? */
1013 /* (autoload "filename" doc nil keymap) */
1016 && EQ (XCAR (tem), Qautoload)
1017 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
1019 struct gcpro gcpro1, gcpro2;
1020 GCPRO2 (tem, object);
1021 do_autoload (tem, object);
1025 object = wrong_type_argument (Qkeymapp, object);
1031 /* Given OBJECT which was found in a slot in a keymap,
1032 trace indirect definitions to get the actual definition of that slot.
1033 An indirect definition is a list of the form
1034 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1035 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1038 get_keyelt (Lisp_Object object, int accept_default)
1040 /* This function can GC */
1044 if (!CONSP (object))
1048 struct gcpro gcpro1;
1050 map = XCAR (object);
1051 map = get_keymap (map, 0, 1);
1054 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1057 Lisp_Object idx = Fcdr (object);
1058 struct key_data indirection;
1062 event.event_type = empty_event;
1063 character_to_event (XCHAR (idx), &event,
1064 XCONSOLE (Vselected_console), 0, 0);
1065 indirection = event.event.key;
1067 else if (CONSP (idx))
1069 if (!INTP (XCDR (idx)))
1071 indirection.keysym = XCAR (idx);
1072 indirection.modifiers = (unsigned char) XINT (XCDR (idx));
1074 else if (SYMBOLP (idx))
1076 indirection.keysym = idx;
1077 indirection.modifiers = 0;
1084 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
1086 else if (STRINGP (XCAR (object)))
1088 /* If the keymap contents looks like (STRING . DEFN),
1090 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1091 will be used by HierarKey menus. */
1092 object = XCDR (object);
1097 /* Anything else is really the value. */
1103 keymap_lookup_1 (Lisp_Object keymap, const struct key_data *key,
1106 /* This function can GC */
1107 return get_keyelt (keymap_lookup_directly (keymap,
1108 key->keysym, key->modifiers),
1113 /************************************************************************/
1114 /* Copying keymaps */
1115 /************************************************************************/
1117 struct copy_keymap_inverse_closure
1119 Lisp_Object inverse_table;
1123 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value,
1124 void *copy_keymap_inverse_closure)
1126 struct copy_keymap_inverse_closure *closure =
1127 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
1129 /* copy-sequence deals with dotted lists. */
1131 value = Fcopy_list (value);
1132 Fputhash (key, value, closure->inverse_table);
1139 copy_keymap_internal (Lisp_Keymap *keymap)
1141 Lisp_Object nkm = make_keymap (0);
1142 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
1143 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1144 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1146 new_keymap->parents = Fcopy_sequence (keymap->parents);
1147 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1148 new_keymap->table = Fcopy_hash_table (keymap->table);
1149 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table);
1150 new_keymap->default_binding = keymap->default_binding;
1151 /* After copying the inverse map, we need to copy the conses which
1152 are its values, lest they be shared by the copy, and mangled.
1154 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
1155 ©_keymap_inverse_closure);
1160 static Lisp_Object copy_keymap (Lisp_Object keymap);
1162 struct copy_keymap_closure
1168 copy_keymap_mapper (Lisp_Object key, Lisp_Object value,
1169 void *copy_keymap_closure)
1171 /* This function can GC */
1172 struct copy_keymap_closure *closure =
1173 (struct copy_keymap_closure *) copy_keymap_closure;
1175 /* When we encounter a keymap which is indirected through a
1176 symbol, we need to copy the sub-map. In v18, the form
1177 (lookup-key (copy-keymap global-map) "\C-x")
1178 returned a new keymap, not the symbol 'Control-X-prefix.
1180 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */
1181 if (KEYMAPP (value))
1182 keymap_store_internal (key, closure->self,
1183 copy_keymap (value));
1188 copy_keymap (Lisp_Object keymap)
1190 /* This function can GC */
1191 struct copy_keymap_closure copy_keymap_closure;
1193 keymap = copy_keymap_internal (XKEYMAP (keymap));
1194 copy_keymap_closure.self = XKEYMAP (keymap);
1195 elisp_maphash (copy_keymap_mapper,
1196 XKEYMAP (keymap)->table,
1197 ©_keymap_closure);
1201 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1202 Return a copy of the keymap KEYMAP.
1203 The copy starts out with the same definitions of KEYMAP,
1204 but changing either the copy or KEYMAP does not affect the other.
1205 Any key definitions that are subkeymaps are recursively copied.
1209 /* This function can GC */
1210 keymap = get_keymap (keymap, 1, 1);
1211 return copy_keymap (keymap);
1216 keymap_fullness (Lisp_Object keymap)
1218 /* This function can GC */
1220 Lisp_Object sub_maps;
1221 struct gcpro gcpro1, gcpro2;
1223 keymap = get_keymap (keymap, 1, 1);
1224 fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table));
1225 GCPRO2 (keymap, sub_maps);
1226 for (sub_maps = keymap_submaps (keymap);
1228 sub_maps = XCDR (sub_maps))
1230 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
1232 Lisp_Object bucky_map = XCDR (XCAR (sub_maps));
1233 fullness--; /* don't count bucky maps themselves. */
1234 fullness += keymap_fullness (bucky_map);
1241 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1242 Return the number of bindings in the keymap.
1246 /* This function can GC */
1247 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
1251 /************************************************************************/
1252 /* Defining keys in keymaps */
1253 /************************************************************************/
1255 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1256 and perform any necessary canonicalization. */
1259 define_key_check_and_coerce_keysym (Lisp_Object spec,
1260 Lisp_Object *keysym,
1261 unsigned int modifiers)
1263 /* Now, check and massage the trailing keysym specifier. */
1264 if (SYMBOLP (*keysym))
1266 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
1268 Lisp_Object ream_gcc_up_the_ass =
1269 make_char (string_char (XSYMBOL (*keysym)->name, 0));
1270 *keysym = ream_gcc_up_the_ass;
1274 else if (CHAR_OR_CHAR_INTP (*keysym))
1276 CHECK_CHAR_COERCE_INT (*keysym);
1278 if (XCHAR (*keysym) < ' '
1279 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
1280 /* yuck! Can't make the above restriction; too many compatibility
1282 signal_simple_error ("keysym char must be printable", *keysym);
1283 /* #### This bites! I want to be able to write (control shift a) */
1284 if (modifiers & MOD_SHIFT)
1286 ("The `shift' modifier may not be applied to ASCII keysyms",
1291 signal_simple_error ("Unknown keysym specifier", *keysym);
1294 if (SYMBOLP (*keysym))
1296 char *name = (char *) string_data (XSYMBOL (*keysym)->name);
1298 /* FSFmacs uses symbols with the printed representation of keysyms in
1299 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1300 confusion, notice the M-x syntax and signal an error - because
1301 otherwise it would be interpreted as a regular keysym, and would even
1302 show up in the list-buffers output, causing confusion to the naive.
1304 We can get away with this because none of the X keysym names contain
1305 a hyphen (some contain underscore, however).
1307 It might be useful to reject keysyms which are not x-valid-keysym-
1308 name-p, but that would interfere with various tricks we do to
1309 sanitize the Sun keyboards, and would make it trickier to
1310 conditionalize a .emacs file for multiple X servers.
1312 if (((int) strlen (name) >= 2 && name[1] == '-')
1315 /* Ok, this is a bit more dubious - prevent people from doing things
1316 like (global-set-key 'RET 'something) because that will have the
1317 same problem as above. (Gag!) Maybe we should just silently
1318 accept these as aliases for the "real" names?
1320 (string_length (XSYMBOL (*keysym)->name) <= 3 &&
1321 (!strcmp (name, "LFD") ||
1322 !strcmp (name, "TAB") ||
1323 !strcmp (name, "RET") ||
1324 !strcmp (name, "ESC") ||
1325 !strcmp (name, "DEL") ||
1326 !strcmp (name, "SPC") ||
1327 !strcmp (name, "BS")))
1331 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1334 /* #### Ok, this is a bit more dubious - make people not lose if they
1335 do things like (global-set-key 'RET 'something) because that would
1336 otherwise have the same problem as above. (Gag!) We silently
1337 accept these as aliases for the "real" names.
1339 else if (!strncmp(name, "kp_", 3)) {
1340 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1343 strncpy(temp, name, sizeof (temp));
1344 temp[sizeof (temp) - 1] = '\0';
1346 *keysym = Fintern_soft(make_string((Bufbyte *)temp,
1349 } else if (EQ (*keysym, QLFD))
1350 *keysym = QKlinefeed;
1351 else if (EQ (*keysym, QTAB))
1353 else if (EQ (*keysym, QRET))
1355 else if (EQ (*keysym, QESC))
1357 else if (EQ (*keysym, QDEL))
1359 else if (EQ (*keysym, QSPC))
1361 else if (EQ (*keysym, QBS))
1362 *keysym = QKbackspace;
1363 /* Emacs compatibility */
1364 else if (EQ(*keysym, Qdown_mouse_1))
1366 else if (EQ(*keysym, Qdown_mouse_2))
1368 else if (EQ(*keysym, Qdown_mouse_3))
1370 else if (EQ(*keysym, Qdown_mouse_4))
1372 else if (EQ(*keysym, Qdown_mouse_5))
1374 else if (EQ(*keysym, Qmouse_1))
1375 *keysym = Qbutton1up;
1376 else if (EQ(*keysym, Qmouse_2))
1377 *keysym = Qbutton2up;
1378 else if (EQ(*keysym, Qmouse_3))
1379 *keysym = Qbutton3up;
1380 else if (EQ(*keysym, Qmouse_4))
1381 *keysym = Qbutton4up;
1382 else if (EQ(*keysym, Qmouse_5))
1383 *keysym = Qbutton5up;
1388 /* Given any kind of key-specifier, return a keysym and modifier mask.
1389 Proper canonicalization is performed:
1391 -- integers are converted into the equivalent characters.
1392 -- one-character strings are converted into the equivalent characters.
1396 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
1398 if (CHAR_OR_CHAR_INTP (spec))
1401 event.event_type = empty_event;
1402 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
1403 XCONSOLE (Vselected_console), 0, 0);
1404 returned_value->keysym = event.event.key.keysym;
1405 returned_value->modifiers = event.event.key.modifiers;
1407 else if (EVENTP (spec))
1409 switch (XEVENT (spec)->event_type)
1411 case key_press_event:
1413 returned_value->keysym = XEVENT (spec)->event.key.keysym;
1414 returned_value->modifiers = XEVENT (spec)->event.key.modifiers;
1417 case button_press_event:
1418 case button_release_event:
1420 int down = (XEVENT (spec)->event_type == button_press_event);
1421 switch (XEVENT (spec)->event.button.button)
1424 returned_value->keysym = (down ? Qbutton1 : Qbutton1up); break;
1426 returned_value->keysym = (down ? Qbutton2 : Qbutton2up); break;
1428 returned_value->keysym = (down ? Qbutton3 : Qbutton3up); break;
1430 returned_value->keysym = (down ? Qbutton4 : Qbutton4up); break;
1432 returned_value->keysym = (down ? Qbutton5 : Qbutton5up); break;
1434 returned_value->keysym = (down ? Qbutton6 : Qbutton6up); break;
1436 returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break;
1438 returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break;
1440 returned_value->modifiers = XEVENT (spec)->event.button.modifiers;
1444 signal_error (Qwrong_type_argument,
1445 list2 (build_translated_string
1446 ("unable to bind this type of event"),
1450 else if (SYMBOLP (spec))
1452 /* Be nice, allow = to mean (=) */
1453 if (bucky_sym_to_bucky_bit (spec) != 0)
1454 signal_simple_error ("Key is a modifier name", spec);
1455 define_key_check_and_coerce_keysym (spec, &spec, 0);
1456 returned_value->keysym = spec;
1457 returned_value->modifiers = 0;
1459 else if (CONSP (spec))
1461 unsigned int modifiers = 0;
1462 Lisp_Object keysym = Qnil;
1463 Lisp_Object rest = spec;
1465 /* First, parse out the leading modifier symbols. */
1466 while (CONSP (rest))
1468 unsigned int modifier;
1470 keysym = XCAR (rest);
1471 modifier = bucky_sym_to_bucky_bit (keysym);
1472 modifiers |= modifier;
1473 if (!NILP (XCDR (rest)))
1476 signal_simple_error ("Unknown modifier", keysym);
1481 signal_simple_error ("Nothing but modifiers here",
1488 signal_simple_error ("List must be nil-terminated", spec);
1490 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
1491 returned_value->keysym = keysym;
1492 returned_value->modifiers = modifiers;
1496 signal_simple_error ("Unknown key-sequence specifier",
1501 /* Used by character-to-event */
1503 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
1504 int allow_menu_events)
1506 struct key_data raw_key;
1508 if (allow_menu_events &&
1510 /* #### where the hell does this come from? */
1511 EQ (XCAR (list), Qmenu_selection))
1513 Lisp_Object fn, arg;
1514 if (! NILP (Fcdr (Fcdr (list))))
1515 signal_simple_error ("Invalid menu event desc", list);
1516 arg = Fcar (Fcdr (list));
1518 fn = Qcall_interactively;
1521 XSETFRAME (XEVENT (event)->channel, selected_frame ());
1522 XEVENT (event)->event_type = misc_user_event;
1523 XEVENT (event)->event.eval.function = fn;
1524 XEVENT (event)->event.eval.object = arg;
1528 define_key_parser (list, &raw_key);
1530 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) ||
1531 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) ||
1532 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) ||
1533 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) ||
1534 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) ||
1535 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) ||
1536 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) ||
1537 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up))
1538 error ("Mouse-clicks can't appear in saved keyboard macros.");
1540 XEVENT (event)->channel = Vselected_console;
1541 XEVENT (event)->event_type = key_press_event;
1542 XEVENT (event)->event.key.keysym = raw_key.keysym;
1543 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
1548 event_matches_key_specifier_p (Lisp_Event *event, Lisp_Object key_specifier)
1552 struct gcpro gcpro1;
1554 if (event->event_type != key_press_event || NILP (key_specifier) ||
1555 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
1558 /* if the specifier is an integer such as 27, then it should match
1559 both of the events 'escape' and 'control ['. Calling
1560 Fcharacter_to_event() will only match 'escape'. */
1561 if (CHAR_OR_CHAR_INTP (key_specifier))
1562 return (XCHAR_OR_CHAR_INT (key_specifier)
1563 == event_to_character (event, 0, 0, 0));
1565 /* Otherwise, we cannot call event_to_character() because we may
1566 be dealing with non-ASCII keystrokes. In any case, if I ask
1567 for 'control [' then I should get exactly that, and not
1570 However, we have to behave differently on TTY's, where 'control ['
1571 is silently converted into 'escape' by the keyboard driver.
1572 In this case, ASCII is the only thing we know about, so we have
1573 to compare the ASCII values. */
1576 event2 = Fmake_event (Qnil, Qnil);
1577 Fcharacter_to_event (key_specifier, event2, Qnil, Qnil);
1578 if (XEVENT (event2)->event_type != key_press_event)
1580 else if (CONSOLE_TTY_P (XCONSOLE (EVENT_CHANNEL (event))))
1584 ch1 = event_to_character (event, 0, 0, 0);
1585 ch2 = event_to_character (XEVENT (event2), 0, 0, 0);
1586 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1588 else if (EQ (event->event.key.keysym, XEVENT (event2)->event.key.keysym) &&
1589 event->event.key.modifiers == XEVENT (event2)->event.key.modifiers)
1593 Fdeallocate_event (event2);
1599 meta_prefix_char_p (const struct key_data *key)
1603 event.event_type = key_press_event;
1604 event.channel = Vselected_console;
1605 event.event.key.keysym = key->keysym;
1606 event.event.key.modifiers = key->modifiers;
1607 return event_matches_key_specifier_p (&event, Vmeta_prefix_char);
1610 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1611 Return non-nil if EVENT matches KEY-SPECIFIER.
1612 This can be useful, e.g., to determine if the user pressed `help-char' or
1615 (event, key_specifier))
1617 CHECK_LIVE_EVENT (event);
1618 return (event_matches_key_specifier_p (XEVENT (event), key_specifier)
1622 #define MACROLET(k,m) do { \
1623 returned_value->keysym = (k); \
1624 returned_value->modifiers = (m); \
1625 RETURN_SANS_WARNINGS; \
1629 Given a keysym, return another keysym/modifier pair which could be
1630 considered the same key in an ASCII world. Backspace returns ^H, for
1634 define_key_alternate_name (struct key_data *key,
1635 struct key_data *returned_value)
1637 Lisp_Object keysym = key->keysym;
1638 unsigned int modifiers = key->modifiers;
1639 unsigned int modifiers_sans_control = (modifiers & (~MOD_CONTROL));
1640 unsigned int modifiers_sans_meta = (modifiers & (~MOD_META));
1641 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1642 returned_value->modifiers = 0;
1643 if (modifiers_sans_meta == MOD_CONTROL)
1645 if EQ (keysym, QKspace)
1646 MACROLET (make_char ('@'), modifiers);
1647 else if (!CHARP (keysym))
1649 else switch (XCHAR (keysym))
1651 case '@': /* c-@ => c-space */
1652 MACROLET (QKspace, modifiers);
1653 case 'h': /* c-h => backspace */
1654 MACROLET (QKbackspace, modifiers_sans_control);
1655 case 'i': /* c-i => tab */
1656 MACROLET (QKtab, modifiers_sans_control);
1657 case 'j': /* c-j => linefeed */
1658 MACROLET (QKlinefeed, modifiers_sans_control);
1659 case 'm': /* c-m => return */
1660 MACROLET (QKreturn, modifiers_sans_control);
1661 case '[': /* c-[ => escape */
1662 MACROLET (QKescape, modifiers_sans_control);
1667 else if (modifiers_sans_meta != 0)
1669 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
1670 MACROLET (make_char ('h'), (modifiers | MOD_CONTROL));
1671 else if (EQ (keysym, QKtab)) /* tab => c-i */
1672 MACROLET (make_char ('i'), (modifiers | MOD_CONTROL));
1673 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
1674 MACROLET (make_char ('j'), (modifiers | MOD_CONTROL));
1675 else if (EQ (keysym, QKreturn)) /* return => c-m */
1676 MACROLET (make_char ('m'), (modifiers | MOD_CONTROL));
1677 else if (EQ (keysym, QKescape)) /* escape => c-[ */
1678 MACROLET (make_char ('['), (modifiers | MOD_CONTROL));
1686 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
1689 /* This function can GC */
1690 Lisp_Object new_keys;
1692 Lisp_Object mpc_binding;
1693 struct key_data meta_key;
1695 if (NILP (Vmeta_prefix_char) ||
1696 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
1699 define_key_parser (Vmeta_prefix_char, &meta_key);
1700 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
1701 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
1706 else if (STRINGP (keys))
1707 new_keys = Fsubstring (keys, Qzero, make_int (indx));
1708 else if (VECTORP (keys))
1710 new_keys = make_vector (indx, Qnil);
1711 for (i = 0; i < indx; i++)
1712 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
1717 if (EQ (keys, new_keys))
1718 error_with_frob (mpc_binding,
1719 "can't bind %s: %s has a non-keymap binding",
1720 (char *) XSTRING_DATA (Fkey_description (keys)),
1721 (char *) XSTRING_DATA (Fsingle_key_description
1722 (Vmeta_prefix_char)));
1724 error_with_frob (mpc_binding,
1725 "can't bind %s: %s %s has a non-keymap binding",
1726 (char *) XSTRING_DATA (Fkey_description (keys)),
1727 (char *) XSTRING_DATA (Fkey_description (new_keys)),
1728 (char *) XSTRING_DATA (Fsingle_key_description
1729 (Vmeta_prefix_char)));
1732 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
1733 Define key sequence KEYS, in KEYMAP, as DEF.
1734 KEYMAP is a keymap object.
1735 KEYS is the sequence of keystrokes to bind, described below.
1736 DEF is anything that can be a key's definition:
1737 nil (means key is undefined in this keymap);
1738 a command (a Lisp function suitable for interactive calling);
1739 a string or key sequence vector (treated as a keyboard macro);
1740 a keymap (to define a prefix key);
1741 a symbol; when the key is looked up, the symbol will stand for its
1742 function definition, that should at that time be one of the above,
1743 or another symbol whose function definition is used, and so on.
1744 a cons (STRING . DEFN), meaning that DEFN is the definition
1745 (DEFN should be a valid definition in its own right);
1746 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1748 Contrary to popular belief, the world is not ASCII. When running under a
1749 window manager, XEmacs can tell the difference between, for example, the
1750 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1751 bind different commands to each of these.
1753 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1754 set of modifiers (such as control and meta). A `keysym' is what is printed
1755 on the keys on your keyboard.
1757 A keysym may be represented by a symbol, or (if and only if it is equivalent
1758 to an ASCII character in the range 32 - 255) by a character or its equivalent
1759 ASCII code. The `A' key may be represented by the symbol `A', the character
1760 `?A', or by the number 65. The `break' key may be represented only by the
1763 A keystroke may be represented by a list: the last element of the list
1764 is the key (a symbol, character, or number, as above) and the
1765 preceding elements are the symbolic names of modifier keys (control,
1766 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1767 represented by the forms `(control b)', `(control ?b)', and `(control
1768 98)'. A keystroke may also be represented by an event object, as
1769 returned by the `next-command-event' and `read-key-sequence'
1772 Note that in this context, the keystroke `control-b' is *not* represented
1773 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1775 The `shift' modifier is somewhat of a special case. You should not (and
1776 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1777 have ASCII equivalents, the state of the shift key is implicit in the
1778 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1779 sort of thing varies from keyboard to keyboard. The shift modifier is for
1780 use only with characters that do not have a second keysym on the same key,
1781 such as `backspace' and `tab'.
1783 A key sequence is a vector of keystrokes. As a degenerate case, elements
1784 of this vector may also be keysyms if they have no modifiers. That is,
1785 the `A' keystroke is represented by all of these forms:
1786 A ?A 65 (A) (?A) (65)
1787 [A] [?A] [65] [(A)] [(?A)] [(65)]
1789 the `control-a' keystroke is represented by these forms:
1790 (control A) (control ?A) (control 65)
1791 [(control A)] [(control ?A)] [(control 65)]
1792 the key sequence `control-c control-a' is represented by these forms:
1793 [(control c) (control a)] [(control ?c) (control ?a)]
1794 [(control 99) (control 65)] etc.
1796 Mouse button clicks work just like keypresses: (control button1) means
1797 pressing the left mouse button while holding down the control key.
1798 \[(control c) (shift button3)] means control-c, hold shift, click right.
1800 Commands may be bound to the mouse-button up-stroke rather than the down-
1801 stroke as well. `button1' means the down-stroke, and `button1up' means the
1802 up-stroke. Different commands may be bound to the up and down strokes,
1803 though that is probably not what you want, so be careful.
1805 For backward compatibility, a key sequence may also be represented by a
1806 string. In this case, it represents the key sequence(s) that would
1807 produce that sequence of ASCII characters in a purely ASCII world. For
1808 example, a string containing the ASCII backspace character, "\\^H", would
1809 represent two key sequences: `(control h)' and `backspace'. Binding a
1810 command to this will actually bind both of those key sequences. Likewise
1811 for the following pairs:
1818 control @ control space
1820 After binding a command to two key sequences with a form like
1822 (define-key global-map "\\^X\\^I" \'command-1)
1824 it is possible to redefine only one of those sequences like so:
1826 (define-key global-map [(control x) (control i)] \'command-2)
1827 (define-key global-map [(control x) tab] \'command-3)
1829 Of course, all of this applies only when running under a window system. If
1830 you're talking to XEmacs through a TTY connection, you don't get any of
1833 (keymap, keys, def))
1835 /* This function can GC */
1840 struct gcpro gcpro1, gcpro2, gcpro3;
1843 len = XVECTOR_LENGTH (keys);
1844 else if (STRINGP (keys))
1845 len = XSTRING_CHAR_LENGTH (keys);
1846 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
1848 if (!CONSP (keys)) keys = list1 (keys);
1850 keys = make_vector (1, keys); /* this is kinda sleazy. */
1854 keys = wrong_type_argument (Qsequencep, keys);
1855 len = XINT (Flength (keys));
1860 GCPRO3 (keymap, keys, def);
1863 When the user defines a key which, in a strictly ASCII world, would be
1864 produced by two different keys (^J and linefeed, or ^H and backspace,
1865 for example) then the binding will be made for both keysyms.
1867 This is done if the user binds a command to a string, as in
1868 (define-key map "\^H" 'something), but not when using one of the new
1869 syntaxes, like (define-key map '(control h) 'something).
1871 ascii_hack = (STRINGP (keys));
1873 keymap = get_keymap (keymap, 1, 1);
1879 struct key_data raw_key1;
1880 struct key_data raw_key2;
1883 c = make_char (string_char (XSTRING (keys), idx));
1885 c = XVECTOR_DATA (keys) [idx];
1887 define_key_parser (c, &raw_key1);
1889 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
1891 if (idx == (len - 1))
1893 /* This is a hack to prevent a binding for the meta-prefix-char
1894 from being made in a map which already has a non-empty "meta"
1895 submap. That is, we can't let both "escape" and "meta" have
1896 a binding in the same keymap. This implies that the idiom
1897 (define-key my-map "\e" my-escape-map)
1898 (define-key my-escape-map "a" 'my-command)
1899 no longer works. That's ok. Instead the luser should do
1900 (define-key my-map "\ea" 'my-command)
1902 (define-key my-map "\M-a" 'my-command)
1904 (defvar my-escape-map (lookup-key my-map "\e"))
1905 if the luser really wants the map in a variable.
1907 Lisp_Object meta_map;
1908 struct gcpro ngcpro1;
1911 meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
1912 XKEYMAP (keymap)->table, Qnil);
1913 if (!NILP (meta_map)
1914 && keymap_fullness (meta_map) != 0)
1915 signal_simple_error_2
1916 ("Map contains meta-bindings, can't bind",
1917 Fsingle_key_description (Vmeta_prefix_char), keymap);
1929 define_key_alternate_name (&raw_key1, &raw_key2);
1932 raw_key2.keysym = Qnil;
1933 raw_key2.modifiers = 0;
1938 raw_key1.modifiers |= MOD_META;
1939 raw_key2.modifiers |= MOD_META;
1943 /* This crap is to make sure that someone doesn't bind something like
1944 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
1945 if (raw_key1.modifiers & MOD_META)
1946 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
1950 keymap_store (keymap, &raw_key1, def);
1951 if (ascii_hack && !NILP (raw_key2.keysym))
1952 keymap_store (keymap, &raw_key2, def);
1959 struct gcpro ngcpro1;
1962 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
1965 cmd = Fmake_sparse_keymap (Qnil);
1966 XKEYMAP (cmd)->name /* for debugging */
1967 = list2 (make_key_description (&raw_key1, 1), keymap);
1968 keymap_store (keymap, &raw_key1, cmd);
1970 if (NILP (Fkeymapp (cmd)))
1971 signal_simple_error_2 ("Invalid prefix keys in sequence",
1974 if (ascii_hack && !NILP (raw_key2.keysym) &&
1975 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
1976 keymap_store (keymap, &raw_key2, cmd);
1978 keymap = get_keymap (cmd, 1, 1);
1985 /************************************************************************/
1986 /* Looking up keys in keymaps */
1987 /************************************************************************/
1989 /* We need a very fast (i.e., non-consing) version of lookup-key in order
1990 to make where-is-internal really fly. */
1992 struct raw_lookup_key_mapper_closure
1995 const struct key_data *raw_keys;
2001 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
2003 /* Caller should gc-protect args (keymaps may autoload) */
2005 raw_lookup_key (Lisp_Object keymap,
2006 const struct key_data *raw_keys, int raw_keys_count,
2007 int keys_so_far, int accept_default)
2009 /* This function can GC */
2010 struct raw_lookup_key_mapper_closure c;
2011 c.remaining = raw_keys_count - 1;
2012 c.raw_keys = raw_keys;
2013 c.raw_keys_count = raw_keys_count;
2014 c.keys_so_far = keys_so_far;
2015 c.accept_default = accept_default;
2017 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
2021 raw_lookup_key_mapper (Lisp_Object k, void *arg)
2023 /* This function can GC */
2024 struct raw_lookup_key_mapper_closure *c =
2025 (struct raw_lookup_key_mapper_closure *) arg;
2026 int accept_default = c->accept_default;
2027 int remaining = c->remaining;
2028 int keys_so_far = c->keys_so_far;
2029 const struct key_data *raw_keys = c->raw_keys;
2032 if (! meta_prefix_char_p (&(raw_keys[0])))
2034 /* Normal case: every case except the meta-hack (see below). */
2035 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2038 /* Return whatever we found if we're out of keys */
2040 else if (NILP (cmd))
2041 /* Found nothing (though perhaps parent map may have binding) */
2043 else if (NILP (Fkeymapp (cmd)))
2044 /* Didn't find a keymap, and we have more keys.
2045 * Return a fixnum to indicate that keys were too long.
2047 cmd = make_int (keys_so_far + 1);
2049 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2050 keys_so_far + 1, accept_default);
2054 /* This is a hack so that looking up a key-sequence whose last
2055 * element is the meta-prefix-char will return the keymap that
2056 * the "meta" keys are stored in, if there is no binding for
2057 * the meta-prefix-char (and if this map has a "meta" submap).
2058 * If this map doesn't have a "meta" submap, then the
2059 * meta-prefix-char is looked up just like any other key.
2063 /* First look for the prefix-char directly */
2064 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2067 /* Do kludgy return of the meta-map */
2068 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
2069 XKEYMAP (k)->table, Qnil);
2074 /* Search for the prefix-char-prefixed sequence directly */
2075 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2076 cmd = get_keymap (cmd, 0, 1);
2078 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2079 keys_so_far + 1, accept_default);
2080 else if ((raw_keys[1].modifiers & MOD_META) == 0)
2082 struct key_data metified;
2083 metified.keysym = raw_keys[1].keysym;
2084 metified.modifiers = raw_keys[1].modifiers | MOD_META;
2086 /* Search for meta-next-char sequence directly */
2087 cmd = keymap_lookup_1 (k, &metified, accept_default);
2092 cmd = get_keymap (cmd, 0, 1);
2094 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
2101 if (accept_default && NILP (cmd))
2102 cmd = XKEYMAP (k)->default_binding;
2106 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2107 /* Caller should gc-protect arguments */
2109 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
2112 /* This function can GC */
2113 struct key_data kkk[20];
2114 struct key_data *raw_keys;
2120 if (nkeys < countof (kkk))
2123 raw_keys = alloca_array (struct key_data, nkeys);
2125 for (i = 0; i < nkeys; i++)
2127 define_key_parser (keys[i], &(raw_keys[i]));
2129 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
2133 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2136 /* This function can GC */
2137 struct key_data kkk[20];
2141 struct key_data *raw_keys;
2142 Lisp_Object tem = Qnil;
2143 struct gcpro gcpro1, gcpro2;
2146 CHECK_LIVE_EVENT (event_head);
2148 nkeys = event_chain_count (event_head);
2150 if (nkeys < countof (kkk))
2153 raw_keys = alloca_array (struct key_data, nkeys);
2156 EVENT_CHAIN_LOOP (event, event_head)
2157 define_key_parser (event, &(raw_keys[nkeys++]));
2158 GCPRO2 (keymaps[0], event_head);
2159 gcpro1.nvars = nmaps;
2160 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
2161 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
2162 for (iii = 0; iii < nmaps; iii++)
2164 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
2168 /* Too long in some local map means don't look at global map */
2172 else if (!NILP (tem))
2179 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
2180 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2181 Nil is returned if KEYS is unbound. See documentation of `define-key'
2182 for valid key definitions and key-sequence specifications.
2183 A number is returned if KEYS is "too long"; that is, the leading
2184 characters fail to be a valid sequence of prefix characters in KEYMAP.
2185 The number is how many characters at the front of KEYS
2186 it takes to reach a non-prefix command.
2188 (keymap, keys, accept_default))
2190 /* This function can GC */
2192 return lookup_keys (keymap,
2193 XVECTOR_LENGTH (keys),
2194 XVECTOR_DATA (keys),
2195 !NILP (accept_default));
2196 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
2197 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
2198 else if (STRINGP (keys))
2200 int length = XSTRING_CHAR_LENGTH (keys);
2202 struct key_data *raw_keys = alloca_array (struct key_data, length);
2206 for (i = 0; i < length; i++)
2208 Emchar n = string_char (XSTRING (keys), i);
2209 define_key_parser (make_char (n), &(raw_keys[i]));
2211 return raw_lookup_key (keymap, raw_keys, length, 0,
2212 !NILP (accept_default));
2216 keys = wrong_type_argument (Qsequencep, keys);
2217 return Flookup_key (keymap, keys, accept_default);
2221 /* Given a key sequence, returns a list of keymaps to search for bindings.
2222 Does all manner of semi-hairy heuristics, like looking in the current
2223 buffer's map before looking in the global map and looking in the local
2224 map of the buffer in which the mouse was clicked in event0 is a click.
2226 It would be kind of nice if this were in Lisp so that this semi-hairy
2227 semi-heuristic command-lookup behavior could be readily understood and
2228 customised. However, this needs to be pretty fast, or performance of
2229 keyboard macros goes to shit; putting this in lisp slows macros down
2230 2-3x. And they're already slower than v18 by 5-6x.
2233 struct relevant_maps
2236 unsigned int max_maps;
2238 struct gcpro *gcpro;
2241 static void get_relevant_extent_keymaps (Lisp_Object pos,
2242 Lisp_Object buffer_or_string,
2244 struct relevant_maps *closure);
2245 static void get_relevant_minor_maps (Lisp_Object buffer,
2246 struct relevant_maps *closure);
2249 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
2251 unsigned int nmaps = closure->nmaps;
2255 closure->nmaps = nmaps + 1;
2256 if (nmaps < closure->max_maps)
2258 closure->maps[nmaps] = map;
2259 closure->gcpro->nvars = nmaps;
2264 get_relevant_keymaps (Lisp_Object keys,
2265 int max_maps, Lisp_Object maps[])
2267 /* This function can GC */
2268 Lisp_Object terminal = Qnil;
2269 struct gcpro gcpro1;
2270 struct relevant_maps closure;
2271 struct console *con;
2276 closure.max_maps = max_maps;
2277 closure.maps = maps;
2278 closure.gcpro = &gcpro1;
2281 terminal = event_chain_tail (keys);
2282 else if (VECTORP (keys))
2284 int len = XVECTOR_LENGTH (keys);
2286 terminal = XVECTOR_DATA (keys)[len - 1];
2289 if (EVENTP (terminal))
2291 CHECK_LIVE_EVENT (terminal);
2292 con = event_console_or_selected (terminal);
2295 con = XCONSOLE (Vselected_console);
2297 if (KEYMAPP (con->overriding_terminal_local_map)
2298 || KEYMAPP (Voverriding_local_map))
2300 if (KEYMAPP (con->overriding_terminal_local_map))
2301 relevant_map_push (con->overriding_terminal_local_map, &closure);
2302 if (KEYMAPP (Voverriding_local_map))
2303 relevant_map_push (Voverriding_local_map, &closure);
2305 else if (!EVENTP (terminal)
2306 || (XEVENT (terminal)->event_type != button_press_event
2307 && XEVENT (terminal)->event_type != button_release_event))
2310 XSETBUFFER (tem, current_buffer);
2311 /* It's not a mouse event; order of keymaps searched is:
2312 o keymap of any/all extents under the mouse
2314 o local-map of current-buffer
2317 /* The terminal element of the lookup may be nil or a keysym.
2318 In those cases we don't want to check for an extent
2320 if (EVENTP (terminal))
2322 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
2323 tem, Qnil, &closure);
2325 get_relevant_minor_maps (tem, &closure);
2327 tem = current_buffer->keymap;
2329 relevant_map_push (tem, &closure);
2331 #ifdef HAVE_WINDOW_SYSTEM
2334 /* It's a mouse event; order of keymaps searched is:
2335 o vertical-divider-map, if event is over a divider
2336 o local-map of mouse-grabbed-buffer
2337 o keymap of any/all extents under the mouse
2338 if the mouse is over a modeline:
2339 o modeline-map of buffer corresponding to that modeline
2340 o else, local-map of buffer under the mouse
2342 o local-map of current-buffer
2345 Lisp_Object window = Fevent_window (terminal);
2347 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
2349 if (KEYMAPP (Vvertical_divider_map))
2350 relevant_map_push (Vvertical_divider_map, &closure);
2353 if (BUFFERP (Vmouse_grabbed_buffer))
2355 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
2357 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
2359 relevant_map_push (map, &closure);
2364 Lisp_Object buffer = Fwindow_buffer (window);
2368 if (!NILP (Fevent_over_modeline_p (terminal)))
2370 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
2373 get_relevant_extent_keymaps
2374 (Fevent_modeline_position (terminal),
2375 XBUFFER (buffer)->generated_modeline_string,
2376 Fevent_glyph_extent (terminal), &closure);
2378 if (!UNBOUNDP (map) && !NILP (map))
2379 relevant_map_push (get_keymap (map, 1, 1), &closure);
2383 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
2384 Fevent_glyph_extent (terminal),
2388 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
2390 Lisp_Object map = XBUFFER (buffer)->keymap;
2392 get_relevant_minor_maps (buffer, &closure);
2394 relevant_map_push (map, &closure);
2398 else if (!NILP (Fevent_over_toolbar_p (terminal)))
2400 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
2402 if (!UNBOUNDP (map) && !NILP (map))
2403 relevant_map_push (map, &closure);
2406 #endif /* HAVE_WINDOW_SYSTEM */
2409 int nmaps = closure.nmaps;
2410 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2411 if (nmaps >= max_maps && max_maps > 0)
2412 maps[max_maps - 1] = Vcurrent_global_map;
2414 maps[nmaps] = Vcurrent_global_map;
2420 /* Returns a set of keymaps extracted from the extents at POS in
2421 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2422 to look for a keymap in, and if it has one, its keymap will be the
2423 first element in the list returned. This is so we can correctly
2424 search the keymaps associated with glyphs which may be physically
2425 disjoint from their extents: for example, if a glyph is out in the
2426 margin, we should still consult the keymap of that glyph's extent,
2427 which may not itself be under the mouse.
2431 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
2433 struct relevant_maps *closure)
2435 /* This function can GC */
2436 /* the glyph keymap, if any, comes first.
2437 (Processing it twice is no big deal: noop.) */
2440 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
2442 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2445 /* Next check the extents at the text position, if any */
2449 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2451 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
2453 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
2455 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2462 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
2464 /* This function can GC */
2467 Lisp_Object sym = XCAR (assoc);
2470 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
2471 if (!NILP (val) && !UNBOUNDP (val))
2473 Lisp_Object map = get_keymap (XCDR (assoc), 0, 1);
2482 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
2484 /* This function can GC */
2487 /* Will you ever lose badly if you make this circular! */
2488 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
2490 alist = XCDR (alist))
2492 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
2494 if (!NILP (m)) relevant_map_push (m, closure);
2499 /* #### Would map-current-keymaps be a better thing?? */
2500 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2501 Return a list of the current keymaps that will be searched for bindings.
2502 This lists keymaps such as the current local map and the minor-mode maps,
2503 but does not list the parents of those keymaps.
2504 EVENT-OR-KEYS controls which keymaps will be listed.
2505 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2506 mouse event), the keymaps for that mouse event will be listed (see
2507 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2511 /* This function can GC */
2512 struct gcpro gcpro1;
2513 Lisp_Object maps[100];
2514 Lisp_Object *gubbish = maps;
2517 GCPRO1 (event_or_keys);
2518 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
2520 if (nmaps > countof (maps))
2522 gubbish = alloca_array (Lisp_Object, nmaps);
2523 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
2526 return Flist (nmaps, gubbish);
2529 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
2530 Return the binding for command KEYS in current keymaps.
2531 KEYS is a string, a vector of events, or a vector of key-description lists
2532 as described in the documentation for the `define-key' function.
2533 The binding is probably a symbol with a function definition; see
2534 the documentation for `lookup-key' for more information.
2536 For key-presses, the order of keymaps searched is:
2537 - the `keymap' property of any extent(s) at point;
2538 - any applicable minor-mode maps;
2539 - the current-local-map of the current-buffer;
2540 - the current global map.
2542 For mouse-clicks, the order of keymaps searched is:
2543 - the current-local-map of the `mouse-grabbed-buffer' if any;
2544 - vertical-divider-map, if the event happened over a vertical divider
2545 - the `keymap' property of any extent(s) at the position of the click
2546 (this includes modeline extents);
2547 - the modeline-map of the buffer corresponding to the modeline under
2548 the mouse (if the click happened over a modeline);
2549 - the value of toolbar-map in the current-buffer (if the click
2550 happened over a toolbar);
2551 - the current-local-map of the buffer under the mouse (does not
2552 apply to toolbar clicks);
2553 - any applicable minor-mode maps;
2554 - the current global map.
2556 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2557 is non-nil, *only* those two maps and the current global map are searched.
2559 (keys, accept_default))
2561 /* This function can GC */
2563 Lisp_Object maps[100];
2565 struct gcpro gcpro1, gcpro2;
2566 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
2568 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
2572 if (EVENTP (keys)) /* unadvertised "feature" for the future */
2573 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
2575 for (i = 0; i < nmaps; i++)
2577 Lisp_Object tem = Flookup_key (maps[i], keys,
2581 /* Too long in some local map means don't look at global map */
2584 else if (!NILP (tem))
2591 process_event_binding_result (Lisp_Object result)
2593 if (EQ (result, Qundefined))
2594 /* The suppress-keymap function binds keys to 'undefined - special-case
2595 that here, so that being bound to that has the same error-behavior as
2596 not being defined at all.
2602 /* Snap out possible keymap indirections */
2603 map = get_keymap (result, 0, 1);
2611 /* Attempts to find a command corresponding to the event-sequence
2612 whose head is event0 (sequence is threaded though event_next).
2614 The return value will be
2616 -- nil (there is no binding; this will also be returned
2617 whenever the event chain is "too long", i.e. there
2618 is a non-nil, non-keymap binding for a prefix of
2620 -- a keymap (part of a command has been specified)
2621 -- a command (anything that satisfies `commandp'; this includes
2622 some symbols, lists, subrs, strings, vectors, and
2623 compiled-function objects) */
2625 event_binding (Lisp_Object event0, int accept_default)
2627 /* This function can GC */
2628 Lisp_Object maps[100];
2631 assert (EVENTP (event0));
2633 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
2634 if (nmaps > countof (maps))
2635 nmaps = countof (maps);
2636 return process_event_binding_result (lookup_events (event0, nmaps, maps,
2640 /* like event_binding, but specify a keymap to search */
2643 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
2645 /* This function can GC */
2646 if (!KEYMAPP (keymap))
2649 return process_event_binding_result (lookup_events (event0, 1, &keymap,
2653 /* Attempts to find a function key mapping corresponding to the
2654 event-sequence whose head is event0 (sequence is threaded through
2655 event_next). The return value will be the same as for event_binding(). */
2657 munging_key_map_event_binding (Lisp_Object event0,
2658 enum munge_me_out_the_door munge)
2660 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2661 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
2662 Vkey_translation_map;
2667 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
2671 /************************************************************************/
2672 /* Setting/querying the global and local maps */
2673 /************************************************************************/
2675 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
2676 Select KEYMAP as the global keymap.
2680 /* This function can GC */
2681 keymap = get_keymap (keymap, 1, 1);
2682 Vcurrent_global_map = keymap;
2686 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
2687 Select KEYMAP as the local keymap in BUFFER.
2688 If KEYMAP is nil, that means no local keymap.
2689 If BUFFER is nil, the current buffer is assumed.
2693 /* This function can GC */
2694 struct buffer *b = decode_buffer (buffer, 0);
2696 keymap = get_keymap (keymap, 1, 1);
2703 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2704 Return BUFFER's local keymap, or nil if it has none.
2705 If BUFFER is nil, the current buffer is assumed.
2709 struct buffer *b = decode_buffer (buffer, 0);
2713 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2714 Return the current global keymap.
2718 return Vcurrent_global_map;
2722 /************************************************************************/
2723 /* Mapping over keymap elements */
2724 /************************************************************************/
2726 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2727 prefix key, it's not entirely obvious what map-keymap should do, but
2728 what it does is: map over all keys in this map; then recursively map
2729 over all submaps of this map that are "bucky" submaps. This means that,
2730 when mapping over a keymap, it appears that "x" and "C-x" are in the
2731 same map, although "C-x" is really in the "control" submap of this one.
2732 However, since we don't recursively descend the submaps that are bound
2733 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2734 those explicitly, if that's what they want.
2736 So the end result of this is that the bucky keymaps (the ones indexed
2737 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2738 invisible from elisp. They're just an implementation detail that code
2739 outside of this file doesn't need to know about.
2742 struct map_keymap_unsorted_closure
2744 void (*fn) (const struct key_data *, Lisp_Object binding, void *arg);
2746 unsigned int modifiers;
2749 /* used by map_keymap() */
2751 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value,
2752 void *map_keymap_unsorted_closure)
2754 /* This function can GC */
2755 struct map_keymap_unsorted_closure *closure =
2756 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
2757 unsigned int modifiers = closure->modifiers;
2758 unsigned int mod_bit;
2759 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
2762 int omod = modifiers;
2763 closure->modifiers = (modifiers | mod_bit);
2764 value = get_keymap (value, 1, 0);
2765 elisp_maphash (map_keymap_unsorted_mapper,
2766 XKEYMAP (value)->table,
2767 map_keymap_unsorted_closure);
2768 closure->modifiers = omod;
2772 struct key_data key;
2773 key.keysym = keysym;
2774 key.modifiers = modifiers;
2775 ((*closure->fn) (&key, value, closure->arg));
2781 struct map_keymap_sorted_closure
2783 Lisp_Object *result_locative;
2786 /* used by map_keymap_sorted() */
2788 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value,
2789 void *map_keymap_sorted_closure)
2791 struct map_keymap_sorted_closure *cl =
2792 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
2793 Lisp_Object *list = cl->result_locative;
2794 *list = Fcons (Fcons (key, value), *list);
2799 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2800 and keymap_submaps().
2803 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
2806 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2808 unsigned int bit1, bit2;
2814 if (EQ (obj1, obj2))
2816 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
2817 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
2819 /* If either is a symbol with a character-set-property, then sort it by
2820 that code instead of alphabetically.
2822 if (! bit1 && SYMBOLP (obj1))
2824 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
2825 if (CHAR_OR_CHAR_INTP (code))
2828 CHECK_CHAR_COERCE_INT (obj1);
2832 if (! bit2 && SYMBOLP (obj2))
2834 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
2835 if (CHAR_OR_CHAR_INTP (code))
2838 CHECK_CHAR_COERCE_INT (obj2);
2843 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2844 if (XTYPE (obj1) != XTYPE (obj2))
2845 return SYMBOLP (obj2) ? 1 : -1;
2847 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
2849 int o1 = XCHAR (obj1);
2850 int o2 = XCHAR (obj2);
2851 if (o1 == o2 && /* If one started out as a symbol and the */
2852 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
2853 return sym2_p ? 1 : -1;
2855 return o1 < o2 ? 1 : -1; /* else just compare them */
2858 /* else they're both symbols. If they're both buckys, then order them. */
2860 return bit1 < bit2 ? 1 : -1;
2862 /* if only one is a bucky, then it comes later */
2864 return bit2 ? 1 : -1;
2866 /* otherwise, string-sort them. */
2868 char *s1 = (char *) string_data (XSYMBOL (obj1)->name);
2869 char *s2 = (char *) string_data (XSYMBOL (obj2)->name);
2871 return 0 > strcoll (s1, s2) ? 1 : -1;
2873 return 0 > strcmp (s1, s2) ? 1 : -1;
2879 /* used by map_keymap() */
2881 map_keymap_sorted (Lisp_Object keymap_table,
2882 unsigned int modifiers,
2883 void (*function) (const struct key_data *key,
2884 Lisp_Object binding,
2885 void *map_keymap_sorted_closure),
2886 void *map_keymap_sorted_closure)
2888 /* This function can GC */
2889 struct gcpro gcpro1;
2890 Lisp_Object contents = Qnil;
2892 if (XINT (Fhash_table_count (keymap_table)) == 0)
2898 struct map_keymap_sorted_closure c1;
2899 c1.result_locative = &contents;
2900 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
2902 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
2903 for (; !NILP (contents); contents = XCDR (contents))
2905 Lisp_Object keysym = XCAR (XCAR (contents));
2906 Lisp_Object binding = XCDR (XCAR (contents));
2907 unsigned int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
2909 map_keymap_sorted (XKEYMAP (get_keymap (binding,
2911 (modifiers | sub_bits),
2913 map_keymap_sorted_closure);
2918 k.modifiers = modifiers;
2919 ((*function) (&k, binding, map_keymap_sorted_closure));
2926 /* used by Fmap_keymap() */
2928 map_keymap_mapper (const struct key_data *key,
2929 Lisp_Object binding,
2932 /* This function can GC */
2934 VOID_TO_LISP (fn, function);
2935 call2 (fn, make_key_description (key, 1), binding);
2940 map_keymap (Lisp_Object keymap_table, int sort_first,
2941 void (*function) (const struct key_data *key,
2942 Lisp_Object binding,
2946 /* This function can GC */
2948 map_keymap_sorted (keymap_table, 0, function, fn_arg);
2951 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
2952 map_keymap_unsorted_closure.fn = function;
2953 map_keymap_unsorted_closure.arg = fn_arg;
2954 map_keymap_unsorted_closure.modifiers = 0;
2955 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
2956 &map_keymap_unsorted_closure);
2960 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
2961 Apply FUNCTION to each element of KEYMAP.
2962 FUNCTION will be called with two arguments: a key-description list, and
2963 the binding. The order in which the elements of the keymap are passed to
2964 the function is unspecified. If the function inserts new elements into
2965 the keymap, it may or may not be called with them later. No element of
2966 the keymap will ever be passed to the function more than once.
2968 The function will not be called on elements of this keymap's parents
2969 \(see the function `keymap-parents') or upon keymaps which are contained
2970 within this keymap (multi-character definitions).
2971 It will be called on "meta" characters since they are not really
2972 two-character sequences.
2974 If the optional third argument SORT-FIRST is non-nil, then the elements of
2975 the keymap will be passed to the mapper function in a canonical order.
2976 Otherwise, they will be passed in hash (that is, random) order, which is
2979 (function, keymap, sort_first))
2981 /* This function can GC */
2982 struct gcpro gcpro1, gcpro2;
2984 /* tolerate obviously transposed args */
2985 if (!NILP (Fkeymapp (function)))
2987 Lisp_Object tmp = function;
2991 GCPRO2 (function, keymap);
2992 keymap = get_keymap (keymap, 1, 1);
2993 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
2994 map_keymap_mapper, LISP_TO_VOID (function));
3001 /************************************************************************/
3002 /* Accessible keymaps */
3003 /************************************************************************/
3005 struct accessible_keymaps_closure
3012 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
3013 unsigned int modifiers,
3014 struct accessible_keymaps_closure *closure)
3016 /* This function can GC */
3017 unsigned int subbits = MODIFIER_HASH_KEY_BITS (keysym);
3021 Lisp_Object submaps;
3023 contents = get_keymap (contents, 1, 1);
3024 submaps = keymap_submaps (contents);
3025 for (; !NILP (submaps); submaps = XCDR (submaps))
3027 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3028 XCDR (XCAR (submaps)),
3029 (subbits | modifiers),
3035 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3036 Lisp_Object cmd = get_keyelt (contents, 1);
3040 struct key_data key;
3041 key.keysym = keysym;
3042 key.modifiers = modifiers;
3046 cmd = get_keymap (cmd, 0, 1);
3050 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3051 len = XVECTOR_LENGTH (thisseq);
3052 for (j = 0; j < len; j++)
3053 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3054 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3056 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3062 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3064 /* This function can GC */
3065 struct accessible_keymaps_closure *closure =
3066 (struct accessible_keymaps_closure *) arg;
3067 Lisp_Object submaps = keymap_submaps (thismap);
3069 for (; !NILP (submaps); submaps = XCDR (submaps))
3071 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3072 XCDR (XCAR (submaps)),
3080 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3081 Find all keymaps accessible via prefix characters from KEYMAP.
3082 Returns a list of elements of the form (KEYS . MAP), where the sequence
3083 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3084 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3085 An optional argument PREFIX, if non-nil, should be a key sequence;
3086 then the value includes only maps for prefixes that start with PREFIX.
3090 /* This function can GC */
3091 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3092 Lisp_Object accessible_keymaps = Qnil;
3093 struct accessible_keymaps_closure c;
3095 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3097 keymap = get_keymap (keymap, 1, 1);
3102 prefix = make_vector (0, Qnil);
3104 else if (VECTORP (prefix) || STRINGP (prefix))
3106 int len = XINT (Flength (prefix));
3110 struct gcpro ngcpro1;
3118 def = Flookup_key (keymap, prefix, Qnil);
3119 def = get_keymap (def, 0, 1);
3124 p = make_vector (len, Qnil);
3126 for (iii = 0; iii < len; iii++)
3128 struct key_data key;
3129 define_key_parser (Faref (prefix, make_int (iii)), &key);
3130 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3137 prefix = wrong_type_argument (Qarrayp, prefix);
3141 accessible_keymaps = list1 (Fcons (prefix, keymap));
3143 /* For each map in the list maps, look at any other maps it points
3144 to and stick them at the end if they are not already in the list */
3146 for (c.tail = accessible_keymaps;
3148 c.tail = XCDR (c.tail))
3150 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3151 CHECK_KEYMAP (thismap);
3152 traverse_keymaps (thismap, Qnil,
3153 accessible_keymaps_keymap_mapper, &c);
3157 return accessible_keymaps;
3162 /************************************************************************/
3163 /* Pretty descriptions of key sequences */
3164 /************************************************************************/
3166 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3167 Return a pretty description of key-sequence KEYS.
3168 Control characters turn into "C-foo" sequences, meta into "M-foo",
3169 spaces are put between sequence elements, etc...
3173 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3176 return Fsingle_key_description (keys);
3178 else if (VECTORP (keys) ||
3181 Lisp_Object string = Qnil;
3182 /* Lisp_Object sep = Qnil; */
3183 int size = XINT (Flength (keys));
3186 for (i = 0; i < size; i++)
3188 Lisp_Object s2 = Fsingle_key_description
3190 ? make_char (string_char (XSTRING (keys), i))
3191 : XVECTOR_DATA (keys)[i]);
3197 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */;
3198 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3203 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3206 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3207 Return a pretty description of command character KEY.
3208 Control characters turn into C-whatever, etc.
3209 This differs from `text-char-description' in that it returns a description
3210 of a key read from the user rather than a character from a buffer.
3215 key = Fcons (key, Qnil); /* sleaze sleaze */
3217 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3223 event.event_type = empty_event;
3224 CHECK_CHAR_COERCE_INT (key);
3225 character_to_event (XCHAR (key), &event,
3226 XCONSOLE (Vselected_console), 0, 1);
3227 format_event_object (buf, &event, 1);
3230 format_event_object (buf, XEVENT (key), 1);
3231 return build_string (buf);
3240 LIST_LOOP (rest, key)
3242 Lisp_Object keysym = XCAR (rest);
3243 if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2;
3244 else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2;
3245 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3246 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3247 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3248 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3249 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3250 else if (CHAR_OR_CHAR_INTP (keysym))
3252 bufp += set_charptr_emchar ((Bufbyte *) bufp,
3253 XCHAR_OR_CHAR_INT (keysym));
3258 CHECK_SYMBOL (keysym);
3259 #if 0 /* This is bogus */
3260 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3261 else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB");
3262 else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET");
3263 else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC");
3264 else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL");
3265 else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC");
3266 else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS");
3269 strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name));
3270 if (!NILP (XCDR (rest)))
3271 signal_simple_error ("Invalid key description",
3275 return build_string (buf);
3277 return Fsingle_key_description
3278 (wrong_type_argument (intern ("char-or-event-p"), key));
3281 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3282 Return a pretty description of file-character CHR.
3283 Unprintable characters turn into "^char" or \\NNN, depending on the value
3284 of the `ctl-arrow' variable.
3285 This differs from `single-key-description' in that it returns a description
3286 of a character from a buffer rather than a key read from the user.
3293 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3294 int ctl_p = !NILP (ctl_arrow);
3295 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3296 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3297 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3302 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3305 signal_simple_continuable_error
3306 ("character has no ASCII equivalent", Fcopy_event (chr, Qnil));
3310 CHECK_CHAR_COERCE_INT (chr);
3315 if (c >= printable_min)
3317 p += set_charptr_emchar (p, c);
3319 else if (c < 040 && ctl_p)
3322 *p++ = c + 64; /* 'A' - 1 */
3329 else if (c >= 0200 || c < 040)
3333 /* !!#### This syntax is not readable. It will
3334 be interpreted as a 3-digit octal number rather
3335 than a 7-digit octal number. */
3338 *p++ = '0' + ((c & 07000000) >> 18);
3339 *p++ = '0' + ((c & 0700000) >> 15);
3340 *p++ = '0' + ((c & 070000) >> 12);
3341 *p++ = '0' + ((c & 07000) >> 9);
3344 *p++ = '0' + ((c & 0700) >> 6);
3345 *p++ = '0' + ((c & 0070) >> 3);
3346 *p++ = '0' + ((c & 0007));
3350 p += set_charptr_emchar (p, c);
3354 return build_string ((char *) buf);
3358 /************************************************************************/
3359 /* where-is (mapping bindings to keys) */
3360 /************************************************************************/
3363 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3364 Lisp_Object firstonly, char *target_buffer);
3366 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3367 Return list of keys that invoke DEFINITION in KEYMAPS.
3368 KEYMAPS can be either a keymap (meaning search in that keymap and the
3369 current global keymap) or a list of keymaps (meaning search in exactly
3370 those keymaps and no others). If KEYMAPS is nil, search in the currently
3371 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3372 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3374 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3375 the first key sequence found, rather than a list of all possible key
3378 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3379 to other keymaps or slots. This makes it possible to search for an
3380 indirect definition itself.
3382 (definition, keymaps, firstonly, noindirect, event_or_keys))
3384 /* This function can GC */
3385 Lisp_Object maps[100];
3386 Lisp_Object *gubbish = maps;
3389 /* Get keymaps as an array */
3392 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3394 if (nmaps > countof (maps))
3396 gubbish = alloca_array (Lisp_Object, nmaps);
3397 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3400 else if (CONSP (keymaps))
3405 nmaps = XINT (Flength (keymaps));
3406 if (nmaps > countof (maps))
3408 gubbish = alloca_array (Lisp_Object, nmaps);
3410 for (rest = keymaps, i = 0; !NILP (rest);
3411 rest = XCDR (keymaps), i++)
3413 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3419 gubbish[0] = get_keymap (keymaps, 1, 1);
3420 if (!EQ (gubbish[0], Vcurrent_global_map))
3422 gubbish[1] = Vcurrent_global_map;
3427 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3430 /* This function is like
3431 (key-description (where-is-internal definition nil t))
3432 except that it writes its output into a (char *) buffer that you
3433 provide; it doesn't cons (or allocate memory) at all, so it's
3434 very fast. This is used by menubar.c.
3437 where_is_to_char (Lisp_Object definition, char *buffer)
3439 /* This function can GC */
3440 Lisp_Object maps[100];
3441 Lisp_Object *gubbish = maps;
3444 /* Get keymaps as an array */
3445 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3446 if (nmaps > countof (maps))
3448 gubbish = alloca_array (Lisp_Object, nmaps);
3449 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3453 where_is_internal (definition, maps, nmaps, Qt, buffer);
3458 raw_keys_to_keys (struct key_data *keys, int count)
3460 Lisp_Object result = make_vector (count, Qnil);
3462 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3468 format_raw_keys (struct key_data *keys, int count, char *buf)
3472 event.event_type = key_press_event;
3473 event.channel = Vselected_console;
3474 for (i = 0; i < count; i++)
3476 event.event.key.keysym = keys[i].keysym;
3477 event.event.key.modifiers = keys[i].modifiers;
3478 format_event_object (buf, &event, 1);
3479 buf += strlen (buf);
3481 buf[0] = ' ', buf++;
3486 /* definition is the thing to look for.
3488 shadow is an array of shadow_count keymaps; if there is a different
3489 binding in any of the keymaps of a key that we are considering
3490 returning, then we reconsider.
3491 firstonly means give up after finding the first match;
3492 keys_so_far and modifiers_so_far describe which map we're looking in;
3493 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3494 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3495 will be MOD_META. That is, keys_so_far is the chain of keys that we
3496 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3499 (keys_so_far is a global buffer and the keys_count arg says how much
3500 of it we're currently interested in.)
3502 If target_buffer is provided, then we write a key-description into it,
3503 to avoid consing a string. This only works with firstonly on.
3506 struct where_is_closure
3508 Lisp_Object definition;
3509 Lisp_Object *shadow;
3513 unsigned int modifiers_so_far;
3514 char *target_buffer;
3515 struct key_data *keys_so_far;
3516 int keys_so_far_total_size;
3517 int keys_so_far_malloced;
3520 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3523 where_is_recursive_mapper (Lisp_Object map, void *arg)
3525 /* This function can GC */
3526 struct where_is_closure *c = (struct where_is_closure *) arg;
3527 Lisp_Object definition = c->definition;
3528 const int firstonly = c->firstonly;
3529 const unsigned int keys_count = c->keys_count;
3530 const unsigned int modifiers_so_far = c->modifiers_so_far;
3531 char *target_buffer = c->target_buffer;
3532 Lisp_Object keys = Fgethash (definition,
3533 XKEYMAP (map)->inverse_table,
3535 Lisp_Object submaps;
3536 Lisp_Object result = Qnil;
3540 /* One or more keys in this map match the definition we're looking for.
3541 Verify that these bindings aren't shadowed by other bindings
3542 in the shadow maps. Either nil or number as value from
3543 raw_lookup_key() means undefined. */
3544 struct key_data *so_far = c->keys_so_far;
3546 for (;;) /* loop over all keys that match */
3548 Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys;
3551 so_far [keys_count].keysym = k;
3552 so_far [keys_count].modifiers = modifiers_so_far;
3554 /* now loop over all shadow maps */
3555 for (i = 0; i < c->shadow_count; i++)
3557 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3562 if (NILP (shadowed) || CHARP (shadowed) ||
3563 EQ (shadowed, definition))
3564 continue; /* we passed this test; it's not shadowed here. */
3566 /* ignore this key binding, since it actually has a
3567 different binding in a shadowing map */
3568 goto c_doesnt_have_proper_loop_exit_statements;
3571 /* OK, the key is for real */
3574 if (!firstonly) abort ();
3575 format_raw_keys (so_far, keys_count + 1, target_buffer);
3576 return make_int (1);
3579 return raw_keys_to_keys (so_far, keys_count + 1);
3581 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3584 c_doesnt_have_proper_loop_exit_statements:
3585 /* now on to the next matching key ... */
3586 if (!CONSP (keys)) break;
3591 /* Now search the sub-keymaps of this map.
3592 If we're in "firstonly" mode and have already found one, this
3593 point is not reached. If we get one from lower down, either
3594 return it immediately (in firstonly mode) or tack it onto the
3595 end of the ones we've gotten so far.
3597 for (submaps = keymap_submaps (map);
3599 submaps = XCDR (submaps))
3601 Lisp_Object key = XCAR (XCAR (submaps));
3602 Lisp_Object submap = XCDR (XCAR (submaps));
3603 unsigned int lower_modifiers;
3604 int lower_keys_count = keys_count;
3607 submap = get_keymap (submap, 0, 0);
3609 if (EQ (submap, map))
3610 /* Arrgh! Some loser has introduced a loop... */
3613 /* If this is not a keymap, then that's probably because someone
3614 did an `fset' of a symbol that used to point to a map such that
3615 it no longer does. Sigh. Ignore this, and invalidate the cache
3616 so that it doesn't happen to us next time too.
3620 XKEYMAP (map)->sub_maps_cache = Qt;
3624 /* If the map is a "bucky" map, then add a bit to the
3625 modifiers_so_far list.
3626 Otherwise, add a new raw_key onto the end of keys_so_far.
3628 bucky = MODIFIER_HASH_KEY_BITS (key);
3630 lower_modifiers = (modifiers_so_far | bucky);
3633 struct key_data *so_far = c->keys_so_far;
3634 lower_modifiers = 0;
3635 so_far [lower_keys_count].keysym = key;
3636 so_far [lower_keys_count].modifiers = modifiers_so_far;
3640 if (lower_keys_count >= c->keys_so_far_total_size)
3642 int size = lower_keys_count + 50;
3643 if (! c->keys_so_far_malloced)
3645 struct key_data *new = xnew_array (struct key_data, size);
3646 memcpy ((void *)new, (const void *)c->keys_so_far,
3647 c->keys_so_far_total_size * sizeof (struct key_data));
3650 XREALLOC_ARRAY (c->keys_so_far, struct key_data, size);
3652 c->keys_so_far_total_size = size;
3653 c->keys_so_far_malloced = 1;
3659 c->keys_count = lower_keys_count;
3660 c->modifiers_so_far = lower_modifiers;
3662 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3664 c->keys_count = keys_count;
3665 c->modifiers_so_far = modifiers_so_far;
3668 result = nconc2 (lower, result);
3669 else if (!NILP (lower))
3678 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3679 Lisp_Object firstonly, char *target_buffer)
3681 /* This function can GC */
3682 Lisp_Object result = Qnil;
3684 struct key_data raw[20];
3685 struct where_is_closure c;
3687 c.definition = definition;
3689 c.firstonly = !NILP (firstonly);
3690 c.target_buffer = target_buffer;
3691 c.keys_so_far = raw;
3692 c.keys_so_far_total_size = countof (raw);
3693 c.keys_so_far_malloced = 0;
3695 /* Loop over each of the maps, accumulating the keys found.
3696 For each map searched, all previous maps shadow this one
3697 so that bogus keys aren't listed. */
3698 for (i = 0; i < nmaps; i++)
3700 Lisp_Object this_result;
3702 /* Reset the things set in each iteration */
3704 c.modifiers_so_far = 0;
3706 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3708 if (!NILP (firstonly))
3710 result = this_result;
3715 result = nconc2 (this_result, result);
3718 if (NILP (firstonly))
3719 result = Fnreverse (result);
3721 if (c.keys_so_far_malloced)
3722 xfree (c.keys_so_far);
3727 /************************************************************************/
3728 /* Describing keymaps */
3729 /************************************************************************/
3731 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3732 Insert a list of all defined keys and their definitions in MAP.
3733 Optional second argument ALL says whether to include even "uninteresting"
3734 definitions (ie symbols with a non-nil `suppress-keymap' property.
3735 Third argument SHADOW is a list of keymaps whose bindings shadow those
3736 of map; if a binding is present in any shadowing map, it is not printed.
3737 Fourth argument PREFIX, if non-nil, should be a key sequence;
3738 only bindings which start with that key sequence will be printed.
3739 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3741 (map, all, shadow, prefix, mouse_only_p))
3743 /* This function can GC */
3745 /* #### At some point, this function should be changed to accept a
3746 BUFFER argument. Currently, the BUFFER argument to
3747 describe_map_tree is being used only internally. */
3748 describe_map_tree (map, NILP (all), shadow, prefix,
3749 !NILP (mouse_only_p), Fcurrent_buffer ());
3754 /* Insert a description of the key bindings in STARTMAP,
3755 followed by those of all maps reachable through STARTMAP.
3756 If PARTIAL is nonzero, omit certain "uninteresting" commands
3757 (such as `undefined').
3758 If SHADOW is non-nil, it is a list of other maps;
3759 don't mention keys which would be shadowed by any of them
3760 If PREFIX is non-nil, only list bindings which start with those keys.
3764 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3765 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3767 /* This function can GC */
3768 Lisp_Object maps = Qnil;
3769 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3770 GCPRO2 (maps, shadow);
3772 maps = Faccessible_keymaps (startmap, prefix);
3774 for (; !NILP (maps); maps = Fcdr (maps))
3776 Lisp_Object sub_shadow = Qnil;
3777 Lisp_Object elt = Fcar (maps);
3779 int no_prefix = (VECTORP (Fcar (elt))
3780 && XINT (Flength (Fcar (elt))) == 0);
3781 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3782 NGCPRO3 (sub_shadow, elt, tail);
3784 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3786 Lisp_Object shmap = XCAR (tail);
3788 /* If the sequence by which we reach this keymap is zero-length,
3789 then the shadow maps for this keymap are just SHADOW. */
3792 /* If the sequence by which we reach this keymap actually has
3793 some elements, then the sequence's definition in SHADOW is
3794 what we should use. */
3797 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3804 Lisp_Object shm = get_keymap (shmap, 0, 1);
3805 /* If shmap is not nil and not a keymap, it completely
3806 shadows this map, so don't describe this map at all. */
3809 sub_shadow = Fcons (shm, sub_shadow);
3814 /* Describe the contents of map MAP, assuming that this map
3815 itself is reached by the sequence of prefix keys KEYS (a vector).
3816 PARTIAL and SHADOW are as in `describe_map_tree'. */
3817 Lisp_Object keysdesc
3819 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3821 describe_map (Fcdr (elt), keysdesc,
3836 describe_command (Lisp_Object definition, Lisp_Object buffer)
3838 /* This function can GC */
3839 int keymapp = !NILP (Fkeymapp (definition));
3840 struct gcpro gcpro1;
3841 GCPRO1 (definition);
3843 Findent_to (make_int (16), make_int (3), buffer);
3845 buffer_insert_c_string (XBUFFER (buffer), "<< ");
3847 if (SYMBOLP (definition))
3849 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3851 else if (STRINGP (definition) || VECTORP (definition))
3853 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: ");
3854 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3856 else if (COMPILED_FUNCTIONP (definition))
3857 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function");
3858 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
3859 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda");
3860 else if (KEYMAPP (definition))
3862 Lisp_Object name = XKEYMAP (definition)->name;
3863 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3865 buffer_insert_c_string (XBUFFER (buffer), "Prefix command ");
3867 && EQ (find_symbol_value (name), definition))
3868 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3871 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3875 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command");
3878 buffer_insert_c_string (XBUFFER (buffer), "??");
3881 buffer_insert_c_string (XBUFFER (buffer), " >>");
3882 buffer_insert_c_string (XBUFFER (buffer), "\n");
3886 struct describe_map_closure
3888 Lisp_Object *list; /* pointer to the list to update */
3889 Lisp_Object partial; /* whether to ignore suppressed commands */
3890 Lisp_Object shadow; /* list of maps shadowing this one */
3891 Lisp_Object self; /* this map */
3892 Lisp_Object self_root; /* this map, or some map that has this map as
3893 a parent. this is the base of the tree */
3894 int mice_only_p; /* whether we are to display only button bindings */
3897 struct describe_map_shadow_closure
3899 const struct key_data *raw_key;
3904 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3906 struct describe_map_shadow_closure *c =
3907 (struct describe_map_shadow_closure *) arg;
3909 if (EQ (map, c->self))
3910 return Qzero; /* Not shadowed; terminate search */
3912 return !NILP (keymap_lookup_directly (map,
3914 c->raw_key->modifiers))
3920 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3922 struct key_data *k = (struct key_data *) arg;
3923 return keymap_lookup_directly (km, k->keysym, k->modifiers);
3928 describe_map_mapper (const struct key_data *key,
3929 Lisp_Object binding,
3930 void *describe_map_closure)
3932 /* This function can GC */
3933 struct describe_map_closure *closure =
3934 (struct describe_map_closure *) describe_map_closure;
3935 Lisp_Object keysym = key->keysym;
3936 unsigned int modifiers = key->modifiers;
3938 /* Don't mention suppressed commands. */
3939 if (SYMBOLP (binding)
3940 && !NILP (closure->partial)
3941 && !NILP (Fget (binding, closure->partial, Qnil)))
3944 /* If we're only supposed to display mouse bindings and this isn't one,
3946 if (closure->mice_only_p &&
3947 (! (EQ (keysym, Qbutton0) ||
3948 EQ (keysym, Qbutton1) ||
3949 EQ (keysym, Qbutton2) ||
3950 EQ (keysym, Qbutton3) ||
3951 EQ (keysym, Qbutton4) ||
3952 EQ (keysym, Qbutton5) ||
3953 EQ (keysym, Qbutton6) ||
3954 EQ (keysym, Qbutton7) ||
3955 EQ (keysym, Qbutton0up) ||
3956 EQ (keysym, Qbutton1up) ||
3957 EQ (keysym, Qbutton2up) ||
3958 EQ (keysym, Qbutton3up) ||
3959 EQ (keysym, Qbutton4up) ||
3960 EQ (keysym, Qbutton5up) ||
3961 EQ (keysym, Qbutton6up) ||
3962 EQ (keysym, Qbutton7up))))
3965 /* If this command in this map is shadowed by some other map, ignore it. */
3969 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3972 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3973 keymap_lookup_inherited_mapper,
3974 /* Cast to discard `const' */
3980 /* If this key is in some map of which this map is a parent, then ignore
3981 it (in that case, it has been shadowed).
3985 struct describe_map_shadow_closure c;
3987 c.self = closure->self;
3989 sh = traverse_keymaps (closure->self_root, Qnil,
3990 describe_map_mapper_shadow_search, &c);
3991 if (!NILP (sh) && !ZEROP (sh))
3995 /* Otherwise add it to the list to be sorted. */
3996 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
4003 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
4006 /* obj1 and obj2 are conses of the form
4007 ( ( <keysym> . <modifiers> ) . <binding> )
4008 keysym and modifiers are used, binding is ignored.
4010 unsigned int bit1, bit2;
4013 bit1 = XINT (XCDR (obj1));
4014 bit2 = XINT (XCDR (obj2));
4016 return bit1 < bit2 ? 1 : -1;
4018 return map_keymap_sort_predicate (obj1, obj2, pred);
4021 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4022 or 2 or more symbolic keysyms that are bound to the same thing and
4023 have consecutive character-set-properties.
4026 elide_next_two_p (Lisp_Object list)
4030 if (NILP (XCDR (list)))
4033 /* next two bindings differ */
4034 if (!EQ (XCDR (XCAR (list)),
4035 XCDR (XCAR (XCDR (list)))))
4038 /* next two modifier-sets differ */
4039 if (!EQ (XCDR (XCAR (XCAR (list))),
4040 XCDR (XCAR (XCAR (XCDR (list))))))
4043 s1 = XCAR (XCAR (XCAR (list)));
4044 s2 = XCAR (XCAR (XCAR (XCDR (list))));
4048 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
4049 if (CHAR_OR_CHAR_INTP (code))
4052 CHECK_CHAR_COERCE_INT (s1);
4058 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
4059 if (CHAR_OR_CHAR_INTP (code))
4062 CHECK_CHAR_COERCE_INT (s2);
4067 return (XCHAR (s1) == XCHAR (s2) ||
4068 XCHAR (s1) + 1 == XCHAR (s2));
4073 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
4075 /* This function can GC */
4076 struct describe_map_closure *describe_map_closure =
4077 (struct describe_map_closure *) arg;
4078 describe_map_closure->self = keymap;
4079 map_keymap (XKEYMAP (keymap)->table,
4080 0, /* don't sort: we'll do it later */
4081 describe_map_mapper, describe_map_closure);
4086 /* Describe the contents of map MAP, assuming that this map itself is
4087 reached by the sequence of prefix keys KEYS (a string or vector).
4088 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4091 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
4092 void (*elt_describer) (Lisp_Object, Lisp_Object),
4098 /* This function can GC */
4099 struct describe_map_closure describe_map_closure;
4100 Lisp_Object list = Qnil;
4101 struct buffer *buf = XBUFFER (buffer);
4102 Emchar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
4103 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
4104 : ((EQ (buf->ctl_arrow, Qt)
4105 || EQ (buf->ctl_arrow, Qnil))
4108 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4110 keymap = get_keymap (keymap, 1, 1);
4111 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4112 describe_map_closure.shadow = shadow;
4113 describe_map_closure.list = &list;
4114 describe_map_closure.self_root = keymap;
4115 describe_map_closure.mice_only_p = mice_only_p;
4117 GCPRO4 (keymap, elt_prefix, shadow, list);
4119 traverse_keymaps (keymap, Qnil,
4120 describe_map_parent_mapper, &describe_map_closure);
4124 list = list_sort (list, Qnil, describe_map_sort_predicate);
4125 buffer_insert_c_string (buf, "\n");
4126 while (!NILP (list))
4128 Lisp_Object elt = XCAR (XCAR (list));
4129 Lisp_Object keysym = XCAR (elt);
4130 unsigned int modifiers = XINT (XCDR (elt));
4132 if (!NILP (elt_prefix))
4133 buffer_insert_lisp_string (buf, elt_prefix);
4135 if (modifiers & MOD_META) buffer_insert_c_string (buf, "M-");
4136 if (modifiers & MOD_CONTROL) buffer_insert_c_string (buf, "C-");
4137 if (modifiers & MOD_SUPER) buffer_insert_c_string (buf, "S-");
4138 if (modifiers & MOD_HYPER) buffer_insert_c_string (buf, "H-");
4139 if (modifiers & MOD_ALT) buffer_insert_c_string (buf, "Alt-");
4140 if (modifiers & MOD_SHIFT) buffer_insert_c_string (buf, "Sh-");
4141 if (SYMBOLP (keysym))
4143 Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil);
4144 Emchar c = (CHAR_OR_CHAR_INTP (code)
4145 ? XCHAR_OR_CHAR_INT (code) : (Emchar) -1);
4146 /* Calling Fsingle_key_description() would cons more */
4147 #if 0 /* This is bogus */
4148 if (EQ (keysym, QKlinefeed))
4149 buffer_insert_c_string (buf, "LFD");
4150 else if (EQ (keysym, QKtab))
4151 buffer_insert_c_string (buf, "TAB");
4152 else if (EQ (keysym, QKreturn))
4153 buffer_insert_c_string (buf, "RET");
4154 else if (EQ (keysym, QKescape))
4155 buffer_insert_c_string (buf, "ESC");
4156 else if (EQ (keysym, QKdelete))
4157 buffer_insert_c_string (buf, "DEL");
4158 else if (EQ (keysym, QKspace))
4159 buffer_insert_c_string (buf, "SPC");
4160 else if (EQ (keysym, QKbackspace))
4161 buffer_insert_c_string (buf, "BS");
4164 if (c >= printable_min)
4165 buffer_insert_emacs_char (buf, c);
4166 else buffer_insert1 (buf, Fsymbol_name (keysym));
4168 else if (CHARP (keysym))
4169 buffer_insert_emacs_char (buf, XCHAR (keysym));
4171 buffer_insert_c_string (buf, "---bad keysym---");
4179 while (elide_next_two_p (list))
4187 buffer_insert_c_string (buf, ", ");
4189 buffer_insert_c_string (buf, " .. ");
4195 /* Print a description of the definition of this character. */
4196 (*elt_describer) (XCDR (XCAR (list)), buffer);
4205 syms_of_keymap (void)
4207 INIT_LRECORD_IMPLEMENTATION (keymap);
4209 defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist");
4211 defsymbol (&Qkeymapp, "keymapp");
4213 defsymbol (&Qsuppress_keymap, "suppress-keymap");
4215 defsymbol (&Qmodeline_map, "modeline-map");
4216 defsymbol (&Qtoolbar_map, "toolbar-map");
4218 DEFSUBR (Fkeymap_parents);
4219 DEFSUBR (Fset_keymap_parents);
4220 DEFSUBR (Fkeymap_name);
4221 DEFSUBR (Fset_keymap_name);
4222 DEFSUBR (Fkeymap_prompt);
4223 DEFSUBR (Fset_keymap_prompt);
4224 DEFSUBR (Fkeymap_default_binding);
4225 DEFSUBR (Fset_keymap_default_binding);
4228 DEFSUBR (Fmake_keymap);
4229 DEFSUBR (Fmake_sparse_keymap);
4231 DEFSUBR (Fcopy_keymap);
4232 DEFSUBR (Fkeymap_fullness);
4233 DEFSUBR (Fmap_keymap);
4234 DEFSUBR (Fevent_matches_key_specifier_p);
4235 DEFSUBR (Fdefine_key);
4236 DEFSUBR (Flookup_key);
4237 DEFSUBR (Fkey_binding);
4238 DEFSUBR (Fuse_global_map);
4239 DEFSUBR (Fuse_local_map);
4240 DEFSUBR (Fcurrent_local_map);
4241 DEFSUBR (Fcurrent_global_map);
4242 DEFSUBR (Fcurrent_keymaps);
4243 DEFSUBR (Faccessible_keymaps);
4244 DEFSUBR (Fkey_description);
4245 DEFSUBR (Fsingle_key_description);
4246 DEFSUBR (Fwhere_is_internal);
4247 DEFSUBR (Fdescribe_bindings_internal);
4249 DEFSUBR (Ftext_char_description);
4251 defsymbol (&Qcontrol, "control");
4252 defsymbol (&Qctrl, "ctrl");
4253 defsymbol (&Qmeta, "meta");
4254 defsymbol (&Qsuper, "super");
4255 defsymbol (&Qhyper, "hyper");
4256 defsymbol (&Qalt, "alt");
4257 defsymbol (&Qshift, "shift");
4258 defsymbol (&Qbutton0, "button0");
4259 defsymbol (&Qbutton1, "button1");
4260 defsymbol (&Qbutton2, "button2");
4261 defsymbol (&Qbutton3, "button3");
4262 defsymbol (&Qbutton4, "button4");
4263 defsymbol (&Qbutton5, "button5");
4264 defsymbol (&Qbutton6, "button6");
4265 defsymbol (&Qbutton7, "button7");
4266 defsymbol (&Qbutton0up, "button0up");
4267 defsymbol (&Qbutton1up, "button1up");
4268 defsymbol (&Qbutton2up, "button2up");
4269 defsymbol (&Qbutton3up, "button3up");
4270 defsymbol (&Qbutton4up, "button4up");
4271 defsymbol (&Qbutton5up, "button5up");
4272 defsymbol (&Qbutton6up, "button6up");
4273 defsymbol (&Qbutton7up, "button7up");
4274 defsymbol (&Qmouse_1, "mouse-1");
4275 defsymbol (&Qmouse_2, "mouse-2");
4276 defsymbol (&Qmouse_3, "mouse-3");
4277 defsymbol (&Qmouse_4, "mouse-4");
4278 defsymbol (&Qmouse_5, "mouse-5");
4279 defsymbol (&Qdown_mouse_1, "down-mouse-1");
4280 defsymbol (&Qdown_mouse_2, "down-mouse-2");
4281 defsymbol (&Qdown_mouse_3, "down-mouse-3");
4282 defsymbol (&Qdown_mouse_4, "down-mouse-4");
4283 defsymbol (&Qdown_mouse_5, "down-mouse-5");
4284 defsymbol (&Qmenu_selection, "menu-selection");
4285 defsymbol (&QLFD, "LFD");
4286 defsymbol (&QTAB, "TAB");
4287 defsymbol (&QRET, "RET");
4288 defsymbol (&QESC, "ESC");
4289 defsymbol (&QDEL, "DEL");
4290 defsymbol (&QSPC, "SPC");
4291 defsymbol (&QBS, "BS");
4295 vars_of_keymap (void)
4297 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
4298 Meta-prefix character.
4299 This character followed by some character `foo' turns into `Meta-foo'.
4300 This can be any form recognized as a single key specifier.
4301 To disable the meta-prefix-char, set it to a negative number.
4303 Vmeta_prefix_char = make_char (033);
4305 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4306 A buffer which should be consulted first for all mouse activity.
4307 When a mouse-click is processed, it will first be looked up in the
4308 local-map of this buffer, and then through the normal mechanism if there
4309 is no binding for that click. This buffer's value of `mode-motion-hook'
4310 will be consulted instead of the `mode-motion-hook' of the buffer of the
4311 window under the mouse. You should *bind* this, not set it.
4313 Vmouse_grabbed_buffer = Qnil;
4315 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
4316 Keymap that overrides all other local keymaps.
4317 If this variable is non-nil, it is used as a keymap instead of the
4318 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4319 You should *bind* this, not set it.
4321 Voverriding_local_map = Qnil;
4323 Fset (Qminor_mode_map_alist, Qnil);
4325 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
4326 Keymap of key translations that can override keymaps.
4327 This keymap works like `function-key-map', but comes after that,
4328 and applies even for keys that have ordinary bindings.
4330 Vkey_translation_map = Qnil;
4332 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
4333 Keymap which handles mouse clicks over vertical dividers.
4335 Vvertical_divider_map = Qnil;
4337 DEFVAR_INT ("keymap-tick", &keymap_tick /*
4338 Incremented for each change to any keymap.
4342 staticpro (&Vcurrent_global_map);
4344 Vsingle_space_string = make_string ((const Bufbyte *) " ", 1);
4345 staticpro (&Vsingle_space_string);
4349 complex_vars_of_keymap (void)
4351 /* This function can GC */
4352 Lisp_Object ESC_prefix = intern ("ESC-prefix");
4353 Lisp_Object meta_disgustitute;
4355 Vcurrent_global_map = Fmake_keymap (Qnil);
4357 meta_disgustitute = Fmake_keymap (Qnil);
4358 Ffset (ESC_prefix, meta_disgustitute);
4359 /* no need to protect meta_disgustitute, though */
4360 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (MOD_META),
4361 XKEYMAP (Vcurrent_global_map),
4363 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
4365 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));