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. */
40 #include "events-mod.h"
43 /* A keymap contains six slots:
45 parents Ordered list of keymaps to search after
46 this one if no match is found.
47 Keymaps can thus be arranged in a hierarchy.
49 table A hash table, hashing keysyms to their bindings.
50 It will be one of the following:
52 -- a symbol, e.g. 'home
53 -- a character, representing something printable
54 (not ?\C-c meaning C-c, for instance)
55 -- an integer representing a modifier combination
57 inverse_table A hash table, hashing bindings to the list of keysyms
58 in this keymap which are bound to them. This is to make
59 the Fwhere_is_internal() function be fast. It needs to be
60 fast because we want to be able to call it in realtime to
61 update the keyboard-equivalents on the pulldown menus.
62 Values of the table are either atoms (keysyms)
63 or a dotted list of keysyms.
65 sub_maps_cache An alist; for each entry in this keymap whose binding is
66 a keymap (that is, Fkeymapp()) this alist associates that
67 keysym with that binding. This is used to optimize both
68 Fwhere_is_internal() and Faccessible_keymaps(). This slot
69 gets set to the symbol `t' every time a change is made to
70 this keymap, causing it to be recomputed when next needed.
72 prompt See `set-keymap-prompt'.
74 default_binding See `set-keymap-default-binding'.
76 Sequences of keys are stored in the obvious way: if the sequence of keys
77 "abc" was bound to some command `foo', the hierarchy would look like
79 keymap-1: associates "a" with keymap-2
80 keymap-2: associates "b" with keymap-3
81 keymap-3: associates "c" with foo
83 However, bucky bits ("modifiers" to the X-minded) are represented in the
84 keymap hierarchy as well. (This lets us use EQable objects as hash keys.)
85 Each combination of modifiers (e.g. control-hyper) gets its own submap
86 off of the main map. The hash key for a modifier combination is
87 an integer, computed by MAKE_MODIFIER_HASH_KEY().
89 If the key `C-a' was bound to some command, the hierarchy would look like
91 keymap-1: associates the integer XEMACS_MOD_CONTROL with keymap-2
92 keymap-2: associates "a" with the command
94 Similarly, if the key `C-H-a' was bound to some command, the hierarchy
97 keymap-1: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
99 keymap-2: associates "a" with the command
101 Note that a special exception is made for the meta modifier, in order
102 to deal with ESC/meta lossage. Any key combination containing the
103 meta modifier is first indexed off of the main map into the meta
104 submap (with hash key XEMACS_MOD_META) and then indexed off of the
105 meta submap with the meta modifier removed from the key combination.
106 For example, when associating a command with C-M-H-a, we'd have
108 keymap-1: associates the integer XEMACS_MOD_META with keymap-2
109 keymap-2: associates the integer (XEMACS_MOD_CONTROL | XEMACS_MOD_HYPER)
111 keymap-3: associates "a" with the command
113 Note that keymap-2 might have normal bindings in it; these would be
114 for key combinations containing only the meta modifier, such as
115 M-y or meta-backspace.
117 If the command that "a" was bound to in keymap-3 was itself a keymap,
118 then that would make the key "C-M-H-a" be a prefix character.
120 Note that this new model of keymaps takes much of the magic away from
121 the Escape key: the value of the variable `esc-map' is no longer indexed
122 in the `global-map' under the ESC key. It's indexed under the integer
123 XEMACS_MOD_META. This is not user-visible, however; none of the "bucky"
126 There is a hack in Flookup_key() that makes (lookup-key global-map "\^[")
127 and (define-key some-random-map "\^[" my-esc-map) work as before, for
130 Since keymaps are opaque, the only way to extract information from them
131 is with the functions lookup-key, key-binding, local-key-binding, and
132 global-key-binding, which work just as before, and the new function
133 map-keymap, which is roughly analogous to maphash.
135 Note that map-keymap perpetuates the illusion that the "bucky" submaps
136 don't exist: if you map over a keymap with bucky submaps, it will also
137 map over those submaps. It does not, however, map over other random
138 submaps of the keymap, just the bucky ones.
140 One implication of this is that when you map over `global-map', you will
141 also map over `esc-map'. It is merely for compatibility that the esc-map
142 is accessible at all; I think that's a bad thing, since it blurs the
143 distinction between ESC and "meta" even more. "M-x" is no more a two-
144 key sequence than "C-x" is.
150 struct lcrecord_header header;
151 Lisp_Object parents; /* Keymaps to be searched after this one.
153 Lisp_Object prompt; /* Qnil or a string to print in the minibuffer
154 when reading from this keymap */
155 Lisp_Object table; /* The contents of this keymap */
156 Lisp_Object inverse_table; /* The inverse mapping of the above */
157 Lisp_Object default_binding; /* Use this if no other binding is found
158 (this overrides parent maps and the
159 normal global-map lookup). */
160 Lisp_Object sub_maps_cache; /* Cache of directly inferior keymaps;
161 This holds an alist, of the key and the
162 maps, or the modifier bit and the map.
163 If this is the symbol t, then the cache
164 needs to be recomputed. */
165 Lisp_Object name; /* Just for debugging convenience */
168 #define MAKE_MODIFIER_HASH_KEY(modifier) make_int (modifier)
169 #define MODIFIER_HASH_KEY_BITS(x) (INTP (x) ? XINT (x) : 0)
173 /* Actually allocate storage for these variables */
175 Lisp_Object Vcurrent_global_map; /* Always a keymap */
177 static Lisp_Object Vmouse_grabbed_buffer;
179 /* Alist of minor mode variables and keymaps. */
180 static Lisp_Object Qminor_mode_map_alist;
182 static Lisp_Object Voverriding_local_map;
184 static Lisp_Object Vkey_translation_map;
186 static Lisp_Object Vvertical_divider_map;
188 /* This is incremented whenever a change is made to a keymap. This is
189 so that things which care (such as the menubar code) can recompute
190 privately-cached data when the user has changed keybindings.
194 /* Prefixing a key with this character is the same as sending a meta bit. */
195 Lisp_Object Vmeta_prefix_char;
197 Lisp_Object Qkeymapp;
198 Lisp_Object Vsingle_space_string;
199 Lisp_Object Qsuppress_keymap;
200 Lisp_Object Qmodeline_map;
201 Lisp_Object Qtoolbar_map;
203 EXFUN (Fkeymap_fullness, 1);
204 EXFUN (Fset_keymap_name, 2);
205 EXFUN (Fsingle_key_description, 1);
207 static void describe_command (Lisp_Object definition, Lisp_Object buffer);
208 static void describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
209 void (*elt_describer) (Lisp_Object, Lisp_Object),
214 static Lisp_Object keymap_submaps (Lisp_Object keymap);
216 Lisp_Object Qcontrol, Qctrl, Qmeta, Qsuper, Qhyper, Qalt, Qshift;
217 Lisp_Object Qbutton0, Qbutton1, Qbutton2, Qbutton3;
218 Lisp_Object Qbutton4, Qbutton5, Qbutton6, Qbutton7;
219 Lisp_Object Qbutton0up, Qbutton1up, Qbutton2up, Qbutton3up;
220 Lisp_Object Qbutton4up, Qbutton5up, Qbutton6up, Qbutton7up;
222 Lisp_Object Qmenu_selection;
223 /* Emacs compatibility */
224 Lisp_Object Qdown_mouse_1, Qmouse_1;
225 Lisp_Object Qdown_mouse_2, Qmouse_2;
226 Lisp_Object Qdown_mouse_3, Qmouse_3;
227 Lisp_Object Qdown_mouse_4, Qmouse_4;
228 Lisp_Object Qdown_mouse_5, Qmouse_5;
229 Lisp_Object Qdown_mouse_6, Qmouse_6;
230 Lisp_Object Qdown_mouse_7, Qmouse_7;
232 /* Kludge kludge kludge */
233 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
236 /************************************************************************/
237 /* The keymap Lisp object */
238 /************************************************************************/
241 mark_keymap (Lisp_Object obj)
243 Lisp_Keymap *keymap = XKEYMAP (obj);
244 mark_object (keymap->parents);
245 mark_object (keymap->prompt);
246 mark_object (keymap->inverse_table);
247 mark_object (keymap->sub_maps_cache);
248 mark_object (keymap->default_binding);
249 mark_object (keymap->name);
250 return keymap->table;
254 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
256 /* This function can GC */
257 Lisp_Keymap *keymap = XKEYMAP (obj);
260 error ("printing unreadable object #<keymap 0x%x>", keymap->header.uid);
261 write_c_string ("#<keymap ", printcharfun);
262 if (!NILP (keymap->name))
264 print_internal (keymap->name, printcharfun, 1);
265 write_c_string (" ", printcharfun);
267 sprintf (buf, "size %ld 0x%x>",
268 (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid);
269 write_c_string (buf, printcharfun);
272 static const struct lrecord_description keymap_description[] = {
273 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, parents) },
274 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, prompt) },
275 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, table) },
276 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, inverse_table) },
277 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, default_binding) },
278 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, sub_maps_cache) },
279 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, name) },
283 /* No need for keymap_equal #### Why not? */
284 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap,
285 mark_keymap, print_keymap, 0, 0, 0,
289 /************************************************************************/
290 /* Traversing keymaps and their parents */
291 /************************************************************************/
294 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents,
295 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg),
298 /* This function can GC */
300 Lisp_Object tail = start_parents;
301 Lisp_Object malloc_sucks[10];
302 Lisp_Object malloc_bites = Qnil;
304 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
305 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail);
308 start_keymap = get_keymap (start_keymap, 1, 1);
309 keymap = start_keymap;
310 /* Hack special-case parents at top-level */
311 tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents;
318 result = mapper (keymap, mapper_arg);
321 while (CONSP (malloc_bites))
323 Lisp_Cons *victim = XCONS (malloc_bites);
324 malloc_bites = victim->cdr;
332 if (stack_depth == 0)
335 return Qnil; /* Nothing found */
338 if (CONSP (malloc_bites))
340 Lisp_Cons *victim = XCONS (malloc_bites);
342 malloc_bites = victim->cdr;
347 tail = malloc_sucks[stack_depth];
348 gcpro1.nvars = stack_depth;
350 keymap = XCAR (tail);
357 keymap = XCAR (tail);
359 parents = XKEYMAP (keymap)->parents;
360 if (!CONSP (parents))
362 else if (NILP (tail))
367 if (CONSP (malloc_bites))
368 malloc_bites = noseeum_cons (tail, malloc_bites);
369 else if (stack_depth < countof (malloc_sucks))
371 malloc_sucks[stack_depth++] = tail;
372 gcpro1.nvars = stack_depth;
376 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */
378 for (i = 0, malloc_bites = Qnil;
379 i < countof (malloc_sucks);
381 malloc_bites = noseeum_cons (malloc_sucks[i],
388 keymap = get_keymap (keymap, 1, 1);
389 if (EQ (keymap, start_keymap))
391 signal_simple_error ("Cyclic keymap indirection",
398 /************************************************************************/
399 /* Some low-level functions */
400 /************************************************************************/
403 bucky_sym_to_bucky_bit (Lisp_Object sym)
405 if (EQ (sym, Qcontrol)) return XEMACS_MOD_CONTROL;
406 if (EQ (sym, Qmeta)) return XEMACS_MOD_META;
407 if (EQ (sym, Qsuper)) return XEMACS_MOD_SUPER;
408 if (EQ (sym, Qhyper)) return XEMACS_MOD_HYPER;
409 if (EQ (sym, Qalt)) return XEMACS_MOD_ALT;
410 if (EQ (sym, Qsymbol)) return XEMACS_MOD_ALT; /* #### - reverse compat */
411 if (EQ (sym, Qshift)) return XEMACS_MOD_SHIFT;
417 control_meta_superify (Lisp_Object frob, int modifiers)
421 frob = Fcons (frob, Qnil);
422 if (modifiers & XEMACS_MOD_SHIFT) frob = Fcons (Qshift, frob);
423 if (modifiers & XEMACS_MOD_ALT) frob = Fcons (Qalt, frob);
424 if (modifiers & XEMACS_MOD_HYPER) frob = Fcons (Qhyper, frob);
425 if (modifiers & XEMACS_MOD_SUPER) frob = Fcons (Qsuper, frob);
426 if (modifiers & XEMACS_MOD_CONTROL) frob = Fcons (Qcontrol, frob);
427 if (modifiers & XEMACS_MOD_META) frob = Fcons (Qmeta, frob);
432 make_key_description (const struct key_data *key, int prettify)
434 Lisp_Object keysym = key->keysym;
435 int modifiers = key->modifiers;
437 if (prettify && CHARP (keysym))
439 /* This is a little slow, but (control a) is prettier than (control 65).
440 It's now ok to do this for digit-chars too, since we've fixed the
441 bug where \9 read as the integer 9 instead of as the symbol with
444 /* !!#### I'm not sure how correct this is. */
445 Bufbyte str [1 + MAX_EMCHAR_LEN];
446 Bytecount count = set_charptr_emchar (str, XCHAR (keysym));
448 keysym = intern ((char *) str);
450 return control_meta_superify (keysym, modifiers);
454 /************************************************************************/
455 /* Low-level keymap-store functions */
456 /************************************************************************/
459 raw_lookup_key (Lisp_Object keymap,
460 const struct key_data *raw_keys, int raw_keys_count,
461 int keys_so_far, int accept_default);
463 /* Relies on caller to gc-protect args */
465 keymap_lookup_directly (Lisp_Object keymap,
466 Lisp_Object keysym, int modifiers)
470 modifiers &= ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3
471 | XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5);
472 if ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER
473 | XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT))
477 k = XKEYMAP (keymap);
479 /* If the keysym is a one-character symbol, use the char code instead. */
480 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
482 Lisp_Object i_fart_on_gcc =
483 make_char (string_char (XSYMBOL (keysym)->name, 0));
484 keysym = i_fart_on_gcc;
487 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
489 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
493 k = XKEYMAP (submap);
494 modifiers &= ~XEMACS_MOD_META;
499 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
503 k = XKEYMAP (submap);
505 return Fgethash (keysym, k->table, Qnil);
509 keymap_store_inverse_internal (Lisp_Object inverse_table,
513 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
518 /* Don't cons this unless necessary */
519 /* keys = Fcons (keysym, Qnil); */
520 Fputhash (value, keys, inverse_table);
522 else if (!CONSP (keys))
524 /* Now it's necessary to cons */
525 keys = Fcons (keys, keysym);
526 Fputhash (value, keys, inverse_table);
530 while (CONSP (XCDR (keys)))
532 XCDR (keys) = Fcons (XCDR (keys), keysym);
533 /* No need to call puthash because we've destructively
534 modified the list tail in place */
540 keymap_delete_inverse_internal (Lisp_Object inverse_table,
544 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
545 Lisp_Object new_keys = keys;
552 for (prev = &new_keys, tail = new_keys;
554 prev = &(XCDR (tail)), tail = XCDR (tail))
556 if (EQ (tail, keysym))
561 else if (EQ (keysym, XCAR (tail)))
569 Fremhash (value, inverse_table);
570 else if (!EQ (keys, new_keys))
571 /* Removed the first elt */
572 Fputhash (value, new_keys, inverse_table);
573 /* else the list's tail has been modified, so we don't need to
574 touch the hash table again (the pointer in there is ok).
578 /* Prevent luser from shooting herself in the foot using something like
579 (define-key ctl-x-4-map "p" global-map) */
581 check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap)
583 def = get_keymap (def, 0, 0);
589 if (XKEYMAP (def) == to_keymap)
590 signal_simple_error ("Cyclic keymap definition", def);
592 for (maps = keymap_submaps (def);
595 check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap);
600 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
603 Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil);
605 if (EQ (prev_def, def))
608 check_keymap_definition_loop (def, keymap);
610 if (!NILP (prev_def))
611 keymap_delete_inverse_internal (keymap->inverse_table,
615 Fremhash (keysym, keymap->table);
619 Fputhash (keysym, def, keymap->table);
620 keymap_store_inverse_internal (keymap->inverse_table,
628 create_bucky_submap (Lisp_Keymap *k, int modifiers,
629 Lisp_Object parent_for_debugging_info)
631 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
632 /* User won't see this, but it is nice for debugging Emacs */
633 XKEYMAP (submap)->name
634 = control_meta_superify (parent_for_debugging_info, modifiers);
635 /* Invalidate cache */
636 k->sub_maps_cache = Qt;
637 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
642 /* Relies on caller to gc-protect keymap, keysym, value */
644 keymap_store (Lisp_Object keymap, const struct key_data *key,
647 Lisp_Object keysym = key->keysym;
648 int modifiers = key->modifiers;
649 Lisp_Keymap *k = XKEYMAP (keymap);
651 modifiers &= ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3
652 | XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5);
653 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META
654 | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER
655 | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0);
657 /* If the keysym is a one-character symbol, use the char code instead. */
658 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
659 keysym = make_char (string_char (XSYMBOL (keysym)->name, 0));
661 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
663 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
666 submap = create_bucky_submap (k, XEMACS_MOD_META, keymap);
667 k = XKEYMAP (submap);
668 modifiers &= ~XEMACS_MOD_META;
673 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
676 submap = create_bucky_submap (k, modifiers, keymap);
677 k = XKEYMAP (submap);
679 k->sub_maps_cache = Qt; /* Invalidate cache */
680 keymap_store_internal (keysym, k, value);
684 /************************************************************************/
685 /* Listing the submaps of a keymap */
686 /************************************************************************/
688 struct keymap_submaps_closure
690 Lisp_Object *result_locative;
694 keymap_submaps_mapper_0 (Lisp_Object key, Lisp_Object value,
695 void *keymap_submaps_closure)
697 /* This function can GC */
698 /* Perform any autoloads, etc */
704 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value,
705 void *keymap_submaps_closure)
707 /* This function can GC */
708 Lisp_Object *result_locative;
709 struct keymap_submaps_closure *cl =
710 (struct keymap_submaps_closure *) keymap_submaps_closure;
711 result_locative = cl->result_locative;
713 if (!NILP (Fkeymapp (value)))
714 *result_locative = Fcons (Fcons (key, value), *result_locative);
718 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
722 keymap_submaps (Lisp_Object keymap)
724 /* This function can GC */
725 Lisp_Keymap *k = XKEYMAP (keymap);
727 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
729 Lisp_Object result = Qnil;
730 struct gcpro gcpro1, gcpro2;
731 struct keymap_submaps_closure keymap_submaps_closure;
733 GCPRO2 (keymap, result);
734 keymap_submaps_closure.result_locative = &result;
735 /* Do this first pass to touch (and load) any autoloaded maps */
736 elisp_maphash (keymap_submaps_mapper_0, k->table,
737 &keymap_submaps_closure);
739 elisp_maphash (keymap_submaps_mapper, k->table,
740 &keymap_submaps_closure);
741 /* keep it sorted so that the result of accessible-keymaps is ordered */
742 k->sub_maps_cache = list_sort (result,
744 map_keymap_sort_predicate);
747 return k->sub_maps_cache;
751 /************************************************************************/
752 /* Basic operations on keymaps */
753 /************************************************************************/
756 make_keymap (size_t size)
759 Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, &lrecord_keymap);
761 XSETKEYMAP (result, keymap);
763 keymap->parents = Qnil;
764 keymap->prompt = Qnil;
765 keymap->table = Qnil;
766 keymap->inverse_table = Qnil;
767 keymap->default_binding = Qnil;
768 keymap->sub_maps_cache = Qnil; /* No possible submaps */
771 if (size != 0) /* hack for copy-keymap */
774 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
775 /* Inverse table is often less dense because of duplicate key-bindings.
776 If not, it will grow anyway. */
777 keymap->inverse_table =
778 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
783 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
784 Construct and return a new keymap object.
785 All entries in it are nil, meaning "command undefined".
787 Optional argument NAME specifies a name to assign to the keymap,
788 as in `set-keymap-name'. This name is only a debugging convenience;
789 it is not used except when printing the keymap.
793 Lisp_Object keymap = make_keymap (60);
795 Fset_keymap_name (keymap, name);
799 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
800 Construct and return a new keymap object.
801 All entries in it are nil, meaning "command undefined". The only
802 difference between this function and `make-keymap' is that this function
803 returns a "smaller" keymap (one that is expected to contain fewer
804 entries). As keymaps dynamically resize, this distinction is not great.
806 Optional argument NAME specifies a name to assign to the keymap,
807 as in `set-keymap-name'. This name is only a debugging convenience;
808 it is not used except when printing the keymap.
812 Lisp_Object keymap = make_keymap (8);
814 Fset_keymap_name (keymap, name);
818 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
819 Return the `parent' keymaps of KEYMAP, or nil.
820 The parents of a keymap are searched for keybindings when a key sequence
821 isn't bound in this one. `(current-global-map)' is the default parent
826 keymap = get_keymap (keymap, 1, 1);
827 return Fcopy_sequence (XKEYMAP (keymap)->parents);
833 traverse_keymaps_noop (Lisp_Object keymap, void *arg)
838 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
839 Set the `parent' keymaps of KEYMAP to PARENTS.
840 The parents of a keymap are searched for keybindings when a key sequence
841 isn't bound in this one. `(current-global-map)' is the default parent
846 /* This function can GC */
848 struct gcpro gcpro1, gcpro2;
850 GCPRO2 (keymap, parents);
851 keymap = get_keymap (keymap, 1, 1);
853 if (KEYMAPP (parents)) /* backwards-compatibility */
854 parents = list1 (parents);
857 Lisp_Object tail = parents;
863 /* Require that it be an actual keymap object, rather than a symbol
864 with a (crockish) symbol-function which is a keymap */
865 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
870 /* Check for circularities */
871 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
873 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
878 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
879 Set the `name' of the KEYMAP to NEW-NAME.
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 XKEYMAP (keymap)->name = new_name;
891 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
892 Return the `name' of KEYMAP.
893 The name is only a debugging convenience; it is not used except
894 when printing the keymap.
898 keymap = get_keymap (keymap, 1, 1);
900 return XKEYMAP (keymap)->name;
903 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
904 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
905 if no prompt is desired. The prompt is shown in the echo-area
906 when reading a key-sequence to be looked-up in this keymap.
908 (keymap, new_prompt))
910 keymap = get_keymap (keymap, 1, 1);
912 if (!NILP (new_prompt))
913 CHECK_STRING (new_prompt);
915 XKEYMAP (keymap)->prompt = new_prompt;
920 keymap_prompt_mapper (Lisp_Object keymap, void *arg)
922 return XKEYMAP (keymap)->prompt;
926 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
927 Return the `prompt' of KEYMAP.
928 If non-nil, the prompt is shown in the echo-area
929 when reading a key-sequence to be looked-up in this keymap.
931 (keymap, use_inherited))
933 /* This function can GC */
936 keymap = get_keymap (keymap, 1, 1);
937 prompt = XKEYMAP (keymap)->prompt;
938 if (!NILP (prompt) || NILP (use_inherited))
941 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
944 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
945 Sets the default binding of KEYMAP to COMMAND, or `nil'
946 if no default is desired. The default-binding is returned when
947 no other binding for a key-sequence is found in the keymap.
948 If a keymap has a non-nil default-binding, neither the keymap's
949 parents nor the current global map are searched for key bindings.
953 /* This function can GC */
954 keymap = get_keymap (keymap, 1, 1);
956 XKEYMAP (keymap)->default_binding = command;
960 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
961 Return the default binding of KEYMAP, or `nil' if it has none.
962 The default-binding is returned when no other binding for a key-sequence
963 is found in the keymap.
964 If a keymap has a non-nil default-binding, neither the keymap's
965 parents nor the current global map are searched for key bindings.
969 /* This function can GC */
970 keymap = get_keymap (keymap, 1, 1);
971 return XKEYMAP (keymap)->default_binding;
974 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
975 Return t if OBJECT is a keymap object.
976 The keymap may be autoloaded first if necessary.
980 /* This function can GC */
981 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
984 /* Check that OBJECT is a keymap (after dereferencing through any
985 symbols). If it is, return it.
987 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
988 is an autoload form, do the autoload and try again.
989 If AUTOLOAD is nonzero, callers must assume GC is possible.
991 ERRORP controls how we respond if OBJECT isn't a keymap.
992 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
994 Note that most of the time, we don't want to pursue autoloads.
995 Functions like Faccessible_keymaps which scan entire keymap trees
996 shouldn't load every autoloaded keymap. I'm not sure about this,
997 but it seems to me that only read_key_sequence, Flookup_key, and
998 Fdefine_key should cause keymaps to be autoloaded. */
1001 get_keymap (Lisp_Object object, int errorp, int autoload)
1003 /* This function can GC */
1006 Lisp_Object tem = indirect_function (object, 0);
1010 /* Should we do an autoload? */
1012 /* (autoload "filename" doc nil keymap) */
1015 && EQ (XCAR (tem), Qautoload)
1016 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
1018 /* do_autoload GCPROs both arguments */
1019 do_autoload (tem, object);
1022 object = wrong_type_argument (Qkeymapp, object);
1028 /* Given OBJECT which was found in a slot in a keymap,
1029 trace indirect definitions to get the actual definition of that slot.
1030 An indirect definition is a list of the form
1031 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1032 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1035 get_keyelt (Lisp_Object object, int accept_default)
1037 /* This function can GC */
1041 if (!CONSP (object))
1045 struct gcpro gcpro1;
1047 map = XCAR (object);
1048 map = get_keymap (map, 0, 1);
1051 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1054 Lisp_Object idx = Fcdr (object);
1055 struct key_data indirection;
1059 event.event_type = empty_event;
1060 character_to_event (XCHAR (idx), &event,
1061 XCONSOLE (Vselected_console), 0, 0);
1062 indirection = event.event.key;
1064 else if (CONSP (idx))
1066 if (!INTP (XCDR (idx)))
1068 indirection.keysym = XCAR (idx);
1069 indirection.modifiers = (unsigned char) XINT (XCDR (idx));
1071 else if (SYMBOLP (idx))
1073 indirection.keysym = idx;
1074 indirection.modifiers = 0;
1081 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
1083 else if (STRINGP (XCAR (object)))
1085 /* If the keymap contents looks like (STRING . DEFN),
1087 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1088 will be used by HierarKey menus. */
1089 object = XCDR (object);
1094 /* Anything else is really the value. */
1100 keymap_lookup_1 (Lisp_Object keymap, const struct key_data *key,
1103 /* This function can GC */
1104 return get_keyelt (keymap_lookup_directly (keymap,
1105 key->keysym, key->modifiers),
1110 /************************************************************************/
1111 /* Copying keymaps */
1112 /************************************************************************/
1114 struct copy_keymap_inverse_closure
1116 Lisp_Object inverse_table;
1120 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value,
1121 void *copy_keymap_inverse_closure)
1123 struct copy_keymap_inverse_closure *closure =
1124 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
1126 /* copy-sequence deals with dotted lists. */
1128 value = Fcopy_list (value);
1129 Fputhash (key, value, closure->inverse_table);
1136 copy_keymap_internal (Lisp_Keymap *keymap)
1138 Lisp_Object nkm = make_keymap (0);
1139 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
1140 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1141 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1143 new_keymap->parents = Fcopy_sequence (keymap->parents);
1144 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1145 new_keymap->table = Fcopy_hash_table (keymap->table);
1146 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table);
1147 new_keymap->default_binding = keymap->default_binding;
1148 /* After copying the inverse map, we need to copy the conses which
1149 are its values, lest they be shared by the copy, and mangled.
1151 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
1152 ©_keymap_inverse_closure);
1157 static Lisp_Object copy_keymap (Lisp_Object keymap);
1159 struct copy_keymap_closure
1165 copy_keymap_mapper (Lisp_Object key, Lisp_Object value,
1166 void *copy_keymap_closure)
1168 /* This function can GC */
1169 struct copy_keymap_closure *closure =
1170 (struct copy_keymap_closure *) copy_keymap_closure;
1172 /* When we encounter a keymap which is indirected through a
1173 symbol, we need to copy the sub-map. In v18, the form
1174 (lookup-key (copy-keymap global-map) "\C-x")
1175 returned a new keymap, not the symbol 'Control-X-prefix.
1177 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */
1178 if (KEYMAPP (value))
1179 keymap_store_internal (key, closure->self,
1180 copy_keymap (value));
1185 copy_keymap (Lisp_Object keymap)
1187 /* This function can GC */
1188 struct copy_keymap_closure copy_keymap_closure;
1190 keymap = copy_keymap_internal (XKEYMAP (keymap));
1191 copy_keymap_closure.self = XKEYMAP (keymap);
1192 elisp_maphash (copy_keymap_mapper,
1193 XKEYMAP (keymap)->table,
1194 ©_keymap_closure);
1198 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1199 Return a copy of the keymap KEYMAP.
1200 The copy starts out with the same definitions of KEYMAP,
1201 but changing either the copy or KEYMAP does not affect the other.
1202 Any key definitions that are subkeymaps are recursively copied.
1206 /* This function can GC */
1207 keymap = get_keymap (keymap, 1, 1);
1208 return copy_keymap (keymap);
1213 keymap_fullness (Lisp_Object keymap)
1215 /* This function can GC */
1217 Lisp_Object sub_maps;
1218 struct gcpro gcpro1, gcpro2;
1220 keymap = get_keymap (keymap, 1, 1);
1221 fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table));
1222 GCPRO2 (keymap, sub_maps);
1223 for (sub_maps = keymap_submaps (keymap);
1225 sub_maps = XCDR (sub_maps))
1227 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
1229 Lisp_Object bucky_map = XCDR (XCAR (sub_maps));
1230 fullness--; /* don't count bucky maps themselves. */
1231 fullness += keymap_fullness (bucky_map);
1238 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1239 Return the number of bindings in the keymap.
1243 /* This function can GC */
1244 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
1248 /************************************************************************/
1249 /* Defining keys in keymaps */
1250 /************************************************************************/
1252 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1253 and perform any necessary canonicalization. */
1256 define_key_check_and_coerce_keysym (Lisp_Object spec,
1257 Lisp_Object *keysym,
1260 /* Now, check and massage the trailing keysym specifier. */
1261 if (SYMBOLP (*keysym))
1263 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
1265 Lisp_Object ream_gcc_up_the_ass =
1266 make_char (string_char (XSYMBOL (*keysym)->name, 0));
1267 *keysym = ream_gcc_up_the_ass;
1271 else if (CHAR_OR_CHAR_INTP (*keysym))
1273 CHECK_CHAR_COERCE_INT (*keysym);
1275 if (XCHAR (*keysym) < ' '
1276 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
1277 /* yuck! Can't make the above restriction; too many compatibility
1279 signal_simple_error ("keysym char must be printable", *keysym);
1280 /* #### This bites! I want to be able to write (control shift a) */
1281 if (modifiers & XEMACS_MOD_SHIFT)
1283 ("The `shift' modifier may not be applied to ASCII keysyms",
1288 signal_simple_error ("Unknown keysym specifier", *keysym);
1291 if (SYMBOLP (*keysym))
1293 char *name = (char *) string_data (XSYMBOL (*keysym)->name);
1295 /* FSFmacs uses symbols with the printed representation of keysyms in
1296 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1297 confusion, notice the M-x syntax and signal an error - because
1298 otherwise it would be interpreted as a regular keysym, and would even
1299 show up in the list-buffers output, causing confusion to the naive.
1301 We can get away with this because none of the X keysym names contain
1302 a hyphen (some contain underscore, however).
1304 It might be useful to reject keysyms which are not x-valid-keysym-
1305 name-p, but that would interfere with various tricks we do to
1306 sanitize the Sun keyboards, and would make it trickier to
1307 conditionalize a .emacs file for multiple X servers.
1309 if (((int) strlen (name) >= 2 && name[1] == '-')
1312 /* Ok, this is a bit more dubious - prevent people from doing things
1313 like (global-set-key 'RET 'something) because that will have the
1314 same problem as above. (Gag!) Maybe we should just silently
1315 accept these as aliases for the "real" names?
1317 (string_length (XSYMBOL (*keysym)->name) <= 3 &&
1318 (!strcmp (name, "LFD") ||
1319 !strcmp (name, "TAB") ||
1320 !strcmp (name, "RET") ||
1321 !strcmp (name, "ESC") ||
1322 !strcmp (name, "DEL") ||
1323 !strcmp (name, "SPC") ||
1324 !strcmp (name, "BS")))
1328 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1331 /* #### Ok, this is a bit more dubious - make people not lose if they
1332 do things like (global-set-key 'RET 'something) because that would
1333 otherwise have the same problem as above. (Gag!) We silently
1334 accept these as aliases for the "real" names.
1336 else if (!strncmp(name, "kp_", 3)) {
1337 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1340 strncpy(temp, name, sizeof (temp));
1341 temp[sizeof (temp) - 1] = '\0';
1343 *keysym = Fintern_soft(make_string((Bufbyte *)temp,
1346 } else if (EQ (*keysym, QLFD))
1347 *keysym = QKlinefeed;
1348 else if (EQ (*keysym, QTAB))
1350 else if (EQ (*keysym, QRET))
1352 else if (EQ (*keysym, QESC))
1354 else if (EQ (*keysym, QDEL))
1356 else if (EQ (*keysym, QSPC))
1358 else if (EQ (*keysym, QBS))
1359 *keysym = QKbackspace;
1360 /* Emacs compatibility */
1361 else if (EQ(*keysym, Qdown_mouse_1))
1363 else if (EQ(*keysym, Qdown_mouse_2))
1365 else if (EQ(*keysym, Qdown_mouse_3))
1367 else if (EQ(*keysym, Qdown_mouse_4))
1369 else if (EQ(*keysym, Qdown_mouse_5))
1371 else if (EQ(*keysym, Qdown_mouse_6))
1373 else if (EQ(*keysym, Qdown_mouse_7))
1375 else if (EQ(*keysym, Qmouse_1))
1376 *keysym = Qbutton1up;
1377 else if (EQ(*keysym, Qmouse_2))
1378 *keysym = Qbutton2up;
1379 else if (EQ(*keysym, Qmouse_3))
1380 *keysym = Qbutton3up;
1381 else if (EQ(*keysym, Qmouse_4))
1382 *keysym = Qbutton4up;
1383 else if (EQ(*keysym, Qmouse_5))
1384 *keysym = Qbutton5up;
1385 else if (EQ(*keysym, Qmouse_6))
1386 *keysym = Qbutton6up;
1387 else if (EQ(*keysym, Qmouse_7))
1388 *keysym = Qbutton7up;
1393 /* Given any kind of key-specifier, return a keysym and modifier mask.
1394 Proper canonicalization is performed:
1396 -- integers are converted into the equivalent characters.
1397 -- one-character strings are converted into the equivalent characters.
1401 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
1403 if (CHAR_OR_CHAR_INTP (spec))
1406 event.event_type = empty_event;
1407 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
1408 XCONSOLE (Vselected_console), 0, 0);
1409 returned_value->keysym = event.event.key.keysym;
1410 returned_value->modifiers = event.event.key.modifiers;
1412 else if (EVENTP (spec))
1414 switch (XEVENT (spec)->event_type)
1416 case key_press_event:
1418 returned_value->keysym = XEVENT (spec)->event.key.keysym;
1419 returned_value->modifiers = XEVENT (spec)->event.key.modifiers;
1422 case button_press_event:
1423 case button_release_event:
1425 int down = (XEVENT (spec)->event_type == button_press_event);
1426 switch (XEVENT (spec)->event.button.button)
1429 returned_value->keysym = (down ? Qbutton1 : Qbutton1up); break;
1431 returned_value->keysym = (down ? Qbutton2 : Qbutton2up); break;
1433 returned_value->keysym = (down ? Qbutton3 : Qbutton3up); break;
1435 returned_value->keysym = (down ? Qbutton4 : Qbutton4up); break;
1437 returned_value->keysym = (down ? Qbutton5 : Qbutton5up); break;
1439 returned_value->keysym = (down ? Qbutton6 : Qbutton6up); break;
1441 returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break;
1443 returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break;
1445 returned_value->modifiers = XEVENT (spec)->event.button.modifiers;
1449 signal_error (Qwrong_type_argument,
1450 list2 (build_translated_string
1451 ("unable to bind this type of event"),
1455 else if (SYMBOLP (spec))
1457 /* Be nice, allow = to mean (=) */
1458 if (bucky_sym_to_bucky_bit (spec) != 0)
1459 signal_simple_error ("Key is a modifier name", spec);
1460 define_key_check_and_coerce_keysym (spec, &spec, 0);
1461 returned_value->keysym = spec;
1462 returned_value->modifiers = 0;
1464 else if (CONSP (spec))
1467 Lisp_Object keysym = Qnil;
1468 Lisp_Object rest = spec;
1470 /* First, parse out the leading modifier symbols. */
1471 while (CONSP (rest))
1475 keysym = XCAR (rest);
1476 modifier = bucky_sym_to_bucky_bit (keysym);
1477 modifiers |= modifier;
1478 if (!NILP (XCDR (rest)))
1481 signal_simple_error ("Unknown modifier", keysym);
1486 signal_simple_error ("Nothing but modifiers here",
1493 signal_simple_error ("List must be nil-terminated", spec);
1495 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
1496 returned_value->keysym = keysym;
1497 returned_value->modifiers = modifiers;
1501 signal_simple_error ("Unknown key-sequence specifier",
1506 /* Used by character-to-event */
1508 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
1509 int allow_menu_events)
1511 struct key_data raw_key;
1513 if (allow_menu_events &&
1515 /* #### where the hell does this come from? */
1516 EQ (XCAR (list), Qmenu_selection))
1518 Lisp_Object fn, arg;
1519 if (! NILP (Fcdr (Fcdr (list))))
1520 signal_simple_error ("Invalid menu event desc", list);
1521 arg = Fcar (Fcdr (list));
1523 fn = Qcall_interactively;
1526 XSETFRAME (XEVENT (event)->channel, selected_frame ());
1527 XEVENT (event)->event_type = misc_user_event;
1528 XEVENT (event)->event.eval.function = fn;
1529 XEVENT (event)->event.eval.object = arg;
1533 define_key_parser (list, &raw_key);
1535 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) ||
1536 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) ||
1537 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) ||
1538 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) ||
1539 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) ||
1540 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) ||
1541 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) ||
1542 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up))
1543 error ("Mouse-clicks can't appear in saved keyboard macros.");
1545 XEVENT (event)->channel = Vselected_console;
1546 XEVENT (event)->event_type = key_press_event;
1547 XEVENT (event)->event.key.keysym = raw_key.keysym;
1548 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
1553 event_matches_key_specifier_p (Lisp_Event *event, Lisp_Object key_specifier)
1555 Lisp_Object event2 = Qnil;
1557 struct gcpro gcpro1;
1559 if (event->event_type != key_press_event || NILP (key_specifier) ||
1560 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
1563 /* if the specifier is an integer such as 27, then it should match
1564 both of the events 'escape' and 'control ['. Calling
1565 Fcharacter_to_event() will only match 'escape'. */
1566 if (CHAR_OR_CHAR_INTP (key_specifier))
1567 return (XCHAR_OR_CHAR_INT (key_specifier)
1568 == event_to_character (event, 0, 0, 0));
1570 /* Otherwise, we cannot call event_to_character() because we may
1571 be dealing with non-ASCII keystrokes. In any case, if I ask
1572 for 'control [' then I should get exactly that, and not
1575 However, we have to behave differently on TTY's, where 'control ['
1576 is silently converted into 'escape' by the keyboard driver.
1577 In this case, ASCII is the only thing we know about, so we have
1578 to compare the ASCII values. */
1581 event2 = Fmake_event (Qnil, Qnil);
1582 Fcharacter_to_event (key_specifier, event2, Qnil, Qnil);
1583 if (XEVENT (event2)->event_type != key_press_event)
1585 else if (CONSOLE_TTY_P (XCONSOLE (EVENT_CHANNEL (event))))
1589 ch1 = event_to_character (event, 0, 0, 0);
1590 ch2 = event_to_character (XEVENT (event2), 0, 0, 0);
1591 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1593 else if (EQ (event->event.key.keysym, XEVENT (event2)->event.key.keysym) &&
1594 event->event.key.modifiers == XEVENT (event2)->event.key.modifiers)
1598 Fdeallocate_event (event2);
1604 meta_prefix_char_p (const struct key_data *key)
1608 event.event_type = key_press_event;
1609 event.channel = Vselected_console;
1610 event.event.key.keysym = key->keysym;
1611 event.event.key.modifiers = key->modifiers;
1612 return event_matches_key_specifier_p (&event, Vmeta_prefix_char);
1615 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1616 Return non-nil if EVENT matches KEY-SPECIFIER.
1617 This can be useful, e.g., to determine if the user pressed `help-char' or
1620 (event, key_specifier))
1622 CHECK_LIVE_EVENT (event);
1623 return (event_matches_key_specifier_p (XEVENT (event), key_specifier)
1627 #define MACROLET(k,m) do { \
1628 returned_value->keysym = (k); \
1629 returned_value->modifiers = (m); \
1630 RETURN_SANS_WARNINGS; \
1634 Given a keysym, return another keysym/modifier pair which could be
1635 considered the same key in an ASCII world. Backspace returns ^H, for
1639 define_key_alternate_name (struct key_data *key,
1640 struct key_data *returned_value)
1642 Lisp_Object keysym = key->keysym;
1643 int modifiers = key->modifiers;
1644 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL));
1645 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META));
1646 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1647 returned_value->modifiers = 0;
1648 if (modifiers_sans_meta == XEMACS_MOD_CONTROL)
1650 if (EQ (keysym, QKspace))
1651 MACROLET (make_char ('@'), modifiers);
1652 else if (!CHARP (keysym))
1654 else switch (XCHAR (keysym))
1656 case '@': /* c-@ => c-space */
1657 MACROLET (QKspace, modifiers);
1658 case 'h': /* c-h => backspace */
1659 MACROLET (QKbackspace, modifiers_sans_control);
1660 case 'i': /* c-i => tab */
1661 MACROLET (QKtab, modifiers_sans_control);
1662 case 'j': /* c-j => linefeed */
1663 MACROLET (QKlinefeed, modifiers_sans_control);
1664 case 'm': /* c-m => return */
1665 MACROLET (QKreturn, modifiers_sans_control);
1666 case '[': /* c-[ => escape */
1667 MACROLET (QKescape, modifiers_sans_control);
1672 else if (modifiers_sans_meta != 0)
1674 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
1675 MACROLET (make_char ('h'), (modifiers | XEMACS_MOD_CONTROL));
1676 else if (EQ (keysym, QKtab)) /* tab => c-i */
1677 MACROLET (make_char ('i'), (modifiers | XEMACS_MOD_CONTROL));
1678 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
1679 MACROLET (make_char ('j'), (modifiers | XEMACS_MOD_CONTROL));
1680 else if (EQ (keysym, QKreturn)) /* return => c-m */
1681 MACROLET (make_char ('m'), (modifiers | XEMACS_MOD_CONTROL));
1682 else if (EQ (keysym, QKescape)) /* escape => c-[ */
1683 MACROLET (make_char ('['), (modifiers | XEMACS_MOD_CONTROL));
1691 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
1694 /* This function can GC */
1695 Lisp_Object new_keys;
1697 Lisp_Object mpc_binding;
1698 struct key_data meta_key;
1700 if (NILP (Vmeta_prefix_char) ||
1701 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
1704 define_key_parser (Vmeta_prefix_char, &meta_key);
1705 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
1706 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
1711 else if (STRINGP (keys))
1712 new_keys = Fsubstring (keys, Qzero, make_int (indx));
1713 else if (VECTORP (keys))
1715 new_keys = make_vector (indx, Qnil);
1716 for (i = 0; i < indx; i++)
1717 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
1725 if (EQ (keys, new_keys))
1726 error_with_frob (mpc_binding,
1727 "can't bind %s: %s has a non-keymap binding",
1728 (char *) XSTRING_DATA (Fkey_description (keys)),
1729 (char *) XSTRING_DATA (Fsingle_key_description
1730 (Vmeta_prefix_char)));
1732 error_with_frob (mpc_binding,
1733 "can't bind %s: %s %s has a non-keymap binding",
1734 (char *) XSTRING_DATA (Fkey_description (keys)),
1735 (char *) XSTRING_DATA (Fkey_description (new_keys)),
1736 (char *) XSTRING_DATA (Fsingle_key_description
1737 (Vmeta_prefix_char)));
1740 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
1741 Define key sequence KEYS, in KEYMAP, as DEF.
1742 KEYMAP is a keymap object.
1743 KEYS is the sequence of keystrokes to bind, described below.
1744 DEF is anything that can be a key's definition:
1745 nil (means key is undefined in this keymap);
1746 a command (a Lisp function suitable for interactive calling);
1747 a string or key sequence vector (treated as a keyboard macro);
1748 a keymap (to define a prefix key);
1749 a symbol; when the key is looked up, the symbol will stand for its
1750 function definition, that should at that time be one of the above,
1751 or another symbol whose function definition is used, and so on.
1752 a cons (STRING . DEFN), meaning that DEFN is the definition
1753 (DEFN should be a valid definition in its own right);
1754 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1756 Contrary to popular belief, the world is not ASCII. When running under a
1757 window manager, XEmacs can tell the difference between, for example, the
1758 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1759 bind different commands to each of these.
1761 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1762 set of modifiers (such as control and meta). A `keysym' is what is printed
1763 on the keys on your keyboard.
1765 A keysym may be represented by a symbol, or (if and only if it is equivalent
1766 to an ASCII character in the range 32 - 255) by a character or its equivalent
1767 ASCII code. The `A' key may be represented by the symbol `A', the character
1768 `?A', or by the number 65. The `break' key may be represented only by the
1771 A keystroke may be represented by a list: the last element of the list
1772 is the key (a symbol, character, or number, as above) and the
1773 preceding elements are the symbolic names of modifier keys (control,
1774 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1775 represented by the forms `(control b)', `(control ?b)', and `(control
1776 98)'. A keystroke may also be represented by an event object, as
1777 returned by the `next-command-event' and `read-key-sequence'
1780 Note that in this context, the keystroke `control-b' is *not* represented
1781 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1783 The `shift' modifier is somewhat of a special case. You should not (and
1784 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1785 have ASCII equivalents, the state of the shift key is implicit in the
1786 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1787 sort of thing varies from keyboard to keyboard. The shift modifier is for
1788 use only with characters that do not have a second keysym on the same key,
1789 such as `backspace' and `tab'.
1791 A key sequence is a vector of keystrokes. As a degenerate case, elements
1792 of this vector may also be keysyms if they have no modifiers. That is,
1793 the `A' keystroke is represented by all of these forms:
1794 A ?A 65 (A) (?A) (65)
1795 [A] [?A] [65] [(A)] [(?A)] [(65)]
1797 the `control-a' keystroke is represented by these forms:
1798 (control A) (control ?A) (control 65)
1799 [(control A)] [(control ?A)] [(control 65)]
1800 the key sequence `control-c control-a' is represented by these forms:
1801 [(control c) (control a)] [(control ?c) (control ?a)]
1802 [(control 99) (control 65)] etc.
1804 Mouse button clicks work just like keypresses: (control button1) means
1805 pressing the left mouse button while holding down the control key.
1806 \[(control c) (shift button3)] means control-c, hold shift, click right.
1808 Commands may be bound to the mouse-button up-stroke rather than the down-
1809 stroke as well. `button1' means the down-stroke, and `button1up' means the
1810 up-stroke. Different commands may be bound to the up and down strokes,
1811 though that is probably not what you want, so be careful.
1813 For backward compatibility, a key sequence may also be represented by a
1814 string. In this case, it represents the key sequence(s) that would
1815 produce that sequence of ASCII characters in a purely ASCII world. For
1816 example, a string containing the ASCII backspace character, "\\^H", would
1817 represent two key sequences: `(control h)' and `backspace'. Binding a
1818 command to this will actually bind both of those key sequences. Likewise
1819 for the following pairs:
1826 control @ control space
1828 After binding a command to two key sequences with a form like
1830 (define-key global-map "\\^X\\^I" \'command-1)
1832 it is possible to redefine only one of those sequences like so:
1834 (define-key global-map [(control x) (control i)] \'command-2)
1835 (define-key global-map [(control x) tab] \'command-3)
1837 Of course, all of this applies only when running under a window system. If
1838 you're talking to XEmacs through a TTY connection, you don't get any of
1841 (keymap, keys, def))
1843 /* This function can GC */
1848 struct gcpro gcpro1, gcpro2, gcpro3;
1851 len = XVECTOR_LENGTH (keys);
1852 else if (STRINGP (keys))
1853 len = XSTRING_CHAR_LENGTH (keys);
1854 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
1856 if (!CONSP (keys)) keys = list1 (keys);
1858 keys = make_vector (1, keys); /* this is kinda sleazy. */
1862 keys = wrong_type_argument (Qsequencep, keys);
1863 len = XINT (Flength (keys));
1868 GCPRO3 (keymap, keys, def);
1871 When the user defines a key which, in a strictly ASCII world, would be
1872 produced by two different keys (^J and linefeed, or ^H and backspace,
1873 for example) then the binding will be made for both keysyms.
1875 This is done if the user binds a command to a string, as in
1876 (define-key map "\^H" 'something), but not when using one of the new
1877 syntaxes, like (define-key map '(control h) 'something).
1879 ascii_hack = (STRINGP (keys));
1881 keymap = get_keymap (keymap, 1, 1);
1887 struct key_data raw_key1;
1888 struct key_data raw_key2;
1891 c = make_char (string_char (XSTRING (keys), idx));
1893 c = XVECTOR_DATA (keys) [idx];
1895 define_key_parser (c, &raw_key1);
1897 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
1899 if (idx == (len - 1))
1901 /* This is a hack to prevent a binding for the meta-prefix-char
1902 from being made in a map which already has a non-empty "meta"
1903 submap. That is, we can't let both "escape" and "meta" have
1904 a binding in the same keymap. This implies that the idiom
1905 (define-key my-map "\e" my-escape-map)
1906 (define-key my-escape-map "a" 'my-command)
1907 no longer works. That's ok. Instead the luser should do
1908 (define-key my-map "\ea" 'my-command)
1910 (define-key my-map "\M-a" 'my-command)
1912 (defvar my-escape-map (lookup-key my-map "\e"))
1913 if the luser really wants the map in a variable.
1915 Lisp_Object meta_map;
1916 struct gcpro ngcpro1;
1919 meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
1920 XKEYMAP (keymap)->table, Qnil);
1921 if (!NILP (meta_map)
1922 && keymap_fullness (meta_map) != 0)
1923 signal_simple_error_2
1924 ("Map contains meta-bindings, can't bind",
1925 Fsingle_key_description (Vmeta_prefix_char), keymap);
1937 define_key_alternate_name (&raw_key1, &raw_key2);
1940 raw_key2.keysym = Qnil;
1941 raw_key2.modifiers = 0;
1946 raw_key1.modifiers |= XEMACS_MOD_META;
1947 raw_key2.modifiers |= XEMACS_MOD_META;
1951 /* This crap is to make sure that someone doesn't bind something like
1952 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
1953 if (raw_key1.modifiers & XEMACS_MOD_META)
1954 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
1958 keymap_store (keymap, &raw_key1, def);
1959 if (ascii_hack && !NILP (raw_key2.keysym))
1960 keymap_store (keymap, &raw_key2, def);
1967 struct gcpro ngcpro1;
1970 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
1973 cmd = Fmake_sparse_keymap (Qnil);
1974 XKEYMAP (cmd)->name /* for debugging */
1975 = list2 (make_key_description (&raw_key1, 1), keymap);
1976 keymap_store (keymap, &raw_key1, cmd);
1978 if (NILP (Fkeymapp (cmd)))
1979 signal_simple_error_2 ("Invalid prefix keys in sequence",
1982 if (ascii_hack && !NILP (raw_key2.keysym) &&
1983 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
1984 keymap_store (keymap, &raw_key2, cmd);
1986 keymap = get_keymap (cmd, 1, 1);
1993 /************************************************************************/
1994 /* Looking up keys in keymaps */
1995 /************************************************************************/
1997 /* We need a very fast (i.e., non-consing) version of lookup-key in order
1998 to make where-is-internal really fly. */
2000 struct raw_lookup_key_mapper_closure
2003 const struct key_data *raw_keys;
2009 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
2011 /* Caller should gc-protect args (keymaps may autoload) */
2013 raw_lookup_key (Lisp_Object keymap,
2014 const struct key_data *raw_keys, int raw_keys_count,
2015 int keys_so_far, int accept_default)
2017 /* This function can GC */
2018 struct raw_lookup_key_mapper_closure c;
2019 c.remaining = raw_keys_count - 1;
2020 c.raw_keys = raw_keys;
2021 c.raw_keys_count = raw_keys_count;
2022 c.keys_so_far = keys_so_far;
2023 c.accept_default = accept_default;
2025 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
2029 raw_lookup_key_mapper (Lisp_Object k, void *arg)
2031 /* This function can GC */
2032 struct raw_lookup_key_mapper_closure *c =
2033 (struct raw_lookup_key_mapper_closure *) arg;
2034 int accept_default = c->accept_default;
2035 int remaining = c->remaining;
2036 int keys_so_far = c->keys_so_far;
2037 const struct key_data *raw_keys = c->raw_keys;
2040 if (! meta_prefix_char_p (&(raw_keys[0])))
2042 /* Normal case: every case except the meta-hack (see below). */
2043 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2046 /* Return whatever we found if we're out of keys */
2048 else if (NILP (cmd))
2049 /* Found nothing (though perhaps parent map may have binding) */
2051 else if (NILP (Fkeymapp (cmd)))
2052 /* Didn't find a keymap, and we have more keys.
2053 * Return a fixnum to indicate that keys were too long.
2055 cmd = make_int (keys_so_far + 1);
2057 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2058 keys_so_far + 1, accept_default);
2062 /* This is a hack so that looking up a key-sequence whose last
2063 * element is the meta-prefix-char will return the keymap that
2064 * the "meta" keys are stored in, if there is no binding for
2065 * the meta-prefix-char (and if this map has a "meta" submap).
2066 * If this map doesn't have a "meta" submap, then the
2067 * meta-prefix-char is looked up just like any other key.
2071 /* First look for the prefix-char directly */
2072 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2075 /* Do kludgy return of the meta-map */
2076 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
2077 XKEYMAP (k)->table, Qnil);
2082 /* Search for the prefix-char-prefixed sequence directly */
2083 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2084 cmd = get_keymap (cmd, 0, 1);
2086 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2087 keys_so_far + 1, accept_default);
2088 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0)
2090 struct key_data metified;
2091 metified.keysym = raw_keys[1].keysym;
2092 metified.modifiers = raw_keys[1].modifiers |
2093 (unsigned char) XEMACS_MOD_META;
2095 /* Search for meta-next-char sequence directly */
2096 cmd = keymap_lookup_1 (k, &metified, accept_default);
2101 cmd = get_keymap (cmd, 0, 1);
2103 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
2110 if (accept_default && NILP (cmd))
2111 cmd = XKEYMAP (k)->default_binding;
2115 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2116 /* Caller should gc-protect arguments */
2118 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
2121 /* This function can GC */
2122 struct key_data kkk[20];
2123 struct key_data *raw_keys;
2129 if (nkeys < countof (kkk))
2132 raw_keys = alloca_array (struct key_data, nkeys);
2134 for (i = 0; i < nkeys; i++)
2136 define_key_parser (keys[i], &(raw_keys[i]));
2138 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
2142 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2145 /* This function can GC */
2146 struct key_data kkk[20];
2150 struct key_data *raw_keys;
2151 Lisp_Object tem = Qnil;
2152 struct gcpro gcpro1, gcpro2;
2155 CHECK_LIVE_EVENT (event_head);
2157 nkeys = event_chain_count (event_head);
2159 if (nkeys < countof (kkk))
2162 raw_keys = alloca_array (struct key_data, nkeys);
2165 EVENT_CHAIN_LOOP (event, event_head)
2166 define_key_parser (event, &(raw_keys[nkeys++]));
2167 GCPRO2 (keymaps[0], event_head);
2168 gcpro1.nvars = nmaps;
2169 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
2170 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
2171 for (iii = 0; iii < nmaps; iii++)
2173 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
2177 /* Too long in some local map means don't look at global map */
2181 else if (!NILP (tem))
2188 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
2189 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2190 Nil is returned if KEYS is unbound. See documentation of `define-key'
2191 for valid key definitions and key-sequence specifications.
2192 A number is returned if KEYS is "too long"; that is, the leading
2193 characters fail to be a valid sequence of prefix characters in KEYMAP.
2194 The number is how many key strokes at the front of KEYS it takes to
2195 reach a non-prefix command.
2197 (keymap, keys, accept_default))
2199 /* This function can GC */
2201 return lookup_keys (keymap,
2202 XVECTOR_LENGTH (keys),
2203 XVECTOR_DATA (keys),
2204 !NILP (accept_default));
2205 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
2206 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
2207 else if (STRINGP (keys))
2209 int length = XSTRING_CHAR_LENGTH (keys);
2211 struct key_data *raw_keys = alloca_array (struct key_data, length);
2215 for (i = 0; i < length; i++)
2217 Emchar n = string_char (XSTRING (keys), i);
2218 define_key_parser (make_char (n), &(raw_keys[i]));
2220 return raw_lookup_key (keymap, raw_keys, length, 0,
2221 !NILP (accept_default));
2225 keys = wrong_type_argument (Qsequencep, keys);
2226 return Flookup_key (keymap, keys, accept_default);
2230 /* Given a key sequence, returns a list of keymaps to search for bindings.
2231 Does all manner of semi-hairy heuristics, like looking in the current
2232 buffer's map before looking in the global map and looking in the local
2233 map of the buffer in which the mouse was clicked in event0 is a click.
2235 It would be kind of nice if this were in Lisp so that this semi-hairy
2236 semi-heuristic command-lookup behavior could be readily understood and
2237 customised. However, this needs to be pretty fast, or performance of
2238 keyboard macros goes to shit; putting this in lisp slows macros down
2239 2-3x. And they're already slower than v18 by 5-6x.
2242 struct relevant_maps
2245 unsigned int max_maps;
2247 struct gcpro *gcpro;
2250 static void get_relevant_extent_keymaps (Lisp_Object pos,
2251 Lisp_Object buffer_or_string,
2253 struct relevant_maps *closure);
2254 static void get_relevant_minor_maps (Lisp_Object buffer,
2255 struct relevant_maps *closure);
2258 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
2260 unsigned int nmaps = closure->nmaps;
2264 closure->nmaps = nmaps + 1;
2265 if (nmaps < closure->max_maps)
2267 closure->maps[nmaps] = map;
2268 closure->gcpro->nvars = nmaps;
2273 get_relevant_keymaps (Lisp_Object keys,
2274 int max_maps, Lisp_Object maps[])
2276 /* This function can GC */
2277 Lisp_Object terminal = Qnil;
2278 struct gcpro gcpro1;
2279 struct relevant_maps closure;
2280 struct console *con;
2285 closure.max_maps = max_maps;
2286 closure.maps = maps;
2287 closure.gcpro = &gcpro1;
2290 terminal = event_chain_tail (keys);
2291 else if (VECTORP (keys))
2293 int len = XVECTOR_LENGTH (keys);
2295 terminal = XVECTOR_DATA (keys)[len - 1];
2298 if (EVENTP (terminal))
2300 CHECK_LIVE_EVENT (terminal);
2301 con = event_console_or_selected (terminal);
2304 con = XCONSOLE (Vselected_console);
2306 if (KEYMAPP (con->overriding_terminal_local_map)
2307 || KEYMAPP (Voverriding_local_map))
2309 if (KEYMAPP (con->overriding_terminal_local_map))
2310 relevant_map_push (con->overriding_terminal_local_map, &closure);
2311 if (KEYMAPP (Voverriding_local_map))
2312 relevant_map_push (Voverriding_local_map, &closure);
2314 else if (!EVENTP (terminal)
2315 || (XEVENT (terminal)->event_type != button_press_event
2316 && XEVENT (terminal)->event_type != button_release_event))
2319 XSETBUFFER (tem, current_buffer);
2320 /* It's not a mouse event; order of keymaps searched is:
2321 o keymap of any/all extents under the mouse
2323 o local-map of current-buffer
2326 /* The terminal element of the lookup may be nil or a keysym.
2327 In those cases we don't want to check for an extent
2329 if (EVENTP (terminal))
2331 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
2332 tem, Qnil, &closure);
2334 get_relevant_minor_maps (tem, &closure);
2336 tem = current_buffer->keymap;
2338 relevant_map_push (tem, &closure);
2340 #ifdef HAVE_WINDOW_SYSTEM
2343 /* It's a mouse event; order of keymaps searched is:
2344 o vertical-divider-map, if event is over a divider
2345 o local-map of mouse-grabbed-buffer
2346 o keymap of any/all extents under the mouse
2347 if the mouse is over a modeline:
2348 o modeline-map of buffer corresponding to that modeline
2349 o else, local-map of buffer under the mouse
2351 o local-map of current-buffer
2354 Lisp_Object window = Fevent_window (terminal);
2356 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
2358 if (KEYMAPP (Vvertical_divider_map))
2359 relevant_map_push (Vvertical_divider_map, &closure);
2362 if (BUFFERP (Vmouse_grabbed_buffer))
2364 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
2366 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
2368 relevant_map_push (map, &closure);
2373 Lisp_Object buffer = Fwindow_buffer (window);
2377 if (!NILP (Fevent_over_modeline_p (terminal)))
2379 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
2382 get_relevant_extent_keymaps
2383 (Fevent_modeline_position (terminal),
2384 XBUFFER (buffer)->generated_modeline_string,
2385 Fevent_glyph_extent (terminal), &closure);
2387 if (!UNBOUNDP (map) && !NILP (map))
2388 relevant_map_push (get_keymap (map, 1, 1), &closure);
2392 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
2393 Fevent_glyph_extent (terminal),
2397 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
2399 Lisp_Object map = XBUFFER (buffer)->keymap;
2401 get_relevant_minor_maps (buffer, &closure);
2403 relevant_map_push (map, &closure);
2407 else if (!NILP (Fevent_over_toolbar_p (terminal)))
2409 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
2411 if (!UNBOUNDP (map) && !NILP (map))
2412 relevant_map_push (map, &closure);
2415 #endif /* HAVE_WINDOW_SYSTEM */
2418 int nmaps = closure.nmaps;
2419 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2420 if (nmaps >= max_maps && max_maps > 0)
2421 maps[max_maps - 1] = Vcurrent_global_map;
2423 maps[nmaps] = Vcurrent_global_map;
2429 /* Returns a set of keymaps extracted from the extents at POS in
2430 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2431 to look for a keymap in, and if it has one, its keymap will be the
2432 first element in the list returned. This is so we can correctly
2433 search the keymaps associated with glyphs which may be physically
2434 disjoint from their extents: for example, if a glyph is out in the
2435 margin, we should still consult the keymap of that glyph's extent,
2436 which may not itself be under the mouse.
2440 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
2442 struct relevant_maps *closure)
2444 /* This function can GC */
2445 /* the glyph keymap, if any, comes first.
2446 (Processing it twice is no big deal: noop.) */
2449 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
2451 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2454 /* Next check the extents at the text position, if any */
2458 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2460 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
2462 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
2464 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2471 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
2473 /* This function can GC */
2476 Lisp_Object sym = XCAR (assoc);
2479 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
2480 if (!NILP (val) && !UNBOUNDP (val))
2482 Lisp_Object map = get_keymap (XCDR (assoc), 0, 1);
2491 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
2493 /* This function can GC */
2496 /* Will you ever lose badly if you make this circular! */
2497 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
2499 alist = XCDR (alist))
2501 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
2503 if (!NILP (m)) relevant_map_push (m, closure);
2508 /* #### Would map-current-keymaps be a better thing?? */
2509 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2510 Return a list of the current keymaps that will be searched for bindings.
2511 This lists keymaps such as the current local map and the minor-mode maps,
2512 but does not list the parents of those keymaps.
2513 EVENT-OR-KEYS controls which keymaps will be listed.
2514 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2515 mouse event), the keymaps for that mouse event will be listed (see
2516 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2520 /* This function can GC */
2521 struct gcpro gcpro1;
2522 Lisp_Object maps[100];
2523 Lisp_Object *gubbish = maps;
2526 GCPRO1 (event_or_keys);
2527 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
2529 if (nmaps > countof (maps))
2531 gubbish = alloca_array (Lisp_Object, nmaps);
2532 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
2535 return Flist (nmaps, gubbish);
2538 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
2539 Return the binding for command KEYS in current keymaps.
2540 KEYS is a string, a vector of events, or a vector of key-description lists
2541 as described in the documentation for the `define-key' function.
2542 The binding is probably a symbol with a function definition; see
2543 the documentation for `lookup-key' for more information.
2545 For key-presses, the order of keymaps searched is:
2546 - the `keymap' property of any extent(s) at point;
2547 - any applicable minor-mode maps;
2548 - the current local map of the current-buffer;
2549 - the current global map.
2551 For mouse-clicks, the order of keymaps searched is:
2552 - the current-local-map of the `mouse-grabbed-buffer' if any;
2553 - vertical-divider-map, if the event happened over a vertical divider
2554 - the `keymap' property of any extent(s) at the position of the click
2555 (this includes modeline extents);
2556 - the modeline-map of the buffer corresponding to the modeline under
2557 the mouse (if the click happened over a modeline);
2558 - the value of `toolbar-map' in the current-buffer (if the click
2559 happened over a toolbar);
2560 - the current local map of the buffer under the mouse (does not
2561 apply to toolbar clicks);
2562 - any applicable minor-mode maps;
2563 - the current global map.
2565 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2566 is non-nil, *only* those two maps and the current global map are searched.
2568 (keys, accept_default))
2570 /* This function can GC */
2572 Lisp_Object maps[100];
2574 struct gcpro gcpro1, gcpro2;
2575 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
2577 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
2581 if (EVENTP (keys)) /* unadvertised "feature" for the future */
2582 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
2584 for (i = 0; i < nmaps; i++)
2586 Lisp_Object tem = Flookup_key (maps[i], keys,
2590 /* Too long in some local map means don't look at global map */
2593 else if (!NILP (tem))
2600 process_event_binding_result (Lisp_Object result)
2602 if (EQ (result, Qundefined))
2603 /* The suppress-keymap function binds keys to 'undefined - special-case
2604 that here, so that being bound to that has the same error-behavior as
2605 not being defined at all.
2611 /* Snap out possible keymap indirections */
2612 map = get_keymap (result, 0, 1);
2620 /* Attempts to find a command corresponding to the event-sequence
2621 whose head is event0 (sequence is threaded though event_next).
2623 The return value will be
2625 -- nil (there is no binding; this will also be returned
2626 whenever the event chain is "too long", i.e. there
2627 is a non-nil, non-keymap binding for a prefix of
2629 -- a keymap (part of a command has been specified)
2630 -- a command (anything that satisfies `commandp'; this includes
2631 some symbols, lists, subrs, strings, vectors, and
2632 compiled-function objects) */
2634 event_binding (Lisp_Object event0, int accept_default)
2636 /* This function can GC */
2637 Lisp_Object maps[100];
2640 assert (EVENTP (event0));
2642 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
2643 if (nmaps > countof (maps))
2644 nmaps = countof (maps);
2645 return process_event_binding_result (lookup_events (event0, nmaps, maps,
2649 /* like event_binding, but specify a keymap to search */
2652 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
2654 /* This function can GC */
2655 if (!KEYMAPP (keymap))
2658 return process_event_binding_result (lookup_events (event0, 1, &keymap,
2662 /* Attempts to find a function key mapping corresponding to the
2663 event-sequence whose head is event0 (sequence is threaded through
2664 event_next). The return value will be the same as for event_binding(). */
2666 munging_key_map_event_binding (Lisp_Object event0,
2667 enum munge_me_out_the_door munge)
2669 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2670 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
2671 Vkey_translation_map;
2676 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
2680 /************************************************************************/
2681 /* Setting/querying the global and local maps */
2682 /************************************************************************/
2684 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
2685 Select KEYMAP as the global keymap.
2689 /* This function can GC */
2690 keymap = get_keymap (keymap, 1, 1);
2691 Vcurrent_global_map = keymap;
2695 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
2696 Select KEYMAP as the local keymap in BUFFER.
2697 If KEYMAP is nil, that means no local keymap.
2698 If BUFFER is nil, the current buffer is assumed.
2702 /* This function can GC */
2703 struct buffer *b = decode_buffer (buffer, 0);
2705 keymap = get_keymap (keymap, 1, 1);
2712 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2713 Return BUFFER's local keymap, or nil if it has none.
2714 If BUFFER is nil, the current buffer is assumed.
2718 struct buffer *b = decode_buffer (buffer, 0);
2722 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2723 Return the current global keymap.
2727 return Vcurrent_global_map;
2731 /************************************************************************/
2732 /* Mapping over keymap elements */
2733 /************************************************************************/
2735 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2736 prefix key, it's not entirely obvious what map-keymap should do, but
2737 what it does is: map over all keys in this map; then recursively map
2738 over all submaps of this map that are "bucky" submaps. This means that,
2739 when mapping over a keymap, it appears that "x" and "C-x" are in the
2740 same map, although "C-x" is really in the "control" submap of this one.
2741 However, since we don't recursively descend the submaps that are bound
2742 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2743 those explicitly, if that's what they want.
2745 So the end result of this is that the bucky keymaps (the ones indexed
2746 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2747 invisible from elisp. They're just an implementation detail that code
2748 outside of this file doesn't need to know about.
2751 struct map_keymap_unsorted_closure
2753 void (*fn) (const struct key_data *, Lisp_Object binding, void *arg);
2758 /* used by map_keymap() */
2760 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value,
2761 void *map_keymap_unsorted_closure)
2763 /* This function can GC */
2764 struct map_keymap_unsorted_closure *closure =
2765 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
2766 int modifiers = closure->modifiers;
2768 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
2771 int omod = modifiers;
2772 closure->modifiers = (modifiers | mod_bit);
2773 value = get_keymap (value, 1, 0);
2774 elisp_maphash (map_keymap_unsorted_mapper,
2775 XKEYMAP (value)->table,
2776 map_keymap_unsorted_closure);
2777 closure->modifiers = omod;
2781 struct key_data key;
2782 key.keysym = keysym;
2783 key.modifiers = modifiers;
2784 ((*closure->fn) (&key, value, closure->arg));
2790 struct map_keymap_sorted_closure
2792 Lisp_Object *result_locative;
2795 /* used by map_keymap_sorted() */
2797 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value,
2798 void *map_keymap_sorted_closure)
2800 struct map_keymap_sorted_closure *cl =
2801 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
2802 Lisp_Object *list = cl->result_locative;
2803 *list = Fcons (Fcons (key, value), *list);
2808 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2809 and keymap_submaps().
2812 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
2815 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2823 if (EQ (obj1, obj2))
2825 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
2826 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
2828 /* If either is a symbol with a character-set-property, then sort it by
2829 that code instead of alphabetically.
2831 if (! bit1 && SYMBOLP (obj1))
2833 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
2834 if (CHAR_OR_CHAR_INTP (code))
2837 CHECK_CHAR_COERCE_INT (obj1);
2841 if (! bit2 && SYMBOLP (obj2))
2843 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
2844 if (CHAR_OR_CHAR_INTP (code))
2847 CHECK_CHAR_COERCE_INT (obj2);
2852 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2853 if (XTYPE (obj1) != XTYPE (obj2))
2854 return SYMBOLP (obj2) ? 1 : -1;
2856 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
2858 int o1 = XCHAR (obj1);
2859 int o2 = XCHAR (obj2);
2860 if (o1 == o2 && /* If one started out as a symbol and the */
2861 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
2862 return sym2_p ? 1 : -1;
2864 return o1 < o2 ? 1 : -1; /* else just compare them */
2867 /* else they're both symbols. If they're both buckys, then order them. */
2869 return bit1 < bit2 ? 1 : -1;
2871 /* if only one is a bucky, then it comes later */
2873 return bit2 ? 1 : -1;
2875 /* otherwise, string-sort them. */
2877 char *s1 = (char *) string_data (XSYMBOL (obj1)->name);
2878 char *s2 = (char *) string_data (XSYMBOL (obj2)->name);
2880 return 0 > strcoll (s1, s2) ? 1 : -1;
2882 return 0 > strcmp (s1, s2) ? 1 : -1;
2888 /* used by map_keymap() */
2890 map_keymap_sorted (Lisp_Object keymap_table,
2892 void (*function) (const struct key_data *key,
2893 Lisp_Object binding,
2894 void *map_keymap_sorted_closure),
2895 void *map_keymap_sorted_closure)
2897 /* This function can GC */
2898 struct gcpro gcpro1;
2899 Lisp_Object contents = Qnil;
2901 if (XINT (Fhash_table_count (keymap_table)) == 0)
2907 struct map_keymap_sorted_closure c1;
2908 c1.result_locative = &contents;
2909 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
2911 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
2912 for (; !NILP (contents); contents = XCDR (contents))
2914 Lisp_Object keysym = XCAR (XCAR (contents));
2915 Lisp_Object binding = XCDR (XCAR (contents));
2916 int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
2918 map_keymap_sorted (XKEYMAP (get_keymap (binding,
2920 (modifiers | sub_bits),
2922 map_keymap_sorted_closure);
2927 k.modifiers = modifiers;
2928 ((*function) (&k, binding, map_keymap_sorted_closure));
2935 /* used by Fmap_keymap() */
2937 map_keymap_mapper (const struct key_data *key,
2938 Lisp_Object binding,
2941 /* This function can GC */
2943 VOID_TO_LISP (fn, function);
2944 call2 (fn, make_key_description (key, 1), binding);
2949 map_keymap (Lisp_Object keymap_table, int sort_first,
2950 void (*function) (const struct key_data *key,
2951 Lisp_Object binding,
2955 /* This function can GC */
2957 map_keymap_sorted (keymap_table, 0, function, fn_arg);
2960 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
2961 map_keymap_unsorted_closure.fn = function;
2962 map_keymap_unsorted_closure.arg = fn_arg;
2963 map_keymap_unsorted_closure.modifiers = 0;
2964 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
2965 &map_keymap_unsorted_closure);
2969 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
2970 Apply FUNCTION to each element of KEYMAP.
2971 FUNCTION will be called with two arguments: a key-description list, and
2972 the binding. The order in which the elements of the keymap are passed to
2973 the function is unspecified. If the function inserts new elements into
2974 the keymap, it may or may not be called with them later. No element of
2975 the keymap will ever be passed to the function more than once.
2977 The function will not be called on elements of this keymap's parents
2978 \(see the function `keymap-parents') or upon keymaps which are contained
2979 within this keymap (multi-character definitions).
2980 It will be called on "meta" characters since they are not really
2981 two-character sequences.
2983 If the optional third argument SORT-FIRST is non-nil, then the elements of
2984 the keymap will be passed to the mapper function in a canonical order.
2985 Otherwise, they will be passed in hash (that is, random) order, which is
2988 (function, keymap, sort_first))
2990 /* This function can GC */
2991 struct gcpro gcpro1, gcpro2, gcpro3;
2992 Lisp_Object table = Qnil;
2994 /* tolerate obviously transposed args */
2995 if (!NILP (Fkeymapp (function)))
2997 Lisp_Object tmp = function;
3002 GCPRO3 (function, keymap, table);
3003 keymap = get_keymap (keymap, 1, 1);
3005 /* elisp_maphash does not allow mapping functions to modify the hash
3006 table being mapped over. Since map-keymap explicitly allows a
3007 mapping function to modify KEYMAP, we map over a copy of the hash
3009 table = Fcopy_hash_table (XKEYMAP (keymap)->table);
3011 map_keymap (table, !NILP (sort_first),
3012 map_keymap_mapper, LISP_TO_VOID (function));
3019 /************************************************************************/
3020 /* Accessible keymaps */
3021 /************************************************************************/
3023 struct accessible_keymaps_closure
3030 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
3032 struct accessible_keymaps_closure *closure)
3034 /* This function can GC */
3035 int subbits = MODIFIER_HASH_KEY_BITS (keysym);
3039 Lisp_Object submaps;
3041 contents = get_keymap (contents, 1, 1);
3042 submaps = keymap_submaps (contents);
3043 for (; !NILP (submaps); submaps = XCDR (submaps))
3045 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3046 XCDR (XCAR (submaps)),
3047 (subbits | modifiers),
3053 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3054 Lisp_Object cmd = get_keyelt (contents, 1);
3058 struct key_data key;
3059 key.keysym = keysym;
3060 key.modifiers = modifiers;
3064 cmd = get_keymap (cmd, 0, 1);
3068 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3069 len = XVECTOR_LENGTH (thisseq);
3070 for (j = 0; j < len; j++)
3071 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3072 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3074 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3080 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3082 /* This function can GC */
3083 struct accessible_keymaps_closure *closure =
3084 (struct accessible_keymaps_closure *) arg;
3085 Lisp_Object submaps = keymap_submaps (thismap);
3087 for (; !NILP (submaps); submaps = XCDR (submaps))
3089 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3090 XCDR (XCAR (submaps)),
3098 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3099 Find all keymaps accessible via prefix characters from KEYMAP.
3100 Returns a list of elements of the form (KEYS . MAP), where the sequence
3101 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3102 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3103 An optional argument PREFIX, if non-nil, should be a key sequence;
3104 then the value includes only maps for prefixes that start with PREFIX.
3108 /* This function can GC */
3109 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3110 Lisp_Object accessible_keymaps = Qnil;
3111 struct accessible_keymaps_closure c;
3113 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3115 keymap = get_keymap (keymap, 1, 1);
3120 prefix = make_vector (0, Qnil);
3122 else if (VECTORP (prefix) || STRINGP (prefix))
3124 int len = XINT (Flength (prefix));
3128 struct gcpro ngcpro1;
3136 def = Flookup_key (keymap, prefix, Qnil);
3137 def = get_keymap (def, 0, 1);
3142 p = make_vector (len, Qnil);
3144 for (iii = 0; iii < len; iii++)
3146 struct key_data key;
3147 define_key_parser (Faref (prefix, make_int (iii)), &key);
3148 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3155 prefix = wrong_type_argument (Qarrayp, prefix);
3159 accessible_keymaps = list1 (Fcons (prefix, keymap));
3161 /* For each map in the list maps, look at any other maps it points
3162 to and stick them at the end if they are not already in the list */
3164 for (c.tail = accessible_keymaps;
3166 c.tail = XCDR (c.tail))
3168 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3169 CHECK_KEYMAP (thismap);
3170 traverse_keymaps (thismap, Qnil,
3171 accessible_keymaps_keymap_mapper, &c);
3175 return accessible_keymaps;
3180 /************************************************************************/
3181 /* Pretty descriptions of key sequences */
3182 /************************************************************************/
3184 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3185 Return a pretty description of key-sequence KEYS.
3186 Control characters turn into "C-foo" sequences, meta into "M-foo",
3187 spaces are put between sequence elements, etc...
3191 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3194 return Fsingle_key_description (keys);
3196 else if (VECTORP (keys) ||
3199 Lisp_Object string = Qnil;
3200 /* Lisp_Object sep = Qnil; */
3201 int size = XINT (Flength (keys));
3204 for (i = 0; i < size; i++)
3206 Lisp_Object s2 = Fsingle_key_description
3208 ? make_char (string_char (XSTRING (keys), i))
3209 : XVECTOR_DATA (keys)[i]);
3215 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */;
3216 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3221 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3224 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3225 Return a pretty description of command character KEY.
3226 Control characters turn into C-whatever, etc.
3227 This differs from `text-char-description' in that it returns a description
3228 of a key read from the user rather than a character from a buffer.
3233 key = Fcons (key, Qnil); /* sleaze sleaze */
3235 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3241 event.event_type = empty_event;
3242 CHECK_CHAR_COERCE_INT (key);
3243 character_to_event (XCHAR (key), &event,
3244 XCONSOLE (Vselected_console), 0, 1);
3245 format_event_object (buf, &event, 1);
3248 format_event_object (buf, XEVENT (key), 1);
3249 return build_string (buf);
3258 LIST_LOOP (rest, key)
3260 Lisp_Object keysym = XCAR (rest);
3261 if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2;
3262 else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2;
3263 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3264 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3265 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3266 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3267 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3268 else if (CHAR_OR_CHAR_INTP (keysym))
3270 bufp += set_charptr_emchar ((Bufbyte *) bufp,
3271 XCHAR_OR_CHAR_INT (keysym));
3276 CHECK_SYMBOL (keysym);
3277 #if 0 /* This is bogus */
3278 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3279 else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB");
3280 else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET");
3281 else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC");
3282 else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL");
3283 else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC");
3284 else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS");
3287 strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name));
3288 if (!NILP (XCDR (rest)))
3289 signal_simple_error ("Invalid key description",
3293 return build_string (buf);
3295 return Fsingle_key_description
3296 (wrong_type_argument (intern ("char-or-event-p"), key));
3299 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3300 Return a pretty description of file-character CHR.
3301 Unprintable characters turn into "^char" or \\NNN, depending on the value
3302 of the `ctl-arrow' variable.
3303 This differs from `single-key-description' in that it returns a description
3304 of a character from a buffer rather than a key read from the user.
3311 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3312 int ctl_p = !NILP (ctl_arrow);
3313 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3314 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3315 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3320 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3323 signal_simple_continuable_error
3324 ("character has no ASCII equivalent", Fcopy_event (chr, Qnil));
3328 CHECK_CHAR_COERCE_INT (chr);
3333 if (c >= printable_min)
3335 p += set_charptr_emchar (p, c);
3337 else if (c < 040 && ctl_p)
3340 *p++ = c + 64; /* 'A' - 1 */
3347 else if (c >= 0200 || c < 040)
3351 /* !!#### This syntax is not readable. It will
3352 be interpreted as a 3-digit octal number rather
3353 than a 7-digit octal number. */
3356 *p++ = '0' + ((c & 07000000) >> 18);
3357 *p++ = '0' + ((c & 0700000) >> 15);
3358 *p++ = '0' + ((c & 070000) >> 12);
3359 *p++ = '0' + ((c & 07000) >> 9);
3362 *p++ = '0' + ((c & 0700) >> 6);
3363 *p++ = '0' + ((c & 0070) >> 3);
3364 *p++ = '0' + ((c & 0007));
3368 p += set_charptr_emchar (p, c);
3372 return build_string ((char *) buf);
3376 /************************************************************************/
3377 /* where-is (mapping bindings to keys) */
3378 /************************************************************************/
3381 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3382 Lisp_Object firstonly, char *target_buffer);
3384 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3385 Return list of keys that invoke DEFINITION in KEYMAPS.
3386 KEYMAPS can be either a keymap (meaning search in that keymap and the
3387 current global keymap) or a list of keymaps (meaning search in exactly
3388 those keymaps and no others). If KEYMAPS is nil, search in the currently
3389 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3390 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3392 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3393 the first key sequence found, rather than a list of all possible key
3396 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3397 to other keymaps or slots. This makes it possible to search for an
3398 indirect definition itself.
3400 (definition, keymaps, firstonly, noindirect, event_or_keys))
3402 /* This function can GC */
3403 Lisp_Object maps[100];
3404 Lisp_Object *gubbish = maps;
3407 /* Get keymaps as an array */
3410 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3412 if (nmaps > countof (maps))
3414 gubbish = alloca_array (Lisp_Object, nmaps);
3415 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3418 else if (CONSP (keymaps))
3423 nmaps = XINT (Flength (keymaps));
3424 if (nmaps > countof (maps))
3426 gubbish = alloca_array (Lisp_Object, nmaps);
3428 for (rest = keymaps, i = 0; !NILP (rest);
3429 rest = XCDR (keymaps), i++)
3431 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3437 gubbish[0] = get_keymap (keymaps, 1, 1);
3438 if (!EQ (gubbish[0], Vcurrent_global_map))
3440 gubbish[1] = Vcurrent_global_map;
3445 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3448 /* This function is like
3449 (key-description (where-is-internal definition nil t))
3450 except that it writes its output into a (char *) buffer that you
3451 provide; it doesn't cons (or allocate memory) at all, so it's
3452 very fast. This is used by menubar.c.
3455 where_is_to_char (Lisp_Object definition, char *buffer)
3457 /* This function can GC */
3458 Lisp_Object maps[100];
3459 Lisp_Object *gubbish = maps;
3462 /* Get keymaps as an array */
3463 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3464 if (nmaps > countof (maps))
3466 gubbish = alloca_array (Lisp_Object, nmaps);
3467 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3471 where_is_internal (definition, maps, nmaps, Qt, buffer);
3476 raw_keys_to_keys (struct key_data *keys, int count)
3478 Lisp_Object result = make_vector (count, Qnil);
3480 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3486 format_raw_keys (struct key_data *keys, int count, char *buf)
3490 event.event_type = key_press_event;
3491 event.channel = Vselected_console;
3492 for (i = 0; i < count; i++)
3494 event.event.key.keysym = keys[i].keysym;
3495 event.event.key.modifiers = keys[i].modifiers;
3496 format_event_object (buf, &event, 1);
3497 buf += strlen (buf);
3499 buf[0] = ' ', buf++;
3504 /* definition is the thing to look for.
3506 shadow is an array of shadow_count keymaps; if there is a different
3507 binding in any of the keymaps of a key that we are considering
3508 returning, then we reconsider.
3509 firstonly means give up after finding the first match;
3510 keys_so_far and modifiers_so_far describe which map we're looking in;
3511 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3512 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3513 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we
3514 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3517 (keys_so_far is a global buffer and the keys_count arg says how much
3518 of it we're currently interested in.)
3520 If target_buffer is provided, then we write a key-description into it,
3521 to avoid consing a string. This only works with firstonly on.
3524 struct where_is_closure
3526 Lisp_Object definition;
3527 Lisp_Object *shadow;
3531 int modifiers_so_far;
3532 char *target_buffer;
3533 struct key_data *keys_so_far;
3534 int keys_so_far_total_size;
3535 int keys_so_far_malloced;
3538 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3541 where_is_recursive_mapper (Lisp_Object map, void *arg)
3543 /* This function can GC */
3544 struct where_is_closure *c = (struct where_is_closure *) arg;
3545 Lisp_Object definition = c->definition;
3546 const int firstonly = c->firstonly;
3547 const int keys_count = c->keys_count;
3548 const int modifiers_so_far = c->modifiers_so_far;
3549 char *target_buffer = c->target_buffer;
3550 Lisp_Object keys = Fgethash (definition,
3551 XKEYMAP (map)->inverse_table,
3553 Lisp_Object submaps;
3554 Lisp_Object result = Qnil;
3558 /* One or more keys in this map match the definition we're looking for.
3559 Verify that these bindings aren't shadowed by other bindings
3560 in the shadow maps. Either nil or number as value from
3561 raw_lookup_key() means undefined. */
3562 struct key_data *so_far = c->keys_so_far;
3564 for (;;) /* loop over all keys that match */
3566 Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys;
3569 so_far [keys_count].keysym = k;
3570 so_far [keys_count].modifiers = modifiers_so_far;
3572 /* now loop over all shadow maps */
3573 for (i = 0; i < c->shadow_count; i++)
3575 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3580 if (NILP (shadowed) || CHARP (shadowed) ||
3581 EQ (shadowed, definition))
3582 continue; /* we passed this test; it's not shadowed here. */
3584 /* ignore this key binding, since it actually has a
3585 different binding in a shadowing map */
3586 goto c_doesnt_have_proper_loop_exit_statements;
3589 /* OK, the key is for real */
3592 if (!firstonly) ABORT ();
3593 format_raw_keys (so_far, keys_count + 1, target_buffer);
3594 return make_int (1);
3597 return raw_keys_to_keys (so_far, keys_count + 1);
3599 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3602 c_doesnt_have_proper_loop_exit_statements:
3603 /* now on to the next matching key ... */
3604 if (!CONSP (keys)) break;
3609 /* Now search the sub-keymaps of this map.
3610 If we're in "firstonly" mode and have already found one, this
3611 point is not reached. If we get one from lower down, either
3612 return it immediately (in firstonly mode) or tack it onto the
3613 end of the ones we've gotten so far.
3615 for (submaps = keymap_submaps (map);
3617 submaps = XCDR (submaps))
3619 Lisp_Object key = XCAR (XCAR (submaps));
3620 Lisp_Object submap = XCDR (XCAR (submaps));
3621 int lower_modifiers;
3622 int lower_keys_count = keys_count;
3625 submap = get_keymap (submap, 0, 0);
3627 if (EQ (submap, map))
3628 /* Arrgh! Some loser has introduced a loop... */
3631 /* If this is not a keymap, then that's probably because someone
3632 did an `fset' of a symbol that used to point to a map such that
3633 it no longer does. Sigh. Ignore this, and invalidate the cache
3634 so that it doesn't happen to us next time too.
3638 XKEYMAP (map)->sub_maps_cache = Qt;
3642 /* If the map is a "bucky" map, then add a bit to the
3643 modifiers_so_far list.
3644 Otherwise, add a new raw_key onto the end of keys_so_far.
3646 bucky = MODIFIER_HASH_KEY_BITS (key);
3648 lower_modifiers = (modifiers_so_far | bucky);
3651 struct key_data *so_far = c->keys_so_far;
3652 lower_modifiers = 0;
3653 so_far [lower_keys_count].keysym = key;
3654 so_far [lower_keys_count].modifiers = modifiers_so_far;
3658 if (lower_keys_count >= c->keys_so_far_total_size)
3660 int size = lower_keys_count + 50;
3661 if (! c->keys_so_far_malloced)
3663 struct key_data *new = xnew_array (struct key_data, size);
3664 memcpy ((void *)new, (const void *)c->keys_so_far,
3665 c->keys_so_far_total_size * sizeof (struct key_data));
3666 xfree (c->keys_so_far);
3667 c->keys_so_far = new;
3670 XREALLOC_ARRAY (c->keys_so_far, struct key_data, size);
3672 c->keys_so_far_total_size = size;
3673 c->keys_so_far_malloced = 1;
3679 c->keys_count = lower_keys_count;
3680 c->modifiers_so_far = lower_modifiers;
3682 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3684 c->keys_count = keys_count;
3685 c->modifiers_so_far = modifiers_so_far;
3688 result = nconc2 (lower, result);
3689 else if (!NILP (lower))
3698 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3699 Lisp_Object firstonly, char *target_buffer)
3701 /* This function can GC */
3702 Lisp_Object result = Qnil;
3704 struct key_data raw[20];
3705 struct where_is_closure c;
3707 c.definition = definition;
3709 c.firstonly = !NILP (firstonly);
3710 c.target_buffer = target_buffer;
3711 c.keys_so_far = raw;
3712 c.keys_so_far_total_size = countof (raw);
3713 c.keys_so_far_malloced = 0;
3715 /* Loop over each of the maps, accumulating the keys found.
3716 For each map searched, all previous maps shadow this one
3717 so that bogus keys aren't listed. */
3718 for (i = 0; i < nmaps; i++)
3720 Lisp_Object this_result;
3722 /* Reset the things set in each iteration */
3724 c.modifiers_so_far = 0;
3726 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3728 if (!NILP (firstonly))
3730 result = this_result;
3735 result = nconc2 (this_result, result);
3738 if (NILP (firstonly))
3739 result = Fnreverse (result);
3741 if (c.keys_so_far_malloced)
3742 xfree (c.keys_so_far);
3747 /************************************************************************/
3748 /* Describing keymaps */
3749 /************************************************************************/
3751 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3752 Insert a list of all defined keys and their definitions in MAP.
3753 Optional second argument ALL says whether to include even "uninteresting"
3754 definitions (ie symbols with a non-nil `suppress-keymap' property.
3755 Third argument SHADOW is a list of keymaps whose bindings shadow those
3756 of map; if a binding is present in any shadowing map, it is not printed.
3757 Fourth argument PREFIX, if non-nil, should be a key sequence;
3758 only bindings which start with that key sequence will be printed.
3759 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3761 (map, all, shadow, prefix, mouse_only_p))
3763 /* This function can GC */
3765 /* #### At some point, this function should be changed to accept a
3766 BUFFER argument. Currently, the BUFFER argument to
3767 describe_map_tree is being used only internally. */
3768 describe_map_tree (map, NILP (all), shadow, prefix,
3769 !NILP (mouse_only_p), Fcurrent_buffer ());
3774 /* Insert a description of the key bindings in STARTMAP,
3775 followed by those of all maps reachable through STARTMAP.
3776 If PARTIAL is nonzero, omit certain "uninteresting" commands
3777 (such as `undefined').
3778 If SHADOW is non-nil, it is a list of other maps;
3779 don't mention keys which would be shadowed by any of them
3780 If PREFIX is non-nil, only list bindings which start with those keys.
3784 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3785 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3787 /* This function can GC */
3788 Lisp_Object maps = Qnil;
3789 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3790 GCPRO2 (maps, shadow);
3792 maps = Faccessible_keymaps (startmap, prefix);
3794 for (; !NILP (maps); maps = Fcdr (maps))
3796 Lisp_Object sub_shadow = Qnil;
3797 Lisp_Object elt = Fcar (maps);
3799 int no_prefix = (VECTORP (Fcar (elt))
3800 && XINT (Flength (Fcar (elt))) == 0);
3801 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3802 NGCPRO3 (sub_shadow, elt, tail);
3804 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3806 Lisp_Object shmap = XCAR (tail);
3808 /* If the sequence by which we reach this keymap is zero-length,
3809 then the shadow maps for this keymap are just SHADOW. */
3812 /* If the sequence by which we reach this keymap actually has
3813 some elements, then the sequence's definition in SHADOW is
3814 what we should use. */
3817 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3824 Lisp_Object shm = get_keymap (shmap, 0, 1);
3825 /* If shmap is not nil and not a keymap, it completely
3826 shadows this map, so don't describe this map at all. */
3829 sub_shadow = Fcons (shm, sub_shadow);
3834 /* Describe the contents of map MAP, assuming that this map
3835 itself is reached by the sequence of prefix keys KEYS (a vector).
3836 PARTIAL and SHADOW are as in `describe_map_tree'. */
3837 Lisp_Object keysdesc
3839 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3841 describe_map (Fcdr (elt), keysdesc,
3856 describe_command (Lisp_Object definition, Lisp_Object buffer)
3858 /* This function can GC */
3859 int keymapp = !NILP (Fkeymapp (definition));
3860 struct gcpro gcpro1;
3861 GCPRO1 (definition);
3863 Findent_to (make_int (16), make_int (3), buffer);
3865 buffer_insert_c_string (XBUFFER (buffer), "<< ");
3867 if (SYMBOLP (definition))
3869 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3871 else if (STRINGP (definition) || VECTORP (definition))
3873 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: ");
3874 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3876 else if (COMPILED_FUNCTIONP (definition))
3877 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function");
3878 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
3879 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda");
3880 else if (KEYMAPP (definition))
3882 Lisp_Object name = XKEYMAP (definition)->name;
3883 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3885 buffer_insert_c_string (XBUFFER (buffer), "Prefix command ");
3887 && EQ (find_symbol_value (name), definition))
3888 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3891 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3895 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command");
3898 buffer_insert_c_string (XBUFFER (buffer), "??");
3901 buffer_insert_c_string (XBUFFER (buffer), " >>");
3902 buffer_insert_c_string (XBUFFER (buffer), "\n");
3906 struct describe_map_closure
3908 Lisp_Object *list; /* pointer to the list to update */
3909 Lisp_Object partial; /* whether to ignore suppressed commands */
3910 Lisp_Object shadow; /* list of maps shadowing this one */
3911 Lisp_Object self; /* this map */
3912 Lisp_Object self_root; /* this map, or some map that has this map as
3913 a parent. this is the base of the tree */
3914 int mice_only_p; /* whether we are to display only button bindings */
3917 struct describe_map_shadow_closure
3919 const struct key_data *raw_key;
3924 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3926 struct describe_map_shadow_closure *c =
3927 (struct describe_map_shadow_closure *) arg;
3929 if (EQ (map, c->self))
3930 return Qzero; /* Not shadowed; terminate search */
3932 return !NILP (keymap_lookup_directly (map,
3934 c->raw_key->modifiers))
3940 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3942 struct key_data *k = (struct key_data *) arg;
3943 return keymap_lookup_directly (km, k->keysym, k->modifiers);
3948 describe_map_mapper (const struct key_data *key,
3949 Lisp_Object binding,
3950 void *describe_map_closure)
3952 /* This function can GC */
3953 struct describe_map_closure *closure =
3954 (struct describe_map_closure *) describe_map_closure;
3955 Lisp_Object keysym = key->keysym;
3956 int modifiers = key->modifiers;
3958 /* Don't mention suppressed commands. */
3959 if (SYMBOLP (binding)
3960 && !NILP (closure->partial)
3961 && !NILP (Fget (binding, closure->partial, Qnil)))
3964 /* If we're only supposed to display mouse bindings and this isn't one,
3966 if (closure->mice_only_p &&
3967 (! (EQ (keysym, Qbutton0) ||
3968 EQ (keysym, Qbutton1) ||
3969 EQ (keysym, Qbutton2) ||
3970 EQ (keysym, Qbutton3) ||
3971 EQ (keysym, Qbutton4) ||
3972 EQ (keysym, Qbutton5) ||
3973 EQ (keysym, Qbutton6) ||
3974 EQ (keysym, Qbutton7) ||
3975 EQ (keysym, Qbutton0up) ||
3976 EQ (keysym, Qbutton1up) ||
3977 EQ (keysym, Qbutton2up) ||
3978 EQ (keysym, Qbutton3up) ||
3979 EQ (keysym, Qbutton4up) ||
3980 EQ (keysym, Qbutton5up) ||
3981 EQ (keysym, Qbutton6up) ||
3982 EQ (keysym, Qbutton7up))))
3985 /* If this command in this map is shadowed by some other map, ignore it. */
3989 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3992 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3993 keymap_lookup_inherited_mapper,
3994 /* Cast to discard `const' */
4000 /* If this key is in some map of which this map is a parent, then ignore
4001 it (in that case, it has been shadowed).
4005 struct describe_map_shadow_closure c;
4007 c.self = closure->self;
4009 sh = traverse_keymaps (closure->self_root, Qnil,
4010 describe_map_mapper_shadow_search, &c);
4011 if (!NILP (sh) && !ZEROP (sh))
4015 /* Otherwise add it to the list to be sorted. */
4016 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
4023 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
4026 /* obj1 and obj2 are conses of the form
4027 ( ( <keysym> . <modifiers> ) . <binding> )
4028 keysym and modifiers are used, binding is ignored.
4033 bit1 = XINT (XCDR (obj1));
4034 bit2 = XINT (XCDR (obj2));
4036 return bit1 < bit2 ? 1 : -1;
4038 return map_keymap_sort_predicate (obj1, obj2, pred);
4041 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4042 or 2 or more symbolic keysyms that are bound to the same thing and
4043 have consecutive character-set-properties.
4046 elide_next_two_p (Lisp_Object list)
4050 if (NILP (XCDR (list)))
4053 /* next two bindings differ */
4054 if (!EQ (XCDR (XCAR (list)),
4055 XCDR (XCAR (XCDR (list)))))
4058 /* next two modifier-sets differ */
4059 if (!EQ (XCDR (XCAR (XCAR (list))),
4060 XCDR (XCAR (XCAR (XCDR (list))))))
4063 s1 = XCAR (XCAR (XCAR (list)));
4064 s2 = XCAR (XCAR (XCAR (XCDR (list))));
4068 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
4069 if (CHAR_OR_CHAR_INTP (code))
4072 CHECK_CHAR_COERCE_INT (s1);
4078 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
4079 if (CHAR_OR_CHAR_INTP (code))
4082 CHECK_CHAR_COERCE_INT (s2);
4087 return (XCHAR (s1) == XCHAR (s2) ||
4088 XCHAR (s1) + 1 == XCHAR (s2));
4093 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
4095 /* This function can GC */
4096 struct describe_map_closure *describe_map_closure =
4097 (struct describe_map_closure *) arg;
4098 describe_map_closure->self = keymap;
4099 map_keymap (XKEYMAP (keymap)->table,
4100 0, /* don't sort: we'll do it later */
4101 describe_map_mapper, describe_map_closure);
4106 /* Describe the contents of map MAP, assuming that this map itself is
4107 reached by the sequence of prefix keys KEYS (a string or vector).
4108 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4111 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
4112 void (*elt_describer) (Lisp_Object, Lisp_Object),
4118 /* This function can GC */
4119 struct describe_map_closure describe_map_closure;
4120 Lisp_Object list = Qnil;
4121 struct buffer *buf = XBUFFER (buffer);
4122 Emchar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
4123 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
4124 : ((EQ (buf->ctl_arrow, Qt)
4125 || EQ (buf->ctl_arrow, Qnil))
4128 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4130 keymap = get_keymap (keymap, 1, 1);
4131 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4132 describe_map_closure.shadow = shadow;
4133 describe_map_closure.list = &list;
4134 describe_map_closure.self_root = keymap;
4135 describe_map_closure.mice_only_p = mice_only_p;
4137 GCPRO4 (keymap, elt_prefix, shadow, list);
4139 traverse_keymaps (keymap, Qnil,
4140 describe_map_parent_mapper, &describe_map_closure);
4144 list = list_sort (list, Qnil, describe_map_sort_predicate);
4145 buffer_insert_c_string (buf, "\n");
4146 while (!NILP (list))
4148 Lisp_Object elt = XCAR (XCAR (list));
4149 Lisp_Object keysym = XCAR (elt);
4150 int modifiers = XINT (XCDR (elt));
4152 if (!NILP (elt_prefix))
4153 buffer_insert_lisp_string (buf, elt_prefix);
4155 if (modifiers & XEMACS_MOD_META)
4156 buffer_insert_c_string (buf, "M-");
4157 if (modifiers & XEMACS_MOD_CONTROL)
4158 buffer_insert_c_string (buf, "C-");
4159 if (modifiers & XEMACS_MOD_SUPER)
4160 buffer_insert_c_string (buf, "S-");
4161 if (modifiers & XEMACS_MOD_HYPER)
4162 buffer_insert_c_string (buf, "H-");
4163 if (modifiers & XEMACS_MOD_ALT)
4164 buffer_insert_c_string (buf, "Alt-");
4165 if (modifiers & XEMACS_MOD_SHIFT)
4166 buffer_insert_c_string (buf, "Sh-");
4167 if (SYMBOLP (keysym))
4169 Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil);
4170 Emchar c = (CHAR_OR_CHAR_INTP (code)
4171 ? XCHAR_OR_CHAR_INT (code) : (Emchar) -1);
4172 /* Calling Fsingle_key_description() would cons more */
4173 #if 0 /* This is bogus */
4174 if (EQ (keysym, QKlinefeed))
4175 buffer_insert_c_string (buf, "LFD");
4176 else if (EQ (keysym, QKtab))
4177 buffer_insert_c_string (buf, "TAB");
4178 else if (EQ (keysym, QKreturn))
4179 buffer_insert_c_string (buf, "RET");
4180 else if (EQ (keysym, QKescape))
4181 buffer_insert_c_string (buf, "ESC");
4182 else if (EQ (keysym, QKdelete))
4183 buffer_insert_c_string (buf, "DEL");
4184 else if (EQ (keysym, QKspace))
4185 buffer_insert_c_string (buf, "SPC");
4186 else if (EQ (keysym, QKbackspace))
4187 buffer_insert_c_string (buf, "BS");
4190 if (c >= printable_min)
4191 buffer_insert_emacs_char (buf, c);
4192 else buffer_insert1 (buf, Fsymbol_name (keysym));
4194 else if (CHARP (keysym))
4195 buffer_insert_emacs_char (buf, XCHAR (keysym));
4197 buffer_insert_c_string (buf, "---bad keysym---");
4205 while (elide_next_two_p (list))
4213 buffer_insert_c_string (buf, ", ");
4215 buffer_insert_c_string (buf, " .. ");
4221 /* Print a description of the definition of this character. */
4222 (*elt_describer) (XCDR (XCAR (list)), buffer);
4231 syms_of_keymap (void)
4233 INIT_LRECORD_IMPLEMENTATION (keymap);
4235 defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist");
4237 defsymbol (&Qkeymapp, "keymapp");
4239 defsymbol (&Qsuppress_keymap, "suppress-keymap");
4241 defsymbol (&Qmodeline_map, "modeline-map");
4242 defsymbol (&Qtoolbar_map, "toolbar-map");
4244 DEFSUBR (Fkeymap_parents);
4245 DEFSUBR (Fset_keymap_parents);
4246 DEFSUBR (Fkeymap_name);
4247 DEFSUBR (Fset_keymap_name);
4248 DEFSUBR (Fkeymap_prompt);
4249 DEFSUBR (Fset_keymap_prompt);
4250 DEFSUBR (Fkeymap_default_binding);
4251 DEFSUBR (Fset_keymap_default_binding);
4254 DEFSUBR (Fmake_keymap);
4255 DEFSUBR (Fmake_sparse_keymap);
4257 DEFSUBR (Fcopy_keymap);
4258 DEFSUBR (Fkeymap_fullness);
4259 DEFSUBR (Fmap_keymap);
4260 DEFSUBR (Fevent_matches_key_specifier_p);
4261 DEFSUBR (Fdefine_key);
4262 DEFSUBR (Flookup_key);
4263 DEFSUBR (Fkey_binding);
4264 DEFSUBR (Fuse_global_map);
4265 DEFSUBR (Fuse_local_map);
4266 DEFSUBR (Fcurrent_local_map);
4267 DEFSUBR (Fcurrent_global_map);
4268 DEFSUBR (Fcurrent_keymaps);
4269 DEFSUBR (Faccessible_keymaps);
4270 DEFSUBR (Fkey_description);
4271 DEFSUBR (Fsingle_key_description);
4272 DEFSUBR (Fwhere_is_internal);
4273 DEFSUBR (Fdescribe_bindings_internal);
4275 DEFSUBR (Ftext_char_description);
4277 defsymbol (&Qcontrol, "control");
4278 defsymbol (&Qctrl, "ctrl");
4279 defsymbol (&Qmeta, "meta");
4280 defsymbol (&Qsuper, "super");
4281 defsymbol (&Qhyper, "hyper");
4282 defsymbol (&Qalt, "alt");
4283 defsymbol (&Qshift, "shift");
4284 defsymbol (&Qbutton0, "button0");
4285 defsymbol (&Qbutton1, "button1");
4286 defsymbol (&Qbutton2, "button2");
4287 defsymbol (&Qbutton3, "button3");
4288 defsymbol (&Qbutton4, "button4");
4289 defsymbol (&Qbutton5, "button5");
4290 defsymbol (&Qbutton6, "button6");
4291 defsymbol (&Qbutton7, "button7");
4292 defsymbol (&Qbutton0up, "button0up");
4293 defsymbol (&Qbutton1up, "button1up");
4294 defsymbol (&Qbutton2up, "button2up");
4295 defsymbol (&Qbutton3up, "button3up");
4296 defsymbol (&Qbutton4up, "button4up");
4297 defsymbol (&Qbutton5up, "button5up");
4298 defsymbol (&Qbutton6up, "button6up");
4299 defsymbol (&Qbutton7up, "button7up");
4300 defsymbol (&Qmouse_1, "mouse-1");
4301 defsymbol (&Qmouse_2, "mouse-2");
4302 defsymbol (&Qmouse_3, "mouse-3");
4303 defsymbol (&Qmouse_4, "mouse-4");
4304 defsymbol (&Qmouse_5, "mouse-5");
4305 defsymbol (&Qmouse_6, "mouse-6");
4306 defsymbol (&Qmouse_7, "mouse-7");
4307 defsymbol (&Qdown_mouse_1, "down-mouse-1");
4308 defsymbol (&Qdown_mouse_2, "down-mouse-2");
4309 defsymbol (&Qdown_mouse_3, "down-mouse-3");
4310 defsymbol (&Qdown_mouse_4, "down-mouse-4");
4311 defsymbol (&Qdown_mouse_5, "down-mouse-5");
4312 defsymbol (&Qdown_mouse_6, "down-mouse-6");
4313 defsymbol (&Qdown_mouse_7, "down-mouse-7");
4314 defsymbol (&Qmenu_selection, "menu-selection");
4315 defsymbol (&QLFD, "LFD");
4316 defsymbol (&QTAB, "TAB");
4317 defsymbol (&QRET, "RET");
4318 defsymbol (&QESC, "ESC");
4319 defsymbol (&QDEL, "DEL");
4320 defsymbol (&QSPC, "SPC");
4321 defsymbol (&QBS, "BS");
4325 vars_of_keymap (void)
4327 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
4328 Meta-prefix character.
4329 This character followed by some character `foo' turns into `Meta-foo'.
4330 This can be any form recognized as a single key specifier.
4331 To disable the meta-prefix-char, set it to a negative number.
4333 Vmeta_prefix_char = make_char (033);
4335 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4336 A buffer which should be consulted first for all mouse activity.
4337 When a mouse-click is processed, it will first be looked up in the
4338 local-map of this buffer, and then through the normal mechanism if there
4339 is no binding for that click. This buffer's value of `mode-motion-hook'
4340 will be consulted instead of the `mode-motion-hook' of the buffer of the
4341 window under the mouse. You should *bind* this, not set it.
4343 Vmouse_grabbed_buffer = Qnil;
4345 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
4346 Keymap that overrides all other local keymaps.
4347 If this variable is non-nil, it is used as a keymap instead of the
4348 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4349 You should *bind* this, not set it.
4351 Voverriding_local_map = Qnil;
4353 Fset (Qminor_mode_map_alist, Qnil);
4355 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
4356 Keymap of key translations that can override keymaps.
4358 This keymap works like `function-key-map', but is searched before it,
4359 and applies even for keys that have ordinary bindings.
4361 The `read-key-sequence' function replaces any subsequence bound by
4362 `key-translation-map' with its binding. More precisely, when the active
4363 keymaps have no binding for the current key sequence but
4364 `key-translation-map' binds a suffix of the sequence to a vector or string,
4365 `read-key-sequence' replaces the matching suffix with its binding, and
4366 continues with the new sequence. See `key-binding' for details.
4368 The events that come from bindings in `key-translation-map' are not
4369 themselves looked up in `key-translation-map'.
4371 #### FIXME: stolen from `function-key-map'; need better example.
4372 #### I guess you could implement a Dvorak keyboard with this?
4373 For example, suppose `key-translation-map' binds `ESC O P' to [f1].
4374 Typing `ESC O P' to `read-key-sequence' would return
4375 \[#<keypress-event f1>]. Typing `C-x ESC O P' would return
4376 \[#<keypress-event control-X> #<keypress-event f1>]. If [f1]
4377 were a prefix key, typing `ESC O P x' would return
4378 \[#<keypress-event f1> #<keypress-event x>].
4380 Vkey_translation_map = Qnil;
4382 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
4383 Keymap which handles mouse clicks over vertical dividers.
4385 Vvertical_divider_map = Qnil;
4387 DEFVAR_INT ("keymap-tick", &keymap_tick /*
4388 Incremented for each change to any keymap.
4392 staticpro (&Vcurrent_global_map);
4394 Vsingle_space_string = make_string ((const Bufbyte *) " ", 1);
4395 staticpro (&Vsingle_space_string);
4399 complex_vars_of_keymap (void)
4401 /* This function can GC */
4402 Lisp_Object ESC_prefix = intern ("ESC-prefix");
4403 Lisp_Object meta_disgustitute;
4405 Vcurrent_global_map = Fmake_keymap (Qnil);
4407 meta_disgustitute = Fmake_keymap (Qnil);
4408 Ffset (ESC_prefix, meta_disgustitute);
4409 /* no need to protect meta_disgustitute, though */
4410 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
4411 XKEYMAP (Vcurrent_global_map),
4413 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
4415 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));