* insdel.c (count_size_as_multibyte): Check for string overflow.
[emacs.git] / src / keymap.c
blob79481833bde448d999e9f914c0f4ff456f942398
1 /* Manipulation of keymaps
2 Copyright (C) 1985-1988, 1993-1995, 1998-2011 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
20 #include <config.h>
21 #include <stdio.h>
22 #include <setjmp.h>
23 #include "lisp.h"
24 #include "commands.h"
25 #include "buffer.h"
26 #include "character.h"
27 #include "charset.h"
28 #include "keyboard.h"
29 #include "frame.h"
30 #include "termhooks.h"
31 #include "blockinput.h"
32 #include "puresize.h"
33 #include "intervals.h"
34 #include "keymap.h"
35 #include "window.h"
37 /* Actually allocate storage for these variables */
39 Lisp_Object current_global_map; /* Current global keymap */
41 Lisp_Object global_map; /* default global key bindings */
43 Lisp_Object meta_map; /* The keymap used for globally bound
44 ESC-prefixed default commands */
46 Lisp_Object control_x_map; /* The keymap used for globally bound
47 C-x-prefixed default commands */
49 /* The keymap used by the minibuf for local
50 bindings when spaces are allowed in the
51 minibuf */
53 /* The keymap used by the minibuf for local
54 bindings when spaces are not encouraged
55 in the minibuf */
57 /* keymap used for minibuffers when doing completion */
58 /* keymap used for minibuffers when doing completion and require a match */
59 static Lisp_Object Qkeymapp, Qnon_ascii;
60 Lisp_Object Qkeymap, Qmenu_item, Qremap;
61 static Lisp_Object QCadvertised_binding;
63 /* Alist of elements like (DEL . "\d"). */
64 static Lisp_Object exclude_keys;
66 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
67 static Lisp_Object command_remapping_vector;
69 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
70 static Lisp_Object where_is_cache;
71 /* Which keymaps are reverse-stored in the cache. */
72 static Lisp_Object where_is_cache_keymaps;
74 static Lisp_Object Flookup_key (Lisp_Object, Lisp_Object, Lisp_Object);
75 static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
76 static void fix_submap_inheritance (Lisp_Object, Lisp_Object, Lisp_Object);
78 static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
79 static void describe_command (Lisp_Object, Lisp_Object);
80 static void describe_translation (Lisp_Object, Lisp_Object);
81 static void describe_map (Lisp_Object, Lisp_Object,
82 void (*) (Lisp_Object, Lisp_Object),
83 int, Lisp_Object, Lisp_Object*, int, int);
84 static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
85 void (*) (Lisp_Object, Lisp_Object), int,
86 Lisp_Object, Lisp_Object, int, int);
87 static void silly_event_symbol_error (Lisp_Object);
88 static Lisp_Object get_keyelt (Lisp_Object, int);
90 /* Keymap object support - constructors and predicates. */
92 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
93 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
94 CHARTABLE is a char-table that holds the bindings for all characters
95 without modifiers. All entries in it are initially nil, meaning
96 "command undefined". ALIST is an assoc-list which holds bindings for
97 function keys, mouse events, and any other things that appear in the
98 input stream. Initially, ALIST is nil.
100 The optional arg STRING supplies a menu name for the keymap
101 in case you use it as a menu with `x-popup-menu'. */)
102 (Lisp_Object string)
104 Lisp_Object tail;
105 if (!NILP (string))
106 tail = Fcons (string, Qnil);
107 else
108 tail = Qnil;
109 return Fcons (Qkeymap,
110 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
113 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
114 doc: /* Construct and return a new sparse keymap.
115 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
116 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
117 which binds the function key or mouse event SYMBOL to DEFINITION.
118 Initially the alist is nil.
120 The optional arg STRING supplies a menu name for the keymap
121 in case you use it as a menu with `x-popup-menu'. */)
122 (Lisp_Object string)
124 if (!NILP (string))
126 if (!NILP (Vpurify_flag))
127 string = Fpurecopy (string);
128 return Fcons (Qkeymap, Fcons (string, Qnil));
130 return Fcons (Qkeymap, Qnil);
133 /* This function is used for installing the standard key bindings
134 at initialization time.
136 For example:
138 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
140 void
141 initial_define_key (Lisp_Object keymap, int key, const char *defname)
143 store_in_keymap (keymap, make_number (key), intern_c_string (defname));
146 void
147 initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname)
149 store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
152 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
153 doc: /* Return t if OBJECT is a keymap.
155 A keymap is a list (keymap . ALIST),
156 or a symbol whose function definition is itself a keymap.
157 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
158 a vector of densely packed bindings for small character codes
159 is also allowed as an element. */)
160 (Lisp_Object object)
162 return (KEYMAPP (object) ? Qt : Qnil);
165 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
166 doc: /* Return the prompt-string of a keymap MAP.
167 If non-nil, the prompt is shown in the echo-area
168 when reading a key-sequence to be looked-up in this keymap. */)
169 (Lisp_Object map)
171 map = get_keymap (map, 0, 0);
172 while (CONSP (map))
174 Lisp_Object tem = XCAR (map);
175 if (STRINGP (tem))
176 return tem;
177 map = XCDR (map);
179 return Qnil;
182 /* Check that OBJECT is a keymap (after dereferencing through any
183 symbols). If it is, return it.
185 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
186 is an autoload form, do the autoload and try again.
187 If AUTOLOAD is nonzero, callers must assume GC is possible.
189 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
190 is zero as well), return Qt.
192 ERROR_IF_NOT_KEYMAP controls how we respond if OBJECT isn't a keymap.
193 If ERROR_IF_NOT_KEYMAP is non-zero, signal an error; otherwise,
194 just return Qnil.
196 Note that most of the time, we don't want to pursue autoloads.
197 Functions like Faccessible_keymaps which scan entire keymap trees
198 shouldn't load every autoloaded keymap. I'm not sure about this,
199 but it seems to me that only read_key_sequence, Flookup_key, and
200 Fdefine_key should cause keymaps to be autoloaded.
202 This function can GC when AUTOLOAD is non-zero, because it calls
203 do_autoload which can GC. */
205 Lisp_Object
206 get_keymap (Lisp_Object object, int error_if_not_keymap, int autoload)
208 Lisp_Object tem;
210 autoload_retry:
211 if (NILP (object))
212 goto end;
213 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
214 return object;
216 tem = indirect_function (object);
217 if (CONSP (tem))
219 if (EQ (XCAR (tem), Qkeymap))
220 return tem;
222 /* Should we do an autoload? Autoload forms for keymaps have
223 Qkeymap as their fifth element. */
224 if ((autoload || !error_if_not_keymap) && EQ (XCAR (tem), Qautoload)
225 && SYMBOLP (object))
227 Lisp_Object tail;
229 tail = Fnth (make_number (4), tem);
230 if (EQ (tail, Qkeymap))
232 if (autoload)
234 struct gcpro gcpro1, gcpro2;
236 GCPRO2 (tem, object);
237 do_autoload (tem, object);
238 UNGCPRO;
240 goto autoload_retry;
242 else
243 return object;
248 end:
249 if (error_if_not_keymap)
250 wrong_type_argument (Qkeymapp, object);
251 return Qnil;
254 /* Return the parent map of KEYMAP, or nil if it has none.
255 We assume that KEYMAP is a valid keymap. */
257 static Lisp_Object
258 keymap_parent (Lisp_Object keymap, int autoload)
260 Lisp_Object list;
262 keymap = get_keymap (keymap, 1, autoload);
264 /* Skip past the initial element `keymap'. */
265 list = XCDR (keymap);
266 for (; CONSP (list); list = XCDR (list))
268 /* See if there is another `keymap'. */
269 if (KEYMAPP (list))
270 return list;
273 return get_keymap (list, 0, autoload);
276 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
277 doc: /* Return the parent keymap of KEYMAP.
278 If KEYMAP has no parent, return nil. */)
279 (Lisp_Object keymap)
281 return keymap_parent (keymap, 1);
284 /* Check whether MAP is one of MAPS parents. */
285 static int
286 keymap_memberp (Lisp_Object map, Lisp_Object maps)
288 if (NILP (map)) return 0;
289 while (KEYMAPP (maps) && !EQ (map, maps))
290 maps = keymap_parent (maps, 0);
291 return (EQ (map, maps));
294 /* Set the parent keymap of MAP to PARENT. */
296 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
297 doc: /* Modify KEYMAP to set its parent map to PARENT.
298 Return PARENT. PARENT should be nil or another keymap. */)
299 (Lisp_Object keymap, Lisp_Object parent)
301 Lisp_Object list, prev;
302 struct gcpro gcpro1, gcpro2;
303 int i;
305 /* Force a keymap flush for the next call to where-is.
306 Since this can be called from within where-is, we don't set where_is_cache
307 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
308 be changed during where-is, while where_is_cache_keymaps is only used at
309 the very beginning of where-is and can thus be changed here without any
310 adverse effect.
311 This is a very minor correctness (rather than safety) issue. */
312 where_is_cache_keymaps = Qt;
314 GCPRO2 (keymap, parent);
315 keymap = get_keymap (keymap, 1, 1);
317 if (!NILP (parent))
319 parent = get_keymap (parent, 1, 1);
321 /* Check for cycles. */
322 if (keymap_memberp (keymap, parent))
323 error ("Cyclic keymap inheritance");
326 /* Skip past the initial element `keymap'. */
327 prev = keymap;
328 while (1)
330 list = XCDR (prev);
331 /* If there is a parent keymap here, replace it.
332 If we came to the end, add the parent in PREV. */
333 if (!CONSP (list) || KEYMAPP (list))
335 /* If we already have the right parent, return now
336 so that we avoid the loops below. */
337 if (EQ (XCDR (prev), parent))
338 RETURN_UNGCPRO (parent);
340 CHECK_IMPURE (prev);
341 XSETCDR (prev, parent);
342 break;
344 prev = list;
347 /* Scan through for submaps, and set their parents too. */
349 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
351 /* Stop the scan when we come to the parent. */
352 if (EQ (XCAR (list), Qkeymap))
353 break;
355 /* If this element holds a prefix map, deal with it. */
356 if (CONSP (XCAR (list))
357 && CONSP (XCDR (XCAR (list))))
358 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
359 XCDR (XCAR (list)));
361 if (VECTORP (XCAR (list)))
362 for (i = 0; i < ASIZE (XCAR (list)); i++)
363 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
364 fix_submap_inheritance (keymap, make_number (i),
365 XVECTOR (XCAR (list))->contents[i]);
367 if (CHAR_TABLE_P (XCAR (list)))
369 map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
373 RETURN_UNGCPRO (parent);
376 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
377 if EVENT is also a prefix in MAP's parent,
378 make sure that SUBMAP inherits that definition as its own parent. */
380 static void
381 fix_submap_inheritance (Lisp_Object map, Lisp_Object event, Lisp_Object submap)
383 Lisp_Object map_parent, parent_entry;
385 /* SUBMAP is a cons that we found as a key binding.
386 Discard the other things found in a menu key binding. */
388 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
390 /* If it isn't a keymap now, there's no work to do. */
391 if (!CONSP (submap))
392 return;
394 map_parent = keymap_parent (map, 0);
395 if (!NILP (map_parent))
396 parent_entry =
397 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
398 else
399 parent_entry = Qnil;
401 /* If MAP's parent has something other than a keymap,
402 our own submap shadows it completely. */
403 if (!CONSP (parent_entry))
404 return;
406 if (! EQ (parent_entry, submap))
408 Lisp_Object submap_parent;
409 submap_parent = submap;
410 while (1)
412 Lisp_Object tem;
414 tem = keymap_parent (submap_parent, 0);
416 if (KEYMAPP (tem))
418 if (keymap_memberp (tem, parent_entry))
419 /* Fset_keymap_parent could create a cycle. */
420 return;
421 submap_parent = tem;
423 else
424 break;
426 Fset_keymap_parent (submap_parent, parent_entry);
430 /* Look up IDX in MAP. IDX may be any sort of event.
431 Note that this does only one level of lookup; IDX must be a single
432 event, not a sequence.
434 If T_OK is non-zero, bindings for Qt are treated as default
435 bindings; any key left unmentioned by other tables and bindings is
436 given the binding of Qt.
438 If T_OK is zero, bindings for Qt are not treated specially.
440 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
442 Lisp_Object
443 access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload)
445 Lisp_Object val;
447 /* Qunbound in VAL means we have found no binding yet. */
448 val = Qunbound;
450 /* If idx is a list (some sort of mouse click, perhaps?),
451 the index we want to use is the car of the list, which
452 ought to be a symbol. */
453 idx = EVENT_HEAD (idx);
455 /* If idx is a symbol, it might have modifiers, which need to
456 be put in the canonical order. */
457 if (SYMBOLP (idx))
458 idx = reorder_modifiers (idx);
459 else if (INTEGERP (idx))
460 /* Clobber the high bits that can be present on a machine
461 with more than 24 bits of integer. */
462 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
464 /* Handle the special meta -> esc mapping. */
465 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
467 /* See if there is a meta-map. If there's none, there is
468 no binding for IDX, unless a default binding exists in MAP. */
469 struct gcpro gcpro1;
470 Lisp_Object event_meta_map;
471 GCPRO1 (map);
472 /* A strange value in which Meta is set would cause
473 infinite recursion. Protect against that. */
474 if (XINT (meta_prefix_char) & CHAR_META)
475 meta_prefix_char = make_number (27);
476 event_meta_map = get_keymap (access_keymap (map, meta_prefix_char,
477 t_ok, noinherit, autoload),
478 0, autoload);
479 UNGCPRO;
480 if (CONSP (event_meta_map))
482 map = event_meta_map;
483 idx = make_number (XUINT (idx) & ~meta_modifier);
485 else if (t_ok)
486 /* Set IDX to t, so that we only find a default binding. */
487 idx = Qt;
488 else
489 /* We know there is no binding. */
490 return Qnil;
493 /* t_binding is where we put a default binding that applies,
494 to use in case we do not find a binding specifically
495 for this key sequence. */
497 Lisp_Object tail;
498 Lisp_Object t_binding = Qnil;
499 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
501 GCPRO4 (map, tail, idx, t_binding);
503 for (tail = XCDR (map);
504 (CONSP (tail)
505 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
506 tail = XCDR (tail))
508 Lisp_Object binding;
510 binding = XCAR (tail);
511 if (SYMBOLP (binding))
513 /* If NOINHERIT, stop finding prefix definitions
514 after we pass a second occurrence of the `keymap' symbol. */
515 if (noinherit && EQ (binding, Qkeymap))
516 RETURN_UNGCPRO (Qnil);
518 else if (CONSP (binding))
520 Lisp_Object key = XCAR (binding);
522 if (EQ (key, idx))
523 val = XCDR (binding);
524 else if (t_ok && EQ (key, Qt))
526 t_binding = XCDR (binding);
527 t_ok = 0;
530 else if (VECTORP (binding))
532 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
533 val = AREF (binding, XFASTINT (idx));
535 else if (CHAR_TABLE_P (binding))
537 /* Character codes with modifiers
538 are not included in a char-table.
539 All character codes without modifiers are included. */
540 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
542 val = Faref (binding, idx);
543 /* `nil' has a special meaning for char-tables, so
544 we use something else to record an explicitly
545 unbound entry. */
546 if (NILP (val))
547 val = Qunbound;
551 /* If we found a binding, clean it up and return it. */
552 if (!EQ (val, Qunbound))
554 if (EQ (val, Qt))
555 /* A Qt binding is just like an explicit nil binding
556 (i.e. it shadows any parent binding but not bindings in
557 keymaps of lower precedence). */
558 val = Qnil;
559 val = get_keyelt (val, autoload);
560 if (KEYMAPP (val))
561 fix_submap_inheritance (map, idx, val);
562 RETURN_UNGCPRO (val);
564 QUIT;
566 UNGCPRO;
567 return get_keyelt (t_binding, autoload);
571 static void
572 map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
574 /* We should maybe try to detect bindings shadowed by previous
575 ones and things like that. */
576 if (EQ (val, Qt))
577 val = Qnil;
578 (*fun) (key, val, args, data);
581 static void
582 map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
584 if (!NILP (val))
586 map_keymap_function_t fun =
587 (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer;
588 args = XCDR (args);
589 /* If the key is a range, make a copy since map_char_table modifies
590 it in place. */
591 if (CONSP (key))
592 key = Fcons (XCAR (key), XCDR (key));
593 map_keymap_item (fun, XCDR (args), key, val,
594 XSAVE_VALUE (XCAR (args))->pointer);
598 /* Call FUN for every binding in MAP and stop at (and return) the parent.
599 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA). */
600 static Lisp_Object
601 map_keymap_internal (Lisp_Object map,
602 map_keymap_function_t fun,
603 Lisp_Object args,
604 void *data)
606 struct gcpro gcpro1, gcpro2, gcpro3;
607 Lisp_Object tail
608 = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
610 GCPRO3 (map, args, tail);
611 for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
613 Lisp_Object binding = XCAR (tail);
615 if (CONSP (binding))
616 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
617 else if (VECTORP (binding))
619 /* Loop over the char values represented in the vector. */
620 int len = ASIZE (binding);
621 int c;
622 for (c = 0; c < len; c++)
624 Lisp_Object character;
625 XSETFASTINT (character, c);
626 map_keymap_item (fun, args, character, AREF (binding, c), data);
629 else if (CHAR_TABLE_P (binding))
631 map_char_table (map_keymap_char_table_item, Qnil, binding,
632 Fcons (make_save_value ((void *) fun, 0),
633 Fcons (make_save_value (data, 0),
634 args)));
637 UNGCPRO;
638 return tail;
641 static void
642 map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
644 call2 (fun, key, val);
647 /* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
648 A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
649 void
650 map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload)
652 struct gcpro gcpro1;
653 GCPRO1 (args);
654 map = get_keymap (map, 1, autoload);
655 while (CONSP (map))
657 map = map_keymap_internal (map, fun, args, data);
658 map = get_keymap (map, 0, autoload);
660 UNGCPRO;
663 static Lisp_Object Qkeymap_canonicalize;
665 /* Same as map_keymap, but does it right, properly eliminating duplicate
666 bindings due to inheritance. */
667 void
668 map_keymap_canonical (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data)
670 struct gcpro gcpro1;
671 GCPRO1 (args);
672 /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
673 so be careful to ignore errors and to inhibit redisplay. */
674 map = safe_call1 (Qkeymap_canonicalize, map);
675 /* No need to use `map_keymap' here because canonical map has no parent. */
676 map_keymap_internal (map, fun, args, data);
677 UNGCPRO;
680 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
681 doc: /* Call FUNCTION once for each event binding in KEYMAP.
682 FUNCTION is called with two arguments: the event that is bound, and
683 the definition it is bound to. The event may be a character range.
684 If KEYMAP has a parent, this function returns it without processing it. */)
685 (Lisp_Object function, Lisp_Object keymap)
687 struct gcpro gcpro1;
688 GCPRO1 (function);
689 keymap = get_keymap (keymap, 1, 1);
690 keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
691 UNGCPRO;
692 return keymap;
695 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
696 doc: /* Call FUNCTION once for each event binding in KEYMAP.
697 FUNCTION is called with two arguments: the event that is bound, and
698 the definition it is bound to. The event may be a character range.
700 If KEYMAP has a parent, the parent's bindings are included as well.
701 This works recursively: if the parent has itself a parent, then the
702 grandparent's bindings are also included and so on.
703 usage: (map-keymap FUNCTION KEYMAP) */)
704 (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first)
706 if (! NILP (sort_first))
707 return call2 (intern ("map-keymap-sorted"), function, keymap);
709 map_keymap (keymap, map_keymap_call, function, NULL, 1);
710 return Qnil;
713 /* Given OBJECT which was found in a slot in a keymap,
714 trace indirect definitions to get the actual definition of that slot.
715 An indirect definition is a list of the form
716 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
717 and INDEX is the object to look up in KEYMAP to yield the definition.
719 Also if OBJECT has a menu string as the first element,
720 remove that. Also remove a menu help string as second element.
722 If AUTOLOAD is nonzero, load autoloadable keymaps
723 that are referred to with indirection.
725 This can GC because menu_item_eval_property calls Feval. */
727 static Lisp_Object
728 get_keyelt (Lisp_Object object, int autoload)
730 while (1)
732 if (!(CONSP (object)))
733 /* This is really the value. */
734 return object;
736 /* If the keymap contents looks like (keymap ...) or (lambda ...)
737 then use itself. */
738 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
739 return object;
741 /* If the keymap contents looks like (menu-item name . DEFN)
742 or (menu-item name DEFN ...) then use DEFN.
743 This is a new format menu item. */
744 else if (EQ (XCAR (object), Qmenu_item))
746 if (CONSP (XCDR (object)))
748 Lisp_Object tem;
750 object = XCDR (XCDR (object));
751 tem = object;
752 if (CONSP (object))
753 object = XCAR (object);
755 /* If there's a `:filter FILTER', apply FILTER to the
756 menu-item's definition to get the real definition to
757 use. */
758 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
759 if (EQ (XCAR (tem), QCfilter) && autoload)
761 Lisp_Object filter;
762 filter = XCAR (XCDR (tem));
763 filter = list2 (filter, list2 (Qquote, object));
764 object = menu_item_eval_property (filter);
765 break;
768 else
769 /* Invalid keymap. */
770 return object;
773 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
774 Keymap alist elements like (CHAR MENUSTRING . DEFN)
775 will be used by HierarKey menus. */
776 else if (STRINGP (XCAR (object)))
778 object = XCDR (object);
779 /* Also remove a menu help string, if any,
780 following the menu item name. */
781 if (CONSP (object) && STRINGP (XCAR (object)))
782 object = XCDR (object);
783 /* Also remove the sublist that caches key equivalences, if any. */
784 if (CONSP (object) && CONSP (XCAR (object)))
786 Lisp_Object carcar;
787 carcar = XCAR (XCAR (object));
788 if (NILP (carcar) || VECTORP (carcar))
789 object = XCDR (object);
793 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
794 else
796 struct gcpro gcpro1;
797 Lisp_Object map;
798 GCPRO1 (object);
799 map = get_keymap (Fcar_safe (object), 0, autoload);
800 UNGCPRO;
801 return (!CONSP (map) ? object /* Invalid keymap */
802 : access_keymap (map, Fcdr (object), 0, 0, autoload));
807 static Lisp_Object
808 store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
810 /* Flush any reverse-map cache. */
811 where_is_cache = Qnil;
812 where_is_cache_keymaps = Qt;
814 /* If we are preparing to dump, and DEF is a menu element
815 with a menu item indicator, copy it to ensure it is not pure. */
816 if (CONSP (def) && PURE_P (def)
817 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
818 def = Fcons (XCAR (def), XCDR (def));
820 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
821 error ("attempt to define a key in a non-keymap");
823 /* If idx is a cons, and the car part is a character, idx must be of
824 the form (FROM-CHAR . TO-CHAR). */
825 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
826 CHECK_CHARACTER_CDR (idx);
827 else
828 /* If idx is a list (some sort of mouse click, perhaps?),
829 the index we want to use is the car of the list, which
830 ought to be a symbol. */
831 idx = EVENT_HEAD (idx);
833 /* If idx is a symbol, it might have modifiers, which need to
834 be put in the canonical order. */
835 if (SYMBOLP (idx))
836 idx = reorder_modifiers (idx);
837 else if (INTEGERP (idx))
838 /* Clobber the high bits that can be present on a machine
839 with more than 24 bits of integer. */
840 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
842 /* Scan the keymap for a binding of idx. */
844 Lisp_Object tail;
846 /* The cons after which we should insert new bindings. If the
847 keymap has a table element, we record its position here, so new
848 bindings will go after it; this way, the table will stay
849 towards the front of the alist and character lookups in dense
850 keymaps will remain fast. Otherwise, this just points at the
851 front of the keymap. */
852 Lisp_Object insertion_point;
854 insertion_point = keymap;
855 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
857 Lisp_Object elt;
859 elt = XCAR (tail);
860 if (VECTORP (elt))
862 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
864 CHECK_IMPURE (elt);
865 ASET (elt, XFASTINT (idx), def);
866 return def;
868 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
870 int from = XFASTINT (XCAR (idx));
871 int to = XFASTINT (XCDR (idx));
873 if (to >= ASIZE (elt))
874 to = ASIZE (elt) - 1;
875 for (; from <= to; from++)
876 ASET (elt, from, def);
877 if (to == XFASTINT (XCDR (idx)))
878 /* We have defined all keys in IDX. */
879 return def;
881 insertion_point = tail;
883 else if (CHAR_TABLE_P (elt))
885 /* Character codes with modifiers
886 are not included in a char-table.
887 All character codes without modifiers are included. */
888 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
890 Faset (elt, idx,
891 /* `nil' has a special meaning for char-tables, so
892 we use something else to record an explicitly
893 unbound entry. */
894 NILP (def) ? Qt : def);
895 return def;
897 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
899 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
900 return def;
902 insertion_point = tail;
904 else if (CONSP (elt))
906 if (EQ (idx, XCAR (elt)))
908 CHECK_IMPURE (elt);
909 XSETCDR (elt, def);
910 return def;
912 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
914 int from = XFASTINT (XCAR (idx));
915 int to = XFASTINT (XCDR (idx));
917 if (from <= XFASTINT (XCAR (elt))
918 && to >= XFASTINT (XCAR (elt)))
920 XSETCDR (elt, def);
921 if (from == to)
922 return def;
926 else if (EQ (elt, Qkeymap))
927 /* If we find a 'keymap' symbol in the spine of KEYMAP,
928 then we must have found the start of a second keymap
929 being used as the tail of KEYMAP, and a binding for IDX
930 should be inserted before it. */
931 goto keymap_end;
933 QUIT;
936 keymap_end:
937 /* We have scanned the entire keymap, and not found a binding for
938 IDX. Let's add one. */
940 Lisp_Object elt;
942 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
944 /* IDX specifies a range of characters, and not all of them
945 were handled yet, which means this keymap doesn't have a
946 char-table. So, we insert a char-table now. */
947 elt = Fmake_char_table (Qkeymap, Qnil);
948 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
950 else
951 elt = Fcons (idx, def);
952 CHECK_IMPURE (insertion_point);
953 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
957 return def;
960 static Lisp_Object Fcopy_keymap (Lisp_Object);
962 static Lisp_Object
963 copy_keymap_item (Lisp_Object elt)
965 Lisp_Object res, tem;
967 if (!CONSP (elt))
968 return elt;
970 res = tem = elt;
972 /* Is this a new format menu item. */
973 if (EQ (XCAR (tem), Qmenu_item))
975 /* Copy cell with menu-item marker. */
976 res = elt = Fcons (XCAR (tem), XCDR (tem));
977 tem = XCDR (elt);
978 if (CONSP (tem))
980 /* Copy cell with menu-item name. */
981 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
982 elt = XCDR (elt);
983 tem = XCDR (elt);
985 if (CONSP (tem))
987 /* Copy cell with binding and if the binding is a keymap,
988 copy that. */
989 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
990 elt = XCDR (elt);
991 tem = XCAR (elt);
992 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
993 XSETCAR (elt, Fcopy_keymap (tem));
994 tem = XCDR (elt);
995 if (CONSP (tem) && CONSP (XCAR (tem)))
996 /* Delete cache for key equivalences. */
997 XSETCDR (elt, XCDR (tem));
1000 else
1002 /* It may be an old fomat menu item.
1003 Skip the optional menu string. */
1004 if (STRINGP (XCAR (tem)))
1006 /* Copy the cell, since copy-alist didn't go this deep. */
1007 res = elt = Fcons (XCAR (tem), XCDR (tem));
1008 tem = XCDR (elt);
1009 /* Also skip the optional menu help string. */
1010 if (CONSP (tem) && STRINGP (XCAR (tem)))
1012 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1013 elt = XCDR (elt);
1014 tem = XCDR (elt);
1016 /* There may also be a list that caches key equivalences.
1017 Just delete it for the new keymap. */
1018 if (CONSP (tem)
1019 && CONSP (XCAR (tem))
1020 && (NILP (XCAR (XCAR (tem)))
1021 || VECTORP (XCAR (XCAR (tem)))))
1023 XSETCDR (elt, XCDR (tem));
1024 tem = XCDR (tem);
1026 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1027 XSETCDR (elt, Fcopy_keymap (tem));
1029 else if (EQ (XCAR (tem), Qkeymap))
1030 res = Fcopy_keymap (elt);
1032 return res;
1035 static void
1036 copy_keymap_1 (Lisp_Object chartable, Lisp_Object idx, Lisp_Object elt)
1038 Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
1041 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1042 doc: /* Return a copy of the keymap KEYMAP.
1043 The copy starts out with the same definitions of KEYMAP,
1044 but changing either the copy or KEYMAP does not affect the other.
1045 Any key definitions that are subkeymaps are recursively copied.
1046 However, a key definition which is a symbol whose definition is a keymap
1047 is not copied. */)
1048 (Lisp_Object keymap)
1050 register Lisp_Object copy, tail;
1051 keymap = get_keymap (keymap, 1, 0);
1052 copy = tail = Fcons (Qkeymap, Qnil);
1053 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1055 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1057 Lisp_Object elt = XCAR (keymap);
1058 if (CHAR_TABLE_P (elt))
1060 elt = Fcopy_sequence (elt);
1061 map_char_table (copy_keymap_1, Qnil, elt, elt);
1063 else if (VECTORP (elt))
1065 int i;
1066 elt = Fcopy_sequence (elt);
1067 for (i = 0; i < ASIZE (elt); i++)
1068 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1070 else if (CONSP (elt))
1071 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1072 XSETCDR (tail, Fcons (elt, Qnil));
1073 tail = XCDR (tail);
1074 keymap = XCDR (keymap);
1076 XSETCDR (tail, keymap);
1077 return copy;
1080 /* Simple Keymap mutators and accessors. */
1082 /* GC is possible in this function if it autoloads a keymap. */
1084 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1085 doc: /* In KEYMAP, define key sequence KEY as DEF.
1086 KEYMAP is a keymap.
1088 KEY is a string or a vector of symbols and characters, representing a
1089 sequence of keystrokes and events. Non-ASCII characters with codes
1090 above 127 (such as ISO Latin-1) can be represented by vectors.
1091 Two types of vector have special meanings:
1092 [remap COMMAND] remaps any key binding for COMMAND.
1093 [t] creates a default definition, which applies to any event with no
1094 other definition in KEYMAP.
1096 DEF is anything that can be a key's definition:
1097 nil (means key is undefined in this keymap),
1098 a command (a Lisp function suitable for interactive calling),
1099 a string (treated as a keyboard macro),
1100 a keymap (to define a prefix key),
1101 a symbol (when the key is looked up, the symbol will stand for its
1102 function definition, which should at that time be one of the above,
1103 or another symbol whose function definition is used, etc.),
1104 a cons (STRING . DEFN), meaning that DEFN is the definition
1105 (DEFN should be a valid definition in its own right),
1106 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1107 or an extended menu item definition.
1108 (See info node `(elisp)Extended Menu Items'.)
1110 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1111 binding is altered. If there is no binding for KEY, the new pair
1112 binding KEY to DEF is added at the front of KEYMAP. */)
1113 (Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
1115 register int idx;
1116 register Lisp_Object c;
1117 register Lisp_Object cmd;
1118 int metized = 0;
1119 int meta_bit;
1120 int length;
1121 struct gcpro gcpro1, gcpro2, gcpro3;
1123 GCPRO3 (keymap, key, def);
1124 keymap = get_keymap (keymap, 1, 1);
1126 CHECK_VECTOR_OR_STRING (key);
1128 length = XFASTINT (Flength (key));
1129 if (length == 0)
1130 RETURN_UNGCPRO (Qnil);
1132 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1133 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1135 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1136 ? meta_modifier : 0x80);
1138 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1139 { /* DEF is apparently an XEmacs-style keyboard macro. */
1140 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1141 int i = ASIZE (def);
1142 while (--i >= 0)
1144 Lisp_Object defi = AREF (def, i);
1145 if (CONSP (defi) && lucid_event_type_list_p (defi))
1146 defi = Fevent_convert_list (defi);
1147 ASET (tmp, i, defi);
1149 def = tmp;
1152 idx = 0;
1153 while (1)
1155 c = Faref (key, make_number (idx));
1157 if (CONSP (c))
1159 /* C may be a Lucid style event type list or a cons (FROM .
1160 TO) specifying a range of characters. */
1161 if (lucid_event_type_list_p (c))
1162 c = Fevent_convert_list (c);
1163 else if (CHARACTERP (XCAR (c)))
1164 CHECK_CHARACTER_CDR (c);
1167 if (SYMBOLP (c))
1168 silly_event_symbol_error (c);
1170 if (INTEGERP (c)
1171 && (XINT (c) & meta_bit)
1172 && !metized)
1174 c = meta_prefix_char;
1175 metized = 1;
1177 else
1179 if (INTEGERP (c))
1180 XSETINT (c, XINT (c) & ~meta_bit);
1182 metized = 0;
1183 idx++;
1186 if (!INTEGERP (c) && !SYMBOLP (c)
1187 && (!CONSP (c)
1188 /* If C is a range, it must be a leaf. */
1189 || (INTEGERP (XCAR (c)) && idx != length)))
1190 message_with_string ("Key sequence contains invalid event %s", c, 1);
1192 if (idx == length)
1193 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1195 cmd = access_keymap (keymap, c, 0, 1, 1);
1197 /* If this key is undefined, make it a prefix. */
1198 if (NILP (cmd))
1199 cmd = define_as_prefix (keymap, c);
1201 keymap = get_keymap (cmd, 0, 1);
1202 if (!CONSP (keymap))
1203 /* We must use Fkey_description rather than just passing key to
1204 error; key might be a vector, not a string. */
1205 error ("Key sequence %s starts with non-prefix key %s",
1206 SDATA (Fkey_description (key, Qnil)),
1207 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1208 make_number (idx)),
1209 Qnil)));
1213 /* This function may GC (it calls Fkey_binding). */
1215 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1216 doc: /* Return the remapping for command COMMAND.
1217 Returns nil if COMMAND is not remapped (or not a symbol).
1219 If the optional argument POSITION is non-nil, it specifies a mouse
1220 position as returned by `event-start' and `event-end', and the
1221 remapping occurs in the keymaps associated with it. It can also be a
1222 number or marker, in which case the keymap properties at the specified
1223 buffer position instead of point are used. The KEYMAPS argument is
1224 ignored if POSITION is non-nil.
1226 If the optional argument KEYMAPS is non-nil, it should be a list of
1227 keymaps to search for command remapping. Otherwise, search for the
1228 remapping in all currently active keymaps. */)
1229 (Lisp_Object command, Lisp_Object position, Lisp_Object keymaps)
1231 if (!SYMBOLP (command))
1232 return Qnil;
1234 ASET (command_remapping_vector, 1, command);
1236 if (NILP (keymaps))
1237 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1238 else
1240 Lisp_Object maps, binding;
1242 for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
1244 binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
1245 if (!NILP (binding) && !INTEGERP (binding))
1246 return binding;
1248 return Qnil;
1252 /* Value is number if KEY is too long; nil if valid but has no definition. */
1253 /* GC is possible in this function if it autoloads a keymap. */
1255 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1256 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1257 A value of nil means undefined. See doc of `define-key'
1258 for kinds of definitions.
1260 A number as value means KEY is "too long";
1261 that is, characters or symbols in it except for the last one
1262 fail to be a valid sequence of prefix characters in KEYMAP.
1263 The number is how many characters at the front of KEY
1264 it takes to reach a non-prefix key.
1266 Normally, `lookup-key' ignores bindings for t, which act as default
1267 bindings, used when nothing else in the keymap applies; this makes it
1268 usable as a general function for probing keymaps. However, if the
1269 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1270 recognize the default bindings, just as `read-key-sequence' does. */)
1271 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
1273 register int idx;
1274 register Lisp_Object cmd;
1275 register Lisp_Object c;
1276 int length;
1277 int t_ok = !NILP (accept_default);
1278 struct gcpro gcpro1, gcpro2;
1280 GCPRO2 (keymap, key);
1281 keymap = get_keymap (keymap, 1, 1);
1283 CHECK_VECTOR_OR_STRING (key);
1285 length = XFASTINT (Flength (key));
1286 if (length == 0)
1287 RETURN_UNGCPRO (keymap);
1289 idx = 0;
1290 while (1)
1292 c = Faref (key, make_number (idx++));
1294 if (CONSP (c) && lucid_event_type_list_p (c))
1295 c = Fevent_convert_list (c);
1297 /* Turn the 8th bit of string chars into a meta modifier. */
1298 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1299 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1301 /* Allow string since binding for `menu-bar-select-buffer'
1302 includes the buffer name in the key sequence. */
1303 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1304 message_with_string ("Key sequence contains invalid event %s", c, 1);
1306 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1307 if (idx == length)
1308 RETURN_UNGCPRO (cmd);
1310 keymap = get_keymap (cmd, 0, 1);
1311 if (!CONSP (keymap))
1312 RETURN_UNGCPRO (make_number (idx));
1314 QUIT;
1318 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1319 Assume that currently it does not define C at all.
1320 Return the keymap. */
1322 static Lisp_Object
1323 define_as_prefix (Lisp_Object keymap, Lisp_Object c)
1325 Lisp_Object cmd;
1327 cmd = Fmake_sparse_keymap (Qnil);
1328 /* If this key is defined as a prefix in an inherited keymap,
1329 make it a prefix in this map, and make its definition
1330 inherit the other prefix definition. */
1331 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1332 store_in_keymap (keymap, c, cmd);
1334 return cmd;
1337 /* Append a key to the end of a key sequence. We always make a vector. */
1339 static Lisp_Object
1340 append_key (Lisp_Object key_sequence, Lisp_Object key)
1342 Lisp_Object args[2];
1344 args[0] = key_sequence;
1346 args[1] = Fcons (key, Qnil);
1347 return Fvconcat (2, args);
1350 /* Given a event type C which is a symbol,
1351 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1353 static void
1354 silly_event_symbol_error (Lisp_Object c)
1356 Lisp_Object parsed, base, name, assoc;
1357 int modifiers;
1359 parsed = parse_modifiers (c);
1360 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1361 base = XCAR (parsed);
1362 name = Fsymbol_name (base);
1363 /* This alist includes elements such as ("RET" . "\\r"). */
1364 assoc = Fassoc (name, exclude_keys);
1366 if (! NILP (assoc))
1368 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1369 char *p = new_mods;
1370 Lisp_Object keystring;
1371 if (modifiers & alt_modifier)
1372 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1373 if (modifiers & ctrl_modifier)
1374 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1375 if (modifiers & hyper_modifier)
1376 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1377 if (modifiers & meta_modifier)
1378 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1379 if (modifiers & shift_modifier)
1380 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1381 if (modifiers & super_modifier)
1382 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1383 *p = 0;
1385 c = reorder_modifiers (c);
1386 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1388 error ((modifiers & ~meta_modifier
1389 ? "To bind the key %s, use [?%s], not [%s]"
1390 : "To bind the key %s, use \"%s\", not [%s]"),
1391 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1392 SDATA (SYMBOL_NAME (c)));
1396 /* Global, local, and minor mode keymap stuff. */
1398 /* We can't put these variables inside current_minor_maps, since under
1399 some systems, static gets macro-defined to be the empty string.
1400 Ickypoo. */
1401 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1402 static int cmm_size = 0;
1404 /* Store a pointer to an array of the currently active minor modes in
1405 *modeptr, a pointer to an array of the keymaps of the currently
1406 active minor modes in *mapptr, and return the number of maps
1407 *mapptr contains.
1409 This function always returns a pointer to the same buffer, and may
1410 free or reallocate it, so if you want to keep it for a long time or
1411 hand it out to lisp code, copy it. This procedure will be called
1412 for every key sequence read, so the nice lispy approach (return a
1413 new assoclist, list, what have you) for each invocation would
1414 result in a lot of consing over time.
1416 If we used xrealloc/xmalloc and ran out of memory, they would throw
1417 back to the command loop, which would try to read a key sequence,
1418 which would call this function again, resulting in an infinite
1419 loop. Instead, we'll use realloc/malloc and silently truncate the
1420 list, let the key sequence be read, and hope some other piece of
1421 code signals the error. */
1423 current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
1425 int i = 0;
1426 int list_number = 0;
1427 Lisp_Object alist, assoc, var, val;
1428 Lisp_Object emulation_alists;
1429 Lisp_Object lists[2];
1431 emulation_alists = Vemulation_mode_map_alists;
1432 lists[0] = Vminor_mode_overriding_map_alist;
1433 lists[1] = Vminor_mode_map_alist;
1435 for (list_number = 0; list_number < 2; list_number++)
1437 if (CONSP (emulation_alists))
1439 alist = XCAR (emulation_alists);
1440 emulation_alists = XCDR (emulation_alists);
1441 if (SYMBOLP (alist))
1442 alist = find_symbol_value (alist);
1443 list_number = -1;
1445 else
1446 alist = lists[list_number];
1448 for ( ; CONSP (alist); alist = XCDR (alist))
1449 if ((assoc = XCAR (alist), CONSP (assoc))
1450 && (var = XCAR (assoc), SYMBOLP (var))
1451 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1452 && !NILP (val))
1454 Lisp_Object temp;
1456 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1457 and also an entry in Vminor_mode_map_alist,
1458 ignore the latter. */
1459 if (list_number == 1)
1461 val = assq_no_quit (var, lists[0]);
1462 if (!NILP (val))
1463 continue;
1466 if (i >= cmm_size)
1468 int newsize, allocsize;
1469 Lisp_Object *newmodes, *newmaps;
1471 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1472 allocsize = newsize * sizeof *newmodes;
1474 /* Use malloc here. See the comment above this function.
1475 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1476 BLOCK_INPUT;
1477 newmodes = (Lisp_Object *) malloc (allocsize);
1478 if (newmodes)
1480 if (cmm_modes)
1482 memcpy (newmodes, cmm_modes,
1483 cmm_size * sizeof cmm_modes[0]);
1484 free (cmm_modes);
1486 cmm_modes = newmodes;
1489 newmaps = (Lisp_Object *) malloc (allocsize);
1490 if (newmaps)
1492 if (cmm_maps)
1494 memcpy (newmaps, cmm_maps,
1495 cmm_size * sizeof cmm_maps[0]);
1496 free (cmm_maps);
1498 cmm_maps = newmaps;
1500 UNBLOCK_INPUT;
1502 if (newmodes == NULL || newmaps == NULL)
1503 break;
1504 cmm_size = newsize;
1507 /* Get the keymap definition--or nil if it is not defined. */
1508 temp = Findirect_function (XCDR (assoc), Qt);
1509 if (!NILP (temp))
1511 cmm_modes[i] = var;
1512 cmm_maps [i] = temp;
1513 i++;
1518 if (modeptr) *modeptr = cmm_modes;
1519 if (mapptr) *mapptr = cmm_maps;
1520 return i;
1523 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1524 0, 2, 0,
1525 doc: /* Return a list of the currently active keymaps.
1526 OLP if non-nil indicates that we should obey `overriding-local-map' and
1527 `overriding-terminal-local-map'. POSITION can specify a click position
1528 like in the respective argument of `key-binding'. */)
1529 (Lisp_Object olp, Lisp_Object position)
1531 int count = SPECPDL_INDEX ();
1533 Lisp_Object keymaps;
1535 /* If a mouse click position is given, our variables are based on
1536 the buffer clicked on, not the current buffer. So we may have to
1537 switch the buffer here. */
1539 if (CONSP (position))
1541 Lisp_Object window;
1543 window = POSN_WINDOW (position);
1545 if (WINDOWP (window)
1546 && BUFFERP (XWINDOW (window)->buffer)
1547 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1549 /* Arrange to go back to the original buffer once we're done
1550 processing the key sequence. We don't use
1551 save_excursion_{save,restore} here, in analogy to
1552 `read-key-sequence' to avoid saving point. Maybe this
1553 would not be a problem here, but it is easier to keep
1554 things the same.
1557 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1559 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1563 keymaps = Fcons (current_global_map, Qnil);
1565 if (!NILP (olp))
1567 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
1568 keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps);
1569 /* The doc said that overriding-terminal-local-map should
1570 override overriding-local-map. The code used them both,
1571 but it seems clearer to use just one. rms, jan 2005. */
1572 else if (!NILP (Voverriding_local_map))
1573 keymaps = Fcons (Voverriding_local_map, keymaps);
1575 if (NILP (XCDR (keymaps)))
1577 Lisp_Object *maps;
1578 int nmaps, i;
1580 Lisp_Object keymap, local_map;
1581 EMACS_INT pt;
1583 pt = INTEGERP (position) ? XINT (position)
1584 : MARKERP (position) ? marker_position (position)
1585 : PT;
1587 /* Get the buffer local maps, possibly overriden by text or
1588 overlay properties */
1590 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1591 keymap = get_local_map (pt, current_buffer, Qkeymap);
1593 if (CONSP (position))
1595 Lisp_Object string;
1597 /* For a mouse click, get the local text-property keymap
1598 of the place clicked on, rather than point. */
1600 if (POSN_INBUFFER_P (position))
1602 Lisp_Object pos;
1604 pos = POSN_BUFFER_POSN (position);
1605 if (INTEGERP (pos)
1606 && XINT (pos) >= BEG && XINT (pos) <= Z)
1608 local_map = get_local_map (XINT (pos),
1609 current_buffer, Qlocal_map);
1611 keymap = get_local_map (XINT (pos),
1612 current_buffer, Qkeymap);
1616 /* If on a mode line string with a local keymap,
1617 or for a click on a string, i.e. overlay string or a
1618 string displayed via the `display' property,
1619 consider `local-map' and `keymap' properties of
1620 that string. */
1622 if (string = POSN_STRING (position),
1623 (CONSP (string) && STRINGP (XCAR (string))))
1625 Lisp_Object pos, map;
1627 pos = XCDR (string);
1628 string = XCAR (string);
1629 if (INTEGERP (pos)
1630 && XINT (pos) >= 0
1631 && XINT (pos) < SCHARS (string))
1633 map = Fget_text_property (pos, Qlocal_map, string);
1634 if (!NILP (map))
1635 local_map = map;
1637 map = Fget_text_property (pos, Qkeymap, string);
1638 if (!NILP (map))
1639 keymap = map;
1645 if (!NILP (local_map))
1646 keymaps = Fcons (local_map, keymaps);
1648 /* Now put all the minor mode keymaps on the list. */
1649 nmaps = current_minor_maps (0, &maps);
1651 for (i = --nmaps; i >= 0; i--)
1652 if (!NILP (maps[i]))
1653 keymaps = Fcons (maps[i], keymaps);
1655 if (!NILP (keymap))
1656 keymaps = Fcons (keymap, keymaps);
1659 unbind_to (count, Qnil);
1661 return keymaps;
1664 /* GC is possible in this function if it autoloads a keymap. */
1666 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1667 doc: /* Return the binding for command KEY in current keymaps.
1668 KEY is a string or vector, a sequence of keystrokes.
1669 The binding is probably a symbol with a function definition.
1671 Normally, `key-binding' ignores bindings for t, which act as default
1672 bindings, used when nothing else in the keymap applies; this makes it
1673 usable as a general function for probing keymaps. However, if the
1674 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1675 recognize the default bindings, just as `read-key-sequence' does.
1677 Like the normal command loop, `key-binding' will remap the command
1678 resulting from looking up KEY by looking up the command in the
1679 current keymaps. However, if the optional third argument NO-REMAP
1680 is non-nil, `key-binding' returns the unmapped command.
1682 If KEY is a key sequence initiated with the mouse, the used keymaps
1683 will depend on the clicked mouse position with regard to the buffer
1684 and possible local keymaps on strings.
1686 If the optional argument POSITION is non-nil, it specifies a mouse
1687 position as returned by `event-start' and `event-end', and the lookup
1688 occurs in the keymaps associated with it instead of KEY. It can also
1689 be a number or marker, in which case the keymap properties at the
1690 specified buffer position instead of point are used.
1692 (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
1694 Lisp_Object *maps, value;
1695 int nmaps, i;
1696 struct gcpro gcpro1, gcpro2;
1697 int count = SPECPDL_INDEX ();
1699 GCPRO2 (key, position);
1701 if (NILP (position) && VECTORP (key))
1703 Lisp_Object event
1704 /* mouse events may have a symbolic prefix indicating the
1705 scrollbar or mode line */
1706 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1708 /* We are not interested in locations without event data */
1710 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1712 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1713 if (EQ (kind, Qmouse_click))
1714 position = EVENT_START (event);
1718 /* Key sequences beginning with mouse clicks
1719 are read using the keymaps of the buffer clicked on, not
1720 the current buffer. So we may have to switch the buffer
1721 here. */
1723 if (CONSP (position))
1725 Lisp_Object window;
1727 window = POSN_WINDOW (position);
1729 if (WINDOWP (window)
1730 && BUFFERP (XWINDOW (window)->buffer)
1731 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1733 /* Arrange to go back to the original buffer once we're done
1734 processing the key sequence. We don't use
1735 save_excursion_{save,restore} here, in analogy to
1736 `read-key-sequence' to avoid saving point. Maybe this
1737 would not be a problem here, but it is easier to keep
1738 things the same.
1741 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1743 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1747 if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
1749 value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map),
1750 key, accept_default);
1751 if (! NILP (value) && !INTEGERP (value))
1752 goto done;
1754 else if (! NILP (Voverriding_local_map))
1756 value = Flookup_key (Voverriding_local_map, key, accept_default);
1757 if (! NILP (value) && !INTEGERP (value))
1758 goto done;
1760 else
1762 Lisp_Object keymap, local_map;
1763 EMACS_INT pt;
1765 pt = INTEGERP (position) ? XINT (position)
1766 : MARKERP (position) ? marker_position (position)
1767 : PT;
1769 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1770 keymap = get_local_map (pt, current_buffer, Qkeymap);
1772 if (CONSP (position))
1774 Lisp_Object string;
1776 /* For a mouse click, get the local text-property keymap
1777 of the place clicked on, rather than point. */
1779 if (POSN_INBUFFER_P (position))
1781 Lisp_Object pos;
1783 pos = POSN_BUFFER_POSN (position);
1784 if (INTEGERP (pos)
1785 && XINT (pos) >= BEG && XINT (pos) <= Z)
1787 local_map = get_local_map (XINT (pos),
1788 current_buffer, Qlocal_map);
1790 keymap = get_local_map (XINT (pos),
1791 current_buffer, Qkeymap);
1795 /* If on a mode line string with a local keymap,
1796 or for a click on a string, i.e. overlay string or a
1797 string displayed via the `display' property,
1798 consider `local-map' and `keymap' properties of
1799 that string. */
1801 if (string = POSN_STRING (position),
1802 (CONSP (string) && STRINGP (XCAR (string))))
1804 Lisp_Object pos, map;
1806 pos = XCDR (string);
1807 string = XCAR (string);
1808 if (INTEGERP (pos)
1809 && XINT (pos) >= 0
1810 && XINT (pos) < SCHARS (string))
1812 map = Fget_text_property (pos, Qlocal_map, string);
1813 if (!NILP (map))
1814 local_map = map;
1816 map = Fget_text_property (pos, Qkeymap, string);
1817 if (!NILP (map))
1818 keymap = map;
1824 if (! NILP (keymap))
1826 value = Flookup_key (keymap, key, accept_default);
1827 if (! NILP (value) && !INTEGERP (value))
1828 goto done;
1831 nmaps = current_minor_maps (0, &maps);
1832 /* Note that all these maps are GCPRO'd
1833 in the places where we found them. */
1835 for (i = 0; i < nmaps; i++)
1836 if (! NILP (maps[i]))
1838 value = Flookup_key (maps[i], key, accept_default);
1839 if (! NILP (value) && !INTEGERP (value))
1840 goto done;
1843 if (! NILP (local_map))
1845 value = Flookup_key (local_map, key, accept_default);
1846 if (! NILP (value) && !INTEGERP (value))
1847 goto done;
1851 value = Flookup_key (current_global_map, key, accept_default);
1853 done:
1854 unbind_to (count, Qnil);
1856 UNGCPRO;
1857 if (NILP (value) || INTEGERP (value))
1858 return Qnil;
1860 /* If the result of the ordinary keymap lookup is an interactive
1861 command, look for a key binding (ie. remapping) for that command. */
1863 if (NILP (no_remap) && SYMBOLP (value))
1865 Lisp_Object value1;
1866 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1867 value = value1;
1870 return value;
1873 /* GC is possible in this function if it autoloads a keymap. */
1875 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1876 doc: /* Return the binding for command KEYS in current local keymap only.
1877 KEYS is a string or vector, a sequence of keystrokes.
1878 The binding is probably a symbol with a function definition.
1880 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1881 bindings; see the description of `lookup-key' for more details about this. */)
1882 (Lisp_Object keys, Lisp_Object accept_default)
1884 register Lisp_Object map;
1885 map = BVAR (current_buffer, keymap);
1886 if (NILP (map))
1887 return Qnil;
1888 return Flookup_key (map, keys, accept_default);
1891 /* GC is possible in this function if it autoloads a keymap. */
1893 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1894 doc: /* Return the binding for command KEYS in current global keymap only.
1895 KEYS is a string or vector, a sequence of keystrokes.
1896 The binding is probably a symbol with a function definition.
1897 This function's return values are the same as those of `lookup-key'
1898 \(which see).
1900 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1901 bindings; see the description of `lookup-key' for more details about this. */)
1902 (Lisp_Object keys, Lisp_Object accept_default)
1904 return Flookup_key (current_global_map, keys, accept_default);
1907 /* GC is possible in this function if it autoloads a keymap. */
1909 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1910 doc: /* Find the visible minor mode bindings of KEY.
1911 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1912 the symbol which names the minor mode binding KEY, and BINDING is
1913 KEY's definition in that mode. In particular, if KEY has no
1914 minor-mode bindings, return nil. If the first binding is a
1915 non-prefix, all subsequent bindings will be omitted, since they would
1916 be ignored. Similarly, the list doesn't include non-prefix bindings
1917 that come after prefix bindings.
1919 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1920 bindings; see the description of `lookup-key' for more details about this. */)
1921 (Lisp_Object key, Lisp_Object accept_default)
1923 Lisp_Object *modes, *maps;
1924 int nmaps;
1925 Lisp_Object binding;
1926 int i, j;
1927 struct gcpro gcpro1, gcpro2;
1929 nmaps = current_minor_maps (&modes, &maps);
1930 /* Note that all these maps are GCPRO'd
1931 in the places where we found them. */
1933 binding = Qnil;
1934 GCPRO2 (key, binding);
1936 for (i = j = 0; i < nmaps; i++)
1937 if (!NILP (maps[i])
1938 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1939 && !INTEGERP (binding))
1941 if (KEYMAPP (binding))
1942 maps[j++] = Fcons (modes[i], binding);
1943 else if (j == 0)
1944 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1947 UNGCPRO;
1948 return Flist (j, maps);
1951 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1952 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1953 A new sparse keymap is stored as COMMAND's function definition and its value.
1954 If a second optional argument MAPVAR is given, the map is stored as
1955 its value instead of as COMMAND's value; but COMMAND is still defined
1956 as a function.
1957 The third optional argument NAME, if given, supplies a menu name
1958 string for the map. This is required to use the keymap as a menu.
1959 This function returns COMMAND. */)
1960 (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name)
1962 Lisp_Object map;
1963 map = Fmake_sparse_keymap (name);
1964 Ffset (command, map);
1965 if (!NILP (mapvar))
1966 Fset (mapvar, map);
1967 else
1968 Fset (command, map);
1969 return command;
1972 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1973 doc: /* Select KEYMAP as the global keymap. */)
1974 (Lisp_Object keymap)
1976 keymap = get_keymap (keymap, 1, 1);
1977 current_global_map = keymap;
1979 return Qnil;
1982 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1983 doc: /* Select KEYMAP as the local keymap.
1984 If KEYMAP is nil, that means no local keymap. */)
1985 (Lisp_Object keymap)
1987 if (!NILP (keymap))
1988 keymap = get_keymap (keymap, 1, 1);
1990 BVAR (current_buffer, keymap) = keymap;
1992 return Qnil;
1995 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1996 doc: /* Return current buffer's local keymap, or nil if it has none.
1997 Normally the local keymap is set by the major mode with `use-local-map'. */)
1998 (void)
2000 return BVAR (current_buffer, keymap);
2003 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2004 doc: /* Return the current global keymap. */)
2005 (void)
2007 return current_global_map;
2010 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2011 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2012 (void)
2014 Lisp_Object *maps;
2015 int nmaps = current_minor_maps (0, &maps);
2017 return Flist (nmaps, maps);
2020 /* Help functions for describing and documenting keymaps. */
2022 struct accessible_keymaps_data {
2023 Lisp_Object maps, tail, thisseq;
2024 /* Does the current sequence end in the meta-prefix-char? */
2025 int is_metized;
2028 static void
2029 accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *data)
2030 /* Use void* data to be compatible with map_keymap_function_t. */
2032 struct accessible_keymaps_data *d = data; /* Cast! */
2033 Lisp_Object maps = d->maps;
2034 Lisp_Object tail = d->tail;
2035 Lisp_Object thisseq = d->thisseq;
2036 int is_metized = d->is_metized && INTEGERP (key);
2037 Lisp_Object tem;
2039 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2040 if (NILP (cmd))
2041 return;
2043 /* Look for and break cycles. */
2044 while (!NILP (tem = Frassq (cmd, maps)))
2046 Lisp_Object prefix = XCAR (tem);
2047 int lim = XINT (Flength (XCAR (tem)));
2048 if (lim <= XINT (Flength (thisseq)))
2049 { /* This keymap was already seen with a smaller prefix. */
2050 int i = 0;
2051 while (i < lim && EQ (Faref (prefix, make_number (i)),
2052 Faref (thisseq, make_number (i))))
2053 i++;
2054 if (i >= lim)
2055 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2056 return;
2058 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2059 but maybe `cmd' occurs again further down in `maps', so keep
2060 looking. */
2061 maps = XCDR (Fmemq (tem, maps));
2064 /* If the last key in thisseq is meta-prefix-char,
2065 turn it into a meta-ized keystroke. We know
2066 that the event we're about to append is an
2067 ascii keystroke since we're processing a
2068 keymap table. */
2069 if (is_metized)
2071 int meta_bit = meta_modifier;
2072 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2073 tem = Fcopy_sequence (thisseq);
2075 Faset (tem, last, make_number (XINT (key) | meta_bit));
2077 /* This new sequence is the same length as
2078 thisseq, so stick it in the list right
2079 after this one. */
2080 XSETCDR (tail,
2081 Fcons (Fcons (tem, cmd), XCDR (tail)));
2083 else
2085 tem = append_key (thisseq, key);
2086 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2090 /* This function cannot GC. */
2092 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2093 1, 2, 0,
2094 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2095 Returns a list of elements of the form (KEYS . MAP), where the sequence
2096 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2097 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2098 An optional argument PREFIX, if non-nil, should be a key sequence;
2099 then the value includes only maps for prefixes that start with PREFIX. */)
2100 (Lisp_Object keymap, Lisp_Object prefix)
2102 Lisp_Object maps, tail;
2103 int prefixlen = XINT (Flength (prefix));
2105 /* no need for gcpro because we don't autoload any keymaps. */
2107 if (!NILP (prefix))
2109 /* If a prefix was specified, start with the keymap (if any) for
2110 that prefix, so we don't waste time considering other prefixes. */
2111 Lisp_Object tem;
2112 tem = Flookup_key (keymap, prefix, Qt);
2113 /* Flookup_key may give us nil, or a number,
2114 if the prefix is not defined in this particular map.
2115 It might even give us a list that isn't a keymap. */
2116 tem = get_keymap (tem, 0, 0);
2117 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2118 want to return it. */
2119 if (!NILP (tem))
2121 /* Convert PREFIX to a vector now, so that later on
2122 we don't have to deal with the possibility of a string. */
2123 if (STRINGP (prefix))
2125 int i, i_byte, c;
2126 Lisp_Object copy;
2128 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2129 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2131 int i_before = i;
2133 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2134 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2135 c ^= 0200 | meta_modifier;
2136 ASET (copy, i_before, make_number (c));
2138 prefix = copy;
2140 maps = Fcons (Fcons (prefix, tem), Qnil);
2142 else
2143 return Qnil;
2145 else
2146 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2147 get_keymap (keymap, 1, 0)),
2148 Qnil);
2150 /* For each map in the list maps,
2151 look at any other maps it points to,
2152 and stick them at the end if they are not already in the list.
2154 This is a breadth-first traversal, where tail is the queue of
2155 nodes, and maps accumulates a list of all nodes visited. */
2157 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2159 struct accessible_keymaps_data data;
2160 register Lisp_Object thismap = Fcdr (XCAR (tail));
2161 Lisp_Object last;
2163 data.thisseq = Fcar (XCAR (tail));
2164 data.maps = maps;
2165 data.tail = tail;
2166 last = make_number (XINT (Flength (data.thisseq)) - 1);
2167 /* Does the current sequence end in the meta-prefix-char? */
2168 data.is_metized = (XINT (last) >= 0
2169 /* Don't metize the last char of PREFIX. */
2170 && XINT (last) >= prefixlen
2171 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2173 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2174 if (CONSP (thismap))
2175 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2177 return maps;
2179 static Lisp_Object Qsingle_key_description, Qkey_description;
2181 /* This function cannot GC. */
2183 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2184 doc: /* Return a pretty description of key-sequence KEYS.
2185 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2186 Control characters turn into "C-foo" sequences, meta into "M-foo",
2187 spaces are put between sequence elements, etc. */)
2188 (Lisp_Object keys, Lisp_Object prefix)
2190 int len = 0;
2191 int i, i_byte;
2192 Lisp_Object *args;
2193 int size = XINT (Flength (keys));
2194 Lisp_Object list;
2195 Lisp_Object sep = build_string (" ");
2196 Lisp_Object key;
2197 int add_meta = 0;
2199 if (!NILP (prefix))
2200 size += XINT (Flength (prefix));
2202 /* This has one extra element at the end that we don't pass to Fconcat. */
2203 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2205 /* In effect, this computes
2206 (mapconcat 'single-key-description keys " ")
2207 but we shouldn't use mapconcat because it can do GC. */
2209 next_list:
2210 if (!NILP (prefix))
2211 list = prefix, prefix = Qnil;
2212 else if (!NILP (keys))
2213 list = keys, keys = Qnil;
2214 else
2216 if (add_meta)
2218 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2219 len += 2;
2221 else if (len == 0)
2222 return empty_unibyte_string;
2223 return Fconcat (len - 1, args);
2226 if (STRINGP (list))
2227 size = SCHARS (list);
2228 else if (VECTORP (list))
2229 size = ASIZE (list);
2230 else if (CONSP (list))
2231 size = XINT (Flength (list));
2232 else
2233 wrong_type_argument (Qarrayp, list);
2235 i = i_byte = 0;
2237 while (i < size)
2239 if (STRINGP (list))
2241 int c;
2242 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2243 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2244 c ^= 0200 | meta_modifier;
2245 XSETFASTINT (key, c);
2247 else if (VECTORP (list))
2249 key = AREF (list, i); i++;
2251 else
2253 key = XCAR (list);
2254 list = XCDR (list);
2255 i++;
2258 if (add_meta)
2260 if (!INTEGERP (key)
2261 || EQ (key, meta_prefix_char)
2262 || (XINT (key) & meta_modifier))
2264 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2265 args[len++] = sep;
2266 if (EQ (key, meta_prefix_char))
2267 continue;
2269 else
2270 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2271 add_meta = 0;
2273 else if (EQ (key, meta_prefix_char))
2275 add_meta = 1;
2276 continue;
2278 args[len++] = Fsingle_key_description (key, Qnil);
2279 args[len++] = sep;
2281 goto next_list;
2285 char *
2286 push_key_description (register unsigned int c, register char *p, int force_multibyte)
2288 unsigned c2;
2290 /* Clear all the meaningless bits above the meta bit. */
2291 c &= meta_modifier | ~ - meta_modifier;
2292 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2293 | meta_modifier | shift_modifier | super_modifier);
2295 if (! CHARACTERP (make_number (c2)))
2297 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2298 p += sprintf (p, "[%d]", c);
2299 return p;
2302 if (c & alt_modifier)
2304 *p++ = 'A';
2305 *p++ = '-';
2306 c -= alt_modifier;
2308 if ((c & ctrl_modifier) != 0
2309 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2311 *p++ = 'C';
2312 *p++ = '-';
2313 c &= ~ctrl_modifier;
2315 if (c & hyper_modifier)
2317 *p++ = 'H';
2318 *p++ = '-';
2319 c -= hyper_modifier;
2321 if (c & meta_modifier)
2323 *p++ = 'M';
2324 *p++ = '-';
2325 c -= meta_modifier;
2327 if (c & shift_modifier)
2329 *p++ = 'S';
2330 *p++ = '-';
2331 c -= shift_modifier;
2333 if (c & super_modifier)
2335 *p++ = 's';
2336 *p++ = '-';
2337 c -= super_modifier;
2339 if (c < 040)
2341 if (c == 033)
2343 *p++ = 'E';
2344 *p++ = 'S';
2345 *p++ = 'C';
2347 else if (c == '\t')
2349 *p++ = 'T';
2350 *p++ = 'A';
2351 *p++ = 'B';
2353 else if (c == Ctl ('M'))
2355 *p++ = 'R';
2356 *p++ = 'E';
2357 *p++ = 'T';
2359 else
2361 /* `C-' already added above. */
2362 if (c > 0 && c <= Ctl ('Z'))
2363 *p++ = c + 0140;
2364 else
2365 *p++ = c + 0100;
2368 else if (c == 0177)
2370 *p++ = 'D';
2371 *p++ = 'E';
2372 *p++ = 'L';
2374 else if (c == ' ')
2376 *p++ = 'S';
2377 *p++ = 'P';
2378 *p++ = 'C';
2380 else if (c < 128
2381 || (NILP (BVAR (current_buffer, enable_multibyte_characters))
2382 && SINGLE_BYTE_CHAR_P (c)
2383 && !force_multibyte))
2385 *p++ = c;
2387 else
2389 /* Now we are sure that C is a valid character code. */
2390 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
2391 && ! force_multibyte)
2392 *p++ = multibyte_char_to_unibyte (c);
2393 else
2394 p += CHAR_STRING (c, (unsigned char *) p);
2397 return p;
2400 /* This function cannot GC. */
2402 DEFUN ("single-key-description", Fsingle_key_description,
2403 Ssingle_key_description, 1, 2, 0,
2404 doc: /* Return a pretty description of command character KEY.
2405 Control characters turn into C-whatever, etc.
2406 Optional argument NO-ANGLES non-nil means don't put angle brackets
2407 around function keys and event symbols. */)
2408 (Lisp_Object key, Lisp_Object no_angles)
2410 if (CONSP (key) && lucid_event_type_list_p (key))
2411 key = Fevent_convert_list (key);
2413 key = EVENT_HEAD (key);
2415 if (INTEGERP (key)) /* Normal character */
2417 char tem[KEY_DESCRIPTION_SIZE];
2419 *push_key_description (XUINT (key), tem, 1) = 0;
2420 return build_string (tem);
2422 else if (SYMBOLP (key)) /* Function key or event-symbol */
2424 if (NILP (no_angles))
2426 char *buffer
2427 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2428 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2429 return build_string (buffer);
2431 else
2432 return Fsymbol_name (key);
2434 else if (STRINGP (key)) /* Buffer names in the menubar. */
2435 return Fcopy_sequence (key);
2436 else
2437 error ("KEY must be an integer, cons, symbol, or string");
2438 return Qnil;
2441 static char *
2442 push_text_char_description (register unsigned int c, register char *p)
2444 if (c >= 0200)
2446 *p++ = 'M';
2447 *p++ = '-';
2448 c -= 0200;
2450 if (c < 040)
2452 *p++ = '^';
2453 *p++ = c + 64; /* 'A' - 1 */
2455 else if (c == 0177)
2457 *p++ = '^';
2458 *p++ = '?';
2460 else
2461 *p++ = c;
2462 return p;
2465 /* This function cannot GC. */
2467 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2468 doc: /* Return a pretty description of file-character CHARACTER.
2469 Control characters turn into "^char", etc. This differs from
2470 `single-key-description' which turns them into "C-char".
2471 Also, this function recognizes the 2**7 bit as the Meta character,
2472 whereas `single-key-description' uses the 2**27 bit for Meta.
2473 See Info node `(elisp)Describing Characters' for examples. */)
2474 (Lisp_Object character)
2476 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2477 char str[6];
2478 int c;
2480 CHECK_NUMBER (character);
2482 c = XINT (character);
2483 if (!ASCII_CHAR_P (c))
2485 int len = CHAR_STRING (c, (unsigned char *) str);
2487 return make_multibyte_string (str, 1, len);
2490 *push_text_char_description (c & 0377, str) = 0;
2492 return build_string (str);
2495 static int where_is_preferred_modifier;
2497 /* Return 0 if SEQ uses non-preferred modifiers or non-char events.
2498 Else, return 2 if SEQ uses the where_is_preferred_modifier,
2499 and 1 otherwise. */
2500 static int
2501 preferred_sequence_p (Lisp_Object seq)
2503 int i;
2504 int len = XINT (Flength (seq));
2505 int result = 1;
2507 for (i = 0; i < len; i++)
2509 Lisp_Object ii, elt;
2511 XSETFASTINT (ii, i);
2512 elt = Faref (seq, ii);
2514 if (!INTEGERP (elt))
2515 return 0;
2516 else
2518 int modifiers = XUINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
2519 if (modifiers == where_is_preferred_modifier)
2520 result = 2;
2521 else if (modifiers)
2522 return 0;
2526 return result;
2530 /* where-is - finding a command in a set of keymaps. */
2532 static void where_is_internal_1 (Lisp_Object key, Lisp_Object binding,
2533 Lisp_Object args, void *data);
2535 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2536 Returns the first non-nil binding found in any of those maps.
2537 If REMAP is true, pass the result of the lookup through command
2538 remapping before returning it. */
2540 static Lisp_Object
2541 shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag,
2542 int remap)
2544 Lisp_Object tail, value;
2546 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2548 value = Flookup_key (XCAR (tail), key, flag);
2549 if (NATNUMP (value))
2551 value = Flookup_key (XCAR (tail),
2552 Fsubstring (key, make_number (0), value), flag);
2553 if (!NILP (value))
2554 return Qnil;
2556 else if (!NILP (value))
2558 Lisp_Object remapping;
2559 if (remap && SYMBOLP (value)
2560 && (remapping = Fcommand_remapping (value, Qnil, shadow),
2561 !NILP (remapping)))
2562 return remapping;
2563 else
2564 return value;
2567 return Qnil;
2570 static Lisp_Object Vmouse_events;
2572 struct where_is_internal_data {
2573 Lisp_Object definition, this, last;
2574 int last_is_meta, noindirect;
2575 Lisp_Object sequences;
2578 /* This function can't GC, AFAIK. */
2579 /* Return the list of bindings found. This list is ordered "longest
2580 to shortest". It may include bindings that are actually shadowed
2581 by others, as well as duplicate bindings and remapping bindings.
2582 The list returned is potentially shared with where_is_cache, so
2583 be careful not to modify it via side-effects. */
2585 static Lisp_Object
2586 where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
2587 int noindirect, int nomenus)
2589 Lisp_Object maps = Qnil;
2590 Lisp_Object found;
2591 struct where_is_internal_data data;
2593 /* Only important use of caching is for the menubar
2594 (i.e. where-is-internal called with (def nil t nil nil)). */
2595 if (nomenus && !noindirect)
2597 /* Check heuristic-consistency of the cache. */
2598 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2599 where_is_cache = Qnil;
2601 if (NILP (where_is_cache))
2603 /* We need to create the cache. */
2604 Lisp_Object args[2];
2605 where_is_cache = Fmake_hash_table (0, args);
2606 where_is_cache_keymaps = Qt;
2608 else
2609 /* We can reuse the cache. */
2610 return Fgethash (definition, where_is_cache, Qnil);
2612 else
2613 /* Kill the cache so that where_is_internal_1 doesn't think
2614 we're filling it up. */
2615 where_is_cache = Qnil;
2617 found = keymaps;
2618 while (CONSP (found))
2620 maps =
2621 nconc2 (maps,
2622 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2623 found = XCDR (found);
2626 data.sequences = Qnil;
2627 for (; CONSP (maps); maps = XCDR (maps))
2629 /* Key sequence to reach map, and the map that it reaches */
2630 register Lisp_Object this, map, tem;
2632 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2633 [M-CHAR] sequences, check if last character of the sequence
2634 is the meta-prefix char. */
2635 Lisp_Object last;
2636 int last_is_meta;
2638 this = Fcar (XCAR (maps));
2639 map = Fcdr (XCAR (maps));
2640 last = make_number (XINT (Flength (this)) - 1);
2641 last_is_meta = (XINT (last) >= 0
2642 && EQ (Faref (this, last), meta_prefix_char));
2644 /* if (nomenus && !preferred_sequence_p (this)) */
2645 if (nomenus && XINT (last) >= 0
2646 && SYMBOLP (tem = Faref (this, make_number (0)))
2647 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2648 /* If no menu entries should be returned, skip over the
2649 keymaps bound to `menu-bar' and `tool-bar' and other
2650 non-ascii prefixes like `C-down-mouse-2'. */
2651 continue;
2653 QUIT;
2655 data.definition = definition;
2656 data.noindirect = noindirect;
2657 data.this = this;
2658 data.last = last;
2659 data.last_is_meta = last_is_meta;
2661 if (CONSP (map))
2662 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2665 if (nomenus && !noindirect)
2666 { /* Remember for which keymaps this cache was built.
2667 We do it here (late) because we want to keep where_is_cache_keymaps
2668 set to t while the cache isn't fully filled. */
2669 where_is_cache_keymaps = keymaps;
2670 /* During cache-filling, data.sequences is not filled by
2671 where_is_internal_1. */
2672 return Fgethash (definition, where_is_cache, Qnil);
2674 else
2675 return data.sequences;
2678 /* This function can GC if Flookup_key autoloads any keymaps. */
2680 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2681 doc: /* Return list of keys that invoke DEFINITION.
2682 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2683 If KEYMAP is nil, search all the currently active keymaps.
2684 If KEYMAP is a list of keymaps, search only those keymaps.
2686 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2687 rather than a list of all possible key sequences.
2688 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2689 no matter what it is.
2690 If FIRSTONLY has another non-nil value, prefer bindings
2691 that use the modifier key specified in `where-is-preferred-modifier'
2692 \(or their meta variants) and entirely reject menu bindings.
2694 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2695 to other keymaps or slots. This makes it possible to search for an
2696 indirect definition itself.
2698 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2699 that invoke a command which is remapped to DEFINITION, but include the
2700 remapped command in the returned list. */)
2701 (Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap)
2703 /* The keymaps in which to search. */
2704 Lisp_Object keymaps;
2705 /* Potentially relevant bindings in "shortest to longest" order. */
2706 Lisp_Object sequences = Qnil;
2707 /* Actually relevant bindings. */
2708 Lisp_Object found = Qnil;
2709 /* 1 means ignore all menu bindings entirely. */
2710 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2711 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
2712 /* List of sequences found via remapping. Keep them in a separate
2713 variable, so as to push them later, since we prefer
2714 non-remapped binding. */
2715 Lisp_Object remapped_sequences = Qnil;
2716 /* Whether or not we're handling remapped sequences. This is needed
2717 because remapping is not done recursively by Fcommand_remapping: you
2718 can't remap a remapped command. */
2719 int remapped = 0;
2720 Lisp_Object tem = Qnil;
2722 /* Refresh the C version of the modifier preference. */
2723 where_is_preferred_modifier
2724 = parse_solitary_modifier (Vwhere_is_preferred_modifier);
2726 /* Find the relevant keymaps. */
2727 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2728 keymaps = keymap;
2729 else if (!NILP (keymap))
2730 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2731 else
2732 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2734 GCPRO6 (definition, keymaps, found, sequences, remapped_sequences, tem);
2736 tem = Fcommand_remapping (definition, Qnil, keymaps);
2737 /* If `definition' is remapped to tem', then OT1H no key will run
2738 that command (since they will run `tem' instead), so we should
2739 return nil; but OTOH all keys bound to `definition' (or to `tem')
2740 will run the same command.
2741 So for menu-shortcut purposes, we want to find all the keys bound (maybe
2742 via remapping) to `tem'. But for the purpose of finding the keys that
2743 run `definition', then we'd want to just return nil.
2744 We choose to make it work right for menu-shortcuts, since it's the most
2745 common use.
2746 Known bugs: if you remap switch-to-buffer to toto, C-h f switch-to-buffer
2747 will tell you that switch-to-buffer is bound to C-x b even though C-x b
2748 will run toto instead. And if `toto' is itself remapped to forward-char,
2749 then C-h f toto will tell you that it's bound to C-f even though C-f does
2750 not run toto and it won't tell you that C-x b does run toto. */
2751 if (NILP (no_remap) && !NILP (tem))
2752 definition = tem;
2754 if (SYMBOLP (definition)
2755 && !NILP (firstonly)
2756 && !NILP (tem = Fget (definition, QCadvertised_binding)))
2758 /* We have a list of advertised bindings. */
2759 while (CONSP (tem))
2760 if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
2761 return XCAR (tem);
2762 else
2763 tem = XCDR (tem);
2764 if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition))
2765 return tem;
2768 sequences = Freverse (where_is_internal (definition, keymaps,
2769 !NILP (noindirect), nomenus));
2771 while (CONSP (sequences)
2772 /* If we're at the end of the `sequences' list and we haven't
2773 considered remapped sequences yet, copy them over and
2774 process them. */
2775 || (!remapped && (sequences = remapped_sequences,
2776 remapped = 1,
2777 CONSP (sequences))))
2779 Lisp_Object sequence, function;
2781 sequence = XCAR (sequences);
2782 sequences = XCDR (sequences);
2784 /* Verify that this key binding is not shadowed by another
2785 binding for the same key, before we say it exists.
2787 Mechanism: look for local definition of this key and if
2788 it is defined and does not match what we found then
2789 ignore this key.
2791 Either nil or number as value from Flookup_key
2792 means undefined. */
2793 if (NILP (Fequal (shadow_lookup (keymaps, sequence, Qnil, remapped),
2794 definition)))
2795 continue;
2797 /* If the current sequence is a command remapping with
2798 format [remap COMMAND], find the key sequences
2799 which run COMMAND, and use those sequences instead. */
2800 if (NILP (no_remap) && !remapped
2801 && VECTORP (sequence) && ASIZE (sequence) == 2
2802 && EQ (AREF (sequence, 0), Qremap)
2803 && (function = AREF (sequence, 1), SYMBOLP (function)))
2805 Lisp_Object seqs = where_is_internal (function, keymaps,
2806 !NILP (noindirect), nomenus);
2807 remapped_sequences = nconc2 (Freverse (seqs), remapped_sequences);
2808 continue;
2811 /* Don't annoy user with strings from a menu such as the
2812 entries from the "Edit => Paste from Kill Menu".
2813 Change them all to "(any string)", so that there
2814 seems to be only one menu item to report. */
2815 if (! NILP (sequence))
2817 Lisp_Object tem1;
2818 tem1 = Faref (sequence, make_number (ASIZE (sequence) - 1));
2819 if (STRINGP (tem1))
2820 Faset (sequence, make_number (ASIZE (sequence) - 1),
2821 build_string ("(any string)"));
2824 /* It is a true unshadowed match. Record it, unless it's already
2825 been seen (as could happen when inheriting keymaps). */
2826 if (NILP (Fmember (sequence, found)))
2827 found = Fcons (sequence, found);
2829 /* If firstonly is Qnon_ascii, then we can return the first
2830 binding we find. If firstonly is not Qnon_ascii but not
2831 nil, then we should return the first ascii-only binding
2832 we find. */
2833 if (EQ (firstonly, Qnon_ascii))
2834 RETURN_UNGCPRO (sequence);
2835 else if (!NILP (firstonly)
2836 && 2 == preferred_sequence_p (sequence))
2837 RETURN_UNGCPRO (sequence);
2840 UNGCPRO;
2842 found = Fnreverse (found);
2844 /* firstonly may have been t, but we may have gone all the way through
2845 the keymaps without finding an all-ASCII key sequence. So just
2846 return the best we could find. */
2847 if (NILP (firstonly))
2848 return found;
2849 else if (where_is_preferred_modifier == 0)
2850 return Fcar (found);
2851 else
2852 { /* Maybe we did not find a preferred_modifier binding, but we did find
2853 some ASCII binding. */
2854 Lisp_Object bindings = found;
2855 while (CONSP (bindings))
2856 if (preferred_sequence_p (XCAR (bindings)))
2857 return XCAR (bindings);
2858 else
2859 bindings = XCDR (bindings);
2860 return Fcar (found);
2864 /* This function can GC because get_keyelt can. */
2866 static void
2867 where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, void *data)
2869 struct where_is_internal_data *d = data; /* Cast! */
2870 Lisp_Object definition = d->definition;
2871 int noindirect = d->noindirect;
2872 Lisp_Object this = d->this;
2873 Lisp_Object last = d->last;
2874 int last_is_meta = d->last_is_meta;
2875 Lisp_Object sequence;
2877 /* Search through indirections unless that's not wanted. */
2878 if (!noindirect)
2879 binding = get_keyelt (binding, 0);
2881 /* End this iteration if this element does not match
2882 the target. */
2884 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2885 || EQ (binding, definition)
2886 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2887 /* Doesn't match. */
2888 return;
2890 /* We have found a match. Construct the key sequence where we found it. */
2891 if (INTEGERP (key) && last_is_meta)
2893 sequence = Fcopy_sequence (this);
2894 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2896 else
2898 if (CONSP (key))
2899 key = Fcons (XCAR (key), XCDR (key));
2900 sequence = append_key (this, key);
2903 if (!NILP (where_is_cache))
2905 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2906 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2908 else
2909 d->sequences = Fcons (sequence, d->sequences);
2912 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2914 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2915 doc: /* Insert the list of all defined keys and their definitions.
2916 The list is inserted in the current buffer, while the bindings are
2917 looked up in BUFFER.
2918 The optional argument PREFIX, if non-nil, should be a key sequence;
2919 then we display only bindings that start with that prefix.
2920 The optional argument MENUS, if non-nil, says to mention menu bindings.
2921 \(Ordinarily these are omitted from the output.) */)
2922 (Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus)
2924 Lisp_Object outbuf, shadow;
2925 int nomenu = NILP (menus);
2926 register Lisp_Object start1;
2927 struct gcpro gcpro1;
2929 const char *alternate_heading
2930 = "\
2931 Keyboard translations:\n\n\
2932 You type Translation\n\
2933 -------- -----------\n";
2935 CHECK_BUFFER (buffer);
2937 shadow = Qnil;
2938 GCPRO1 (shadow);
2940 outbuf = Fcurrent_buffer ();
2942 /* Report on alternates for keys. */
2943 if (STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) && !NILP (prefix))
2945 int c;
2946 const unsigned char *translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
2947 int translate_len = SCHARS (KVAR (current_kboard, Vkeyboard_translate_table));
2949 for (c = 0; c < translate_len; c++)
2950 if (translate[c] != c)
2952 char buf[KEY_DESCRIPTION_SIZE];
2953 char *bufend;
2955 if (alternate_heading)
2957 insert_string (alternate_heading);
2958 alternate_heading = 0;
2961 bufend = push_key_description (translate[c], buf, 1);
2962 insert (buf, bufend - buf);
2963 Findent_to (make_number (16), make_number (1));
2964 bufend = push_key_description (c, buf, 1);
2965 insert (buf, bufend - buf);
2967 insert ("\n", 1);
2969 /* Insert calls signal_after_change which may GC. */
2970 translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
2973 insert ("\n", 1);
2976 if (!NILP (Vkey_translation_map))
2977 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2978 "Key translations", nomenu, 1, 0, 0);
2981 /* Print the (major mode) local map. */
2982 start1 = Qnil;
2983 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
2984 start1 = KVAR (current_kboard, Voverriding_terminal_local_map);
2985 else if (!NILP (Voverriding_local_map))
2986 start1 = Voverriding_local_map;
2988 if (!NILP (start1))
2990 describe_map_tree (start1, 1, shadow, prefix,
2991 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
2992 shadow = Fcons (start1, shadow);
2994 else
2996 /* Print the minor mode and major mode keymaps. */
2997 int i, nmaps;
2998 Lisp_Object *modes, *maps;
3000 /* Temporarily switch to `buffer', so that we can get that buffer's
3001 minor modes correctly. */
3002 Fset_buffer (buffer);
3004 nmaps = current_minor_maps (&modes, &maps);
3005 Fset_buffer (outbuf);
3007 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3008 XBUFFER (buffer), Qkeymap);
3009 if (!NILP (start1))
3011 describe_map_tree (start1, 1, shadow, prefix,
3012 "\f\n`keymap' Property Bindings", nomenu,
3013 0, 0, 0);
3014 shadow = Fcons (start1, shadow);
3017 /* Print the minor mode maps. */
3018 for (i = 0; i < nmaps; i++)
3020 /* The title for a minor mode keymap
3021 is constructed at run time.
3022 We let describe_map_tree do the actual insertion
3023 because it takes care of other features when doing so. */
3024 char *title, *p;
3026 if (!SYMBOLP (modes[i]))
3027 abort ();
3029 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3030 *p++ = '\f';
3031 *p++ = '\n';
3032 *p++ = '`';
3033 memcpy (p, SDATA (SYMBOL_NAME (modes[i])),
3034 SCHARS (SYMBOL_NAME (modes[i])));
3035 p += SCHARS (SYMBOL_NAME (modes[i]));
3036 *p++ = '\'';
3037 memcpy (p, " Minor Mode Bindings", strlen (" Minor Mode Bindings"));
3038 p += strlen (" Minor Mode Bindings");
3039 *p = 0;
3041 describe_map_tree (maps[i], 1, shadow, prefix,
3042 title, nomenu, 0, 0, 0);
3043 shadow = Fcons (maps[i], shadow);
3046 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3047 XBUFFER (buffer), Qlocal_map);
3048 if (!NILP (start1))
3050 if (EQ (start1, BVAR (XBUFFER (buffer), keymap)))
3051 describe_map_tree (start1, 1, shadow, prefix,
3052 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3053 else
3054 describe_map_tree (start1, 1, shadow, prefix,
3055 "\f\n`local-map' Property Bindings",
3056 nomenu, 0, 0, 0);
3058 shadow = Fcons (start1, shadow);
3062 describe_map_tree (current_global_map, 1, shadow, prefix,
3063 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3065 /* Print the function-key-map translations under this prefix. */
3066 if (!NILP (KVAR (current_kboard, Vlocal_function_key_map)))
3067 describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix,
3068 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3070 /* Print the input-decode-map translations under this prefix. */
3071 if (!NILP (KVAR (current_kboard, Vinput_decode_map)))
3072 describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix,
3073 "\f\nInput decoding map translations", nomenu, 1, 0, 0);
3075 UNGCPRO;
3076 return Qnil;
3079 /* Insert a description of the key bindings in STARTMAP,
3080 followed by those of all maps reachable through STARTMAP.
3081 If PARTIAL is nonzero, omit certain "uninteresting" commands
3082 (such as `undefined').
3083 If SHADOW is non-nil, it is a list of maps;
3084 don't mention keys which would be shadowed by any of them.
3085 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3086 TITLE, if not 0, is a string to insert at the beginning.
3087 TITLE should not end with a colon or a newline; we supply that.
3088 If NOMENU is not 0, then omit menu-bar commands.
3090 If TRANSL is nonzero, the definitions are actually key translations
3091 so print strings and vectors differently.
3093 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3094 to look through.
3096 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3097 don't omit it; instead, mention it but say it is shadowed. */
3099 void
3100 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3101 Lisp_Object prefix, const char *title, int nomenu, int transl,
3102 int always_title, int mention_shadow)
3104 Lisp_Object maps, orig_maps, seen, sub_shadows;
3105 struct gcpro gcpro1, gcpro2, gcpro3;
3106 int something = 0;
3107 const char *key_heading
3108 = "\
3109 key binding\n\
3110 --- -------\n";
3112 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3113 seen = Qnil;
3114 sub_shadows = Qnil;
3115 GCPRO3 (maps, seen, sub_shadows);
3117 if (nomenu)
3119 Lisp_Object list;
3121 /* Delete from MAPS each element that is for the menu bar. */
3122 for (list = maps; CONSP (list); list = XCDR (list))
3124 Lisp_Object elt, elt_prefix, tem;
3126 elt = XCAR (list);
3127 elt_prefix = Fcar (elt);
3128 if (ASIZE (elt_prefix) >= 1)
3130 tem = Faref (elt_prefix, make_number (0));
3131 if (EQ (tem, Qmenu_bar))
3132 maps = Fdelq (elt, maps);
3137 if (!NILP (maps) || always_title)
3139 if (title)
3141 insert_string (title);
3142 if (!NILP (prefix))
3144 insert_string (" Starting With ");
3145 insert1 (Fkey_description (prefix, Qnil));
3147 insert_string (":\n");
3149 insert_string (key_heading);
3150 something = 1;
3153 for (; CONSP (maps); maps = XCDR (maps))
3155 register Lisp_Object elt, elt_prefix, tail;
3157 elt = XCAR (maps);
3158 elt_prefix = Fcar (elt);
3160 sub_shadows = Qnil;
3162 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3164 Lisp_Object shmap;
3166 shmap = XCAR (tail);
3168 /* If the sequence by which we reach this keymap is zero-length,
3169 then the shadow map for this keymap is just SHADOW. */
3170 if ((STRINGP (elt_prefix) && SCHARS (elt_prefix) == 0)
3171 || (VECTORP (elt_prefix) && ASIZE (elt_prefix) == 0))
3173 /* If the sequence by which we reach this keymap actually has
3174 some elements, then the sequence's definition in SHADOW is
3175 what we should use. */
3176 else
3178 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3179 if (INTEGERP (shmap))
3180 shmap = Qnil;
3183 /* If shmap is not nil and not a keymap,
3184 it completely shadows this map, so don't
3185 describe this map at all. */
3186 if (!NILP (shmap) && !KEYMAPP (shmap))
3187 goto skip;
3189 if (!NILP (shmap))
3190 sub_shadows = Fcons (shmap, sub_shadows);
3193 /* Maps we have already listed in this loop shadow this map. */
3194 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3196 Lisp_Object tem;
3197 tem = Fequal (Fcar (XCAR (tail)), elt_prefix);
3198 if (!NILP (tem))
3199 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3202 describe_map (Fcdr (elt), elt_prefix,
3203 transl ? describe_translation : describe_command,
3204 partial, sub_shadows, &seen, nomenu, mention_shadow);
3206 skip: ;
3209 if (something)
3210 insert_string ("\n");
3212 UNGCPRO;
3215 static int previous_description_column;
3217 static void
3218 describe_command (Lisp_Object definition, Lisp_Object args)
3220 register Lisp_Object tem1;
3221 EMACS_INT column = current_column ();
3222 int description_column;
3224 /* If column 16 is no good, go to col 32;
3225 but don't push beyond that--go to next line instead. */
3226 if (column > 30)
3228 insert_char ('\n');
3229 description_column = 32;
3231 else if (column > 14 || (column > 10 && previous_description_column == 32))
3232 description_column = 32;
3233 else
3234 description_column = 16;
3236 Findent_to (make_number (description_column), make_number (1));
3237 previous_description_column = description_column;
3239 if (SYMBOLP (definition))
3241 tem1 = SYMBOL_NAME (definition);
3242 insert1 (tem1);
3243 insert_string ("\n");
3245 else if (STRINGP (definition) || VECTORP (definition))
3246 insert_string ("Keyboard Macro\n");
3247 else if (KEYMAPP (definition))
3248 insert_string ("Prefix Command\n");
3249 else
3250 insert_string ("??\n");
3253 static void
3254 describe_translation (Lisp_Object definition, Lisp_Object args)
3256 register Lisp_Object tem1;
3258 Findent_to (make_number (16), make_number (1));
3260 if (SYMBOLP (definition))
3262 tem1 = SYMBOL_NAME (definition);
3263 insert1 (tem1);
3264 insert_string ("\n");
3266 else if (STRINGP (definition) || VECTORP (definition))
3268 insert1 (Fkey_description (definition, Qnil));
3269 insert_string ("\n");
3271 else if (KEYMAPP (definition))
3272 insert_string ("Prefix Command\n");
3273 else
3274 insert_string ("??\n");
3277 /* describe_map puts all the usable elements of a sparse keymap
3278 into an array of `struct describe_map_elt',
3279 then sorts them by the events. */
3281 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3283 /* qsort comparison function for sorting `struct describe_map_elt' by
3284 the event field. */
3286 static int
3287 describe_map_compare (const void *aa, const void *bb)
3289 const struct describe_map_elt *a = aa, *b = bb;
3290 if (INTEGERP (a->event) && INTEGERP (b->event))
3291 return ((XINT (a->event) > XINT (b->event))
3292 - (XINT (a->event) < XINT (b->event)));
3293 if (!INTEGERP (a->event) && INTEGERP (b->event))
3294 return 1;
3295 if (INTEGERP (a->event) && !INTEGERP (b->event))
3296 return -1;
3297 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3298 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3299 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3300 : 0);
3301 return 0;
3304 /* Describe the contents of map MAP, assuming that this map itself is
3305 reached by the sequence of prefix keys PREFIX (a string or vector).
3306 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3308 static void
3309 describe_map (Lisp_Object map, Lisp_Object prefix,
3310 void (*elt_describer) (Lisp_Object, Lisp_Object),
3311 int partial, Lisp_Object shadow,
3312 Lisp_Object *seen, int nomenu, int mention_shadow)
3314 Lisp_Object tail, definition, event;
3315 Lisp_Object tem;
3316 Lisp_Object suppress;
3317 Lisp_Object kludge;
3318 int first = 1;
3319 struct gcpro gcpro1, gcpro2, gcpro3;
3321 /* These accumulate the values from sparse keymap bindings,
3322 so we can sort them and handle them in order. */
3323 int length_needed = 0;
3324 struct describe_map_elt *vect;
3325 int slots_used = 0;
3326 int i;
3328 suppress = Qnil;
3330 if (partial)
3331 suppress = intern ("suppress-keymap");
3333 /* This vector gets used to present single keys to Flookup_key. Since
3334 that is done once per keymap element, we don't want to cons up a
3335 fresh vector every time. */
3336 kludge = Fmake_vector (make_number (1), Qnil);
3337 definition = Qnil;
3339 GCPRO3 (prefix, definition, kludge);
3341 map = call1 (Qkeymap_canonicalize, map);
3343 for (tail = map; CONSP (tail); tail = XCDR (tail))
3344 length_needed++;
3346 vect = ((struct describe_map_elt *)
3347 alloca (sizeof (struct describe_map_elt) * length_needed));
3349 for (tail = map; CONSP (tail); tail = XCDR (tail))
3351 QUIT;
3353 if (VECTORP (XCAR (tail))
3354 || CHAR_TABLE_P (XCAR (tail)))
3355 describe_vector (XCAR (tail),
3356 prefix, Qnil, elt_describer, partial, shadow, map,
3357 1, mention_shadow);
3358 else if (CONSP (XCAR (tail)))
3360 int this_shadowed = 0;
3362 event = XCAR (XCAR (tail));
3364 /* Ignore bindings whose "prefix" are not really valid events.
3365 (We get these in the frames and buffers menu.) */
3366 if (!(SYMBOLP (event) || INTEGERP (event)))
3367 continue;
3369 if (nomenu && EQ (event, Qmenu_bar))
3370 continue;
3372 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3374 /* Don't show undefined commands or suppressed commands. */
3375 if (NILP (definition)) continue;
3376 if (SYMBOLP (definition) && partial)
3378 tem = Fget (definition, suppress);
3379 if (!NILP (tem))
3380 continue;
3383 /* Don't show a command that isn't really visible
3384 because a local definition of the same key shadows it. */
3386 ASET (kludge, 0, event);
3387 if (!NILP (shadow))
3389 tem = shadow_lookup (shadow, kludge, Qt, 0);
3390 if (!NILP (tem))
3392 /* If both bindings are keymaps, this key is a prefix key,
3393 so don't say it is shadowed. */
3394 if (KEYMAPP (definition) && KEYMAPP (tem))
3396 /* Avoid generating duplicate entries if the
3397 shadowed binding has the same definition. */
3398 else if (mention_shadow && !EQ (tem, definition))
3399 this_shadowed = 1;
3400 else
3401 continue;
3405 tem = Flookup_key (map, kludge, Qt);
3406 if (!EQ (tem, definition)) continue;
3408 vect[slots_used].event = event;
3409 vect[slots_used].definition = definition;
3410 vect[slots_used].shadowed = this_shadowed;
3411 slots_used++;
3413 else if (EQ (XCAR (tail), Qkeymap))
3415 /* The same keymap might be in the structure twice, if we're
3416 using an inherited keymap. So skip anything we've already
3417 encountered. */
3418 tem = Fassq (tail, *seen);
3419 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3420 break;
3421 *seen = Fcons (Fcons (tail, prefix), *seen);
3425 /* If we found some sparse map events, sort them. */
3427 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3428 describe_map_compare);
3430 /* Now output them in sorted order. */
3432 for (i = 0; i < slots_used; i++)
3434 Lisp_Object start, end;
3436 if (first)
3438 previous_description_column = 0;
3439 insert ("\n", 1);
3440 first = 0;
3443 ASET (kludge, 0, vect[i].event);
3444 start = vect[i].event;
3445 end = start;
3447 definition = vect[i].definition;
3449 /* Find consecutive chars that are identically defined. */
3450 if (INTEGERP (vect[i].event))
3452 while (i + 1 < slots_used
3453 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3454 && !NILP (Fequal (vect[i + 1].definition, definition))
3455 && vect[i].shadowed == vect[i + 1].shadowed)
3456 i++;
3457 end = vect[i].event;
3460 /* Now START .. END is the range to describe next. */
3462 /* Insert the string to describe the event START. */
3463 insert1 (Fkey_description (kludge, prefix));
3465 if (!EQ (start, end))
3467 insert (" .. ", 4);
3469 ASET (kludge, 0, end);
3470 /* Insert the string to describe the character END. */
3471 insert1 (Fkey_description (kludge, prefix));
3474 /* Print a description of the definition of this character.
3475 elt_describer will take care of spacing out far enough
3476 for alignment purposes. */
3477 (*elt_describer) (vect[i].definition, Qnil);
3479 if (vect[i].shadowed)
3481 SET_PT (PT - 1);
3482 insert_string ("\n (that binding is currently shadowed by another mode)");
3483 SET_PT (PT + 1);
3487 UNGCPRO;
3490 static void
3491 describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
3493 Findent_to (make_number (16), make_number (1));
3494 call1 (fun, elt);
3495 Fterpri (Qnil);
3498 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3499 doc: /* Insert a description of contents of VECTOR.
3500 This is text showing the elements of vector matched against indices.
3501 DESCRIBER is the output function used; nil means use `princ'. */)
3502 (Lisp_Object vector, Lisp_Object describer)
3504 int count = SPECPDL_INDEX ();
3505 if (NILP (describer))
3506 describer = intern ("princ");
3507 specbind (Qstandard_output, Fcurrent_buffer ());
3508 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3509 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3510 Qnil, Qnil, 0, 0);
3512 return unbind_to (count, Qnil);
3515 /* Insert in the current buffer a description of the contents of VECTOR.
3516 We call ELT_DESCRIBER to insert the description of one value found
3517 in VECTOR.
3519 ELT_PREFIX describes what "comes before" the keys or indices defined
3520 by this vector. This is a human-readable string whose size
3521 is not necessarily related to the situation.
3523 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3524 leads to this keymap.
3526 If the vector is a chartable, ELT_PREFIX is the vector
3527 of bytes that lead to the character set or portion of a character
3528 set described by this chartable.
3530 If PARTIAL is nonzero, it means do not mention suppressed commands
3531 (that assumes the vector is in a keymap).
3533 SHADOW is a list of keymaps that shadow this map.
3534 If it is non-nil, then we look up the key in those maps
3535 and we don't mention it now if it is defined by any of them.
3537 ENTIRE_MAP is the keymap in which this vector appears.
3538 If the definition in effect in the whole map does not match
3539 the one in this vector, we ignore this one.
3541 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3543 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3545 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3547 static void
3548 describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3549 void (*elt_describer) (Lisp_Object, Lisp_Object),
3550 int partial, Lisp_Object shadow, Lisp_Object entire_map,
3551 int keymap_p, int mention_shadow)
3553 Lisp_Object definition;
3554 Lisp_Object tem2;
3555 Lisp_Object elt_prefix = Qnil;
3556 int i;
3557 Lisp_Object suppress;
3558 Lisp_Object kludge;
3559 int first = 1;
3560 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3561 /* Range of elements to be handled. */
3562 int from, to, stop;
3563 Lisp_Object character;
3564 int starting_i;
3566 suppress = Qnil;
3568 definition = Qnil;
3570 if (!keymap_p)
3572 /* Call Fkey_description first, to avoid GC bug for the other string. */
3573 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3575 Lisp_Object tem;
3576 tem = Fkey_description (prefix, Qnil);
3577 elt_prefix = concat2 (tem, build_string (" "));
3579 prefix = Qnil;
3582 /* This vector gets used to present single keys to Flookup_key. Since
3583 that is done once per vector element, we don't want to cons up a
3584 fresh vector every time. */
3585 kludge = Fmake_vector (make_number (1), Qnil);
3586 GCPRO4 (elt_prefix, prefix, definition, kludge);
3588 if (partial)
3589 suppress = intern ("suppress-keymap");
3591 from = 0;
3592 if (CHAR_TABLE_P (vector))
3593 stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1;
3594 else
3595 stop = to = ASIZE (vector);
3597 for (i = from; ; i++)
3599 int this_shadowed = 0;
3600 int range_beg, range_end;
3601 Lisp_Object val;
3603 QUIT;
3605 if (i == stop)
3607 if (i == to)
3608 break;
3609 stop = to;
3612 starting_i = i;
3614 if (CHAR_TABLE_P (vector))
3616 range_beg = i;
3617 i = stop - 1;
3618 val = char_table_ref_and_range (vector, range_beg, &range_beg, &i);
3620 else
3621 val = AREF (vector, i);
3622 definition = get_keyelt (val, 0);
3624 if (NILP (definition)) continue;
3626 /* Don't mention suppressed commands. */
3627 if (SYMBOLP (definition) && partial)
3629 Lisp_Object tem;
3631 tem = Fget (definition, suppress);
3633 if (!NILP (tem)) continue;
3636 character = make_number (starting_i);
3637 ASET (kludge, 0, character);
3639 /* If this binding is shadowed by some other map, ignore it. */
3640 if (!NILP (shadow))
3642 Lisp_Object tem;
3644 tem = shadow_lookup (shadow, kludge, Qt, 0);
3646 if (!NILP (tem))
3648 if (mention_shadow)
3649 this_shadowed = 1;
3650 else
3651 continue;
3655 /* Ignore this definition if it is shadowed by an earlier
3656 one in the same keymap. */
3657 if (!NILP (entire_map))
3659 Lisp_Object tem;
3661 tem = Flookup_key (entire_map, kludge, Qt);
3663 if (!EQ (tem, definition))
3664 continue;
3667 if (first)
3669 insert ("\n", 1);
3670 first = 0;
3673 /* Output the prefix that applies to every entry in this map. */
3674 if (!NILP (elt_prefix))
3675 insert1 (elt_prefix);
3677 insert1 (Fkey_description (kludge, prefix));
3679 /* Find all consecutive characters or rows that have the same
3680 definition. But, VECTOR is a char-table, we had better put a
3681 boundary between normal characters (-#x3FFF7F) and 8-bit
3682 characters (#x3FFF80-). */
3683 if (CHAR_TABLE_P (vector))
3685 while (i + 1 < stop
3686 && (range_beg = i + 1, range_end = stop - 1,
3687 val = char_table_ref_and_range (vector, range_beg,
3688 &range_beg, &range_end),
3689 tem2 = get_keyelt (val, 0),
3690 !NILP (tem2))
3691 && !NILP (Fequal (tem2, definition)))
3692 i = range_end;
3694 else
3695 while (i + 1 < stop
3696 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3697 !NILP (tem2))
3698 && !NILP (Fequal (tem2, definition)))
3699 i++;
3701 /* If we have a range of more than one character,
3702 print where the range reaches to. */
3704 if (i != starting_i)
3706 insert (" .. ", 4);
3708 ASET (kludge, 0, make_number (i));
3710 if (!NILP (elt_prefix))
3711 insert1 (elt_prefix);
3713 insert1 (Fkey_description (kludge, prefix));
3716 /* Print a description of the definition of this character.
3717 elt_describer will take care of spacing out far enough
3718 for alignment purposes. */
3719 (*elt_describer) (definition, args);
3721 if (this_shadowed)
3723 SET_PT (PT - 1);
3724 insert_string (" (binding currently shadowed)");
3725 SET_PT (PT + 1);
3729 if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
3731 if (!NILP (elt_prefix))
3732 insert1 (elt_prefix);
3733 insert ("default", 7);
3734 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3737 UNGCPRO;
3740 /* Apropos - finding all symbols whose names match a regexp. */
3741 static Lisp_Object apropos_predicate;
3742 static Lisp_Object apropos_accumulate;
3744 static void
3745 apropos_accum (Lisp_Object symbol, Lisp_Object string)
3747 register Lisp_Object tem;
3749 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3750 if (!NILP (tem) && !NILP (apropos_predicate))
3751 tem = call1 (apropos_predicate, symbol);
3752 if (!NILP (tem))
3753 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3756 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3757 doc: /* Show all symbols whose names contain match for REGEXP.
3758 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3759 for each symbol and a symbol is mentioned only if that returns non-nil.
3760 Return list of symbols found. */)
3761 (Lisp_Object regexp, Lisp_Object predicate)
3763 Lisp_Object tem;
3764 CHECK_STRING (regexp);
3765 apropos_predicate = predicate;
3766 apropos_accumulate = Qnil;
3767 map_obarray (Vobarray, apropos_accum, regexp);
3768 tem = Fsort (apropos_accumulate, Qstring_lessp);
3769 apropos_accumulate = Qnil;
3770 apropos_predicate = Qnil;
3771 return tem;
3774 void
3775 syms_of_keymap (void)
3777 Qkeymap = intern_c_string ("keymap");
3778 staticpro (&Qkeymap);
3779 staticpro (&apropos_predicate);
3780 staticpro (&apropos_accumulate);
3781 apropos_predicate = Qnil;
3782 apropos_accumulate = Qnil;
3784 Qkeymap_canonicalize = intern_c_string ("keymap-canonicalize");
3785 staticpro (&Qkeymap_canonicalize);
3787 /* Now we are ready to set up this property, so we can
3788 create char tables. */
3789 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3791 /* Initialize the keymaps standardly used.
3792 Each one is the value of a Lisp variable, and is also
3793 pointed to by a C variable */
3795 global_map = Fmake_keymap (Qnil);
3796 Fset (intern_c_string ("global-map"), global_map);
3798 current_global_map = global_map;
3799 staticpro (&global_map);
3800 staticpro (&current_global_map);
3802 meta_map = Fmake_keymap (Qnil);
3803 Fset (intern_c_string ("esc-map"), meta_map);
3804 Ffset (intern_c_string ("ESC-prefix"), meta_map);
3806 control_x_map = Fmake_keymap (Qnil);
3807 Fset (intern_c_string ("ctl-x-map"), control_x_map);
3808 Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
3810 exclude_keys
3811 = pure_cons (pure_cons (make_pure_c_string ("DEL"), make_pure_c_string ("\\d")),
3812 pure_cons (pure_cons (make_pure_c_string ("TAB"), make_pure_c_string ("\\t")),
3813 pure_cons (pure_cons (make_pure_c_string ("RET"), make_pure_c_string ("\\r")),
3814 pure_cons (pure_cons (make_pure_c_string ("ESC"), make_pure_c_string ("\\e")),
3815 pure_cons (pure_cons (make_pure_c_string ("SPC"), make_pure_c_string (" ")),
3816 Qnil)))));
3817 staticpro (&exclude_keys);
3819 DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
3820 doc: /* List of commands given new key bindings recently.
3821 This is used for internal purposes during Emacs startup;
3822 don't alter it yourself. */);
3823 Vdefine_key_rebound_commands = Qt;
3825 DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map,
3826 doc: /* Default keymap to use when reading from the minibuffer. */);
3827 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3829 DEFVAR_LISP ("minibuffer-local-ns-map", Vminibuffer_local_ns_map,
3830 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
3831 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3832 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3834 DEFVAR_LISP ("minibuffer-local-completion-map", Vminibuffer_local_completion_map,
3835 doc: /* Local keymap for minibuffer input with completion. */);
3836 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3837 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
3839 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
3840 Vminibuffer_local_filename_completion_map,
3841 doc: /* Local keymap for minibuffer input with completion for filenames. */);
3842 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
3843 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
3844 Vminibuffer_local_completion_map);
3847 DEFVAR_LISP ("minibuffer-local-must-match-map", Vminibuffer_local_must_match_map,
3848 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
3849 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3850 Fset_keymap_parent (Vminibuffer_local_must_match_map,
3851 Vminibuffer_local_completion_map);
3853 DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
3854 Vminibuffer_local_filename_must_match_map,
3855 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
3856 Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
3857 Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
3858 Vminibuffer_local_must_match_map);
3860 DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist,
3861 doc: /* Alist of keymaps to use for minor modes.
3862 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3863 key sequences and look up bindings if VARIABLE's value is non-nil.
3864 If two active keymaps bind the same key, the keymap appearing earlier
3865 in the list takes precedence. */);
3866 Vminor_mode_map_alist = Qnil;
3868 DEFVAR_LISP ("minor-mode-overriding-map-alist", Vminor_mode_overriding_map_alist,
3869 doc: /* Alist of keymaps to use for minor modes, in current major mode.
3870 This variable is an alist just like `minor-mode-map-alist', and it is
3871 used the same way (and before `minor-mode-map-alist'); however,
3872 it is provided for major modes to bind locally. */);
3873 Vminor_mode_overriding_map_alist = Qnil;
3875 DEFVAR_LISP ("emulation-mode-map-alists", Vemulation_mode_map_alists,
3876 doc: /* List of keymap alists to use for emulations modes.
3877 It is intended for modes or packages using multiple minor-mode keymaps.
3878 Each element is a keymap alist just like `minor-mode-map-alist', or a
3879 symbol with a variable binding which is a keymap alist, and it is used
3880 the same way. The "active" keymaps in each alist are used before
3881 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3882 Vemulation_mode_map_alists = Qnil;
3884 DEFVAR_LISP ("where-is-preferred-modifier", Vwhere_is_preferred_modifier,
3885 doc: /* Preferred modifier to use for `where-is'.
3886 When a single binding is requested, `where-is' will return one that
3887 uses this modifier if possible. If nil, or if no such binding exists,
3888 bindings using keys without modifiers (or only with meta) will be
3889 preferred. */);
3890 Vwhere_is_preferred_modifier = Qnil;
3891 where_is_preferred_modifier = 0;
3893 staticpro (&Vmouse_events);
3894 Vmouse_events = pure_cons (intern_c_string ("menu-bar"),
3895 pure_cons (intern_c_string ("tool-bar"),
3896 pure_cons (intern_c_string ("header-line"),
3897 pure_cons (intern_c_string ("mode-line"),
3898 pure_cons (intern_c_string ("mouse-1"),
3899 pure_cons (intern_c_string ("mouse-2"),
3900 pure_cons (intern_c_string ("mouse-3"),
3901 pure_cons (intern_c_string ("mouse-4"),
3902 pure_cons (intern_c_string ("mouse-5"),
3903 Qnil)))))))));
3906 Qsingle_key_description = intern_c_string ("single-key-description");
3907 staticpro (&Qsingle_key_description);
3909 Qkey_description = intern_c_string ("key-description");
3910 staticpro (&Qkey_description);
3912 Qkeymapp = intern_c_string ("keymapp");
3913 staticpro (&Qkeymapp);
3915 Qnon_ascii = intern_c_string ("non-ascii");
3916 staticpro (&Qnon_ascii);
3918 Qmenu_item = intern_c_string ("menu-item");
3919 staticpro (&Qmenu_item);
3921 Qremap = intern_c_string ("remap");
3922 staticpro (&Qremap);
3924 QCadvertised_binding = intern_c_string (":advertised-binding");
3925 staticpro (&QCadvertised_binding);
3927 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
3928 staticpro (&command_remapping_vector);
3930 where_is_cache_keymaps = Qt;
3931 where_is_cache = Qnil;
3932 staticpro (&where_is_cache);
3933 staticpro (&where_is_cache_keymaps);
3935 defsubr (&Skeymapp);
3936 defsubr (&Skeymap_parent);
3937 defsubr (&Skeymap_prompt);
3938 defsubr (&Sset_keymap_parent);
3939 defsubr (&Smake_keymap);
3940 defsubr (&Smake_sparse_keymap);
3941 defsubr (&Smap_keymap_internal);
3942 defsubr (&Smap_keymap);
3943 defsubr (&Scopy_keymap);
3944 defsubr (&Scommand_remapping);
3945 defsubr (&Skey_binding);
3946 defsubr (&Slocal_key_binding);
3947 defsubr (&Sglobal_key_binding);
3948 defsubr (&Sminor_mode_key_binding);
3949 defsubr (&Sdefine_key);
3950 defsubr (&Slookup_key);
3951 defsubr (&Sdefine_prefix_command);
3952 defsubr (&Suse_global_map);
3953 defsubr (&Suse_local_map);
3954 defsubr (&Scurrent_local_map);
3955 defsubr (&Scurrent_global_map);
3956 defsubr (&Scurrent_minor_mode_maps);
3957 defsubr (&Scurrent_active_maps);
3958 defsubr (&Saccessible_keymaps);
3959 defsubr (&Skey_description);
3960 defsubr (&Sdescribe_vector);
3961 defsubr (&Ssingle_key_description);
3962 defsubr (&Stext_char_description);
3963 defsubr (&Swhere_is_internal);
3964 defsubr (&Sdescribe_buffer_bindings);
3965 defsubr (&Sapropos_internal);
3968 void
3969 keys_of_keymap (void)
3971 initial_define_key (global_map, 033, "ESC-prefix");
3972 initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");