(c-guess-basic-syntax): Move CASE 19 to a different place, correctly to
[emacs.git] / src / keymap.c
blob4459ef07d68eb190539058d348886c64773609e6
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 /* The number of elements in keymap vectors. */
38 #define DENSE_TABLE_SIZE (0200)
40 /* Actually allocate storage for these variables */
42 Lisp_Object current_global_map; /* Current global keymap */
44 Lisp_Object global_map; /* default global key bindings */
46 Lisp_Object meta_map; /* The keymap used for globally bound
47 ESC-prefixed default commands */
49 Lisp_Object control_x_map; /* The keymap used for globally bound
50 C-x-prefixed default commands */
52 /* The keymap used by the minibuf for local
53 bindings when spaces are allowed in the
54 minibuf */
56 /* The keymap used by the minibuf for local
57 bindings when spaces are not encouraged
58 in the minibuf */
60 /* keymap used for minibuffers when doing completion */
61 /* keymap used for minibuffers when doing completion and require a match */
62 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
63 Lisp_Object QCadvertised_binding;
65 /* Alist of elements like (DEL . "\d"). */
66 static Lisp_Object exclude_keys;
68 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
69 static Lisp_Object command_remapping_vector;
71 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
72 static Lisp_Object where_is_cache;
73 /* Which keymaps are reverse-stored in the cache. */
74 static Lisp_Object where_is_cache_keymaps;
76 static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
77 static void fix_submap_inheritance (Lisp_Object, Lisp_Object, Lisp_Object);
79 static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
80 static void describe_command (Lisp_Object, Lisp_Object);
81 static void describe_translation (Lisp_Object, Lisp_Object);
82 static void describe_map (Lisp_Object, Lisp_Object,
83 void (*) (Lisp_Object, Lisp_Object),
84 int, Lisp_Object, Lisp_Object*, int, int);
85 static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
86 void (*) (Lisp_Object, Lisp_Object), int,
87 Lisp_Object, Lisp_Object, int *,
88 int, int, int);
89 static void silly_event_symbol_error (Lisp_Object);
90 static Lisp_Object get_keyelt (Lisp_Object, int);
92 /* Keymap object support - constructors and predicates. */
94 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
95 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
96 CHARTABLE is a char-table that holds the bindings for all characters
97 without modifiers. All entries in it are initially nil, meaning
98 "command undefined". ALIST is an assoc-list which holds bindings for
99 function keys, mouse events, and any other things that appear in the
100 input stream. Initially, ALIST is nil.
102 The optional arg STRING supplies a menu name for the keymap
103 in case you use it as a menu with `x-popup-menu'. */)
104 (Lisp_Object string)
106 Lisp_Object tail;
107 if (!NILP (string))
108 tail = Fcons (string, Qnil);
109 else
110 tail = Qnil;
111 return Fcons (Qkeymap,
112 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
115 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
116 doc: /* Construct and return a new sparse keymap.
117 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
118 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
119 which binds the function key or mouse event SYMBOL to DEFINITION.
120 Initially the alist is nil.
122 The optional arg STRING supplies a menu name for the keymap
123 in case you use it as a menu with `x-popup-menu'. */)
124 (Lisp_Object string)
126 if (!NILP (string))
128 if (!NILP (Vpurify_flag))
129 string = Fpurecopy (string);
130 return Fcons (Qkeymap, Fcons (string, Qnil));
132 return Fcons (Qkeymap, Qnil);
135 /* This function is used for installing the standard key bindings
136 at initialization time.
138 For example:
140 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
142 void
143 initial_define_key (Lisp_Object keymap, int key, const char *defname)
145 store_in_keymap (keymap, make_number (key), intern_c_string (defname));
148 void
149 initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname)
151 store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
154 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
155 doc: /* Return t if OBJECT is a keymap.
157 A keymap is a list (keymap . ALIST),
158 or a symbol whose function definition is itself a keymap.
159 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
160 a vector of densely packed bindings for small character codes
161 is also allowed as an element. */)
162 (Lisp_Object object)
164 return (KEYMAPP (object) ? Qt : Qnil);
167 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
168 doc: /* Return the prompt-string of a keymap MAP.
169 If non-nil, the prompt is shown in the echo-area
170 when reading a key-sequence to be looked-up in this keymap. */)
171 (Lisp_Object map)
173 map = get_keymap (map, 0, 0);
174 while (CONSP (map))
176 Lisp_Object tem = XCAR (map);
177 if (STRINGP (tem))
178 return tem;
179 map = XCDR (map);
181 return Qnil;
184 /* Check that OBJECT is a keymap (after dereferencing through any
185 symbols). If it is, return it.
187 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
188 is an autoload form, do the autoload and try again.
189 If AUTOLOAD is nonzero, callers must assume GC is possible.
191 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
192 is zero as well), return Qt.
194 ERROR controls how we respond if OBJECT isn't a keymap.
195 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
197 Note that most of the time, we don't want to pursue autoloads.
198 Functions like Faccessible_keymaps which scan entire keymap trees
199 shouldn't load every autoloaded keymap. I'm not sure about this,
200 but it seems to me that only read_key_sequence, Flookup_key, and
201 Fdefine_key should cause keymaps to be autoloaded.
203 This function can GC when AUTOLOAD is non-zero, because it calls
204 do_autoload which can GC. */
206 Lisp_Object
207 get_keymap (Lisp_Object object, int error, int autoload)
209 Lisp_Object tem;
211 autoload_retry:
212 if (NILP (object))
213 goto end;
214 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
215 return object;
217 tem = indirect_function (object);
218 if (CONSP (tem))
220 if (EQ (XCAR (tem), Qkeymap))
221 return tem;
223 /* Should we do an autoload? Autoload forms for keymaps have
224 Qkeymap as their fifth element. */
225 if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
226 && SYMBOLP (object))
228 Lisp_Object tail;
230 tail = Fnth (make_number (4), tem);
231 if (EQ (tail, Qkeymap))
233 if (autoload)
235 struct gcpro gcpro1, gcpro2;
237 GCPRO2 (tem, object);
238 do_autoload (tem, object);
239 UNGCPRO;
241 goto autoload_retry;
243 else
244 return object;
249 end:
250 if (error)
251 wrong_type_argument (Qkeymapp, object);
252 return Qnil;
255 /* Return the parent map of KEYMAP, or nil if it has none.
256 We assume that KEYMAP is a valid keymap. */
258 Lisp_Object
259 keymap_parent (Lisp_Object keymap, int autoload)
261 Lisp_Object list;
263 keymap = get_keymap (keymap, 1, autoload);
265 /* Skip past the initial element `keymap'. */
266 list = XCDR (keymap);
267 for (; CONSP (list); list = XCDR (list))
269 /* See if there is another `keymap'. */
270 if (KEYMAPP (list))
271 return list;
274 return get_keymap (list, 0, autoload);
277 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
278 doc: /* Return the parent keymap of KEYMAP.
279 If KEYMAP has no parent, return nil. */)
280 (Lisp_Object keymap)
282 return keymap_parent (keymap, 1);
285 /* Check whether MAP is one of MAPS parents. */
287 keymap_memberp (Lisp_Object map, Lisp_Object maps)
289 if (NILP (map)) return 0;
290 while (KEYMAPP (maps) && !EQ (map, maps))
291 maps = keymap_parent (maps, 0);
292 return (EQ (map, maps));
295 /* Set the parent keymap of MAP to PARENT. */
297 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
298 doc: /* Modify KEYMAP to set its parent map to PARENT.
299 Return PARENT. PARENT should be nil or another keymap. */)
300 (Lisp_Object keymap, Lisp_Object parent)
302 Lisp_Object list, prev;
303 struct gcpro gcpro1, gcpro2;
304 int i;
306 /* Force a keymap flush for the next call to where-is.
307 Since this can be called from within where-is, we don't set where_is_cache
308 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
309 be changed during where-is, while where_is_cache_keymaps is only used at
310 the very beginning of where-is and can thus be changed here without any
311 adverse effect.
312 This is a very minor correctness (rather than safety) issue. */
313 where_is_cache_keymaps = Qt;
315 GCPRO2 (keymap, parent);
316 keymap = get_keymap (keymap, 1, 1);
318 if (!NILP (parent))
320 parent = get_keymap (parent, 1, 1);
322 /* Check for cycles. */
323 if (keymap_memberp (keymap, parent))
324 error ("Cyclic keymap inheritance");
327 /* Skip past the initial element `keymap'. */
328 prev = keymap;
329 while (1)
331 list = XCDR (prev);
332 /* If there is a parent keymap here, replace it.
333 If we came to the end, add the parent in PREV. */
334 if (!CONSP (list) || KEYMAPP (list))
336 /* If we already have the right parent, return now
337 so that we avoid the loops below. */
338 if (EQ (XCDR (prev), parent))
339 RETURN_UNGCPRO (parent);
341 CHECK_IMPURE (prev);
342 XSETCDR (prev, parent);
343 break;
345 prev = list;
348 /* Scan through for submaps, and set their parents too. */
350 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
352 /* Stop the scan when we come to the parent. */
353 if (EQ (XCAR (list), Qkeymap))
354 break;
356 /* If this element holds a prefix map, deal with it. */
357 if (CONSP (XCAR (list))
358 && CONSP (XCDR (XCAR (list))))
359 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
360 XCDR (XCAR (list)));
362 if (VECTORP (XCAR (list)))
363 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
364 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
365 fix_submap_inheritance (keymap, make_number (i),
366 XVECTOR (XCAR (list))->contents[i]);
368 if (CHAR_TABLE_P (XCAR (list)))
370 map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
374 RETURN_UNGCPRO (parent);
377 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
378 if EVENT is also a prefix in MAP's parent,
379 make sure that SUBMAP inherits that definition as its own parent. */
381 static void
382 fix_submap_inheritance (Lisp_Object map, Lisp_Object event, Lisp_Object submap)
384 Lisp_Object map_parent, parent_entry;
386 /* SUBMAP is a cons that we found as a key binding.
387 Discard the other things found in a menu key binding. */
389 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
391 /* If it isn't a keymap now, there's no work to do. */
392 if (!CONSP (submap))
393 return;
395 map_parent = keymap_parent (map, 0);
396 if (!NILP (map_parent))
397 parent_entry =
398 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
399 else
400 parent_entry = Qnil;
402 /* If MAP's parent has something other than a keymap,
403 our own submap shadows it completely. */
404 if (!CONSP (parent_entry))
405 return;
407 if (! EQ (parent_entry, submap))
409 Lisp_Object submap_parent;
410 submap_parent = submap;
411 while (1)
413 Lisp_Object tem;
415 tem = keymap_parent (submap_parent, 0);
417 if (KEYMAPP (tem))
419 if (keymap_memberp (tem, parent_entry))
420 /* Fset_keymap_parent could create a cycle. */
421 return;
422 submap_parent = tem;
424 else
425 break;
427 Fset_keymap_parent (submap_parent, parent_entry);
431 /* Look up IDX in MAP. IDX may be any sort of event.
432 Note that this does only one level of lookup; IDX must be a single
433 event, not a sequence.
435 If T_OK is non-zero, bindings for Qt are treated as default
436 bindings; any key left unmentioned by other tables and bindings is
437 given the binding of Qt.
439 If T_OK is zero, bindings for Qt are not treated specially.
441 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
443 Lisp_Object
444 access_keymap (Lisp_Object map, Lisp_Object idx, int t_ok, int noinherit, int autoload)
446 Lisp_Object val;
448 /* Qunbound in VAL means we have found no binding yet. */
449 val = Qunbound;
451 /* If idx is a list (some sort of mouse click, perhaps?),
452 the index we want to use is the car of the list, which
453 ought to be a symbol. */
454 idx = EVENT_HEAD (idx);
456 /* If idx is a symbol, it might have modifiers, which need to
457 be put in the canonical order. */
458 if (SYMBOLP (idx))
459 idx = reorder_modifiers (idx);
460 else if (INTEGERP (idx))
461 /* Clobber the high bits that can be present on a machine
462 with more than 24 bits of integer. */
463 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
465 /* Handle the special meta -> esc mapping. */
466 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
468 /* See if there is a meta-map. If there's none, there is
469 no binding for IDX, unless a default binding exists in MAP. */
470 struct gcpro gcpro1;
471 Lisp_Object meta_map;
472 GCPRO1 (map);
473 /* A strange value in which Meta is set would cause
474 infinite recursion. Protect against that. */
475 if (XINT (meta_prefix_char) & CHAR_META)
476 meta_prefix_char = make_number (27);
477 meta_map = get_keymap (access_keymap (map, meta_prefix_char,
478 t_ok, noinherit, autoload),
479 0, autoload);
480 UNGCPRO;
481 if (CONSP (meta_map))
483 map = meta_map;
484 idx = make_number (XUINT (idx) & ~meta_modifier);
486 else if (t_ok)
487 /* Set IDX to t, so that we only find a default binding. */
488 idx = Qt;
489 else
490 /* We know there is no binding. */
491 return Qnil;
494 /* t_binding is where we put a default binding that applies,
495 to use in case we do not find a binding specifically
496 for this key sequence. */
498 Lisp_Object tail;
499 Lisp_Object t_binding = Qnil;
500 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
502 GCPRO4 (map, tail, idx, t_binding);
504 for (tail = XCDR (map);
505 (CONSP (tail)
506 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
507 tail = XCDR (tail))
509 Lisp_Object binding;
511 binding = XCAR (tail);
512 if (SYMBOLP (binding))
514 /* If NOINHERIT, stop finding prefix definitions
515 after we pass a second occurrence of the `keymap' symbol. */
516 if (noinherit && EQ (binding, Qkeymap))
517 RETURN_UNGCPRO (Qnil);
519 else if (CONSP (binding))
521 Lisp_Object key = XCAR (binding);
523 if (EQ (key, idx))
524 val = XCDR (binding);
525 else if (t_ok && EQ (key, Qt))
527 t_binding = XCDR (binding);
528 t_ok = 0;
531 else if (VECTORP (binding))
533 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
534 val = AREF (binding, XFASTINT (idx));
536 else if (CHAR_TABLE_P (binding))
538 /* Character codes with modifiers
539 are not included in a char-table.
540 All character codes without modifiers are included. */
541 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
543 val = Faref (binding, idx);
544 /* `nil' has a special meaning for char-tables, so
545 we use something else to record an explicitly
546 unbound entry. */
547 if (NILP (val))
548 val = Qunbound;
552 /* If we found a binding, clean it up and return it. */
553 if (!EQ (val, Qunbound))
555 if (EQ (val, Qt))
556 /* A Qt binding is just like an explicit nil binding
557 (i.e. it shadows any parent binding but not bindings in
558 keymaps of lower precedence). */
559 val = Qnil;
560 val = get_keyelt (val, autoload);
561 if (KEYMAPP (val))
562 fix_submap_inheritance (map, idx, val);
563 RETURN_UNGCPRO (val);
565 QUIT;
567 UNGCPRO;
568 return get_keyelt (t_binding, autoload);
572 static void
573 map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
575 /* We should maybe try to detect bindings shadowed by previous
576 ones and things like that. */
577 if (EQ (val, Qt))
578 val = Qnil;
579 (*fun) (key, val, args, data);
582 static void
583 map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
585 if (!NILP (val))
587 map_keymap_function_t fun =
588 (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer;
589 args = XCDR (args);
590 /* If the key is a range, make a copy since map_char_table modifies
591 it in place. */
592 if (CONSP (key))
593 key = Fcons (XCAR (key), XCDR (key));
594 map_keymap_item (fun, XCDR (args), key, val,
595 XSAVE_VALUE (XCAR (args))->pointer);
599 /* Call FUN for every binding in MAP and stop at (and return) the parent.
600 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA). */
601 Lisp_Object
602 map_keymap_internal (Lisp_Object map,
603 map_keymap_function_t fun,
604 Lisp_Object args,
605 void *data)
607 struct gcpro gcpro1, gcpro2, gcpro3;
608 Lisp_Object tail
609 = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
611 GCPRO3 (map, args, tail);
612 for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
614 Lisp_Object binding = XCAR (tail);
616 if (CONSP (binding))
617 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
618 else if (VECTORP (binding))
620 /* Loop over the char values represented in the vector. */
621 int len = ASIZE (binding);
622 int c;
623 for (c = 0; c < len; c++)
625 Lisp_Object character;
626 XSETFASTINT (character, c);
627 map_keymap_item (fun, args, character, AREF (binding, c), data);
630 else if (CHAR_TABLE_P (binding))
632 map_char_table (map_keymap_char_table_item, Qnil, binding,
633 Fcons (make_save_value ((void *) fun, 0),
634 Fcons (make_save_value (data, 0),
635 args)));
638 UNGCPRO;
639 return tail;
642 static void
643 map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
645 call2 (fun, key, val);
648 /* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
649 A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
650 void
651 map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data, int autoload)
653 struct gcpro gcpro1;
654 GCPRO1 (args);
655 map = get_keymap (map, 1, autoload);
656 while (CONSP (map))
658 map = map_keymap_internal (map, fun, args, data);
659 map = get_keymap (map, 0, autoload);
661 UNGCPRO;
664 Lisp_Object Qkeymap_canonicalize;
666 /* Same as map_keymap, but does it right, properly eliminating duplicate
667 bindings due to inheritance. */
668 void
669 map_keymap_canonical (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data)
671 struct gcpro gcpro1;
672 GCPRO1 (args);
673 /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
674 so be careful to ignore errors and to inhibit redisplay. */
675 map = safe_call1 (Qkeymap_canonicalize, map);
676 /* No need to use `map_keymap' here because canonical map has no parent. */
677 map_keymap_internal (map, fun, args, data);
678 UNGCPRO;
681 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
682 doc: /* Call FUNCTION once for each event binding in KEYMAP.
683 FUNCTION is called with two arguments: the event that is bound, and
684 the definition it is bound to. The event may be a character range.
685 If KEYMAP has a parent, this function returns it without processing it. */)
686 (Lisp_Object function, Lisp_Object keymap)
688 struct gcpro gcpro1;
689 GCPRO1 (function);
690 keymap = get_keymap (keymap, 1, 1);
691 keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
692 UNGCPRO;
693 return keymap;
696 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
697 doc: /* Call FUNCTION once for each event binding in KEYMAP.
698 FUNCTION is called with two arguments: the event that is bound, and
699 the definition it is bound to. The event may be a character range.
701 If KEYMAP has a parent, the parent's bindings are included as well.
702 This works recursively: if the parent has itself a parent, then the
703 grandparent's bindings are also included and so on.
704 usage: (map-keymap FUNCTION KEYMAP) */)
705 (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first)
707 if (! NILP (sort_first))
708 return call2 (intern ("map-keymap-sorted"), function, keymap);
710 map_keymap (keymap, map_keymap_call, function, NULL, 1);
711 return Qnil;
714 /* Given OBJECT which was found in a slot in a keymap,
715 trace indirect definitions to get the actual definition of that slot.
716 An indirect definition is a list of the form
717 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
718 and INDEX is the object to look up in KEYMAP to yield the definition.
720 Also if OBJECT has a menu string as the first element,
721 remove that. Also remove a menu help string as second element.
723 If AUTOLOAD is nonzero, load autoloadable keymaps
724 that are referred to with indirection.
726 This can GC because menu_item_eval_property calls Feval. */
728 static Lisp_Object
729 get_keyelt (Lisp_Object object, int autoload)
731 while (1)
733 if (!(CONSP (object)))
734 /* This is really the value. */
735 return object;
737 /* If the keymap contents looks like (keymap ...) or (lambda ...)
738 then use itself. */
739 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
740 return object;
742 /* If the keymap contents looks like (menu-item name . DEFN)
743 or (menu-item name DEFN ...) then use DEFN.
744 This is a new format menu item. */
745 else if (EQ (XCAR (object), Qmenu_item))
747 if (CONSP (XCDR (object)))
749 Lisp_Object tem;
751 object = XCDR (XCDR (object));
752 tem = object;
753 if (CONSP (object))
754 object = XCAR (object);
756 /* If there's a `:filter FILTER', apply FILTER to the
757 menu-item's definition to get the real definition to
758 use. */
759 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
760 if (EQ (XCAR (tem), QCfilter) && autoload)
762 Lisp_Object filter;
763 filter = XCAR (XCDR (tem));
764 filter = list2 (filter, list2 (Qquote, object));
765 object = menu_item_eval_property (filter);
766 break;
769 else
770 /* Invalid keymap. */
771 return object;
774 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
775 Keymap alist elements like (CHAR MENUSTRING . DEFN)
776 will be used by HierarKey menus. */
777 else if (STRINGP (XCAR (object)))
779 object = XCDR (object);
780 /* Also remove a menu help string, if any,
781 following the menu item name. */
782 if (CONSP (object) && STRINGP (XCAR (object)))
783 object = XCDR (object);
784 /* Also remove the sublist that caches key equivalences, if any. */
785 if (CONSP (object) && CONSP (XCAR (object)))
787 Lisp_Object carcar;
788 carcar = XCAR (XCAR (object));
789 if (NILP (carcar) || VECTORP (carcar))
790 object = XCDR (object);
794 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
795 else
797 struct gcpro gcpro1;
798 Lisp_Object map;
799 GCPRO1 (object);
800 map = get_keymap (Fcar_safe (object), 0, autoload);
801 UNGCPRO;
802 return (!CONSP (map) ? object /* Invalid keymap */
803 : access_keymap (map, Fcdr (object), 0, 0, autoload));
808 static Lisp_Object
809 store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
811 /* Flush any reverse-map cache. */
812 where_is_cache = Qnil;
813 where_is_cache_keymaps = Qt;
815 /* If we are preparing to dump, and DEF is a menu element
816 with a menu item indicator, copy it to ensure it is not pure. */
817 if (CONSP (def) && PURE_P (def)
818 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
819 def = Fcons (XCAR (def), XCDR (def));
821 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
822 error ("attempt to define a key in a non-keymap");
824 /* If idx is a cons, and the car part is a character, idx must be of
825 the form (FROM-CHAR . TO-CHAR). */
826 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
827 CHECK_CHARACTER_CDR (idx);
828 else
829 /* If idx is a list (some sort of mouse click, perhaps?),
830 the index we want to use is the car of the list, which
831 ought to be a symbol. */
832 idx = EVENT_HEAD (idx);
834 /* If idx is a symbol, it might have modifiers, which need to
835 be put in the canonical order. */
836 if (SYMBOLP (idx))
837 idx = reorder_modifiers (idx);
838 else if (INTEGERP (idx))
839 /* Clobber the high bits that can be present on a machine
840 with more than 24 bits of integer. */
841 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
843 /* Scan the keymap for a binding of idx. */
845 Lisp_Object tail;
847 /* The cons after which we should insert new bindings. If the
848 keymap has a table element, we record its position here, so new
849 bindings will go after it; this way, the table will stay
850 towards the front of the alist and character lookups in dense
851 keymaps will remain fast. Otherwise, this just points at the
852 front of the keymap. */
853 Lisp_Object insertion_point;
855 insertion_point = keymap;
856 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
858 Lisp_Object elt;
860 elt = XCAR (tail);
861 if (VECTORP (elt))
863 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
865 CHECK_IMPURE (elt);
866 ASET (elt, XFASTINT (idx), def);
867 return def;
869 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
871 int from = XFASTINT (XCAR (idx));
872 int to = XFASTINT (XCDR (idx));
874 if (to >= ASIZE (elt))
875 to = ASIZE (elt) - 1;
876 for (; from <= to; from++)
877 ASET (elt, from, def);
878 if (to == XFASTINT (XCDR (idx)))
879 /* We have defined all keys in IDX. */
880 return def;
882 insertion_point = tail;
884 else if (CHAR_TABLE_P (elt))
886 /* Character codes with modifiers
887 are not included in a char-table.
888 All character codes without modifiers are included. */
889 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
891 Faset (elt, idx,
892 /* `nil' has a special meaning for char-tables, so
893 we use something else to record an explicitly
894 unbound entry. */
895 NILP (def) ? Qt : def);
896 return def;
898 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
900 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
901 return def;
903 insertion_point = tail;
905 else if (CONSP (elt))
907 if (EQ (idx, XCAR (elt)))
909 CHECK_IMPURE (elt);
910 XSETCDR (elt, def);
911 return def;
913 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
915 int from = XFASTINT (XCAR (idx));
916 int to = XFASTINT (XCDR (idx));
918 if (from <= XFASTINT (XCAR (elt))
919 && to >= XFASTINT (XCAR (elt)))
921 XSETCDR (elt, def);
922 if (from == to)
923 return def;
927 else if (EQ (elt, Qkeymap))
928 /* If we find a 'keymap' symbol in the spine of KEYMAP,
929 then we must have found the start of a second keymap
930 being used as the tail of KEYMAP, and a binding for IDX
931 should be inserted before it. */
932 goto keymap_end;
934 QUIT;
937 keymap_end:
938 /* We have scanned the entire keymap, and not found a binding for
939 IDX. Let's add one. */
941 Lisp_Object elt;
943 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
945 /* IDX specifies a range of characters, and not all of them
946 were handled yet, which means this keymap doesn't have a
947 char-table. So, we insert a char-table now. */
948 elt = Fmake_char_table (Qkeymap, Qnil);
949 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
951 else
952 elt = Fcons (idx, def);
953 CHECK_IMPURE (insertion_point);
954 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
958 return def;
961 EXFUN (Fcopy_keymap, 1);
963 Lisp_Object
964 copy_keymap_item (Lisp_Object elt)
966 Lisp_Object res, tem;
968 if (!CONSP (elt))
969 return elt;
971 res = tem = elt;
973 /* Is this a new format menu item. */
974 if (EQ (XCAR (tem), Qmenu_item))
976 /* Copy cell with menu-item marker. */
977 res = elt = Fcons (XCAR (tem), XCDR (tem));
978 tem = XCDR (elt);
979 if (CONSP (tem))
981 /* Copy cell with menu-item name. */
982 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
983 elt = XCDR (elt);
984 tem = XCDR (elt);
986 if (CONSP (tem))
988 /* Copy cell with binding and if the binding is a keymap,
989 copy that. */
990 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
991 elt = XCDR (elt);
992 tem = XCAR (elt);
993 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
994 XSETCAR (elt, Fcopy_keymap (tem));
995 tem = XCDR (elt);
996 if (CONSP (tem) && CONSP (XCAR (tem)))
997 /* Delete cache for key equivalences. */
998 XSETCDR (elt, XCDR (tem));
1001 else
1003 /* It may be an old fomat menu item.
1004 Skip the optional menu string. */
1005 if (STRINGP (XCAR (tem)))
1007 /* Copy the cell, since copy-alist didn't go this deep. */
1008 res = elt = Fcons (XCAR (tem), XCDR (tem));
1009 tem = XCDR (elt);
1010 /* Also skip the optional menu help string. */
1011 if (CONSP (tem) && STRINGP (XCAR (tem)))
1013 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1014 elt = XCDR (elt);
1015 tem = XCDR (elt);
1017 /* There may also be a list that caches key equivalences.
1018 Just delete it for the new keymap. */
1019 if (CONSP (tem)
1020 && CONSP (XCAR (tem))
1021 && (NILP (XCAR (XCAR (tem)))
1022 || VECTORP (XCAR (XCAR (tem)))))
1024 XSETCDR (elt, XCDR (tem));
1025 tem = XCDR (tem);
1027 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1028 XSETCDR (elt, Fcopy_keymap (tem));
1030 else if (EQ (XCAR (tem), Qkeymap))
1031 res = Fcopy_keymap (elt);
1033 return res;
1036 static void
1037 copy_keymap_1 (Lisp_Object chartable, Lisp_Object idx, Lisp_Object elt)
1039 Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
1042 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1043 doc: /* Return a copy of the keymap KEYMAP.
1044 The copy starts out with the same definitions of KEYMAP,
1045 but changing either the copy or KEYMAP does not affect the other.
1046 Any key definitions that are subkeymaps are recursively copied.
1047 However, a key definition which is a symbol whose definition is a keymap
1048 is not copied. */)
1049 (Lisp_Object keymap)
1051 register Lisp_Object copy, tail;
1052 keymap = get_keymap (keymap, 1, 0);
1053 copy = tail = Fcons (Qkeymap, Qnil);
1054 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1056 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1058 Lisp_Object elt = XCAR (keymap);
1059 if (CHAR_TABLE_P (elt))
1061 elt = Fcopy_sequence (elt);
1062 map_char_table (copy_keymap_1, Qnil, elt, elt);
1064 else if (VECTORP (elt))
1066 int i;
1067 elt = Fcopy_sequence (elt);
1068 for (i = 0; i < ASIZE (elt); i++)
1069 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1071 else if (CONSP (elt))
1072 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1073 XSETCDR (tail, Fcons (elt, Qnil));
1074 tail = XCDR (tail);
1075 keymap = XCDR (keymap);
1077 XSETCDR (tail, keymap);
1078 return copy;
1081 /* Simple Keymap mutators and accessors. */
1083 /* GC is possible in this function if it autoloads a keymap. */
1085 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1086 doc: /* In KEYMAP, define key sequence KEY as DEF.
1087 KEYMAP is a keymap.
1089 KEY is a string or a vector of symbols and characters, representing a
1090 sequence of keystrokes and events. Non-ASCII characters with codes
1091 above 127 (such as ISO Latin-1) can be represented by vectors.
1092 Two types of vector have special meanings:
1093 [remap COMMAND] remaps any key binding for COMMAND.
1094 [t] creates a default definition, which applies to any event with no
1095 other definition in KEYMAP.
1097 DEF is anything that can be a key's definition:
1098 nil (means key is undefined in this keymap),
1099 a command (a Lisp function suitable for interactive calling),
1100 a string (treated as a keyboard macro),
1101 a keymap (to define a prefix key),
1102 a symbol (when the key is looked up, the symbol will stand for its
1103 function definition, which should at that time be one of the above,
1104 or another symbol whose function definition is used, etc.),
1105 a cons (STRING . DEFN), meaning that DEFN is the definition
1106 (DEFN should be a valid definition in its own right),
1107 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1108 or an extended menu item definition.
1109 (See info node `(elisp)Extended Menu Items'.)
1111 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1112 binding is altered. If there is no binding for KEY, the new pair
1113 binding KEY to DEF is added at the front of KEYMAP. */)
1114 (Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
1116 register int idx;
1117 register Lisp_Object c;
1118 register Lisp_Object cmd;
1119 int metized = 0;
1120 int meta_bit;
1121 int length;
1122 struct gcpro gcpro1, gcpro2, gcpro3;
1124 GCPRO3 (keymap, key, def);
1125 keymap = get_keymap (keymap, 1, 1);
1127 CHECK_VECTOR_OR_STRING (key);
1129 length = XFASTINT (Flength (key));
1130 if (length == 0)
1131 RETURN_UNGCPRO (Qnil);
1133 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1134 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1136 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1137 ? meta_modifier : 0x80);
1139 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1140 { /* DEF is apparently an XEmacs-style keyboard macro. */
1141 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1142 int i = ASIZE (def);
1143 while (--i >= 0)
1145 Lisp_Object c = AREF (def, i);
1146 if (CONSP (c) && lucid_event_type_list_p (c))
1147 c = Fevent_convert_list (c);
1148 ASET (tmp, i, c);
1150 def = tmp;
1153 idx = 0;
1154 while (1)
1156 c = Faref (key, make_number (idx));
1158 if (CONSP (c))
1160 /* C may be a Lucid style event type list or a cons (FROM .
1161 TO) specifying a range of characters. */
1162 if (lucid_event_type_list_p (c))
1163 c = Fevent_convert_list (c);
1164 else if (CHARACTERP (XCAR (c)))
1165 CHECK_CHARACTER_CDR (c);
1168 if (SYMBOLP (c))
1169 silly_event_symbol_error (c);
1171 if (INTEGERP (c)
1172 && (XINT (c) & meta_bit)
1173 && !metized)
1175 c = meta_prefix_char;
1176 metized = 1;
1178 else
1180 if (INTEGERP (c))
1181 XSETINT (c, XINT (c) & ~meta_bit);
1183 metized = 0;
1184 idx++;
1187 if (!INTEGERP (c) && !SYMBOLP (c)
1188 && (!CONSP (c)
1189 /* If C is a range, it must be a leaf. */
1190 || (INTEGERP (XCAR (c)) && idx != length)))
1191 message_with_string ("Key sequence contains invalid event %s", c, 1);
1193 if (idx == length)
1194 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1196 cmd = access_keymap (keymap, c, 0, 1, 1);
1198 /* If this key is undefined, make it a prefix. */
1199 if (NILP (cmd))
1200 cmd = define_as_prefix (keymap, c);
1202 keymap = get_keymap (cmd, 0, 1);
1203 if (!CONSP (keymap))
1204 /* We must use Fkey_description rather than just passing key to
1205 error; key might be a vector, not a string. */
1206 error ("Key sequence %s starts with non-prefix key %s",
1207 SDATA (Fkey_description (key, Qnil)),
1208 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1209 make_number (idx)),
1210 Qnil)));
1214 /* This function may GC (it calls Fkey_binding). */
1216 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1217 doc: /* Return the remapping for command COMMAND.
1218 Returns nil if COMMAND is not remapped (or not a symbol).
1220 If the optional argument POSITION is non-nil, it specifies a mouse
1221 position as returned by `event-start' and `event-end', and the
1222 remapping occurs in the keymaps associated with it. It can also be a
1223 number or marker, in which case the keymap properties at the specified
1224 buffer position instead of point are used. The KEYMAPS argument is
1225 ignored if POSITION is non-nil.
1227 If the optional argument KEYMAPS is non-nil, it should be a list of
1228 keymaps to search for command remapping. Otherwise, search for the
1229 remapping in all currently active keymaps. */)
1230 (Lisp_Object command, Lisp_Object position, Lisp_Object keymaps)
1232 if (!SYMBOLP (command))
1233 return Qnil;
1235 ASET (command_remapping_vector, 1, command);
1237 if (NILP (keymaps))
1238 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1239 else
1241 Lisp_Object maps, binding;
1243 for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
1245 binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
1246 if (!NILP (binding) && !INTEGERP (binding))
1247 return binding;
1249 return Qnil;
1253 /* Value is number if KEY is too long; nil if valid but has no definition. */
1254 /* GC is possible in this function if it autoloads a keymap. */
1256 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1257 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1258 A value of nil means undefined. See doc of `define-key'
1259 for kinds of definitions.
1261 A number as value means KEY is "too long";
1262 that is, characters or symbols in it except for the last one
1263 fail to be a valid sequence of prefix characters in KEYMAP.
1264 The number is how many characters at the front of KEY
1265 it takes to reach a non-prefix key.
1267 Normally, `lookup-key' ignores bindings for t, which act as default
1268 bindings, used when nothing else in the keymap applies; this makes it
1269 usable as a general function for probing keymaps. However, if the
1270 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1271 recognize the default bindings, just as `read-key-sequence' does. */)
1272 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
1274 register int idx;
1275 register Lisp_Object cmd;
1276 register Lisp_Object c;
1277 int length;
1278 int t_ok = !NILP (accept_default);
1279 struct gcpro gcpro1, gcpro2;
1281 GCPRO2 (keymap, key);
1282 keymap = get_keymap (keymap, 1, 1);
1284 CHECK_VECTOR_OR_STRING (key);
1286 length = XFASTINT (Flength (key));
1287 if (length == 0)
1288 RETURN_UNGCPRO (keymap);
1290 idx = 0;
1291 while (1)
1293 c = Faref (key, make_number (idx++));
1295 if (CONSP (c) && lucid_event_type_list_p (c))
1296 c = Fevent_convert_list (c);
1298 /* Turn the 8th bit of string chars into a meta modifier. */
1299 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1300 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1302 /* Allow string since binding for `menu-bar-select-buffer'
1303 includes the buffer name in the key sequence. */
1304 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1305 message_with_string ("Key sequence contains invalid event %s", c, 1);
1307 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1308 if (idx == length)
1309 RETURN_UNGCPRO (cmd);
1311 keymap = get_keymap (cmd, 0, 1);
1312 if (!CONSP (keymap))
1313 RETURN_UNGCPRO (make_number (idx));
1315 QUIT;
1319 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1320 Assume that currently it does not define C at all.
1321 Return the keymap. */
1323 static Lisp_Object
1324 define_as_prefix (Lisp_Object keymap, Lisp_Object c)
1326 Lisp_Object cmd;
1328 cmd = Fmake_sparse_keymap (Qnil);
1329 /* If this key is defined as a prefix in an inherited keymap,
1330 make it a prefix in this map, and make its definition
1331 inherit the other prefix definition. */
1332 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1333 store_in_keymap (keymap, c, cmd);
1335 return cmd;
1338 /* Append a key to the end of a key sequence. We always make a vector. */
1340 Lisp_Object
1341 append_key (Lisp_Object key_sequence, Lisp_Object key)
1343 Lisp_Object args[2];
1345 args[0] = key_sequence;
1347 args[1] = Fcons (key, Qnil);
1348 return Fvconcat (2, args);
1351 /* Given a event type C which is a symbol,
1352 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1354 static void
1355 silly_event_symbol_error (Lisp_Object c)
1357 Lisp_Object parsed, base, name, assoc;
1358 int modifiers;
1360 parsed = parse_modifiers (c);
1361 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1362 base = XCAR (parsed);
1363 name = Fsymbol_name (base);
1364 /* This alist includes elements such as ("RET" . "\\r"). */
1365 assoc = Fassoc (name, exclude_keys);
1367 if (! NILP (assoc))
1369 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1370 char *p = new_mods;
1371 Lisp_Object keystring;
1372 if (modifiers & alt_modifier)
1373 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1374 if (modifiers & ctrl_modifier)
1375 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1376 if (modifiers & hyper_modifier)
1377 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1378 if (modifiers & meta_modifier)
1379 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1380 if (modifiers & shift_modifier)
1381 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1382 if (modifiers & super_modifier)
1383 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1384 *p = 0;
1386 c = reorder_modifiers (c);
1387 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1389 error ((modifiers & ~meta_modifier
1390 ? "To bind the key %s, use [?%s], not [%s]"
1391 : "To bind the key %s, use \"%s\", not [%s]"),
1392 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1393 SDATA (SYMBOL_NAME (c)));
1397 /* Global, local, and minor mode keymap stuff. */
1399 /* We can't put these variables inside current_minor_maps, since under
1400 some systems, static gets macro-defined to be the empty string.
1401 Ickypoo. */
1402 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1403 static int cmm_size = 0;
1405 /* Store a pointer to an array of the currently active minor modes in
1406 *modeptr, a pointer to an array of the keymaps of the currently
1407 active minor modes in *mapptr, and return the number of maps
1408 *mapptr contains.
1410 This function always returns a pointer to the same buffer, and may
1411 free or reallocate it, so if you want to keep it for a long time or
1412 hand it out to lisp code, copy it. This procedure will be called
1413 for every key sequence read, so the nice lispy approach (return a
1414 new assoclist, list, what have you) for each invocation would
1415 result in a lot of consing over time.
1417 If we used xrealloc/xmalloc and ran out of memory, they would throw
1418 back to the command loop, which would try to read a key sequence,
1419 which would call this function again, resulting in an infinite
1420 loop. Instead, we'll use realloc/malloc and silently truncate the
1421 list, let the key sequence be read, and hope some other piece of
1422 code signals the error. */
1424 current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
1426 int i = 0;
1427 int list_number = 0;
1428 Lisp_Object alist, assoc, var, val;
1429 Lisp_Object emulation_alists;
1430 Lisp_Object lists[2];
1432 emulation_alists = Vemulation_mode_map_alists;
1433 lists[0] = Vminor_mode_overriding_map_alist;
1434 lists[1] = Vminor_mode_map_alist;
1436 for (list_number = 0; list_number < 2; list_number++)
1438 if (CONSP (emulation_alists))
1440 alist = XCAR (emulation_alists);
1441 emulation_alists = XCDR (emulation_alists);
1442 if (SYMBOLP (alist))
1443 alist = find_symbol_value (alist);
1444 list_number = -1;
1446 else
1447 alist = lists[list_number];
1449 for ( ; CONSP (alist); alist = XCDR (alist))
1450 if ((assoc = XCAR (alist), CONSP (assoc))
1451 && (var = XCAR (assoc), SYMBOLP (var))
1452 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1453 && !NILP (val))
1455 Lisp_Object temp;
1457 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1458 and also an entry in Vminor_mode_map_alist,
1459 ignore the latter. */
1460 if (list_number == 1)
1462 val = assq_no_quit (var, lists[0]);
1463 if (!NILP (val))
1464 continue;
1467 if (i >= cmm_size)
1469 int newsize, allocsize;
1470 Lisp_Object *newmodes, *newmaps;
1472 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1473 allocsize = newsize * sizeof *newmodes;
1475 /* Use malloc here. See the comment above this function.
1476 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1477 BLOCK_INPUT;
1478 newmodes = (Lisp_Object *) malloc (allocsize);
1479 if (newmodes)
1481 if (cmm_modes)
1483 memcpy (newmodes, cmm_modes,
1484 cmm_size * sizeof cmm_modes[0]);
1485 free (cmm_modes);
1487 cmm_modes = newmodes;
1490 newmaps = (Lisp_Object *) malloc (allocsize);
1491 if (newmaps)
1493 if (cmm_maps)
1495 memcpy (newmaps, cmm_maps,
1496 cmm_size * sizeof cmm_maps[0]);
1497 free (cmm_maps);
1499 cmm_maps = newmaps;
1501 UNBLOCK_INPUT;
1503 if (newmodes == NULL || newmaps == NULL)
1504 break;
1505 cmm_size = newsize;
1508 /* Get the keymap definition--or nil if it is not defined. */
1509 temp = Findirect_function (XCDR (assoc), Qt);
1510 if (!NILP (temp))
1512 cmm_modes[i] = var;
1513 cmm_maps [i] = temp;
1514 i++;
1519 if (modeptr) *modeptr = cmm_modes;
1520 if (mapptr) *mapptr = cmm_maps;
1521 return i;
1524 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1525 0, 2, 0,
1526 doc: /* Return a list of the currently active keymaps.
1527 OLP if non-nil indicates that we should obey `overriding-local-map' and
1528 `overriding-terminal-local-map'. POSITION can specify a click position
1529 like in the respective argument of `key-binding'. */)
1530 (Lisp_Object olp, Lisp_Object position)
1532 int count = SPECPDL_INDEX ();
1534 Lisp_Object keymaps;
1536 /* If a mouse click position is given, our variables are based on
1537 the buffer clicked on, not the current buffer. So we may have to
1538 switch the buffer here. */
1540 if (CONSP (position))
1542 Lisp_Object window;
1544 window = POSN_WINDOW (position);
1546 if (WINDOWP (window)
1547 && BUFFERP (XWINDOW (window)->buffer)
1548 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1550 /* Arrange to go back to the original buffer once we're done
1551 processing the key sequence. We don't use
1552 save_excursion_{save,restore} here, in analogy to
1553 `read-key-sequence' to avoid saving point. Maybe this
1554 would not be a problem here, but it is easier to keep
1555 things the same.
1558 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1560 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1564 keymaps = Fcons (current_global_map, Qnil);
1566 if (!NILP (olp))
1568 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
1569 keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map), keymaps);
1570 /* The doc said that overriding-terminal-local-map should
1571 override overriding-local-map. The code used them both,
1572 but it seems clearer to use just one. rms, jan 2005. */
1573 else if (!NILP (Voverriding_local_map))
1574 keymaps = Fcons (Voverriding_local_map, keymaps);
1576 if (NILP (XCDR (keymaps)))
1578 Lisp_Object *maps;
1579 int nmaps, i;
1581 Lisp_Object keymap, local_map;
1582 EMACS_INT pt;
1584 pt = INTEGERP (position) ? XINT (position)
1585 : MARKERP (position) ? marker_position (position)
1586 : PT;
1588 /* Get the buffer local maps, possibly overriden by text or
1589 overlay properties */
1591 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1592 keymap = get_local_map (pt, current_buffer, Qkeymap);
1594 if (CONSP (position))
1596 Lisp_Object string;
1598 /* For a mouse click, get the local text-property keymap
1599 of the place clicked on, rather than point. */
1601 if (POSN_INBUFFER_P (position))
1603 Lisp_Object pos;
1605 pos = POSN_BUFFER_POSN (position);
1606 if (INTEGERP (pos)
1607 && XINT (pos) >= BEG && XINT (pos) <= Z)
1609 local_map = get_local_map (XINT (pos),
1610 current_buffer, Qlocal_map);
1612 keymap = get_local_map (XINT (pos),
1613 current_buffer, Qkeymap);
1617 /* If on a mode line string with a local keymap,
1618 or for a click on a string, i.e. overlay string or a
1619 string displayed via the `display' property,
1620 consider `local-map' and `keymap' properties of
1621 that string. */
1623 if (string = POSN_STRING (position),
1624 (CONSP (string) && STRINGP (XCAR (string))))
1626 Lisp_Object pos, map;
1628 pos = XCDR (string);
1629 string = XCAR (string);
1630 if (INTEGERP (pos)
1631 && XINT (pos) >= 0
1632 && XINT (pos) < SCHARS (string))
1634 map = Fget_text_property (pos, Qlocal_map, string);
1635 if (!NILP (map))
1636 local_map = map;
1638 map = Fget_text_property (pos, Qkeymap, string);
1639 if (!NILP (map))
1640 keymap = map;
1646 if (!NILP (local_map))
1647 keymaps = Fcons (local_map, keymaps);
1649 /* Now put all the minor mode keymaps on the list. */
1650 nmaps = current_minor_maps (0, &maps);
1652 for (i = --nmaps; i >= 0; i--)
1653 if (!NILP (maps[i]))
1654 keymaps = Fcons (maps[i], keymaps);
1656 if (!NILP (keymap))
1657 keymaps = Fcons (keymap, keymaps);
1660 unbind_to (count, Qnil);
1662 return keymaps;
1665 /* GC is possible in this function if it autoloads a keymap. */
1667 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1668 doc: /* Return the binding for command KEY in current keymaps.
1669 KEY is a string or vector, a sequence of keystrokes.
1670 The binding is probably a symbol with a function definition.
1672 Normally, `key-binding' ignores bindings for t, which act as default
1673 bindings, used when nothing else in the keymap applies; this makes it
1674 usable as a general function for probing keymaps. However, if the
1675 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1676 recognize the default bindings, just as `read-key-sequence' does.
1678 Like the normal command loop, `key-binding' will remap the command
1679 resulting from looking up KEY by looking up the command in the
1680 current keymaps. However, if the optional third argument NO-REMAP
1681 is non-nil, `key-binding' returns the unmapped command.
1683 If KEY is a key sequence initiated with the mouse, the used keymaps
1684 will depend on the clicked mouse position with regard to the buffer
1685 and possible local keymaps on strings.
1687 If the optional argument POSITION is non-nil, it specifies a mouse
1688 position as returned by `event-start' and `event-end', and the lookup
1689 occurs in the keymaps associated with it instead of KEY. It can also
1690 be a number or marker, in which case the keymap properties at the
1691 specified buffer position instead of point are used.
1693 (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
1695 Lisp_Object *maps, value;
1696 int nmaps, i;
1697 struct gcpro gcpro1, gcpro2;
1698 int count = SPECPDL_INDEX ();
1700 GCPRO2 (key, position);
1702 if (NILP (position) && VECTORP (key))
1704 Lisp_Object event
1705 /* mouse events may have a symbolic prefix indicating the
1706 scrollbar or mode line */
1707 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1709 /* We are not interested in locations without event data */
1711 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1713 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1714 if (EQ (kind, Qmouse_click))
1715 position = EVENT_START (event);
1719 /* Key sequences beginning with mouse clicks
1720 are read using the keymaps of the buffer clicked on, not
1721 the current buffer. So we may have to switch the buffer
1722 here. */
1724 if (CONSP (position))
1726 Lisp_Object window;
1728 window = POSN_WINDOW (position);
1730 if (WINDOWP (window)
1731 && BUFFERP (XWINDOW (window)->buffer)
1732 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1734 /* Arrange to go back to the original buffer once we're done
1735 processing the key sequence. We don't use
1736 save_excursion_{save,restore} here, in analogy to
1737 `read-key-sequence' to avoid saving point. Maybe this
1738 would not be a problem here, but it is easier to keep
1739 things the same.
1742 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1744 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1748 if (! NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
1750 value = Flookup_key (KVAR (current_kboard, Voverriding_terminal_local_map),
1751 key, accept_default);
1752 if (! NILP (value) && !INTEGERP (value))
1753 goto done;
1755 else if (! NILP (Voverriding_local_map))
1757 value = Flookup_key (Voverriding_local_map, key, accept_default);
1758 if (! NILP (value) && !INTEGERP (value))
1759 goto done;
1761 else
1763 Lisp_Object keymap, local_map;
1764 EMACS_INT pt;
1766 pt = INTEGERP (position) ? XINT (position)
1767 : MARKERP (position) ? marker_position (position)
1768 : PT;
1770 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1771 keymap = get_local_map (pt, current_buffer, Qkeymap);
1773 if (CONSP (position))
1775 Lisp_Object string;
1777 /* For a mouse click, get the local text-property keymap
1778 of the place clicked on, rather than point. */
1780 if (POSN_INBUFFER_P (position))
1782 Lisp_Object pos;
1784 pos = POSN_BUFFER_POSN (position);
1785 if (INTEGERP (pos)
1786 && XINT (pos) >= BEG && XINT (pos) <= Z)
1788 local_map = get_local_map (XINT (pos),
1789 current_buffer, Qlocal_map);
1791 keymap = get_local_map (XINT (pos),
1792 current_buffer, Qkeymap);
1796 /* If on a mode line string with a local keymap,
1797 or for a click on a string, i.e. overlay string or a
1798 string displayed via the `display' property,
1799 consider `local-map' and `keymap' properties of
1800 that string. */
1802 if (string = POSN_STRING (position),
1803 (CONSP (string) && STRINGP (XCAR (string))))
1805 Lisp_Object pos, map;
1807 pos = XCDR (string);
1808 string = XCAR (string);
1809 if (INTEGERP (pos)
1810 && XINT (pos) >= 0
1811 && XINT (pos) < SCHARS (string))
1813 map = Fget_text_property (pos, Qlocal_map, string);
1814 if (!NILP (map))
1815 local_map = map;
1817 map = Fget_text_property (pos, Qkeymap, string);
1818 if (!NILP (map))
1819 keymap = map;
1825 if (! NILP (keymap))
1827 value = Flookup_key (keymap, key, accept_default);
1828 if (! NILP (value) && !INTEGERP (value))
1829 goto done;
1832 nmaps = current_minor_maps (0, &maps);
1833 /* Note that all these maps are GCPRO'd
1834 in the places where we found them. */
1836 for (i = 0; i < nmaps; i++)
1837 if (! NILP (maps[i]))
1839 value = Flookup_key (maps[i], key, accept_default);
1840 if (! NILP (value) && !INTEGERP (value))
1841 goto done;
1844 if (! NILP (local_map))
1846 value = Flookup_key (local_map, key, accept_default);
1847 if (! NILP (value) && !INTEGERP (value))
1848 goto done;
1852 value = Flookup_key (current_global_map, key, accept_default);
1854 done:
1855 unbind_to (count, Qnil);
1857 UNGCPRO;
1858 if (NILP (value) || INTEGERP (value))
1859 return Qnil;
1861 /* If the result of the ordinary keymap lookup is an interactive
1862 command, look for a key binding (ie. remapping) for that command. */
1864 if (NILP (no_remap) && SYMBOLP (value))
1866 Lisp_Object value1;
1867 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1868 value = value1;
1871 return value;
1874 /* GC is possible in this function if it autoloads a keymap. */
1876 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1877 doc: /* Return the binding for command KEYS in current local keymap only.
1878 KEYS is a string or vector, a sequence of keystrokes.
1879 The binding is probably a symbol with a function definition.
1881 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1882 bindings; see the description of `lookup-key' for more details about this. */)
1883 (Lisp_Object keys, Lisp_Object accept_default)
1885 register Lisp_Object map;
1886 map = BVAR (current_buffer, keymap);
1887 if (NILP (map))
1888 return Qnil;
1889 return Flookup_key (map, keys, accept_default);
1892 /* GC is possible in this function if it autoloads a keymap. */
1894 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1895 doc: /* Return the binding for command KEYS in current global keymap only.
1896 KEYS is a string or vector, a sequence of keystrokes.
1897 The binding is probably a symbol with a function definition.
1898 This function's return values are the same as those of `lookup-key'
1899 \(which see).
1901 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1902 bindings; see the description of `lookup-key' for more details about this. */)
1903 (Lisp_Object keys, Lisp_Object accept_default)
1905 return Flookup_key (current_global_map, keys, accept_default);
1908 /* GC is possible in this function if it autoloads a keymap. */
1910 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1911 doc: /* Find the visible minor mode bindings of KEY.
1912 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1913 the symbol which names the minor mode binding KEY, and BINDING is
1914 KEY's definition in that mode. In particular, if KEY has no
1915 minor-mode bindings, return nil. If the first binding is a
1916 non-prefix, all subsequent bindings will be omitted, since they would
1917 be ignored. Similarly, the list doesn't include non-prefix bindings
1918 that come after prefix bindings.
1920 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1921 bindings; see the description of `lookup-key' for more details about this. */)
1922 (Lisp_Object key, Lisp_Object accept_default)
1924 Lisp_Object *modes, *maps;
1925 int nmaps;
1926 Lisp_Object binding;
1927 int i, j;
1928 struct gcpro gcpro1, gcpro2;
1930 nmaps = current_minor_maps (&modes, &maps);
1931 /* Note that all these maps are GCPRO'd
1932 in the places where we found them. */
1934 binding = Qnil;
1935 GCPRO2 (key, binding);
1937 for (i = j = 0; i < nmaps; i++)
1938 if (!NILP (maps[i])
1939 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1940 && !INTEGERP (binding))
1942 if (KEYMAPP (binding))
1943 maps[j++] = Fcons (modes[i], binding);
1944 else if (j == 0)
1945 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1948 UNGCPRO;
1949 return Flist (j, maps);
1952 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1953 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1954 A new sparse keymap is stored as COMMAND's function definition and its value.
1955 If a second optional argument MAPVAR is given, the map is stored as
1956 its value instead of as COMMAND's value; but COMMAND is still defined
1957 as a function.
1958 The third optional argument NAME, if given, supplies a menu name
1959 string for the map. This is required to use the keymap as a menu.
1960 This function returns COMMAND. */)
1961 (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name)
1963 Lisp_Object map;
1964 map = Fmake_sparse_keymap (name);
1965 Ffset (command, map);
1966 if (!NILP (mapvar))
1967 Fset (mapvar, map);
1968 else
1969 Fset (command, map);
1970 return command;
1973 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1974 doc: /* Select KEYMAP as the global keymap. */)
1975 (Lisp_Object keymap)
1977 keymap = get_keymap (keymap, 1, 1);
1978 current_global_map = keymap;
1980 return Qnil;
1983 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1984 doc: /* Select KEYMAP as the local keymap.
1985 If KEYMAP is nil, that means no local keymap. */)
1986 (Lisp_Object keymap)
1988 if (!NILP (keymap))
1989 keymap = get_keymap (keymap, 1, 1);
1991 BVAR (current_buffer, keymap) = keymap;
1993 return Qnil;
1996 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1997 doc: /* Return current buffer's local keymap, or nil if it has none.
1998 Normally the local keymap is set by the major mode with `use-local-map'. */)
1999 (void)
2001 return BVAR (current_buffer, keymap);
2004 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2005 doc: /* Return the current global keymap. */)
2006 (void)
2008 return current_global_map;
2011 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2012 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2013 (void)
2015 Lisp_Object *maps;
2016 int nmaps = current_minor_maps (0, &maps);
2018 return Flist (nmaps, maps);
2021 /* Help functions for describing and documenting keymaps. */
2023 struct accessible_keymaps_data {
2024 Lisp_Object maps, tail, thisseq;
2025 /* Does the current sequence end in the meta-prefix-char? */
2026 int is_metized;
2029 static void
2030 accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *data)
2031 /* Use void* data to be compatible with map_keymap_function_t. */
2033 struct accessible_keymaps_data *d = data; /* Cast! */
2034 Lisp_Object maps = d->maps;
2035 Lisp_Object tail = d->tail;
2036 Lisp_Object thisseq = d->thisseq;
2037 int is_metized = d->is_metized && INTEGERP (key);
2038 Lisp_Object tem;
2040 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2041 if (NILP (cmd))
2042 return;
2044 /* Look for and break cycles. */
2045 while (!NILP (tem = Frassq (cmd, maps)))
2047 Lisp_Object prefix = XCAR (tem);
2048 int lim = XINT (Flength (XCAR (tem)));
2049 if (lim <= XINT (Flength (thisseq)))
2050 { /* This keymap was already seen with a smaller prefix. */
2051 int i = 0;
2052 while (i < lim && EQ (Faref (prefix, make_number (i)),
2053 Faref (thisseq, make_number (i))))
2054 i++;
2055 if (i >= lim)
2056 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2057 return;
2059 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2060 but maybe `cmd' occurs again further down in `maps', so keep
2061 looking. */
2062 maps = XCDR (Fmemq (tem, maps));
2065 /* If the last key in thisseq is meta-prefix-char,
2066 turn it into a meta-ized keystroke. We know
2067 that the event we're about to append is an
2068 ascii keystroke since we're processing a
2069 keymap table. */
2070 if (is_metized)
2072 int meta_bit = meta_modifier;
2073 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2074 tem = Fcopy_sequence (thisseq);
2076 Faset (tem, last, make_number (XINT (key) | meta_bit));
2078 /* This new sequence is the same length as
2079 thisseq, so stick it in the list right
2080 after this one. */
2081 XSETCDR (tail,
2082 Fcons (Fcons (tem, cmd), XCDR (tail)));
2084 else
2086 tem = append_key (thisseq, key);
2087 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2091 /* This function cannot GC. */
2093 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2094 1, 2, 0,
2095 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2096 Returns a list of elements of the form (KEYS . MAP), where the sequence
2097 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2098 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2099 An optional argument PREFIX, if non-nil, should be a key sequence;
2100 then the value includes only maps for prefixes that start with PREFIX. */)
2101 (Lisp_Object keymap, Lisp_Object prefix)
2103 Lisp_Object maps, tail;
2104 int prefixlen = XINT (Flength (prefix));
2106 /* no need for gcpro because we don't autoload any keymaps. */
2108 if (!NILP (prefix))
2110 /* If a prefix was specified, start with the keymap (if any) for
2111 that prefix, so we don't waste time considering other prefixes. */
2112 Lisp_Object tem;
2113 tem = Flookup_key (keymap, prefix, Qt);
2114 /* Flookup_key may give us nil, or a number,
2115 if the prefix is not defined in this particular map.
2116 It might even give us a list that isn't a keymap. */
2117 tem = get_keymap (tem, 0, 0);
2118 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2119 want to return it. */
2120 if (!NILP (tem))
2122 /* Convert PREFIX to a vector now, so that later on
2123 we don't have to deal with the possibility of a string. */
2124 if (STRINGP (prefix))
2126 int i, i_byte, c;
2127 Lisp_Object copy;
2129 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2130 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2132 int i_before = i;
2134 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2135 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2136 c ^= 0200 | meta_modifier;
2137 ASET (copy, i_before, make_number (c));
2139 prefix = copy;
2141 maps = Fcons (Fcons (prefix, tem), Qnil);
2143 else
2144 return Qnil;
2146 else
2147 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2148 get_keymap (keymap, 1, 0)),
2149 Qnil);
2151 /* For each map in the list maps,
2152 look at any other maps it points to,
2153 and stick them at the end if they are not already in the list.
2155 This is a breadth-first traversal, where tail is the queue of
2156 nodes, and maps accumulates a list of all nodes visited. */
2158 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2160 struct accessible_keymaps_data data;
2161 register Lisp_Object thismap = Fcdr (XCAR (tail));
2162 Lisp_Object last;
2164 data.thisseq = Fcar (XCAR (tail));
2165 data.maps = maps;
2166 data.tail = tail;
2167 last = make_number (XINT (Flength (data.thisseq)) - 1);
2168 /* Does the current sequence end in the meta-prefix-char? */
2169 data.is_metized = (XINT (last) >= 0
2170 /* Don't metize the last char of PREFIX. */
2171 && XINT (last) >= prefixlen
2172 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2174 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2175 if (CONSP (thismap))
2176 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2178 return maps;
2180 Lisp_Object Qsingle_key_description, Qkey_description;
2182 /* This function cannot GC. */
2184 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2185 doc: /* Return a pretty description of key-sequence KEYS.
2186 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2187 Control characters turn into "C-foo" sequences, meta into "M-foo",
2188 spaces are put between sequence elements, etc. */)
2189 (Lisp_Object keys, Lisp_Object prefix)
2191 int len = 0;
2192 int i, i_byte;
2193 Lisp_Object *args;
2194 int size = XINT (Flength (keys));
2195 Lisp_Object list;
2196 Lisp_Object sep = build_string (" ");
2197 Lisp_Object key;
2198 int add_meta = 0;
2200 if (!NILP (prefix))
2201 size += XINT (Flength (prefix));
2203 /* This has one extra element at the end that we don't pass to Fconcat. */
2204 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2206 /* In effect, this computes
2207 (mapconcat 'single-key-description keys " ")
2208 but we shouldn't use mapconcat because it can do GC. */
2210 next_list:
2211 if (!NILP (prefix))
2212 list = prefix, prefix = Qnil;
2213 else if (!NILP (keys))
2214 list = keys, keys = Qnil;
2215 else
2217 if (add_meta)
2219 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2220 len += 2;
2222 else if (len == 0)
2223 return empty_unibyte_string;
2224 return Fconcat (len - 1, args);
2227 if (STRINGP (list))
2228 size = SCHARS (list);
2229 else if (VECTORP (list))
2230 size = XVECTOR (list)->size;
2231 else if (CONSP (list))
2232 size = XINT (Flength (list));
2233 else
2234 wrong_type_argument (Qarrayp, list);
2236 i = i_byte = 0;
2238 while (i < size)
2240 if (STRINGP (list))
2242 int c;
2243 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2244 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2245 c ^= 0200 | meta_modifier;
2246 XSETFASTINT (key, c);
2248 else if (VECTORP (list))
2250 key = AREF (list, i); i++;
2252 else
2254 key = XCAR (list);
2255 list = XCDR (list);
2256 i++;
2259 if (add_meta)
2261 if (!INTEGERP (key)
2262 || EQ (key, meta_prefix_char)
2263 || (XINT (key) & meta_modifier))
2265 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2266 args[len++] = sep;
2267 if (EQ (key, meta_prefix_char))
2268 continue;
2270 else
2271 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2272 add_meta = 0;
2274 else if (EQ (key, meta_prefix_char))
2276 add_meta = 1;
2277 continue;
2279 args[len++] = Fsingle_key_description (key, Qnil);
2280 args[len++] = sep;
2282 goto next_list;
2286 char *
2287 push_key_description (register unsigned int c, register char *p, int force_multibyte)
2289 unsigned c2;
2291 /* Clear all the meaningless bits above the meta bit. */
2292 c &= meta_modifier | ~ - meta_modifier;
2293 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2294 | meta_modifier | shift_modifier | super_modifier);
2296 if (! CHARACTERP (make_number (c2)))
2298 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2299 p += sprintf (p, "[%d]", c);
2300 return p;
2303 if (c & alt_modifier)
2305 *p++ = 'A';
2306 *p++ = '-';
2307 c -= alt_modifier;
2309 if ((c & ctrl_modifier) != 0
2310 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2312 *p++ = 'C';
2313 *p++ = '-';
2314 c &= ~ctrl_modifier;
2316 if (c & hyper_modifier)
2318 *p++ = 'H';
2319 *p++ = '-';
2320 c -= hyper_modifier;
2322 if (c & meta_modifier)
2324 *p++ = 'M';
2325 *p++ = '-';
2326 c -= meta_modifier;
2328 if (c & shift_modifier)
2330 *p++ = 'S';
2331 *p++ = '-';
2332 c -= shift_modifier;
2334 if (c & super_modifier)
2336 *p++ = 's';
2337 *p++ = '-';
2338 c -= super_modifier;
2340 if (c < 040)
2342 if (c == 033)
2344 *p++ = 'E';
2345 *p++ = 'S';
2346 *p++ = 'C';
2348 else if (c == '\t')
2350 *p++ = 'T';
2351 *p++ = 'A';
2352 *p++ = 'B';
2354 else if (c == Ctl ('M'))
2356 *p++ = 'R';
2357 *p++ = 'E';
2358 *p++ = 'T';
2360 else
2362 /* `C-' already added above. */
2363 if (c > 0 && c <= Ctl ('Z'))
2364 *p++ = c + 0140;
2365 else
2366 *p++ = c + 0100;
2369 else if (c == 0177)
2371 *p++ = 'D';
2372 *p++ = 'E';
2373 *p++ = 'L';
2375 else if (c == ' ')
2377 *p++ = 'S';
2378 *p++ = 'P';
2379 *p++ = 'C';
2381 else if (c < 128
2382 || (NILP (BVAR (current_buffer, enable_multibyte_characters))
2383 && SINGLE_BYTE_CHAR_P (c)
2384 && !force_multibyte))
2386 *p++ = c;
2388 else
2390 /* Now we are sure that C is a valid character code. */
2391 if (NILP (BVAR (current_buffer, enable_multibyte_characters))
2392 && ! force_multibyte)
2393 *p++ = multibyte_char_to_unibyte (c, Qnil);
2394 else
2395 p += CHAR_STRING (c, (unsigned char *) p);
2398 return p;
2401 /* This function cannot GC. */
2403 DEFUN ("single-key-description", Fsingle_key_description,
2404 Ssingle_key_description, 1, 2, 0,
2405 doc: /* Return a pretty description of command character KEY.
2406 Control characters turn into C-whatever, etc.
2407 Optional argument NO-ANGLES non-nil means don't put angle brackets
2408 around function keys and event symbols. */)
2409 (Lisp_Object key, Lisp_Object no_angles)
2411 if (CONSP (key) && lucid_event_type_list_p (key))
2412 key = Fevent_convert_list (key);
2414 key = EVENT_HEAD (key);
2416 if (INTEGERP (key)) /* Normal character */
2418 char tem[KEY_DESCRIPTION_SIZE];
2420 *push_key_description (XUINT (key), tem, 1) = 0;
2421 return build_string (tem);
2423 else if (SYMBOLP (key)) /* Function key or event-symbol */
2425 if (NILP (no_angles))
2427 char *buffer
2428 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2429 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2430 return build_string (buffer);
2432 else
2433 return Fsymbol_name (key);
2435 else if (STRINGP (key)) /* Buffer names in the menubar. */
2436 return Fcopy_sequence (key);
2437 else
2438 error ("KEY must be an integer, cons, symbol, or string");
2439 return Qnil;
2442 char *
2443 push_text_char_description (register unsigned int c, register char *p)
2445 if (c >= 0200)
2447 *p++ = 'M';
2448 *p++ = '-';
2449 c -= 0200;
2451 if (c < 040)
2453 *p++ = '^';
2454 *p++ = c + 64; /* 'A' - 1 */
2456 else if (c == 0177)
2458 *p++ = '^';
2459 *p++ = '?';
2461 else
2462 *p++ = c;
2463 return p;
2466 /* This function cannot GC. */
2468 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2469 doc: /* Return a pretty description of file-character CHARACTER.
2470 Control characters turn into "^char", etc. This differs from
2471 `single-key-description' which turns them into "C-char".
2472 Also, this function recognizes the 2**7 bit as the Meta character,
2473 whereas `single-key-description' uses the 2**27 bit for Meta.
2474 See Info node `(elisp)Describing Characters' for examples. */)
2475 (Lisp_Object character)
2477 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2478 char str[6];
2479 int c;
2481 CHECK_NUMBER (character);
2483 c = XINT (character);
2484 if (!ASCII_CHAR_P (c))
2486 int len = CHAR_STRING (c, (unsigned char *) str);
2488 return make_multibyte_string (str, 1, len);
2491 *push_text_char_description (c & 0377, str) = 0;
2493 return build_string (str);
2496 static int where_is_preferred_modifier;
2498 /* Return 0 if SEQ uses non-preferred modifiers or non-char events.
2499 Else, return 2 if SEQ uses the where_is_preferred_modifier,
2500 and 1 otherwise. */
2501 static int
2502 preferred_sequence_p (Lisp_Object seq)
2504 int i;
2505 int len = XINT (Flength (seq));
2506 int result = 1;
2508 for (i = 0; i < len; i++)
2510 Lisp_Object ii, elt;
2512 XSETFASTINT (ii, i);
2513 elt = Faref (seq, ii);
2515 if (!INTEGERP (elt))
2516 return 0;
2517 else
2519 int modifiers = XUINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
2520 if (modifiers == where_is_preferred_modifier)
2521 result = 2;
2522 else if (modifiers)
2523 return 0;
2527 return result;
2531 /* where-is - finding a command in a set of keymaps. */
2533 static void where_is_internal_1 (Lisp_Object key, Lisp_Object binding,
2534 Lisp_Object args, void *data);
2536 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2537 Returns the first non-nil binding found in any of those maps.
2538 If REMAP is true, pass the result of the lookup through command
2539 remapping before returning it. */
2541 static Lisp_Object
2542 shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag,
2543 int remap)
2545 Lisp_Object tail, value;
2547 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2549 value = Flookup_key (XCAR (tail), key, flag);
2550 if (NATNUMP (value))
2552 value = Flookup_key (XCAR (tail),
2553 Fsubstring (key, make_number (0), value), flag);
2554 if (!NILP (value))
2555 return Qnil;
2557 else if (!NILP (value))
2559 Lisp_Object remapping;
2560 if (remap && SYMBOLP (value)
2561 && (remapping = Fcommand_remapping (value, Qnil, shadow),
2562 !NILP (remapping)))
2563 return remapping;
2564 else
2565 return value;
2568 return Qnil;
2571 static Lisp_Object Vmouse_events;
2573 struct where_is_internal_data {
2574 Lisp_Object definition, this, last;
2575 int last_is_meta, noindirect;
2576 Lisp_Object sequences;
2579 /* This function can't GC, AFAIK. */
2580 /* Return the list of bindings found. This list is ordered "longest
2581 to shortest". It may include bindings that are actually shadowed
2582 by others, as well as duplicate bindings and remapping bindings.
2583 The list returned is potentially shared with where_is_cache, so
2584 be careful not to modify it via side-effects. */
2586 static Lisp_Object
2587 where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
2588 int noindirect, int nomenus)
2590 Lisp_Object maps = Qnil;
2591 Lisp_Object found;
2592 struct where_is_internal_data data;
2594 /* Only important use of caching is for the menubar
2595 (i.e. where-is-internal called with (def nil t nil nil)). */
2596 if (nomenus && !noindirect)
2598 /* Check heuristic-consistency of the cache. */
2599 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2600 where_is_cache = Qnil;
2602 if (NILP (where_is_cache))
2604 /* We need to create the cache. */
2605 Lisp_Object args[2];
2606 where_is_cache = Fmake_hash_table (0, args);
2607 where_is_cache_keymaps = Qt;
2609 else
2610 /* We can reuse the cache. */
2611 return Fgethash (definition, where_is_cache, Qnil);
2613 else
2614 /* Kill the cache so that where_is_internal_1 doesn't think
2615 we're filling it up. */
2616 where_is_cache = Qnil;
2618 found = keymaps;
2619 while (CONSP (found))
2621 maps =
2622 nconc2 (maps,
2623 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2624 found = XCDR (found);
2627 data.sequences = Qnil;
2628 for (; CONSP (maps); maps = XCDR (maps))
2630 /* Key sequence to reach map, and the map that it reaches */
2631 register Lisp_Object this, map, tem;
2633 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2634 [M-CHAR] sequences, check if last character of the sequence
2635 is the meta-prefix char. */
2636 Lisp_Object last;
2637 int last_is_meta;
2639 this = Fcar (XCAR (maps));
2640 map = Fcdr (XCAR (maps));
2641 last = make_number (XINT (Flength (this)) - 1);
2642 last_is_meta = (XINT (last) >= 0
2643 && EQ (Faref (this, last), meta_prefix_char));
2645 /* if (nomenus && !preferred_sequence_p (this)) */
2646 if (nomenus && XINT (last) >= 0
2647 && SYMBOLP (tem = Faref (this, make_number (0)))
2648 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2649 /* If no menu entries should be returned, skip over the
2650 keymaps bound to `menu-bar' and `tool-bar' and other
2651 non-ascii prefixes like `C-down-mouse-2'. */
2652 continue;
2654 QUIT;
2656 data.definition = definition;
2657 data.noindirect = noindirect;
2658 data.this = this;
2659 data.last = last;
2660 data.last_is_meta = last_is_meta;
2662 if (CONSP (map))
2663 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2666 if (nomenus && !noindirect)
2667 { /* Remember for which keymaps this cache was built.
2668 We do it here (late) because we want to keep where_is_cache_keymaps
2669 set to t while the cache isn't fully filled. */
2670 where_is_cache_keymaps = keymaps;
2671 /* During cache-filling, data.sequences is not filled by
2672 where_is_internal_1. */
2673 return Fgethash (definition, where_is_cache, Qnil);
2675 else
2676 return data.sequences;
2679 /* This function can GC if Flookup_key autoloads any keymaps. */
2681 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2682 doc: /* Return list of keys that invoke DEFINITION.
2683 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2684 If KEYMAP is nil, search all the currently active keymaps.
2685 If KEYMAP is a list of keymaps, search only those keymaps.
2687 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2688 rather than a list of all possible key sequences.
2689 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2690 no matter what it is.
2691 If FIRSTONLY has another non-nil value, prefer bindings
2692 that use the modifier key specified in `where-is-preferred-modifier'
2693 \(or their meta variants) and entirely reject menu bindings.
2695 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2696 to other keymaps or slots. This makes it possible to search for an
2697 indirect definition itself.
2699 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2700 that invoke a command which is remapped to DEFINITION, but include the
2701 remapped command in the returned list. */)
2702 (Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap)
2704 /* The keymaps in which to search. */
2705 Lisp_Object keymaps;
2706 /* Potentially relevant bindings in "shortest to longest" order. */
2707 Lisp_Object sequences = Qnil;
2708 /* Actually relevant bindings. */
2709 Lisp_Object found = Qnil;
2710 /* 1 means ignore all menu bindings entirely. */
2711 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2712 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
2713 /* List of sequences found via remapping. Keep them in a separate
2714 variable, so as to push them later, since we prefer
2715 non-remapped binding. */
2716 Lisp_Object remapped_sequences = Qnil;
2717 /* Whether or not we're handling remapped sequences. This is needed
2718 because remapping is not done recursively by Fcommand_remapping: you
2719 can't remap a remapped command. */
2720 int remapped = 0;
2721 Lisp_Object tem = Qnil;
2723 /* Refresh the C version of the modifier preference. */
2724 where_is_preferred_modifier
2725 = parse_solitary_modifier (Vwhere_is_preferred_modifier);
2727 /* Find the relevant keymaps. */
2728 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2729 keymaps = keymap;
2730 else if (!NILP (keymap))
2731 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2732 else
2733 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2735 GCPRO6 (definition, keymaps, found, sequences, remapped_sequences, tem);
2737 tem = Fcommand_remapping (definition, Qnil, keymaps);
2738 /* If `definition' is remapped to tem', then OT1H no key will run
2739 that command (since they will run `tem' instead), so we should
2740 return nil; but OTOH all keys bound to `definition' (or to `tem')
2741 will run the same command.
2742 So for menu-shortcut purposes, we want to find all the keys bound (maybe
2743 via remapping) to `tem'. But for the purpose of finding the keys that
2744 run `definition', then we'd want to just return nil.
2745 We choose to make it work right for menu-shortcuts, since it's the most
2746 common use.
2747 Known bugs: if you remap switch-to-buffer to toto, C-h f switch-to-buffer
2748 will tell you that switch-to-buffer is bound to C-x b even though C-x b
2749 will run toto instead. And if `toto' is itself remapped to forward-char,
2750 then C-h f toto will tell you that it's bound to C-f even though C-f does
2751 not run toto and it won't tell you that C-x b does run toto. */
2752 if (NILP (no_remap) && !NILP (tem))
2753 definition = tem;
2755 if (SYMBOLP (definition)
2756 && !NILP (firstonly)
2757 && !NILP (tem = Fget (definition, QCadvertised_binding)))
2759 /* We have a list of advertised bindings. */
2760 while (CONSP (tem))
2761 if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
2762 return XCAR (tem);
2763 else
2764 tem = XCDR (tem);
2765 if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition))
2766 return tem;
2769 sequences = Freverse (where_is_internal (definition, keymaps,
2770 !NILP (noindirect), nomenus));
2772 while (CONSP (sequences)
2773 /* If we're at the end of the `sequences' list and we haven't
2774 considered remapped sequences yet, copy them over and
2775 process them. */
2776 || (!remapped && (sequences = remapped_sequences,
2777 remapped = 1),
2778 CONSP (sequences)))
2780 Lisp_Object sequence, function;
2782 sequence = XCAR (sequences);
2783 sequences = XCDR (sequences);
2785 /* Verify that this key binding is not shadowed by another
2786 binding for the same key, before we say it exists.
2788 Mechanism: look for local definition of this key and if
2789 it is defined and does not match what we found then
2790 ignore this key.
2792 Either nil or number as value from Flookup_key
2793 means undefined. */
2794 if (NILP (Fequal (shadow_lookup (keymaps, sequence, Qnil, remapped),
2795 definition)))
2796 continue;
2798 /* If the current sequence is a command remapping with
2799 format [remap COMMAND], find the key sequences
2800 which run COMMAND, and use those sequences instead. */
2801 if (NILP (no_remap) && !remapped
2802 && VECTORP (sequence) && ASIZE (sequence) == 2
2803 && EQ (AREF (sequence, 0), Qremap)
2804 && (function = AREF (sequence, 1), SYMBOLP (function)))
2806 Lisp_Object seqs = where_is_internal (function, keymaps,
2807 !NILP (noindirect), nomenus);
2808 remapped_sequences = nconc2 (Freverse (seqs), remapped_sequences);
2809 continue;
2812 /* Don't annoy user with strings from a menu such as the
2813 entries from the "Edit => Paste from Kill Menu".
2814 Change them all to "(any string)", so that there
2815 seems to be only one menu item to report. */
2816 if (! NILP (sequence))
2818 Lisp_Object tem;
2819 tem = Faref (sequence, make_number (ASIZE (sequence) - 1));
2820 if (STRINGP (tem))
2821 Faset (sequence, make_number (ASIZE (sequence) - 1),
2822 build_string ("(any string)"));
2825 /* It is a true unshadowed match. Record it, unless it's already
2826 been seen (as could happen when inheriting keymaps). */
2827 if (NILP (Fmember (sequence, found)))
2828 found = Fcons (sequence, found);
2830 /* If firstonly is Qnon_ascii, then we can return the first
2831 binding we find. If firstonly is not Qnon_ascii but not
2832 nil, then we should return the first ascii-only binding
2833 we find. */
2834 if (EQ (firstonly, Qnon_ascii))
2835 RETURN_UNGCPRO (sequence);
2836 else if (!NILP (firstonly)
2837 && 2 == preferred_sequence_p (sequence))
2838 RETURN_UNGCPRO (sequence);
2841 UNGCPRO;
2843 found = Fnreverse (found);
2845 /* firstonly may have been t, but we may have gone all the way through
2846 the keymaps without finding an all-ASCII key sequence. So just
2847 return the best we could find. */
2848 if (NILP (firstonly))
2849 return found;
2850 else if (where_is_preferred_modifier == 0)
2851 return Fcar (found);
2852 else
2853 { /* Maybe we did not find a preferred_modifier binding, but we did find
2854 some ASCII binding. */
2855 Lisp_Object bindings = found;
2856 while (CONSP (bindings))
2857 if (preferred_sequence_p (XCAR (bindings)))
2858 return XCAR (bindings);
2859 else
2860 bindings = XCDR (bindings);
2861 return Fcar (found);
2865 /* This function can GC because get_keyelt can. */
2867 static void
2868 where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, void *data)
2870 struct where_is_internal_data *d = data; /* Cast! */
2871 Lisp_Object definition = d->definition;
2872 int noindirect = d->noindirect;
2873 Lisp_Object this = d->this;
2874 Lisp_Object last = d->last;
2875 int last_is_meta = d->last_is_meta;
2876 Lisp_Object sequence;
2878 /* Search through indirections unless that's not wanted. */
2879 if (!noindirect)
2880 binding = get_keyelt (binding, 0);
2882 /* End this iteration if this element does not match
2883 the target. */
2885 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2886 || EQ (binding, definition)
2887 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2888 /* Doesn't match. */
2889 return;
2891 /* We have found a match. Construct the key sequence where we found it. */
2892 if (INTEGERP (key) && last_is_meta)
2894 sequence = Fcopy_sequence (this);
2895 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2897 else
2899 if (CONSP (key))
2900 key = Fcons (XCAR (key), XCDR (key));
2901 sequence = append_key (this, key);
2904 if (!NILP (where_is_cache))
2906 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2907 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2909 else
2910 d->sequences = Fcons (sequence, d->sequences);
2913 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2915 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2916 doc: /* Insert the list of all defined keys and their definitions.
2917 The list is inserted in the current buffer, while the bindings are
2918 looked up in BUFFER.
2919 The optional argument PREFIX, if non-nil, should be a key sequence;
2920 then we display only bindings that start with that prefix.
2921 The optional argument MENUS, if non-nil, says to mention menu bindings.
2922 \(Ordinarily these are omitted from the output.) */)
2923 (Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus)
2925 Lisp_Object outbuf, shadow;
2926 int nomenu = NILP (menus);
2927 register Lisp_Object start1;
2928 struct gcpro gcpro1;
2930 const char *alternate_heading
2931 = "\
2932 Keyboard translations:\n\n\
2933 You type Translation\n\
2934 -------- -----------\n";
2936 CHECK_BUFFER (buffer);
2938 shadow = Qnil;
2939 GCPRO1 (shadow);
2941 outbuf = Fcurrent_buffer ();
2943 /* Report on alternates for keys. */
2944 if (STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) && !NILP (prefix))
2946 int c;
2947 const unsigned char *translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
2948 int translate_len = SCHARS (KVAR (current_kboard, Vkeyboard_translate_table));
2950 for (c = 0; c < translate_len; c++)
2951 if (translate[c] != c)
2953 char buf[KEY_DESCRIPTION_SIZE];
2954 char *bufend;
2956 if (alternate_heading)
2958 insert_string (alternate_heading);
2959 alternate_heading = 0;
2962 bufend = push_key_description (translate[c], buf, 1);
2963 insert (buf, bufend - buf);
2964 Findent_to (make_number (16), make_number (1));
2965 bufend = push_key_description (c, buf, 1);
2966 insert (buf, bufend - buf);
2968 insert ("\n", 1);
2970 /* Insert calls signal_after_change which may GC. */
2971 translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
2974 insert ("\n", 1);
2977 if (!NILP (Vkey_translation_map))
2978 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2979 "Key translations", nomenu, 1, 0, 0);
2982 /* Print the (major mode) local map. */
2983 start1 = Qnil;
2984 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
2985 start1 = KVAR (current_kboard, Voverriding_terminal_local_map);
2986 else if (!NILP (Voverriding_local_map))
2987 start1 = Voverriding_local_map;
2989 if (!NILP (start1))
2991 describe_map_tree (start1, 1, shadow, prefix,
2992 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
2993 shadow = Fcons (start1, shadow);
2995 else
2997 /* Print the minor mode and major mode keymaps. */
2998 int i, nmaps;
2999 Lisp_Object *modes, *maps;
3001 /* Temporarily switch to `buffer', so that we can get that buffer's
3002 minor modes correctly. */
3003 Fset_buffer (buffer);
3005 nmaps = current_minor_maps (&modes, &maps);
3006 Fset_buffer (outbuf);
3008 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3009 XBUFFER (buffer), Qkeymap);
3010 if (!NILP (start1))
3012 describe_map_tree (start1, 1, shadow, prefix,
3013 "\f\n`keymap' Property Bindings", nomenu,
3014 0, 0, 0);
3015 shadow = Fcons (start1, shadow);
3018 /* Print the minor mode maps. */
3019 for (i = 0; i < nmaps; i++)
3021 /* The title for a minor mode keymap
3022 is constructed at run time.
3023 We let describe_map_tree do the actual insertion
3024 because it takes care of other features when doing so. */
3025 char *title, *p;
3027 if (!SYMBOLP (modes[i]))
3028 abort ();
3030 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3031 *p++ = '\f';
3032 *p++ = '\n';
3033 *p++ = '`';
3034 memcpy (p, SDATA (SYMBOL_NAME (modes[i])),
3035 SCHARS (SYMBOL_NAME (modes[i])));
3036 p += SCHARS (SYMBOL_NAME (modes[i]));
3037 *p++ = '\'';
3038 memcpy (p, " Minor Mode Bindings", strlen (" Minor Mode Bindings"));
3039 p += strlen (" Minor Mode Bindings");
3040 *p = 0;
3042 describe_map_tree (maps[i], 1, shadow, prefix,
3043 title, nomenu, 0, 0, 0);
3044 shadow = Fcons (maps[i], shadow);
3047 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3048 XBUFFER (buffer), Qlocal_map);
3049 if (!NILP (start1))
3051 if (EQ (start1, BVAR (XBUFFER (buffer), keymap)))
3052 describe_map_tree (start1, 1, shadow, prefix,
3053 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3054 else
3055 describe_map_tree (start1, 1, shadow, prefix,
3056 "\f\n`local-map' Property Bindings",
3057 nomenu, 0, 0, 0);
3059 shadow = Fcons (start1, shadow);
3063 describe_map_tree (current_global_map, 1, shadow, prefix,
3064 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3066 /* Print the function-key-map translations under this prefix. */
3067 if (!NILP (KVAR (current_kboard, Vlocal_function_key_map)))
3068 describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix,
3069 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3071 /* Print the input-decode-map translations under this prefix. */
3072 if (!NILP (KVAR (current_kboard, Vinput_decode_map)))
3073 describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix,
3074 "\f\nInput decoding map translations", nomenu, 1, 0, 0);
3076 UNGCPRO;
3077 return Qnil;
3080 /* Insert a description of the key bindings in STARTMAP,
3081 followed by those of all maps reachable through STARTMAP.
3082 If PARTIAL is nonzero, omit certain "uninteresting" commands
3083 (such as `undefined').
3084 If SHADOW is non-nil, it is a list of maps;
3085 don't mention keys which would be shadowed by any of them.
3086 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3087 TITLE, if not 0, is a string to insert at the beginning.
3088 TITLE should not end with a colon or a newline; we supply that.
3089 If NOMENU is not 0, then omit menu-bar commands.
3091 If TRANSL is nonzero, the definitions are actually key translations
3092 so print strings and vectors differently.
3094 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3095 to look through.
3097 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3098 don't omit it; instead, mention it but say it is shadowed. */
3100 void
3101 describe_map_tree (Lisp_Object startmap, int partial, Lisp_Object shadow,
3102 Lisp_Object prefix, const char *title, int nomenu, int transl,
3103 int always_title, int mention_shadow)
3105 Lisp_Object maps, orig_maps, seen, sub_shadows;
3106 struct gcpro gcpro1, gcpro2, gcpro3;
3107 int something = 0;
3108 const char *key_heading
3109 = "\
3110 key binding\n\
3111 --- -------\n";
3113 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3114 seen = Qnil;
3115 sub_shadows = Qnil;
3116 GCPRO3 (maps, seen, sub_shadows);
3118 if (nomenu)
3120 Lisp_Object list;
3122 /* Delete from MAPS each element that is for the menu bar. */
3123 for (list = maps; CONSP (list); list = XCDR (list))
3125 Lisp_Object elt, prefix, tem;
3127 elt = XCAR (list);
3128 prefix = Fcar (elt);
3129 if (XVECTOR (prefix)->size >= 1)
3131 tem = Faref (prefix, make_number (0));
3132 if (EQ (tem, Qmenu_bar))
3133 maps = Fdelq (elt, maps);
3138 if (!NILP (maps) || always_title)
3140 if (title)
3142 insert_string (title);
3143 if (!NILP (prefix))
3145 insert_string (" Starting With ");
3146 insert1 (Fkey_description (prefix, Qnil));
3148 insert_string (":\n");
3150 insert_string (key_heading);
3151 something = 1;
3154 for (; CONSP (maps); maps = XCDR (maps))
3156 register Lisp_Object elt, prefix, tail;
3158 elt = XCAR (maps);
3159 prefix = Fcar (elt);
3161 sub_shadows = Qnil;
3163 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3165 Lisp_Object shmap;
3167 shmap = XCAR (tail);
3169 /* If the sequence by which we reach this keymap is zero-length,
3170 then the shadow map for this keymap is just SHADOW. */
3171 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3172 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3174 /* If the sequence by which we reach this keymap actually has
3175 some elements, then the sequence's definition in SHADOW is
3176 what we should use. */
3177 else
3179 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3180 if (INTEGERP (shmap))
3181 shmap = Qnil;
3184 /* If shmap is not nil and not a keymap,
3185 it completely shadows this map, so don't
3186 describe this map at all. */
3187 if (!NILP (shmap) && !KEYMAPP (shmap))
3188 goto skip;
3190 if (!NILP (shmap))
3191 sub_shadows = Fcons (shmap, sub_shadows);
3194 /* Maps we have already listed in this loop shadow this map. */
3195 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3197 Lisp_Object tem;
3198 tem = Fequal (Fcar (XCAR (tail)), prefix);
3199 if (!NILP (tem))
3200 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3203 describe_map (Fcdr (elt), prefix,
3204 transl ? describe_translation : describe_command,
3205 partial, sub_shadows, &seen, nomenu, mention_shadow);
3207 skip: ;
3210 if (something)
3211 insert_string ("\n");
3213 UNGCPRO;
3216 static int previous_description_column;
3218 static void
3219 describe_command (Lisp_Object definition, Lisp_Object args)
3221 register Lisp_Object tem1;
3222 EMACS_INT column = current_column ();
3223 int description_column;
3225 /* If column 16 is no good, go to col 32;
3226 but don't push beyond that--go to next line instead. */
3227 if (column > 30)
3229 insert_char ('\n');
3230 description_column = 32;
3232 else if (column > 14 || (column > 10 && previous_description_column == 32))
3233 description_column = 32;
3234 else
3235 description_column = 16;
3237 Findent_to (make_number (description_column), make_number (1));
3238 previous_description_column = description_column;
3240 if (SYMBOLP (definition))
3242 tem1 = SYMBOL_NAME (definition);
3243 insert1 (tem1);
3244 insert_string ("\n");
3246 else if (STRINGP (definition) || VECTORP (definition))
3247 insert_string ("Keyboard Macro\n");
3248 else if (KEYMAPP (definition))
3249 insert_string ("Prefix Command\n");
3250 else
3251 insert_string ("??\n");
3254 static void
3255 describe_translation (Lisp_Object definition, Lisp_Object args)
3257 register Lisp_Object tem1;
3259 Findent_to (make_number (16), make_number (1));
3261 if (SYMBOLP (definition))
3263 tem1 = SYMBOL_NAME (definition);
3264 insert1 (tem1);
3265 insert_string ("\n");
3267 else if (STRINGP (definition) || VECTORP (definition))
3269 insert1 (Fkey_description (definition, Qnil));
3270 insert_string ("\n");
3272 else if (KEYMAPP (definition))
3273 insert_string ("Prefix Command\n");
3274 else
3275 insert_string ("??\n");
3278 /* describe_map puts all the usable elements of a sparse keymap
3279 into an array of `struct describe_map_elt',
3280 then sorts them by the events. */
3282 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3284 /* qsort comparison function for sorting `struct describe_map_elt' by
3285 the event field. */
3287 static int
3288 describe_map_compare (const void *aa, const void *bb)
3290 const struct describe_map_elt *a = aa, *b = bb;
3291 if (INTEGERP (a->event) && INTEGERP (b->event))
3292 return ((XINT (a->event) > XINT (b->event))
3293 - (XINT (a->event) < XINT (b->event)));
3294 if (!INTEGERP (a->event) && INTEGERP (b->event))
3295 return 1;
3296 if (INTEGERP (a->event) && !INTEGERP (b->event))
3297 return -1;
3298 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3299 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3300 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3301 : 0);
3302 return 0;
3305 /* Describe the contents of map MAP, assuming that this map itself is
3306 reached by the sequence of prefix keys PREFIX (a string or vector).
3307 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3309 static void
3310 describe_map (Lisp_Object map, Lisp_Object prefix,
3311 void (*elt_describer) (Lisp_Object, Lisp_Object),
3312 int partial, Lisp_Object shadow,
3313 Lisp_Object *seen, int nomenu, int mention_shadow)
3315 Lisp_Object tail, definition, event;
3316 Lisp_Object tem;
3317 Lisp_Object suppress;
3318 Lisp_Object kludge;
3319 int first = 1;
3320 struct gcpro gcpro1, gcpro2, gcpro3;
3322 /* These accumulate the values from sparse keymap bindings,
3323 so we can sort them and handle them in order. */
3324 int length_needed = 0;
3325 struct describe_map_elt *vect;
3326 int slots_used = 0;
3327 int i;
3329 suppress = Qnil;
3331 if (partial)
3332 suppress = intern ("suppress-keymap");
3334 /* This vector gets used to present single keys to Flookup_key. Since
3335 that is done once per keymap element, we don't want to cons up a
3336 fresh vector every time. */
3337 kludge = Fmake_vector (make_number (1), Qnil);
3338 definition = Qnil;
3340 GCPRO3 (prefix, definition, kludge);
3342 map = call1 (Qkeymap_canonicalize, map);
3344 for (tail = map; CONSP (tail); tail = XCDR (tail))
3345 length_needed++;
3347 vect = ((struct describe_map_elt *)
3348 alloca (sizeof (struct describe_map_elt) * length_needed));
3350 for (tail = map; CONSP (tail); tail = XCDR (tail))
3352 QUIT;
3354 if (VECTORP (XCAR (tail))
3355 || CHAR_TABLE_P (XCAR (tail)))
3356 describe_vector (XCAR (tail),
3357 prefix, Qnil, elt_describer, partial, shadow, map,
3358 (int *)0, 0, 1, mention_shadow);
3359 else if (CONSP (XCAR (tail)))
3361 int this_shadowed = 0;
3363 event = XCAR (XCAR (tail));
3365 /* Ignore bindings whose "prefix" are not really valid events.
3366 (We get these in the frames and buffers menu.) */
3367 if (!(SYMBOLP (event) || INTEGERP (event)))
3368 continue;
3370 if (nomenu && EQ (event, Qmenu_bar))
3371 continue;
3373 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3375 /* Don't show undefined commands or suppressed commands. */
3376 if (NILP (definition)) continue;
3377 if (SYMBOLP (definition) && partial)
3379 tem = Fget (definition, suppress);
3380 if (!NILP (tem))
3381 continue;
3384 /* Don't show a command that isn't really visible
3385 because a local definition of the same key shadows it. */
3387 ASET (kludge, 0, event);
3388 if (!NILP (shadow))
3390 tem = shadow_lookup (shadow, kludge, Qt, 0);
3391 if (!NILP (tem))
3393 /* If both bindings are keymaps, this key is a prefix key,
3394 so don't say it is shadowed. */
3395 if (KEYMAPP (definition) && KEYMAPP (tem))
3397 /* Avoid generating duplicate entries if the
3398 shadowed binding has the same definition. */
3399 else if (mention_shadow && !EQ (tem, definition))
3400 this_shadowed = 1;
3401 else
3402 continue;
3406 tem = Flookup_key (map, kludge, Qt);
3407 if (!EQ (tem, definition)) continue;
3409 vect[slots_used].event = event;
3410 vect[slots_used].definition = definition;
3411 vect[slots_used].shadowed = this_shadowed;
3412 slots_used++;
3414 else if (EQ (XCAR (tail), Qkeymap))
3416 /* The same keymap might be in the structure twice, if we're
3417 using an inherited keymap. So skip anything we've already
3418 encountered. */
3419 tem = Fassq (tail, *seen);
3420 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3421 break;
3422 *seen = Fcons (Fcons (tail, prefix), *seen);
3426 /* If we found some sparse map events, sort them. */
3428 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3429 describe_map_compare);
3431 /* Now output them in sorted order. */
3433 for (i = 0; i < slots_used; i++)
3435 Lisp_Object start, end;
3437 if (first)
3439 previous_description_column = 0;
3440 insert ("\n", 1);
3441 first = 0;
3444 ASET (kludge, 0, vect[i].event);
3445 start = vect[i].event;
3446 end = start;
3448 definition = vect[i].definition;
3450 /* Find consecutive chars that are identically defined. */
3451 if (INTEGERP (vect[i].event))
3453 while (i + 1 < slots_used
3454 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3455 && !NILP (Fequal (vect[i + 1].definition, definition))
3456 && vect[i].shadowed == vect[i + 1].shadowed)
3457 i++;
3458 end = vect[i].event;
3461 /* Now START .. END is the range to describe next. */
3463 /* Insert the string to describe the event START. */
3464 insert1 (Fkey_description (kludge, prefix));
3466 if (!EQ (start, end))
3468 insert (" .. ", 4);
3470 ASET (kludge, 0, end);
3471 /* Insert the string to describe the character END. */
3472 insert1 (Fkey_description (kludge, prefix));
3475 /* Print a description of the definition of this character.
3476 elt_describer will take care of spacing out far enough
3477 for alignment purposes. */
3478 (*elt_describer) (vect[i].definition, Qnil);
3480 if (vect[i].shadowed)
3482 SET_PT (PT - 1);
3483 insert_string ("\n (that binding is currently shadowed by another mode)");
3484 SET_PT (PT + 1);
3488 UNGCPRO;
3491 static void
3492 describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
3494 Findent_to (make_number (16), make_number (1));
3495 call1 (fun, elt);
3496 Fterpri (Qnil);
3499 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3500 doc: /* Insert a description of contents of VECTOR.
3501 This is text showing the elements of vector matched against indices.
3502 DESCRIBER is the output function used; nil means use `princ'. */)
3503 (Lisp_Object vector, Lisp_Object describer)
3505 int count = SPECPDL_INDEX ();
3506 if (NILP (describer))
3507 describer = intern ("princ");
3508 specbind (Qstandard_output, Fcurrent_buffer ());
3509 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3510 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3511 Qnil, Qnil, (int *)0, 0, 0, 0);
3513 return unbind_to (count, Qnil);
3516 /* Insert in the current buffer a description of the contents of VECTOR.
3517 We call ELT_DESCRIBER to insert the description of one value found
3518 in VECTOR.
3520 ELT_PREFIX describes what "comes before" the keys or indices defined
3521 by this vector. This is a human-readable string whose size
3522 is not necessarily related to the situation.
3524 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3525 leads to this keymap.
3527 If the vector is a chartable, ELT_PREFIX is the vector
3528 of bytes that lead to the character set or portion of a character
3529 set described by this chartable.
3531 If PARTIAL is nonzero, it means do not mention suppressed commands
3532 (that assumes the vector is in a keymap).
3534 SHADOW is a list of keymaps that shadow this map.
3535 If it is non-nil, then we look up the key in those maps
3536 and we don't mention it now if it is defined by any of them.
3538 ENTIRE_MAP is the keymap in which this vector appears.
3539 If the definition in effect in the whole map does not match
3540 the one in this vector, we ignore this one.
3542 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3544 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3545 the near future.
3547 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3549 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3551 static void
3552 describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3553 void (*elt_describer) (Lisp_Object, Lisp_Object),
3554 int partial, Lisp_Object shadow, Lisp_Object entire_map,
3555 int *indices, int char_table_depth, int keymap_p,
3556 int mention_shadow)
3558 Lisp_Object definition;
3559 Lisp_Object tem2;
3560 Lisp_Object elt_prefix = Qnil;
3561 int i;
3562 Lisp_Object suppress;
3563 Lisp_Object kludge;
3564 int first = 1;
3565 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3566 /* Range of elements to be handled. */
3567 int from, to, stop;
3568 Lisp_Object character;
3569 int starting_i;
3571 suppress = Qnil;
3573 definition = Qnil;
3575 if (!keymap_p)
3577 /* Call Fkey_description first, to avoid GC bug for the other string. */
3578 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3580 Lisp_Object tem;
3581 tem = Fkey_description (prefix, Qnil);
3582 elt_prefix = concat2 (tem, build_string (" "));
3584 prefix = Qnil;
3587 /* This vector gets used to present single keys to Flookup_key. Since
3588 that is done once per vector element, we don't want to cons up a
3589 fresh vector every time. */
3590 kludge = Fmake_vector (make_number (1), Qnil);
3591 GCPRO4 (elt_prefix, prefix, definition, kludge);
3593 if (partial)
3594 suppress = intern ("suppress-keymap");
3596 from = 0;
3597 if (CHAR_TABLE_P (vector))
3598 stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1;
3599 else
3600 stop = to = XVECTOR (vector)->size;
3602 for (i = from; ; i++)
3604 int this_shadowed = 0;
3605 int range_beg, range_end;
3606 Lisp_Object val;
3608 QUIT;
3610 if (i == stop)
3612 if (i == to)
3613 break;
3614 stop = to;
3617 starting_i = i;
3619 if (CHAR_TABLE_P (vector))
3621 range_beg = i;
3622 i = stop - 1;
3623 val = char_table_ref_and_range (vector, range_beg, &range_beg, &i);
3625 else
3626 val = AREF (vector, i);
3627 definition = get_keyelt (val, 0);
3629 if (NILP (definition)) continue;
3631 /* Don't mention suppressed commands. */
3632 if (SYMBOLP (definition) && partial)
3634 Lisp_Object tem;
3636 tem = Fget (definition, suppress);
3638 if (!NILP (tem)) continue;
3641 character = make_number (starting_i);
3642 ASET (kludge, 0, character);
3644 /* If this binding is shadowed by some other map, ignore it. */
3645 if (!NILP (shadow))
3647 Lisp_Object tem;
3649 tem = shadow_lookup (shadow, kludge, Qt, 0);
3651 if (!NILP (tem))
3653 if (mention_shadow)
3654 this_shadowed = 1;
3655 else
3656 continue;
3660 /* Ignore this definition if it is shadowed by an earlier
3661 one in the same keymap. */
3662 if (!NILP (entire_map))
3664 Lisp_Object tem;
3666 tem = Flookup_key (entire_map, kludge, Qt);
3668 if (!EQ (tem, definition))
3669 continue;
3672 if (first)
3674 insert ("\n", 1);
3675 first = 0;
3678 /* Output the prefix that applies to every entry in this map. */
3679 if (!NILP (elt_prefix))
3680 insert1 (elt_prefix);
3682 insert1 (Fkey_description (kludge, prefix));
3684 /* Find all consecutive characters or rows that have the same
3685 definition. But, VECTOR is a char-table, we had better put a
3686 boundary between normal characters (-#x3FFF7F) and 8-bit
3687 characters (#x3FFF80-). */
3688 if (CHAR_TABLE_P (vector))
3690 while (i + 1 < stop
3691 && (range_beg = i + 1, range_end = stop - 1,
3692 val = char_table_ref_and_range (vector, range_beg,
3693 &range_beg, &range_end),
3694 tem2 = get_keyelt (val, 0),
3695 !NILP (tem2))
3696 && !NILP (Fequal (tem2, definition)))
3697 i = range_end;
3699 else
3700 while (i + 1 < stop
3701 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3702 !NILP (tem2))
3703 && !NILP (Fequal (tem2, definition)))
3704 i++;
3706 /* If we have a range of more than one character,
3707 print where the range reaches to. */
3709 if (i != starting_i)
3711 insert (" .. ", 4);
3713 ASET (kludge, 0, make_number (i));
3715 if (!NILP (elt_prefix))
3716 insert1 (elt_prefix);
3718 insert1 (Fkey_description (kludge, prefix));
3721 /* Print a description of the definition of this character.
3722 elt_describer will take care of spacing out far enough
3723 for alignment purposes. */
3724 (*elt_describer) (definition, args);
3726 if (this_shadowed)
3728 SET_PT (PT - 1);
3729 insert_string (" (binding currently shadowed)");
3730 SET_PT (PT + 1);
3734 if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
3736 if (!NILP (elt_prefix))
3737 insert1 (elt_prefix);
3738 insert ("default", 7);
3739 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3742 UNGCPRO;
3745 /* Apropos - finding all symbols whose names match a regexp. */
3746 static Lisp_Object apropos_predicate;
3747 static Lisp_Object apropos_accumulate;
3749 static void
3750 apropos_accum (Lisp_Object symbol, Lisp_Object string)
3752 register Lisp_Object tem;
3754 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3755 if (!NILP (tem) && !NILP (apropos_predicate))
3756 tem = call1 (apropos_predicate, symbol);
3757 if (!NILP (tem))
3758 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3761 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3762 doc: /* Show all symbols whose names contain match for REGEXP.
3763 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3764 for each symbol and a symbol is mentioned only if that returns non-nil.
3765 Return list of symbols found. */)
3766 (Lisp_Object regexp, Lisp_Object predicate)
3768 Lisp_Object tem;
3769 CHECK_STRING (regexp);
3770 apropos_predicate = predicate;
3771 apropos_accumulate = Qnil;
3772 map_obarray (Vobarray, apropos_accum, regexp);
3773 tem = Fsort (apropos_accumulate, Qstring_lessp);
3774 apropos_accumulate = Qnil;
3775 apropos_predicate = Qnil;
3776 return tem;
3779 void
3780 syms_of_keymap (void)
3782 Qkeymap = intern_c_string ("keymap");
3783 staticpro (&Qkeymap);
3784 staticpro (&apropos_predicate);
3785 staticpro (&apropos_accumulate);
3786 apropos_predicate = Qnil;
3787 apropos_accumulate = Qnil;
3789 Qkeymap_canonicalize = intern_c_string ("keymap-canonicalize");
3790 staticpro (&Qkeymap_canonicalize);
3792 /* Now we are ready to set up this property, so we can
3793 create char tables. */
3794 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3796 /* Initialize the keymaps standardly used.
3797 Each one is the value of a Lisp variable, and is also
3798 pointed to by a C variable */
3800 global_map = Fmake_keymap (Qnil);
3801 Fset (intern_c_string ("global-map"), global_map);
3803 current_global_map = global_map;
3804 staticpro (&global_map);
3805 staticpro (&current_global_map);
3807 meta_map = Fmake_keymap (Qnil);
3808 Fset (intern_c_string ("esc-map"), meta_map);
3809 Ffset (intern_c_string ("ESC-prefix"), meta_map);
3811 control_x_map = Fmake_keymap (Qnil);
3812 Fset (intern_c_string ("ctl-x-map"), control_x_map);
3813 Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
3815 exclude_keys
3816 = pure_cons (pure_cons (make_pure_c_string ("DEL"), make_pure_c_string ("\\d")),
3817 pure_cons (pure_cons (make_pure_c_string ("TAB"), make_pure_c_string ("\\t")),
3818 pure_cons (pure_cons (make_pure_c_string ("RET"), make_pure_c_string ("\\r")),
3819 pure_cons (pure_cons (make_pure_c_string ("ESC"), make_pure_c_string ("\\e")),
3820 pure_cons (pure_cons (make_pure_c_string ("SPC"), make_pure_c_string (" ")),
3821 Qnil)))));
3822 staticpro (&exclude_keys);
3824 DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
3825 doc: /* List of commands given new key bindings recently.
3826 This is used for internal purposes during Emacs startup;
3827 don't alter it yourself. */);
3828 Vdefine_key_rebound_commands = Qt;
3830 DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map,
3831 doc: /* Default keymap to use when reading from the minibuffer. */);
3832 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3834 DEFVAR_LISP ("minibuffer-local-ns-map", Vminibuffer_local_ns_map,
3835 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
3836 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3837 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3839 DEFVAR_LISP ("minibuffer-local-completion-map", Vminibuffer_local_completion_map,
3840 doc: /* Local keymap for minibuffer input with completion. */);
3841 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3842 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
3844 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
3845 Vminibuffer_local_filename_completion_map,
3846 doc: /* Local keymap for minibuffer input with completion for filenames. */);
3847 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
3848 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
3849 Vminibuffer_local_completion_map);
3852 DEFVAR_LISP ("minibuffer-local-must-match-map", Vminibuffer_local_must_match_map,
3853 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
3854 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3855 Fset_keymap_parent (Vminibuffer_local_must_match_map,
3856 Vminibuffer_local_completion_map);
3858 DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
3859 Vminibuffer_local_filename_must_match_map,
3860 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
3861 Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
3862 Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
3863 Vminibuffer_local_must_match_map);
3865 DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist,
3866 doc: /* Alist of keymaps to use for minor modes.
3867 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3868 key sequences and look up bindings if VARIABLE's value is non-nil.
3869 If two active keymaps bind the same key, the keymap appearing earlier
3870 in the list takes precedence. */);
3871 Vminor_mode_map_alist = Qnil;
3873 DEFVAR_LISP ("minor-mode-overriding-map-alist", Vminor_mode_overriding_map_alist,
3874 doc: /* Alist of keymaps to use for minor modes, in current major mode.
3875 This variable is an alist just like `minor-mode-map-alist', and it is
3876 used the same way (and before `minor-mode-map-alist'); however,
3877 it is provided for major modes to bind locally. */);
3878 Vminor_mode_overriding_map_alist = Qnil;
3880 DEFVAR_LISP ("emulation-mode-map-alists", Vemulation_mode_map_alists,
3881 doc: /* List of keymap alists to use for emulations modes.
3882 It is intended for modes or packages using multiple minor-mode keymaps.
3883 Each element is a keymap alist just like `minor-mode-map-alist', or a
3884 symbol with a variable binding which is a keymap alist, and it is used
3885 the same way. The "active" keymaps in each alist are used before
3886 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3887 Vemulation_mode_map_alists = Qnil;
3889 DEFVAR_LISP ("where-is-preferred-modifier", Vwhere_is_preferred_modifier,
3890 doc: /* Preferred modifier to use for `where-is'.
3891 When a single binding is requested, `where-is' will return one that
3892 uses this modifier if possible. If nil, or if no such binding exists,
3893 bindings using keys without modifiers (or only with meta) will be
3894 preferred. */);
3895 Vwhere_is_preferred_modifier = Qnil;
3896 where_is_preferred_modifier = 0;
3898 staticpro (&Vmouse_events);
3899 Vmouse_events = pure_cons (intern_c_string ("menu-bar"),
3900 pure_cons (intern_c_string ("tool-bar"),
3901 pure_cons (intern_c_string ("header-line"),
3902 pure_cons (intern_c_string ("mode-line"),
3903 pure_cons (intern_c_string ("mouse-1"),
3904 pure_cons (intern_c_string ("mouse-2"),
3905 pure_cons (intern_c_string ("mouse-3"),
3906 pure_cons (intern_c_string ("mouse-4"),
3907 pure_cons (intern_c_string ("mouse-5"),
3908 Qnil)))))))));
3911 Qsingle_key_description = intern_c_string ("single-key-description");
3912 staticpro (&Qsingle_key_description);
3914 Qkey_description = intern_c_string ("key-description");
3915 staticpro (&Qkey_description);
3917 Qkeymapp = intern_c_string ("keymapp");
3918 staticpro (&Qkeymapp);
3920 Qnon_ascii = intern_c_string ("non-ascii");
3921 staticpro (&Qnon_ascii);
3923 Qmenu_item = intern_c_string ("menu-item");
3924 staticpro (&Qmenu_item);
3926 Qremap = intern_c_string ("remap");
3927 staticpro (&Qremap);
3929 QCadvertised_binding = intern_c_string (":advertised-binding");
3930 staticpro (&QCadvertised_binding);
3932 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
3933 staticpro (&command_remapping_vector);
3935 where_is_cache_keymaps = Qt;
3936 where_is_cache = Qnil;
3937 staticpro (&where_is_cache);
3938 staticpro (&where_is_cache_keymaps);
3940 defsubr (&Skeymapp);
3941 defsubr (&Skeymap_parent);
3942 defsubr (&Skeymap_prompt);
3943 defsubr (&Sset_keymap_parent);
3944 defsubr (&Smake_keymap);
3945 defsubr (&Smake_sparse_keymap);
3946 defsubr (&Smap_keymap_internal);
3947 defsubr (&Smap_keymap);
3948 defsubr (&Scopy_keymap);
3949 defsubr (&Scommand_remapping);
3950 defsubr (&Skey_binding);
3951 defsubr (&Slocal_key_binding);
3952 defsubr (&Sglobal_key_binding);
3953 defsubr (&Sminor_mode_key_binding);
3954 defsubr (&Sdefine_key);
3955 defsubr (&Slookup_key);
3956 defsubr (&Sdefine_prefix_command);
3957 defsubr (&Suse_global_map);
3958 defsubr (&Suse_local_map);
3959 defsubr (&Scurrent_local_map);
3960 defsubr (&Scurrent_global_map);
3961 defsubr (&Scurrent_minor_mode_maps);
3962 defsubr (&Scurrent_active_maps);
3963 defsubr (&Saccessible_keymaps);
3964 defsubr (&Skey_description);
3965 defsubr (&Sdescribe_vector);
3966 defsubr (&Ssingle_key_description);
3967 defsubr (&Stext_char_description);
3968 defsubr (&Swhere_is_internal);
3969 defsubr (&Sdescribe_buffer_bindings);
3970 defsubr (&Sapropos_internal);
3973 void
3974 keys_of_keymap (void)
3976 initial_define_key (global_map, 033, "ESC-prefix");
3977 initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");