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 if ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER
467 | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) != 0)
470 k = XKEYMAP (keymap);
472 /* If the keysym is a one-character symbol, use the char code instead. */
473 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
475 Lisp_Object i_fart_on_gcc =
476 make_char (string_char (XSYMBOL (keysym)->name, 0));
477 keysym = i_fart_on_gcc;
480 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
482 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
486 k = XKEYMAP (submap);
487 modifiers &= ~XEMACS_MOD_META;
492 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
496 k = XKEYMAP (submap);
498 return Fgethash (keysym, k->table, Qnil);
502 keymap_store_inverse_internal (Lisp_Object inverse_table,
506 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
511 /* Don't cons this unless necessary */
512 /* keys = Fcons (keysym, Qnil); */
513 Fputhash (value, keys, inverse_table);
515 else if (!CONSP (keys))
517 /* Now it's necessary to cons */
518 keys = Fcons (keys, keysym);
519 Fputhash (value, keys, inverse_table);
523 while (CONSP (XCDR (keys)))
525 XCDR (keys) = Fcons (XCDR (keys), keysym);
526 /* No need to call puthash because we've destructively
527 modified the list tail in place */
533 keymap_delete_inverse_internal (Lisp_Object inverse_table,
537 Lisp_Object keys = Fgethash (value, inverse_table, Qunbound);
538 Lisp_Object new_keys = keys;
545 for (prev = &new_keys, tail = new_keys;
547 prev = &(XCDR (tail)), tail = XCDR (tail))
549 if (EQ (tail, keysym))
554 else if (EQ (keysym, XCAR (tail)))
562 Fremhash (value, inverse_table);
563 else if (!EQ (keys, new_keys))
564 /* Removed the first elt */
565 Fputhash (value, new_keys, inverse_table);
566 /* else the list's tail has been modified, so we don't need to
567 touch the hash table again (the pointer in there is ok).
571 /* Prevent luser from shooting herself in the foot using something like
572 (define-key ctl-x-4-map "p" global-map) */
574 check_keymap_definition_loop (Lisp_Object def, Lisp_Keymap *to_keymap)
576 def = get_keymap (def, 0, 0);
582 if (XKEYMAP (def) == to_keymap)
583 signal_simple_error ("Cyclic keymap definition", def);
585 for (maps = keymap_submaps (def);
588 check_keymap_definition_loop (XCDR (XCAR (maps)), to_keymap);
593 keymap_store_internal (Lisp_Object keysym, Lisp_Keymap *keymap,
596 Lisp_Object prev_def = Fgethash (keysym, keymap->table, Qnil);
598 if (EQ (prev_def, def))
601 check_keymap_definition_loop (def, keymap);
603 if (!NILP (prev_def))
604 keymap_delete_inverse_internal (keymap->inverse_table,
608 Fremhash (keysym, keymap->table);
612 Fputhash (keysym, def, keymap->table);
613 keymap_store_inverse_internal (keymap->inverse_table,
621 create_bucky_submap (Lisp_Keymap *k, int modifiers,
622 Lisp_Object parent_for_debugging_info)
624 Lisp_Object submap = Fmake_sparse_keymap (Qnil);
625 /* User won't see this, but it is nice for debugging Emacs */
626 XKEYMAP (submap)->name
627 = control_meta_superify (parent_for_debugging_info, modifiers);
628 /* Invalidate cache */
629 k->sub_maps_cache = Qt;
630 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (modifiers), k, submap);
635 /* Relies on caller to gc-protect keymap, keysym, value */
637 keymap_store (Lisp_Object keymap, const struct key_data *key,
640 Lisp_Object keysym = key->keysym;
641 int modifiers = key->modifiers;
642 Lisp_Keymap *k = XKEYMAP (keymap);
644 assert ((modifiers & ~(XEMACS_MOD_CONTROL | XEMACS_MOD_META
645 | XEMACS_MOD_SUPER | XEMACS_MOD_HYPER
646 | XEMACS_MOD_ALT | XEMACS_MOD_SHIFT)) == 0);
648 /* If the keysym is a one-character symbol, use the char code instead. */
649 if (SYMBOLP (keysym) && string_char_length (XSYMBOL (keysym)->name) == 1)
650 keysym = make_char (string_char (XSYMBOL (keysym)->name, 0));
652 if (modifiers & XEMACS_MOD_META) /* Utterly hateful ESC lossage */
654 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
657 submap = create_bucky_submap (k, XEMACS_MOD_META, keymap);
658 k = XKEYMAP (submap);
659 modifiers &= ~XEMACS_MOD_META;
664 Lisp_Object submap = Fgethash (MAKE_MODIFIER_HASH_KEY (modifiers),
667 submap = create_bucky_submap (k, modifiers, keymap);
668 k = XKEYMAP (submap);
670 k->sub_maps_cache = Qt; /* Invalidate cache */
671 keymap_store_internal (keysym, k, value);
675 /************************************************************************/
676 /* Listing the submaps of a keymap */
677 /************************************************************************/
679 struct keymap_submaps_closure
681 Lisp_Object *result_locative;
685 keymap_submaps_mapper_0 (Lisp_Object key, Lisp_Object value,
686 void *keymap_submaps_closure)
688 /* This function can GC */
689 /* Perform any autoloads, etc */
695 keymap_submaps_mapper (Lisp_Object key, Lisp_Object value,
696 void *keymap_submaps_closure)
698 /* This function can GC */
699 Lisp_Object *result_locative;
700 struct keymap_submaps_closure *cl =
701 (struct keymap_submaps_closure *) keymap_submaps_closure;
702 result_locative = cl->result_locative;
704 if (!NILP (Fkeymapp (value)))
705 *result_locative = Fcons (Fcons (key, value), *result_locative);
709 static int map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
713 keymap_submaps (Lisp_Object keymap)
715 /* This function can GC */
716 Lisp_Keymap *k = XKEYMAP (keymap);
718 if (EQ (k->sub_maps_cache, Qt)) /* Unknown */
720 Lisp_Object result = Qnil;
721 struct gcpro gcpro1, gcpro2;
722 struct keymap_submaps_closure keymap_submaps_closure;
724 GCPRO2 (keymap, result);
725 keymap_submaps_closure.result_locative = &result;
726 /* Do this first pass to touch (and load) any autoloaded maps */
727 elisp_maphash (keymap_submaps_mapper_0, k->table,
728 &keymap_submaps_closure);
730 elisp_maphash (keymap_submaps_mapper, k->table,
731 &keymap_submaps_closure);
732 /* keep it sorted so that the result of accessible-keymaps is ordered */
733 k->sub_maps_cache = list_sort (result,
735 map_keymap_sort_predicate);
738 return k->sub_maps_cache;
742 /************************************************************************/
743 /* Basic operations on keymaps */
744 /************************************************************************/
747 make_keymap (size_t size)
750 Lisp_Keymap *keymap = alloc_lcrecord_type (Lisp_Keymap, &lrecord_keymap);
752 XSETKEYMAP (result, keymap);
754 keymap->parents = Qnil;
755 keymap->prompt = Qnil;
756 keymap->table = Qnil;
757 keymap->inverse_table = Qnil;
758 keymap->default_binding = Qnil;
759 keymap->sub_maps_cache = Qnil; /* No possible submaps */
762 if (size != 0) /* hack for copy-keymap */
765 make_lisp_hash_table (size, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
766 /* Inverse table is often less dense because of duplicate key-bindings.
767 If not, it will grow anyway. */
768 keymap->inverse_table =
769 make_lisp_hash_table (size * 3 / 4, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
774 DEFUN ("make-keymap", Fmake_keymap, 0, 1, 0, /*
775 Construct and return a new keymap object.
776 All entries in it are nil, meaning "command undefined".
778 Optional argument NAME specifies a name to assign to the keymap,
779 as in `set-keymap-name'. This name is only a debugging convenience;
780 it is not used except when printing the keymap.
784 Lisp_Object keymap = make_keymap (60);
786 Fset_keymap_name (keymap, name);
790 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, 0, 1, 0, /*
791 Construct and return a new keymap object.
792 All entries in it are nil, meaning "command undefined". The only
793 difference between this function and make-keymap is that this function
794 returns a "smaller" keymap (one that is expected to contain fewer
795 entries). As keymaps dynamically resize, the distinction is not great.
797 Optional argument NAME specifies a name to assign to the keymap,
798 as in `set-keymap-name'. This name is only a debugging convenience;
799 it is not used except when printing the keymap.
803 Lisp_Object keymap = make_keymap (8);
805 Fset_keymap_name (keymap, name);
809 DEFUN ("keymap-parents", Fkeymap_parents, 1, 1, 0, /*
810 Return the `parent' keymaps of KEYMAP, or nil.
811 The parents of a keymap are searched for keybindings when a key sequence
812 isn't bound in this one. `(current-global-map)' is the default parent
817 keymap = get_keymap (keymap, 1, 1);
818 return Fcopy_sequence (XKEYMAP (keymap)->parents);
824 traverse_keymaps_noop (Lisp_Object keymap, void *arg)
829 DEFUN ("set-keymap-parents", Fset_keymap_parents, 2, 2, 0, /*
830 Set the `parent' keymaps of KEYMAP to PARENTS.
831 The parents of a keymap are searched for keybindings when a key sequence
832 isn't bound in this one. `(current-global-map)' is the default parent
837 /* This function can GC */
839 struct gcpro gcpro1, gcpro2;
841 GCPRO2 (keymap, parents);
842 keymap = get_keymap (keymap, 1, 1);
844 if (KEYMAPP (parents)) /* backwards-compatibility */
845 parents = list1 (parents);
848 Lisp_Object tail = parents;
854 /* Require that it be an actual keymap object, rather than a symbol
855 with a (crockish) symbol-function which is a keymap */
856 CHECK_KEYMAP (k); /* get_keymap (k, 1, 1); */
861 /* Check for circularities */
862 traverse_keymaps (keymap, parents, traverse_keymaps_noop, 0);
864 XKEYMAP (keymap)->parents = Fcopy_sequence (parents);
869 DEFUN ("set-keymap-name", Fset_keymap_name, 2, 2, 0, /*
870 Set the `name' of the KEYMAP to NEW-NAME.
871 The name is only a debugging convenience; it is not used except
872 when printing the keymap.
876 keymap = get_keymap (keymap, 1, 1);
878 XKEYMAP (keymap)->name = new_name;
882 DEFUN ("keymap-name", Fkeymap_name, 1, 1, 0, /*
883 Return the `name' of KEYMAP.
884 The name is only a debugging convenience; it is not used except
885 when printing the keymap.
889 keymap = get_keymap (keymap, 1, 1);
891 return XKEYMAP (keymap)->name;
894 DEFUN ("set-keymap-prompt", Fset_keymap_prompt, 2, 2, 0, /*
895 Set the `prompt' of KEYMAP to string NEW-PROMPT, or `nil'
896 if no prompt is desired. The prompt is shown in the echo-area
897 when reading a key-sequence to be looked-up in this keymap.
899 (keymap, new_prompt))
901 keymap = get_keymap (keymap, 1, 1);
903 if (!NILP (new_prompt))
904 CHECK_STRING (new_prompt);
906 XKEYMAP (keymap)->prompt = new_prompt;
911 keymap_prompt_mapper (Lisp_Object keymap, void *arg)
913 return XKEYMAP (keymap)->prompt;
917 DEFUN ("keymap-prompt", Fkeymap_prompt, 1, 2, 0, /*
918 Return the `prompt' of KEYMAP.
919 If non-nil, the prompt is shown in the echo-area
920 when reading a key-sequence to be looked-up in this keymap.
922 (keymap, use_inherited))
924 /* This function can GC */
927 keymap = get_keymap (keymap, 1, 1);
928 prompt = XKEYMAP (keymap)->prompt;
929 if (!NILP (prompt) || NILP (use_inherited))
932 return traverse_keymaps (keymap, Qnil, keymap_prompt_mapper, 0);
935 DEFUN ("set-keymap-default-binding", Fset_keymap_default_binding, 2, 2, 0, /*
936 Sets the default binding of KEYMAP to COMMAND, or `nil'
937 if no default is desired. The default-binding is returned when
938 no other binding for a key-sequence is found in the keymap.
939 If a keymap has a non-nil default-binding, neither the keymap's
940 parents nor the current global map are searched for key bindings.
944 /* This function can GC */
945 keymap = get_keymap (keymap, 1, 1);
947 XKEYMAP (keymap)->default_binding = command;
951 DEFUN ("keymap-default-binding", Fkeymap_default_binding, 1, 1, 0, /*
952 Return the default binding of KEYMAP, or `nil' if it has none.
953 The default-binding is returned when no other binding for a key-sequence
954 is found in the keymap.
955 If a keymap has a non-nil default-binding, neither the keymap's
956 parents nor the current global map are searched for key bindings.
960 /* This function can GC */
961 keymap = get_keymap (keymap, 1, 1);
962 return XKEYMAP (keymap)->default_binding;
965 DEFUN ("keymapp", Fkeymapp, 1, 1, 0, /*
966 Return t if ARG is a keymap object.
967 The keymap may be autoloaded first if necessary.
971 /* This function can GC */
972 return KEYMAPP (get_keymap (object, 0, 0)) ? Qt : Qnil;
975 /* Check that OBJECT is a keymap (after dereferencing through any
976 symbols). If it is, return it.
978 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
979 is an autoload form, do the autoload and try again.
980 If AUTOLOAD is nonzero, callers must assume GC is possible.
982 ERRORP controls how we respond if OBJECT isn't a keymap.
983 If ERRORP is non-zero, signal an error; otherwise, just return Qnil.
985 Note that most of the time, we don't want to pursue autoloads.
986 Functions like Faccessible_keymaps which scan entire keymap trees
987 shouldn't load every autoloaded keymap. I'm not sure about this,
988 but it seems to me that only read_key_sequence, Flookup_key, and
989 Fdefine_key should cause keymaps to be autoloaded. */
992 get_keymap (Lisp_Object object, int errorp, int autoload)
994 /* This function can GC */
997 Lisp_Object tem = indirect_function (object, 0);
1001 /* Should we do an autoload? */
1003 /* (autoload "filename" doc nil keymap) */
1006 && EQ (XCAR (tem), Qautoload)
1007 && EQ (Fcar (Fcdr (Fcdr (Fcdr (Fcdr (tem))))), Qkeymap))
1009 struct gcpro gcpro1, gcpro2;
1010 GCPRO2 (tem, object);
1011 do_autoload (tem, object);
1015 object = wrong_type_argument (Qkeymapp, object);
1021 /* Given OBJECT which was found in a slot in a keymap,
1022 trace indirect definitions to get the actual definition of that slot.
1023 An indirect definition is a list of the form
1024 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
1025 and INDEX is an ASCII code, or a cons of (KEYSYM . MODIFIERS).
1028 get_keyelt (Lisp_Object object, int accept_default)
1030 /* This function can GC */
1034 if (!CONSP (object))
1038 struct gcpro gcpro1;
1040 map = XCAR (object);
1041 map = get_keymap (map, 0, 1);
1044 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
1047 Lisp_Object idx = Fcdr (object);
1048 struct key_data indirection;
1052 event.event_type = empty_event;
1053 character_to_event (XCHAR (idx), &event,
1054 XCONSOLE (Vselected_console), 0, 0);
1055 indirection = event.event.key;
1057 else if (CONSP (idx))
1059 if (!INTP (XCDR (idx)))
1061 indirection.keysym = XCAR (idx);
1062 indirection.modifiers = (unsigned char) XINT (XCDR (idx));
1064 else if (SYMBOLP (idx))
1066 indirection.keysym = idx;
1067 indirection.modifiers = 0;
1074 return raw_lookup_key (map, &indirection, 1, 0, accept_default);
1076 else if (STRINGP (XCAR (object)))
1078 /* If the keymap contents looks like (STRING . DEFN),
1080 Keymap alist elements like (CHAR MENUSTRING . DEFN)
1081 will be used by HierarKey menus. */
1082 object = XCDR (object);
1087 /* Anything else is really the value. */
1093 keymap_lookup_1 (Lisp_Object keymap, const struct key_data *key,
1096 /* This function can GC */
1097 return get_keyelt (keymap_lookup_directly (keymap,
1098 key->keysym, key->modifiers),
1103 /************************************************************************/
1104 /* Copying keymaps */
1105 /************************************************************************/
1107 struct copy_keymap_inverse_closure
1109 Lisp_Object inverse_table;
1113 copy_keymap_inverse_mapper (Lisp_Object key, Lisp_Object value,
1114 void *copy_keymap_inverse_closure)
1116 struct copy_keymap_inverse_closure *closure =
1117 (struct copy_keymap_inverse_closure *) copy_keymap_inverse_closure;
1119 /* copy-sequence deals with dotted lists. */
1121 value = Fcopy_list (value);
1122 Fputhash (key, value, closure->inverse_table);
1129 copy_keymap_internal (Lisp_Keymap *keymap)
1131 Lisp_Object nkm = make_keymap (0);
1132 Lisp_Keymap *new_keymap = XKEYMAP (nkm);
1133 struct copy_keymap_inverse_closure copy_keymap_inverse_closure;
1134 copy_keymap_inverse_closure.inverse_table = keymap->inverse_table;
1136 new_keymap->parents = Fcopy_sequence (keymap->parents);
1137 new_keymap->sub_maps_cache = Qnil; /* No submaps */
1138 new_keymap->table = Fcopy_hash_table (keymap->table);
1139 new_keymap->inverse_table = Fcopy_hash_table (keymap->inverse_table);
1140 new_keymap->default_binding = keymap->default_binding;
1141 /* After copying the inverse map, we need to copy the conses which
1142 are its values, lest they be shared by the copy, and mangled.
1144 elisp_maphash (copy_keymap_inverse_mapper, keymap->inverse_table,
1145 ©_keymap_inverse_closure);
1150 static Lisp_Object copy_keymap (Lisp_Object keymap);
1152 struct copy_keymap_closure
1158 copy_keymap_mapper (Lisp_Object key, Lisp_Object value,
1159 void *copy_keymap_closure)
1161 /* This function can GC */
1162 struct copy_keymap_closure *closure =
1163 (struct copy_keymap_closure *) copy_keymap_closure;
1165 /* When we encounter a keymap which is indirected through a
1166 symbol, we need to copy the sub-map. In v18, the form
1167 (lookup-key (copy-keymap global-map) "\C-x")
1168 returned a new keymap, not the symbol 'Control-X-prefix.
1170 value = get_keymap (value, 0, 1); /* #### autoload GC-safe here? */
1171 if (KEYMAPP (value))
1172 keymap_store_internal (key, closure->self,
1173 copy_keymap (value));
1178 copy_keymap (Lisp_Object keymap)
1180 /* This function can GC */
1181 struct copy_keymap_closure copy_keymap_closure;
1183 keymap = copy_keymap_internal (XKEYMAP (keymap));
1184 copy_keymap_closure.self = XKEYMAP (keymap);
1185 elisp_maphash (copy_keymap_mapper,
1186 XKEYMAP (keymap)->table,
1187 ©_keymap_closure);
1191 DEFUN ("copy-keymap", Fcopy_keymap, 1, 1, 0, /*
1192 Return a copy of the keymap KEYMAP.
1193 The copy starts out with the same definitions of KEYMAP,
1194 but changing either the copy or KEYMAP does not affect the other.
1195 Any key definitions that are subkeymaps are recursively copied.
1199 /* This function can GC */
1200 keymap = get_keymap (keymap, 1, 1);
1201 return copy_keymap (keymap);
1206 keymap_fullness (Lisp_Object keymap)
1208 /* This function can GC */
1210 Lisp_Object sub_maps;
1211 struct gcpro gcpro1, gcpro2;
1213 keymap = get_keymap (keymap, 1, 1);
1214 fullness = XINT (Fhash_table_count (XKEYMAP (keymap)->table));
1215 GCPRO2 (keymap, sub_maps);
1216 for (sub_maps = keymap_submaps (keymap);
1218 sub_maps = XCDR (sub_maps))
1220 if (MODIFIER_HASH_KEY_BITS (XCAR (XCAR (sub_maps))) != 0)
1222 Lisp_Object bucky_map = XCDR (XCAR (sub_maps));
1223 fullness--; /* don't count bucky maps themselves. */
1224 fullness += keymap_fullness (bucky_map);
1231 DEFUN ("keymap-fullness", Fkeymap_fullness, 1, 1, 0, /*
1232 Return the number of bindings in the keymap.
1236 /* This function can GC */
1237 return make_int (keymap_fullness (get_keymap (keymap, 1, 1)));
1241 /************************************************************************/
1242 /* Defining keys in keymaps */
1243 /************************************************************************/
1245 /* Given a keysym (should be a symbol, int, char), make sure it's valid
1246 and perform any necessary canonicalization. */
1249 define_key_check_and_coerce_keysym (Lisp_Object spec,
1250 Lisp_Object *keysym,
1253 /* Now, check and massage the trailing keysym specifier. */
1254 if (SYMBOLP (*keysym))
1256 if (string_char_length (XSYMBOL (*keysym)->name) == 1)
1258 Lisp_Object ream_gcc_up_the_ass =
1259 make_char (string_char (XSYMBOL (*keysym)->name, 0));
1260 *keysym = ream_gcc_up_the_ass;
1264 else if (CHAR_OR_CHAR_INTP (*keysym))
1266 CHECK_CHAR_COERCE_INT (*keysym);
1268 if (XCHAR (*keysym) < ' '
1269 /* || (XCHAR (*keysym) >= 128 && XCHAR (*keysym) < 160) */)
1270 /* yuck! Can't make the above restriction; too many compatibility
1272 signal_simple_error ("keysym char must be printable", *keysym);
1273 /* #### This bites! I want to be able to write (control shift a) */
1274 if (modifiers & XEMACS_MOD_SHIFT)
1276 ("The `shift' modifier may not be applied to ASCII keysyms",
1281 signal_simple_error ("Unknown keysym specifier", *keysym);
1284 if (SYMBOLP (*keysym))
1286 char *name = (char *) string_data (XSYMBOL (*keysym)->name);
1288 /* FSFmacs uses symbols with the printed representation of keysyms in
1289 their names, like 'M-x, and we use the syntax '(meta x). So, to avoid
1290 confusion, notice the M-x syntax and signal an error - because
1291 otherwise it would be interpreted as a regular keysym, and would even
1292 show up in the list-buffers output, causing confusion to the naive.
1294 We can get away with this because none of the X keysym names contain
1295 a hyphen (some contain underscore, however).
1297 It might be useful to reject keysyms which are not x-valid-keysym-
1298 name-p, but that would interfere with various tricks we do to
1299 sanitize the Sun keyboards, and would make it trickier to
1300 conditionalize a .emacs file for multiple X servers.
1302 if (((int) strlen (name) >= 2 && name[1] == '-')
1305 /* Ok, this is a bit more dubious - prevent people from doing things
1306 like (global-set-key 'RET 'something) because that will have the
1307 same problem as above. (Gag!) Maybe we should just silently
1308 accept these as aliases for the "real" names?
1310 (string_length (XSYMBOL (*keysym)->name) <= 3 &&
1311 (!strcmp (name, "LFD") ||
1312 !strcmp (name, "TAB") ||
1313 !strcmp (name, "RET") ||
1314 !strcmp (name, "ESC") ||
1315 !strcmp (name, "DEL") ||
1316 !strcmp (name, "SPC") ||
1317 !strcmp (name, "BS")))
1321 ("Invalid (FSF Emacs) key format (see doc of define-key)",
1324 /* #### Ok, this is a bit more dubious - make people not lose if they
1325 do things like (global-set-key 'RET 'something) because that would
1326 otherwise have the same problem as above. (Gag!) We silently
1327 accept these as aliases for the "real" names.
1329 else if (!strncmp(name, "kp_", 3)) {
1330 /* Likewise, the obsolete keysym binding of kp_.* should not lose. */
1333 strncpy(temp, name, sizeof (temp));
1334 temp[sizeof (temp) - 1] = '\0';
1336 *keysym = Fintern_soft(make_string((Bufbyte *)temp,
1339 } else if (EQ (*keysym, QLFD))
1340 *keysym = QKlinefeed;
1341 else if (EQ (*keysym, QTAB))
1343 else if (EQ (*keysym, QRET))
1345 else if (EQ (*keysym, QESC))
1347 else if (EQ (*keysym, QDEL))
1349 else if (EQ (*keysym, QSPC))
1351 else if (EQ (*keysym, QBS))
1352 *keysym = QKbackspace;
1353 /* Emacs compatibility */
1354 else if (EQ(*keysym, Qdown_mouse_1))
1356 else if (EQ(*keysym, Qdown_mouse_2))
1358 else if (EQ(*keysym, Qdown_mouse_3))
1360 else if (EQ(*keysym, Qdown_mouse_4))
1362 else if (EQ(*keysym, Qdown_mouse_5))
1364 else if (EQ(*keysym, Qmouse_1))
1365 *keysym = Qbutton1up;
1366 else if (EQ(*keysym, Qmouse_2))
1367 *keysym = Qbutton2up;
1368 else if (EQ(*keysym, Qmouse_3))
1369 *keysym = Qbutton3up;
1370 else if (EQ(*keysym, Qmouse_4))
1371 *keysym = Qbutton4up;
1372 else if (EQ(*keysym, Qmouse_5))
1373 *keysym = Qbutton5up;
1378 /* Given any kind of key-specifier, return a keysym and modifier mask.
1379 Proper canonicalization is performed:
1381 -- integers are converted into the equivalent characters.
1382 -- one-character strings are converted into the equivalent characters.
1386 define_key_parser (Lisp_Object spec, struct key_data *returned_value)
1388 if (CHAR_OR_CHAR_INTP (spec))
1391 event.event_type = empty_event;
1392 character_to_event (XCHAR_OR_CHAR_INT (spec), &event,
1393 XCONSOLE (Vselected_console), 0, 0);
1394 returned_value->keysym = event.event.key.keysym;
1395 returned_value->modifiers = event.event.key.modifiers;
1397 else if (EVENTP (spec))
1399 switch (XEVENT (spec)->event_type)
1401 case key_press_event:
1403 returned_value->keysym = XEVENT (spec)->event.key.keysym;
1404 returned_value->modifiers = XEVENT (spec)->event.key.modifiers;
1407 case button_press_event:
1408 case button_release_event:
1410 int down = (XEVENT (spec)->event_type == button_press_event);
1411 switch (XEVENT (spec)->event.button.button)
1414 returned_value->keysym = (down ? Qbutton1 : Qbutton1up); break;
1416 returned_value->keysym = (down ? Qbutton2 : Qbutton2up); break;
1418 returned_value->keysym = (down ? Qbutton3 : Qbutton3up); break;
1420 returned_value->keysym = (down ? Qbutton4 : Qbutton4up); break;
1422 returned_value->keysym = (down ? Qbutton5 : Qbutton5up); break;
1424 returned_value->keysym = (down ? Qbutton6 : Qbutton6up); break;
1426 returned_value->keysym = (down ? Qbutton7 : Qbutton7up); break;
1428 returned_value->keysym = (down ? Qbutton0 : Qbutton0up); break;
1430 returned_value->modifiers = XEVENT (spec)->event.button.modifiers;
1434 signal_error (Qwrong_type_argument,
1435 list2 (build_translated_string
1436 ("unable to bind this type of event"),
1440 else if (SYMBOLP (spec))
1442 /* Be nice, allow = to mean (=) */
1443 if (bucky_sym_to_bucky_bit (spec) != 0)
1444 signal_simple_error ("Key is a modifier name", spec);
1445 define_key_check_and_coerce_keysym (spec, &spec, 0);
1446 returned_value->keysym = spec;
1447 returned_value->modifiers = 0;
1449 else if (CONSP (spec))
1452 Lisp_Object keysym = Qnil;
1453 Lisp_Object rest = spec;
1455 /* First, parse out the leading modifier symbols. */
1456 while (CONSP (rest))
1460 keysym = XCAR (rest);
1461 modifier = bucky_sym_to_bucky_bit (keysym);
1462 modifiers |= modifier;
1463 if (!NILP (XCDR (rest)))
1466 signal_simple_error ("Unknown modifier", keysym);
1471 signal_simple_error ("Nothing but modifiers here",
1478 signal_simple_error ("List must be nil-terminated", spec);
1480 define_key_check_and_coerce_keysym (spec, &keysym, modifiers);
1481 returned_value->keysym = keysym;
1482 returned_value->modifiers = modifiers;
1486 signal_simple_error ("Unknown key-sequence specifier",
1491 /* Used by character-to-event */
1493 key_desc_list_to_event (Lisp_Object list, Lisp_Object event,
1494 int allow_menu_events)
1496 struct key_data raw_key;
1498 if (allow_menu_events &&
1500 /* #### where the hell does this come from? */
1501 EQ (XCAR (list), Qmenu_selection))
1503 Lisp_Object fn, arg;
1504 if (! NILP (Fcdr (Fcdr (list))))
1505 signal_simple_error ("Invalid menu event desc", list);
1506 arg = Fcar (Fcdr (list));
1508 fn = Qcall_interactively;
1511 XSETFRAME (XEVENT (event)->channel, selected_frame ());
1512 XEVENT (event)->event_type = misc_user_event;
1513 XEVENT (event)->event.eval.function = fn;
1514 XEVENT (event)->event.eval.object = arg;
1518 define_key_parser (list, &raw_key);
1520 if (EQ (raw_key.keysym, Qbutton0) || EQ (raw_key.keysym, Qbutton0up) ||
1521 EQ (raw_key.keysym, Qbutton1) || EQ (raw_key.keysym, Qbutton1up) ||
1522 EQ (raw_key.keysym, Qbutton2) || EQ (raw_key.keysym, Qbutton2up) ||
1523 EQ (raw_key.keysym, Qbutton3) || EQ (raw_key.keysym, Qbutton3up) ||
1524 EQ (raw_key.keysym, Qbutton4) || EQ (raw_key.keysym, Qbutton4up) ||
1525 EQ (raw_key.keysym, Qbutton5) || EQ (raw_key.keysym, Qbutton5up) ||
1526 EQ (raw_key.keysym, Qbutton6) || EQ (raw_key.keysym, Qbutton6up) ||
1527 EQ (raw_key.keysym, Qbutton7) || EQ (raw_key.keysym, Qbutton7up))
1528 error ("Mouse-clicks can't appear in saved keyboard macros.");
1530 XEVENT (event)->channel = Vselected_console;
1531 XEVENT (event)->event_type = key_press_event;
1532 XEVENT (event)->event.key.keysym = raw_key.keysym;
1533 XEVENT (event)->event.key.modifiers = raw_key.modifiers;
1538 event_matches_key_specifier_p (Lisp_Event *event, Lisp_Object key_specifier)
1542 struct gcpro gcpro1;
1544 if (event->event_type != key_press_event || NILP (key_specifier) ||
1545 (INTP (key_specifier) && !CHAR_INTP (key_specifier)))
1548 /* if the specifier is an integer such as 27, then it should match
1549 both of the events 'escape' and 'control ['. Calling
1550 Fcharacter_to_event() will only match 'escape'. */
1551 if (CHAR_OR_CHAR_INTP (key_specifier))
1552 return (XCHAR_OR_CHAR_INT (key_specifier)
1553 == event_to_character (event, 0, 0, 0));
1555 /* Otherwise, we cannot call event_to_character() because we may
1556 be dealing with non-ASCII keystrokes. In any case, if I ask
1557 for 'control [' then I should get exactly that, and not
1560 However, we have to behave differently on TTY's, where 'control ['
1561 is silently converted into 'escape' by the keyboard driver.
1562 In this case, ASCII is the only thing we know about, so we have
1563 to compare the ASCII values. */
1566 event2 = Fmake_event (Qnil, Qnil);
1567 Fcharacter_to_event (key_specifier, event2, Qnil, Qnil);
1568 if (XEVENT (event2)->event_type != key_press_event)
1570 else if (CONSOLE_TTY_P (XCONSOLE (EVENT_CHANNEL (event))))
1574 ch1 = event_to_character (event, 0, 0, 0);
1575 ch2 = event_to_character (XEVENT (event2), 0, 0, 0);
1576 retval = (ch1 >= 0 && ch2 >= 0 && ch1 == ch2);
1578 else if (EQ (event->event.key.keysym, XEVENT (event2)->event.key.keysym) &&
1579 event->event.key.modifiers == XEVENT (event2)->event.key.modifiers)
1583 Fdeallocate_event (event2);
1589 meta_prefix_char_p (const struct key_data *key)
1593 event.event_type = key_press_event;
1594 event.channel = Vselected_console;
1595 event.event.key.keysym = key->keysym;
1596 event.event.key.modifiers = key->modifiers;
1597 return event_matches_key_specifier_p (&event, Vmeta_prefix_char);
1600 DEFUN ("event-matches-key-specifier-p", Fevent_matches_key_specifier_p, 2, 2, 0, /*
1601 Return non-nil if EVENT matches KEY-SPECIFIER.
1602 This can be useful, e.g., to determine if the user pressed `help-char' or
1605 (event, key_specifier))
1607 CHECK_LIVE_EVENT (event);
1608 return (event_matches_key_specifier_p (XEVENT (event), key_specifier)
1612 #define MACROLET(k,m) do { \
1613 returned_value->keysym = (k); \
1614 returned_value->modifiers = (m); \
1615 RETURN_SANS_WARNINGS; \
1619 Given a keysym, return another keysym/modifier pair which could be
1620 considered the same key in an ASCII world. Backspace returns ^H, for
1624 define_key_alternate_name (struct key_data *key,
1625 struct key_data *returned_value)
1627 Lisp_Object keysym = key->keysym;
1628 int modifiers = key->modifiers;
1629 int modifiers_sans_control = (modifiers & (~XEMACS_MOD_CONTROL));
1630 int modifiers_sans_meta = (modifiers & (~XEMACS_MOD_META));
1631 returned_value->keysym = Qnil; /* By default, no "alternate" key */
1632 returned_value->modifiers = 0;
1633 if (modifiers_sans_meta == XEMACS_MOD_CONTROL)
1635 if EQ (keysym, QKspace)
1636 MACROLET (make_char ('@'), modifiers);
1637 else if (!CHARP (keysym))
1639 else switch (XCHAR (keysym))
1641 case '@': /* c-@ => c-space */
1642 MACROLET (QKspace, modifiers);
1643 case 'h': /* c-h => backspace */
1644 MACROLET (QKbackspace, modifiers_sans_control);
1645 case 'i': /* c-i => tab */
1646 MACROLET (QKtab, modifiers_sans_control);
1647 case 'j': /* c-j => linefeed */
1648 MACROLET (QKlinefeed, modifiers_sans_control);
1649 case 'm': /* c-m => return */
1650 MACROLET (QKreturn, modifiers_sans_control);
1651 case '[': /* c-[ => escape */
1652 MACROLET (QKescape, modifiers_sans_control);
1657 else if (modifiers_sans_meta != 0)
1659 else if (EQ (keysym, QKbackspace)) /* backspace => c-h */
1660 MACROLET (make_char ('h'), (modifiers | XEMACS_MOD_CONTROL));
1661 else if (EQ (keysym, QKtab)) /* tab => c-i */
1662 MACROLET (make_char ('i'), (modifiers | XEMACS_MOD_CONTROL));
1663 else if (EQ (keysym, QKlinefeed)) /* linefeed => c-j */
1664 MACROLET (make_char ('j'), (modifiers | XEMACS_MOD_CONTROL));
1665 else if (EQ (keysym, QKreturn)) /* return => c-m */
1666 MACROLET (make_char ('m'), (modifiers | XEMACS_MOD_CONTROL));
1667 else if (EQ (keysym, QKescape)) /* escape => c-[ */
1668 MACROLET (make_char ('['), (modifiers | XEMACS_MOD_CONTROL));
1676 ensure_meta_prefix_char_keymapp (Lisp_Object keys, int indx,
1679 /* This function can GC */
1680 Lisp_Object new_keys;
1682 Lisp_Object mpc_binding;
1683 struct key_data meta_key;
1685 if (NILP (Vmeta_prefix_char) ||
1686 (INTP (Vmeta_prefix_char) && !CHAR_INTP (Vmeta_prefix_char)))
1689 define_key_parser (Vmeta_prefix_char, &meta_key);
1690 mpc_binding = keymap_lookup_1 (keymap, &meta_key, 0);
1691 if (NILP (mpc_binding) || !NILP (Fkeymapp (mpc_binding)))
1696 else if (STRINGP (keys))
1697 new_keys = Fsubstring (keys, Qzero, make_int (indx));
1698 else if (VECTORP (keys))
1700 new_keys = make_vector (indx, Qnil);
1701 for (i = 0; i < indx; i++)
1702 XVECTOR_DATA (new_keys) [i] = XVECTOR_DATA (keys) [i];
1707 if (EQ (keys, new_keys))
1708 error_with_frob (mpc_binding,
1709 "can't bind %s: %s has a non-keymap binding",
1710 (char *) XSTRING_DATA (Fkey_description (keys)),
1711 (char *) XSTRING_DATA (Fsingle_key_description
1712 (Vmeta_prefix_char)));
1714 error_with_frob (mpc_binding,
1715 "can't bind %s: %s %s has a non-keymap binding",
1716 (char *) XSTRING_DATA (Fkey_description (keys)),
1717 (char *) XSTRING_DATA (Fkey_description (new_keys)),
1718 (char *) XSTRING_DATA (Fsingle_key_description
1719 (Vmeta_prefix_char)));
1722 DEFUN ("define-key", Fdefine_key, 3, 3, 0, /*
1723 Define key sequence KEYS, in KEYMAP, as DEF.
1724 KEYMAP is a keymap object.
1725 KEYS is the sequence of keystrokes to bind, described below.
1726 DEF is anything that can be a key's definition:
1727 nil (means key is undefined in this keymap);
1728 a command (a Lisp function suitable for interactive calling);
1729 a string or key sequence vector (treated as a keyboard macro);
1730 a keymap (to define a prefix key);
1731 a symbol; when the key is looked up, the symbol will stand for its
1732 function definition, that should at that time be one of the above,
1733 or another symbol whose function definition is used, and so on.
1734 a cons (STRING . DEFN), meaning that DEFN is the definition
1735 (DEFN should be a valid definition in its own right);
1736 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1738 Contrary to popular belief, the world is not ASCII. When running under a
1739 window manager, XEmacs can tell the difference between, for example, the
1740 keystrokes control-h, control-shift-h, and backspace. You can, in fact,
1741 bind different commands to each of these.
1743 A `key sequence' is a set of keystrokes. A `keystroke' is a keysym and some
1744 set of modifiers (such as control and meta). A `keysym' is what is printed
1745 on the keys on your keyboard.
1747 A keysym may be represented by a symbol, or (if and only if it is equivalent
1748 to an ASCII character in the range 32 - 255) by a character or its equivalent
1749 ASCII code. The `A' key may be represented by the symbol `A', the character
1750 `?A', or by the number 65. The `break' key may be represented only by the
1753 A keystroke may be represented by a list: the last element of the list
1754 is the key (a symbol, character, or number, as above) and the
1755 preceding elements are the symbolic names of modifier keys (control,
1756 meta, super, hyper, alt, and shift). Thus, the sequence control-b is
1757 represented by the forms `(control b)', `(control ?b)', and `(control
1758 98)'. A keystroke may also be represented by an event object, as
1759 returned by the `next-command-event' and `read-key-sequence'
1762 Note that in this context, the keystroke `control-b' is *not* represented
1763 by the number 2 (the ASCII code for ^B) or the character `?\^B'. See below.
1765 The `shift' modifier is somewhat of a special case. You should not (and
1766 cannot) use `(meta shift a)' to mean `(meta A)', since for characters that
1767 have ASCII equivalents, the state of the shift key is implicit in the
1768 keysym (a vs. A). You also cannot say `(shift =)' to mean `+', as that
1769 sort of thing varies from keyboard to keyboard. The shift modifier is for
1770 use only with characters that do not have a second keysym on the same key,
1771 such as `backspace' and `tab'.
1773 A key sequence is a vector of keystrokes. As a degenerate case, elements
1774 of this vector may also be keysyms if they have no modifiers. That is,
1775 the `A' keystroke is represented by all of these forms:
1776 A ?A 65 (A) (?A) (65)
1777 [A] [?A] [65] [(A)] [(?A)] [(65)]
1779 the `control-a' keystroke is represented by these forms:
1780 (control A) (control ?A) (control 65)
1781 [(control A)] [(control ?A)] [(control 65)]
1782 the key sequence `control-c control-a' is represented by these forms:
1783 [(control c) (control a)] [(control ?c) (control ?a)]
1784 [(control 99) (control 65)] etc.
1786 Mouse button clicks work just like keypresses: (control button1) means
1787 pressing the left mouse button while holding down the control key.
1788 \[(control c) (shift button3)] means control-c, hold shift, click right.
1790 Commands may be bound to the mouse-button up-stroke rather than the down-
1791 stroke as well. `button1' means the down-stroke, and `button1up' means the
1792 up-stroke. Different commands may be bound to the up and down strokes,
1793 though that is probably not what you want, so be careful.
1795 For backward compatibility, a key sequence may also be represented by a
1796 string. In this case, it represents the key sequence(s) that would
1797 produce that sequence of ASCII characters in a purely ASCII world. For
1798 example, a string containing the ASCII backspace character, "\\^H", would
1799 represent two key sequences: `(control h)' and `backspace'. Binding a
1800 command to this will actually bind both of those key sequences. Likewise
1801 for the following pairs:
1808 control @ control space
1810 After binding a command to two key sequences with a form like
1812 (define-key global-map "\\^X\\^I" \'command-1)
1814 it is possible to redefine only one of those sequences like so:
1816 (define-key global-map [(control x) (control i)] \'command-2)
1817 (define-key global-map [(control x) tab] \'command-3)
1819 Of course, all of this applies only when running under a window system. If
1820 you're talking to XEmacs through a TTY connection, you don't get any of
1823 (keymap, keys, def))
1825 /* This function can GC */
1830 struct gcpro gcpro1, gcpro2, gcpro3;
1833 len = XVECTOR_LENGTH (keys);
1834 else if (STRINGP (keys))
1835 len = XSTRING_CHAR_LENGTH (keys);
1836 else if (CHAR_OR_CHAR_INTP (keys) || SYMBOLP (keys) || CONSP (keys))
1838 if (!CONSP (keys)) keys = list1 (keys);
1840 keys = make_vector (1, keys); /* this is kinda sleazy. */
1844 keys = wrong_type_argument (Qsequencep, keys);
1845 len = XINT (Flength (keys));
1850 GCPRO3 (keymap, keys, def);
1853 When the user defines a key which, in a strictly ASCII world, would be
1854 produced by two different keys (^J and linefeed, or ^H and backspace,
1855 for example) then the binding will be made for both keysyms.
1857 This is done if the user binds a command to a string, as in
1858 (define-key map "\^H" 'something), but not when using one of the new
1859 syntaxes, like (define-key map '(control h) 'something).
1861 ascii_hack = (STRINGP (keys));
1863 keymap = get_keymap (keymap, 1, 1);
1869 struct key_data raw_key1;
1870 struct key_data raw_key2;
1873 c = make_char (string_char (XSTRING (keys), idx));
1875 c = XVECTOR_DATA (keys) [idx];
1877 define_key_parser (c, &raw_key1);
1879 if (!metized && ascii_hack && meta_prefix_char_p (&raw_key1))
1881 if (idx == (len - 1))
1883 /* This is a hack to prevent a binding for the meta-prefix-char
1884 from being made in a map which already has a non-empty "meta"
1885 submap. That is, we can't let both "escape" and "meta" have
1886 a binding in the same keymap. This implies that the idiom
1887 (define-key my-map "\e" my-escape-map)
1888 (define-key my-escape-map "a" 'my-command)
1889 no longer works. That's ok. Instead the luser should do
1890 (define-key my-map "\ea" 'my-command)
1892 (define-key my-map "\M-a" 'my-command)
1894 (defvar my-escape-map (lookup-key my-map "\e"))
1895 if the luser really wants the map in a variable.
1897 Lisp_Object meta_map;
1898 struct gcpro ngcpro1;
1901 meta_map = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
1902 XKEYMAP (keymap)->table, Qnil);
1903 if (!NILP (meta_map)
1904 && keymap_fullness (meta_map) != 0)
1905 signal_simple_error_2
1906 ("Map contains meta-bindings, can't bind",
1907 Fsingle_key_description (Vmeta_prefix_char), keymap);
1919 define_key_alternate_name (&raw_key1, &raw_key2);
1922 raw_key2.keysym = Qnil;
1923 raw_key2.modifiers = 0;
1928 raw_key1.modifiers |= XEMACS_MOD_META;
1929 raw_key2.modifiers |= XEMACS_MOD_META;
1933 /* This crap is to make sure that someone doesn't bind something like
1934 "C-x M-a" while "C-x ESC" has a non-keymap binding. */
1935 if (raw_key1.modifiers & XEMACS_MOD_META)
1936 ensure_meta_prefix_char_keymapp (keys, idx, keymap);
1940 keymap_store (keymap, &raw_key1, def);
1941 if (ascii_hack && !NILP (raw_key2.keysym))
1942 keymap_store (keymap, &raw_key2, def);
1949 struct gcpro ngcpro1;
1952 cmd = keymap_lookup_1 (keymap, &raw_key1, 0);
1955 cmd = Fmake_sparse_keymap (Qnil);
1956 XKEYMAP (cmd)->name /* for debugging */
1957 = list2 (make_key_description (&raw_key1, 1), keymap);
1958 keymap_store (keymap, &raw_key1, cmd);
1960 if (NILP (Fkeymapp (cmd)))
1961 signal_simple_error_2 ("Invalid prefix keys in sequence",
1964 if (ascii_hack && !NILP (raw_key2.keysym) &&
1965 NILP (keymap_lookup_1 (keymap, &raw_key2, 0)))
1966 keymap_store (keymap, &raw_key2, cmd);
1968 keymap = get_keymap (cmd, 1, 1);
1975 /************************************************************************/
1976 /* Looking up keys in keymaps */
1977 /************************************************************************/
1979 /* We need a very fast (i.e., non-consing) version of lookup-key in order
1980 to make where-is-internal really fly. */
1982 struct raw_lookup_key_mapper_closure
1985 const struct key_data *raw_keys;
1991 static Lisp_Object raw_lookup_key_mapper (Lisp_Object k, void *);
1993 /* Caller should gc-protect args (keymaps may autoload) */
1995 raw_lookup_key (Lisp_Object keymap,
1996 const struct key_data *raw_keys, int raw_keys_count,
1997 int keys_so_far, int accept_default)
1999 /* This function can GC */
2000 struct raw_lookup_key_mapper_closure c;
2001 c.remaining = raw_keys_count - 1;
2002 c.raw_keys = raw_keys;
2003 c.raw_keys_count = raw_keys_count;
2004 c.keys_so_far = keys_so_far;
2005 c.accept_default = accept_default;
2007 return traverse_keymaps (keymap, Qnil, raw_lookup_key_mapper, &c);
2011 raw_lookup_key_mapper (Lisp_Object k, void *arg)
2013 /* This function can GC */
2014 struct raw_lookup_key_mapper_closure *c =
2015 (struct raw_lookup_key_mapper_closure *) arg;
2016 int accept_default = c->accept_default;
2017 int remaining = c->remaining;
2018 int keys_so_far = c->keys_so_far;
2019 const struct key_data *raw_keys = c->raw_keys;
2022 if (! meta_prefix_char_p (&(raw_keys[0])))
2024 /* Normal case: every case except the meta-hack (see below). */
2025 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2028 /* Return whatever we found if we're out of keys */
2030 else if (NILP (cmd))
2031 /* Found nothing (though perhaps parent map may have binding) */
2033 else if (NILP (Fkeymapp (cmd)))
2034 /* Didn't find a keymap, and we have more keys.
2035 * Return a fixnum to indicate that keys were too long.
2037 cmd = make_int (keys_so_far + 1);
2039 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2040 keys_so_far + 1, accept_default);
2044 /* This is a hack so that looking up a key-sequence whose last
2045 * element is the meta-prefix-char will return the keymap that
2046 * the "meta" keys are stored in, if there is no binding for
2047 * the meta-prefix-char (and if this map has a "meta" submap).
2048 * If this map doesn't have a "meta" submap, then the
2049 * meta-prefix-char is looked up just like any other key.
2053 /* First look for the prefix-char directly */
2054 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2057 /* Do kludgy return of the meta-map */
2058 cmd = Fgethash (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
2059 XKEYMAP (k)->table, Qnil);
2064 /* Search for the prefix-char-prefixed sequence directly */
2065 cmd = keymap_lookup_1 (k, &(raw_keys[0]), accept_default);
2066 cmd = get_keymap (cmd, 0, 1);
2068 cmd = raw_lookup_key (cmd, raw_keys + 1, remaining,
2069 keys_so_far + 1, accept_default);
2070 else if ((raw_keys[1].modifiers & XEMACS_MOD_META) == 0)
2072 struct key_data metified;
2073 metified.keysym = raw_keys[1].keysym;
2074 metified.modifiers = raw_keys[1].modifiers | XEMACS_MOD_META;
2076 /* Search for meta-next-char sequence directly */
2077 cmd = keymap_lookup_1 (k, &metified, accept_default);
2082 cmd = get_keymap (cmd, 0, 1);
2084 cmd = raw_lookup_key (cmd, raw_keys + 2, remaining - 1,
2091 if (accept_default && NILP (cmd))
2092 cmd = XKEYMAP (k)->default_binding;
2096 /* Value is number if `keys' is too long; NIL if valid but has no definition.*/
2097 /* Caller should gc-protect arguments */
2099 lookup_keys (Lisp_Object keymap, int nkeys, Lisp_Object *keys,
2102 /* This function can GC */
2103 struct key_data kkk[20];
2104 struct key_data *raw_keys;
2110 if (nkeys < countof (kkk))
2113 raw_keys = alloca_array (struct key_data, nkeys);
2115 for (i = 0; i < nkeys; i++)
2117 define_key_parser (keys[i], &(raw_keys[i]));
2119 return raw_lookup_key (keymap, raw_keys, nkeys, 0, accept_default);
2123 lookup_events (Lisp_Object event_head, int nmaps, Lisp_Object keymaps[],
2126 /* This function can GC */
2127 struct key_data kkk[20];
2131 struct key_data *raw_keys;
2132 Lisp_Object tem = Qnil;
2133 struct gcpro gcpro1, gcpro2;
2136 CHECK_LIVE_EVENT (event_head);
2138 nkeys = event_chain_count (event_head);
2140 if (nkeys < countof (kkk))
2143 raw_keys = alloca_array (struct key_data, nkeys);
2146 EVENT_CHAIN_LOOP (event, event_head)
2147 define_key_parser (event, &(raw_keys[nkeys++]));
2148 GCPRO2 (keymaps[0], event_head);
2149 gcpro1.nvars = nmaps;
2150 /* ####raw_keys[].keysym slots aren't gc-protected. We rely (but shouldn't)
2151 * on somebody else somewhere (obarray) having a pointer to all keysyms. */
2152 for (iii = 0; iii < nmaps; iii++)
2154 tem = raw_lookup_key (keymaps[iii], raw_keys, nkeys, 0,
2158 /* Too long in some local map means don't look at global map */
2162 else if (!NILP (tem))
2169 DEFUN ("lookup-key", Flookup_key, 2, 3, 0, /*
2170 In keymap KEYMAP, look up key-sequence KEYS. Return the definition.
2171 Nil is returned if KEYS is unbound. See documentation of `define-key'
2172 for valid key definitions and key-sequence specifications.
2173 A number is returned if KEYS is "too long"; that is, the leading
2174 characters fail to be a valid sequence of prefix characters in KEYMAP.
2175 The number is how many characters at the front of KEYS
2176 it takes to reach a non-prefix command.
2178 (keymap, keys, accept_default))
2180 /* This function can GC */
2182 return lookup_keys (keymap,
2183 XVECTOR_LENGTH (keys),
2184 XVECTOR_DATA (keys),
2185 !NILP (accept_default));
2186 else if (SYMBOLP (keys) || CHAR_OR_CHAR_INTP (keys) || CONSP (keys))
2187 return lookup_keys (keymap, 1, &keys, !NILP (accept_default));
2188 else if (STRINGP (keys))
2190 int length = XSTRING_CHAR_LENGTH (keys);
2192 struct key_data *raw_keys = alloca_array (struct key_data, length);
2196 for (i = 0; i < length; i++)
2198 Emchar n = string_char (XSTRING (keys), i);
2199 define_key_parser (make_char (n), &(raw_keys[i]));
2201 return raw_lookup_key (keymap, raw_keys, length, 0,
2202 !NILP (accept_default));
2206 keys = wrong_type_argument (Qsequencep, keys);
2207 return Flookup_key (keymap, keys, accept_default);
2211 /* Given a key sequence, returns a list of keymaps to search for bindings.
2212 Does all manner of semi-hairy heuristics, like looking in the current
2213 buffer's map before looking in the global map and looking in the local
2214 map of the buffer in which the mouse was clicked in event0 is a click.
2216 It would be kind of nice if this were in Lisp so that this semi-hairy
2217 semi-heuristic command-lookup behavior could be readily understood and
2218 customised. However, this needs to be pretty fast, or performance of
2219 keyboard macros goes to shit; putting this in lisp slows macros down
2220 2-3x. And they're already slower than v18 by 5-6x.
2223 struct relevant_maps
2226 unsigned int max_maps;
2228 struct gcpro *gcpro;
2231 static void get_relevant_extent_keymaps (Lisp_Object pos,
2232 Lisp_Object buffer_or_string,
2234 struct relevant_maps *closure);
2235 static void get_relevant_minor_maps (Lisp_Object buffer,
2236 struct relevant_maps *closure);
2239 relevant_map_push (Lisp_Object map, struct relevant_maps *closure)
2241 unsigned int nmaps = closure->nmaps;
2245 closure->nmaps = nmaps + 1;
2246 if (nmaps < closure->max_maps)
2248 closure->maps[nmaps] = map;
2249 closure->gcpro->nvars = nmaps;
2254 get_relevant_keymaps (Lisp_Object keys,
2255 int max_maps, Lisp_Object maps[])
2257 /* This function can GC */
2258 Lisp_Object terminal = Qnil;
2259 struct gcpro gcpro1;
2260 struct relevant_maps closure;
2261 struct console *con;
2266 closure.max_maps = max_maps;
2267 closure.maps = maps;
2268 closure.gcpro = &gcpro1;
2271 terminal = event_chain_tail (keys);
2272 else if (VECTORP (keys))
2274 int len = XVECTOR_LENGTH (keys);
2276 terminal = XVECTOR_DATA (keys)[len - 1];
2279 if (EVENTP (terminal))
2281 CHECK_LIVE_EVENT (terminal);
2282 con = event_console_or_selected (terminal);
2285 con = XCONSOLE (Vselected_console);
2287 if (KEYMAPP (con->overriding_terminal_local_map)
2288 || KEYMAPP (Voverriding_local_map))
2290 if (KEYMAPP (con->overriding_terminal_local_map))
2291 relevant_map_push (con->overriding_terminal_local_map, &closure);
2292 if (KEYMAPP (Voverriding_local_map))
2293 relevant_map_push (Voverriding_local_map, &closure);
2295 else if (!EVENTP (terminal)
2296 || (XEVENT (terminal)->event_type != button_press_event
2297 && XEVENT (terminal)->event_type != button_release_event))
2300 XSETBUFFER (tem, current_buffer);
2301 /* It's not a mouse event; order of keymaps searched is:
2302 o keymap of any/all extents under the mouse
2304 o local-map of current-buffer
2307 /* The terminal element of the lookup may be nil or a keysym.
2308 In those cases we don't want to check for an extent
2310 if (EVENTP (terminal))
2312 get_relevant_extent_keymaps (make_int (BUF_PT (current_buffer)),
2313 tem, Qnil, &closure);
2315 get_relevant_minor_maps (tem, &closure);
2317 tem = current_buffer->keymap;
2319 relevant_map_push (tem, &closure);
2321 #ifdef HAVE_WINDOW_SYSTEM
2324 /* It's a mouse event; order of keymaps searched is:
2325 o vertical-divider-map, if event is over a divider
2326 o local-map of mouse-grabbed-buffer
2327 o keymap of any/all extents under the mouse
2328 if the mouse is over a modeline:
2329 o modeline-map of buffer corresponding to that modeline
2330 o else, local-map of buffer under the mouse
2332 o local-map of current-buffer
2335 Lisp_Object window = Fevent_window (terminal);
2337 if (!NILP (Fevent_over_vertical_divider_p (terminal)))
2339 if (KEYMAPP (Vvertical_divider_map))
2340 relevant_map_push (Vvertical_divider_map, &closure);
2343 if (BUFFERP (Vmouse_grabbed_buffer))
2345 Lisp_Object map = XBUFFER (Vmouse_grabbed_buffer)->keymap;
2347 get_relevant_minor_maps (Vmouse_grabbed_buffer, &closure);
2349 relevant_map_push (map, &closure);
2354 Lisp_Object buffer = Fwindow_buffer (window);
2358 if (!NILP (Fevent_over_modeline_p (terminal)))
2360 Lisp_Object map = symbol_value_in_buffer (Qmodeline_map,
2363 get_relevant_extent_keymaps
2364 (Fevent_modeline_position (terminal),
2365 XBUFFER (buffer)->generated_modeline_string,
2366 Fevent_glyph_extent (terminal), &closure);
2368 if (!UNBOUNDP (map) && !NILP (map))
2369 relevant_map_push (get_keymap (map, 1, 1), &closure);
2373 get_relevant_extent_keymaps (Fevent_point (terminal), buffer,
2374 Fevent_glyph_extent (terminal),
2378 if (!EQ (buffer, Vmouse_grabbed_buffer)) /* already pushed */
2380 Lisp_Object map = XBUFFER (buffer)->keymap;
2382 get_relevant_minor_maps (buffer, &closure);
2384 relevant_map_push (map, &closure);
2388 else if (!NILP (Fevent_over_toolbar_p (terminal)))
2390 Lisp_Object map = Fsymbol_value (Qtoolbar_map);
2392 if (!UNBOUNDP (map) && !NILP (map))
2393 relevant_map_push (map, &closure);
2396 #endif /* HAVE_WINDOW_SYSTEM */
2399 int nmaps = closure.nmaps;
2400 /* Silently truncate at 100 keymaps to prevent infinite lossage */
2401 if (nmaps >= max_maps && max_maps > 0)
2402 maps[max_maps - 1] = Vcurrent_global_map;
2404 maps[nmaps] = Vcurrent_global_map;
2410 /* Returns a set of keymaps extracted from the extents at POS in
2411 BUFFER_OR_STRING. The GLYPH arg, if specified, is one more extent
2412 to look for a keymap in, and if it has one, its keymap will be the
2413 first element in the list returned. This is so we can correctly
2414 search the keymaps associated with glyphs which may be physically
2415 disjoint from their extents: for example, if a glyph is out in the
2416 margin, we should still consult the keymap of that glyph's extent,
2417 which may not itself be under the mouse.
2421 get_relevant_extent_keymaps (Lisp_Object pos, Lisp_Object buffer_or_string,
2423 struct relevant_maps *closure)
2425 /* This function can GC */
2426 /* the glyph keymap, if any, comes first.
2427 (Processing it twice is no big deal: noop.) */
2430 Lisp_Object keymap = Fextent_property (glyph, Qkeymap, Qnil);
2432 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2435 /* Next check the extents at the text position, if any */
2439 for (extent = Fextent_at (pos, buffer_or_string, Qkeymap, Qnil, Qnil);
2441 extent = Fextent_at (pos, buffer_or_string, Qkeymap, extent, Qnil))
2443 Lisp_Object keymap = Fextent_property (extent, Qkeymap, Qnil);
2445 relevant_map_push (get_keymap (keymap, 1, 1), closure);
2452 minor_mode_keymap_predicate (Lisp_Object assoc, Lisp_Object buffer)
2454 /* This function can GC */
2457 Lisp_Object sym = XCAR (assoc);
2460 Lisp_Object val = symbol_value_in_buffer (sym, buffer);
2461 if (!NILP (val) && !UNBOUNDP (val))
2463 Lisp_Object map = get_keymap (XCDR (assoc), 0, 1);
2472 get_relevant_minor_maps (Lisp_Object buffer, struct relevant_maps *closure)
2474 /* This function can GC */
2477 /* Will you ever lose badly if you make this circular! */
2478 for (alist = symbol_value_in_buffer (Qminor_mode_map_alist, buffer);
2480 alist = XCDR (alist))
2482 Lisp_Object m = minor_mode_keymap_predicate (XCAR (alist),
2484 if (!NILP (m)) relevant_map_push (m, closure);
2489 /* #### Would map-current-keymaps be a better thing?? */
2490 DEFUN ("current-keymaps", Fcurrent_keymaps, 0, 1, 0, /*
2491 Return a list of the current keymaps that will be searched for bindings.
2492 This lists keymaps such as the current local map and the minor-mode maps,
2493 but does not list the parents of those keymaps.
2494 EVENT-OR-KEYS controls which keymaps will be listed.
2495 If EVENT-OR-KEYS is a mouse event (or a vector whose last element is a
2496 mouse event), the keymaps for that mouse event will be listed (see
2497 `key-binding'). Otherwise, the keymaps for key presses will be listed.
2501 /* This function can GC */
2502 struct gcpro gcpro1;
2503 Lisp_Object maps[100];
2504 Lisp_Object *gubbish = maps;
2507 GCPRO1 (event_or_keys);
2508 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
2510 if (nmaps > countof (maps))
2512 gubbish = alloca_array (Lisp_Object, nmaps);
2513 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
2516 return Flist (nmaps, gubbish);
2519 DEFUN ("key-binding", Fkey_binding, 1, 2, 0, /*
2520 Return the binding for command KEYS in current keymaps.
2521 KEYS is a string, a vector of events, or a vector of key-description lists
2522 as described in the documentation for the `define-key' function.
2523 The binding is probably a symbol with a function definition; see
2524 the documentation for `lookup-key' for more information.
2526 For key-presses, the order of keymaps searched is:
2527 - the `keymap' property of any extent(s) at point;
2528 - any applicable minor-mode maps;
2529 - the current-local-map of the current-buffer;
2530 - the current global map.
2532 For mouse-clicks, the order of keymaps searched is:
2533 - the current-local-map of the `mouse-grabbed-buffer' if any;
2534 - vertical-divider-map, if the event happened over a vertical divider
2535 - the `keymap' property of any extent(s) at the position of the click
2536 (this includes modeline extents);
2537 - the modeline-map of the buffer corresponding to the modeline under
2538 the mouse (if the click happened over a modeline);
2539 - the value of toolbar-map in the current-buffer (if the click
2540 happened over a toolbar);
2541 - the current-local-map of the buffer under the mouse (does not
2542 apply to toolbar clicks);
2543 - any applicable minor-mode maps;
2544 - the current global map.
2546 Note that if `overriding-local-map' or `overriding-terminal-local-map'
2547 is non-nil, *only* those two maps and the current global map are searched.
2549 (keys, accept_default))
2551 /* This function can GC */
2553 Lisp_Object maps[100];
2555 struct gcpro gcpro1, gcpro2;
2556 GCPRO2 (keys, accept_default); /* get_relevant_keymaps may autoload */
2558 nmaps = get_relevant_keymaps (keys, countof (maps), maps);
2562 if (EVENTP (keys)) /* unadvertised "feature" for the future */
2563 return lookup_events (keys, nmaps, maps, !NILP (accept_default));
2565 for (i = 0; i < nmaps; i++)
2567 Lisp_Object tem = Flookup_key (maps[i], keys,
2571 /* Too long in some local map means don't look at global map */
2574 else if (!NILP (tem))
2581 process_event_binding_result (Lisp_Object result)
2583 if (EQ (result, Qundefined))
2584 /* The suppress-keymap function binds keys to 'undefined - special-case
2585 that here, so that being bound to that has the same error-behavior as
2586 not being defined at all.
2592 /* Snap out possible keymap indirections */
2593 map = get_keymap (result, 0, 1);
2601 /* Attempts to find a command corresponding to the event-sequence
2602 whose head is event0 (sequence is threaded though event_next).
2604 The return value will be
2606 -- nil (there is no binding; this will also be returned
2607 whenever the event chain is "too long", i.e. there
2608 is a non-nil, non-keymap binding for a prefix of
2610 -- a keymap (part of a command has been specified)
2611 -- a command (anything that satisfies `commandp'; this includes
2612 some symbols, lists, subrs, strings, vectors, and
2613 compiled-function objects) */
2615 event_binding (Lisp_Object event0, int accept_default)
2617 /* This function can GC */
2618 Lisp_Object maps[100];
2621 assert (EVENTP (event0));
2623 nmaps = get_relevant_keymaps (event0, countof (maps), maps);
2624 if (nmaps > countof (maps))
2625 nmaps = countof (maps);
2626 return process_event_binding_result (lookup_events (event0, nmaps, maps,
2630 /* like event_binding, but specify a keymap to search */
2633 event_binding_in (Lisp_Object event0, Lisp_Object keymap, int accept_default)
2635 /* This function can GC */
2636 if (!KEYMAPP (keymap))
2639 return process_event_binding_result (lookup_events (event0, 1, &keymap,
2643 /* Attempts to find a function key mapping corresponding to the
2644 event-sequence whose head is event0 (sequence is threaded through
2645 event_next). The return value will be the same as for event_binding(). */
2647 munging_key_map_event_binding (Lisp_Object event0,
2648 enum munge_me_out_the_door munge)
2650 Lisp_Object keymap = (munge == MUNGE_ME_FUNCTION_KEY) ?
2651 CONSOLE_FUNCTION_KEY_MAP (event_console_or_selected (event0)) :
2652 Vkey_translation_map;
2657 return process_event_binding_result (lookup_events (event0, 1, &keymap, 1));
2661 /************************************************************************/
2662 /* Setting/querying the global and local maps */
2663 /************************************************************************/
2665 DEFUN ("use-global-map", Fuse_global_map, 1, 1, 0, /*
2666 Select KEYMAP as the global keymap.
2670 /* This function can GC */
2671 keymap = get_keymap (keymap, 1, 1);
2672 Vcurrent_global_map = keymap;
2676 DEFUN ("use-local-map", Fuse_local_map, 1, 2, 0, /*
2677 Select KEYMAP as the local keymap in BUFFER.
2678 If KEYMAP is nil, that means no local keymap.
2679 If BUFFER is nil, the current buffer is assumed.
2683 /* This function can GC */
2684 struct buffer *b = decode_buffer (buffer, 0);
2686 keymap = get_keymap (keymap, 1, 1);
2693 DEFUN ("current-local-map", Fcurrent_local_map, 0, 1, 0, /*
2694 Return BUFFER's local keymap, or nil if it has none.
2695 If BUFFER is nil, the current buffer is assumed.
2699 struct buffer *b = decode_buffer (buffer, 0);
2703 DEFUN ("current-global-map", Fcurrent_global_map, 0, 0, 0, /*
2704 Return the current global keymap.
2708 return Vcurrent_global_map;
2712 /************************************************************************/
2713 /* Mapping over keymap elements */
2714 /************************************************************************/
2716 /* Since keymaps are arranged in a hierarchy, one keymap per bucky bit or
2717 prefix key, it's not entirely obvious what map-keymap should do, but
2718 what it does is: map over all keys in this map; then recursively map
2719 over all submaps of this map that are "bucky" submaps. This means that,
2720 when mapping over a keymap, it appears that "x" and "C-x" are in the
2721 same map, although "C-x" is really in the "control" submap of this one.
2722 However, since we don't recursively descend the submaps that are bound
2723 to prefix keys (like C-x, C-h, etc) the caller will have to recurse on
2724 those explicitly, if that's what they want.
2726 So the end result of this is that the bucky keymaps (the ones indexed
2727 under the large integers returned from MAKE_MODIFIER_HASH_KEY()) are
2728 invisible from elisp. They're just an implementation detail that code
2729 outside of this file doesn't need to know about.
2732 struct map_keymap_unsorted_closure
2734 void (*fn) (const struct key_data *, Lisp_Object binding, void *arg);
2739 /* used by map_keymap() */
2741 map_keymap_unsorted_mapper (Lisp_Object keysym, Lisp_Object value,
2742 void *map_keymap_unsorted_closure)
2744 /* This function can GC */
2745 struct map_keymap_unsorted_closure *closure =
2746 (struct map_keymap_unsorted_closure *) map_keymap_unsorted_closure;
2747 int modifiers = closure->modifiers;
2749 mod_bit = MODIFIER_HASH_KEY_BITS (keysym);
2752 int omod = modifiers;
2753 closure->modifiers = (modifiers | mod_bit);
2754 value = get_keymap (value, 1, 0);
2755 elisp_maphash (map_keymap_unsorted_mapper,
2756 XKEYMAP (value)->table,
2757 map_keymap_unsorted_closure);
2758 closure->modifiers = omod;
2762 struct key_data key;
2763 key.keysym = keysym;
2764 key.modifiers = modifiers;
2765 ((*closure->fn) (&key, value, closure->arg));
2771 struct map_keymap_sorted_closure
2773 Lisp_Object *result_locative;
2776 /* used by map_keymap_sorted() */
2778 map_keymap_sorted_mapper (Lisp_Object key, Lisp_Object value,
2779 void *map_keymap_sorted_closure)
2781 struct map_keymap_sorted_closure *cl =
2782 (struct map_keymap_sorted_closure *) map_keymap_sorted_closure;
2783 Lisp_Object *list = cl->result_locative;
2784 *list = Fcons (Fcons (key, value), *list);
2789 /* used by map_keymap_sorted(), describe_map_sort_predicate(),
2790 and keymap_submaps().
2793 map_keymap_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
2796 /* obj1 and obj2 are conses with keysyms in their cars. Cdrs are ignored.
2804 if (EQ (obj1, obj2))
2806 bit1 = MODIFIER_HASH_KEY_BITS (obj1);
2807 bit2 = MODIFIER_HASH_KEY_BITS (obj2);
2809 /* If either is a symbol with a character-set-property, then sort it by
2810 that code instead of alphabetically.
2812 if (! bit1 && SYMBOLP (obj1))
2814 Lisp_Object code = Fget (obj1, Vcharacter_set_property, Qnil);
2815 if (CHAR_OR_CHAR_INTP (code))
2818 CHECK_CHAR_COERCE_INT (obj1);
2822 if (! bit2 && SYMBOLP (obj2))
2824 Lisp_Object code = Fget (obj2, Vcharacter_set_property, Qnil);
2825 if (CHAR_OR_CHAR_INTP (code))
2828 CHECK_CHAR_COERCE_INT (obj2);
2833 /* all symbols (non-ASCIIs) come after characters (ASCIIs) */
2834 if (XTYPE (obj1) != XTYPE (obj2))
2835 return SYMBOLP (obj2) ? 1 : -1;
2837 if (! bit1 && CHARP (obj1)) /* they're both ASCII */
2839 int o1 = XCHAR (obj1);
2840 int o2 = XCHAR (obj2);
2841 if (o1 == o2 && /* If one started out as a symbol and the */
2842 sym1_p != sym2_p) /* other didn't, the symbol comes last. */
2843 return sym2_p ? 1 : -1;
2845 return o1 < o2 ? 1 : -1; /* else just compare them */
2848 /* else they're both symbols. If they're both buckys, then order them. */
2850 return bit1 < bit2 ? 1 : -1;
2852 /* if only one is a bucky, then it comes later */
2854 return bit2 ? 1 : -1;
2856 /* otherwise, string-sort them. */
2858 char *s1 = (char *) string_data (XSYMBOL (obj1)->name);
2859 char *s2 = (char *) string_data (XSYMBOL (obj2)->name);
2861 return 0 > strcoll (s1, s2) ? 1 : -1;
2863 return 0 > strcmp (s1, s2) ? 1 : -1;
2869 /* used by map_keymap() */
2871 map_keymap_sorted (Lisp_Object keymap_table,
2873 void (*function) (const struct key_data *key,
2874 Lisp_Object binding,
2875 void *map_keymap_sorted_closure),
2876 void *map_keymap_sorted_closure)
2878 /* This function can GC */
2879 struct gcpro gcpro1;
2880 Lisp_Object contents = Qnil;
2882 if (XINT (Fhash_table_count (keymap_table)) == 0)
2888 struct map_keymap_sorted_closure c1;
2889 c1.result_locative = &contents;
2890 elisp_maphash (map_keymap_sorted_mapper, keymap_table, &c1);
2892 contents = list_sort (contents, Qnil, map_keymap_sort_predicate);
2893 for (; !NILP (contents); contents = XCDR (contents))
2895 Lisp_Object keysym = XCAR (XCAR (contents));
2896 Lisp_Object binding = XCDR (XCAR (contents));
2897 int sub_bits = MODIFIER_HASH_KEY_BITS (keysym);
2899 map_keymap_sorted (XKEYMAP (get_keymap (binding,
2901 (modifiers | sub_bits),
2903 map_keymap_sorted_closure);
2908 k.modifiers = modifiers;
2909 ((*function) (&k, binding, map_keymap_sorted_closure));
2916 /* used by Fmap_keymap() */
2918 map_keymap_mapper (const struct key_data *key,
2919 Lisp_Object binding,
2922 /* This function can GC */
2924 VOID_TO_LISP (fn, function);
2925 call2 (fn, make_key_description (key, 1), binding);
2930 map_keymap (Lisp_Object keymap_table, int sort_first,
2931 void (*function) (const struct key_data *key,
2932 Lisp_Object binding,
2936 /* This function can GC */
2938 map_keymap_sorted (keymap_table, 0, function, fn_arg);
2941 struct map_keymap_unsorted_closure map_keymap_unsorted_closure;
2942 map_keymap_unsorted_closure.fn = function;
2943 map_keymap_unsorted_closure.arg = fn_arg;
2944 map_keymap_unsorted_closure.modifiers = 0;
2945 elisp_maphash (map_keymap_unsorted_mapper, keymap_table,
2946 &map_keymap_unsorted_closure);
2950 DEFUN ("map-keymap", Fmap_keymap, 2, 3, 0, /*
2951 Apply FUNCTION to each element of KEYMAP.
2952 FUNCTION will be called with two arguments: a key-description list, and
2953 the binding. The order in which the elements of the keymap are passed to
2954 the function is unspecified. If the function inserts new elements into
2955 the keymap, it may or may not be called with them later. No element of
2956 the keymap will ever be passed to the function more than once.
2958 The function will not be called on elements of this keymap's parents
2959 \(see the function `keymap-parents') or upon keymaps which are contained
2960 within this keymap (multi-character definitions).
2961 It will be called on "meta" characters since they are not really
2962 two-character sequences.
2964 If the optional third argument SORT-FIRST is non-nil, then the elements of
2965 the keymap will be passed to the mapper function in a canonical order.
2966 Otherwise, they will be passed in hash (that is, random) order, which is
2969 (function, keymap, sort_first))
2971 /* This function can GC */
2972 struct gcpro gcpro1, gcpro2;
2974 /* tolerate obviously transposed args */
2975 if (!NILP (Fkeymapp (function)))
2977 Lisp_Object tmp = function;
2981 GCPRO2 (function, keymap);
2982 keymap = get_keymap (keymap, 1, 1);
2983 map_keymap (XKEYMAP (keymap)->table, !NILP (sort_first),
2984 map_keymap_mapper, LISP_TO_VOID (function));
2991 /************************************************************************/
2992 /* Accessible keymaps */
2993 /************************************************************************/
2995 struct accessible_keymaps_closure
3002 accessible_keymaps_mapper_1 (Lisp_Object keysym, Lisp_Object contents,
3004 struct accessible_keymaps_closure *closure)
3006 /* This function can GC */
3007 int subbits = MODIFIER_HASH_KEY_BITS (keysym);
3011 Lisp_Object submaps;
3013 contents = get_keymap (contents, 1, 1);
3014 submaps = keymap_submaps (contents);
3015 for (; !NILP (submaps); submaps = XCDR (submaps))
3017 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3018 XCDR (XCAR (submaps)),
3019 (subbits | modifiers),
3025 Lisp_Object thisseq = Fcar (Fcar (closure->tail));
3026 Lisp_Object cmd = get_keyelt (contents, 1);
3030 struct key_data key;
3031 key.keysym = keysym;
3032 key.modifiers = modifiers;
3036 cmd = get_keymap (cmd, 0, 1);
3040 vec = make_vector (XVECTOR_LENGTH (thisseq) + 1, Qnil);
3041 len = XVECTOR_LENGTH (thisseq);
3042 for (j = 0; j < len; j++)
3043 XVECTOR_DATA (vec) [j] = XVECTOR_DATA (thisseq) [j];
3044 XVECTOR_DATA (vec) [j] = make_key_description (&key, 1);
3046 nconc2 (closure->tail, list1 (Fcons (vec, cmd)));
3052 accessible_keymaps_keymap_mapper (Lisp_Object thismap, void *arg)
3054 /* This function can GC */
3055 struct accessible_keymaps_closure *closure =
3056 (struct accessible_keymaps_closure *) arg;
3057 Lisp_Object submaps = keymap_submaps (thismap);
3059 for (; !NILP (submaps); submaps = XCDR (submaps))
3061 accessible_keymaps_mapper_1 (XCAR (XCAR (submaps)),
3062 XCDR (XCAR (submaps)),
3070 DEFUN ("accessible-keymaps", Faccessible_keymaps, 1, 2, 0, /*
3071 Find all keymaps accessible via prefix characters from KEYMAP.
3072 Returns a list of elements of the form (KEYS . MAP), where the sequence
3073 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
3074 so that the KEYS increase in length. The first element is ([] . KEYMAP).
3075 An optional argument PREFIX, if non-nil, should be a key sequence;
3076 then the value includes only maps for prefixes that start with PREFIX.
3080 /* This function can GC */
3081 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3082 Lisp_Object accessible_keymaps = Qnil;
3083 struct accessible_keymaps_closure c;
3085 GCPRO4 (accessible_keymaps, c.tail, prefix, keymap);
3087 keymap = get_keymap (keymap, 1, 1);
3092 prefix = make_vector (0, Qnil);
3094 else if (VECTORP (prefix) || STRINGP (prefix))
3096 int len = XINT (Flength (prefix));
3100 struct gcpro ngcpro1;
3108 def = Flookup_key (keymap, prefix, Qnil);
3109 def = get_keymap (def, 0, 1);
3114 p = make_vector (len, Qnil);
3116 for (iii = 0; iii < len; iii++)
3118 struct key_data key;
3119 define_key_parser (Faref (prefix, make_int (iii)), &key);
3120 XVECTOR_DATA (p)[iii] = make_key_description (&key, 1);
3127 prefix = wrong_type_argument (Qarrayp, prefix);
3131 accessible_keymaps = list1 (Fcons (prefix, keymap));
3133 /* For each map in the list maps, look at any other maps it points
3134 to and stick them at the end if they are not already in the list */
3136 for (c.tail = accessible_keymaps;
3138 c.tail = XCDR (c.tail))
3140 Lisp_Object thismap = Fcdr (Fcar (c.tail));
3141 CHECK_KEYMAP (thismap);
3142 traverse_keymaps (thismap, Qnil,
3143 accessible_keymaps_keymap_mapper, &c);
3147 return accessible_keymaps;
3152 /************************************************************************/
3153 /* Pretty descriptions of key sequences */
3154 /************************************************************************/
3156 DEFUN ("key-description", Fkey_description, 1, 1, 0, /*
3157 Return a pretty description of key-sequence KEYS.
3158 Control characters turn into "C-foo" sequences, meta into "M-foo",
3159 spaces are put between sequence elements, etc...
3163 if (CHAR_OR_CHAR_INTP (keys) || CONSP (keys) || SYMBOLP (keys)
3166 return Fsingle_key_description (keys);
3168 else if (VECTORP (keys) ||
3171 Lisp_Object string = Qnil;
3172 /* Lisp_Object sep = Qnil; */
3173 int size = XINT (Flength (keys));
3176 for (i = 0; i < size; i++)
3178 Lisp_Object s2 = Fsingle_key_description
3180 ? make_char (string_char (XSTRING (keys), i))
3181 : XVECTOR_DATA (keys)[i]);
3187 /* if (NILP (sep)) Lisp_Object sep = build_string (" ") */;
3188 string = concat2 (string, concat2 (Vsingle_space_string, s2));
3193 return Fkey_description (wrong_type_argument (Qsequencep, keys));
3196 DEFUN ("single-key-description", Fsingle_key_description, 1, 1, 0, /*
3197 Return a pretty description of command character KEY.
3198 Control characters turn into C-whatever, etc.
3199 This differs from `text-char-description' in that it returns a description
3200 of a key read from the user rather than a character from a buffer.
3205 key = Fcons (key, Qnil); /* sleaze sleaze */
3207 if (EVENTP (key) || CHAR_OR_CHAR_INTP (key))
3213 event.event_type = empty_event;
3214 CHECK_CHAR_COERCE_INT (key);
3215 character_to_event (XCHAR (key), &event,
3216 XCONSOLE (Vselected_console), 0, 1);
3217 format_event_object (buf, &event, 1);
3220 format_event_object (buf, XEVENT (key), 1);
3221 return build_string (buf);
3230 LIST_LOOP (rest, key)
3232 Lisp_Object keysym = XCAR (rest);
3233 if (EQ (keysym, Qcontrol)) strcpy (bufp, "C-"), bufp += 2;
3234 else if (EQ (keysym, Qctrl)) strcpy (bufp, "C-"), bufp += 2;
3235 else if (EQ (keysym, Qmeta)) strcpy (bufp, "M-"), bufp += 2;
3236 else if (EQ (keysym, Qsuper)) strcpy (bufp, "S-"), bufp += 2;
3237 else if (EQ (keysym, Qhyper)) strcpy (bufp, "H-"), bufp += 2;
3238 else if (EQ (keysym, Qalt)) strcpy (bufp, "A-"), bufp += 2;
3239 else if (EQ (keysym, Qshift)) strcpy (bufp, "Sh-"), bufp += 3;
3240 else if (CHAR_OR_CHAR_INTP (keysym))
3242 bufp += set_charptr_emchar ((Bufbyte *) bufp,
3243 XCHAR_OR_CHAR_INT (keysym));
3248 CHECK_SYMBOL (keysym);
3249 #if 0 /* This is bogus */
3250 if (EQ (keysym, QKlinefeed)) strcpy (bufp, "LFD");
3251 else if (EQ (keysym, QKtab)) strcpy (bufp, "TAB");
3252 else if (EQ (keysym, QKreturn)) strcpy (bufp, "RET");
3253 else if (EQ (keysym, QKescape)) strcpy (bufp, "ESC");
3254 else if (EQ (keysym, QKdelete)) strcpy (bufp, "DEL");
3255 else if (EQ (keysym, QKspace)) strcpy (bufp, "SPC");
3256 else if (EQ (keysym, QKbackspace)) strcpy (bufp, "BS");
3259 strcpy (bufp, (char *) string_data (XSYMBOL (keysym)->name));
3260 if (!NILP (XCDR (rest)))
3261 signal_simple_error ("Invalid key description",
3265 return build_string (buf);
3267 return Fsingle_key_description
3268 (wrong_type_argument (intern ("char-or-event-p"), key));
3271 DEFUN ("text-char-description", Ftext_char_description, 1, 1, 0, /*
3272 Return a pretty description of file-character CHR.
3273 Unprintable characters turn into "^char" or \\NNN, depending on the value
3274 of the `ctl-arrow' variable.
3275 This differs from `single-key-description' in that it returns a description
3276 of a character from a buffer rather than a key read from the user.
3283 Lisp_Object ctl_arrow = current_buffer->ctl_arrow;
3284 int ctl_p = !NILP (ctl_arrow);
3285 Emchar printable_min = (CHAR_OR_CHAR_INTP (ctl_arrow)
3286 ? XCHAR_OR_CHAR_INT (ctl_arrow)
3287 : ((EQ (ctl_arrow, Qt) || NILP (ctl_arrow))
3292 Lisp_Object ch = Fevent_to_character (chr, Qnil, Qnil, Qt);
3295 signal_simple_continuable_error
3296 ("character has no ASCII equivalent", Fcopy_event (chr, Qnil));
3300 CHECK_CHAR_COERCE_INT (chr);
3305 if (c >= printable_min)
3307 p += set_charptr_emchar (p, c);
3309 else if (c < 040 && ctl_p)
3312 *p++ = c + 64; /* 'A' - 1 */
3319 else if (c >= 0200 || c < 040)
3323 /* !!#### This syntax is not readable. It will
3324 be interpreted as a 3-digit octal number rather
3325 than a 7-digit octal number. */
3328 *p++ = '0' + ((c & 07000000) >> 18);
3329 *p++ = '0' + ((c & 0700000) >> 15);
3330 *p++ = '0' + ((c & 070000) >> 12);
3331 *p++ = '0' + ((c & 07000) >> 9);
3334 *p++ = '0' + ((c & 0700) >> 6);
3335 *p++ = '0' + ((c & 0070) >> 3);
3336 *p++ = '0' + ((c & 0007));
3340 p += set_charptr_emchar (p, c);
3344 return build_string ((char *) buf);
3348 /************************************************************************/
3349 /* where-is (mapping bindings to keys) */
3350 /************************************************************************/
3353 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3354 Lisp_Object firstonly, char *target_buffer);
3356 DEFUN ("where-is-internal", Fwhere_is_internal, 1, 5, 0, /*
3357 Return list of keys that invoke DEFINITION in KEYMAPS.
3358 KEYMAPS can be either a keymap (meaning search in that keymap and the
3359 current global keymap) or a list of keymaps (meaning search in exactly
3360 those keymaps and no others). If KEYMAPS is nil, search in the currently
3361 applicable maps for EVENT-OR-KEYS (this is equivalent to specifying
3362 `(current-keymaps EVENT-OR-KEYS)' as the argument to KEYMAPS).
3364 If optional 3rd arg FIRSTONLY is non-nil, return a vector representing
3365 the first key sequence found, rather than a list of all possible key
3368 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
3369 to other keymaps or slots. This makes it possible to search for an
3370 indirect definition itself.
3372 (definition, keymaps, firstonly, noindirect, event_or_keys))
3374 /* This function can GC */
3375 Lisp_Object maps[100];
3376 Lisp_Object *gubbish = maps;
3379 /* Get keymaps as an array */
3382 nmaps = get_relevant_keymaps (event_or_keys, countof (maps),
3384 if (nmaps > countof (maps))
3386 gubbish = alloca_array (Lisp_Object, nmaps);
3387 nmaps = get_relevant_keymaps (event_or_keys, nmaps, gubbish);
3390 else if (CONSP (keymaps))
3395 nmaps = XINT (Flength (keymaps));
3396 if (nmaps > countof (maps))
3398 gubbish = alloca_array (Lisp_Object, nmaps);
3400 for (rest = keymaps, i = 0; !NILP (rest);
3401 rest = XCDR (keymaps), i++)
3403 gubbish[i] = get_keymap (XCAR (keymaps), 1, 1);
3409 gubbish[0] = get_keymap (keymaps, 1, 1);
3410 if (!EQ (gubbish[0], Vcurrent_global_map))
3412 gubbish[1] = Vcurrent_global_map;
3417 return where_is_internal (definition, gubbish, nmaps, firstonly, 0);
3420 /* This function is like
3421 (key-description (where-is-internal definition nil t))
3422 except that it writes its output into a (char *) buffer that you
3423 provide; it doesn't cons (or allocate memory) at all, so it's
3424 very fast. This is used by menubar.c.
3427 where_is_to_char (Lisp_Object definition, char *buffer)
3429 /* This function can GC */
3430 Lisp_Object maps[100];
3431 Lisp_Object *gubbish = maps;
3434 /* Get keymaps as an array */
3435 nmaps = get_relevant_keymaps (Qnil, countof (maps), gubbish);
3436 if (nmaps > countof (maps))
3438 gubbish = alloca_array (Lisp_Object, nmaps);
3439 nmaps = get_relevant_keymaps (Qnil, nmaps, gubbish);
3443 where_is_internal (definition, maps, nmaps, Qt, buffer);
3448 raw_keys_to_keys (struct key_data *keys, int count)
3450 Lisp_Object result = make_vector (count, Qnil);
3452 XVECTOR_DATA (result) [count] = make_key_description (&(keys[count]), 1);
3458 format_raw_keys (struct key_data *keys, int count, char *buf)
3462 event.event_type = key_press_event;
3463 event.channel = Vselected_console;
3464 for (i = 0; i < count; i++)
3466 event.event.key.keysym = keys[i].keysym;
3467 event.event.key.modifiers = keys[i].modifiers;
3468 format_event_object (buf, &event, 1);
3469 buf += strlen (buf);
3471 buf[0] = ' ', buf++;
3476 /* definition is the thing to look for.
3478 shadow is an array of shadow_count keymaps; if there is a different
3479 binding in any of the keymaps of a key that we are considering
3480 returning, then we reconsider.
3481 firstonly means give up after finding the first match;
3482 keys_so_far and modifiers_so_far describe which map we're looking in;
3483 If we're in the "meta" submap of the map that "C-x 4" is bound to,
3484 then keys_so_far will be {(control x), \4}, and modifiers_so_far
3485 will be XEMACS_MOD_META. That is, keys_so_far is the chain of keys that we
3486 have followed, and modifiers_so_far_so_far is the bits (partial keys)
3489 (keys_so_far is a global buffer and the keys_count arg says how much
3490 of it we're currently interested in.)
3492 If target_buffer is provided, then we write a key-description into it,
3493 to avoid consing a string. This only works with firstonly on.
3496 struct where_is_closure
3498 Lisp_Object definition;
3499 Lisp_Object *shadow;
3503 int modifiers_so_far;
3504 char *target_buffer;
3505 struct key_data *keys_so_far;
3506 int keys_so_far_total_size;
3507 int keys_so_far_malloced;
3510 static Lisp_Object where_is_recursive_mapper (Lisp_Object map, void *arg);
3513 where_is_recursive_mapper (Lisp_Object map, void *arg)
3515 /* This function can GC */
3516 struct where_is_closure *c = (struct where_is_closure *) arg;
3517 Lisp_Object definition = c->definition;
3518 const int firstonly = c->firstonly;
3519 const int keys_count = c->keys_count;
3520 const int modifiers_so_far = c->modifiers_so_far;
3521 char *target_buffer = c->target_buffer;
3522 Lisp_Object keys = Fgethash (definition,
3523 XKEYMAP (map)->inverse_table,
3525 Lisp_Object submaps;
3526 Lisp_Object result = Qnil;
3530 /* One or more keys in this map match the definition we're looking for.
3531 Verify that these bindings aren't shadowed by other bindings
3532 in the shadow maps. Either nil or number as value from
3533 raw_lookup_key() means undefined. */
3534 struct key_data *so_far = c->keys_so_far;
3536 for (;;) /* loop over all keys that match */
3538 Lisp_Object k = CONSP (keys) ? XCAR (keys) : keys;
3541 so_far [keys_count].keysym = k;
3542 so_far [keys_count].modifiers = modifiers_so_far;
3544 /* now loop over all shadow maps */
3545 for (i = 0; i < c->shadow_count; i++)
3547 Lisp_Object shadowed = raw_lookup_key (c->shadow[i],
3552 if (NILP (shadowed) || CHARP (shadowed) ||
3553 EQ (shadowed, definition))
3554 continue; /* we passed this test; it's not shadowed here. */
3556 /* ignore this key binding, since it actually has a
3557 different binding in a shadowing map */
3558 goto c_doesnt_have_proper_loop_exit_statements;
3561 /* OK, the key is for real */
3564 if (!firstonly) abort ();
3565 format_raw_keys (so_far, keys_count + 1, target_buffer);
3566 return make_int (1);
3569 return raw_keys_to_keys (so_far, keys_count + 1);
3571 result = Fcons (raw_keys_to_keys (so_far, keys_count + 1),
3574 c_doesnt_have_proper_loop_exit_statements:
3575 /* now on to the next matching key ... */
3576 if (!CONSP (keys)) break;
3581 /* Now search the sub-keymaps of this map.
3582 If we're in "firstonly" mode and have already found one, this
3583 point is not reached. If we get one from lower down, either
3584 return it immediately (in firstonly mode) or tack it onto the
3585 end of the ones we've gotten so far.
3587 for (submaps = keymap_submaps (map);
3589 submaps = XCDR (submaps))
3591 Lisp_Object key = XCAR (XCAR (submaps));
3592 Lisp_Object submap = XCDR (XCAR (submaps));
3593 int lower_modifiers;
3594 int lower_keys_count = keys_count;
3597 submap = get_keymap (submap, 0, 0);
3599 if (EQ (submap, map))
3600 /* Arrgh! Some loser has introduced a loop... */
3603 /* If this is not a keymap, then that's probably because someone
3604 did an `fset' of a symbol that used to point to a map such that
3605 it no longer does. Sigh. Ignore this, and invalidate the cache
3606 so that it doesn't happen to us next time too.
3610 XKEYMAP (map)->sub_maps_cache = Qt;
3614 /* If the map is a "bucky" map, then add a bit to the
3615 modifiers_so_far list.
3616 Otherwise, add a new raw_key onto the end of keys_so_far.
3618 bucky = MODIFIER_HASH_KEY_BITS (key);
3620 lower_modifiers = (modifiers_so_far | bucky);
3623 struct key_data *so_far = c->keys_so_far;
3624 lower_modifiers = 0;
3625 so_far [lower_keys_count].keysym = key;
3626 so_far [lower_keys_count].modifiers = modifiers_so_far;
3630 if (lower_keys_count >= c->keys_so_far_total_size)
3632 int size = lower_keys_count + 50;
3633 if (! c->keys_so_far_malloced)
3635 struct key_data *new = xnew_array (struct key_data, size);
3636 memcpy ((void *)new, (const void *)c->keys_so_far,
3637 c->keys_so_far_total_size * sizeof (struct key_data));
3640 XREALLOC_ARRAY (c->keys_so_far, struct key_data, size);
3642 c->keys_so_far_total_size = size;
3643 c->keys_so_far_malloced = 1;
3649 c->keys_count = lower_keys_count;
3650 c->modifiers_so_far = lower_modifiers;
3652 lower = traverse_keymaps (submap, Qnil, where_is_recursive_mapper, c);
3654 c->keys_count = keys_count;
3655 c->modifiers_so_far = modifiers_so_far;
3658 result = nconc2 (lower, result);
3659 else if (!NILP (lower))
3668 where_is_internal (Lisp_Object definition, Lisp_Object *maps, int nmaps,
3669 Lisp_Object firstonly, char *target_buffer)
3671 /* This function can GC */
3672 Lisp_Object result = Qnil;
3674 struct key_data raw[20];
3675 struct where_is_closure c;
3677 c.definition = definition;
3679 c.firstonly = !NILP (firstonly);
3680 c.target_buffer = target_buffer;
3681 c.keys_so_far = raw;
3682 c.keys_so_far_total_size = countof (raw);
3683 c.keys_so_far_malloced = 0;
3685 /* Loop over each of the maps, accumulating the keys found.
3686 For each map searched, all previous maps shadow this one
3687 so that bogus keys aren't listed. */
3688 for (i = 0; i < nmaps; i++)
3690 Lisp_Object this_result;
3692 /* Reset the things set in each iteration */
3694 c.modifiers_so_far = 0;
3696 this_result = traverse_keymaps (maps[i], Qnil, where_is_recursive_mapper,
3698 if (!NILP (firstonly))
3700 result = this_result;
3705 result = nconc2 (this_result, result);
3708 if (NILP (firstonly))
3709 result = Fnreverse (result);
3711 if (c.keys_so_far_malloced)
3712 xfree (c.keys_so_far);
3717 /************************************************************************/
3718 /* Describing keymaps */
3719 /************************************************************************/
3721 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, 1, 5, 0, /*
3722 Insert a list of all defined keys and their definitions in MAP.
3723 Optional second argument ALL says whether to include even "uninteresting"
3724 definitions (ie symbols with a non-nil `suppress-keymap' property.
3725 Third argument SHADOW is a list of keymaps whose bindings shadow those
3726 of map; if a binding is present in any shadowing map, it is not printed.
3727 Fourth argument PREFIX, if non-nil, should be a key sequence;
3728 only bindings which start with that key sequence will be printed.
3729 Fifth argument MOUSE-ONLY-P says to only print bindings for mouse clicks.
3731 (map, all, shadow, prefix, mouse_only_p))
3733 /* This function can GC */
3735 /* #### At some point, this function should be changed to accept a
3736 BUFFER argument. Currently, the BUFFER argument to
3737 describe_map_tree is being used only internally. */
3738 describe_map_tree (map, NILP (all), shadow, prefix,
3739 !NILP (mouse_only_p), Fcurrent_buffer ());
3744 /* Insert a description of the key bindings in STARTMAP,
3745 followed by those of all maps reachable through STARTMAP.
3746 If PARTIAL is nonzero, omit certain "uninteresting" commands
3747 (such as `undefined').
3748 If SHADOW is non-nil, it is a list of other maps;
3749 don't mention keys which would be shadowed by any of them
3750 If PREFIX is non-nil, only list bindings which start with those keys.
3754 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3755 Lisp_Object prefix, int mice_only_p, Lisp_Object buffer)
3757 /* This function can GC */
3758 Lisp_Object maps = Qnil;
3759 struct gcpro gcpro1, gcpro2; /* get_keymap may autoload */
3760 GCPRO2 (maps, shadow);
3762 maps = Faccessible_keymaps (startmap, prefix);
3764 for (; !NILP (maps); maps = Fcdr (maps))
3766 Lisp_Object sub_shadow = Qnil;
3767 Lisp_Object elt = Fcar (maps);
3769 int no_prefix = (VECTORP (Fcar (elt))
3770 && XINT (Flength (Fcar (elt))) == 0);
3771 struct gcpro ngcpro1, ngcpro2, ngcpro3;
3772 NGCPRO3 (sub_shadow, elt, tail);
3774 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3776 Lisp_Object shmap = XCAR (tail);
3778 /* If the sequence by which we reach this keymap is zero-length,
3779 then the shadow maps for this keymap are just SHADOW. */
3782 /* If the sequence by which we reach this keymap actually has
3783 some elements, then the sequence's definition in SHADOW is
3784 what we should use. */
3787 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3794 Lisp_Object shm = get_keymap (shmap, 0, 1);
3795 /* If shmap is not nil and not a keymap, it completely
3796 shadows this map, so don't describe this map at all. */
3799 sub_shadow = Fcons (shm, sub_shadow);
3804 /* Describe the contents of map MAP, assuming that this map
3805 itself is reached by the sequence of prefix keys KEYS (a vector).
3806 PARTIAL and SHADOW are as in `describe_map_tree'. */
3807 Lisp_Object keysdesc
3809 ? concat2 (Fkey_description (Fcar (elt)), Vsingle_space_string)
3811 describe_map (Fcdr (elt), keysdesc,
3826 describe_command (Lisp_Object definition, Lisp_Object buffer)
3828 /* This function can GC */
3829 int keymapp = !NILP (Fkeymapp (definition));
3830 struct gcpro gcpro1;
3831 GCPRO1 (definition);
3833 Findent_to (make_int (16), make_int (3), buffer);
3835 buffer_insert_c_string (XBUFFER (buffer), "<< ");
3837 if (SYMBOLP (definition))
3839 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (definition));
3841 else if (STRINGP (definition) || VECTORP (definition))
3843 buffer_insert_c_string (XBUFFER (buffer), "Kbd Macro: ");
3844 buffer_insert1 (XBUFFER (buffer), Fkey_description (definition));
3846 else if (COMPILED_FUNCTIONP (definition))
3847 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Compiled Function");
3848 else if (CONSP (definition) && EQ (XCAR (definition), Qlambda))
3849 buffer_insert_c_string (XBUFFER (buffer), "Anonymous Lambda");
3850 else if (KEYMAPP (definition))
3852 Lisp_Object name = XKEYMAP (definition)->name;
3853 if (STRINGP (name) || (SYMBOLP (name) && !NILP (name)))
3855 buffer_insert_c_string (XBUFFER (buffer), "Prefix command ");
3857 && EQ (find_symbol_value (name), definition))
3858 buffer_insert1 (XBUFFER (buffer), Fsymbol_name (name));
3861 buffer_insert1 (XBUFFER (buffer), Fprin1_to_string (name, Qnil));
3865 buffer_insert_c_string (XBUFFER (buffer), "Prefix Command");
3868 buffer_insert_c_string (XBUFFER (buffer), "??");
3871 buffer_insert_c_string (XBUFFER (buffer), " >>");
3872 buffer_insert_c_string (XBUFFER (buffer), "\n");
3876 struct describe_map_closure
3878 Lisp_Object *list; /* pointer to the list to update */
3879 Lisp_Object partial; /* whether to ignore suppressed commands */
3880 Lisp_Object shadow; /* list of maps shadowing this one */
3881 Lisp_Object self; /* this map */
3882 Lisp_Object self_root; /* this map, or some map that has this map as
3883 a parent. this is the base of the tree */
3884 int mice_only_p; /* whether we are to display only button bindings */
3887 struct describe_map_shadow_closure
3889 const struct key_data *raw_key;
3894 describe_map_mapper_shadow_search (Lisp_Object map, void *arg)
3896 struct describe_map_shadow_closure *c =
3897 (struct describe_map_shadow_closure *) arg;
3899 if (EQ (map, c->self))
3900 return Qzero; /* Not shadowed; terminate search */
3902 return !NILP (keymap_lookup_directly (map,
3904 c->raw_key->modifiers))
3910 keymap_lookup_inherited_mapper (Lisp_Object km, void *arg)
3912 struct key_data *k = (struct key_data *) arg;
3913 return keymap_lookup_directly (km, k->keysym, k->modifiers);
3918 describe_map_mapper (const struct key_data *key,
3919 Lisp_Object binding,
3920 void *describe_map_closure)
3922 /* This function can GC */
3923 struct describe_map_closure *closure =
3924 (struct describe_map_closure *) describe_map_closure;
3925 Lisp_Object keysym = key->keysym;
3926 int modifiers = key->modifiers;
3928 /* Don't mention suppressed commands. */
3929 if (SYMBOLP (binding)
3930 && !NILP (closure->partial)
3931 && !NILP (Fget (binding, closure->partial, Qnil)))
3934 /* If we're only supposed to display mouse bindings and this isn't one,
3936 if (closure->mice_only_p &&
3937 (! (EQ (keysym, Qbutton0) ||
3938 EQ (keysym, Qbutton1) ||
3939 EQ (keysym, Qbutton2) ||
3940 EQ (keysym, Qbutton3) ||
3941 EQ (keysym, Qbutton4) ||
3942 EQ (keysym, Qbutton5) ||
3943 EQ (keysym, Qbutton6) ||
3944 EQ (keysym, Qbutton7) ||
3945 EQ (keysym, Qbutton0up) ||
3946 EQ (keysym, Qbutton1up) ||
3947 EQ (keysym, Qbutton2up) ||
3948 EQ (keysym, Qbutton3up) ||
3949 EQ (keysym, Qbutton4up) ||
3950 EQ (keysym, Qbutton5up) ||
3951 EQ (keysym, Qbutton6up) ||
3952 EQ (keysym, Qbutton7up))))
3955 /* If this command in this map is shadowed by some other map, ignore it. */
3959 for (tail = closure->shadow; CONSP (tail); tail = XCDR (tail))
3962 if (!NILP (traverse_keymaps (XCAR (tail), Qnil,
3963 keymap_lookup_inherited_mapper,
3964 /* Cast to discard `const' */
3970 /* If this key is in some map of which this map is a parent, then ignore
3971 it (in that case, it has been shadowed).
3975 struct describe_map_shadow_closure c;
3977 c.self = closure->self;
3979 sh = traverse_keymaps (closure->self_root, Qnil,
3980 describe_map_mapper_shadow_search, &c);
3981 if (!NILP (sh) && !ZEROP (sh))
3985 /* Otherwise add it to the list to be sorted. */
3986 *(closure->list) = Fcons (Fcons (Fcons (keysym, make_int (modifiers)),
3993 describe_map_sort_predicate (Lisp_Object obj1, Lisp_Object obj2,
3996 /* obj1 and obj2 are conses of the form
3997 ( ( <keysym> . <modifiers> ) . <binding> )
3998 keysym and modifiers are used, binding is ignored.
4003 bit1 = XINT (XCDR (obj1));
4004 bit2 = XINT (XCDR (obj2));
4006 return bit1 < bit2 ? 1 : -1;
4008 return map_keymap_sort_predicate (obj1, obj2, pred);
4011 /* Elide 2 or more consecutive numeric keysyms bound to the same thing,
4012 or 2 or more symbolic keysyms that are bound to the same thing and
4013 have consecutive character-set-properties.
4016 elide_next_two_p (Lisp_Object list)
4020 if (NILP (XCDR (list)))
4023 /* next two bindings differ */
4024 if (!EQ (XCDR (XCAR (list)),
4025 XCDR (XCAR (XCDR (list)))))
4028 /* next two modifier-sets differ */
4029 if (!EQ (XCDR (XCAR (XCAR (list))),
4030 XCDR (XCAR (XCAR (XCDR (list))))))
4033 s1 = XCAR (XCAR (XCAR (list)));
4034 s2 = XCAR (XCAR (XCAR (XCDR (list))));
4038 Lisp_Object code = Fget (s1, Vcharacter_set_property, Qnil);
4039 if (CHAR_OR_CHAR_INTP (code))
4042 CHECK_CHAR_COERCE_INT (s1);
4048 Lisp_Object code = Fget (s2, Vcharacter_set_property, Qnil);
4049 if (CHAR_OR_CHAR_INTP (code))
4052 CHECK_CHAR_COERCE_INT (s2);
4057 return (XCHAR (s1) == XCHAR (s2) ||
4058 XCHAR (s1) + 1 == XCHAR (s2));
4063 describe_map_parent_mapper (Lisp_Object keymap, void *arg)
4065 /* This function can GC */
4066 struct describe_map_closure *describe_map_closure =
4067 (struct describe_map_closure *) arg;
4068 describe_map_closure->self = keymap;
4069 map_keymap (XKEYMAP (keymap)->table,
4070 0, /* don't sort: we'll do it later */
4071 describe_map_mapper, describe_map_closure);
4076 /* Describe the contents of map MAP, assuming that this map itself is
4077 reached by the sequence of prefix keys KEYS (a string or vector).
4078 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
4081 describe_map (Lisp_Object keymap, Lisp_Object elt_prefix,
4082 void (*elt_describer) (Lisp_Object, Lisp_Object),
4088 /* This function can GC */
4089 struct describe_map_closure describe_map_closure;
4090 Lisp_Object list = Qnil;
4091 struct buffer *buf = XBUFFER (buffer);
4092 Emchar printable_min = (CHAR_OR_CHAR_INTP (buf->ctl_arrow)
4093 ? XCHAR_OR_CHAR_INT (buf->ctl_arrow)
4094 : ((EQ (buf->ctl_arrow, Qt)
4095 || EQ (buf->ctl_arrow, Qnil))
4098 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
4100 keymap = get_keymap (keymap, 1, 1);
4101 describe_map_closure.partial = (partial ? Qsuppress_keymap : Qnil);
4102 describe_map_closure.shadow = shadow;
4103 describe_map_closure.list = &list;
4104 describe_map_closure.self_root = keymap;
4105 describe_map_closure.mice_only_p = mice_only_p;
4107 GCPRO4 (keymap, elt_prefix, shadow, list);
4109 traverse_keymaps (keymap, Qnil,
4110 describe_map_parent_mapper, &describe_map_closure);
4114 list = list_sort (list, Qnil, describe_map_sort_predicate);
4115 buffer_insert_c_string (buf, "\n");
4116 while (!NILP (list))
4118 Lisp_Object elt = XCAR (XCAR (list));
4119 Lisp_Object keysym = XCAR (elt);
4120 int modifiers = XINT (XCDR (elt));
4122 if (!NILP (elt_prefix))
4123 buffer_insert_lisp_string (buf, elt_prefix);
4125 if (modifiers & XEMACS_MOD_META) buffer_insert_c_string (buf, "M-");
4126 if (modifiers & XEMACS_MOD_CONTROL) buffer_insert_c_string (buf, "C-");
4127 if (modifiers & XEMACS_MOD_SUPER) buffer_insert_c_string (buf, "S-");
4128 if (modifiers & XEMACS_MOD_HYPER) buffer_insert_c_string (buf, "H-");
4129 if (modifiers & XEMACS_MOD_ALT) buffer_insert_c_string (buf, "Alt-");
4130 if (modifiers & XEMACS_MOD_SHIFT) buffer_insert_c_string (buf, "Sh-");
4131 if (SYMBOLP (keysym))
4133 Lisp_Object code = Fget (keysym, Vcharacter_set_property, Qnil);
4134 Emchar c = (CHAR_OR_CHAR_INTP (code)
4135 ? XCHAR_OR_CHAR_INT (code) : (Emchar) -1);
4136 /* Calling Fsingle_key_description() would cons more */
4137 #if 0 /* This is bogus */
4138 if (EQ (keysym, QKlinefeed))
4139 buffer_insert_c_string (buf, "LFD");
4140 else if (EQ (keysym, QKtab))
4141 buffer_insert_c_string (buf, "TAB");
4142 else if (EQ (keysym, QKreturn))
4143 buffer_insert_c_string (buf, "RET");
4144 else if (EQ (keysym, QKescape))
4145 buffer_insert_c_string (buf, "ESC");
4146 else if (EQ (keysym, QKdelete))
4147 buffer_insert_c_string (buf, "DEL");
4148 else if (EQ (keysym, QKspace))
4149 buffer_insert_c_string (buf, "SPC");
4150 else if (EQ (keysym, QKbackspace))
4151 buffer_insert_c_string (buf, "BS");
4154 if (c >= printable_min)
4155 buffer_insert_emacs_char (buf, c);
4156 else buffer_insert1 (buf, Fsymbol_name (keysym));
4158 else if (CHARP (keysym))
4159 buffer_insert_emacs_char (buf, XCHAR (keysym));
4161 buffer_insert_c_string (buf, "---bad keysym---");
4169 while (elide_next_two_p (list))
4177 buffer_insert_c_string (buf, ", ");
4179 buffer_insert_c_string (buf, " .. ");
4185 /* Print a description of the definition of this character. */
4186 (*elt_describer) (XCDR (XCAR (list)), buffer);
4195 syms_of_keymap (void)
4197 INIT_LRECORD_IMPLEMENTATION (keymap);
4199 defsymbol (&Qminor_mode_map_alist, "minor-mode-map-alist");
4201 defsymbol (&Qkeymapp, "keymapp");
4203 defsymbol (&Qsuppress_keymap, "suppress-keymap");
4205 defsymbol (&Qmodeline_map, "modeline-map");
4206 defsymbol (&Qtoolbar_map, "toolbar-map");
4208 DEFSUBR (Fkeymap_parents);
4209 DEFSUBR (Fset_keymap_parents);
4210 DEFSUBR (Fkeymap_name);
4211 DEFSUBR (Fset_keymap_name);
4212 DEFSUBR (Fkeymap_prompt);
4213 DEFSUBR (Fset_keymap_prompt);
4214 DEFSUBR (Fkeymap_default_binding);
4215 DEFSUBR (Fset_keymap_default_binding);
4218 DEFSUBR (Fmake_keymap);
4219 DEFSUBR (Fmake_sparse_keymap);
4221 DEFSUBR (Fcopy_keymap);
4222 DEFSUBR (Fkeymap_fullness);
4223 DEFSUBR (Fmap_keymap);
4224 DEFSUBR (Fevent_matches_key_specifier_p);
4225 DEFSUBR (Fdefine_key);
4226 DEFSUBR (Flookup_key);
4227 DEFSUBR (Fkey_binding);
4228 DEFSUBR (Fuse_global_map);
4229 DEFSUBR (Fuse_local_map);
4230 DEFSUBR (Fcurrent_local_map);
4231 DEFSUBR (Fcurrent_global_map);
4232 DEFSUBR (Fcurrent_keymaps);
4233 DEFSUBR (Faccessible_keymaps);
4234 DEFSUBR (Fkey_description);
4235 DEFSUBR (Fsingle_key_description);
4236 DEFSUBR (Fwhere_is_internal);
4237 DEFSUBR (Fdescribe_bindings_internal);
4239 DEFSUBR (Ftext_char_description);
4241 defsymbol (&Qcontrol, "control");
4242 defsymbol (&Qctrl, "ctrl");
4243 defsymbol (&Qmeta, "meta");
4244 defsymbol (&Qsuper, "super");
4245 defsymbol (&Qhyper, "hyper");
4246 defsymbol (&Qalt, "alt");
4247 defsymbol (&Qshift, "shift");
4248 defsymbol (&Qbutton0, "button0");
4249 defsymbol (&Qbutton1, "button1");
4250 defsymbol (&Qbutton2, "button2");
4251 defsymbol (&Qbutton3, "button3");
4252 defsymbol (&Qbutton4, "button4");
4253 defsymbol (&Qbutton5, "button5");
4254 defsymbol (&Qbutton6, "button6");
4255 defsymbol (&Qbutton7, "button7");
4256 defsymbol (&Qbutton0up, "button0up");
4257 defsymbol (&Qbutton1up, "button1up");
4258 defsymbol (&Qbutton2up, "button2up");
4259 defsymbol (&Qbutton3up, "button3up");
4260 defsymbol (&Qbutton4up, "button4up");
4261 defsymbol (&Qbutton5up, "button5up");
4262 defsymbol (&Qbutton6up, "button6up");
4263 defsymbol (&Qbutton7up, "button7up");
4264 defsymbol (&Qmouse_1, "mouse-1");
4265 defsymbol (&Qmouse_2, "mouse-2");
4266 defsymbol (&Qmouse_3, "mouse-3");
4267 defsymbol (&Qmouse_4, "mouse-4");
4268 defsymbol (&Qmouse_5, "mouse-5");
4269 defsymbol (&Qdown_mouse_1, "down-mouse-1");
4270 defsymbol (&Qdown_mouse_2, "down-mouse-2");
4271 defsymbol (&Qdown_mouse_3, "down-mouse-3");
4272 defsymbol (&Qdown_mouse_4, "down-mouse-4");
4273 defsymbol (&Qdown_mouse_5, "down-mouse-5");
4274 defsymbol (&Qmenu_selection, "menu-selection");
4275 defsymbol (&QLFD, "LFD");
4276 defsymbol (&QTAB, "TAB");
4277 defsymbol (&QRET, "RET");
4278 defsymbol (&QESC, "ESC");
4279 defsymbol (&QDEL, "DEL");
4280 defsymbol (&QSPC, "SPC");
4281 defsymbol (&QBS, "BS");
4285 vars_of_keymap (void)
4287 DEFVAR_LISP ("meta-prefix-char", &Vmeta_prefix_char /*
4288 Meta-prefix character.
4289 This character followed by some character `foo' turns into `Meta-foo'.
4290 This can be any form recognized as a single key specifier.
4291 To disable the meta-prefix-char, set it to a negative number.
4293 Vmeta_prefix_char = make_char (033);
4295 DEFVAR_LISP ("mouse-grabbed-buffer", &Vmouse_grabbed_buffer /*
4296 A buffer which should be consulted first for all mouse activity.
4297 When a mouse-click is processed, it will first be looked up in the
4298 local-map of this buffer, and then through the normal mechanism if there
4299 is no binding for that click. This buffer's value of `mode-motion-hook'
4300 will be consulted instead of the `mode-motion-hook' of the buffer of the
4301 window under the mouse. You should *bind* this, not set it.
4303 Vmouse_grabbed_buffer = Qnil;
4305 DEFVAR_LISP ("overriding-local-map", &Voverriding_local_map /*
4306 Keymap that overrides all other local keymaps.
4307 If this variable is non-nil, it is used as a keymap instead of the
4308 buffer's local map, and the minor mode keymaps and extent-local keymaps.
4309 You should *bind* this, not set it.
4311 Voverriding_local_map = Qnil;
4313 Fset (Qminor_mode_map_alist, Qnil);
4315 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map /*
4316 Keymap of key translations that can override keymaps.
4317 This keymap works like `function-key-map', but comes after that,
4318 and applies even for keys that have ordinary bindings.
4320 Vkey_translation_map = Qnil;
4322 DEFVAR_LISP ("vertical-divider-map", &Vvertical_divider_map /*
4323 Keymap which handles mouse clicks over vertical dividers.
4325 Vvertical_divider_map = Qnil;
4327 DEFVAR_INT ("keymap-tick", &keymap_tick /*
4328 Incremented for each change to any keymap.
4332 staticpro (&Vcurrent_global_map);
4334 Vsingle_space_string = make_string ((const Bufbyte *) " ", 1);
4335 staticpro (&Vsingle_space_string);
4339 complex_vars_of_keymap (void)
4341 /* This function can GC */
4342 Lisp_Object ESC_prefix = intern ("ESC-prefix");
4343 Lisp_Object meta_disgustitute;
4345 Vcurrent_global_map = Fmake_keymap (Qnil);
4347 meta_disgustitute = Fmake_keymap (Qnil);
4348 Ffset (ESC_prefix, meta_disgustitute);
4349 /* no need to protect meta_disgustitute, though */
4350 keymap_store_internal (MAKE_MODIFIER_HASH_KEY (XEMACS_MOD_META),
4351 XKEYMAP (Vcurrent_global_map),
4353 XKEYMAP (Vcurrent_global_map)->sub_maps_cache = Qt;
4355 Vkey_translation_map = Fmake_sparse_keymap (intern ("key-translation-map"));