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, Qdown_mouse_2, Qdown_mouse_3, Qdown_mouse_4,
226 Lisp_Object Qmouse_1, Qmouse_2, Qmouse_3, Qmouse_4, Qmouse_5;
228 /* Kludge kludge kludge */
229 Lisp_Object QLFD, QTAB, QRET, QESC, QDEL, QSPC, QBS;
232 /************************************************************************/
233 /* The keymap Lisp object */
234 /************************************************************************/
237 mark_keymap (Lisp_Object obj)
239 Lisp_Keymap *keymap = XKEYMAP (obj);
240 mark_object (keymap->parents);
241 mark_object (keymap->prompt);
242 mark_object (keymap->inverse_table);
243 mark_object (keymap->sub_maps_cache);
244 mark_object (keymap->default_binding);
245 mark_object (keymap->name);
246 return keymap->table;
250 print_keymap (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
252 /* This function can GC */
253 Lisp_Keymap *keymap = XKEYMAP (obj);
256 error ("printing unreadable object #<keymap 0x%x>", keymap->header.uid);
257 write_c_string ("#<keymap ", printcharfun);
258 if (!NILP (keymap->name))
260 print_internal (keymap->name, printcharfun, 1);
261 write_c_string (" ", printcharfun);
263 sprintf (buf, "size %ld 0x%x>",
264 (long) XINT (Fkeymap_fullness (obj)), keymap->header.uid);
265 write_c_string (buf, printcharfun);
268 static const struct lrecord_description keymap_description[] = {
269 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, parents) },
270 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, prompt) },
271 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, table) },
272 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, inverse_table) },
273 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, default_binding) },
274 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, sub_maps_cache) },
275 { XD_LISP_OBJECT, offsetof (Lisp_Keymap, name) },
279 /* No need for keymap_equal #### Why not? */
280 DEFINE_LRECORD_IMPLEMENTATION ("keymap", keymap,
281 mark_keymap, print_keymap, 0, 0, 0,
285 /************************************************************************/
286 /* Traversing keymaps and their parents */
287 /************************************************************************/
290 traverse_keymaps (Lisp_Object start_keymap, Lisp_Object start_parents,
291 Lisp_Object (*mapper) (Lisp_Object keymap, void *mapper_arg),
294 /* This function can GC */
296 Lisp_Object tail = start_parents;
297 Lisp_Object malloc_sucks[10];
298 Lisp_Object malloc_bites = Qnil;
300 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
301 GCPRO4 (*malloc_sucks, malloc_bites, start_keymap, tail);
304 start_keymap = get_keymap (start_keymap, 1, 1);
305 keymap = start_keymap;
306 /* Hack special-case parents at top-level */
307 tail = !NILP (tail) ? tail : XKEYMAP (keymap)->parents;
314 result = mapper (keymap, mapper_arg);
317 while (CONSP (malloc_bites))
319 Lisp_Cons *victim = XCONS (malloc_bites);
320 malloc_bites = victim->cdr;
328 if (stack_depth == 0)
331 return Qnil; /* Nothing found */
334 if (CONSP (malloc_bites))
336 Lisp_Cons *victim = XCONS (malloc_bites);
338 malloc_bites = victim->cdr;
343 tail = malloc_sucks[stack_depth];
344 gcpro1.nvars = stack_depth;
346 keymap = XCAR (tail);
353 keymap = XCAR (tail);
355 parents = XKEYMAP (keymap)->parents;
356 if (!CONSP (parents))
358 else if (NILP (tail))
363 if (CONSP (malloc_bites))
364 malloc_bites = noseeum_cons (tail, malloc_bites);
365 else if (stack_depth < countof (malloc_sucks))
367 malloc_sucks[stack_depth++] = tail;
368 gcpro1.nvars = stack_depth;
372 /* *&@##[*&^$ C. @#[$*&@# Unix. Losers all. */
374 for (i = 0, malloc_bites = Qnil;
375 i < countof (malloc_sucks);
377 malloc_bites = noseeum_cons (malloc_sucks[i],
384 keymap = get_keymap (keymap, 1, 1);
385 if (EQ (keymap, start_keymap))
387 signal_simple_error ("Cyclic keymap indirection",
394 /************************************************************************/
395 /* Some low-level functions */
396 /************************************************************************/
399 bucky_sym_to_bucky_bit (Lisp_Object sym)
401 if (EQ (sym, Qcontrol)) return XEMACS_MOD_CONTROL;
402 if (EQ (sym, Qmeta)) return XEMACS_MOD_META;
403 if (EQ (sym, Qsuper)) return XEMACS_MOD_SUPER;
404 if (EQ (sym, Qhyper)) return XEMACS_MOD_HYPER;
405 if (EQ (sym, Qalt)) return XEMACS_MOD_ALT;
406 if (EQ (sym, Qsymbol)) return XEMACS_MOD_ALT; /* #### - reverse compat */
407 if (EQ (sym, Qshift)) return XEMACS_MOD_SHIFT;
413 control_meta_superify (Lisp_Object frob, int modifiers)
417 frob = Fcons (frob, Qnil);
418 if (modifiers & XEMACS_MOD_SHIFT) frob = Fcons (Qshift, frob);
419 if (modifiers & XEMACS_MOD_ALT) frob = Fcons (Qalt, frob);
420 if (modifiers & XEMACS_MOD_HYPER) frob = Fcons (Qhyper, frob);
421 if (modifiers & XEMACS_MOD_SUPER) frob = Fcons (Qsuper, frob);
422 if (modifiers & XEMACS_MOD_CONTROL) frob = Fcons (Qcontrol, frob);
423 if (modifiers & XEMACS_MOD_META) frob = Fcons (Qmeta, frob);
428 make_key_description (const struct key_data *key, int prettify)
430 Lisp_Object keysym = key->keysym;
431 int modifiers = key->modifiers;
433 if (prettify && CHARP (keysym))
435 /* This is a little slow, but (control a) is prettier than (control 65).
436 It's now ok to do this for digit-chars too, since we've fixed the
437 bug where \9 read as the integer 9 instead of as the symbol with
440 /* !!#### I'm not sure how correct this is. */
441 Bufbyte str [1 + MAX_EMCHAR_LEN];
442 Bytecount count = set_charptr_emchar (str, XCHAR (keysym));
444 keysym = intern ((char *) str);
446 return control_meta_superify (keysym, modifiers);
450 /************************************************************************/
451 /* Low-level keymap-store functions */
452 /************************************************************************/
455 raw_lookup_key (Lisp_Object keymap,
456 const struct key_data *raw_keys, int raw_keys_count,
457 int keys_so_far, int accept_default);
459 /* Relies on caller to gc-protect args */
461 keymap_lookup_directly (Lisp_Object keymap,
462 Lisp_Object keysym, int modifiers)
466 modifiers &= ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3
467 | XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5);
468 if ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER
469 | XEMACS_MOD_HYPER | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT))
473 k = XKEYMAP (keymap);
475 /* If the keysym is a one-character symbol, use the char code instead. */
476 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
478 Lisp_Object i_fart_on_gcc =
479 make_char (string_char (XSYMBOL (keysym)->name, 0));
480 keysym = i_fart_on_gcc;
483 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
485 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
489 k = XKEYMAP (submap);
490 modifiers &= ~XEMACS_MOD_META;
495 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
499 k = XKEYMAP (submap);
501 return Fgethash (keysym, k->table, Qnil);
505 keymap_store_inverse_internal (Lisp_Object inverse_table,
509 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
514 /* Don't cons this unless necessary */
515 /* keys = Fcons (keysym, Qnil); */
516 Fputhash (value, keys, inverse_table);
518 else if (!CONSP (keys))
520 /* Now it's necessary to cons */
521 keys = Fcons (keys, keysym);
522 Fputhash (value, keys, inverse_table);
526 while (CONSP (XCDR (keys)))
528 XCDR (keys) = Fcons (XCDR (keys), keysym);
529 /* No need to call puthash because we've destructively
530 modified the list tail in place */
536 keymap_delete_inverse_internal (Lisp_Object inverse_table,
540 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
541 Lisp_Object new_keys = keys;
548 for (prev = &new_keys, tail = new_keys;
550 prev = &(XCDR (tail)), tail = XCDR (tail))
552 if (EQ (tail, keysym))
557 else if (EQ (keysym, XCAR (tail)))
565 Fremhash (value, inverse_table);
566 else if (!EQ (keys, new_keys))
567 /* Removed the first elt */
568 Fputhash (value, new_keys, inverse_table);
569 /* else the list's tail has been modified, so we don't need to
570 touch the hash table again (the pointer in there is ok).
574 /* Prevent luser from shooting herself in the foot using something like
575 (define-key ctl-x-4-map "p" global-map) */
577 check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap)
579 def = get_keymap (def, 0, 0);
585 if (XKEYMAP (def) == to_keymap)
586 signal_simple_error ("Cyclic keymap definition", def);
588 for (maps = keymap_submaps (def);
591 check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap);
596 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
599 Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil);
601 if (EQ (prev_def, def))
604 check_keymap_definition_loop (def, keymap);
606 if (!NILP (prev_def))
607 keymap_delete_inverse_internal (keymap->inverse_table,
611 Fremhash (keysym, keymap->table);
615 Fputhash (keysym, def, keymap->table);
616 keymap_store_inverse_internal (keymap->inverse_table,
624 create_bucky_submap (Lisp_Keymap *k, int modifiers,
625 Lisp_Object parent_for_debugging_info)
627 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
628 /* User won't see this, but it is nice for debugging Emacs */
629 XKEYMAP (submap)->name
630 = control_meta_superify (parent_for_debugging_info, modifiers);
631 /* Invalidate cache */
632 k->sub_maps_cache = Qt;
633 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
638 /* Relies on caller to gc-protect keymap, keysym, value */
640 keymap_store (Lisp_Object keymap, const struct key_data *key,
643 Lisp_Object keysym = key->keysym;
644 int modifiers = key->modifiers;
645 Lisp_Keymap *k = XKEYMAP (keymap);
647 modifiers &= ~(XEMACS_MOD_BUTTON1 | XEMACS_MOD_BUTTON2 | XEMACS_MOD_BUTTON3
648 | XEMACS_MOD_BUTTON4 | XEMACS_MOD_BUTTON5);
649 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META
650 | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER
651 | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0);
653 /* If the keysym is a one-character symbol, use the char code instead. */
654 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
655 keysym = make_char (string_char (XSYMBOL (keysym)->name, 0));
657 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
659 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
662 submap = create_bucky_submap (k, XEMACS_MOD_META, keymap);
663 k = XKEYMAP (submap);
664 modifiers &= ~XEMACS_MOD_META;
669 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
672 submap = create_bucky_submap (k, modifiers, keymap);
673 k = XKEYMAP (submap);
675 k->sub_maps_cache = Qt; /* Invalidate cache */
676 keymap_store_internal (keysym, k, value);
680 /************************************************************************/
681 /* Listing the submaps of a keymap */
682 /************************************************************************/
684 struct keymap_submaps_closure
686 Lisp_Object *result_locative;
690 keymap_submaps_mapper_0 (Lisp_Object key, Lisp_Object value,
691 void *keymap_submaps_closure)
693 /* This function can GC */
694 /* Perform any autoloads, etc */
700 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value,
701 void *keymap_submaps_closure)
703 /* This function can GC */
704 Lisp_Object *result_locative;
705 struct keymap_submaps_closure *cl =
706 (struct keymap_submaps_closure *) keymap_submaps_closure;
707 result_locative = cl->result_locative;
709 if (!NILP (Fkeymapp (value)))
710 *result_locative = Fcons (Fcons (key, value), *result_locative);
714 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
718 keymap_submaps (Lisp_Object keymap)
720 /* This function can GC */
721 Lisp_Keymap *k = XKEYMAP (keymap);
723 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
725 Lisp_Object result = Qnil;
726 struct gcpro gcpro1, gcpro2;
727 struct keymap_submaps_closure keymap_submaps_closure;
729 GCPRO2 (keymap, result);
730 keymap_submaps_closure.result_locative = &result;
731 /* Do this first pass to touch (and load) any autoloaded maps */
732 elisp_maphash (keymap_submaps_mapper_0, k->table,
733 &keymap_submaps_closure);
735 elisp_maphash (keymap_submaps_mapper, k->table,
736 &keymap_submaps_closure);
737 /* keep it sorted so that the result of accessible-keymaps is ordered */
738 k->sub_maps_cache = list_sort (result,
740 map_keymap_sort_predicate);
743 return k->sub_maps_cache;
747 /************************************************************************/
748 /* Basic operations on keymaps */
749 /************************************************************************/
752 make_keymap (size_t size)
755 Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, &lrecord_keymap);
757 XSETKEYMAP (result, keymap);
759 keymap->parents = Qnil;
760 keymap->prompt = Qnil;
761 keymap->table = Qnil;
762 keymap->inverse_table = Qnil;
763 keymap->default_binding = Qnil;
764 keymap->sub_maps_cache = Qnil; /* No possible submaps */
767 if (size != 0) /* hack for copy-keymap */
770 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
771 /* Inverse table is often less dense because of duplicate key-bindings.
772 If not, it will grow anyway. */
773 keymap->inverse_table =
774 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
779 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
780 Construct and return a new keymap object.
781 All entries in it are nil, meaning "command undefined".
783 Optional argument NAME specifies a name to assign to the keymap,
784 as in `set-keymap-name'. This name is only a debugging convenience;
785 it is not used except when printing the keymap.
789 Lisp_Object keymap = make_keymap (60);
791 Fset_keymap_name (keymap, name);
795 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
796 Construct and return a new keymap object.
797 All entries in it are nil, meaning "command undefined". The only
798 difference between this function and `make-keymap' is that this function
799 returns a "smaller" keymap (one that is expected to contain fewer
800 entries). As keymaps dynamically resize, this distinction is not great.
802 Optional argument NAME specifies a name to assign to the keymap,
803 as in `set-keymap-name'. This name is only a debugging convenience;
804 it is not used except when printing the keymap.
808 Lisp_Object keymap = make_keymap (8);
810 Fset_keymap_name (keymap, name);
814 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
815 Return the `parent' keymaps of KEYMAP, or nil.
816 The parents of a keymap are searched for keybindings when a key sequence
817 isn't bound in this one. `(current-global-map)' is the default parent
822 keymap = get_keymap (keymap, 1, 1);
823 return Fcopy_sequence (XKEYMAP (keymap)->parents);
829 traverse_keymaps_noop (Lisp_Object keymap, void *arg)
834 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
835 Set the `parent' keymaps of KEYMAP to PARENTS.
836 The parents of a keymap are searched for keybindings when a key sequence
837 isn't bound in this one. `(current-global-map)' is the default parent
842 /* This function can GC */
844 struct gcpro gcpro1, gcpro2;
846 GCPRO2 (keymap, parents);
847 keymap = get_keymap (keymap, 1, 1);
849 if (KEYMAPP (parents)) /* backwards-compatibility */
850 parents = list1 (parents);
853 Lisp_Object tail = parents;
859 /* Require that it be an actual keymap object, rather than a symbol
860 with a (crockish) symbol-function which is a keymap */
861 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
866 /* Check for circularities */
867 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
869 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
874 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
875 Set the `name' of the KEYMAP to NEW-NAME.
876 The name is only a debugging convenience; it is not used except
877 when printing the keymap.
881 keymap = get_keymap (keymap, 1, 1);
883 XKEYMAP (keymap)->name = new_name;
887 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
888 Return the `name' of KEYMAP.
889 The name is only a debugging convenience; it is not used except
890 when printing the keymap.
894 keymap = get_keymap (keymap, 1, 1);
896 return XKEYMAP (keymap)->name;
899 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
900 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
901 if no prompt is desired. The prompt is shown in the echo-area
902 when reading a key-sequence to be looked-up in this keymap.
904 (keymap, new_prompt))
906 keymap = get_keymap (keymap, 1, 1);
908 if (!NILP (new_prompt))
909 CHECK_STRING (new_prompt);
911 XKEYMAP (keymap)->prompt = new_prompt;
916 keymap_prompt_mapper (Lisp_Object keymap, void *arg)
918 return XKEYMAP (keymap)->prompt;
922 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
923 Return the `prompt' of KEYMAP.
924 If non-nil, the prompt is shown in the echo-area
925 when reading a key-sequence to be looked-up in this keymap.
927 (keymap, use_inherited))
929 /* This function can GC */
932 keymap = get_keymap (keymap, 1, 1);
933 prompt = XKEYMAP (keymap)->prompt;
934 if (!NILP (prompt) || NILP (use_inherited))
937 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
940 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
941 Sets the default binding of KEYMAP to COMMAND, or `nil'
942 if no default is desired. The default-binding is returned when
943 no other binding for a key-sequence is found in the keymap.
944 If a keymap has a non-nil default-binding, neither the keymap's
945 parents nor the current global map are searched for key bindings.
949 /* This function can GC */
950 keymap = get_keymap (keymap, 1, 1);
952 XKEYMAP (keymap)->default_binding = command;
956 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
957 Return the default binding of KEYMAP, or `nil' if it has none.
958 The default-binding is returned when no other binding for a key-sequence
959 is found in the keymap.
960 If a keymap has a non-nil default-binding, neither the keymap's
961 parents nor the current global map are searched for key bindings.
965 /* This function can GC */
966 keymap = get_keymap (keymap, 1, 1);
967 return XKEYMAP (keymap)->default_binding;
970 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
971 Return t if OBJECT is a keymap object.
972 The keymap may be autoloaded first if necessary.
976 /* This function can GC */
977 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
980 /* Check that OBJECT is a keymap (after dereferencing through any
981 symbols). If it is, return it.
983 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
984 is an autoload form, do the autoload and try again.
985 If AUTOLOAD is nonzero, callers must assume GC is possible.
987 ERRORP controls how we respond if OBJECT isn't a keymap.
988 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
990 Note that most of the time, we don't want to pursue autoloads.
991 Functions like Faccessible_keymaps which scan entire keymap trees
992 shouldn't load every autoloaded keymap. I'm not sure about this,
993 but it seems to me that only read_key_sequence, Flookup_key, and
994 Fdefine_key should cause keymaps to be autoloaded. */
997 get_keymap (Lisp_Object object, int errorp, int autoload)
999 /* This function can GC */
1002 Lisp_Object tem = indirect_function (object, 0);
1006 /* Should we do an autoload? */
1008 /* (autoload "filename" doc nil keymap) */
1011 && EQ (XCAR (tem), Qautoload)
1012 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
1014 struct gcpro gcpro1, gcpro2;
1015 GCPRO2 (tem, object);
1016 do_autoload (tem, object);
1020 object = wrong_type_argument (Qkeymapp, object);
1026 /* Given OBJECT which was found in a slot in a keymap,
1027 trace indirect definitions to get the actual definition of that slot.
1028 An indirect definition is a list of the form
1029 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1030 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1033 get_keyelt (Lisp_Object object, int accept_default)
1035 /* This function can GC */
1039 if (!CONSP (object))
1043 struct gcpro gcpro1;
1045 map = XCAR (object);
1046 map = get_keymap (map, 0, 1);
1049 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1052 Lisp_Object idx = Fcdr (object);
1053 struct key_data indirection;
1057 event.event_type = empty_event;
1058 character_to_event (XCHAR (idx), &event,
1059 XCONSOLE (Vselected_console), 0, 0);
1060 indirection = event.event.key;
1062 else if (CONSP (idx))
1064 if (!INTP (XCDR (idx)))
1066 indirection.keysym = XCAR (idx);
1067 indirection.modifiers = (unsigned char) XINT (XCDR (idx));
1069 else if (SYMBOLP (idx))
1071 indirection.keysym = idx;
1072 indirection.modifiers = 0;
1079 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
1081 else if (STRINGP (XCAR (object)))
1083 /* If the keymap contents looks like (STRING . DEFN),
1085 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1086 will be used by HierarKey menus. */
1087 object = XCDR (object);
1092 /* Anything else is really the value. */
1098 keymap_lookup_1 (Lisp_Object keymap, const struct key_data *key,
1101 /* This function can GC */
1102 return get_keyelt (keymap_lookup_directly (keymap,
1103 key->keysym, key->modifiers),
1108 /************************************************************************/
1109 /* Copying keymaps */
1110 /************************************************************************/
1112 struct copy_keymap_inverse_closure
1114 Lisp_Object inverse_table;
1118 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value,
1119 void *copy_keymap_inverse_closure)
1121 struct copy_keymap_inverse_closure *closure =
1122 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
1124 /* copy-sequence deals with dotted lists. */
1126 value = Fcopy_list (value);
1127 Fputhash (key, value, closure->inverse_table);
1134 copy_keymap_internal (Lisp_Keymap *keymap)
1136 Lisp_Object nkm = make_keymap (0);
1137 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
1138 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1139 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1141 new_keymap->parents = Fcopy_sequence (keymap->parents);
1142 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1143 new_keymap->table = Fcopy_hash_table (keymap->table);
1144 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table);
1145 new_keymap->default_binding = keymap->default_binding;
1146 /* After copying the inverse map, we need to copy the conses which
1147 are its values, lest they be shared by the copy, and mangled.
1149 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
1150 ©_keymap_inverse_closure);
1155 static Lisp_Object copy_keymap (Lisp_Object keymap);
1157 struct copy_keymap_closure
1163 copy_keymap_mapper (Lisp_Object key, Lisp_Object value,
1164 void *copy_keymap_closure)
1166 /* This function can GC */
1167 struct copy_keymap_closure *closure =
1168 (struct copy_keymap_closure *) copy_keymap_closure;
1170 /* When we encounter a keymap which is indirected through a
1171 symbol, we need to copy the sub-map. In v18, the form
1172 (lookup-key (copy-keymap global-map) "\C-x")
1173 returned a new keymap, not the symbol 'Control-X-prefix.
1175 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */
1176 if (KEYMAPP (value))
1177 keymap_store_internal (key, closure->self,
1178 copy_keymap (value));
1183 copy_keymap (Lisp_Object keymap)
1185 /* This function can GC */
1186 struct copy_keymap_closure copy_keymap_closure;
1188 keymap = copy_keymap_internal (XKEYMAP (keymap));
1189 copy_keymap_closure.self = XKEYMAP (keymap);
1190 elisp_maphash (copy_keymap_mapper,
1191 XKEYMAP (keymap)->table,
1192 ©_keymap_closure);
1196 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1197 Return a copy of the keymap KEYMAP.
1198 The copy starts out with the same definitions of KEYMAP,
1199 but changing either the copy or KEYMAP does not affect the other.
1200 Any key definitions that are subkeymaps are recursively copied.
1204 /* This function can GC */
1205 keymap = get_keymap (keymap, 1, 1);
1206 return copy_keymap (keymap);
1211 keymap_fullness (Lisp_Object keymap)
1213 /* This function can GC */
1215 Lisp_Object sub_maps;
1216 struct gcpro gcpro1, gcpro2;
1218 keymap = get_keymap (keymap, 1, 1);
1219 fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table));
1220 GCPRO2 (keymap, sub_maps);
1221 for (sub_maps = keymap_submaps (keymap);
1223 sub_maps = XCDR (sub_maps))
1225 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
1227 Lisp_Object bucky_map = XCDR (XCAR (sub_maps));
1228 fullness--; /* don't count bucky maps themselves. */
1229 fullness += keymap_fullness (bucky_map);
1236 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1237 Return the number of bindings in the keymap.
1241 /* This function can GC */
1242 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
1246 /************************************************************************/
1247 /* Defining keys in keymaps */
1248 /************************************************************************/
1250 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1251 and perform any necessary canonicalization. */
1254 define_key_check_and_coerce_keysym (Lisp_Object spec,
1255 Lisp_Object *keysym,
1258 /* Now, check and massage the trailing keysym specifier. */
1259 if (SYMBOLP (*keysym))
1261 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
1263 Lisp_Object ream_gcc_up_the_ass =
1264 make_char (string_char (XSYMBOL (*keysym)->name, 0));
1265 *keysym = ream_gcc_up_the_ass;
1269 else if (CHAR_OR_CHAR_INTP (*keysym))
1271 CHECK_CHAR_COERCE_INT (*keysym);
1273 if (XCHAR (*keysym) < ' '
1274 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
1275 /* yuck! Can't make the above restriction; too many compatibility
1277 signal_simple_error ("keysym char must be printable", *keysym);
1278 /* #### This bites! I want to be able to write (control shift a) */
1279 if (modifiers & XEMACS_MOD_SHIFT)
1281 ("The `shift' modifier may not be applied to ASCII keysyms",
1286 signal_simple_error ("Unknown keysym specifier", *keysym);
1289 if (SYMBOLP (*keysym))
1291 char *name = (char *) string_data (XSYMBOL (*keysym)->name);
1293 /* FSFmacs uses symbols with the printed representation of keysyms in
1294 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1295 confusion, notice the M-x syntax and signal an error - because
1296 otherwise it would be interpreted as a regular keysym, and would even
1297 show up in the list-buffers output, causing confusion to the naive.
1299 We can get away with this because none of the X keysym names contain
1300 a hyphen (some contain underscore, however).
1302 It might be useful to reject keysyms which are not x-valid-keysym-
1303 name-p, but that would interfere with various tricks we do to
1304 sanitize the Sun keyboards, and would make it trickier to
1305 conditionalize a .emacs file for multiple X servers.
1307 if (((int) strlen (name) >= 2 && name[1] == '-')
1310 /* Ok, this is a bit more dubious - prevent people from doing things
1311 like (global-set-key 'RET 'something) because that will have the
1312 same problem as above. (Gag!) Maybe we should just silently
1313 accept these as aliases for the "real" names?
1315 (string_length (XSYMBOL (*keysym)->name) <= 3 &&
1316 (!strcmp (name, "LFD") ||
1317 !strcmp (name, "TAB") ||
1318 !strcmp (name, "RET") ||
1319 !strcmp (name, "ESC") ||
1320 !strcmp (name, "DEL") ||
1321 !strcmp (name, "SPC") ||
1322 !strcmp (name, "BS")))
1326 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1329 /* #### Ok, this is a bit more dubious - make people not lose if they
1330 do things like (global-set-key 'RET 'something) because that would
1331 otherwise have the same problem as above. (Gag!) We silently
1332 accept these as aliases for the "real" names.
1334 else if (!strncmp(name, "kp_", 3)) {
1335 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1338 strncpy(temp, name, sizeof (temp));
1339 temp[sizeof (temp) - 1] = '\0';
1341 *keysym = Fintern_soft(make_string((Bufbyte *)temp,
1344 } else if (EQ (*keysym, QLFD))
1345 *keysym = QKlinefeed;
1346 else if (EQ (*keysym, QTAB))
1348 else if (EQ (*keysym, QRET))
1350 else if (EQ (*keysym, QESC))
1352 else if (EQ (*keysym, QDEL))
1354 else if (EQ (*keysym, QSPC))
1356 else if (EQ (*keysym, QBS))
1357 *keysym = QKbackspace;
1358 /* Emacs compatibility */
1359 else if (EQ(*keysym, Qdown_mouse_1))
1361 else if (EQ(*keysym, Qdown_mouse_2))
1363 else if (EQ(*keysym, Qdown_mouse_3))
1365 else if (EQ(*keysym, Qdown_mouse_4))
1367 else if (EQ(*keysym, Qdown_mouse_5))
1369 else if (EQ(*keysym, Qmouse_1))
1370 *keysym = Qbutton1up;
1371 else if (EQ(*keysym, Qmouse_2))
1372 *keysym = Qbutton2up;
1373 else if (EQ(*keysym, Qmouse_3))
1374 *keysym = Qbutton3up;
1375 else if (EQ(*keysym, Qmouse_4))
1376 *keysym = Qbutton4up;
1377 else if (EQ(*keysym, Qmouse_5))
1378 *keysym = Qbutton5up;
1383 /* Given any kind of key-specifier, return a keysym and modifier mask.
1384 Proper canonicalization is performed:
1386 -- integers are converted into the equivalent characters.
1387 -- one-character strings are converted into the equivalent characters.
1391 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
1393 if (CHAR_OR_CHAR_INTP (spec))
1396 event.event_type = empty_event;
1397 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
1398 XCONSOLE (Vselected_console), 0, 0);
1399 returned_value->keysym = event.event.key.keysym;
1400 returned_value->modifiers = event.event.key.modifiers;
1402 else if (EVENTP (spec))
1404 switch (XEVENT (spec)->event_type)
1406 case key_press_event:
1408 returned_value->keysym = XEVENT (spec)->event.key.keysym;
1409 returned_value->modifiers = XEVENT (spec)->event.key.modifiers;
1412 case button_press_event:
1413 case button_release_event:
1415 int down = (XEVENT (spec)->event_type == button_press_event);
1416 switch (XEVENT (spec)->event.button.button)
1419 returned_value->keysym = (down ? Qbutton1 : Qbutton1up); break;
1421 returned_value->keysym = (down ? Qbutton2 : Qbutton2up); break;
1423 returned_value->keysym = (down ? Qbutton3 : Qbutton3up); break;
1425 returned_value->keysym = (down ? Qbutton4 : Qbutton4up); break;
1427 returned_value->keysym = (down ? Qbutton5 : Qbutton5up); break;
1429 returned_value->keysym = (down ? Qbutton6 : Qbutton6up); break;
1431 returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break;
1433 returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break;
1435 returned_value->modifiers = XEVENT (spec)->event.button.modifiers;
1439 signal_error (Qwrong_type_argument,
1440 list2 (build_translated_string
1441 ("unable to bind this type of event"),
1445 else if (SYMBOLP (spec))
1447 /* Be nice, allow = to mean (=) */
1448 if (bucky_sym_to_bucky_bit (spec) != 0)
1449 signal_simple_error ("Key is a modifier name", spec);
1450 define_key_check_and_coerce_keysym (spec, &spec, 0);
1451 returned_value->keysym = spec;
1452 returned_value->modifiers = 0;
1454 else if (CONSP (spec))
1457 Lisp_Object keysym = Qnil;
1458 Lisp_Object rest = spec;
1460 /* First, parse out the leading modifier symbols. */
1461 while (CONSP (rest))
1465 keysym = XCAR (rest);
1466 modifier = bucky_sym_to_bucky_bit (keysym);
1467 modifiers |= modifier;
1468 if (!NILP (XCDR (rest)))
1471 signal_simple_error ("Unknown modifier", keysym);
1476 signal_simple_error ("Nothing but modifiers here",
1483 signal_simple_error ("List must be nil-terminated", spec);
1485 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
1486 returned_value->keysym = keysym;
1487 returned_value->modifiers = modifiers;
1491 signal_simple_error ("Unknown key-sequence specifier",
1496 /* Used by character-to-event */
1498 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
1499 int allow_menu_events)
1501 struct key_data raw_key;
1503 if (allow_menu_events &&
1505 /* #### where the hell does this come from? */
1506 EQ (XCAR (list), Qmenu_selection))
1508 Lisp_Object fn, arg;
1509 if (! NILP (Fcdr (Fcdr (list))))
1510 signal_simple_error ("Invalid menu event desc", list);
1511 arg = Fcar (Fcdr (list));
1513 fn = Qcall_interactively;
1516 XSETFRAME (XEVENT (event)->channel, selected_frame ());
1517 XEVENT (event)->event_type = misc_user_event;
1518 XEVENT (event)->event.eval.function = fn;
1519 XEVENT (event)->event.eval.object = arg;
1523 define_key_parser (list, &raw_key);
1525 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) ||
1526 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) ||
1527 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) ||
1528 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) ||
1529 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) ||
1530 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) ||
1531 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) ||
1532 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up))
1533 error ("Mouse-clicks can't appear in saved keyboard macros.");
1535 XEVENT (event)->channel = Vselected_console;
1536 XEVENT (event)->event_type = key_press_event;
1537 XEVENT (event)->event.key.keysym = raw_key.keysym;
1538 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
1543 event_matches_key_specifier_p (Lisp_Event *event, Lisp_Object key_specifier)
1545 Lisp_Object event2 = Qnil;
1547 struct gcpro gcpro1;
1549 if (event->event_type != key_press_event || NILP (key_specifier) ||
1550 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
1553 /* if the specifier is an integer such as 27, then it should match
1554 both of the events 'escape' and 'control ['. Calling
1555 Fcharacter_to_event() will only match 'escape'. */
1556 if (CHAR_OR_CHAR_INTP (key_specifier))
1557 return (XCHAR_OR_CHAR_INT (key_specifier)
1558 == event_to_character (event, 0, 0, 0));
1560 /* Otherwise, we cannot call event_to_character() because we may
1561 be dealing with non-ASCII keystrokes. In any case, if I ask
1562 for 'control [' then I should get exactly that, and not
1565 However, we have to behave differently on TTY's, where 'control ['
1566 is silently converted into 'escape' by the keyboard driver.
1567 In this case, ASCII is the only thing we know about, so we have
1568 to compare the ASCII values. */
1571 event2 = Fmake_event (Qnil, Qnil);
1572 Fcharacter_to_event (key_specifier, event2, Qnil, Qnil);
1573 if (XEVENT (event2)->event_type != key_press_event)
1575 else if (CONSOLE_TTY_P (XCONSOLE (EVENT_CHANNEL (event))))
1579 ch1 = event_to_character (event, 0, 0, 0);
1580 ch2 = event_to_character (XEVENT (event2), 0, 0, 0);
1581 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1583 else if (EQ (event->event.key.keysym, XEVENT (event2)->event.key.keysym) &&
1584 event->event.key.modifiers == XEVENT (event2)->event.key.modifiers)
1588 Fdeallocate_event (event2);
1594 meta_prefix_char_p (const struct key_data *key)
1598 event.event_type = key_press_event;
1599 event.channel = Vselected_console;
1600 event.event.key.keysym = key->keysym;
1601 event.event.key.modifiers = key->modifiers;
1602 return event_matches_key_specifier_p (&event, Vmeta_prefix_char);
1605 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1606 Return non-nil if EVENT matches KEY-SPECIFIER.
1607 This can be useful, e.g., to determine if the user pressed `help-char' or
1610 (event, key_specifier))
1612 CHECK_LIVE_EVENT (event);
1613 return (event_matches_key_specifier_p (XEVENT (event), key_specifier)
1617 #define MACROLET(k,m) do { \
1618 returned_value->keysym = (k); \
1619 returned_value->modifiers = (m); \
1620 RETURN_SANS_WARNINGS; \
1624 Given a keysym, return another keysym/modifier pair which could be
1625 considered the same key in an ASCII world. Backspace returns ^H, for
1629 define_key_alternate_name (struct key_data *key,
1630 struct key_data *returned_value)
1632 Lisp_Object keysym = key->keysym;
1633 int modifiers = key->modifiers;
1634 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL));
1635 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META));
1636 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1637 returned_value->modifiers = 0;
1638 if (modifiers_sans_meta == XEMACS_MOD_CONTROL)
1640 if EQ (keysym, QKspace)
1641 MACROLET (make_char ('@'), modifiers);
1642 else if (!CHARP (keysym))
1644 else switch (XCHAR (keysym))
1646 case '@': /* c-@ => c-space */
1647 MACROLET (QKspace, modifiers);
1648 case 'h': /* c-h => backspace */
1649 MACROLET (QKbackspace, modifiers_sans_control);
1650 case 'i': /* c-i => tab */
1651 MACROLET (QKtab, modifiers_sans_control);
1652 case 'j': /* c-j => linefeed */
1653 MACROLET (QKlinefeed, modifiers_sans_control);
1654 case 'm': /* c-m => return */
1655 MACROLET (QKreturn, modifiers_sans_control);
1656 case '[': /* c-[ => escape */
1657 MACROLET (QKescape, modifiers_sans_control);
1662 else if (modifiers_sans_meta != 0)
1664 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
1665 MACROLET (make_char ('h'), (modifiers | XEMACS_MOD_CONTROL));
1666 else if (EQ (keysym, QKtab)) /* tab => c-i */
1667 MACROLET (make_char ('i'), (modifiers | XEMACS_MOD_CONTROL));
1668 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
1669 MACROLET (make_char ('j'), (modifiers | XEMACS_MOD_CONTROL));
1670 else if (EQ (keysym, QKreturn)) /* return => c-m */
1671 MACROLET (make_char ('m'), (modifiers | XEMACS_MOD_CONTROL));
1672 else if (EQ (keysym, QKescape)) /* escape => c-[ */
1673 MACROLET (make_char ('['), (modifiers | XEMACS_MOD_CONTROL));
1681 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
1684 /* This function can GC */
1685 Lisp_Object new_keys;
1687 Lisp_Object mpc_binding;
1688 struct key_data meta_key;
1690 if (NILP (Vmeta_prefix_char) ||
1691 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
1694 define_key_parser (Vmeta_prefix_char, &meta_key);
1695 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
1696 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
1701 else if (STRINGP (keys))
1702 new_keys = Fsubstring (keys, Qzero, make_int (indx));
1703 else if (VECTORP (keys))
1705 new_keys = make_vector (indx, Qnil);
1706 for (i = 0; i < indx; i++)
1707 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
1715 if (EQ (keys, new_keys))
1716 error_with_frob (mpc_binding,
1717 "can't bind %s: %s has a non-keymap binding",
1718 (char *) XSTRING_DATA (Fkey_description (keys)),
1719 (char *) XSTRING_DATA (Fsingle_key_description
1720 (Vmeta_prefix_char)));
1722 error_with_frob (mpc_binding,
1723 "can't bind %s: %s %s has a non-keymap binding",
1724 (char *) XSTRING_DATA (Fkey_description (keys)),
1725 (char *) XSTRING_DATA (Fkey_description (new_keys)),
1726 (char *) XSTRING_DATA (Fsingle_key_description
1727 (Vmeta_prefix_char)));
1730 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
1731 Define key sequence KEYS, in KEYMAP, as DEF.
1732 KEYMAP is a keymap object.
1733 KEYS is the sequence of keystrokes to bind, described below.
1734 DEF is anything that can be a key's definition:
1735 nil (means key is undefined in this keymap);
1736 a command (a Lisp function suitable for interactive calling);
1737 a string or key sequence vector (treated as a keyboard macro);
1738 a keymap (to define a prefix key);
1739 a symbol; when the key is looked up, the symbol will stand for its
1740 function definition, that should at that time be one of the above,
1741 or another symbol whose function definition is used, and so on.
1742 a cons (STRING . DEFN), meaning that DEFN is the definition
1743 (DEFN should be a valid definition in its own right);
1744 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1746 Contrary to popular belief, the world is not ASCII. When running under a
1747 window manager, XEmacs can tell the difference between, for example, the
1748 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1749 bind different commands to each of these.
1751 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1752 set of modifiers (such as control and meta). A `keysym' is what is printed
1753 on the keys on your keyboard.
1755 A keysym may be represented by a symbol, or (if and only if it is equivalent
1756 to an ASCII character in the range 32 - 255) by a character or its equivalent
1757 ASCII code. The `A' key may be represented by the symbol `A', the character
1758 `?A', or by the number 65. The `break' key may be represented only by the
1761 A keystroke may be represented by a list: the last element of the list
1762 is the key (a symbol, character, or number, as above) and the
1763 preceding elements are the symbolic names of modifier keys (control,
1764 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1765 represented by the forms `(control b)', `(control ?b)', and `(control
1766 98)'. A keystroke may also be represented by an event object, as
1767 returned by the `next-command-event' and `read-key-sequence'
1770 Note that in this context, the keystroke `control-b' is *not* represented
1771 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1773 The `shift' modifier is somewhat of a special case. You should not (and
1774 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1775 have ASCII equivalents, the state of the shift key is implicit in the
1776 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1777 sort of thing varies from keyboard to keyboard. The shift modifier is for
1778 use only with characters that do not have a second keysym on the same key,
1779 such as `backspace' and `tab'.
1781 A key sequence is a vector of keystrokes. As a degenerate case, elements
1782 of this vector may also be keysyms if they have no modifiers. That is,
1783 the `A' keystroke is represented by all of these forms:
1784 A ?A 65 (A) (?A) (65)
1785 [A] [?A] [65] [(A)] [(?A)] [(65)]
1787 the `control-a' keystroke is represented by these forms:
1788 (control A) (control ?A) (control 65)
1789 [(control A)] [(control ?A)] [(control 65)]
1790 the key sequence `control-c control-a' is represented by these forms:
1791 [(control c) (control a)] [(control ?c) (control ?a)]
1792 [(control 99) (control 65)] etc.
1794 Mouse button clicks work just like keypresses: (control button1) means
1795 pressing the left mouse button while holding down the control key.
1796 \[(control c) (shift button3)] means control-c, hold shift, click right.
1798 Commands may be bound to the mouse-button up-stroke rather than the down-
1799 stroke as well. `button1' means the down-stroke, and `button1up' means the
1800 up-stroke. Different commands may be bound to the up and down strokes,
1801 though that is probably not what you want, so be careful.
1803 For backward compatibility, a key sequence may also be represented by a
1804 string. In this case, it represents the key sequence(s) that would
1805 produce that sequence of ASCII characters in a purely ASCII world. For
1806 example, a string containing the ASCII backspace character, "\\^H", would
1807 represent two key sequences: `(control h)' and `backspace'. Binding a
1808 command to this will actually bind both of those key sequences. Likewise
1809 for the following pairs:
1816 control @ control space
1818 After binding a command to two key sequences with a form like
1820 (define-key global-map "\\^X\\^I" \'command-1)
1822 it is possible to redefine only one of those sequences like so:
1824 (define-key global-map [(control x) (control i)] \'command-2)
1825 (define-key global-map [(control x) tab] \'command-3)
1827 Of course, all of this applies only when running under a window system. If
1828 you're talking to XEmacs through a TTY connection, you don't get any of
1831 (keymap, keys, def))
1833 /* This function can GC */
1838 struct gcpro gcpro1, gcpro2, gcpro3;
1841 len = XVECTOR_LENGTH (keys);
1842 else if (STRINGP (keys))
1843 len = XSTRING_CHAR_LENGTH (keys);
1844 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
1846 if (!CONSP (keys)) keys = list1 (keys);
1848 keys = make_vector (1, keys); /* this is kinda sleazy. */
1852 keys = wrong_type_argument (Qsequencep, keys);
1853 len = XINT (Flength (keys));
1858 GCPRO3 (keymap, keys, def);
1861 When the user defines a key which, in a strictly ASCII world, would be
1862 produced by two different keys (^J and linefeed, or ^H and backspace,
1863 for example) then the binding will be made for both keysyms.
1865 This is done if the user binds a command to a string, as in
1866 (define-key map "\^H" 'something), but not when using one of the new
1867 syntaxes, like (define-key map '(control h) 'something).
1869 ascii_hack = (STRINGP (keys));
1871 keymap = get_keymap (keymap, 1, 1);
1877 struct key_data raw_key1;
1878 struct key_data raw_key2;
1881 c = make_char (string_char (XSTRING (keys), idx));
1883 c = XVECTOR_DATA (keys) [idx];
1885 define_key_parser (c, &raw_key1);
1887 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
1889 if (idx == (len - 1))
1891 /* This is a hack to prevent a binding for the meta-prefix-char
1892 from being made in a map which already has a non-empty "meta"
1893 submap. That is, we can't let both "escape" and "meta" have
1894 a binding in the same keymap. This implies that the idiom
1895 (define-key my-map "\e" my-escape-map)
1896 (define-key my-escape-map "a" 'my-command)
1897 no longer works. That's ok. Instead the luser should do
1898 (define-key my-map "\ea" 'my-command)
1900 (define-key my-map "\M-a" 'my-command)
1902 (defvar my-escape-map (lookup-key my-map "\e"))
1903 if the luser really wants the map in a variable.
1905 Lisp_Object meta_map;
1906 struct gcpro ngcpro1;
1909 meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
1910 XKEYMAP (keymap)->table, Qnil);
1911 if (!NILP (meta_map)
1912 && keymap_fullness (meta_map) != 0)
1913 signal_simple_error_2
1914 ("Map contains meta-bindings, can't bind",
1915 Fsingle_key_description (Vmeta_prefix_char), keymap);
1927 define_key_alternate_name (&raw_key1, &raw_key2);
1930 raw_key2.keysym = Qnil;
1931 raw_key2.modifiers = 0;
1936 raw_key1.modifiers |= XEMACS_MOD_META;
1937 raw_key2.modifiers |= XEMACS_MOD_META;
1941 /* This crap is to make sure that someone doesn't bind something like
1942 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
1943 if (raw_key1.modifiers & XEMACS_MOD_META)
1944 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
1948 keymap_store (keymap, &raw_key1, def);
1949 if (ascii_hack && !NILP (raw_key2.keysym))
1950 keymap_store (keymap, &raw_key2, def);
1957 struct gcpro ngcpro1;
1960 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
1963 cmd = Fmake_sparse_keymap (Qnil);
1964 XKEYMAP (cmd)->name /* for debugging */
1965 = list2 (make_key_description (&raw_key1, 1), keymap);
1966 keymap_store (keymap, &raw_key1, cmd);
1968 if (NILP (Fkeymapp (cmd)))
1969 signal_simple_error_2 ("Invalid prefix keys in sequence",
1972 if (ascii_hack && !NILP (raw_key2.keysym) &&
1973 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
1974 keymap_store (keymap, &raw_key2, cmd);
1976 keymap = get_keymap (cmd, 1, 1);
1983 /************************************************************************/
1984 /* Looking up keys in keymaps */
1985 /************************************************************************/
1987 /* We need a very fast (i.e., non-consing) version of lookup-key in order
1988 to make where-is-internal really fly. */
1990 struct raw_lookup_key_mapper_closure
1993 const struct key_data *raw_keys;
1999 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
2001 /* Caller should gc-protect args (keymaps may autoload) */
2003 raw_lookup_key (Lisp_Object keymap,
2004 const struct key_data *raw_keys, int raw_keys_count,
2005 int keys_so_far, int accept_default)
2007 /* This function can GC */
2008 struct raw_lookup_key_mapper_closure c;
2009 c.remaining = raw_keys_count - 1;
2010 c.raw_keys = raw_keys;
2011 c.raw_keys_count = raw_keys_count;
2012 c.keys_so_far = keys_so_far;
2013 c.accept_default = accept_default;
2015 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
2019 raw_lookup_key_mapper (Lisp_Object k, void *arg)
2021 /* This function can GC */
2022 struct raw_lookup_key_mapper_closure *c =
2023 (struct raw_lookup_key_mapper_closure *) arg;
2024 int accept_default = c->accept_default;
2025 int remaining = c->remaining;
2026 int keys_so_far = c->keys_so_far;
2027 const struct key_data *raw_keys = c->raw_keys;
2030 if (! meta_prefix_char_p (&(raw_keys[0])))
2032 /* Normal case: every case except the meta-hack (see below). */
2033 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2036 /* Return whatever we found if we're out of keys */
2038 else if (NILP (cmd))
2039 /* Found nothing (though perhaps parent map may have binding) */
2041 else if (NILP (Fkeymapp (cmd)))
2042 /* Didn't find a keymap, and we have more keys.
2043 * Return a fixnum to indicate that keys were too long.
2045 cmd = make_int (keys_so_far + 1);
2047 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2048 keys_so_far + 1, accept_default);
2052 /* This is a hack so that looking up a key-sequence whose last
2053 * element is the meta-prefix-char will return the keymap that
2054 * the "meta" keys are stored in, if there is no binding for
2055 * the meta-prefix-char (and if this map has a "meta" submap).
2056 * If this map doesn't have a "meta" submap, then the
2057 * meta-prefix-char is looked up just like any other key.
2061 /* First look for the prefix-char directly */
2062 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2065 /* Do kludgy return of the meta-map */
2066 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
2067 XKEYMAP (k)->table, Qnil);
2072 /* Search for the prefix-char-prefixed sequence directly */
2073 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2074 cmd = get_keymap (cmd, 0, 1);
2076 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2077 keys_so_far + 1, accept_default);
2078 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0)
2080 struct key_data metified;
2081 metified.keysym = raw_keys[1].keysym;
2082 metified.modifiers = raw_keys[1].modifiers |
2083 (unsigned char) XEMACS_MOD_META;
2085 /* Search for meta-next-char sequence directly */
2086 cmd = keymap_lookup_1 (k, &metified, accept_default);
2091 cmd = get_keymap (cmd, 0, 1);
2093 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
2100 if (accept_default && NILP (cmd))
2101 cmd = XKEYMAP (k)->default_binding;
2105 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2106 /* Caller should gc-protect arguments */
2108 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
2111 /* This function can GC */
2112 struct key_data kkk[20];
2113 struct key_data *raw_keys;
2119 if (nkeys < countof (kkk))
2122 raw_keys = alloca_array (struct key_data, nkeys);
2124 for (i = 0; i < nkeys; i++)
2126 define_key_parser (keys[i], &(raw_keys[i]));
2128 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
2132 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2135 /* This function can GC */
2136 struct key_data kkk[20];
2140 struct key_data *raw_keys;
2141 Lisp_Object tem = Qnil;
2142 struct gcpro gcpro1, gcpro2;
2145 CHECK_LIVE_EVENT (event_head);
2147 nkeys = event_chain_count (event_head);
2149 if (nkeys < countof (kkk))
2152 raw_keys = alloca_array (struct key_data, nkeys);
2155 EVENT_CHAIN_LOOP (event, event_head)
2156 define_key_parser (event, &(raw_keys[nkeys++]));
2157 GCPRO2 (keymaps[0], event_head);
2158 gcpro1.nvars = nmaps;
2159 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
2160 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
2161 for (iii = 0; iii < nmaps; iii++)
2163 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
2167 /* Too long in some local map means don't look at global map */
2171 else if (!NILP (tem))
2178 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
2179 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2180 Nil is returned if KEYS is unbound. See documentation of `define-key'
2181 for valid key definitions and key-sequence specifications.
2182 A number is returned if KEYS is "too long"; that is, the leading
2183 characters fail to be a valid sequence of prefix characters in KEYMAP.
2184 The number is how many key strokes at the front of KEYS it takes to
2185 reach a non-prefix command.
2187 (keymap, keys, accept_default))
2189 /* This function can GC */
2191 return lookup_keys (keymap,
2192 XVECTOR_LENGTH (keys),
2193 XVECTOR_DATA (keys),
2194 !NILP (accept_default));
2195 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
2196 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
2197 else if (STRINGP (keys))
2199 int length = XSTRING_CHAR_LENGTH (keys);
2201 struct key_data *raw_keys = alloca_array (struct key_data, length);
2205 for (i = 0; i < length; i++)
2207 Emchar n = string_char (XSTRING (keys), i);
2208 define_key_parser (make_char (n), &(raw_keys[i]));
2210 return raw_lookup_key (keymap, raw_keys, length, 0,
2211 !NILP (accept_default));
2215 keys = wrong_type_argument (Qsequencep, keys);
2216 return Flookup_key (keymap, keys, accept_default);
2220 /* Given a key sequence, returns a list of keymaps to search for bindings.
2221 Does all manner of semi-hairy heuristics, like looking in the current
2222 buffer's map before looking in the global map and looking in the local
2223 map of the buffer in which the mouse was clicked in event0 is a click.
2225 It would be kind of nice if this were in Lisp so that this semi-hairy
2226 semi-heuristic command-lookup behavior could be readily understood and
2227 customised. However, this needs to be pretty fast, or performance of
2228 keyboard macros goes to shit; putting this in lisp slows macros down
2229 2-3x. And they're already slower than v18 by 5-6x.
2232 struct relevant_maps
2235 unsigned int max_maps;
2237 struct gcpro *gcpro;
2240 static void get_relevant_extent_keymaps (Lisp_Object pos,
2241 Lisp_Object buffer_or_string,
2243 struct relevant_maps *closure);
2244 static void get_relevant_minor_maps (Lisp_Object buffer,
2245 struct relevant_maps *closure);
2248 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
2250 unsigned int nmaps = closure->nmaps;
2254 closure->nmaps = nmaps + 1;
2255 if (nmaps < closure->max_maps)
2257 closure->maps[nmaps] = map;
2258 closure->gcpro->nvars = nmaps;
2263 get_relevant_keymaps (Lisp_Object keys,
2264 int max_maps, Lisp_Object maps[])
2266 /* This function can GC */
2267 Lisp_Object terminal = Qnil;
2268 struct gcpro gcpro1;
2269 struct relevant_maps closure;
2270 struct console *con;
2275 closure.max_maps = max_maps;
2276 closure.maps = maps;
2277 closure.gcpro = &gcpro1;
2280 terminal = event_chain_tail (keys);
2281 else if (VECTORP (keys))
2283 int len = XVECTOR_LENGTH (keys);
2285 terminal = XVECTOR_DATA (keys)[len - 1];
2288 if (EVENTP (terminal))
2290 CHECK_LIVE_EVENT (terminal);
2291 con = event_console_or_selected (terminal);
2294 con = XCONSOLE (Vselected_console);
2296 if (KEYMAPP (con->overriding_terminal_local_map)
2297 || KEYMAPP (Voverriding_local_map))
2299 if (KEYMAPP (con->overriding_terminal_local_map))
2300 relevant_map_push (con->overriding_terminal_local_map, &closure);
2301 if (KEYMAPP (Voverriding_local_map))
2302 relevant_map_push (Voverriding_local_map, &closure);
2304 else if (!EVENTP (terminal)
2305 || (XEVENT (terminal)->event_type != button_press_event
2306 && XEVENT (terminal)->event_type != button_release_event))
2309 XSETBUFFER (tem, current_buffer);
2310 /* It's not a mouse event; order of keymaps searched is:
2311 o keymap of any/all extents under the mouse
2313 o local-map of current-buffer
2316 /* The terminal element of the lookup may be nil or a keysym.
2317 In those cases we don't want to check for an extent
2319 if (EVENTP (terminal))
2321 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
2322 tem, Qnil, &closure);
2324 get_relevant_minor_maps (tem, &closure);
2326 tem = current_buffer->keymap;
2328 relevant_map_push (tem, &closure);
2330 #ifdef HAVE_WINDOW_SYSTEM
2333 /* It's a mouse event; order of keymaps searched is:
2334 o vertical-divider-map, if event is over a divider
2335 o local-map of mouse-grabbed-buffer
2336 o keymap of any/all extents under the mouse
2337 if the mouse is over a modeline:
2338 o modeline-map of buffer corresponding to that modeline
2339 o else, local-map of buffer under the mouse
2341 o local-map of current-buffer
2344 Lisp_Object window = Fevent_window (terminal);
2346 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
2348 if (KEYMAPP (Vvertical_divider_map))
2349 relevant_map_push (Vvertical_divider_map, &closure);
2352 if (BUFFERP (Vmouse_grabbed_buffer))
2354 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
2356 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
2358 relevant_map_push (map, &closure);
2363 Lisp_Object buffer = Fwindow_buffer (window);
2367 if (!NILP (Fevent_over_modeline_p (terminal)))
2369 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
2372 get_relevant_extent_keymaps
2373 (Fevent_modeline_position (terminal),
2374 XBUFFER (buffer)->generated_modeline_string,
2375 Fevent_glyph_extent (terminal), &closure);
2377 if (!UNBOUNDP (map) && !NILP (map))
2378 relevant_map_push (get_keymap (map, 1, 1), &closure);
2382 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
2383 Fevent_glyph_extent (terminal),
2387 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
2389 Lisp_Object map = XBUFFER (buffer)->keymap;
2391 get_relevant_minor_maps (buffer, &closure);
2393 relevant_map_push (map, &closure);
2397 else if (!NILP (Fevent_over_toolbar_p (terminal)))
2399 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
2401 if (!UNBOUNDP (map) && !NILP (map))
2402 relevant_map_push (map, &closure);
2405 #endif /* HAVE_WINDOW_SYSTEM */
2408 int nmaps = closure.nmaps;
2409 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2410 if (nmaps >= max_maps && max_maps > 0)
2411 maps[max_maps - 1] = Vcurrent_global_map;
2413 maps[nmaps] = Vcurrent_global_map;
2419 /* Returns a set of keymaps extracted from the extents at POS in
2420 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2421 to look for a keymap in, and if it has one, its keymap will be the
2422 first element in the list returned. This is so we can correctly
2423 search the keymaps associated with glyphs which may be physically
2424 disjoint from their extents: for example, if a glyph is out in the
2425 margin, we should still consult the keymap of that glyph's extent,
2426 which may not itself be under the mouse.
2430 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
2432 struct relevant_maps *closure)
2434 /* This function can GC */
2435 /* the glyph keymap, if any, comes first.
2436 (Processing it twice is no big deal: noop.) */
2439 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
2441 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2444 /* Next check the extents at the text position, if any */
2448 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2450 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
2452 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
2454 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2461 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
2463 /* This function can GC */
2466 Lisp_Object sym = XCAR (assoc);
2469 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
2470 if (!NILP (val) && !UNBOUNDP (val))
2472 Lisp_Object map = get_keymap (XCDR (assoc), 0, 1);
2481 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
2483 /* This function can GC */
2486 /* Will you ever lose badly if you make this circular! */
2487 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
2489 alist = XCDR (alist))
2491 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
2493 if (!NILP (m)) relevant_map_push (m, closure);
2498 /* #### Would map-current-keymaps be a better thing?? */
2499 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2500 Return a list of the current keymaps that will be searched for bindings.
2501 This lists keymaps such as the current local map and the minor-mode maps,
2502 but does not list the parents of those keymaps.
2503 EVENT-OR-KEYS controls which keymaps will be listed.
2504 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2505 mouse event), the keymaps for that mouse event will be listed (see
2506 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2510 /* This function can GC */
2511 struct gcpro gcpro1;
2512 Lisp_Object maps[100];
2513 Lisp_Object *gubbish = maps;
2516 GCPRO1 (event_or_keys);
2517 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
2519 if (nmaps > countof (maps))
2521 gubbish = alloca_array (Lisp_Object, nmaps);
2522 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
2525 return Flist (nmaps, gubbish);
2528 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
2529 Return the binding for command KEYS in current keymaps.
2530 KEYS is a string, a vector of events, or a vector of key-description lists
2531 as described in the documentation for the `define-key' function.
2532 The binding is probably a symbol with a function definition; see
2533 the documentation for `lookup-key' for more information.
2535 For key-presses, the order of keymaps searched is:
2536 - the `keymap' property of any extent(s) at point;
2537 - any applicable minor-mode maps;
2538 - the current local map of the current-buffer;
2539 - the current global map.
2541 For mouse-clicks, the order of keymaps searched is:
2542 - the current-local-map of the `mouse-grabbed-buffer' if any;
2543 - vertical-divider-map, if the event happened over a vertical divider
2544 - the `keymap' property of any extent(s) at the position of the click
2545 (this includes modeline extents);
2546 - the modeline-map of the buffer corresponding to the modeline under
2547 the mouse (if the click happened over a modeline);
2548 - the value of `toolbar-map' in the current-buffer (if the click
2549 happened over a toolbar);
2550 - the current local map of the buffer under the mouse (does not
2551 apply to toolbar clicks);
2552 - any applicable minor-mode maps;
2553 - the current global map.
2555 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2556 is non-nil, *only* those two maps and the current global map are searched.
2558 (keys, accept_default))
2560 /* This function can GC */
2562 Lisp_Object maps[100];
2564 struct gcpro gcpro1, gcpro2;
2565 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
2567 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
2571 if (EVENTP (keys)) /* unadvertised "feature" for the future */
2572 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
2574 for (i = 0; i < nmaps; i++)
2576 Lisp_Object tem = Flookup_key (maps[i], keys,
2580 /* Too long in some local map means don't look at global map */
2583 else if (!NILP (tem))
2590 process_event_binding_result (Lisp_Object result)
2592 if (EQ (result, Qundefined))
2593 /* The suppress-keymap function binds keys to 'undefined - special-case
2594 that here, so that being bound to that has the same error-behavior as
2595 not being defined at all.
2601 /* Snap out possible keymap indirections */
2602 map = get_keymap (result, 0, 1);
2610 /* Attempts to find a command corresponding to the event-sequence
2611 whose head is event0 (sequence is threaded though event_next).
2613 The return value will be
2615 -- nil (there is no binding; this will also be returned
2616 whenever the event chain is "too long", i.e. there
2617 is a non-nil, non-keymap binding for a prefix of
2619 -- a keymap (part of a command has been specified)
2620 -- a command (anything that satisfies `commandp'; this includes
2621 some symbols, lists, subrs, strings, vectors, and
2622 compiled-function objects) */
2624 event_binding (Lisp_Object event0, int accept_default)
2626 /* This function can GC */
2627 Lisp_Object maps[100];
2630 assert (EVENTP (event0));
2632 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
2633 if (nmaps > countof (maps))
2634 nmaps = countof (maps);
2635 return process_event_binding_result (lookup_events (event0, nmaps, maps,
2639 /* like event_binding, but specify a keymap to search */
2642 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
2644 /* This function can GC */
2645 if (!KEYMAPP (keymap))
2648 return process_event_binding_result (lookup_events (event0, 1, &keymap,
2652 /* Attempts to find a function key mapping corresponding to the
2653 event-sequence whose head is event0 (sequence is threaded through
2654 event_next). The return value will be the same as for event_binding(). */
2656 munging_key_map_event_binding (Lisp_Object event0,
2657 enum munge_me_out_the_door munge)
2659 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2660 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
2661 Vkey_translation_map;
2666 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
2670 /************************************************************************/
2671 /* Setting/querying the global and local maps */
2672 /************************************************************************/
2674 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
2675 Select KEYMAP as the global keymap.
2679 /* This function can GC */
2680 keymap = get_keymap (keymap, 1, 1);
2681 Vcurrent_global_map = keymap;
2685 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
2686 Select KEYMAP as the local keymap in BUFFER.
2687 If KEYMAP is nil, that means no local keymap.
2688 If BUFFER is nil, the current buffer is assumed.
2692 /* This function can GC */
2693 struct buffer *b = decode_buffer (buffer, 0);
2695 keymap = get_keymap (keymap, 1, 1);
2702 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2703 Return BUFFER's local keymap, or nil if it has none.
2704 If BUFFER is nil, the current buffer is assumed.
2708 struct buffer *b = decode_buffer (buffer, 0);
2712 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2713 Return the current global keymap.
2717 return Vcurrent_global_map;
2721 /************************************************************************/
2722 /* Mapping over keymap elements */
2723 /************************************************************************/
2725 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2726 prefix key, it's not entirely obvious what map-keymap should do, but
2727 what it does is: map over all keys in this map; then recursively map
2728 over all submaps of this map that are "bucky" submaps. This means that,
2729 when mapping over a keymap, it appears that "x" and "C-x" are in the
2730 same map, although "C-x" is really in the "control" submap of this one.
2731 However, since we don't recursively descend the submaps that are bound
2732 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2733 those explicitly, if that's what they want.
2735 So the end result of this is that the bucky keymaps (the ones indexed
2736 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2737 invisible from elisp. They're just an implementation detail that code
2738 outside of this file doesn't need to know about.
2741 struct map_keymap_unsorted_closure
2743 void (*fn) (const struct key_data *, Lisp_Object binding, void *arg);
2748 /* used by map_keymap() */
2750 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value,
2751 void *map_keymap_unsorted_closure)
2753 /* This function can GC */
2754 struct map_keymap_unsorted_closure *closure =
2755 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
2756 int modifiers = closure->modifiers;
2758 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
2761 int omod = modifiers;
2762 closure->modifiers = (modifiers | mod_bit);
2763 value = get_keymap (value, 1, 0);
2764 elisp_maphash (map_keymap_unsorted_mapper,
2765 XKEYMAP (value)->table,
2766 map_keymap_unsorted_closure);
2767 closure->modifiers = omod;
2771 struct key_data key;
2772 key.keysym = keysym;
2773 key.modifiers = modifiers;
2774 ((*closure->fn) (&key, value, closure->arg));
2780 struct map_keymap_sorted_closure
2782 Lisp_Object *result_locative;
2785 /* used by map_keymap_sorted() */
2787 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value,
2788 void *map_keymap_sorted_closure)
2790 struct map_keymap_sorted_closure *cl =
2791 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
2792 Lisp_Object *list = cl->result_locative;
2793 *list = Fcons (Fcons (key, value), *list);
2798 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2799 and keymap_submaps().
2802 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
2805 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2813 if (EQ (obj1, obj2))
2815 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
2816 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
2818 /* If either is a symbol with a character-set-property, then sort it by
2819 that code instead of alphabetically.
2821 if (! bit1 && SYMBOLP (obj1))
2823 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
2824 if (CHAR_OR_CHAR_INTP (code))
2827 CHECK_CHAR_COERCE_INT (obj1);
2831 if (! bit2 && SYMBOLP (obj2))
2833 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
2834 if (CHAR_OR_CHAR_INTP (code))
2837 CHECK_CHAR_COERCE_INT (obj2);
2842 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2843 if (XTYPE (obj1) != XTYPE (obj2))
2844 return SYMBOLP (obj2) ? 1 : -1;
2846 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
2848 int o1 = XCHAR (obj1);
2849 int o2 = XCHAR (obj2);
2850 if (o1 == o2 && /* If one started out as a symbol and the */
2851 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
2852 return sym2_p ? 1 : -1;
2854 return o1 < o2 ? 1 : -1; /* else just compare them */
2857 /* else they're both symbols. If they're both buckys, then order them. */
2859 return bit1 < bit2 ? 1 : -1;
2861 /* if only one is a bucky, then it comes later */
2863 return bit2 ? 1 : -1;
2865 /* otherwise, string-sort them. */
2867 char *s1 = (char *) string_data (XSYMBOL (obj1)->name);
2868 char *s2 = (char *) string_data (XSYMBOL (obj2)->name);
2870 return 0 > strcoll (s1, s2) ? 1 : -1;
2872 return 0 > strcmp (s1, s2) ? 1 : -1;
2878 /* used by map_keymap() */
2880 map_keymap_sorted (Lisp_Object keymap_table,
2882 void (*function) (const struct key_data *key,
2883 Lisp_Object binding,
2884 void *map_keymap_sorted_closure),
2885 void *map_keymap_sorted_closure)
2887 /* This function can GC */
2888 struct gcpro gcpro1;
2889 Lisp_Object contents = Qnil;
2891 if (XINT (Fhash_table_count (keymap_table)) == 0)
2897 struct map_keymap_sorted_closure c1;
2898 c1.result_locative = &contents;
2899 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
2901 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
2902 for (; !NILP (contents); contents = XCDR (contents))
2904 Lisp_Object keysym = XCAR (XCAR (contents));
2905 Lisp_Object binding = XCDR (XCAR (contents));
2906 int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
2908 map_keymap_sorted (XKEYMAP (get_keymap (binding,
2910 (modifiers | sub_bits),
2912 map_keymap_sorted_closure);
2917 k.modifiers = modifiers;
2918 ((*function) (&k, binding, map_keymap_sorted_closure));
2925 /* used by Fmap_keymap() */
2927 map_keymap_mapper (const struct key_data *key,
2928 Lisp_Object binding,
2931 /* This function can GC */
2933 VOID_TO_LISP (fn, function);
2934 call2 (fn, make_key_description (key, 1), binding);
2939 map_keymap (Lisp_Object keymap_table, int sort_first,
2940 void (*function) (const struct key_data *key,
2941 Lisp_Object binding,
2945 /* This function can GC */
2947 map_keymap_sorted (keymap_table, 0, function, fn_arg);
2950 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
2951 map_keymap_unsorted_closure.fn = function;
2952 map_keymap_unsorted_closure.arg = fn_arg;
2953 map_keymap_unsorted_closure.modifiers = 0;
2954 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
2955 &map_keymap_unsorted_closure);
2959 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
2960 Apply FUNCTION to each element of KEYMAP.
2961 FUNCTION will be called with two arguments: a key-description list, and
2962 the binding. The order in which the elements of the keymap are passed to
2963 the function is unspecified. If the function inserts new elements into
2964 the keymap, it may or may not be called with them later. No element of
2965 the keymap will ever be passed to the function more than once.
2967 The function will not be called on elements of this keymap's parents
2968 \(see the function `keymap-parents') or upon keymaps which are contained
2969 within this keymap (multi-character definitions).
2970 It will be called on "meta" characters since they are not really
2971 two-character sequences.
2973 If the optional third argument SORT-FIRST is non-nil, then the elements of
2974 the keymap will be passed to the mapper function in a canonical order.
2975 Otherwise, they will be passed in hash (that is, random) order, which is
2978 (function, keymap, sort_first))
2980 /* This function can GC */
2981 struct gcpro gcpro1, gcpro2;
2983 /* tolerate obviously transposed args */
2984 if (!NILP (Fkeymapp (function)))
2986 Lisp_Object tmp = function;
2990 GCPRO2 (function, keymap);
2991 keymap = get_keymap (keymap, 1, 1);
2992 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
2993 map_keymap_mapper, LISP_TO_VOID (function));
3000 /************************************************************************/
3001 /* Accessible keymaps */
3002 /************************************************************************/
3004 struct accessible_keymaps_closure
3011 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
3013 struct accessible_keymaps_closure *closure)
3015 /* This function can GC */
3016 int subbits = MODIFIER_HASH_KEY_BITS (keysym);
3020 Lisp_Object submaps;
3022 contents = get_keymap (contents, 1, 1);
3023 submaps = keymap_submaps (contents);
3024 for (; !NILP (submaps); submaps = XCDR (submaps))
3026 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3027 XCDR (XCAR (submaps)),
3028 (subbits | modifiers),
3034 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3035 Lisp_Object cmd = get_keyelt (contents, 1);
3039 struct key_data key;
3040 key.keysym = keysym;
3041 key.modifiers = modifiers;
3045 cmd = get_keymap (cmd, 0, 1);
3049 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3050 len = XVECTOR_LENGTH (thisseq);
3051 for (j = 0; j < len; j++)
3052 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3053 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3055 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3061 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3063 /* This function can GC */
3064 struct accessible_keymaps_closure *closure =
3065 (struct accessible_keymaps_closure *) arg;
3066 Lisp_Object submaps = keymap_submaps (thismap);
3068 for (; !NILP (submaps); submaps = XCDR (submaps))
3070 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3071 XCDR (XCAR (submaps)),
3079 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3080 Find all keymaps accessible via prefix characters from KEYMAP.
3081 Returns a list of elements of the form (KEYS . MAP), where the sequence
3082 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3083 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3084 An optional argument PREFIX, if non-nil, should be a key sequence;
3085 then the value includes only maps for prefixes that start with PREFIX.
3089 /* This function can GC */
3090 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3091 Lisp_Object accessible_keymaps = Qnil;
3092 struct accessible_keymaps_closure c;
3094 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3096 keymap = get_keymap (keymap, 1, 1);
3101 prefix = make_vector (0, Qnil);
3103 else if (VECTORP (prefix) || STRINGP (prefix))
3105 int len = XINT (Flength (prefix));
3109 struct gcpro ngcpro1;
3117 def = Flookup_key (keymap, prefix, Qnil);
3118 def = get_keymap (def, 0, 1);
3123 p = make_vector (len, Qnil);
3125 for (iii = 0; iii < len; iii++)
3127 struct key_data key;
3128 define_key_parser (Faref (prefix, make_int (iii)), &key);
3129 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3136 prefix = wrong_type_argument (Qarrayp, prefix);
3140 accessible_keymaps = list1 (Fcons (prefix, keymap));
3142 /* For each map in the list maps, look at any other maps it points
3143 to and stick them at the end if they are not already in the list */
3145 for (c.tail = accessible_keymaps;
3147 c.tail = XCDR (c.tail))
3149 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3150 CHECK_KEYMAP (thismap);
3151 traverse_keymaps (thismap, Qnil,
3152 accessible_keymaps_keymap_mapper, &c);
3156 return accessible_keymaps;
3161 /************************************************************************/
3162 /* Pretty descriptions of key sequences */
3163 /************************************************************************/
3165 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3166 Return a pretty description of key-sequence KEYS.
3167 Control characters turn into "C-foo" sequences, meta into "M-foo",
3168 spaces are put between sequence elements, etc...
3172 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3175 return Fsingle_key_description (keys);
3177 else if (VECTORP (keys) ||
3180 Lisp_Object string = Qnil;
3181 /* Lisp_Object sep = Qnil; */
3182 int size = XINT (Flength (keys));
3185 for (i = 0; i < size; i++)
3187 Lisp_Object s2 = Fsingle_key_description
3189 ? make_char (string_char (XSTRING (keys), i))
3190 : XVECTOR_DATA (keys)[i]);
3196 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */;
3197 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3202 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3205 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3206 Return a pretty description of command character KEY.
3207 Control characters turn into C-whatever, etc.
3208 This differs from `text-char-description' in that it returns a description
3209 of a key read from the user rather than a character from a buffer.
3214 key = Fcons (key, Qnil); /* sleaze sleaze */
3216 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3222 event.event_type = empty_event;
3223 CHECK_CHAR_COERCE_INT (key);
3224 character_to_event (XCHAR (key), &event,
3225 XCONSOLE (Vselected_console), 0, 1);
3226 format_event_object (buf, &event, 1);
3229 format_event_object (buf, XEVENT (key), 1);
3230 return build_string (buf);
3239 LIST_LOOP (rest, key)
3241 Lisp_Object keysym = XCAR (rest);
3242 if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2;
3243 else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2;
3244 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3245 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3246 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3247 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3248 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3249 else if (CHAR_OR_CHAR_INTP (keysym))
3251 bufp += set_charptr_emchar ((Bufbyte *) bufp,
3252 XCHAR_OR_CHAR_INT (keysym));
3257 CHECK_SYMBOL (keysym);
3258 #if 0 /* This is bogus */
3259 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3260 else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB");
3261 else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET");
3262 else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC");
3263 else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL");
3264 else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC");
3265 else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS");
3268 strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name));
3269 if (!NILP (XCDR (rest)))
3270 signal_simple_error ("Invalid key description",
3274 return build_string (buf);
3276 return Fsingle_key_description
3277 (wrong_type_argument (intern ("char-or-event-p"), key));
3280 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3281 Return a pretty description of file-character CHR.
3282 Unprintable characters turn into "^char" or \\NNN, depending on the value
3283 of the `ctl-arrow' variable.
3284 This differs from `single-key-description' in that it returns a description
3285 of a character from a buffer rather than a key read from the user.
3292 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3293 int ctl_p = !NILP (ctl_arrow);
3294 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3295 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3296 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3301 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3304 signal_simple_continuable_error
3305 ("character has no ASCII equivalent", Fcopy_event (chr, Qnil));
3309 CHECK_CHAR_COERCE_INT (chr);
3314 if (c >= printable_min)
3316 p += set_charptr_emchar (p, c);
3318 else if (c < 040 && ctl_p)
3321 *p++ = c + 64; /* 'A' - 1 */
3328 else if (c >= 0200 || c < 040)
3332 /* !!#### This syntax is not readable. It will
3333 be interpreted as a 3-digit octal number rather
3334 than a 7-digit octal number. */
3337 *p++ = '0' + ((c & 07000000) >> 18);
3338 *p++ = '0' + ((c & 0700000) >> 15);
3339 *p++ = '0' + ((c & 070000) >> 12);
3340 *p++ = '0' + ((c & 07000) >> 9);
3343 *p++ = '0' + ((c & 0700) >> 6);
3344 *p++ = '0' + ((c & 0070) >> 3);
3345 *p++ = '0' + ((c & 0007));
3349 p += set_charptr_emchar (p, c);
3353 return build_string ((char *) buf);
3357 /************************************************************************/
3358 /* where-is (mapping bindings to keys) */
3359 /************************************************************************/
3362 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3363 Lisp_Object firstonly, char *target_buffer);
3365 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3366 Return list of keys that invoke DEFINITION in KEYMAPS.
3367 KEYMAPS can be either a keymap (meaning search in that keymap and the
3368 current global keymap) or a list of keymaps (meaning search in exactly
3369 those keymaps and no others). If KEYMAPS is nil, search in the currently
3370 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3371 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3373 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3374 the first key sequence found, rather than a list of all possible key
3377 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3378 to other keymaps or slots. This makes it possible to search for an
3379 indirect definition itself.
3381 (definition, keymaps, firstonly, noindirect, event_or_keys))
3383 /* This function can GC */
3384 Lisp_Object maps[100];
3385 Lisp_Object *gubbish = maps;
3388 /* Get keymaps as an array */
3391 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3393 if (nmaps > countof (maps))
3395 gubbish = alloca_array (Lisp_Object, nmaps);
3396 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3399 else if (CONSP (keymaps))
3404 nmaps = XINT (Flength (keymaps));
3405 if (nmaps > countof (maps))
3407 gubbish = alloca_array (Lisp_Object, nmaps);
3409 for (rest = keymaps, i = 0; !NILP (rest);
3410 rest = XCDR (keymaps), i++)
3412 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3418 gubbish[0] = get_keymap (keymaps, 1, 1);
3419 if (!EQ (gubbish[0], Vcurrent_global_map))
3421 gubbish[1] = Vcurrent_global_map;
3426 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3429 /* This function is like
3430 (key-description (where-is-internal definition nil t))
3431 except that it writes its output into a (char *) buffer that you
3432 provide; it doesn't cons (or allocate memory) at all, so it's
3433 very fast. This is used by menubar.c.
3436 where_is_to_char (Lisp_Object definition, char *buffer)
3438 /* This function can GC */
3439 Lisp_Object maps[100];
3440 Lisp_Object *gubbish = maps;
3443 /* Get keymaps as an array */
3444 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3445 if (nmaps > countof (maps))
3447 gubbish = alloca_array (Lisp_Object, nmaps);
3448 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3452 where_is_internal (definition, maps, nmaps, Qt, buffer);
3457 raw_keys_to_keys (struct key_data *keys, int count)
3459 Lisp_Object result = make_vector (count, Qnil);
3461 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3467 format_raw_keys (struct key_data *keys, int count, char *buf)
3471 event.event_type = key_press_event;
3472 event.channel = Vselected_console;
3473 for (i = 0; i < count; i++)
3475 event.event.key.keysym = keys[i].keysym;
3476 event.event.key.modifiers = keys[i].modifiers;
3477 format_event_object (buf, &event, 1);
3478 buf += strlen (buf);
3480 buf[0] = ' ', buf++;
3485 /* definition is the thing to look for.
3487 shadow is an array of shadow_count keymaps; if there is a different
3488 binding in any of the keymaps of a key that we are considering
3489 returning, then we reconsider.
3490 firstonly means give up after finding the first match;
3491 keys_so_far and modifiers_so_far describe which map we're looking in;
3492 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3493 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3494 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we
3495 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3498 (keys_so_far is a global buffer and the keys_count arg says how much
3499 of it we're currently interested in.)
3501 If target_buffer is provided, then we write a key-description into it,
3502 to avoid consing a string. This only works with firstonly on.
3505 struct where_is_closure
3507 Lisp_Object definition;
3508 Lisp_Object *shadow;
3512 int modifiers_so_far;
3513 char *target_buffer;
3514 struct key_data *keys_so_far;
3515 int keys_so_far_total_size;
3516 int keys_so_far_malloced;
3519 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3522 where_is_recursive_mapper (Lisp_Object map, void *arg)
3524 /* This function can GC */
3525 struct where_is_closure *c = (struct where_is_closure *) arg;
3526 Lisp_Object definition = c->definition;
3527 const int firstonly = c->firstonly;
3528 const int keys_count = c->keys_count;
3529 const int modifiers_so_far = c->modifiers_so_far;
3530 char *target_buffer = c->target_buffer;
3531 Lisp_Object keys = Fgethash (definition,
3532 XKEYMAP (map)->inverse_table,
3534 Lisp_Object submaps;
3535 Lisp_Object result = Qnil;
3539 /* One or more keys in this map match the definition we're looking for.
3540 Verify that these bindings aren't shadowed by other bindings
3541 in the shadow maps. Either nil or number as value from
3542 raw_lookup_key() means undefined. */
3543 struct key_data *so_far = c->keys_so_far;
3545 for (;;) /* loop over all keys that match */
3547 Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys;
3550 so_far [keys_count].keysym = k;
3551 so_far [keys_count].modifiers = modifiers_so_far;
3553 /* now loop over all shadow maps */
3554 for (i = 0; i < c->shadow_count; i++)
3556 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3561 if (NILP (shadowed) || CHARP (shadowed) ||
3562 EQ (shadowed, definition))
3563 continue; /* we passed this test; it's not shadowed here. */
3565 /* ignore this key binding, since it actually has a
3566 different binding in a shadowing map */
3567 goto c_doesnt_have_proper_loop_exit_statements;
3570 /* OK, the key is for real */
3573 if (!firstonly) abort ();
3574 format_raw_keys (so_far, keys_count + 1, target_buffer);
3575 return make_int (1);
3578 return raw_keys_to_keys (so_far, keys_count + 1);
3580 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3583 c_doesnt_have_proper_loop_exit_statements:
3584 /* now on to the next matching key ... */
3585 if (!CONSP (keys)) break;
3590 /* Now search the sub-keymaps of this map.
3591 If we're in "firstonly" mode and have already found one, this
3592 point is not reached. If we get one from lower down, either
3593 return it immediately (in firstonly mode) or tack it onto the
3594 end of the ones we've gotten so far.
3596 for (submaps = keymap_submaps (map);
3598 submaps = XCDR (submaps))
3600 Lisp_Object key = XCAR (XCAR (submaps));
3601 Lisp_Object submap = XCDR (XCAR (submaps));
3602 int lower_modifiers;
3603 int lower_keys_count = keys_count;
3606 submap = get_keymap (submap, 0, 0);
3608 if (EQ (submap, map))
3609 /* Arrgh! Some loser has introduced a loop... */
3612 /* If this is not a keymap, then that's probably because someone
3613 did an `fset' of a symbol that used to point to a map such that
3614 it no longer does. Sigh. Ignore this, and invalidate the cache
3615 so that it doesn't happen to us next time too.
3619 XKEYMAP (map)->sub_maps_cache = Qt;
3623 /* If the map is a "bucky" map, then add a bit to the
3624 modifiers_so_far list.
3625 Otherwise, add a new raw_key onto the end of keys_so_far.
3627 bucky = MODIFIER_HASH_KEY_BITS (key);
3629 lower_modifiers = (modifiers_so_far | bucky);
3632 struct key_data *so_far = c->keys_so_far;
3633 lower_modifiers = 0;
3634 so_far [lower_keys_count].keysym = key;
3635 so_far [lower_keys_count].modifiers = modifiers_so_far;
3639 if (lower_keys_count >= c->keys_so_far_total_size)
3641 int size = lower_keys_count + 50;
3642 if (! c->keys_so_far_malloced)
3644 struct key_data *new = xnew_array (struct key_data, size);
3645 memcpy ((void *)new, (const void *)c->keys_so_far,
3646 c->keys_so_far_total_size * sizeof (struct key_data));
3649 XREALLOC_ARRAY (c->keys_so_far, struct key_data, size);
3651 c->keys_so_far_total_size = size;
3652 c->keys_so_far_malloced = 1;
3658 c->keys_count = lower_keys_count;
3659 c->modifiers_so_far = lower_modifiers;
3661 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3663 c->keys_count = keys_count;
3664 c->modifiers_so_far = modifiers_so_far;
3667 result = nconc2 (lower, result);
3668 else if (!NILP (lower))
3677 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3678 Lisp_Object firstonly, char *target_buffer)
3680 /* This function can GC */
3681 Lisp_Object result = Qnil;
3683 struct key_data raw[20];
3684 struct where_is_closure c;
3686 c.definition = definition;
3688 c.firstonly = !NILP (firstonly);
3689 c.target_buffer = target_buffer;
3690 c.keys_so_far = raw;
3691 c.keys_so_far_total_size = countof (raw);
3692 c.keys_so_far_malloced = 0;
3694 /* Loop over each of the maps, accumulating the keys found.
3695 For each map searched, all previous maps shadow this one
3696 so that bogus keys aren't listed. */
3697 for (i = 0; i < nmaps; i++)
3699 Lisp_Object this_result;
3701 /* Reset the things set in each iteration */
3703 c.modifiers_so_far = 0;
3705 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3707 if (!NILP (firstonly))
3709 result = this_result;
3714 result = nconc2 (this_result, result);
3717 if (NILP (firstonly))
3718 result = Fnreverse (result);
3720 if (c.keys_so_far_malloced)
3721 xfree (c.keys_so_far);
3726 /************************************************************************/
3727 /* Describing keymaps */
3728 /************************************************************************/
3730 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3731 Insert a list of all defined keys and their definitions in MAP.
3732 Optional second argument ALL says whether to include even "uninteresting"
3733 definitions (ie symbols with a non-nil `suppress-keymap' property.
3734 Third argument SHADOW is a list of keymaps whose bindings shadow those
3735 of map; if a binding is present in any shadowing map, it is not printed.
3736 Fourth argument PREFIX, if non-nil, should be a key sequence;
3737 only bindings which start with that key sequence will be printed.
3738 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3740 (map, all, shadow, prefix, mouse_only_p))
3742 /* This function can GC */
3744 /* #### At some point, this function should be changed to accept a
3745 BUFFER argument. Currently, the BUFFER argument to
3746 describe_map_tree is being used only internally. */
3747 describe_map_tree (map, NILP (all), shadow, prefix,
3748 !NILP (mouse_only_p), Fcurrent_buffer ());
3753 /* Insert a description of the key bindings in STARTMAP,
3754 followed by those of all maps reachable through STARTMAP.
3755 If PARTIAL is nonzero, omit certain "uninteresting" commands
3756 (such as `undefined').
3757 If SHADOW is non-nil, it is a list of other maps;
3758 don't mention keys which would be shadowed by any of them
3759 If PREFIX is non-nil, only list bindings which start with those keys.
3763 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3764 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3766 /* This function can GC */
3767 Lisp_Object maps = Qnil;
3768 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3769 GCPRO2 (maps, shadow);
3771 maps = Faccessible_keymaps (startmap, prefix);
3773 for (; !NILP (maps); maps = Fcdr (maps))
3775 Lisp_Object sub_shadow = Qnil;
3776 Lisp_Object elt = Fcar (maps);
3778 int no_prefix = (VECTORP (Fcar (elt))
3779 && XINT (Flength (Fcar (elt))) == 0);
3780 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3781 NGCPRO3 (sub_shadow, elt, tail);
3783 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3785 Lisp_Object shmap = XCAR (tail);
3787 /* If the sequence by which we reach this keymap is zero-length,
3788 then the shadow maps for this keymap are just SHADOW. */
3791 /* If the sequence by which we reach this keymap actually has
3792 some elements, then the sequence's definition in SHADOW is
3793 what we should use. */
3796 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3803 Lisp_Object shm = get_keymap (shmap, 0, 1);
3804 /* If shmap is not nil and not a keymap, it completely
3805 shadows this map, so don't describe this map at all. */
3808 sub_shadow = Fcons (shm, sub_shadow);
3813 /* Describe the contents of map MAP, assuming that this map
3814 itself is reached by the sequence of prefix keys KEYS (a vector).
3815 PARTIAL and SHADOW are as in `describe_map_tree'. */
3816 Lisp_Object keysdesc
3818 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3820 describe_map (Fcdr (elt), keysdesc,
3835 describe_command (Lisp_Object definition, Lisp_Object buffer)
3837 /* This function can GC */
3838 int keymapp = !NILP (Fkeymapp (definition));
3839 struct gcpro gcpro1;
3840 GCPRO1 (definition);
3842 Findent_to (make_int (16), make_int (3), buffer);
3844 buffer_insert_c_string (XBUFFER (buffer), "<< ");
3846 if (SYMBOLP (definition))
3848 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3850 else if (STRINGP (definition) || VECTORP (definition))
3852 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: ");
3853 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3855 else if (COMPILED_FUNCTIONP (definition))
3856 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function");
3857 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
3858 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda");
3859 else if (KEYMAPP (definition))
3861 Lisp_Object name = XKEYMAP (definition)->name;
3862 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3864 buffer_insert_c_string (XBUFFER (buffer), "Prefix command ");
3866 && EQ (find_symbol_value (name), definition))
3867 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3870 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3874 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command");
3877 buffer_insert_c_string (XBUFFER (buffer), "??");
3880 buffer_insert_c_string (XBUFFER (buffer), " >>");
3881 buffer_insert_c_string (XBUFFER (buffer), "\n");
3885 struct describe_map_closure
3887 Lisp_Object *list; /* pointer to the list to update */
3888 Lisp_Object partial; /* whether to ignore suppressed commands */
3889 Lisp_Object shadow; /* list of maps shadowing this one */
3890 Lisp_Object self; /* this map */
3891 Lisp_Object self_root; /* this map, or some map that has this map as
3892 a parent. this is the base of the tree */
3893 int mice_only_p; /* whether we are to display only button bindings */
3896 struct describe_map_shadow_closure
3898 const struct key_data *raw_key;
3903 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3905 struct describe_map_shadow_closure *c =
3906 (struct describe_map_shadow_closure *) arg;
3908 if (EQ (map, c->self))
3909 return Qzero; /* Not shadowed; terminate search */
3911 return !NILP (keymap_lookup_directly (map,
3913 c->raw_key->modifiers))
3919 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3921 struct key_data *k = (struct key_data *) arg;
3922 return keymap_lookup_directly (km, k->keysym, k->modifiers);
3927 describe_map_mapper (const struct key_data *key,
3928 Lisp_Object binding,
3929 void *describe_map_closure)
3931 /* This function can GC */
3932 struct describe_map_closure *closure =
3933 (struct describe_map_closure *) describe_map_closure;
3934 Lisp_Object keysym = key->keysym;
3935 int modifiers = key->modifiers;
3937 /* Don't mention suppressed commands. */
3938 if (SYMBOLP (binding)
3939 && !NILP (closure->partial)
3940 && !NILP (Fget (binding, closure->partial, Qnil)))
3943 /* If we're only supposed to display mouse bindings and this isn't one,
3945 if (closure->mice_only_p &&
3946 (! (EQ (keysym, Qbutton0) ||
3947 EQ (keysym, Qbutton1) ||
3948 EQ (keysym, Qbutton2) ||
3949 EQ (keysym, Qbutton3) ||
3950 EQ (keysym, Qbutton4) ||
3951 EQ (keysym, Qbutton5) ||
3952 EQ (keysym, Qbutton6) ||
3953 EQ (keysym, Qbutton7) ||
3954 EQ (keysym, Qbutton0up) ||
3955 EQ (keysym, Qbutton1up) ||
3956 EQ (keysym, Qbutton2up) ||
3957 EQ (keysym, Qbutton3up) ||
3958 EQ (keysym, Qbutton4up) ||
3959 EQ (keysym, Qbutton5up) ||
3960 EQ (keysym, Qbutton6up) ||
3961 EQ (keysym, Qbutton7up))))
3964 /* If this command in this map is shadowed by some other map, ignore it. */
3968 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3971 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3972 keymap_lookup_inherited_mapper,
3973 /* Cast to discard `const' */
3979 /* If this key is in some map of which this map is a parent, then ignore
3980 it (in that case, it has been shadowed).
3984 struct describe_map_shadow_closure c;
3986 c.self = closure->self;
3988 sh = traverse_keymaps (closure->self_root, Qnil,
3989 describe_map_mapper_shadow_search, &c);
3990 if (!NILP (sh) && !ZEROP (sh))
3994 /* Otherwise add it to the list to be sorted. */
3995 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
4002 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
4005 /* obj1 and obj2 are conses of the form
4006 ( ( <keysym> . <modifiers> ) . <binding> )
4007 keysym and modifiers are used, binding is ignored.
4012 bit1 = XINT (XCDR (obj1));
4013 bit2 = XINT (XCDR (obj2));
4015 return bit1 < bit2 ? 1 : -1;
4017 return map_keymap_sort_predicate (obj1, obj2, pred);
4020 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4021 or 2 or more symbolic keysyms that are bound to the same thing and
4022 have consecutive character-set-properties.
4025 elide_next_two_p (Lisp_Object list)
4029 if (NILP (XCDR (list)))
4032 /* next two bindings differ */
4033 if (!EQ (XCDR (XCAR (list)),
4034 XCDR (XCAR (XCDR (list)))))
4037 /* next two modifier-sets differ */
4038 if (!EQ (XCDR (XCAR (XCAR (list))),
4039 XCDR (XCAR (XCAR (XCDR (list))))))
4042 s1 = XCAR (XCAR (XCAR (list)));
4043 s2 = XCAR (XCAR (XCAR (XCDR (list))));
4047 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
4048 if (CHAR_OR_CHAR_INTP (code))
4051 CHECK_CHAR_COERCE_INT (s1);
4057 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
4058 if (CHAR_OR_CHAR_INTP (code))
4061 CHECK_CHAR_COERCE_INT (s2);
4066 return (XCHAR (s1) == XCHAR (s2) ||
4067 XCHAR (s1) + 1 == XCHAR (s2));
4072 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
4074 /* This function can GC */
4075 struct describe_map_closure *describe_map_closure =
4076 (struct describe_map_closure *) arg;
4077 describe_map_closure->self = keymap;
4078 map_keymap (XKEYMAP (keymap)->table,
4079 0, /* don't sort: we'll do it later */
4080 describe_map_mapper, describe_map_closure);
4085 /* Describe the contents of map MAP, assuming that this map itself is
4086 reached by the sequence of prefix keys KEYS (a string or vector).
4087 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4090 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
4091 void (*elt_describer) (Lisp_Object, Lisp_Object),
4097 /* This function can GC */
4098 struct describe_map_closure describe_map_closure;
4099 Lisp_Object list = Qnil;
4100 struct buffer *buf = XBUFFER (buffer);
4101 Emchar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
4102 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
4103 : ((EQ (buf->ctl_arrow, Qt)
4104 || EQ (buf->ctl_arrow, Qnil))
4107 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4109 keymap = get_keymap (keymap, 1, 1);
4110 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4111 describe_map_closure.shadow = shadow;
4112 describe_map_closure.list = &list;
4113 describe_map_closure.self_root = keymap;
4114 describe_map_closure.mice_only_p = mice_only_p;
4116 GCPRO4 (keymap, elt_prefix, shadow, list);
4118 traverse_keymaps (keymap, Qnil,
4119 describe_map_parent_mapper, &describe_map_closure);
4123 list = list_sort (list, Qnil, describe_map_sort_predicate);
4124 buffer_insert_c_string (buf, "\n");
4125 while (!NILP (list))
4127 Lisp_Object elt = XCAR (XCAR (list));
4128 Lisp_Object keysym = XCAR (elt);
4129 int modifiers = XINT (XCDR (elt));
4131 if (!NILP (elt_prefix))
4132 buffer_insert_lisp_string (buf, elt_prefix);
4134 if (modifiers & XEMACS_MOD_META)
4135 buffer_insert_c_string (buf, "M-");
4136 if (modifiers & XEMACS_MOD_CONTROL)
4137 buffer_insert_c_string (buf, "C-");
4138 if (modifiers & XEMACS_MOD_SUPER)
4139 buffer_insert_c_string (buf, "S-");
4140 if (modifiers & XEMACS_MOD_HYPER)
4141 buffer_insert_c_string (buf, "H-");
4142 if (modifiers & XEMACS_MOD_ALT)
4143 buffer_insert_c_string (buf, "Alt-");
4144 if (modifiers & XEMACS_MOD_SHIFT)
4145 buffer_insert_c_string (buf, "Sh-");
4146 if (SYMBOLP (keysym))
4148 Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil);
4149 Emchar c = (CHAR_OR_CHAR_INTP (code)
4150 ? XCHAR_OR_CHAR_INT (code) : (Emchar) -1);
4151 /* Calling Fsingle_key_description() would cons more */
4152 #if 0 /* This is bogus */
4153 if (EQ (keysym, QKlinefeed))
4154 buffer_insert_c_string (buf, "LFD");
4155 else if (EQ (keysym, QKtab))
4156 buffer_insert_c_string (buf, "TAB");
4157 else if (EQ (keysym, QKreturn))
4158 buffer_insert_c_string (buf, "RET");
4159 else if (EQ (keysym, QKescape))
4160 buffer_insert_c_string (buf, "ESC");
4161 else if (EQ (keysym, QKdelete))
4162 buffer_insert_c_string (buf, "DEL");
4163 else if (EQ (keysym, QKspace))
4164 buffer_insert_c_string (buf, "SPC");
4165 else if (EQ (keysym, QKbackspace))
4166 buffer_insert_c_string (buf, "BS");
4169 if (c >= printable_min)
4170 buffer_insert_emacs_char (buf, c);
4171 else buffer_insert1 (buf, Fsymbol_name (keysym));
4173 else if (CHARP (keysym))
4174 buffer_insert_emacs_char (buf, XCHAR (keysym));
4176 buffer_insert_c_string (buf, "---bad keysym---");
4184 while (elide_next_two_p (list))
4192 buffer_insert_c_string (buf, ", ");
4194 buffer_insert_c_string (buf, " .. ");
4200 /* Print a description of the definition of this character. */
4201 (*elt_describer) (XCDR (XCAR (list)), buffer);
4210 syms_of_keymap (void)
4212 INIT_LRECORD_IMPLEMENTATION (keymap);
4214 defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist");
4216 defsymbol (&Qkeymapp, "keymapp");
4218 defsymbol (&Qsuppress_keymap, "suppress-keymap");
4220 defsymbol (&Qmodeline_map, "modeline-map");
4221 defsymbol (&Qtoolbar_map, "toolbar-map");
4223 DEFSUBR (Fkeymap_parents);
4224 DEFSUBR (Fset_keymap_parents);
4225 DEFSUBR (Fkeymap_name);
4226 DEFSUBR (Fset_keymap_name);
4227 DEFSUBR (Fkeymap_prompt);
4228 DEFSUBR (Fset_keymap_prompt);
4229 DEFSUBR (Fkeymap_default_binding);
4230 DEFSUBR (Fset_keymap_default_binding);
4233 DEFSUBR (Fmake_keymap);
4234 DEFSUBR (Fmake_sparse_keymap);
4236 DEFSUBR (Fcopy_keymap);
4237 DEFSUBR (Fkeymap_fullness);
4238 DEFSUBR (Fmap_keymap);
4239 DEFSUBR (Fevent_matches_key_specifier_p);
4240 DEFSUBR (Fdefine_key);
4241 DEFSUBR (Flookup_key);
4242 DEFSUBR (Fkey_binding);
4243 DEFSUBR (Fuse_global_map);
4244 DEFSUBR (Fuse_local_map);
4245 DEFSUBR (Fcurrent_local_map);
4246 DEFSUBR (Fcurrent_global_map);
4247 DEFSUBR (Fcurrent_keymaps);
4248 DEFSUBR (Faccessible_keymaps);
4249 DEFSUBR (Fkey_description);
4250 DEFSUBR (Fsingle_key_description);
4251 DEFSUBR (Fwhere_is_internal);
4252 DEFSUBR (Fdescribe_bindings_internal);
4254 DEFSUBR (Ftext_char_description);
4256 defsymbol (&Qcontrol, "control");
4257 defsymbol (&Qctrl, "ctrl");
4258 defsymbol (&Qmeta, "meta");
4259 defsymbol (&Qsuper, "super");
4260 defsymbol (&Qhyper, "hyper");
4261 defsymbol (&Qalt, "alt");
4262 defsymbol (&Qshift, "shift");
4263 defsymbol (&Qbutton0, "button0");
4264 defsymbol (&Qbutton1, "button1");
4265 defsymbol (&Qbutton2, "button2");
4266 defsymbol (&Qbutton3, "button3");
4267 defsymbol (&Qbutton4, "button4");
4268 defsymbol (&Qbutton5, "button5");
4269 defsymbol (&Qbutton6, "button6");
4270 defsymbol (&Qbutton7, "button7");
4271 defsymbol (&Qbutton0up, "button0up");
4272 defsymbol (&Qbutton1up, "button1up");
4273 defsymbol (&Qbutton2up, "button2up");
4274 defsymbol (&Qbutton3up, "button3up");
4275 defsymbol (&Qbutton4up, "button4up");
4276 defsymbol (&Qbutton5up, "button5up");
4277 defsymbol (&Qbutton6up, "button6up");
4278 defsymbol (&Qbutton7up, "button7up");
4279 defsymbol (&Qmouse_1, "mouse-1");
4280 defsymbol (&Qmouse_2, "mouse-2");
4281 defsymbol (&Qmouse_3, "mouse-3");
4282 defsymbol (&Qmouse_4, "mouse-4");
4283 defsymbol (&Qmouse_5, "mouse-5");
4284 defsymbol (&Qdown_mouse_1, "down-mouse-1");
4285 defsymbol (&Qdown_mouse_2, "down-mouse-2");
4286 defsymbol (&Qdown_mouse_3, "down-mouse-3");
4287 defsymbol (&Qdown_mouse_4, "down-mouse-4");
4288 defsymbol (&Qdown_mouse_5, "down-mouse-5");
4289 defsymbol (&Qmenu_selection, "menu-selection");
4290 defsymbol (&QLFD, "LFD");
4291 defsymbol (&QTAB, "TAB");
4292 defsymbol (&QRET, "RET");
4293 defsymbol (&QESC, "ESC");
4294 defsymbol (&QDEL, "DEL");
4295 defsymbol (&QSPC, "SPC");
4296 defsymbol (&QBS, "BS");
4300 vars_of_keymap (void)
4302 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
4303 Meta-prefix character.
4304 This character followed by some character `foo' turns into `Meta-foo'.
4305 This can be any form recognized as a single key specifier.
4306 To disable the meta-prefix-char, set it to a negative number.
4308 Vmeta_prefix_char = make_char (033);
4310 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4311 A buffer which should be consulted first for all mouse activity.
4312 When a mouse-click is processed, it will first be looked up in the
4313 local-map of this buffer, and then through the normal mechanism if there
4314 is no binding for that click. This buffer's value of `mode-motion-hook'
4315 will be consulted instead of the `mode-motion-hook' of the buffer of the
4316 window under the mouse. You should *bind* this, not set it.
4318 Vmouse_grabbed_buffer = Qnil;
4320 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
4321 Keymap that overrides all other local keymaps.
4322 If this variable is non-nil, it is used as a keymap instead of the
4323 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4324 You should *bind* this, not set it.
4326 Voverriding_local_map = Qnil;
4328 Fset (Qminor_mode_map_alist, Qnil);
4330 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
4331 Keymap of key translations that can override keymaps.
4332 This keymap works like `function-key-map', but comes after that,
4333 and applies even for keys that have ordinary bindings.
4335 Vkey_translation_map = Qnil;
4337 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
4338 Keymap which handles mouse clicks over vertical dividers.
4340 Vvertical_divider_map = Qnil;
4342 DEFVAR_INT ("keymap-tick", &keymap_tick /*
4343 Incremented for each change to any keymap.
4347 staticpro (&Vcurrent_global_map);
4349 Vsingle_space_string = make_string ((const Bufbyte *) " ", 1);
4350 staticpro (&Vsingle_space_string);
4354 complex_vars_of_keymap (void)
4356 /* This function can GC */
4357 Lisp_Object ESC_prefix = intern ("ESC-prefix");
4358 Lisp_Object meta_disgustitute;
4360 Vcurrent_global_map = Fmake_keymap (Qnil);
4362 meta_disgustitute = Fmake_keymap (Qnil);
4363 Ffset (ESC_prefix, meta_disgustitute);
4364 /* no need to protect meta_disgustitute, though */
4365 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
4366 XKEYMAP (Vcurrent_global_map),
4368 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
4370 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));