1 /* Manipulation of keymaps
2 Copyright (C) 1985, 1991-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Board of Trustees, University of Illinois.
4 Copyright (C) 1995 Sun Microsystems, Inc.
5 Totally redesigned by jwz in 1991.
7 This file is part of XEmacs.
9 XEmacs is free software; you can redistribute it and/or modify it
10 under the terms of the GNU General Public License as published by the
11 Free Software Foundation; either version 2, or (at your option) any
14 XEmacs is distributed in the hope that it will be useful, but WITHOUT
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
19 You should have received a copy of the GNU General Public License
20 along with XEmacs; see the file COPYING. If not, write to
21 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22 Boston, MA 02111-1307, USA. */
24 /* Synched up with: Mule 2.0. Not synched with FSF. Substantially
25 different from FSF. */
42 /* Hmm, under unix we want X modifiers, under NT we want X modifiers if
43 we are running X and Windows modifiers otherwise.
44 gak. This is a kludge until we support multiple native GUIs!
51 #include "events-mod.h"
54 /* A keymap contains six slots:
56 parents Ordered list of keymaps to search after
57 this one if no match is found.
58 Keymaps can thus be arranged in a hierarchy.
60 table A hash table, hashing keysyms to their bindings.
61 It will be one of the following:
63 -- a symbol, e.g. 'home
64 -- a character, representing something printable
65 (not ?\C-c meaning C-c, for instance)
66 -- an integer representing a modifier combination
68 inverse_table A hash table, hashing bindings to the list of keysyms
69 in this keymap which are bound to them. This is to make
70 the Fwhere_is_internal() function be fast. It needs to be
71 fast because we want to be able to call it in realtime to
72 update the keyboard-equivalents on the pulldown menus.
73 Values of the table are either atoms (keysyms)
74 or a dotted list of keysyms.
76 sub_maps_cache An alist; for each entry in this keymap whose binding is
77 a keymap (that is, Fkeymapp()) this alist associates that
78 keysym with that binding. This is used to optimize both
79 Fwhere_is_internal() and Faccessible_keymaps(). This slot
80 gets set to the symbol `t' every time a change is made to
81 this keymap, causing it to be recomputed when next needed.
83 prompt See `set-keymap-prompt'.
85 default_binding See `set-keymap-default-binding'.
87 Sequences of keys are stored in the obvious way: if the sequence of keys
88 "abc" was bound to some command `foo', the hierarchy would look like
90 keymap-1: associates "a" with keymap-2
91 keymap-2: associates "b" with keymap-3
92 keymap-3: associates "c" with foo
94 However, bucky bits ("modifiers" to the X-minded) are represented in the
95 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
96 Each combination of modifiers (e.g. control-hyper) gets its own submap
97 off of the main map. The hash key for a modifier combination is
98 an integer, computed by MAKE_MODIFIER_HASH_KEY().
100 If the key `C-a' was bound to some command, the hierarchy would look like
102 keymap-1: associates the integer MOD_CONTROL with keymap-2
103 keymap-2: associates "a" with the command
105 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
108 keymap-1: associates the integer (MOD_CONTROL | MOD_HYPER)
110 keymap-2: associates "a" with the command
112 Note that a special exception is made for the meta modifier, in order
113 to deal with ESC/meta lossage. Any key combination containing the
114 meta modifier is first indexed off of the main map into the meta
115 submap (with hash key MOD_META) and then indexed off of the
116 meta submap with the meta modifier removed from the key combination.
117 For example, when associating a command with C-M-H-a, we'd have
119 keymap-1: associates the integer MOD_META with keymap-2
120 keymap-2: associates the integer (MOD_CONTROL | MOD_HYPER)
122 keymap-3: associates "a" with the command
124 Note that keymap-2 might have normal bindings in it; these would be
125 for key combinations containing only the meta modifier, such as
126 M-y or meta-backspace.
128 If the command that "a" was bound to in keymap-3 was itself a keymap,
129 then that would make the key "C-M-H-a" be a prefix character.
131 Note that this new model of keymaps takes much of the magic away from
132 the Escape key: the value of the variable `esc-map' is no longer indexed
133 in the `global-map' under the ESC key. It's indexed under the integer
134 MOD_META. This is not user-visible, however; none of the "bucky"
137 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
138 and (define-key some-random-map "\^[" my-esc-map) work as before, for
141 Since keymaps are opaque, the only way to extract information from them
142 is with the functions lookup-key, key-binding, local-key-binding, and
143 global-key-binding, which work just as before, and the new function
144 map-keymap, which is roughly analagous to maphash.
146 Note that map-keymap perpetuates the illusion that the "bucky" submaps
147 don't exist: if you map over a keymap with bucky submaps, it will also
148 map over those submaps. It does not, however, map over other random
149 submaps of the keymap, just the bucky ones.
151 One implication of this is that when you map over `global-map', you will
152 also map over `esc-map'. It is merely for compatibility that the esc-map
153 is accessible at all; I think that's a bad thing, since it blurs the
154 distinction between ESC and "meta" even more. "M-x" is no more a two-
155 key sequence than "C-x" is.
159 typedef struct Lisp_Keymap
161 struct lcrecord_header header;
162 Lisp_Object parents; /* Keymaps to be searched after this one
164 Lisp_Object prompt; /* Qnil or a string to print in the minibuffer
165 * when reading from this keymap */
167 Lisp_Object table; /* The contents of this keymap */
168 Lisp_Object inverse_table; /* The inverse mapping of the above */
170 Lisp_Object default_binding; /* Use this if no other binding is found
171 * (this overrides parent maps and the
172 * normal global-map lookup). */
175 Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps;
176 This holds an alist, of the key and the
177 maps, or the modifier bit and the map.
178 If this is the symbol t, then the cache
179 needs to be recomputed.
181 int fullness; /* How many entries there are in this table.
182 This should be the same as the fullness
183 of the `table', but hash.c is broken. */
184 Lisp_Object name; /* Just for debugging convenience */
187 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
188 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
192 /* Actually allocate storage for these variables */
194 static Lisp_Object Vcurrent_global_map; /* Always a keymap */
196 static Lisp_Object Vmouse_grabbed_buffer;
198 /* Alist of minor mode variables and keymaps. */
199 static Lisp_Object Qminor_mode_map_alist;
201 static Lisp_Object Voverriding_local_map;
203 static Lisp_Object Vkey_translation_map;
205 static Lisp_Object Vvertical_divider_map;
207 /* This is incremented whenever a change is made to a keymap. This is
208 so that things which care (such as the menubar code) can recompute
209 privately-cached data when the user has changed keybindings.
213 /* Prefixing a key with this character is the same as sending a meta bit. */
214 Lisp_Object Vmeta_prefix_char;
216 Lisp_Object Qkeymapp;
217 Lisp_Object Vsingle_space_string;
218 Lisp_Object Qsuppress_keymap;
219 Lisp_Object Qmodeline_map;
220 Lisp_Object Qtoolbar_map;
222 EXFUN (Fkeymap_fullness, 1);
223 EXFUN (Fset_keymap_name, 2);
224 EXFUN (Fsingle_key_description, 1);
226 static void describe_command (Lisp_Object definition, Lisp_Object buffer);
227 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
228 void (*elt_describer) (Lisp_Object, Lisp_Object),
234 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
235 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3;
236 Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7;
237 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up;
238 Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up;
240 Lisp_Object Qmenu_selection;
241 /* Emacs compatibility */
242 Lisp_Object Qdown_mouse_1, Qdown_mouse_2, Qdown_mouse_3, Qdown_mouse_4,
244 Lisp_Object Qmouse_1, Qmouse_2, Qmouse_3, Qmouse_4, Qmouse_5;
246 /* Kludge kludge kludge */
247 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
250 /************************************************************************/
251 /* The keymap Lisp object */
252 /************************************************************************/
255 mark_keymap (Lisp_Object obj, void (*markobj) (Lisp_Object))
257 Lisp_Keymap *keymap = XKEYMAP (obj);
258 markobj (keymap->parents);
259 markobj (keymap->prompt);
260 markobj (keymap->inverse_table);
261 markobj (keymap->sub_maps_cache);
262 markobj (keymap->default_binding);
263 markobj (keymap->name);
264 return keymap->table;
268 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
270 /* This function can GC */
271 Lisp_Keymap *keymap = XKEYMAP (obj);
273 int size = XINT (Fkeymap_fullness (obj));
275 error ("printing unreadable object #<keymap 0x%x>", keymap->header.uid);
276 write_c_string ("#<keymap ", printcharfun);
277 if (!NILP (keymap->name))
278 print_internal (keymap->name, printcharfun, 1);
279 /* #### Yuck! This is no way to form plural! --hniksic */
280 sprintf (buf, "%s%d entr%s 0x%x>",
281 ((NILP (keymap->name)) ? "" : " "),
283 ((size == 1) ? "y" : "ies"),
285 write_c_string (buf, printcharfun);
288 /* No need for keymap_equal #### Why not? */
289 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap,
290 mark_keymap, print_keymap, 0, 0, 0,
293 /************************************************************************/
294 /* Traversing keymaps and their parents */
295 /************************************************************************/
298 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents,
299 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg),
302 /* This function can GC */
304 Lisp_Object tail = start_parents;
305 Lisp_Object malloc_sucks[10];
306 Lisp_Object malloc_bites = Qnil;
308 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
309 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail);
312 start_keymap = get_keymap (start_keymap, 1, 1);
313 keymap = start_keymap;
314 /* Hack special-case parents at top-level */
315 tail = ((!NILP (tail)) ? tail : XKEYMAP (keymap)->parents);
322 result = ((mapper) (keymap, mapper_arg));
325 while (CONSP (malloc_bites))
327 struct Lisp_Cons *victim = XCONS (malloc_bites);
328 malloc_bites = victim->cdr;
336 if (stack_depth == 0)
339 return Qnil; /* Nothing found */
342 if (CONSP (malloc_bites))
344 struct Lisp_Cons *victim = XCONS (malloc_bites);
346 malloc_bites = victim->cdr;
351 tail = malloc_sucks[stack_depth];
352 gcpro1.nvars = stack_depth;
354 keymap = XCAR (tail);
361 keymap = XCAR (tail);
363 parents = XKEYMAP (keymap)->parents;
364 if (!CONSP (parents))
366 else if (NILP (tail))
371 if (CONSP (malloc_bites))
372 malloc_bites = noseeum_cons (tail, malloc_bites);
373 else if (stack_depth < countof (malloc_sucks))
375 malloc_sucks[stack_depth++] = tail;
376 gcpro1.nvars = stack_depth;
380 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */
382 for (i = 0, malloc_bites = Qnil;
383 i < countof (malloc_sucks);
385 malloc_bites = noseeum_cons (malloc_sucks[i],
392 keymap = get_keymap (keymap, 1, 1);
393 if (EQ (keymap, start_keymap))
395 signal_simple_error ("Cyclic keymap indirection",
402 /************************************************************************/
403 /* Some low-level functions */
404 /************************************************************************/
407 bucky_sym_to_bucky_bit (Lisp_Object sym)
409 if (EQ (sym, Qcontrol)) return MOD_CONTROL;
410 if (EQ (sym, Qmeta)) return MOD_META;
411 if (EQ (sym, Qsuper)) return MOD_SUPER;
412 if (EQ (sym, Qhyper)) return MOD_HYPER;
413 if (EQ (sym, Qalt)) return MOD_ALT;
414 if (EQ (sym, Qsymbol)) return MOD_ALT; /* #### - reverse compat */
415 if (EQ (sym, Qshift)) return MOD_SHIFT;
421 control_meta_superify (Lisp_Object frob, unsigned int modifiers)
425 frob = Fcons (frob, Qnil);
426 if (modifiers & MOD_SHIFT) frob = Fcons (Qshift, frob);
427 if (modifiers & MOD_ALT) frob = Fcons (Qalt, frob);
428 if (modifiers & MOD_HYPER) frob = Fcons (Qhyper, frob);
429 if (modifiers & MOD_SUPER) frob = Fcons (Qsuper, frob);
430 if (modifiers & MOD_CONTROL) frob = Fcons (Qcontrol, frob);
431 if (modifiers & MOD_META) frob = Fcons (Qmeta, frob);
436 make_key_description (CONST struct key_data *key, int prettify)
438 Lisp_Object keysym = key->keysym;
439 unsigned int modifiers = key->modifiers;
441 if (prettify && CHARP (keysym))
443 /* This is a little slow, but (control a) is prettier than (control 65).
444 It's now ok to do this for digit-chars too, since we've fixed the
445 bug where \9 read as the integer 9 instead of as the symbol with
448 /* !!#### I'm not sure how correct this is. */
449 Bufbyte str [1 + MAX_EMCHAR_LEN];
450 Bytecount count = set_charptr_emchar (str, XCHAR (keysym));
452 keysym = intern ((char *) str);
454 return control_meta_superify (keysym, modifiers);
458 /************************************************************************/
459 /* Low-level keymap-store functions */
460 /************************************************************************/
463 raw_lookup_key (Lisp_Object keymap,
464 CONST struct key_data *raw_keys, int raw_keys_count,
465 int keys_so_far, int accept_default);
467 /* Relies on caller to gc-protect args */
469 keymap_lookup_directly (Lisp_Object keymap,
470 Lisp_Object keysym, unsigned int modifiers)
474 if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
475 | MOD_ALT | MOD_SHIFT)) != 0)
478 k = XKEYMAP (keymap);
480 /* If the keysym is a one-character symbol, use the char code instead. */
481 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
483 Lisp_Object i_fart_on_gcc =
484 make_char (string_char (XSYMBOL (keysym)->name, 0));
485 keysym = i_fart_on_gcc;
488 if (modifiers & MOD_META) /* Utterly hateful ESC lossage */
490 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
494 k = XKEYMAP (submap);
495 modifiers &= ~MOD_META;
500 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
504 k = XKEYMAP (submap);
506 return Fgethash (keysym, k->table, Qnil);
510 keymap_store_inverse_internal (Lisp_Object inverse_table,
514 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
519 /* Don't cons this unless necessary */
520 /* keys = Fcons (keysym, Qnil); */
521 Fputhash (value, keys, inverse_table);
523 else if (!CONSP (keys))
525 /* Now it's necessary to cons */
526 keys = Fcons (keys, keysym);
527 Fputhash (value, keys, inverse_table);
531 while (CONSP (XCDR (keys)))
533 XCDR (keys) = Fcons (XCDR (keys), keysym);
534 /* No need to call puthash because we've destructively
535 modified the list tail in place */
541 keymap_delete_inverse_internal (Lisp_Object inverse_table,
545 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
546 Lisp_Object new_keys = keys;
553 for (prev = &new_keys, tail = new_keys;
555 prev = &(XCDR (tail)), tail = XCDR (tail))
557 if (EQ (tail, keysym))
562 else if (EQ (keysym, XCAR (tail)))
570 Fremhash (value, inverse_table);
571 else if (!EQ (keys, new_keys))
572 /* Removed the first elt */
573 Fputhash (value, new_keys, inverse_table);
574 /* else the list's tail has been modified, so we don't need to
575 touch the hash table again (the pointer in there is ok).
581 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
584 Lisp_Object prev_value = Fgethash (keysym, keymap->table, Qnil);
586 if (EQ (prev_value, value))
588 if (!NILP (prev_value))
589 keymap_delete_inverse_internal (keymap->inverse_table,
594 if (keymap->fullness < 0) abort ();
595 Fremhash (keysym, keymap->table);
599 if (NILP (prev_value))
601 Fputhash (keysym, value, keymap->table);
602 keymap_store_inverse_internal (keymap->inverse_table,
610 create_bucky_submap (Lisp_Keymap *k, unsigned int modifiers,
611 Lisp_Object parent_for_debugging_info)
613 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
614 /* User won't see this, but it is nice for debugging Emacs */
615 XKEYMAP (submap)->name
616 = control_meta_superify (parent_for_debugging_info, modifiers);
617 /* Invalidate cache */
618 k->sub_maps_cache = Qt;
619 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
624 /* Relies on caller to gc-protect keymap, keysym, value */
626 keymap_store (Lisp_Object keymap, CONST struct key_data *key,
629 Lisp_Object keysym = key->keysym;
630 unsigned int modifiers = key->modifiers;
633 if ((modifiers & ~(MOD_CONTROL | MOD_META | MOD_SUPER | MOD_HYPER
634 | MOD_ALT | MOD_SHIFT)) != 0)
637 k = XKEYMAP (keymap);
639 /* If the keysym is a one-character symbol, use the char code instead. */
640 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
642 Lisp_Object run_the_gcc_developers_over_with_a_steamroller =
643 make_char (string_char (XSYMBOL (keysym)->name, 0));
644 keysym = run_the_gcc_developers_over_with_a_steamroller;
647 if (modifiers & MOD_META) /* Utterly hateful ESC lossage */
649 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
652 submap = create_bucky_submap (k, MOD_META, keymap);
653 k = XKEYMAP (submap);
654 modifiers &= ~MOD_META;
659 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
662 submap = create_bucky_submap (k, modifiers, keymap);
663 k = XKEYMAP (submap);
665 k->sub_maps_cache = Qt; /* Invalidate cache */
666 keymap_store_internal (keysym, k, value);
670 /************************************************************************/
671 /* Listing the submaps of a keymap */
672 /************************************************************************/
674 struct keymap_submaps_closure
676 Lisp_Object *result_locative;
680 keymap_submaps_mapper_0 (Lisp_Object key, Lisp_Object value,
681 void *keymap_submaps_closure)
683 /* This function can GC */
684 /* Perform any autoloads, etc */
690 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value,
691 void *keymap_submaps_closure)
693 /* This function can GC */
694 Lisp_Object *result_locative;
695 struct keymap_submaps_closure *cl =
696 (struct keymap_submaps_closure *) keymap_submaps_closure;
697 result_locative = cl->result_locative;
699 if (!NILP (Fkeymapp (value)))
700 *result_locative = Fcons (Fcons (key, value), *result_locative);
704 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
708 keymap_submaps (Lisp_Object keymap)
710 /* This function can GC */
711 Lisp_Keymap *k = XKEYMAP (keymap);
713 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
715 Lisp_Object result = Qnil;
716 struct gcpro gcpro1, gcpro2;
717 struct keymap_submaps_closure keymap_submaps_closure;
719 GCPRO2 (keymap, result);
720 keymap_submaps_closure.result_locative = &result;
721 /* Do this first pass to touch (and load) any autoloaded maps */
722 elisp_maphash (keymap_submaps_mapper_0, k->table,
723 &keymap_submaps_closure);
725 elisp_maphash (keymap_submaps_mapper, k->table,
726 &keymap_submaps_closure);
727 /* keep it sorted so that the result of accessible-keymaps is ordered */
728 k->sub_maps_cache = list_sort (result,
730 map_keymap_sort_predicate);
733 return k->sub_maps_cache;
737 /************************************************************************/
738 /* Basic operations on keymaps */
739 /************************************************************************/
742 make_keymap (size_t size)
745 Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, lrecord_keymap);
747 XSETKEYMAP (result, keymap);
749 keymap->parents = Qnil;
750 keymap->prompt = Qnil;
751 keymap->table = Qnil;
752 keymap->inverse_table = Qnil;
753 keymap->default_binding = Qnil;
754 keymap->sub_maps_cache = Qnil; /* No possible submaps */
755 keymap->fullness = 0;
758 if (size != 0) /* hack for copy-keymap */
761 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
762 /* Inverse table is often less dense because of duplicate key-bindings.
763 If not, it will grow anyway. */
764 keymap->inverse_table =
765 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
770 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
771 Construct and return a new keymap object.
772 All entries in it are nil, meaning "command undefined".
774 Optional argument NAME specifies a name to assign to the keymap,
775 as in `set-keymap-name'. This name is only a debugging convenience;
776 it is not used except when printing the keymap.
780 Lisp_Object keymap = make_keymap (60);
782 Fset_keymap_name (keymap, name);
786 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
787 Construct and return a new keymap object.
788 All entries in it are nil, meaning "command undefined". The only
789 difference between this function and make-keymap is that this function
790 returns a "smaller" keymap (one that is expected to contain fewer
791 entries). As keymaps dynamically resize, the distinction is not great.
793 Optional argument NAME specifies a name to assign to the keymap,
794 as in `set-keymap-name'. This name is only a debugging convenience;
795 it is not used except when printing the keymap.
799 Lisp_Object keymap = make_keymap (8);
801 Fset_keymap_name (keymap, name);
805 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
806 Return the `parent' keymaps of KEYMAP, or nil.
807 The parents of a keymap are searched for keybindings when a key sequence
808 isn't bound in this one. `(current-global-map)' is the default parent
813 keymap = get_keymap (keymap, 1, 1);
814 return Fcopy_sequence (XKEYMAP (keymap)->parents);
820 traverse_keymaps_noop (Lisp_Object keymap, void *arg)
825 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
826 Set the `parent' keymaps of KEYMAP to PARENTS.
827 The parents of a keymap are searched for keybindings when a key sequence
828 isn't bound in this one. `(current-global-map)' is the default parent
833 /* This function can GC */
835 struct gcpro gcpro1, gcpro2;
837 GCPRO2 (keymap, parents);
838 keymap = get_keymap (keymap, 1, 1);
840 if (KEYMAPP (parents)) /* backwards-compatibility */
841 parents = list1 (parents);
844 Lisp_Object tail = parents;
850 /* Require that it be an actual keymap object, rather than a symbol
851 with a (crockish) symbol-function which is a keymap */
852 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
857 /* Check for circularities */
858 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
860 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
865 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
866 Set the `name' of the KEYMAP to NEW-NAME.
867 The name is only a debugging convenience; it is not used except
868 when printing the keymap.
872 keymap = get_keymap (keymap, 1, 1);
874 XKEYMAP (keymap)->name = new_name;
878 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
879 Return the `name' of KEYMAP.
880 The name is only a debugging convenience; it is not used except
881 when printing the keymap.
885 keymap = get_keymap (keymap, 1, 1);
887 return XKEYMAP (keymap)->name;
890 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
891 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
892 if no prompt is desired. The prompt is shown in the echo-area
893 when reading a key-sequence to be looked-up in this keymap.
895 (keymap, new_prompt))
897 keymap = get_keymap (keymap, 1, 1);
899 if (!NILP (new_prompt))
900 CHECK_STRING (new_prompt);
902 XKEYMAP (keymap)->prompt = new_prompt;
907 keymap_prompt_mapper (Lisp_Object keymap, void *arg)
909 return XKEYMAP (keymap)->prompt;
913 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
914 Return the `prompt' of KEYMAP.
915 If non-nil, the prompt is shown in the echo-area
916 when reading a key-sequence to be looked-up in this keymap.
918 (keymap, use_inherited))
920 /* This function can GC */
923 keymap = get_keymap (keymap, 1, 1);
924 prompt = XKEYMAP (keymap)->prompt;
925 if (!NILP (prompt) || NILP (use_inherited))
928 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
931 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
932 Sets the default binding of KEYMAP to COMMAND, or `nil'
933 if no default is desired. The default-binding is returned when
934 no other binding for a key-sequence is found in the keymap.
935 If a keymap has a non-nil default-binding, neither the keymap's
936 parents nor the current global map are searched for key bindings.
940 /* This function can GC */
941 keymap = get_keymap (keymap, 1, 1);
943 XKEYMAP (keymap)->default_binding = command;
947 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
948 Return the default binding of KEYMAP, or `nil' if it has none.
949 The default-binding is returned when no other binding for a key-sequence
950 is found in the keymap.
951 If a keymap has a non-nil default-binding, neither the keymap's
952 parents nor the current global map are searched for key bindings.
956 /* This function can GC */
957 keymap = get_keymap (keymap, 1, 1);
958 return XKEYMAP (keymap)->default_binding;
961 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
962 Return t if ARG is a keymap object.
963 The keymap may be autoloaded first if necessary.
967 /* This function can GC */
968 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
971 /* Check that OBJECT is a keymap (after dereferencing through any
972 symbols). If it is, return it.
974 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
975 is an autoload form, do the autoload and try again.
976 If AUTOLOAD is nonzero, callers must assume GC is possible.
978 ERRORP controls how we respond if OBJECT isn't a keymap.
979 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
981 Note that most of the time, we don't want to pursue autoloads.
982 Functions like Faccessible_keymaps which scan entire keymap trees
983 shouldn't load every autoloaded keymap. I'm not sure about this,
984 but it seems to me that only read_key_sequence, Flookup_key, and
985 Fdefine_key should cause keymaps to be autoloaded. */
988 get_keymap (Lisp_Object object, int errorp, int autoload)
990 /* This function can GC */
993 Lisp_Object tem = indirect_function (object, 0);
997 /* Should we do an autoload? */
999 /* (autoload "filename" doc nil keymap) */
1002 && EQ (XCAR (tem), Qautoload)
1003 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
1005 struct gcpro gcpro1, gcpro2;
1006 GCPRO2 (tem, object);
1007 do_autoload (tem, object);
1011 object = wrong_type_argument (Qkeymapp, object);
1017 /* Given OBJECT which was found in a slot in a keymap,
1018 trace indirect definitions to get the actual definition of that slot.
1019 An indirect definition is a list of the form
1020 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1021 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1024 get_keyelt (Lisp_Object object, int accept_default)
1026 /* This function can GC */
1030 if (!CONSP (object))
1034 struct gcpro gcpro1;
1036 map = XCAR (object);
1037 map = get_keymap (map, 0, 1);
1040 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1043 Lisp_Object idx = Fcdr (object);
1044 struct key_data indirection;
1047 struct Lisp_Event event;
1048 event.event_type = empty_event;
1049 character_to_event (XCHAR (idx), &event,
1050 XCONSOLE (Vselected_console), 0, 0);
1051 indirection = event.event.key;
1053 else if (CONSP (idx))
1055 if (!INTP (XCDR (idx)))
1057 indirection.keysym = XCAR (idx);
1058 indirection.modifiers = XINT (XCDR (idx));
1060 else if (SYMBOLP (idx))
1062 indirection.keysym = idx;
1063 indirection.modifiers = 0;
1070 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
1072 else if (STRINGP (XCAR (object)))
1074 /* If the keymap contents looks like (STRING . DEFN),
1076 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1077 will be used by HierarKey menus. */
1078 object = XCDR (object);
1083 /* Anything else is really the value. */
1089 keymap_lookup_1 (Lisp_Object keymap, CONST struct key_data *key,
1092 /* This function can GC */
1093 return get_keyelt (keymap_lookup_directly (keymap,
1094 key->keysym, key->modifiers),
1099 /************************************************************************/
1100 /* Copying keymaps */
1101 /************************************************************************/
1103 struct copy_keymap_inverse_closure
1105 Lisp_Object inverse_table;
1109 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value,
1110 void *copy_keymap_inverse_closure)
1112 struct copy_keymap_inverse_closure *closure =
1113 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
1115 /* copy-sequence deals with dotted lists. */
1117 value = Fcopy_list (value);
1118 Fputhash (key, value, closure->inverse_table);
1125 copy_keymap_internal (Lisp_Keymap *keymap)
1127 Lisp_Object nkm = make_keymap (0);
1128 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
1129 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1130 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1132 new_keymap->parents = Fcopy_sequence (keymap->parents);
1133 new_keymap->fullness = keymap->fullness;
1134 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1135 new_keymap->table = Fcopy_hash_table (keymap->table);
1136 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table);
1137 /* After copying the inverse map, we need to copy the conses which
1138 are its values, lest they be shared by the copy, and mangled.
1140 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
1141 ©_keymap_inverse_closure);
1146 static Lisp_Object copy_keymap (Lisp_Object keymap);
1148 struct copy_keymap_closure
1154 copy_keymap_mapper (Lisp_Object key, Lisp_Object value,
1155 void *copy_keymap_closure)
1157 /* This function can GC */
1158 struct copy_keymap_closure *closure =
1159 (struct copy_keymap_closure *) copy_keymap_closure;
1161 /* When we encounter a keymap which is indirected through a
1162 symbol, we need to copy the sub-map. In v18, the form
1163 (lookup-key (copy-keymap global-map) "\C-x")
1164 returned a new keymap, not the symbol 'Control-X-prefix.
1166 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */
1167 if (KEYMAPP (value))
1168 keymap_store_internal (key, closure->self,
1169 copy_keymap (value));
1174 copy_keymap (Lisp_Object keymap)
1176 /* This function can GC */
1177 struct copy_keymap_closure copy_keymap_closure;
1179 keymap = copy_keymap_internal (XKEYMAP (keymap));
1180 copy_keymap_closure.self = XKEYMAP (keymap);
1181 elisp_maphash (copy_keymap_mapper,
1182 XKEYMAP (keymap)->table,
1183 ©_keymap_closure);
1187 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1188 Return a copy of the keymap KEYMAP.
1189 The copy starts out with the same definitions of KEYMAP,
1190 but changing either the copy or KEYMAP does not affect the other.
1191 Any key definitions that are subkeymaps are recursively copied.
1195 /* This function can GC */
1196 keymap = get_keymap (keymap, 1, 1);
1197 return copy_keymap (keymap);
1202 keymap_fullness (Lisp_Object keymap)
1204 /* This function can GC */
1206 Lisp_Object sub_maps;
1207 struct gcpro gcpro1, gcpro2;
1209 keymap = get_keymap (keymap, 1, 1);
1210 fullness = XKEYMAP (keymap)->fullness;
1211 sub_maps = keymap_submaps (keymap);
1212 GCPRO2 (keymap, sub_maps);
1213 for (; !NILP (sub_maps); sub_maps = XCDR (sub_maps))
1215 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
1217 Lisp_Object sub_map = XCDR (XCAR (sub_maps));
1218 fullness--; /* don't count bucky maps */
1219 fullness += keymap_fullness (sub_map);
1226 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1227 Return the number of bindings in the keymap.
1231 /* This function can GC */
1232 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
1236 /************************************************************************/
1237 /* Defining keys in keymaps */
1238 /************************************************************************/
1240 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1241 and perform any necessary canonicalization. */
1244 define_key_check_and_coerce_keysym (Lisp_Object spec,
1245 Lisp_Object *keysym,
1246 unsigned int modifiers)
1248 /* Now, check and massage the trailing keysym specifier. */
1249 if (SYMBOLP (*keysym))
1251 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
1253 Lisp_Object ream_gcc_up_the_ass =
1254 make_char (string_char (XSYMBOL (*keysym)->name, 0));
1255 *keysym = ream_gcc_up_the_ass;
1259 else if (CHAR_OR_CHAR_INTP (*keysym))
1261 CHECK_CHAR_COERCE_INT (*keysym);
1263 if (XCHAR (*keysym) < ' '
1264 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
1265 /* yuck! Can't make the above restriction; too many compatibility
1267 signal_simple_error ("keysym char must be printable", *keysym);
1268 /* #### This bites! I want to be able to write (control shift a) */
1269 if (modifiers & MOD_SHIFT)
1271 ("The `shift' modifier may not be applied to ASCII keysyms",
1276 signal_simple_error ("Unknown keysym specifier",
1280 if (SYMBOLP (*keysym))
1282 char *name = (char *)
1283 string_data (XSYMBOL (*keysym)->name);
1285 /* FSFmacs uses symbols with the printed representation of keysyms in
1286 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1287 confusion, notice the M-x syntax and signal an error - because
1288 otherwise it would be interpreted as a regular keysym, and would even
1289 show up in the list-buffers output, causing confusion to the naive.
1291 We can get away with this because none of the X keysym names contain
1292 a hyphen (some contain underscore, however).
1294 It might be useful to reject keysyms which are not x-valid-keysym-
1295 name-p, but that would interfere with various tricks we do to
1296 sanitize the Sun keyboards, and would make it trickier to
1297 conditionalize a .emacs file for multiple X servers.
1299 if (((int) strlen (name) >= 2 && name[1] == '-')
1302 /* Ok, this is a bit more dubious - prevent people from doing things
1303 like (global-set-key 'RET 'something) because that will have the
1304 same problem as above. (Gag!) Maybe we should just silently
1305 accept these as aliases for the "real" names?
1307 (string_length (XSYMBOL (*keysym)->name) <= 3 &&
1308 (!strcmp (name, "LFD") ||
1309 !strcmp (name, "TAB") ||
1310 !strcmp (name, "RET") ||
1311 !strcmp (name, "ESC") ||
1312 !strcmp (name, "DEL") ||
1313 !strcmp (name, "SPC") ||
1314 !strcmp (name, "BS")))
1318 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1321 /* #### Ok, this is a bit more dubious - make people not lose if they
1322 do things like (global-set-key 'RET 'something) because that would
1323 otherwise have the same problem as above. (Gag!) We silently
1324 accept these as aliases for the "real" names.
1326 else if (!strncmp(name, "kp_", 3)) {
1327 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1330 strncpy(temp, name, sizeof (temp));
1331 temp[sizeof (temp) - 1] = '\0';
1333 *keysym = Fintern_soft(make_string((Bufbyte *)temp,
1336 } else if (EQ (*keysym, QLFD))
1337 *keysym = QKlinefeed;
1338 else if (EQ (*keysym, QTAB))
1340 else if (EQ (*keysym, QRET))
1342 else if (EQ (*keysym, QESC))
1344 else if (EQ (*keysym, QDEL))
1346 else if (EQ (*keysym, QBS))
1347 *keysym = QKbackspace;
1348 /* Emacs compatibility */
1349 else if (EQ(*keysym, Qdown_mouse_1))
1351 else if (EQ(*keysym, Qdown_mouse_2))
1353 else if (EQ(*keysym, Qdown_mouse_3))
1355 else if (EQ(*keysym, Qdown_mouse_4))
1357 else if (EQ(*keysym, Qdown_mouse_5))
1359 else if (EQ(*keysym, Qmouse_1))
1360 *keysym = Qbutton1up;
1361 else if (EQ(*keysym, Qmouse_2))
1362 *keysym = Qbutton2up;
1363 else if (EQ(*keysym, Qmouse_3))
1364 *keysym = Qbutton3up;
1365 else if (EQ(*keysym, Qmouse_4))
1366 *keysym = Qbutton4up;
1367 else if (EQ(*keysym, Qmouse_5))
1368 *keysym = Qbutton5up;
1373 /* Given any kind of key-specifier, return a keysym and modifier mask.
1374 Proper canonicalization is performed:
1376 -- integers are converted into the equivalent characters.
1377 -- one-character strings are converted into the equivalent characters.
1381 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
1383 if (CHAR_OR_CHAR_INTP (spec))
1385 struct Lisp_Event event;
1386 event.event_type = empty_event;
1387 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
1388 XCONSOLE (Vselected_console), 0, 0);
1389 returned_value->keysym = event.event.key.keysym;
1390 returned_value->modifiers = event.event.key.modifiers;
1392 else if (EVENTP (spec))
1394 switch (XEVENT (spec)->event_type)
1396 case key_press_event:
1398 returned_value->keysym = XEVENT (spec)->event.key.keysym;
1399 returned_value->modifiers = XEVENT (spec)->event.key.modifiers;
1402 case button_press_event:
1403 case button_release_event:
1405 int down = (XEVENT (spec)->event_type == button_press_event);
1406 switch (XEVENT (spec)->event.button.button)
1409 returned_value->keysym = (down ? Qbutton1 : Qbutton1up); break;
1411 returned_value->keysym = (down ? Qbutton2 : Qbutton2up); break;
1413 returned_value->keysym = (down ? Qbutton3 : Qbutton3up); break;
1415 returned_value->keysym = (down ? Qbutton4 : Qbutton4up); break;
1417 returned_value->keysym = (down ? Qbutton5 : Qbutton5up); break;
1419 returned_value->keysym = (down ? Qbutton6 : Qbutton6up); break;
1421 returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break;
1423 returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break;
1425 returned_value->modifiers = XEVENT (spec)->event.button.modifiers;
1429 signal_error (Qwrong_type_argument,
1430 list2 (build_translated_string
1431 ("unable to bind this type of event"),
1435 else if (SYMBOLP (spec))
1437 /* Be nice, allow = to mean (=) */
1438 if (bucky_sym_to_bucky_bit (spec) != 0)
1439 signal_simple_error ("Key is a modifier name", spec);
1440 define_key_check_and_coerce_keysym (spec, &spec, 0);
1441 returned_value->keysym = spec;
1442 returned_value->modifiers = 0;
1444 else if (CONSP (spec))
1446 unsigned int modifiers = 0;
1447 Lisp_Object keysym = Qnil;
1448 Lisp_Object rest = spec;
1450 /* First, parse out the leading modifier symbols. */
1451 while (CONSP (rest))
1453 unsigned int modifier;
1455 keysym = XCAR (rest);
1456 modifier = bucky_sym_to_bucky_bit (keysym);
1457 modifiers |= modifier;
1458 if (!NILP (XCDR (rest)))
1461 signal_simple_error ("Unknown modifier", keysym);
1466 signal_simple_error ("Nothing but modifiers here",
1473 signal_simple_error ("List must be nil-terminated", spec);
1475 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
1476 returned_value->keysym = keysym;
1477 returned_value->modifiers = modifiers;
1481 signal_simple_error ("Unknown key-sequence specifier",
1486 /* Used by character-to-event */
1488 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
1489 int allow_menu_events)
1491 struct key_data raw_key;
1493 if (allow_menu_events &&
1495 /* #### where the hell does this come from? */
1496 EQ (XCAR (list), Qmenu_selection))
1498 Lisp_Object fn, arg;
1499 if (! NILP (Fcdr (Fcdr (list))))
1500 signal_simple_error ("Invalid menu event desc", list);
1501 arg = Fcar (Fcdr (list));
1503 fn = Qcall_interactively;
1506 XSETFRAME (XEVENT (event)->channel, selected_frame ());
1507 XEVENT (event)->event_type = misc_user_event;
1508 XEVENT (event)->event.eval.function = fn;
1509 XEVENT (event)->event.eval.object = arg;
1513 define_key_parser (list, &raw_key);
1515 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) ||
1516 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) ||
1517 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) ||
1518 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) ||
1519 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) ||
1520 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) ||
1521 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) ||
1522 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up))
1523 error ("Mouse-clicks can't appear in saved keyboard macros.");
1525 XEVENT (event)->channel = Vselected_console;
1526 XEVENT (event)->event_type = key_press_event;
1527 XEVENT (event)->event.key.keysym = raw_key.keysym;
1528 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
1533 event_matches_key_specifier_p (struct Lisp_Event *event,
1534 Lisp_Object key_specifier)
1538 struct gcpro gcpro1;
1540 if (event->event_type != key_press_event || NILP (key_specifier) ||
1541 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
1544 /* if the specifier is an integer such as 27, then it should match
1545 both of the events 'escape' and 'control ['. Calling
1546 Fcharacter_to_event() will only match 'escape'. */
1547 if (CHAR_OR_CHAR_INTP (key_specifier))
1548 return (XCHAR_OR_CHAR_INT (key_specifier)
1549 == event_to_character (event, 0, 0, 0));
1551 /* Otherwise, we cannot call event_to_character() because we may
1552 be dealing with non-ASCII keystrokes. In any case, if I ask
1553 for 'control [' then I should get exactly that, and not
1556 However, we have to behave differently on TTY's, where 'control ['
1557 is silently converted into 'escape' by the keyboard driver.
1558 In this case, ASCII is the only thing we know about, so we have
1559 to compare the ASCII values. */
1562 event2 = Fmake_event (Qnil, Qnil);
1563 Fcharacter_to_event (key_specifier, event2, Qnil, Qnil);
1564 if (XEVENT (event2)->event_type != key_press_event)
1566 else if (CONSOLE_TTY_P (XCONSOLE (EVENT_CHANNEL (event))))
1570 ch1 = event_to_character (event, 0, 0, 0);
1571 ch2 = event_to_character (XEVENT (event2), 0, 0, 0);
1572 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1574 else if (EQ (event->event.key.keysym, XEVENT (event2)->event.key.keysym) &&
1575 event->event.key.modifiers == XEVENT (event2)->event.key.modifiers)
1579 Fdeallocate_event (event2);
1585 meta_prefix_char_p (CONST struct key_data *key)
1587 struct Lisp_Event event;
1589 event.event_type = key_press_event;
1590 event.channel = Vselected_console;
1591 event.event.key.keysym = key->keysym;
1592 event.event.key.modifiers = key->modifiers;
1593 return event_matches_key_specifier_p (&event, Vmeta_prefix_char);
1596 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1597 Return non-nil if EVENT matches KEY-SPECIFIER.
1598 This can be useful, e.g., to determine if the user pressed `help-char' or
1601 (event, key_specifier))
1603 CHECK_LIVE_EVENT (event);
1604 return (event_matches_key_specifier_p (XEVENT (event), key_specifier)
1608 #define MACROLET(k,m) do { \
1609 returned_value->keysym = (k); \
1610 returned_value->modifiers = (m); \
1611 RETURN_SANS_WARNINGS; \
1615 Given a keysym, return another keysym/modifier pair which could be
1616 considered the same key in an ASCII world. Backspace returns ^H, for
1620 define_key_alternate_name (struct key_data *key,
1621 struct key_data *returned_value)
1623 Lisp_Object keysym = key->keysym;
1624 unsigned int modifiers = key->modifiers;
1625 unsigned int modifiers_sans_control = (modifiers & (~MOD_CONTROL));
1626 unsigned int modifiers_sans_meta = (modifiers & (~MOD_META));
1627 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1628 returned_value->modifiers = 0;
1629 if (modifiers_sans_meta == MOD_CONTROL)
1631 if EQ (keysym, QKspace)
1632 MACROLET (make_char ('@'), modifiers);
1633 else if (!CHARP (keysym))
1635 else switch (XCHAR (keysym))
1637 case '@': /* c-@ => c-space */
1638 MACROLET (QKspace, modifiers);
1639 case 'h': /* c-h => backspace */
1640 MACROLET (QKbackspace, modifiers_sans_control);
1641 case 'i': /* c-i => tab */
1642 MACROLET (QKtab, modifiers_sans_control);
1643 case 'j': /* c-j => linefeed */
1644 MACROLET (QKlinefeed, modifiers_sans_control);
1645 case 'm': /* c-m => return */
1646 MACROLET (QKreturn, modifiers_sans_control);
1647 case '[': /* c-[ => escape */
1648 MACROLET (QKescape, modifiers_sans_control);
1653 else if (modifiers_sans_meta != 0)
1655 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
1656 MACROLET (make_char ('h'), (modifiers | MOD_CONTROL));
1657 else if (EQ (keysym, QKtab)) /* tab => c-i */
1658 MACROLET (make_char ('i'), (modifiers | MOD_CONTROL));
1659 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
1660 MACROLET (make_char ('j'), (modifiers | MOD_CONTROL));
1661 else if (EQ (keysym, QKreturn)) /* return => c-m */
1662 MACROLET (make_char ('m'), (modifiers | MOD_CONTROL));
1663 else if (EQ (keysym, QKescape)) /* escape => c-[ */
1664 MACROLET (make_char ('['), (modifiers | MOD_CONTROL));
1672 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
1675 /* This function can GC */
1676 Lisp_Object new_keys;
1678 Lisp_Object mpc_binding;
1679 struct key_data meta_key;
1681 if (NILP (Vmeta_prefix_char) ||
1682 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
1685 define_key_parser (Vmeta_prefix_char, &meta_key);
1686 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
1687 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
1692 else if (STRINGP (keys))
1693 new_keys = Fsubstring (keys, Qzero, make_int (indx));
1694 else if (VECTORP (keys))
1696 new_keys = make_vector (indx, Qnil);
1697 for (i = 0; i < indx; i++)
1698 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
1703 if (EQ (keys, new_keys))
1704 error_with_frob (mpc_binding,
1705 "can't bind %s: %s has a non-keymap binding",
1706 (char *) XSTRING_DATA (Fkey_description (keys)),
1707 (char *) XSTRING_DATA (Fsingle_key_description
1708 (Vmeta_prefix_char)));
1710 error_with_frob (mpc_binding,
1711 "can't bind %s: %s %s has a non-keymap binding",
1712 (char *) XSTRING_DATA (Fkey_description (keys)),
1713 (char *) XSTRING_DATA (Fkey_description (new_keys)),
1714 (char *) XSTRING_DATA (Fsingle_key_description
1715 (Vmeta_prefix_char)));
1718 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
1719 Define key sequence KEYS, in KEYMAP, as DEF.
1720 KEYMAP is a keymap object.
1721 KEYS is the sequence of keystrokes to bind, described below.
1722 DEF is anything that can be a key's definition:
1723 nil (means key is undefined in this keymap);
1724 a command (a Lisp function suitable for interactive calling);
1725 a string or key sequence vector (treated as a keyboard macro);
1726 a keymap (to define a prefix key);
1727 a symbol; when the key is looked up, the symbol will stand for its
1728 function definition, that should at that time be one of the above,
1729 or another symbol whose function definition is used, and so on.
1730 a cons (STRING . DEFN), meaning that DEFN is the definition
1731 (DEFN should be a valid definition in its own right);
1732 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1734 Contrary to popular belief, the world is not ASCII. When running under a
1735 window manager, XEmacs can tell the difference between, for example, the
1736 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1737 bind different commands to each of these.
1739 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1740 set of modifiers (such as control and meta). A `keysym' is what is printed
1741 on the keys on your keyboard.
1743 A keysym may be represented by a symbol, or (if and only if it is equivalent
1744 to an ASCII character in the range 32 - 255) by a character or its equivalent
1745 ASCII code. The `A' key may be represented by the symbol `A', the character
1746 `?A', or by the number 65. The `break' key may be represented only by the
1749 A keystroke may be represented by a list: the last element of the list
1750 is the key (a symbol, character, or number, as above) and the
1751 preceding elements are the symbolic names of modifier keys (control,
1752 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1753 represented by the forms `(control b)', `(control ?b)', and `(control
1754 98)'. A keystroke may also be represented by an event object, as
1755 returned by the `next-command-event' and `read-key-sequence'
1758 Note that in this context, the keystroke `control-b' is *not* represented
1759 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1761 The `shift' modifier is somewhat of a special case. You should not (and
1762 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1763 have ASCII equivalents, the state of the shift key is implicit in the
1764 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1765 sort of thing varies from keyboard to keyboard. The shift modifier is for
1766 use only with characters that do not have a second keysym on the same key,
1767 such as `backspace' and `tab'.
1769 A key sequence is a vector of keystrokes. As a degenerate case, elements
1770 of this vector may also be keysyms if they have no modifiers. That is,
1771 the `A' keystroke is represented by all of these forms:
1772 A ?A 65 (A) (?A) (65)
1773 [A] [?A] [65] [(A)] [(?A)] [(65)]
1775 the `control-a' keystroke is represented by these forms:
1776 (control A) (control ?A) (control 65)
1777 [(control A)] [(control ?A)] [(control 65)]
1778 the key sequence `control-c control-a' is represented by these forms:
1779 [(control c) (control a)] [(control ?c) (control ?a)]
1780 [(control 99) (control 65)] etc.
1782 Mouse button clicks work just like keypresses: (control button1) means
1783 pressing the left mouse button while holding down the control key.
1784 \[(control c) (shift button3)] means control-c, hold shift, click right.
1786 Commands may be bound to the mouse-button up-stroke rather than the down-
1787 stroke as well. `button1' means the down-stroke, and `button1up' means the
1788 up-stroke. Different commands may be bound to the up and down strokes,
1789 though that is probably not what you want, so be careful.
1791 For backward compatibility, a key sequence may also be represented by a
1792 string. In this case, it represents the key sequence(s) that would
1793 produce that sequence of ASCII characters in a purely ASCII world. For
1794 example, a string containing the ASCII backspace character, "\\^H", would
1795 represent two key sequences: `(control h)' and `backspace'. Binding a
1796 command to this will actually bind both of those key sequences. Likewise
1797 for the following pairs:
1804 control @ control space
1806 After binding a command to two key sequences with a form like
1808 (define-key global-map "\\^X\\^I" \'command-1)
1810 it is possible to redefine only one of those sequences like so:
1812 (define-key global-map [(control x) (control i)] \'command-2)
1813 (define-key global-map [(control x) tab] \'command-3)
1815 Of course, all of this applies only when running under a window system. If
1816 you're talking to XEmacs through a TTY connection, you don't get any of
1819 (keymap, keys, def))
1821 /* This function can GC */
1826 struct gcpro gcpro1, gcpro2, gcpro3;
1829 len = XVECTOR_LENGTH (keys);
1830 else if (STRINGP (keys))
1831 len = XSTRING_CHAR_LENGTH (keys);
1832 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
1834 if (!CONSP (keys)) keys = list1 (keys);
1836 keys = make_vector (1, keys); /* this is kinda sleazy. */
1840 keys = wrong_type_argument (Qsequencep, keys);
1841 len = XINT (Flength (keys));
1846 GCPRO3 (keymap, keys, def);
1849 When the user defines a key which, in a strictly ASCII world, would be
1850 produced by two different keys (^J and linefeed, or ^H and backspace,
1851 for example) then the binding will be made for both keysyms.
1853 This is done if the user binds a command to a string, as in
1854 (define-key map "\^H" 'something), but not when using one of the new
1855 syntaxes, like (define-key map '(control h) 'something).
1857 ascii_hack = (STRINGP (keys));
1859 keymap = get_keymap (keymap, 1, 1);
1865 struct key_data raw_key1;
1866 struct key_data raw_key2;
1869 c = make_char (string_char (XSTRING (keys), idx));
1871 c = XVECTOR_DATA (keys) [idx];
1873 define_key_parser (c, &raw_key1);
1875 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
1877 if (idx == (len - 1))
1879 /* This is a hack to prevent a binding for the meta-prefix-char
1880 from being made in a map which already has a non-empty "meta"
1881 submap. That is, we can't let both "escape" and "meta" have
1882 a binding in the same keymap. This implies that the idiom
1883 (define-key my-map "\e" my-escape-map)
1884 (define-key my-escape-map "a" 'my-command)
1885 no longer works. That's ok. Instead the luser should do
1886 (define-key my-map "\ea" 'my-command)
1888 (define-key my-map "\M-a" 'my-command)
1890 (defvar my-escape-map (lookup-key my-map "\e"))
1891 if the luser really wants the map in a variable.
1894 struct gcpro ngcpro1;
1897 mmap = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
1898 XKEYMAP (keymap)->table, Qnil);
1900 && keymap_fullness (mmap) != 0)
1903 = Fsingle_key_description (Vmeta_prefix_char);
1904 signal_simple_error_2
1905 ("Map contains meta-bindings, can't bind", desc, keymap);
1918 define_key_alternate_name (&raw_key1, &raw_key2);
1921 raw_key2.keysym = Qnil;
1922 raw_key2.modifiers = 0;
1927 raw_key1.modifiers |= MOD_META;
1928 raw_key2.modifiers |= MOD_META;
1932 /* This crap is to make sure that someone doesn't bind something like
1933 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
1934 if (raw_key1.modifiers & MOD_META)
1935 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
1939 keymap_store (keymap, &raw_key1, def);
1940 if (ascii_hack && !NILP (raw_key2.keysym))
1941 keymap_store (keymap, &raw_key2, def);
1948 struct gcpro ngcpro1;
1951 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
1954 cmd = Fmake_sparse_keymap (Qnil);
1955 XKEYMAP (cmd)->name /* for debugging */
1956 = list2 (make_key_description (&raw_key1, 1), keymap);
1957 keymap_store (keymap, &raw_key1, cmd);
1959 if (NILP (Fkeymapp (cmd)))
1960 signal_simple_error_2 ("Invalid prefix keys in sequence",
1963 if (ascii_hack && !NILP (raw_key2.keysym) &&
1964 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
1965 keymap_store (keymap, &raw_key2, cmd);
1967 keymap = get_keymap (cmd, 1, 1);
1974 /************************************************************************/
1975 /* Looking up keys in keymaps */
1976 /************************************************************************/
1978 /* We need a very fast (i.e., non-consing) version of lookup-key in order
1979 to make where-is-internal really fly. */
1981 struct raw_lookup_key_mapper_closure
1984 CONST struct key_data *raw_keys;
1990 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
1992 /* Caller should gc-protect args (keymaps may autoload) */
1994 raw_lookup_key (Lisp_Object keymap,
1995 CONST struct key_data *raw_keys, int raw_keys_count,
1996 int keys_so_far, int accept_default)
1998 /* This function can GC */
1999 struct raw_lookup_key_mapper_closure c;
2000 c.remaining = raw_keys_count - 1;
2001 c.raw_keys = raw_keys;
2002 c.raw_keys_count = raw_keys_count;
2003 c.keys_so_far = keys_so_far;
2004 c.accept_default = accept_default;
2006 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
2010 raw_lookup_key_mapper (Lisp_Object k, void *arg)
2012 /* This function can GC */
2013 struct raw_lookup_key_mapper_closure *c =
2014 (struct raw_lookup_key_mapper_closure *) arg;
2015 int accept_default = c->accept_default;
2016 int remaining = c->remaining;
2017 int keys_so_far = c->keys_so_far;
2018 CONST struct key_data *raw_keys = c->raw_keys;
2021 if (! meta_prefix_char_p (&(raw_keys[0])))
2023 /* Normal case: every case except the meta-hack (see below). */
2024 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2027 /* Return whatever we found if we're out of keys */
2029 else if (NILP (cmd))
2030 /* Found nothing (though perhaps parent map may have binding) */
2032 else if (NILP (Fkeymapp (cmd)))
2033 /* Didn't find a keymap, and we have more keys.
2034 * Return a fixnum to indicate that keys were too long.
2036 cmd = make_int (keys_so_far + 1);
2038 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2039 keys_so_far + 1, accept_default);
2043 /* This is a hack so that looking up a key-sequence whose last
2044 * element is the meta-prefix-char will return the keymap that
2045 * the "meta" keys are stored in, if there is no binding for
2046 * the meta-prefix-char (and if this map has a "meta" submap).
2047 * If this map doesn't have a "meta" submap, then the
2048 * meta-prefix-char is looked up just like any other key.
2052 /* First look for the prefix-char directly */
2053 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2056 /* Do kludgy return of the meta-map */
2057 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (MOD_META),
2058 XKEYMAP (k)->table, Qnil);
2063 /* Search for the prefix-char-prefixed sequence directly */
2064 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2065 cmd = get_keymap (cmd, 0, 1);
2067 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2068 keys_so_far + 1, accept_default);
2069 else if ((raw_keys[1].modifiers & MOD_META) == 0)
2071 struct key_data metified;
2072 metified.keysym = raw_keys[1].keysym;
2073 metified.modifiers = raw_keys[1].modifiers | MOD_META;
2075 /* Search for meta-next-char sequence directly */
2076 cmd = keymap_lookup_1 (k, &metified, accept_default);
2081 cmd = get_keymap (cmd, 0, 1);
2083 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
2090 if (accept_default && NILP (cmd))
2091 cmd = XKEYMAP (k)->default_binding;
2095 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2096 /* Caller should gc-protect arguments */
2098 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
2101 /* This function can GC */
2102 struct key_data kkk[20];
2103 struct key_data *raw_keys;
2109 if (nkeys < (countof (kkk)))
2112 raw_keys = alloca_array (struct key_data, nkeys);
2114 for (i = 0; i < nkeys; i++)
2116 define_key_parser (keys[i], &(raw_keys[i]));
2118 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
2122 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2125 /* This function can GC */
2126 struct key_data kkk[20];
2130 struct key_data *raw_keys;
2131 Lisp_Object tem = Qnil;
2132 struct gcpro gcpro1, gcpro2;
2135 CHECK_LIVE_EVENT (event_head);
2137 nkeys = event_chain_count (event_head);
2139 if (nkeys < (countof (kkk)))
2142 raw_keys = alloca_array (struct key_data, nkeys);
2145 EVENT_CHAIN_LOOP (event, event_head)
2146 define_key_parser (event, &(raw_keys[nkeys++]));
2147 GCPRO2 (keymaps[0], event_head);
2148 gcpro1.nvars = nmaps;
2149 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
2150 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
2151 for (iii = 0; iii < nmaps; iii++)
2153 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
2157 /* Too long in some local map means don't look at global map */
2161 else if (!NILP (tem))
2168 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
2169 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2170 Nil is returned if KEYS is unbound. See documentation of `define-key'
2171 for valid key definitions and key-sequence specifications.
2172 A number is returned if KEYS is "too long"; that is, the leading
2173 characters fail to be a valid sequence of prefix characters in KEYMAP.
2174 The number is how many characters at the front of KEYS
2175 it takes to reach a non-prefix command.
2177 (keymap, keys, accept_default))
2179 /* This function can GC */
2181 return lookup_keys (keymap,
2182 XVECTOR_LENGTH (keys),
2183 XVECTOR_DATA (keys),
2184 !NILP (accept_default));
2185 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
2186 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
2187 else if (STRINGP (keys))
2189 int length = XSTRING_CHAR_LENGTH (keys);
2191 struct key_data *raw_keys = alloca_array (struct key_data, length);
2195 for (i = 0; i < length; i++)
2197 Emchar n = string_char (XSTRING (keys), i);
2198 define_key_parser (make_char (n), &(raw_keys[i]));
2200 return raw_lookup_key (keymap, raw_keys, length, 0,
2201 !NILP (accept_default));
2205 keys = wrong_type_argument (Qsequencep, keys);
2206 return Flookup_key (keymap, keys, accept_default);
2210 /* Given a key sequence, returns a list of keymaps to search for bindings.
2211 Does all manner of semi-hairy heuristics, like looking in the current
2212 buffer's map before looking in the global map and looking in the local
2213 map of the buffer in which the mouse was clicked in event0 is a click.
2215 It would be kind of nice if this were in Lisp so that this semi-hairy
2216 semi-heuristic command-lookup behavior could be readily understood and
2217 customised. However, this needs to be pretty fast, or performance of
2218 keyboard macros goes to shit; putting this in lisp slows macros down
2219 2-3x. And they're already slower than v18 by 5-6x.
2222 struct relevant_maps
2225 unsigned int max_maps;
2227 struct gcpro *gcpro;
2230 static void get_relevant_extent_keymaps (Lisp_Object pos,
2231 Lisp_Object buffer_or_string,
2233 struct relevant_maps *closure);
2234 static void get_relevant_minor_maps (Lisp_Object buffer,
2235 struct relevant_maps *closure);
2238 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
2240 unsigned int nmaps = closure->nmaps;
2244 closure->nmaps = nmaps + 1;
2245 if (nmaps < closure->max_maps)
2247 closure->maps[nmaps] = map;
2248 closure->gcpro->nvars = nmaps;
2253 get_relevant_keymaps (Lisp_Object keys,
2254 int max_maps, Lisp_Object maps[])
2256 /* This function can GC */
2257 Lisp_Object terminal = Qnil;
2258 struct gcpro gcpro1;
2259 struct relevant_maps closure;
2260 struct console *con;
2265 closure.max_maps = max_maps;
2266 closure.maps = maps;
2267 closure.gcpro = &gcpro1;
2270 terminal = event_chain_tail (keys);
2271 else if (VECTORP (keys))
2273 int len = XVECTOR_LENGTH (keys);
2275 terminal = XVECTOR_DATA (keys)[len - 1];
2278 if (EVENTP (terminal))
2280 CHECK_LIVE_EVENT (terminal);
2281 con = event_console_or_selected (terminal);
2284 con = XCONSOLE (Vselected_console);
2286 if (KEYMAPP (con->overriding_terminal_local_map)
2287 || KEYMAPP (Voverriding_local_map))
2289 if (KEYMAPP (con->overriding_terminal_local_map))
2290 relevant_map_push (con->overriding_terminal_local_map, &closure);
2291 if (KEYMAPP (Voverriding_local_map))
2292 relevant_map_push (Voverriding_local_map, &closure);
2294 else if (!EVENTP (terminal)
2295 || (XEVENT (terminal)->event_type != button_press_event
2296 && XEVENT (terminal)->event_type != button_release_event))
2299 XSETBUFFER (tem, current_buffer);
2300 /* It's not a mouse event; order of keymaps searched is:
2301 o keymap of any/all extents under the mouse
2303 o local-map of current-buffer
2306 /* The terminal element of the lookup may be nil or a keysym.
2307 In those cases we don't want to check for an extent
2309 if (EVENTP (terminal))
2311 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
2312 tem, Qnil, &closure);
2314 get_relevant_minor_maps (tem, &closure);
2316 tem = current_buffer->keymap;
2318 relevant_map_push (tem, &closure);
2320 #ifdef HAVE_WINDOW_SYSTEM
2323 /* It's a mouse event; order of keymaps searched is:
2324 o vertical-divider-map, if event is over a divider
2325 o local-map of mouse-grabbed-buffer
2326 o keymap of any/all extents under the mouse
2327 if the mouse is over a modeline:
2328 o modeline-map of buffer corresponding to that modeline
2329 o else, local-map of buffer under the mouse
2331 o local-map of current-buffer
2334 Lisp_Object window = Fevent_window (terminal);
2336 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
2338 if (KEYMAPP (Vvertical_divider_map))
2339 relevant_map_push (Vvertical_divider_map, &closure);
2342 if (BUFFERP (Vmouse_grabbed_buffer))
2344 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
2346 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
2348 relevant_map_push (map, &closure);
2353 Lisp_Object buffer = Fwindow_buffer (window);
2357 if (!NILP (Fevent_over_modeline_p (terminal)))
2359 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
2362 get_relevant_extent_keymaps
2363 (Fevent_modeline_position (terminal),
2364 XBUFFER (buffer)->generated_modeline_string,
2365 /* #### third arg should maybe be a glyph. */
2368 if (!UNBOUNDP (map) && !NILP (map))
2369 relevant_map_push (get_keymap (map, 1, 1), &closure);
2373 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
2374 Fevent_glyph_extent (terminal),
2378 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
2380 Lisp_Object map = XBUFFER (buffer)->keymap;
2382 get_relevant_minor_maps (buffer, &closure);
2384 relevant_map_push (map, &closure);
2388 else if (!NILP (Fevent_over_toolbar_p (terminal)))
2390 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
2392 if (!UNBOUNDP (map) && !NILP (map))
2393 relevant_map_push (map, &closure);
2396 #endif /* HAVE_WINDOW_SYSTEM */
2399 int nmaps = closure.nmaps;
2400 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2401 if (nmaps >= max_maps && max_maps > 0)
2402 maps[max_maps - 1] = Vcurrent_global_map;
2404 maps[nmaps] = Vcurrent_global_map;
2410 /* Returns a set of keymaps extracted from the extents at POS in
2411 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2412 to look for a keymap in, and if it has one, its keymap will be the
2413 first element in the list returned. This is so we can correctly
2414 search the keymaps associated with glyphs which may be physically
2415 disjoint from their extents: for example, if a glyph is out in the
2416 margin, we should still consult the keymap of that glyph's extent,
2417 which may not itself be under the mouse.
2421 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
2423 struct relevant_maps *closure)
2425 /* This function can GC */
2426 /* the glyph keymap, if any, comes first.
2427 (Processing it twice is no big deal: noop.) */
2430 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
2432 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2435 /* Next check the extents at the text position, if any */
2439 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2441 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
2443 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
2445 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2452 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
2454 /* This function can GC */
2457 Lisp_Object sym = XCAR (assoc);
2460 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
2461 if (!NILP (val) && !UNBOUNDP (val))
2463 Lisp_Object map = get_keymap (XCDR (assoc), 0, 1);
2472 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
2474 /* This function can GC */
2477 /* Will you ever lose badly if you make this circular! */
2478 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
2480 alist = XCDR (alist))
2482 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
2484 if (!NILP (m)) relevant_map_push (m, closure);
2489 /* #### Would map-current-keymaps be a better thing?? */
2490 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2491 Return a list of the current keymaps that will be searched for bindings.
2492 This lists keymaps such as the current local map and the minor-mode maps,
2493 but does not list the parents of those keymaps.
2494 EVENT-OR-KEYS controls which keymaps will be listed.
2495 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2496 mouse event), the keymaps for that mouse event will be listed (see
2497 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2501 /* This function can GC */
2502 struct gcpro gcpro1;
2503 Lisp_Object maps[100];
2504 Lisp_Object *gubbish = maps;
2507 GCPRO1 (event_or_keys);
2508 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
2510 if (nmaps > countof (maps))
2512 gubbish = alloca_array (Lisp_Object, nmaps);
2513 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
2516 return Flist (nmaps, gubbish);
2519 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
2520 Return the binding for command KEYS in current keymaps.
2521 KEYS is a string, a vector of events, or a vector of key-description lists
2522 as described in the documentation for the `define-key' function.
2523 The binding is probably a symbol with a function definition; see
2524 the documentation for `lookup-key' for more information.
2526 For key-presses, the order of keymaps searched is:
2527 - the `keymap' property of any extent(s) at point;
2528 - any applicable minor-mode maps;
2529 - the current-local-map of the current-buffer;
2530 - the current global map.
2532 For mouse-clicks, the order of keymaps searched is:
2533 - the current-local-map of the `mouse-grabbed-buffer' if any;
2534 - vertical-divider-map, if the event happened over a vertical divider
2535 - the `keymap' property of any extent(s) at the position of the click
2536 (this includes modeline extents);
2537 - the modeline-map of the buffer corresponding to the modeline under
2538 the mouse (if the click happened over a modeline);
2539 - the value of toolbar-map in the current-buffer (if the click
2540 happened over a toolbar);
2541 - the current-local-map of the buffer under the mouse (does not
2542 apply to toolbar clicks);
2543 - any applicable minor-mode maps;
2544 - the current global map.
2546 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2547 is non-nil, *only* those two maps and the current global map are searched.
2549 (keys, accept_default))
2551 /* This function can GC */
2553 Lisp_Object maps[100];
2555 struct gcpro gcpro1, gcpro2;
2556 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
2558 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
2562 if (EVENTP (keys)) /* unadvertised "feature" for the future */
2563 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
2565 for (i = 0; i < nmaps; i++)
2567 Lisp_Object tem = Flookup_key (maps[i], keys,
2571 /* Too long in some local map means don't look at global map */
2574 else if (!NILP (tem))
2581 process_event_binding_result (Lisp_Object result)
2583 if (EQ (result, Qundefined))
2584 /* The suppress-keymap function binds keys to 'undefined - special-case
2585 that here, so that being bound to that has the same error-behavior as
2586 not being defined at all.
2592 /* Snap out possible keymap indirections */
2593 map = get_keymap (result, 0, 1);
2601 /* Attempts to find a command corresponding to the event-sequence
2602 whose head is event0 (sequence is threaded though event_next).
2604 The return value will be
2606 -- nil (there is no binding; this will also be returned
2607 whenever the event chain is "too long", i.e. there
2608 is a non-nil, non-keymap binding for a prefix of
2610 -- a keymap (part of a command has been specified)
2611 -- a command (anything that satisfies `commandp'; this includes
2612 some symbols, lists, subrs, strings, vectors, and
2613 compiled-function objects) */
2615 event_binding (Lisp_Object event0, int accept_default)
2617 /* This function can GC */
2618 Lisp_Object maps[100];
2621 assert (EVENTP (event0));
2623 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
2624 if (nmaps > countof (maps))
2625 nmaps = countof (maps);
2626 return process_event_binding_result (lookup_events (event0, nmaps, maps,
2630 /* like event_binding, but specify a keymap to search */
2633 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
2635 /* This function can GC */
2636 if (!KEYMAPP (keymap))
2639 return process_event_binding_result (lookup_events (event0, 1, &keymap,
2643 /* Attempts to find a function key mapping corresponding to the
2644 event-sequence whose head is event0 (sequence is threaded through
2645 event_next). The return value will be the same as for event_binding(). */
2647 munging_key_map_event_binding (Lisp_Object event0,
2648 enum munge_me_out_the_door munge)
2650 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2651 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
2652 Vkey_translation_map;
2657 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
2661 /************************************************************************/
2662 /* Setting/querying the global and local maps */
2663 /************************************************************************/
2665 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
2666 Select KEYMAP as the global keymap.
2670 /* This function can GC */
2671 keymap = get_keymap (keymap, 1, 1);
2672 Vcurrent_global_map = keymap;
2676 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
2677 Select KEYMAP as the local keymap in BUFFER.
2678 If KEYMAP is nil, that means no local keymap.
2679 If BUFFER is nil, the current buffer is assumed.
2683 /* This function can GC */
2684 struct buffer *b = decode_buffer (buffer, 0);
2686 keymap = get_keymap (keymap, 1, 1);
2693 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2694 Return BUFFER's local keymap, or nil if it has none.
2695 If BUFFER is nil, the current buffer is assumed.
2699 struct buffer *b = decode_buffer (buffer, 0);
2703 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2704 Return the current global keymap.
2708 return Vcurrent_global_map;
2712 /************************************************************************/
2713 /* Mapping over keymap elements */
2714 /************************************************************************/
2716 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2717 prefix key, it's not entirely obvious what map-keymap should do, but
2718 what it does is: map over all keys in this map; then recursively map
2719 over all submaps of this map that are "bucky" submaps. This means that,
2720 when mapping over a keymap, it appears that "x" and "C-x" are in the
2721 same map, although "C-x" is really in the "control" submap of this one.
2722 However, since we don't recursively descend the submaps that are bound
2723 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2724 those explicitly, if that's what they want.
2726 So the end result of this is that the bucky keymaps (the ones indexed
2727 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2728 invisible from elisp. They're just an implementation detail that code
2729 outside of this file doesn't need to know about.
2732 struct map_keymap_unsorted_closure
2734 void (*fn) (CONST struct key_data *, Lisp_Object binding, void *arg);
2736 unsigned int modifiers;
2739 /* used by map_keymap() */
2741 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value,
2742 void *map_keymap_unsorted_closure)
2744 /* This function can GC */
2745 struct map_keymap_unsorted_closure *closure =
2746 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
2747 unsigned int modifiers = closure->modifiers;
2748 unsigned int mod_bit;
2749 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
2752 int omod = modifiers;
2753 closure->modifiers = (modifiers | mod_bit);
2754 value = get_keymap (value, 1, 0);
2755 elisp_maphash (map_keymap_unsorted_mapper,
2756 XKEYMAP (value)->table,
2757 map_keymap_unsorted_closure);
2758 closure->modifiers = omod;
2762 struct key_data key;
2763 key.keysym = keysym;
2764 key.modifiers = modifiers;
2765 ((*closure->fn) (&key, value, closure->arg));
2771 struct map_keymap_sorted_closure
2773 Lisp_Object *result_locative;
2776 /* used by map_keymap_sorted() */
2778 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value,
2779 void *map_keymap_sorted_closure)
2781 struct map_keymap_sorted_closure *cl =
2782 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
2783 Lisp_Object *list = cl->result_locative;
2784 *list = Fcons (Fcons (key, value), *list);
2789 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2790 and keymap_submaps().
2793 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
2796 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2798 unsigned int bit1, bit2;
2804 if (EQ (obj1, obj2))
2806 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
2807 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
2809 /* If either is a symbol with a character-set-property, then sort it by
2810 that code instead of alphabetically.
2812 if (! bit1 && SYMBOLP (obj1))
2814 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
2815 if (CHAR_OR_CHAR_INTP (code))
2818 CHECK_CHAR_COERCE_INT (obj1);
2822 if (! bit2 && SYMBOLP (obj2))
2824 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
2825 if (CHAR_OR_CHAR_INTP (code))
2828 CHECK_CHAR_COERCE_INT (obj2);
2833 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2834 if (XTYPE (obj1) != XTYPE (obj2))
2835 return SYMBOLP (obj2) ? 1 : -1;
2837 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
2839 int o1 = XCHAR (obj1);
2840 int o2 = XCHAR (obj2);
2841 if (o1 == o2 && /* If one started out as a symbol and the */
2842 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
2843 return sym2_p ? 1 : -1;
2845 return o1 < o2 ? 1 : -1; /* else just compare them */
2848 /* else they're both symbols. If they're both buckys, then order them. */
2850 return bit1 < bit2 ? 1 : -1;
2852 /* if only one is a bucky, then it comes later */
2854 return bit2 ? 1 : -1;
2856 /* otherwise, string-sort them. */
2858 char *s1 = (char *) string_data (XSYMBOL (obj1)->name);
2859 char *s2 = (char *) string_data (XSYMBOL (obj2)->name);
2861 return 0 > strcoll (s1, s2) ? 1 : -1;
2863 return 0 > strcmp (s1, s2) ? 1 : -1;
2869 /* used by map_keymap() */
2871 map_keymap_sorted (Lisp_Object keymap_table,
2872 unsigned int modifiers,
2873 void (*function) (CONST struct key_data *key,
2874 Lisp_Object binding,
2875 void *map_keymap_sorted_closure),
2876 void *map_keymap_sorted_closure)
2878 /* This function can GC */
2879 struct gcpro gcpro1;
2880 Lisp_Object contents = Qnil;
2882 if (XINT (Fhash_table_count (keymap_table)) == 0)
2888 struct map_keymap_sorted_closure c1;
2889 c1.result_locative = &contents;
2890 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
2892 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
2893 for (; !NILP (contents); contents = XCDR (contents))
2895 Lisp_Object keysym = XCAR (XCAR (contents));
2896 Lisp_Object binding = XCDR (XCAR (contents));
2897 unsigned int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
2899 map_keymap_sorted (XKEYMAP (get_keymap (binding,
2901 (modifiers | sub_bits),
2903 map_keymap_sorted_closure);
2908 k.modifiers = modifiers;
2909 ((*function) (&k, binding, map_keymap_sorted_closure));
2916 /* used by Fmap_keymap() */
2918 map_keymap_mapper (CONST struct key_data *key,
2919 Lisp_Object binding,
2922 /* This function can GC */
2924 VOID_TO_LISP (fn, function);
2925 call2 (fn, make_key_description (key, 1), binding);
2930 map_keymap (Lisp_Object keymap_table, int sort_first,
2931 void (*function) (CONST struct key_data *key,
2932 Lisp_Object binding,
2936 /* This function can GC */
2938 map_keymap_sorted (keymap_table, 0, function, fn_arg);
2941 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
2942 map_keymap_unsorted_closure.fn = function;
2943 map_keymap_unsorted_closure.arg = fn_arg;
2944 map_keymap_unsorted_closure.modifiers = 0;
2945 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
2946 &map_keymap_unsorted_closure);
2950 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
2951 Apply FUNCTION to each element of KEYMAP.
2952 FUNCTION will be called with two arguments: a key-description list, and
2953 the binding. The order in which the elements of the keymap are passed to
2954 the function is unspecified. If the function inserts new elements into
2955 the keymap, it may or may not be called with them later. No element of
2956 the keymap will ever be passed to the function more than once.
2958 The function will not be called on elements of this keymap's parents
2959 \(see the function `keymap-parents') or upon keymaps which are contained
2960 within this keymap (multi-character definitions).
2961 It will be called on "meta" characters since they are not really
2962 two-character sequences.
2964 If the optional third argument SORT-FIRST is non-nil, then the elements of
2965 the keymap will be passed to the mapper function in a canonical order.
2966 Otherwise, they will be passed in hash (that is, random) order, which is
2969 (function, keymap, sort_first))
2971 /* This function can GC */
2972 struct gcpro gcpro1, gcpro2;
2974 /* tolerate obviously transposed args */
2975 if (!NILP (Fkeymapp (function)))
2977 Lisp_Object tmp = function;
2981 GCPRO2 (function, keymap);
2982 keymap = get_keymap (keymap, 1, 1);
2983 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
2984 map_keymap_mapper, LISP_TO_VOID (function));
2991 /************************************************************************/
2992 /* Accessible keymaps */
2993 /************************************************************************/
2995 struct accessible_keymaps_closure
3002 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
3003 unsigned int modifiers,
3004 struct accessible_keymaps_closure *closure)
3006 /* This function can GC */
3007 unsigned int subbits = MODIFIER_HASH_KEY_BITS (keysym);
3011 Lisp_Object submaps;
3013 contents = get_keymap (contents, 1, 1);
3014 submaps = keymap_submaps (contents);
3015 for (; !NILP (submaps); submaps = XCDR (submaps))
3017 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3018 XCDR (XCAR (submaps)),
3019 (subbits | modifiers),
3025 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3026 Lisp_Object cmd = get_keyelt (contents, 1);
3030 struct key_data key;
3031 key.keysym = keysym;
3032 key.modifiers = modifiers;
3036 cmd = get_keymap (cmd, 0, 1);
3040 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3041 len = XVECTOR_LENGTH (thisseq);
3042 for (j = 0; j < len; j++)
3043 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3044 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3046 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3052 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3054 /* This function can GC */
3055 struct accessible_keymaps_closure *closure =
3056 (struct accessible_keymaps_closure *) arg;
3057 Lisp_Object submaps = keymap_submaps (thismap);
3059 for (; !NILP (submaps); submaps = XCDR (submaps))
3061 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3062 XCDR (XCAR (submaps)),
3070 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3071 Find all keymaps accessible via prefix characters from KEYMAP.
3072 Returns a list of elements of the form (KEYS . MAP), where the sequence
3073 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3074 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3075 An optional argument PREFIX, if non-nil, should be a key sequence;
3076 then the value includes only maps for prefixes that start with PREFIX.
3080 /* This function can GC */
3081 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3082 Lisp_Object accessible_keymaps = Qnil;
3083 struct accessible_keymaps_closure c;
3085 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3088 keymap = get_keymap (keymap, 1, 1);
3090 prefix = make_vector (0, Qnil);
3091 else if (!VECTORP (prefix) || STRINGP (prefix))
3093 prefix = wrong_type_argument (Qarrayp, prefix);
3098 int len = XINT (Flength (prefix));
3099 Lisp_Object def = Flookup_key (keymap, prefix, Qnil);
3102 struct gcpro ngcpro1;
3104 def = get_keymap (def, 0, 1);
3109 p = make_vector (len, Qnil);
3111 for (iii = 0; iii < len; iii++)
3113 struct key_data key;
3114 define_key_parser (Faref (prefix, make_int (iii)), &key);
3115 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3121 accessible_keymaps = list1 (Fcons (prefix, keymap));
3123 /* For each map in the list maps,
3124 look at any other maps it points to
3125 and stick them at the end if they are not already in the list */
3127 for (c.tail = accessible_keymaps;
3129 c.tail = XCDR (c.tail))
3131 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3132 CHECK_KEYMAP (thismap);
3133 traverse_keymaps (thismap, Qnil,
3134 accessible_keymaps_keymap_mapper, &c);
3138 return accessible_keymaps;
3143 /************************************************************************/
3144 /* Pretty descriptions of key sequences */
3145 /************************************************************************/
3147 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3148 Return a pretty description of key-sequence KEYS.
3149 Control characters turn into "C-foo" sequences, meta into "M-foo",
3150 spaces are put between sequence elements, etc...
3154 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3157 return Fsingle_key_description (keys);
3159 else if (VECTORP (keys) ||
3162 Lisp_Object string = Qnil;
3163 /* Lisp_Object sep = Qnil; */
3164 int size = XINT (Flength (keys));
3167 for (i = 0; i < size; i++)
3169 Lisp_Object s2 = Fsingle_key_description
3171 ? make_char (string_char (XSTRING (keys), i))
3172 : XVECTOR_DATA (keys)[i]));
3178 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */;
3179 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3184 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3187 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3188 Return a pretty description of command character KEY.
3189 Control characters turn into C-whatever, etc.
3190 This differs from `text-char-description' in that it returns a description
3191 of a key read from the user rather than a character from a buffer.
3196 key = Fcons (key, Qnil); /* sleaze sleaze */
3198 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3203 struct Lisp_Event event;
3204 event.event_type = empty_event;
3205 CHECK_CHAR_COERCE_INT (key);
3206 character_to_event (XCHAR (key), &event,
3207 XCONSOLE (Vselected_console), 0, 1);
3208 format_event_object (buf, &event, 1);
3211 format_event_object (buf, XEVENT (key), 1);
3212 return build_string (buf);
3221 LIST_LOOP (rest, key)
3223 Lisp_Object keysym = XCAR (rest);
3224 if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2;
3225 else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2;
3226 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3227 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3228 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3229 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3230 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3231 else if (CHAR_OR_CHAR_INTP (keysym))
3233 bufp += set_charptr_emchar ((Bufbyte *) bufp,
3234 XCHAR_OR_CHAR_INT (keysym));
3239 CHECK_SYMBOL (keysym);
3240 #if 0 /* This is bogus */
3241 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3242 else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB");
3243 else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET");
3244 else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC");
3245 else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL");
3246 else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC");
3247 else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS");
3250 strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name));
3251 if (!NILP (XCDR (rest)))
3252 signal_simple_error ("Invalid key description",
3256 return build_string (buf);
3258 return Fsingle_key_description
3259 (wrong_type_argument (intern ("char-or-event-p"), key));
3262 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3263 Return a pretty description of file-character CHR.
3264 Unprintable characters turn into "^char" or \\NNN, depending on the value
3265 of the `ctl-arrow' variable.
3266 This differs from `single-key-description' in that it returns a description
3267 of a character from a buffer rather than a key read from the user.
3274 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3275 int ctl_p = !NILP (ctl_arrow);
3276 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3277 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3278 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3283 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3286 signal_simple_continuable_error
3287 ("character has no ASCII equivalent", Fcopy_event (chr, Qnil));
3291 CHECK_CHAR_COERCE_INT (chr);
3296 if (c >= printable_min)
3298 p += set_charptr_emchar (p, c);
3300 else if (c < 040 && ctl_p)
3303 *p++ = c + 64; /* 'A' - 1 */
3310 else if (c >= 0200 || c < 040)
3314 /* !!#### This syntax is not readable. It will
3315 be interpreted as a 3-digit octal number rather
3316 than a 7-digit octal number. */
3319 *p++ = '0' + ((c & 07000000) >> 18);
3320 *p++ = '0' + ((c & 0700000) >> 15);
3321 *p++ = '0' + ((c & 070000) >> 12);
3322 *p++ = '0' + ((c & 07000) >> 9);
3325 *p++ = '0' + ((c & 0700) >> 6);
3326 *p++ = '0' + ((c & 0070) >> 3);
3327 *p++ = '0' + ((c & 0007));
3331 p += set_charptr_emchar (p, c);
3335 return build_string ((char *) buf);
3339 /************************************************************************/
3340 /* where-is (mapping bindings to keys) */
3341 /************************************************************************/
3344 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3345 Lisp_Object firstonly, char *target_buffer);
3347 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3348 Return list of keys that invoke DEFINITION in KEYMAPS.
3349 KEYMAPS can be either a keymap (meaning search in that keymap and the
3350 current global keymap) or a list of keymaps (meaning search in exactly
3351 those keymaps and no others). If KEYMAPS is nil, search in the currently
3352 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3353 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3355 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3356 the first key sequence found, rather than a list of all possible key
3359 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3360 to other keymaps or slots. This makes it possible to search for an
3361 indirect definition itself.
3363 (definition, keymaps, firstonly, noindirect, event_or_keys))
3365 /* This function can GC */
3366 Lisp_Object maps[100];
3367 Lisp_Object *gubbish = maps;
3370 /* Get keymaps as an array */
3373 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3375 if (nmaps > countof (maps))
3377 gubbish = alloca_array (Lisp_Object, nmaps);
3378 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3381 else if (CONSP (keymaps))
3386 nmaps = XINT (Flength (keymaps));
3387 if (nmaps > countof (maps))
3389 gubbish = alloca_array (Lisp_Object, nmaps);
3391 for (rest = keymaps, i = 0; !NILP (rest);
3392 rest = XCDR (keymaps), i++)
3394 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3400 gubbish[0] = get_keymap (keymaps, 1, 1);
3401 if (!EQ (gubbish[0], Vcurrent_global_map))
3403 gubbish[1] = Vcurrent_global_map;
3408 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3411 /* This function is like
3412 (key-description (where-is-internal definition nil t))
3413 except that it writes its output into a (char *) buffer that you
3414 provide; it doesn't cons (or allocate memory) at all, so it's
3415 very fast. This is used by menubar.c.
3418 where_is_to_char (Lisp_Object definition, char *buffer)
3420 /* This function can GC */
3421 Lisp_Object maps[100];
3422 Lisp_Object *gubbish = maps;
3425 /* Get keymaps as an array */
3426 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3427 if (nmaps > countof (maps))
3429 gubbish = alloca_array (Lisp_Object, nmaps);
3430 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3434 where_is_internal (definition, maps, nmaps, Qt, buffer);
3439 raw_keys_to_keys (struct key_data *keys, int count)
3441 Lisp_Object result = make_vector (count, Qnil);
3443 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3449 format_raw_keys (struct key_data *keys, int count, char *buf)
3452 struct Lisp_Event event;
3453 event.event_type = key_press_event;
3454 event.channel = Vselected_console;
3455 for (i = 0; i < count; i++)
3457 event.event.key.keysym = keys[i].keysym;
3458 event.event.key.modifiers = keys[i].modifiers;
3459 format_event_object (buf, &event, 1);
3460 buf += strlen (buf);
3462 buf[0] = ' ', buf++;
3467 /* definition is the thing to look for.
3469 shadow is an array of shadow_count keymaps; if there is a different
3470 binding in any of the keymaps of a key that we are considering
3471 returning, then we reconsider.
3472 firstonly means give up after finding the first match;
3473 keys_so_far and modifiers_so_far describe which map we're looking in;
3474 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3475 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3476 will be MOD_META. That is, keys_so_far is the chain of keys that we
3477 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3480 (keys_so_far is a global buffer and the keys_count arg says how much
3481 of it we're currently interested in.)
3483 If target_buffer is provided, then we write a key-description into it,
3484 to avoid consing a string. This only works with firstonly on.
3487 struct where_is_closure
3489 Lisp_Object definition;
3490 Lisp_Object *shadow;
3494 unsigned int modifiers_so_far;
3495 char *target_buffer;
3496 struct key_data *keys_so_far;
3497 int keys_so_far_total_size;
3498 int keys_so_far_malloced;
3501 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3504 where_is_recursive_mapper (Lisp_Object map, void *arg)
3506 /* This function can GC */
3507 struct where_is_closure *c = (struct where_is_closure *) arg;
3508 Lisp_Object definition = c->definition;
3509 CONST int firstonly = c->firstonly;
3510 CONST unsigned int keys_count = c->keys_count;
3511 CONST unsigned int modifiers_so_far = c->modifiers_so_far;
3512 char *target_buffer = c->target_buffer;
3513 Lisp_Object keys = Fgethash (definition,
3514 XKEYMAP (map)->inverse_table,
3516 Lisp_Object submaps;
3517 Lisp_Object result = Qnil;
3521 /* One or more keys in this map match the definition we're looking for.
3522 Verify that these bindings aren't shadowed by other bindings
3523 in the shadow maps. Either nil or number as value from
3524 raw_lookup_key() means undefined. */
3525 struct key_data *so_far = c->keys_so_far;
3527 for (;;) /* loop over all keys that match */
3529 Lisp_Object k = ((CONSP (keys)) ? XCAR (keys) : keys);
3532 so_far [keys_count].keysym = k;
3533 so_far [keys_count].modifiers = modifiers_so_far;
3535 /* now loop over all shadow maps */
3536 for (i = 0; i < c->shadow_count; i++)
3538 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3543 if (NILP (shadowed) || CHARP (shadowed) ||
3544 EQ (shadowed, definition))
3545 continue; /* we passed this test; it's not shadowed here. */
3547 /* ignore this key binding, since it actually has a
3548 different binding in a shadowing map */
3549 goto c_doesnt_have_proper_loop_exit_statements;
3552 /* OK, the key is for real */
3555 if (!firstonly) abort ();
3556 format_raw_keys (so_far, keys_count + 1, target_buffer);
3557 return make_int (1);
3560 return raw_keys_to_keys (so_far, keys_count + 1);
3562 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3565 c_doesnt_have_proper_loop_exit_statements:
3566 /* now on to the next matching key ... */
3567 if (!CONSP (keys)) break;
3572 /* Now search the sub-keymaps of this map.
3573 If we're in "firstonly" mode and have already found one, this
3574 point is not reached. If we get one from lower down, either
3575 return it immediately (in firstonly mode) or tack it onto the
3576 end of the ones we've gotten so far.
3578 for (submaps = keymap_submaps (map);
3580 submaps = XCDR (submaps))
3582 Lisp_Object key = XCAR (XCAR (submaps));
3583 Lisp_Object submap = XCDR (XCAR (submaps));
3584 unsigned int lower_modifiers;
3585 int lower_keys_count = keys_count;
3588 submap = get_keymap (submap, 0, 0);
3590 if (EQ (submap, map))
3591 /* Arrgh! Some loser has introduced a loop... */
3594 /* If this is not a keymap, then that's probably because someone
3595 did an `fset' of a symbol that used to point to a map such that
3596 it no longer does. Sigh. Ignore this, and invalidate the cache
3597 so that it doesn't happen to us next time too.
3601 XKEYMAP (map)->sub_maps_cache = Qt;
3605 /* If the map is a "bucky" map, then add a bit to the
3606 modifiers_so_far list.
3607 Otherwise, add a new raw_key onto the end of keys_so_far.
3609 bucky = MODIFIER_HASH_KEY_BITS (key);
3611 lower_modifiers = (modifiers_so_far | bucky);
3614 struct key_data *so_far = c->keys_so_far;
3615 lower_modifiers = 0;
3616 so_far [lower_keys_count].keysym = key;
3617 so_far [lower_keys_count].modifiers = modifiers_so_far;
3621 if (lower_keys_count >= c->keys_so_far_total_size)
3623 int size = lower_keys_count + 50;
3624 if (! c->keys_so_far_malloced)
3626 struct key_data *new = xnew_array (struct key_data, size);
3627 memcpy ((void *)new, (CONST void *)c->keys_so_far,
3628 c->keys_so_far_total_size * sizeof (struct key_data));
3631 XREALLOC_ARRAY (c->keys_so_far, struct key_data, size);
3633 c->keys_so_far_total_size = size;
3634 c->keys_so_far_malloced = 1;
3640 c->keys_count = lower_keys_count;
3641 c->modifiers_so_far = lower_modifiers;
3643 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3645 c->keys_count = keys_count;
3646 c->modifiers_so_far = modifiers_so_far;
3649 result = nconc2 (lower, result);
3650 else if (!NILP (lower))
3659 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3660 Lisp_Object firstonly, char *target_buffer)
3662 /* This function can GC */
3663 Lisp_Object result = Qnil;
3665 struct key_data raw[20];
3666 struct where_is_closure c;
3668 c.definition = definition;
3670 c.firstonly = !NILP (firstonly);
3671 c.target_buffer = target_buffer;
3672 c.keys_so_far = raw;
3673 c.keys_so_far_total_size = countof (raw);
3674 c.keys_so_far_malloced = 0;
3676 /* Loop over each of the maps, accumulating the keys found.
3677 For each map searched, all previous maps shadow this one
3678 so that bogus keys aren't listed. */
3679 for (i = 0; i < nmaps; i++)
3681 Lisp_Object this_result;
3683 /* Reset the things set in each iteration */
3685 c.modifiers_so_far = 0;
3687 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3689 if (!NILP (firstonly))
3691 result = this_result;
3696 result = nconc2 (this_result, result);
3699 if (NILP (firstonly))
3700 result = Fnreverse (result);
3702 if (c.keys_so_far_malloced)
3703 xfree (c.keys_so_far);
3708 /************************************************************************/
3709 /* Describing keymaps */
3710 /************************************************************************/
3712 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3713 Insert a list of all defined keys and their definitions in MAP.
3714 Optional second argument ALL says whether to include even "uninteresting"
3715 definitions (ie symbols with a non-nil `suppress-keymap' property.
3716 Third argument SHADOW is a list of keymaps whose bindings shadow those
3717 of map; if a binding is present in any shadowing map, it is not printed.
3718 Fourth argument PREFIX, if non-nil, should be a key sequence;
3719 only bindings which start with that key sequence will be printed.
3720 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3722 (map, all, shadow, prefix, mouse_only_p))
3724 /* This function can GC */
3726 /* #### At some point, this function should be changed to accept a
3727 BUFFER argument. Currently, the BUFFER argument to
3728 describe_map_tree is being used only internally. */
3729 describe_map_tree (map, NILP (all), shadow, prefix,
3730 !NILP (mouse_only_p), Fcurrent_buffer ());
3735 /* Insert a description of the key bindings in STARTMAP,
3736 followed by those of all maps reachable through STARTMAP.
3737 If PARTIAL is nonzero, omit certain "uninteresting" commands
3738 (such as `undefined').
3739 If SHADOW is non-nil, it is a list of other maps;
3740 don't mention keys which would be shadowed by any of them
3741 If PREFIX is non-nil, only list bindings which start with those keys.
3745 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3746 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3748 /* This function can GC */
3749 Lisp_Object maps = Qnil;
3750 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3751 GCPRO2 (maps, shadow);
3753 maps = Faccessible_keymaps (startmap, prefix);
3755 for (; !NILP (maps); maps = Fcdr (maps))
3757 Lisp_Object sub_shadow = Qnil;
3758 Lisp_Object elt = Fcar (maps);
3760 int no_prefix = (VECTORP (Fcar (elt))
3761 && XINT (Flength (Fcar (elt))) == 0);
3762 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3763 NGCPRO3 (sub_shadow, elt, tail);
3765 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3767 Lisp_Object shmap = XCAR (tail);
3769 /* If the sequence by which we reach this keymap is zero-length,
3770 then the shadow maps for this keymap are just SHADOW. */
3773 /* If the sequence by which we reach this keymap actually has
3774 some elements, then the sequence's definition in SHADOW is
3775 what we should use. */
3778 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3785 Lisp_Object shm = get_keymap (shmap, 0, 1);
3786 /* If shmap is not nil and not a keymap, it completely
3787 shadows this map, so don't describe this map at all. */
3790 sub_shadow = Fcons (shm, sub_shadow);
3795 /* Describe the contents of map MAP, assuming that this map
3796 itself is reached by the sequence of prefix keys KEYS (a vector).
3797 PARTIAL and SHADOW are as in `describe_map_tree'. */
3798 Lisp_Object keysdesc
3800 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3802 describe_map (Fcdr (elt), keysdesc,
3817 describe_command (Lisp_Object definition, Lisp_Object buffer)
3819 /* This function can GC */
3820 int keymapp = !NILP (Fkeymapp (definition));
3821 struct gcpro gcpro1;
3822 GCPRO1 (definition);
3824 Findent_to (make_int (16), make_int (3), buffer);
3826 buffer_insert_c_string (XBUFFER (buffer), "<< ");
3828 if (SYMBOLP (definition))
3830 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3832 else if (STRINGP (definition) || VECTORP (definition))
3834 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: ");
3835 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3837 else if (COMPILED_FUNCTIONP (definition))
3838 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function");
3839 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
3840 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda");
3841 else if (KEYMAPP (definition))
3843 Lisp_Object name = XKEYMAP (definition)->name;
3844 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3846 buffer_insert_c_string (XBUFFER (buffer), "Prefix command ");
3848 && EQ (find_symbol_value (name), definition))
3849 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3852 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3856 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command");
3859 buffer_insert_c_string (XBUFFER (buffer), "??");
3862 buffer_insert_c_string (XBUFFER (buffer), " >>");
3863 buffer_insert_c_string (XBUFFER (buffer), "\n");
3867 struct describe_map_closure
3869 Lisp_Object *list; /* pointer to the list to update */
3870 Lisp_Object partial; /* whether to ignore suppressed commands */
3871 Lisp_Object shadow; /* list of maps shadowing this one */
3872 Lisp_Object self; /* this map */
3873 Lisp_Object self_root; /* this map, or some map that has this map as
3874 a parent. this is the base of the tree */
3875 int mice_only_p; /* whether we are to display only button bindings */
3878 struct describe_map_shadow_closure
3880 CONST struct key_data *raw_key;
3885 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3887 struct describe_map_shadow_closure *c =
3888 (struct describe_map_shadow_closure *) arg;
3890 if (EQ (map, c->self))
3891 return Qzero; /* Not shadowed; terminate search */
3893 return !NILP (keymap_lookup_directly (map,
3895 c->raw_key->modifiers))
3901 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3903 struct key_data *k = (struct key_data *) arg;
3904 return keymap_lookup_directly (km, k->keysym, k->modifiers);
3909 describe_map_mapper (CONST struct key_data *key,
3910 Lisp_Object binding,
3911 void *describe_map_closure)
3913 /* This function can GC */
3914 struct describe_map_closure *closure =
3915 (struct describe_map_closure *) describe_map_closure;
3916 Lisp_Object keysym = key->keysym;
3917 unsigned int modifiers = key->modifiers;
3919 /* Don't mention suppressed commands. */
3920 if (SYMBOLP (binding)
3921 && !NILP (closure->partial)
3922 && !NILP (Fget (binding, closure->partial, Qnil)))
3925 /* If we're only supposed to display mouse bindings and this isn't one,
3927 if (closure->mice_only_p &&
3928 (! (EQ (keysym, Qbutton0) ||
3929 EQ (keysym, Qbutton1) ||
3930 EQ (keysym, Qbutton2) ||
3931 EQ (keysym, Qbutton3) ||
3932 EQ (keysym, Qbutton4) ||
3933 EQ (keysym, Qbutton5) ||
3934 EQ (keysym, Qbutton6) ||
3935 EQ (keysym, Qbutton7) ||
3936 EQ (keysym, Qbutton0up) ||
3937 EQ (keysym, Qbutton1up) ||
3938 EQ (keysym, Qbutton2up) ||
3939 EQ (keysym, Qbutton3up) ||
3940 EQ (keysym, Qbutton4up) ||
3941 EQ (keysym, Qbutton5up) ||
3942 EQ (keysym, Qbutton6up) ||
3943 EQ (keysym, Qbutton7up))))
3946 /* If this command in this map is shadowed by some other map, ignore it. */
3950 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3953 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3954 keymap_lookup_inherited_mapper,
3955 /* Cast to discard `const' */
3961 /* If this key is in some map of which this map is a parent, then ignore
3962 it (in that case, it has been shadowed).
3966 struct describe_map_shadow_closure c;
3968 c.self = closure->self;
3970 sh = traverse_keymaps (closure->self_root, Qnil,
3971 describe_map_mapper_shadow_search, &c);
3972 if (!NILP (sh) && !ZEROP (sh))
3976 /* Otherwise add it to the list to be sorted. */
3977 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
3984 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
3987 /* obj1 and obj2 are conses of the form
3988 ( ( <keysym> . <modifiers> ) . <binding> )
3989 keysym and modifiers are used, binding is ignored.
3991 unsigned int bit1, bit2;
3994 bit1 = XINT (XCDR (obj1));
3995 bit2 = XINT (XCDR (obj2));
3997 return bit1 < bit2 ? 1 : -1;
3999 return map_keymap_sort_predicate (obj1, obj2, pred);
4002 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4003 or 2 or more symbolic keysyms that are bound to the same thing and
4004 have consecutive character-set-properties.
4007 elide_next_two_p (Lisp_Object list)
4011 if (NILP (XCDR (list)))
4014 /* next two bindings differ */
4015 if (!EQ (XCDR (XCAR (list)),
4016 XCDR (XCAR (XCDR (list)))))
4019 /* next two modifier-sets differ */
4020 if (!EQ (XCDR (XCAR (XCAR (list))),
4021 XCDR (XCAR (XCAR (XCDR (list))))))
4024 s1 = XCAR (XCAR (XCAR (list)));
4025 s2 = XCAR (XCAR (XCAR (XCDR (list))));
4029 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
4030 if (CHAR_OR_CHAR_INTP (code))
4033 CHECK_CHAR_COERCE_INT (s1);
4039 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
4040 if (CHAR_OR_CHAR_INTP (code))
4043 CHECK_CHAR_COERCE_INT (s2);
4048 return (XCHAR (s1) == XCHAR (s2) ||
4049 XCHAR (s1) + 1 == XCHAR (s2));
4054 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
4056 /* This function can GC */
4057 struct describe_map_closure *describe_map_closure =
4058 (struct describe_map_closure *) arg;
4059 describe_map_closure->self = keymap;
4060 map_keymap (XKEYMAP (keymap)->table,
4061 0, /* don't sort: we'll do it later */
4062 describe_map_mapper, describe_map_closure);
4067 /* Describe the contents of map MAP, assuming that this map itself is
4068 reached by the sequence of prefix keys KEYS (a string or vector).
4069 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4072 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
4073 void (*elt_describer) (Lisp_Object, Lisp_Object),
4079 /* This function can GC */
4080 struct describe_map_closure describe_map_closure;
4081 Lisp_Object list = Qnil;
4082 struct buffer *buf = XBUFFER (buffer);
4083 Emchar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
4084 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
4085 : ((EQ (buf->ctl_arrow, Qt)
4086 || EQ (buf->ctl_arrow, Qnil))
4089 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4091 keymap = get_keymap (keymap, 1, 1);
4092 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4093 describe_map_closure.shadow = shadow;
4094 describe_map_closure.list = &list;
4095 describe_map_closure.self_root = keymap;
4096 describe_map_closure.mice_only_p = mice_only_p;
4098 GCPRO4 (keymap, elt_prefix, shadow, list);
4100 traverse_keymaps (keymap, Qnil,
4101 describe_map_parent_mapper, &describe_map_closure);
4105 list = list_sort (list, Qnil, describe_map_sort_predicate);
4106 buffer_insert_c_string (buf, "\n");
4107 while (!NILP (list))
4109 Lisp_Object elt = XCAR (XCAR (list));
4110 Lisp_Object keysym = XCAR (elt);
4111 unsigned int modifiers = XINT (XCDR (elt));
4113 if (!NILP (elt_prefix))
4114 buffer_insert_lisp_string (buf, elt_prefix);
4116 if (modifiers & MOD_META) buffer_insert_c_string (buf, "M-");
4117 if (modifiers & MOD_CONTROL) buffer_insert_c_string (buf, "C-");
4118 if (modifiers & MOD_SUPER) buffer_insert_c_string (buf, "S-");
4119 if (modifiers & MOD_HYPER) buffer_insert_c_string (buf, "H-");
4120 if (modifiers & MOD_ALT) buffer_insert_c_string (buf, "Alt-");
4121 if (modifiers & MOD_SHIFT) buffer_insert_c_string (buf, "Sh-");
4122 if (SYMBOLP (keysym))
4124 Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil);
4125 Emchar c = (CHAR_OR_CHAR_INTP (code)
4126 ? XCHAR_OR_CHAR_INT (code) : (Emchar) -1);
4127 /* Calling Fsingle_key_description() would cons more */
4128 #if 0 /* This is bogus */
4129 if (EQ (keysym, QKlinefeed))
4130 buffer_insert_c_string (buf, "LFD");
4131 else if (EQ (keysym, QKtab))
4132 buffer_insert_c_string (buf, "TAB");
4133 else if (EQ (keysym, QKreturn))
4134 buffer_insert_c_string (buf, "RET");
4135 else if (EQ (keysym, QKescape))
4136 buffer_insert_c_string (buf, "ESC");
4137 else if (EQ (keysym, QKdelete))
4138 buffer_insert_c_string (buf, "DEL");
4139 else if (EQ (keysym, QKspace))
4140 buffer_insert_c_string (buf, "SPC");
4141 else if (EQ (keysym, QKbackspace))
4142 buffer_insert_c_string (buf, "BS");
4145 if (c >= printable_min)
4146 buffer_insert_emacs_char (buf, c);
4147 else buffer_insert1 (buf, Fsymbol_name (keysym));
4149 else if (CHARP (keysym))
4150 buffer_insert_emacs_char (buf, XCHAR (keysym));
4152 buffer_insert_c_string (buf, "---bad keysym---");
4160 while (elide_next_two_p (list))
4168 buffer_insert_c_string (buf, ", ");
4170 buffer_insert_c_string (buf, " .. ");
4176 /* Print a description of the definition of this character. */
4177 (*elt_describer) (XCDR (XCAR (list)), buffer);
4186 syms_of_keymap (void)
4188 defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist");
4190 defsymbol (&Qkeymapp, "keymapp");
4192 defsymbol (&Qsuppress_keymap, "suppress-keymap");
4194 defsymbol (&Qmodeline_map, "modeline-map");
4195 defsymbol (&Qtoolbar_map, "toolbar-map");
4197 DEFSUBR (Fkeymap_parents);
4198 DEFSUBR (Fset_keymap_parents);
4199 DEFSUBR (Fkeymap_name);
4200 DEFSUBR (Fset_keymap_name);
4201 DEFSUBR (Fkeymap_prompt);
4202 DEFSUBR (Fset_keymap_prompt);
4203 DEFSUBR (Fkeymap_default_binding);
4204 DEFSUBR (Fset_keymap_default_binding);
4207 DEFSUBR (Fmake_keymap);
4208 DEFSUBR (Fmake_sparse_keymap);
4210 DEFSUBR (Fcopy_keymap);
4211 DEFSUBR (Fkeymap_fullness);
4212 DEFSUBR (Fmap_keymap);
4213 DEFSUBR (Fevent_matches_key_specifier_p);
4214 DEFSUBR (Fdefine_key);
4215 DEFSUBR (Flookup_key);
4216 DEFSUBR (Fkey_binding);
4217 DEFSUBR (Fuse_global_map);
4218 DEFSUBR (Fuse_local_map);
4219 DEFSUBR (Fcurrent_local_map);
4220 DEFSUBR (Fcurrent_global_map);
4221 DEFSUBR (Fcurrent_keymaps);
4222 DEFSUBR (Faccessible_keymaps);
4223 DEFSUBR (Fkey_description);
4224 DEFSUBR (Fsingle_key_description);
4225 DEFSUBR (Fwhere_is_internal);
4226 DEFSUBR (Fdescribe_bindings_internal);
4228 DEFSUBR (Ftext_char_description);
4230 defsymbol (&Qcontrol, "control");
4231 defsymbol (&Qctrl, "ctrl");
4232 defsymbol (&Qmeta, "meta");
4233 defsymbol (&Qsuper, "super");
4234 defsymbol (&Qhyper, "hyper");
4235 defsymbol (&Qalt, "alt");
4236 defsymbol (&Qshift, "shift");
4237 defsymbol (&Qbutton0, "button0");
4238 defsymbol (&Qbutton1, "button1");
4239 defsymbol (&Qbutton2, "button2");
4240 defsymbol (&Qbutton3, "button3");
4241 defsymbol (&Qbutton4, "button4");
4242 defsymbol (&Qbutton5, "button5");
4243 defsymbol (&Qbutton6, "button6");
4244 defsymbol (&Qbutton7, "button7");
4245 defsymbol (&Qbutton0up, "button0up");
4246 defsymbol (&Qbutton1up, "button1up");
4247 defsymbol (&Qbutton2up, "button2up");
4248 defsymbol (&Qbutton3up, "button3up");
4249 defsymbol (&Qbutton4up, "button4up");
4250 defsymbol (&Qbutton5up, "button5up");
4251 defsymbol (&Qbutton6up, "button6up");
4252 defsymbol (&Qbutton7up, "button7up");
4253 defsymbol (&Qmouse_1, "mouse-1");
4254 defsymbol (&Qmouse_2, "mouse-2");
4255 defsymbol (&Qmouse_3, "mouse-3");
4256 defsymbol (&Qmouse_4, "mouse-4");
4257 defsymbol (&Qmouse_5, "mouse-5");
4258 defsymbol (&Qdown_mouse_1, "down-mouse-1");
4259 defsymbol (&Qdown_mouse_2, "down-mouse-2");
4260 defsymbol (&Qdown_mouse_3, "down-mouse-3");
4261 defsymbol (&Qdown_mouse_4, "down-mouse-4");
4262 defsymbol (&Qdown_mouse_5, "down-mouse-5");
4263 defsymbol (&Qmenu_selection, "menu-selection");
4264 defsymbol (&QLFD, "LFD");
4265 defsymbol (&QTAB, "TAB");
4266 defsymbol (&QRET, "RET");
4267 defsymbol (&QESC, "ESC");
4268 defsymbol (&QDEL, "DEL");
4269 defsymbol (&QBS, "BS");
4273 vars_of_keymap (void)
4275 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
4276 Meta-prefix character.
4277 This character followed by some character `foo' turns into `Meta-foo'.
4278 This can be any form recognized as a single key specifier.
4279 To disable the meta-prefix-char, set it to a negative number.
4281 Vmeta_prefix_char = make_char (033);
4283 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4284 A buffer which should be consulted first for all mouse activity.
4285 When a mouse-click is processed, it will first be looked up in the
4286 local-map of this buffer, and then through the normal mechanism if there
4287 is no binding for that click. This buffer's value of `mode-motion-hook'
4288 will be consulted instead of the `mode-motion-hook' of the buffer of the
4289 window under the mouse. You should *bind* this, not set it.
4291 Vmouse_grabbed_buffer = Qnil;
4293 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
4294 Keymap that overrides all other local keymaps.
4295 If this variable is non-nil, it is used as a keymap instead of the
4296 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4297 You should *bind* this, not set it.
4299 Voverriding_local_map = Qnil;
4301 Fset (Qminor_mode_map_alist, Qnil);
4303 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
4304 Keymap of key translations that can override keymaps.
4305 This keymap works like `function-key-map', but comes after that,
4306 and applies even for keys that have ordinary bindings.
4308 Vkey_translation_map = Qnil;
4310 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
4311 Keymap which handles mouse clicks over vertical dividers.
4313 Vvertical_divider_map = Qnil;
4315 DEFVAR_INT ("keymap-tick", &keymap_tick /*
4316 Incremented for each change to any keymap.
4320 staticpro (&Vcurrent_global_map);
4322 Vsingle_space_string = make_pure_string ((CONST Bufbyte *) " ", 1, Qnil, 1);
4323 staticpro (&Vsingle_space_string);
4327 complex_vars_of_keymap (void)
4329 /* This function can GC */
4330 Lisp_Object ESC_prefix = intern ("ESC-prefix");
4331 Lisp_Object meta_disgustitute;
4333 Vcurrent_global_map = Fmake_keymap (Qnil);
4335 meta_disgustitute = Fmake_keymap (Qnil);
4336 Ffset (ESC_prefix, meta_disgustitute);
4337 /* no need to protect meta_disgustitute, though */
4338 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (MOD_META),
4339 XKEYMAP (Vcurrent_global_map),
4341 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
4343 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));