* keymap.c (access_keymap): Add AUTOLOAD parameter.
[emacs.git] / src / keymap.c
blobd9344397bcf85c1af190c72999e4c61b7737feac
1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99 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 2, or (at your option)
9 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; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 #include <config.h>
23 #include <stdio.h>
24 #include "lisp.h"
25 #include "commands.h"
26 #include "buffer.h"
27 #include "charset.h"
28 #include "keyboard.h"
29 #include "termhooks.h"
30 #include "blockinput.h"
31 #include "puresize.h"
32 #include "intervals.h"
34 #define min(a, b) ((a) < (b) ? (a) : (b))
35 #define KEYMAPP(m) (!NILP (Fkeymapp (m)))
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 /* was MinibufLocalMap */
53 Lisp_Object Vminibuffer_local_map;
54 /* The keymap used by the minibuf for local
55 bindings when spaces are allowed in the
56 minibuf */
58 /* was MinibufLocalNSMap */
59 Lisp_Object Vminibuffer_local_ns_map;
60 /* The keymap used by the minibuf for local
61 bindings when spaces are not encouraged
62 in the minibuf */
64 /* keymap used for minibuffers when doing completion */
65 /* was MinibufLocalCompletionMap */
66 Lisp_Object Vminibuffer_local_completion_map;
68 /* keymap used for minibuffers when doing completion and require a match */
69 /* was MinibufLocalMustMatchMap */
70 Lisp_Object Vminibuffer_local_must_match_map;
72 /* Alist of minor mode variables and keymaps. */
73 Lisp_Object Vminor_mode_map_alist;
75 /* Alist of major-mode-specific overrides for
76 minor mode variables and keymaps. */
77 Lisp_Object Vminor_mode_overriding_map_alist;
79 /* Keymap mapping ASCII function key sequences onto their preferred forms.
80 Initialized by the terminal-specific lisp files. See DEFVAR for more
81 documentation. */
82 Lisp_Object Vfunction_key_map;
84 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
85 Lisp_Object Vkey_translation_map;
87 /* A list of all commands given new bindings since a certain time
88 when nil was stored here.
89 This is used to speed up recomputation of menu key equivalents
90 when Emacs starts up. t means don't record anything here. */
91 Lisp_Object Vdefine_key_rebound_commands;
93 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
95 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
96 in a string key sequence is equivalent to prefixing with this
97 character. */
98 extern Lisp_Object meta_prefix_char;
100 extern Lisp_Object Voverriding_local_map;
102 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
103 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
105 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
106 static Lisp_Object describe_buffer_bindings P_ ((Lisp_Object));
107 static void describe_command P_ ((Lisp_Object));
108 static void describe_translation P_ ((Lisp_Object));
109 static void describe_map P_ ((Lisp_Object, Lisp_Object,
110 void (*) P_ ((Lisp_Object)),
111 int, Lisp_Object, Lisp_Object*, int));
113 /* Keymap object support - constructors and predicates. */
115 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
116 "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
117 CHARTABLE is a char-table that holds the bindings for the ASCII\n\
118 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
119 mouse events, and any other things that appear in the input stream.\n\
120 All entries in it are initially nil, meaning \"command undefined\".\n\n\
121 The optional arg STRING supplies a menu name for the keymap\n\
122 in case you use it as a menu with `x-popup-menu'.")
123 (string)
124 Lisp_Object string;
126 Lisp_Object tail;
127 if (!NILP (string))
128 tail = Fcons (string, Qnil);
129 else
130 tail = Qnil;
131 return Fcons (Qkeymap,
132 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
135 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
136 "Construct and return a new sparse-keymap list.\n\
137 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
138 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
139 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
140 Initially the alist is nil.\n\n\
141 The optional arg STRING supplies a menu name for the keymap\n\
142 in case you use it as a menu with `x-popup-menu'.")
143 (string)
144 Lisp_Object string;
146 if (!NILP (string))
147 return Fcons (Qkeymap, Fcons (string, Qnil));
148 return Fcons (Qkeymap, Qnil);
151 /* This function is used for installing the standard key bindings
152 at initialization time.
154 For example:
156 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
158 void
159 initial_define_key (keymap, key, defname)
160 Lisp_Object keymap;
161 int key;
162 char *defname;
164 store_in_keymap (keymap, make_number (key), intern (defname));
167 void
168 initial_define_lispy_key (keymap, keyname, defname)
169 Lisp_Object keymap;
170 char *keyname;
171 char *defname;
173 store_in_keymap (keymap, intern (keyname), intern (defname));
176 /* Define character fromchar in map frommap as an alias for character
177 tochar in map tomap. Subsequent redefinitions of the latter WILL
178 affect the former. */
180 #if 0
181 void
182 synkey (frommap, fromchar, tomap, tochar)
183 struct Lisp_Vector *frommap, *tomap;
184 int fromchar, tochar;
186 Lisp_Object v, c;
187 XSETVECTOR (v, tomap);
188 XSETFASTINT (c, tochar);
189 frommap->contents[fromchar] = Fcons (v, c);
191 #endif /* 0 */
193 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
194 "Return t if OBJECT is a keymap.\n\
196 A keymap is a list (keymap . ALIST),\n\
197 or a symbol whose function definition is itself a keymap.\n\
198 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
199 a vector of densely packed bindings for small character codes\n\
200 is also allowed as an element.")
201 (object)
202 Lisp_Object object;
204 /* FIXME: Maybe this should return t for autoloaded keymaps? -sm */
205 return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
208 /* Check that OBJECT is a keymap (after dereferencing through any
209 symbols). If it is, return it.
211 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
212 is an autoload form, do the autoload and try again.
213 If AUTOLOAD is nonzero, callers must assume GC is possible.
215 ERROR controls how we respond if OBJECT isn't a keymap.
216 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
218 Note that most of the time, we don't want to pursue autoloads.
219 Functions like Faccessible_keymaps which scan entire keymap trees
220 shouldn't load every autoloaded keymap. I'm not sure about this,
221 but it seems to me that only read_key_sequence, Flookup_key, and
222 Fdefine_key should cause keymaps to be autoloaded.
224 This function can GC when AUTOLOAD is non-zero, because it calls
225 do_autoload which can GC. */
227 Lisp_Object
228 get_keymap_1 (object, error, autoload)
229 Lisp_Object object;
230 int error, autoload;
232 Lisp_Object tem;
234 autoload_retry:
235 if (NILP (object))
236 goto end;
237 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
238 return object;
239 else
241 tem = indirect_function (object);
242 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
243 return tem;
246 /* Should we do an autoload? Autoload forms for keymaps have
247 Qkeymap as their fifth element. */
248 if (autoload
249 && SYMBOLP (object)
250 && CONSP (tem)
251 && EQ (XCAR (tem), Qautoload))
253 Lisp_Object tail;
255 tail = Fnth (make_number (4), tem);
256 if (EQ (tail, Qkeymap))
258 struct gcpro gcpro1, gcpro2;
260 GCPRO2 (tem, object);
261 do_autoload (tem, object);
262 UNGCPRO;
264 goto autoload_retry;
268 end:
269 if (error)
270 wrong_type_argument (Qkeymapp, object);
271 return Qnil;
275 /* Follow any symbol chaining, and return the keymap denoted by OBJECT.
276 If OBJECT doesn't denote a keymap at all, signal an error. */
277 Lisp_Object
278 get_keymap (object)
279 Lisp_Object object;
281 return get_keymap_1 (object, 1, 0);
284 /* Return the parent map of the keymap MAP, or nil if it has none.
285 We assume that MAP is a valid keymap. */
287 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
288 "Return the parent keymap of KEYMAP.")
289 (keymap)
290 Lisp_Object keymap;
292 Lisp_Object list;
294 keymap = get_keymap_1 (keymap, 1, 1);
296 /* Skip past the initial element `keymap'. */
297 list = XCDR (keymap);
298 for (; CONSP (list); list = XCDR (list))
300 /* See if there is another `keymap'. */
301 if (KEYMAPP (list))
302 return list;
305 return get_keymap_1(list, 0, autoload);
309 /* Check whether MAP is one of MAPS parents. */
311 keymap_memberp (map, maps)
312 Lisp_Object map, maps;
314 while (KEYMAPP (maps) && !EQ (map, maps))
315 maps = Fkeymap_parent (maps);
316 return (EQ (map, maps));
319 /* Set the parent keymap of MAP to PARENT. */
321 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
322 "Modify KEYMAP to set its parent map to PARENT.\n\
323 PARENT should be nil or another keymap.")
324 (keymap, parent)
325 Lisp_Object keymap, parent;
327 Lisp_Object list, prev;
328 struct gcpro gcpro1;
329 int i;
331 keymap = get_keymap_1 (keymap, 1, 1);
332 GCPRO1 (keymap);
334 if (!NILP (parent))
336 parent = get_keymap_1 (parent, 1, 1);
338 /* Check for cycles. */
339 if (keymap_memberp (keymap, parent))
340 error ("Cyclic keymap inheritance");
343 /* Skip past the initial element `keymap'. */
344 prev = keymap;
345 while (1)
347 list = XCDR (prev);
348 /* If there is a parent keymap here, replace it.
349 If we came to the end, add the parent in PREV. */
350 if (! CONSP (list) || KEYMAPP (list))
352 /* If we already have the right parent, return now
353 so that we avoid the loops below. */
354 if (EQ (XCDR (prev), parent))
355 RETURN_UNGCPRO (parent);
357 XCDR (prev) = parent;
358 break;
360 prev = list;
363 /* Scan through for submaps, and set their parents too. */
365 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
367 /* Stop the scan when we come to the parent. */
368 if (EQ (XCAR (list), Qkeymap))
369 break;
371 /* If this element holds a prefix map, deal with it. */
372 if (CONSP (XCAR (list))
373 && CONSP (XCDR (XCAR (list))))
374 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
375 XCDR (XCAR (list)));
377 if (VECTORP (XCAR (list)))
378 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
379 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
380 fix_submap_inheritance (keymap, make_number (i),
381 XVECTOR (XCAR (list))->contents[i]);
383 if (CHAR_TABLE_P (XCAR (list)))
385 Lisp_Object indices[3];
387 map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
388 keymap, 0, indices);
392 RETURN_UNGCPRO (parent);
395 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
396 if EVENT is also a prefix in MAP's parent,
397 make sure that SUBMAP inherits that definition as its own parent. */
399 static void
400 fix_submap_inheritance (map, event, submap)
401 Lisp_Object map, event, submap;
403 Lisp_Object map_parent, parent_entry;
405 /* SUBMAP is a cons that we found as a key binding.
406 Discard the other things found in a menu key binding. */
408 submap = get_keymap_1 (get_keyelt (submap, 0), 0, 0);
410 /* If it isn't a keymap now, there's no work to do. */
411 if (NILP (submap))
412 return;
414 map_parent = Fkeymap_parent (map);
415 if (! NILP (map_parent))
416 parent_entry = access_keymap (map_parent, event, 0, 0, 0);
417 else
418 parent_entry = Qnil;
420 /* If MAP's parent has something other than a keymap,
421 our own submap shadows it completely, so use nil as SUBMAP's parent. */
422 if (! KEYMAPP (parent_entry))
423 parent_entry = Qnil;
425 if (! EQ (parent_entry, submap))
427 Lisp_Object submap_parent;
428 submap_parent = submap;
429 while (1)
431 Lisp_Object tem;
432 tem = Fkeymap_parent (submap_parent);
433 if (keymap_memberp (tem, parent_entry))
434 /* Fset_keymap_parent could create a cycle. */
435 return;
436 if (KEYMAPP (tem))
437 submap_parent = tem;
438 else
439 break;
441 Fset_keymap_parent (submap_parent, parent_entry);
445 /* Look up IDX in MAP. IDX may be any sort of event.
446 Note that this does only one level of lookup; IDX must be a single
447 event, not a sequence.
449 If T_OK is non-zero, bindings for Qt are treated as default
450 bindings; any key left unmentioned by other tables and bindings is
451 given the binding of Qt.
453 If T_OK is zero, bindings for Qt are not treated specially.
455 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
457 Lisp_Object
458 access_keymap (map, idx, t_ok, noinherit, autoload)
459 Lisp_Object map;
460 Lisp_Object idx;
461 int t_ok;
462 int noinherit;
463 int autoload;
465 int noprefix = 0;
466 Lisp_Object val;
468 /* If idx is a list (some sort of mouse click, perhaps?),
469 the index we want to use is the car of the list, which
470 ought to be a symbol. */
471 idx = EVENT_HEAD (idx);
473 /* If idx is a symbol, it might have modifiers, which need to
474 be put in the canonical order. */
475 if (SYMBOLP (idx))
476 idx = reorder_modifiers (idx);
477 else if (INTEGERP (idx))
478 /* Clobber the high bits that can be present on a machine
479 with more than 24 bits of integer. */
480 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
482 /* Handle the special meta -> esc mapping. */
483 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
485 map = get_keymap_1 (access_keymap
486 (map, meta_prefix_char, t_ok, noinherit, autoload),
487 0, autoload);
488 XSETINT (idx, XFASTINT (idx) & ~meta_modifier);
492 Lisp_Object tail;
493 Lisp_Object t_binding;
495 t_binding = Qnil;
496 for (tail = XCDR (map);
497 CONSP (tail) || (tail = get_keymap_1(tail, 0, autoload), CONSP (tail));
498 tail = XCDR (tail))
500 Lisp_Object binding;
502 binding = XCAR (tail);
503 if (SYMBOLP (binding))
505 /* If NOINHERIT, stop finding prefix definitions
506 after we pass a second occurrence of the `keymap' symbol. */
507 if (noinherit && EQ (binding, Qkeymap))
508 noprefix = 1;
510 else if (CONSP (binding))
512 if (EQ (XCAR (binding), idx))
514 val = XCDR (binding);
515 if (noprefix && KEYMAPP (val))
516 return Qnil;
517 if (CONSP (val))
518 fix_submap_inheritance (map, idx, val);
519 return get_keyelt (val, autoload);
521 if (t_ok && EQ (XCAR (binding), Qt))
522 t_binding = XCDR (binding);
524 else if (VECTORP (binding))
526 if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
528 val = XVECTOR (binding)->contents[XFASTINT (idx)];
529 if (noprefix && KEYMAPP (val))
530 return Qnil;
531 if (CONSP (val))
532 fix_submap_inheritance (map, idx, val);
533 return get_keyelt (val, autoload);
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)
542 && ! (XFASTINT (idx)
543 & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
544 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
546 val = Faref (binding, idx);
547 if (noprefix && KEYMAPP (val))
548 return Qnil;
549 if (CONSP (val))
550 fix_submap_inheritance (map, idx, val);
551 return get_keyelt (val, autoload);
555 QUIT;
558 return get_keyelt (t_binding, autoload);
562 /* Given OBJECT which was found in a slot in a keymap,
563 trace indirect definitions to get the actual definition of that slot.
564 An indirect definition is a list of the form
565 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
566 and INDEX is the object to look up in KEYMAP to yield the definition.
568 Also if OBJECT has a menu string as the first element,
569 remove that. Also remove a menu help string as second element.
571 If AUTOLOAD is nonzero, load autoloadable keymaps
572 that are referred to with indirection. */
574 Lisp_Object
575 get_keyelt (object, autoload)
576 register Lisp_Object object;
577 int autoload;
579 while (1)
581 if (!(CONSP (object)))
582 /* This is really the value. */
583 return object;
585 /* If the keymap contents looks like (keymap ...) or (lambda ...)
586 then use itself. */
587 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
588 return object;
590 /* If the keymap contents looks like (menu-item name . DEFN)
591 or (menu-item name DEFN ...) then use DEFN.
592 This is a new format menu item. */
593 else if (EQ (XCAR (object), Qmenu_item))
595 if (CONSP (XCDR (object)))
597 Lisp_Object tem;
599 object = XCDR (XCDR (object));
600 tem = object;
601 if (CONSP (object))
602 object = XCAR (object);
604 /* If there's a `:filter FILTER', apply FILTER to the
605 menu-item's definition to get the real definition to
606 use. Temporarily inhibit GC while evaluating FILTER,
607 because not functions calling get_keyelt are prepared
608 for a GC. */
609 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
610 if (EQ (XCAR (tem), QCfilter))
612 int count = inhibit_garbage_collection ();
613 Lisp_Object filter;
614 filter = XCAR (XCDR (tem));
615 filter = list2 (filter, list2 (Qquote, object));
616 object = menu_item_eval_property (filter);
617 unbind_to (count, Qnil);
618 break;
621 else
622 /* Invalid keymap */
623 return object;
626 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
627 Keymap alist elements like (CHAR MENUSTRING . DEFN)
628 will be used by HierarKey menus. */
629 else if (STRINGP (XCAR (object)))
631 object = XCDR (object);
632 /* Also remove a menu help string, if any,
633 following the menu item name. */
634 if (CONSP (object) && STRINGP (XCAR (object)))
635 object = XCDR (object);
636 /* Also remove the sublist that caches key equivalences, if any. */
637 if (CONSP (object) && CONSP (XCAR (object)))
639 Lisp_Object carcar;
640 carcar = XCAR (XCAR (object));
641 if (NILP (carcar) || VECTORP (carcar))
642 object = XCDR (object);
646 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
647 else
649 Lisp_Object map;
650 map = get_keymap_1 (Fcar_safe (object), 0, autoload);
651 return (NILP (map) ? object /* Invalid keymap */
652 : access_keymap (map, Fcdr (object), 0, 0, autoload));
657 static Lisp_Object
658 store_in_keymap (keymap, idx, def)
659 Lisp_Object keymap;
660 register Lisp_Object idx;
661 register Lisp_Object def;
663 /* If we are preparing to dump, and DEF is a menu element
664 with a menu item indicator, copy it to ensure it is not pure. */
665 if (CONSP (def) && PURE_P (def)
666 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
667 def = Fcons (XCAR (def), XCDR (def));
669 if (!CONSP (keymap) || ! EQ (XCAR (keymap), Qkeymap))
670 error ("attempt to define a key in a non-keymap");
672 /* If idx is a list (some sort of mouse click, perhaps?),
673 the index we want to use is the car of the list, which
674 ought to be a symbol. */
675 idx = EVENT_HEAD (idx);
677 /* If idx is a symbol, it might have modifiers, which need to
678 be put in the canonical order. */
679 if (SYMBOLP (idx))
680 idx = reorder_modifiers (idx);
681 else if (INTEGERP (idx))
682 /* Clobber the high bits that can be present on a machine
683 with more than 24 bits of integer. */
684 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
686 /* Scan the keymap for a binding of idx. */
688 Lisp_Object tail;
690 /* The cons after which we should insert new bindings. If the
691 keymap has a table element, we record its position here, so new
692 bindings will go after it; this way, the table will stay
693 towards the front of the alist and character lookups in dense
694 keymaps will remain fast. Otherwise, this just points at the
695 front of the keymap. */
696 Lisp_Object insertion_point;
698 insertion_point = keymap;
699 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
701 Lisp_Object elt;
703 elt = XCAR (tail);
704 if (VECTORP (elt))
706 if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (elt)->size)
708 XVECTOR (elt)->contents[XFASTINT (idx)] = def;
709 return def;
711 insertion_point = tail;
713 else if (CHAR_TABLE_P (elt))
715 /* Character codes with modifiers
716 are not included in a char-table.
717 All character codes without modifiers are included. */
718 if (NATNUMP (idx)
719 && ! (XFASTINT (idx)
720 & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
721 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
723 Faset (elt, idx, def);
724 return def;
726 insertion_point = tail;
728 else if (CONSP (elt))
730 if (EQ (idx, XCAR (elt)))
732 XCDR (elt) = def;
733 return def;
736 else if (SYMBOLP (elt))
738 /* If we find a 'keymap' symbol in the spine of KEYMAP,
739 then we must have found the start of a second keymap
740 being used as the tail of KEYMAP, and a binding for IDX
741 should be inserted before it. */
742 if (EQ (elt, Qkeymap))
743 goto keymap_end;
746 QUIT;
749 keymap_end:
750 /* We have scanned the entire keymap, and not found a binding for
751 IDX. Let's add one. */
752 XCDR (insertion_point)
753 = Fcons (Fcons (idx, def), XCDR (insertion_point));
756 return def;
759 void
760 copy_keymap_1 (chartable, idx, elt)
761 Lisp_Object chartable, idx, elt;
763 if (!SYMBOLP (elt) && ! NILP (Fkeymapp (elt)))
764 Faset (chartable, idx, Fcopy_keymap (elt));
767 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
768 "Return a copy of the keymap KEYMAP.\n\
769 The copy starts out with the same definitions of KEYMAP,\n\
770 but changing either the copy or KEYMAP does not affect the other.\n\
771 Any key definitions that are subkeymaps are recursively copied.\n\
772 However, a key definition which is a symbol whose definition is a keymap\n\
773 is not copied.")
774 (keymap)
775 Lisp_Object keymap;
777 register Lisp_Object copy, tail;
779 copy = Fcopy_alist (get_keymap (keymap));
781 for (tail = copy; CONSP (tail); tail = XCDR (tail))
783 Lisp_Object elt;
785 elt = XCAR (tail);
786 if (CHAR_TABLE_P (elt))
788 Lisp_Object indices[3];
790 elt = Fcopy_sequence (elt);
791 XCAR (tail) = elt;
793 map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
795 else if (VECTORP (elt))
797 int i;
799 elt = Fcopy_sequence (elt);
800 XCAR (tail) = elt;
802 for (i = 0; i < XVECTOR (elt)->size; i++)
803 if (!SYMBOLP (XVECTOR (elt)->contents[i])
804 && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i])))
805 XVECTOR (elt)->contents[i]
806 = Fcopy_keymap (XVECTOR (elt)->contents[i]);
808 else if (CONSP (elt) && CONSP (XCDR (elt)))
810 Lisp_Object tem;
811 tem = XCDR (elt);
813 /* Is this a new format menu item. */
814 if (EQ (XCAR (tem),Qmenu_item))
816 /* Copy cell with menu-item marker. */
817 XCDR (elt)
818 = Fcons (XCAR (tem), XCDR (tem));
819 elt = XCDR (elt);
820 tem = XCDR (elt);
821 if (CONSP (tem))
823 /* Copy cell with menu-item name. */
824 XCDR (elt)
825 = Fcons (XCAR (tem), XCDR (tem));
826 elt = XCDR (elt);
827 tem = XCDR (elt);
829 if (CONSP (tem))
831 /* Copy cell with binding and if the binding is a keymap,
832 copy that. */
833 XCDR (elt)
834 = Fcons (XCAR (tem), XCDR (tem));
835 elt = XCDR (elt);
836 tem = XCAR (elt);
837 if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem))))
838 XCAR (elt) = Fcopy_keymap (tem);
839 tem = XCDR (elt);
840 if (CONSP (tem) && CONSP (XCAR (tem)))
841 /* Delete cache for key equivalences. */
842 XCDR (elt) = XCDR (tem);
845 else
847 /* It may be an old fomat menu item.
848 Skip the optional menu string.
850 if (STRINGP (XCAR (tem)))
852 /* Copy the cell, since copy-alist didn't go this deep. */
853 XCDR (elt)
854 = Fcons (XCAR (tem), XCDR (tem));
855 elt = XCDR (elt);
856 tem = XCDR (elt);
857 /* Also skip the optional menu help string. */
858 if (CONSP (tem) && STRINGP (XCAR (tem)))
860 XCDR (elt)
861 = Fcons (XCAR (tem), XCDR (tem));
862 elt = XCDR (elt);
863 tem = XCDR (elt);
865 /* There may also be a list that caches key equivalences.
866 Just delete it for the new keymap. */
867 if (CONSP (tem)
868 && CONSP (XCAR (tem))
869 && (NILP (XCAR (XCAR (tem)))
870 || VECTORP (XCAR (XCAR (tem)))))
871 XCDR (elt) = XCDR (tem);
873 if (CONSP (elt)
874 && ! SYMBOLP (XCDR (elt))
875 && ! NILP (Fkeymapp (XCDR (elt))))
876 XCDR (elt) = Fcopy_keymap (XCDR (elt));
882 return copy;
885 /* Simple Keymap mutators and accessors. */
887 /* GC is possible in this function if it autoloads a keymap. */
889 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
890 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
891 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
892 meaning a sequence of keystrokes and events.\n\
893 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
894 can be included if you use a vector.\n\
895 DEF is anything that can be a key's definition:\n\
896 nil (means key is undefined in this keymap),\n\
897 a command (a Lisp function suitable for interactive calling)\n\
898 a string (treated as a keyboard macro),\n\
899 a keymap (to define a prefix key),\n\
900 a symbol. When the key is looked up, the symbol will stand for its\n\
901 function definition, which should at that time be one of the above,\n\
902 or another symbol whose function definition is used, etc.\n\
903 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
904 (DEFN should be a valid definition in its own right),\n\
905 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
907 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
908 the front of KEYMAP.")
909 (keymap, key, def)
910 Lisp_Object keymap;
911 Lisp_Object key;
912 Lisp_Object def;
914 register int idx;
915 register Lisp_Object c;
916 register Lisp_Object cmd;
917 int metized = 0;
918 int meta_bit;
919 int length;
920 struct gcpro gcpro1, gcpro2, gcpro3;
922 keymap = get_keymap_1 (keymap, 1, 1);
924 if (!VECTORP (key) && !STRINGP (key))
925 key = wrong_type_argument (Qarrayp, key);
927 length = XFASTINT (Flength (key));
928 if (length == 0)
929 return Qnil;
931 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
932 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
934 GCPRO3 (keymap, key, def);
936 if (VECTORP (key))
937 meta_bit = meta_modifier;
938 else
939 meta_bit = 0x80;
941 idx = 0;
942 while (1)
944 c = Faref (key, make_number (idx));
946 if (CONSP (c) && lucid_event_type_list_p (c))
947 c = Fevent_convert_list (c);
949 if (INTEGERP (c)
950 && (XINT (c) & meta_bit)
951 && !metized)
953 c = meta_prefix_char;
954 metized = 1;
956 else
958 if (INTEGERP (c))
959 XSETINT (c, XINT (c) & ~meta_bit);
961 metized = 0;
962 idx++;
965 if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
966 error ("Key sequence contains invalid events");
968 if (idx == length)
969 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
971 cmd = access_keymap (keymap, c, 0, 1, 1);
973 /* If this key is undefined, make it a prefix. */
974 if (NILP (cmd))
975 cmd = define_as_prefix (keymap, c);
977 keymap = get_keymap_1 (cmd, 0, 1);
978 if (NILP (keymap))
979 /* We must use Fkey_description rather than just passing key to
980 error; key might be a vector, not a string. */
981 error ("Key sequence %s uses invalid prefix characters",
982 XSTRING (Fkey_description (key))->data);
986 /* Value is number if KEY is too long; NIL if valid but has no definition. */
987 /* GC is possible in this function if it autoloads a keymap. */
989 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
990 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
991 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
993 A number as value means KEY is \"too long\";\n\
994 that is, characters or symbols in it except for the last one\n\
995 fail to be a valid sequence of prefix characters in KEYMAP.\n\
996 The number is how many characters at the front of KEY\n\
997 it takes to reach a non-prefix command.\n\
999 Normally, `lookup-key' ignores bindings for t, which act as default\n\
1000 bindings, used when nothing else in the keymap applies; this makes it\n\
1001 usable as a general function for probing keymaps. However, if the\n\
1002 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
1003 recognize the default bindings, just as `read-key-sequence' does.")
1004 (keymap, key, accept_default)
1005 register Lisp_Object keymap;
1006 Lisp_Object key;
1007 Lisp_Object accept_default;
1009 register int idx;
1010 register Lisp_Object cmd;
1011 register Lisp_Object c;
1012 int length;
1013 int t_ok = ! NILP (accept_default);
1014 struct gcpro gcpro1;
1016 keymap = get_keymap_1 (keymap, 1, 1);
1018 if (!VECTORP (key) && !STRINGP (key))
1019 key = wrong_type_argument (Qarrayp, key);
1021 length = XFASTINT (Flength (key));
1022 if (length == 0)
1023 return keymap;
1025 GCPRO1 (key);
1027 idx = 0;
1028 while (1)
1030 c = Faref (key, make_number (idx++));
1032 if (CONSP (c) && lucid_event_type_list_p (c))
1033 c = Fevent_convert_list (c);
1035 /* Turn the 8th bit of string chars into a meta modifier. */
1036 if (XINT (c) & 0x80 && STRINGP (key))
1037 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1039 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1040 if (idx == length)
1041 RETURN_UNGCPRO (cmd);
1043 keymap = get_keymap_1 (cmd, 0, 1);
1044 if (NILP (keymap))
1045 RETURN_UNGCPRO (make_number (idx));
1047 QUIT;
1051 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1052 Assume that currently it does not define C at all.
1053 Return the keymap. */
1055 static Lisp_Object
1056 define_as_prefix (keymap, c)
1057 Lisp_Object keymap, c;
1059 Lisp_Object cmd;
1061 cmd = Fmake_sparse_keymap (Qnil);
1062 /* If this key is defined as a prefix in an inherited keymap,
1063 make it a prefix in this map, and make its definition
1064 inherit the other prefix definition. */
1065 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1066 store_in_keymap (keymap, c, cmd);
1068 return cmd;
1071 /* Append a key to the end of a key sequence. We always make a vector. */
1073 Lisp_Object
1074 append_key (key_sequence, key)
1075 Lisp_Object key_sequence, key;
1077 Lisp_Object args[2];
1079 args[0] = key_sequence;
1081 args[1] = Fcons (key, Qnil);
1082 return Fvconcat (2, args);
1086 /* Global, local, and minor mode keymap stuff. */
1088 /* We can't put these variables inside current_minor_maps, since under
1089 some systems, static gets macro-defined to be the empty string.
1090 Ickypoo. */
1091 static Lisp_Object *cmm_modes, *cmm_maps;
1092 static int cmm_size;
1094 /* Error handler used in current_minor_maps. */
1095 static Lisp_Object
1096 current_minor_maps_error ()
1098 return Qnil;
1101 /* Store a pointer to an array of the keymaps of the currently active
1102 minor modes in *buf, and return the number of maps it contains.
1104 This function always returns a pointer to the same buffer, and may
1105 free or reallocate it, so if you want to keep it for a long time or
1106 hand it out to lisp code, copy it. This procedure will be called
1107 for every key sequence read, so the nice lispy approach (return a
1108 new assoclist, list, what have you) for each invocation would
1109 result in a lot of consing over time.
1111 If we used xrealloc/xmalloc and ran out of memory, they would throw
1112 back to the command loop, which would try to read a key sequence,
1113 which would call this function again, resulting in an infinite
1114 loop. Instead, we'll use realloc/malloc and silently truncate the
1115 list, let the key sequence be read, and hope some other piece of
1116 code signals the error. */
1118 current_minor_maps (modeptr, mapptr)
1119 Lisp_Object **modeptr, **mapptr;
1121 int i = 0;
1122 int list_number = 0;
1123 Lisp_Object alist, assoc, var, val;
1124 Lisp_Object lists[2];
1126 lists[0] = Vminor_mode_overriding_map_alist;
1127 lists[1] = Vminor_mode_map_alist;
1129 for (list_number = 0; list_number < 2; list_number++)
1130 for (alist = lists[list_number];
1131 CONSP (alist);
1132 alist = XCDR (alist))
1133 if ((assoc = XCAR (alist), CONSP (assoc))
1134 && (var = XCAR (assoc), SYMBOLP (var))
1135 && (val = find_symbol_value (var), ! EQ (val, Qunbound))
1136 && ! NILP (val))
1138 Lisp_Object temp;
1140 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1141 and also an entry in Vminor_mode_map_alist,
1142 ignore the latter. */
1143 if (list_number == 1)
1145 val = assq_no_quit (var, lists[0]);
1146 if (!NILP (val))
1147 break;
1150 if (i >= cmm_size)
1152 Lisp_Object *newmodes, *newmaps;
1154 if (cmm_maps)
1156 BLOCK_INPUT;
1157 cmm_size *= 2;
1158 newmodes
1159 = (Lisp_Object *) realloc (cmm_modes,
1160 cmm_size * sizeof (Lisp_Object));
1161 newmaps
1162 = (Lisp_Object *) realloc (cmm_maps,
1163 cmm_size * sizeof (Lisp_Object));
1164 UNBLOCK_INPUT;
1166 else
1168 BLOCK_INPUT;
1169 cmm_size = 30;
1170 newmodes
1171 = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object));
1172 newmaps
1173 = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object));
1174 UNBLOCK_INPUT;
1177 if (newmaps && newmodes)
1179 cmm_modes = newmodes;
1180 cmm_maps = newmaps;
1182 else
1183 break;
1186 /* Get the keymap definition--or nil if it is not defined. */
1187 temp = internal_condition_case_1 (Findirect_function,
1188 XCDR (assoc),
1189 Qerror, current_minor_maps_error);
1190 if (!NILP (temp))
1192 cmm_modes[i] = var;
1193 cmm_maps [i] = temp;
1194 i++;
1198 if (modeptr) *modeptr = cmm_modes;
1199 if (mapptr) *mapptr = cmm_maps;
1200 return i;
1203 /* GC is possible in this function if it autoloads a keymap. */
1205 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
1206 "Return the binding for command KEY in current keymaps.\n\
1207 KEY is a string or vector, a sequence of keystrokes.\n\
1208 The binding is probably a symbol with a function definition.\n\
1210 Normally, `key-binding' ignores bindings for t, which act as default\n\
1211 bindings, used when nothing else in the keymap applies; this makes it\n\
1212 usable as a general function for probing keymaps. However, if the\n\
1213 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
1214 recognize the default bindings, just as `read-key-sequence' does.")
1215 (key, accept_default)
1216 Lisp_Object key, accept_default;
1218 Lisp_Object *maps, value;
1219 int nmaps, i;
1220 struct gcpro gcpro1;
1222 GCPRO1 (key);
1224 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1226 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1227 key, accept_default);
1228 if (! NILP (value) && !INTEGERP (value))
1229 RETURN_UNGCPRO (value);
1231 else if (!NILP (Voverriding_local_map))
1233 value = Flookup_key (Voverriding_local_map, key, accept_default);
1234 if (! NILP (value) && !INTEGERP (value))
1235 RETURN_UNGCPRO (value);
1237 else
1239 Lisp_Object local;
1241 nmaps = current_minor_maps (0, &maps);
1242 /* Note that all these maps are GCPRO'd
1243 in the places where we found them. */
1245 for (i = 0; i < nmaps; i++)
1246 if (! NILP (maps[i]))
1248 value = Flookup_key (maps[i], key, accept_default);
1249 if (! NILP (value) && !INTEGERP (value))
1250 RETURN_UNGCPRO (value);
1253 local = get_local_map (PT, current_buffer, keymap);
1254 if (! NILP (local))
1256 value = Flookup_key (local, key, accept_default);
1257 if (! NILP (value) && !INTEGERP (value))
1258 RETURN_UNGCPRO (value);
1261 local = get_local_map (PT, current_buffer, local_map);
1263 if (! NILP (local))
1265 value = Flookup_key (local, key, accept_default);
1266 if (! NILP (value) && !INTEGERP (value))
1267 RETURN_UNGCPRO (value);
1271 value = Flookup_key (current_global_map, key, accept_default);
1272 UNGCPRO;
1273 if (! NILP (value) && !INTEGERP (value))
1274 return value;
1276 return Qnil;
1279 /* GC is possible in this function if it autoloads a keymap. */
1281 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1282 "Return the binding for command KEYS in current local keymap only.\n\
1283 KEYS is a string, a sequence of keystrokes.\n\
1284 The binding is probably a symbol with a function definition.\n\
1286 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1287 bindings; see the description of `lookup-key' for more details about this.")
1288 (keys, accept_default)
1289 Lisp_Object keys, accept_default;
1291 register Lisp_Object map;
1292 map = current_buffer->keymap;
1293 if (NILP (map))
1294 return Qnil;
1295 return Flookup_key (map, keys, accept_default);
1298 /* GC is possible in this function if it autoloads a keymap. */
1300 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1301 "Return the binding for command KEYS in current global keymap only.\n\
1302 KEYS is a string, a sequence of keystrokes.\n\
1303 The binding is probably a symbol with a function definition.\n\
1304 This function's return values are the same as those of lookup-key\n\
1305 \(which see).\n\
1307 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1308 bindings; see the description of `lookup-key' for more details about this.")
1309 (keys, accept_default)
1310 Lisp_Object keys, accept_default;
1312 return Flookup_key (current_global_map, keys, accept_default);
1315 /* GC is possible in this function if it autoloads a keymap. */
1317 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1318 "Find the visible minor mode bindings of KEY.\n\
1319 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
1320 the symbol which names the minor mode binding KEY, and BINDING is\n\
1321 KEY's definition in that mode. In particular, if KEY has no\n\
1322 minor-mode bindings, return nil. If the first binding is a\n\
1323 non-prefix, all subsequent bindings will be omitted, since they would\n\
1324 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
1325 that come after prefix bindings.\n\
1327 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1328 bindings; see the description of `lookup-key' for more details about this.")
1329 (key, accept_default)
1330 Lisp_Object key, accept_default;
1332 Lisp_Object *modes, *maps;
1333 int nmaps;
1334 Lisp_Object binding;
1335 int i, j;
1336 struct gcpro gcpro1, gcpro2;
1338 nmaps = current_minor_maps (&modes, &maps);
1339 /* Note that all these maps are GCPRO'd
1340 in the places where we found them. */
1342 binding = Qnil;
1343 GCPRO2 (key, binding);
1345 for (i = j = 0; i < nmaps; i++)
1346 if (! NILP (maps[i])
1347 && ! NILP (binding = Flookup_key (maps[i], key, accept_default))
1348 && !INTEGERP (binding))
1350 if (! NILP (get_keymap (binding)))
1351 maps[j++] = Fcons (modes[i], binding);
1352 else if (j == 0)
1353 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1356 UNGCPRO;
1357 return Flist (j, maps);
1360 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1361 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
1362 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1363 If a second optional argument MAPVAR is given, the map is stored as\n\
1364 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1365 as a function.\n\
1366 The third optional argument NAME, if given, supplies a menu name\n\
1367 string for the map. This is required to use the keymap as a menu.")
1368 (command, mapvar, name)
1369 Lisp_Object command, mapvar, name;
1371 Lisp_Object map;
1372 map = Fmake_sparse_keymap (name);
1373 Ffset (command, map);
1374 if (!NILP (mapvar))
1375 Fset (mapvar, map);
1376 else
1377 Fset (command, map);
1378 return command;
1381 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1382 "Select KEYMAP as the global keymap.")
1383 (keymap)
1384 Lisp_Object keymap;
1386 keymap = get_keymap (keymap);
1387 current_global_map = keymap;
1389 return Qnil;
1392 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1393 "Select KEYMAP as the local keymap.\n\
1394 If KEYMAP is nil, that means no local keymap.")
1395 (keymap)
1396 Lisp_Object keymap;
1398 if (!NILP (keymap))
1399 keymap = get_keymap (keymap);
1401 current_buffer->keymap = keymap;
1403 return Qnil;
1406 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1407 "Return current buffer's local keymap, or nil if it has none.")
1410 return current_buffer->keymap;
1413 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1414 "Return the current global keymap.")
1417 return current_global_map;
1420 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1421 "Return a list of keymaps for the minor modes of the current buffer.")
1424 Lisp_Object *maps;
1425 int nmaps = current_minor_maps (0, &maps);
1427 return Flist (nmaps, maps);
1430 /* Help functions for describing and documenting keymaps. */
1432 static void accessible_keymaps_char_table ();
1434 /* This function cannot GC. */
1436 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1437 1, 2, 0,
1438 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1439 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1440 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1441 so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
1442 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1443 then the value includes only maps for prefixes that start with PREFIX.")
1444 (keymap, prefix)
1445 Lisp_Object keymap, prefix;
1447 Lisp_Object maps, good_maps, tail;
1448 int prefixlen = 0;
1450 /* no need for gcpro because we don't autoload any keymaps. */
1452 if (!NILP (prefix))
1453 prefixlen = XINT (Flength (prefix));
1455 if (!NILP (prefix))
1457 /* If a prefix was specified, start with the keymap (if any) for
1458 that prefix, so we don't waste time considering other prefixes. */
1459 Lisp_Object tem;
1460 tem = Flookup_key (keymap, prefix, Qt);
1461 /* Flookup_key may give us nil, or a number,
1462 if the prefix is not defined in this particular map.
1463 It might even give us a list that isn't a keymap. */
1464 tem = get_keymap_1 (tem, 0, 0);
1465 if (!NILP (tem))
1467 /* Convert PREFIX to a vector now, so that later on
1468 we don't have to deal with the possibility of a string. */
1469 if (STRINGP (prefix))
1471 int i, i_byte, c;
1472 Lisp_Object copy;
1474 copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
1475 for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
1477 int i_before = i;
1479 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
1480 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1481 c ^= 0200 | meta_modifier;
1482 XVECTOR (copy)->contents[i_before] = make_number (c);
1484 prefix = copy;
1486 maps = Fcons (Fcons (prefix, tem), Qnil);
1488 else
1489 return Qnil;
1491 else
1492 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1493 get_keymap (keymap)),
1494 Qnil);
1496 /* For each map in the list maps,
1497 look at any other maps it points to,
1498 and stick them at the end if they are not already in the list.
1500 This is a breadth-first traversal, where tail is the queue of
1501 nodes, and maps accumulates a list of all nodes visited. */
1503 for (tail = maps; CONSP (tail); tail = XCDR (tail))
1505 register Lisp_Object thisseq, thismap;
1506 Lisp_Object last;
1507 /* Does the current sequence end in the meta-prefix-char? */
1508 int is_metized;
1510 thisseq = Fcar (Fcar (tail));
1511 thismap = Fcdr (Fcar (tail));
1512 last = make_number (XINT (Flength (thisseq)) - 1);
1513 is_metized = (XINT (last) >= 0
1514 /* Don't metize the last char of PREFIX. */
1515 && XINT (last) >= prefixlen
1516 && EQ (Faref (thisseq, last), meta_prefix_char));
1518 for (; CONSP (thismap); thismap = XCDR (thismap))
1520 Lisp_Object elt;
1522 elt = XCAR (thismap);
1524 QUIT;
1526 if (CHAR_TABLE_P (elt))
1528 Lisp_Object indices[3];
1530 map_char_table (accessible_keymaps_char_table, Qnil,
1531 elt, Fcons (maps, Fcons (tail, thisseq)),
1532 0, indices);
1534 else if (VECTORP (elt))
1536 register int i;
1538 /* Vector keymap. Scan all the elements. */
1539 for (i = 0; i < XVECTOR (elt)->size; i++)
1541 register Lisp_Object tem;
1542 register Lisp_Object cmd;
1544 cmd = get_keyelt (XVECTOR (elt)->contents[i], 0);
1545 if (NILP (cmd)) continue;
1546 tem = Fkeymapp (cmd);
1547 if (!NILP (tem))
1549 cmd = get_keymap (cmd);
1550 /* Ignore keymaps that are already added to maps. */
1551 tem = Frassq (cmd, maps);
1552 if (NILP (tem))
1554 /* If the last key in thisseq is meta-prefix-char,
1555 turn it into a meta-ized keystroke. We know
1556 that the event we're about to append is an
1557 ascii keystroke since we're processing a
1558 keymap table. */
1559 if (is_metized)
1561 int meta_bit = meta_modifier;
1562 tem = Fcopy_sequence (thisseq);
1564 Faset (tem, last, make_number (i | meta_bit));
1566 /* This new sequence is the same length as
1567 thisseq, so stick it in the list right
1568 after this one. */
1569 XCDR (tail)
1570 = Fcons (Fcons (tem, cmd), XCDR (tail));
1572 else
1574 tem = append_key (thisseq, make_number (i));
1575 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1581 else if (CONSP (elt))
1583 register Lisp_Object cmd, tem;
1585 cmd = get_keyelt (XCDR (elt), 0);
1586 /* Ignore definitions that aren't keymaps themselves. */
1587 tem = Fkeymapp (cmd);
1588 if (!NILP (tem))
1590 /* Ignore keymaps that have been seen already. */
1591 cmd = get_keymap (cmd);
1592 tem = Frassq (cmd, maps);
1593 if (NILP (tem))
1595 /* Let elt be the event defined by this map entry. */
1596 elt = XCAR (elt);
1598 /* If the last key in thisseq is meta-prefix-char, and
1599 this entry is a binding for an ascii keystroke,
1600 turn it into a meta-ized keystroke. */
1601 if (is_metized && INTEGERP (elt))
1603 Lisp_Object element;
1605 element = thisseq;
1606 tem = Fvconcat (1, &element);
1607 XSETFASTINT (XVECTOR (tem)->contents[XINT (last)],
1608 XINT (elt) | meta_modifier);
1610 /* This new sequence is the same length as
1611 thisseq, so stick it in the list right
1612 after this one. */
1613 XCDR (tail)
1614 = Fcons (Fcons (tem, cmd), XCDR (tail));
1616 else
1617 nconc2 (tail,
1618 Fcons (Fcons (append_key (thisseq, elt), cmd),
1619 Qnil));
1626 if (NILP (prefix))
1627 return maps;
1629 /* Now find just the maps whose access prefixes start with PREFIX. */
1631 good_maps = Qnil;
1632 for (; CONSP (maps); maps = XCDR (maps))
1634 Lisp_Object elt, thisseq;
1635 elt = XCAR (maps);
1636 thisseq = XCAR (elt);
1637 /* The access prefix must be at least as long as PREFIX,
1638 and the first elements must match those of PREFIX. */
1639 if (XINT (Flength (thisseq)) >= prefixlen)
1641 int i;
1642 for (i = 0; i < prefixlen; i++)
1644 Lisp_Object i1;
1645 XSETFASTINT (i1, i);
1646 if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1647 break;
1649 if (i == prefixlen)
1650 good_maps = Fcons (elt, good_maps);
1654 return Fnreverse (good_maps);
1657 static void
1658 accessible_keymaps_char_table (args, index, cmd)
1659 Lisp_Object args, index, cmd;
1661 Lisp_Object tem;
1662 Lisp_Object maps, tail, thisseq;
1664 if (NILP (cmd))
1665 return;
1667 maps = XCAR (args);
1668 tail = XCAR (XCDR (args));
1669 thisseq = XCDR (XCDR (args));
1671 tem = Fkeymapp (cmd);
1672 if (!NILP (tem))
1674 cmd = get_keymap (cmd);
1675 /* Ignore keymaps that are already added to maps. */
1676 tem = Frassq (cmd, maps);
1677 if (NILP (tem))
1679 tem = append_key (thisseq, index);
1680 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1685 Lisp_Object Qsingle_key_description, Qkey_description;
1687 /* This function cannot GC. */
1689 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1690 "Return a pretty description of key-sequence KEYS.\n\
1691 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1692 spaces are put between sequence elements, etc.")
1693 (keys)
1694 Lisp_Object keys;
1696 int len = 0;
1697 int i, i_byte;
1698 Lisp_Object sep;
1699 Lisp_Object *args = NULL;
1701 if (STRINGP (keys))
1703 Lisp_Object vector;
1704 vector = Fmake_vector (Flength (keys), Qnil);
1705 for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
1707 int c;
1708 int i_before = i;
1710 FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
1711 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1712 c ^= 0200 | meta_modifier;
1713 XSETFASTINT (XVECTOR (vector)->contents[i_before], c);
1715 keys = vector;
1718 if (VECTORP (keys))
1720 /* In effect, this computes
1721 (mapconcat 'single-key-description keys " ")
1722 but we shouldn't use mapconcat because it can do GC. */
1724 len = XVECTOR (keys)->size;
1725 sep = build_string (" ");
1726 /* This has one extra element at the end that we don't pass to Fconcat. */
1727 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1729 for (i = 0; i < len; i++)
1731 args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i],
1732 Qnil);
1733 args[i * 2 + 1] = sep;
1736 else if (CONSP (keys))
1738 /* In effect, this computes
1739 (mapconcat 'single-key-description keys " ")
1740 but we shouldn't use mapconcat because it can do GC. */
1742 len = XFASTINT (Flength (keys));
1743 sep = build_string (" ");
1744 /* This has one extra element at the end that we don't pass to Fconcat. */
1745 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1747 for (i = 0; i < len; i++)
1749 args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
1750 args[i * 2 + 1] = sep;
1751 keys = XCDR (keys);
1754 else
1755 keys = wrong_type_argument (Qarrayp, keys);
1757 return Fconcat (len * 2 - 1, args);
1760 char *
1761 push_key_description (c, p)
1762 register unsigned int c;
1763 register char *p;
1765 unsigned c2;
1767 /* Clear all the meaningless bits above the meta bit. */
1768 c &= meta_modifier | ~ - meta_modifier;
1769 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
1770 | meta_modifier | shift_modifier | super_modifier);
1772 if (c & alt_modifier)
1774 *p++ = 'A';
1775 *p++ = '-';
1776 c -= alt_modifier;
1778 if ((c & ctrl_modifier) != 0
1779 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
1781 *p++ = 'C';
1782 *p++ = '-';
1783 c &= ~ctrl_modifier;
1785 if (c & hyper_modifier)
1787 *p++ = 'H';
1788 *p++ = '-';
1789 c -= hyper_modifier;
1791 if (c & meta_modifier)
1793 *p++ = 'M';
1794 *p++ = '-';
1795 c -= meta_modifier;
1797 if (c & shift_modifier)
1799 *p++ = 'S';
1800 *p++ = '-';
1801 c -= shift_modifier;
1803 if (c & super_modifier)
1805 *p++ = 's';
1806 *p++ = '-';
1807 c -= super_modifier;
1809 if (c < 040)
1811 if (c == 033)
1813 *p++ = 'E';
1814 *p++ = 'S';
1815 *p++ = 'C';
1817 else if (c == '\t')
1819 *p++ = 'T';
1820 *p++ = 'A';
1821 *p++ = 'B';
1823 else if (c == Ctl ('M'))
1825 *p++ = 'R';
1826 *p++ = 'E';
1827 *p++ = 'T';
1829 else
1831 /* `C-' already added above. */
1832 if (c > 0 && c <= Ctl ('Z'))
1833 *p++ = c + 0140;
1834 else
1835 *p++ = c + 0100;
1838 else if (c == 0177)
1840 *p++ = 'D';
1841 *p++ = 'E';
1842 *p++ = 'L';
1844 else if (c == ' ')
1846 *p++ = 'S';
1847 *p++ = 'P';
1848 *p++ = 'C';
1850 else if (c < 128
1851 || (NILP (current_buffer->enable_multibyte_characters)
1852 && SINGLE_BYTE_CHAR_P (c)))
1853 *p++ = c;
1854 else
1856 if (! NILP (current_buffer->enable_multibyte_characters))
1857 c = unibyte_char_to_multibyte (c);
1859 if (NILP (current_buffer->enable_multibyte_characters)
1860 || SINGLE_BYTE_CHAR_P (c)
1861 || ! char_valid_p (c, 0))
1863 int bit_offset;
1864 *p++ = '\\';
1865 /* The biggest character code uses 19 bits. */
1866 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
1868 if (c >= (1 << bit_offset))
1869 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
1872 else
1874 p += CHAR_STRING (c, p);
1878 return p;
1881 /* This function cannot GC. */
1883 DEFUN ("single-key-description", Fsingle_key_description,
1884 Ssingle_key_description, 1, 2, 0,
1885 "Return a pretty description of command character KEY.\n\
1886 Control characters turn into C-whatever, etc.\n\
1887 Optional argument NO-ANGLES non-nil means don't put angle brackets\n\
1888 around function keys and event symbols.")
1889 (key, no_angles)
1890 Lisp_Object key, no_angles;
1892 if (CONSP (key) && lucid_event_type_list_p (key))
1893 key = Fevent_convert_list (key);
1895 key = EVENT_HEAD (key);
1897 if (INTEGERP (key)) /* Normal character */
1899 unsigned int charset, c1, c2;
1900 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
1902 if (SINGLE_BYTE_CHAR_P (without_bits))
1903 charset = 0;
1904 else
1905 SPLIT_CHAR (without_bits, charset, c1, c2);
1907 if (charset
1908 && CHARSET_DEFINED_P (charset)
1909 && ((c1 >= 0 && c1 < 32)
1910 || (c2 >= 0 && c2 < 32)))
1912 /* Handle a generic character. */
1913 Lisp_Object name;
1914 name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
1915 CHECK_STRING (name, 0);
1916 return concat2 (build_string ("Character set "), name);
1918 else
1920 char tem[KEY_DESCRIPTION_SIZE];
1922 *push_key_description (XUINT (key), tem) = 0;
1923 return build_string (tem);
1926 else if (SYMBOLP (key)) /* Function key or event-symbol */
1928 if (NILP (no_angles))
1930 char *buffer
1931 = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
1932 sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
1933 return build_string (buffer);
1935 else
1936 return Fsymbol_name (key);
1938 else if (STRINGP (key)) /* Buffer names in the menubar. */
1939 return Fcopy_sequence (key);
1940 else
1941 error ("KEY must be an integer, cons, symbol, or string");
1942 return Qnil;
1945 char *
1946 push_text_char_description (c, p)
1947 register unsigned int c;
1948 register char *p;
1950 if (c >= 0200)
1952 *p++ = 'M';
1953 *p++ = '-';
1954 c -= 0200;
1956 if (c < 040)
1958 *p++ = '^';
1959 *p++ = c + 64; /* 'A' - 1 */
1961 else if (c == 0177)
1963 *p++ = '^';
1964 *p++ = '?';
1966 else
1967 *p++ = c;
1968 return p;
1971 /* This function cannot GC. */
1973 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1974 "Return a pretty description of file-character CHARACTER.\n\
1975 Control characters turn into \"^char\", etc.")
1976 (character)
1977 Lisp_Object character;
1979 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
1980 unsigned char str[6];
1981 int c;
1983 CHECK_NUMBER (character, 0);
1985 c = XINT (character);
1986 if (!SINGLE_BYTE_CHAR_P (c))
1988 int len = CHAR_STRING (c, str);
1990 return make_multibyte_string (str, 1, len);
1993 *push_text_char_description (c & 0377, str) = 0;
1995 return build_string (str);
1998 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
1999 a meta bit. */
2000 static int
2001 ascii_sequence_p (seq)
2002 Lisp_Object seq;
2004 int i;
2005 int len = XINT (Flength (seq));
2007 for (i = 0; i < len; i++)
2009 Lisp_Object ii, elt;
2011 XSETFASTINT (ii, i);
2012 elt = Faref (seq, ii);
2014 if (!INTEGERP (elt)
2015 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2016 return 0;
2019 return 1;
2023 /* where-is - finding a command in a set of keymaps. */
2025 static Lisp_Object where_is_internal_1 ();
2026 static void where_is_internal_2 ();
2028 /* This function can GC if Flookup_key autoloads any keymaps. */
2030 static INLINE int
2031 menu_item_p (item)
2032 Lisp_Object item;
2034 return (CONSP (item)
2035 && (EQ (XCAR (item),Qmenu_item)
2036 || STRINGP (XCAR (item))));
2039 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
2040 "Return list of keys that invoke DEFINITION.\n\
2041 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
2042 If KEYMAP is nil, search all the currently active keymaps.\n\
2044 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
2045 rather than a list of all possible key sequences.\n\
2046 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
2047 no matter what it is.\n\
2048 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
2049 and entirely reject menu bindings.\n\
2051 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
2052 to other keymaps or slots. This makes it possible to search for an\n\
2053 indirect definition itself.")
2054 (definition, xkeymap, firstonly, noindirect)
2055 Lisp_Object definition, xkeymap;
2056 Lisp_Object firstonly, noindirect;
2058 Lisp_Object maps;
2059 Lisp_Object found, sequences;
2060 Lisp_Object keymap1;
2061 int keymap_specified = !NILP (xkeymap);
2062 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2063 /* 1 means ignore all menu bindings entirely. */
2064 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2066 /* Find keymaps accessible from `keymap' or the current
2067 context. But don't muck with the value of `keymap',
2068 because `where_is_internal_1' uses it to check for
2069 shadowed bindings. */
2070 keymap1 = xkeymap;
2071 if (! keymap_specified)
2072 keymap1 = get_local_map (PT, current_buffer, keymap);
2074 if (!NILP (keymap1))
2075 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
2076 Faccessible_keymaps (get_keymap (current_global_map),
2077 Qnil));
2078 else
2080 keymap1 = xkeymap;
2081 if (! keymap_specified)
2082 keymap1 = get_local_map (PT, current_buffer, local_map);
2084 if (!NILP (keymap1))
2085 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
2086 Faccessible_keymaps (get_keymap (current_global_map),
2087 Qnil));
2088 else
2089 maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
2092 /* Put the minor mode keymaps on the front. */
2093 if (! keymap_specified)
2095 Lisp_Object minors;
2096 minors = Fnreverse (Fcurrent_minor_mode_maps ());
2097 while (!NILP (minors))
2099 maps = nconc2 (Faccessible_keymaps (get_keymap (XCAR (minors)),
2100 Qnil),
2101 maps);
2102 minors = XCDR (minors);
2106 GCPRO5 (definition, xkeymap, maps, found, sequences);
2107 found = Qnil;
2108 sequences = Qnil;
2110 for (; !NILP (maps); maps = Fcdr (maps))
2112 /* Key sequence to reach map, and the map that it reaches */
2113 register Lisp_Object this, map;
2115 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2116 [M-CHAR] sequences, check if last character of the sequence
2117 is the meta-prefix char. */
2118 Lisp_Object last;
2119 int last_is_meta;
2121 this = Fcar (Fcar (maps));
2122 map = Fcdr (Fcar (maps));
2123 last = make_number (XINT (Flength (this)) - 1);
2124 last_is_meta = (XINT (last) >= 0
2125 && EQ (Faref (this, last), meta_prefix_char));
2127 if (nomenus && XINT (last) >= 0)
2128 { /* If no menu entries should be returned, skip over the
2129 keymaps bound to `menu-bar' and `tool-bar'. */
2130 Lisp_Object tem = Faref (this, 0);
2131 if (EQ (tem, Qmenu_bar) || EQ (tem, Qtool_bar))
2132 continue;
2135 QUIT;
2137 while (CONSP (map))
2139 /* Because the code we want to run on each binding is rather
2140 large, we don't want to have two separate loop bodies for
2141 sparse keymap bindings and tables; we want to iterate one
2142 loop body over both keymap and vector bindings.
2144 For this reason, if Fcar (map) is a vector, we don't
2145 advance map to the next element until i indicates that we
2146 have finished off the vector. */
2147 Lisp_Object elt, key, binding;
2148 elt = XCAR (map);
2149 map = XCDR (map);
2151 sequences = Qnil;
2153 QUIT;
2155 /* Set key and binding to the current key and binding, and
2156 advance map and i to the next binding. */
2157 if (VECTORP (elt))
2159 Lisp_Object sequence;
2160 int i;
2161 /* In a vector, look at each element. */
2162 for (i = 0; i < XVECTOR (elt)->size; i++)
2164 binding = XVECTOR (elt)->contents[i];
2165 XSETFASTINT (key, i);
2166 sequence = where_is_internal_1 (binding, key, definition,
2167 noindirect, xkeymap, this,
2168 last, nomenus, last_is_meta);
2169 if (!NILP (sequence))
2170 sequences = Fcons (sequence, sequences);
2173 else if (CHAR_TABLE_P (elt))
2175 Lisp_Object indices[3];
2176 Lisp_Object args;
2178 args = Fcons (Fcons (Fcons (definition, noindirect),
2179 Fcons (xkeymap, Qnil)),
2180 Fcons (Fcons (this, last),
2181 Fcons (make_number (nomenus),
2182 make_number (last_is_meta))));
2183 map_char_table (where_is_internal_2, Qnil, elt, args,
2184 0, indices);
2185 sequences = XCDR (XCDR (XCAR (args)));
2187 else if (CONSP (elt))
2189 Lisp_Object sequence;
2191 key = XCAR (elt);
2192 binding = XCDR (elt);
2194 sequence = where_is_internal_1 (binding, key, definition,
2195 noindirect, xkeymap, this,
2196 last, nomenus, last_is_meta);
2197 if (!NILP (sequence))
2198 sequences = Fcons (sequence, sequences);
2202 for (; ! NILP (sequences); sequences = XCDR (sequences))
2204 Lisp_Object sequence;
2206 sequence = XCAR (sequences);
2208 /* It is a true unshadowed match. Record it, unless it's already
2209 been seen (as could happen when inheriting keymaps). */
2210 if (NILP (Fmember (sequence, found)))
2211 found = Fcons (sequence, found);
2213 /* If firstonly is Qnon_ascii, then we can return the first
2214 binding we find. If firstonly is not Qnon_ascii but not
2215 nil, then we should return the first ascii-only binding
2216 we find. */
2217 if (EQ (firstonly, Qnon_ascii))
2218 RETURN_UNGCPRO (sequence);
2219 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
2220 RETURN_UNGCPRO (sequence);
2225 UNGCPRO;
2227 found = Fnreverse (found);
2229 /* firstonly may have been t, but we may have gone all the way through
2230 the keymaps without finding an all-ASCII key sequence. So just
2231 return the best we could find. */
2232 if (! NILP (firstonly))
2233 return Fcar (found);
2235 return found;
2238 /* This is the function that Fwhere_is_internal calls using map_char_table.
2239 ARGS has the form
2240 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2242 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2243 Since map_char_table doesn't really use the return value from this function,
2244 we the result append to RESULT, the slot in ARGS.
2246 This function can GC because it calls where_is_internal_1 which can
2247 GC. */
2249 static void
2250 where_is_internal_2 (args, key, binding)
2251 Lisp_Object args, key, binding;
2253 Lisp_Object definition, noindirect, keymap, this, last;
2254 Lisp_Object result, sequence;
2255 int nomenus, last_is_meta;
2256 struct gcpro gcpro1, gcpro2, gcpro3;
2258 GCPRO3 (args, key, binding);
2259 result = XCDR (XCDR (XCAR (args)));
2260 definition = XCAR (XCAR (XCAR (args)));
2261 noindirect = XCDR (XCAR (XCAR (args)));
2262 keymap = XCAR (XCDR (XCAR (args)));
2263 this = XCAR (XCAR (XCDR (args)));
2264 last = XCDR (XCAR (XCDR (args)));
2265 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2266 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2268 sequence = where_is_internal_1 (binding, key, definition, noindirect, keymap,
2269 this, last, nomenus, last_is_meta);
2271 if (!NILP (sequence))
2272 XCDR (XCDR (XCAR (args))) = Fcons (sequence, result);
2274 UNGCPRO;
2278 /* This function can GC.because Flookup_key calls get_keymap_1 with
2279 non-zero argument AUTOLOAD. */
2281 static Lisp_Object
2282 where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
2283 nomenus, last_is_meta)
2284 Lisp_Object binding, key, definition, noindirect, keymap, this, last;
2285 int nomenus, last_is_meta;
2287 Lisp_Object sequence;
2288 int keymap_specified = !NILP (keymap);
2289 struct gcpro gcpro1, gcpro2;
2291 /* Skip left-over menu-items.
2292 These can appear in a keymap bound to a mouse click, for example. */
2293 if (nomenus && menu_item_p (binding))
2294 return Qnil;
2295 /* Search through indirections unless that's not wanted. */
2296 if (NILP (noindirect))
2297 binding = get_keyelt (binding, 0);
2299 /* End this iteration if this element does not match
2300 the target. */
2302 if (CONSP (definition))
2304 Lisp_Object tem;
2305 tem = Fequal (binding, definition);
2306 if (NILP (tem))
2307 return Qnil;
2309 else
2310 if (!EQ (binding, definition))
2311 return Qnil;
2313 /* We have found a match.
2314 Construct the key sequence where we found it. */
2315 if (INTEGERP (key) && last_is_meta)
2317 sequence = Fcopy_sequence (this);
2318 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2320 else
2321 sequence = append_key (this, key);
2323 /* Verify that this key binding is not shadowed by another
2324 binding for the same key, before we say it exists.
2326 Mechanism: look for local definition of this key and if
2327 it is defined and does not match what we found then
2328 ignore this key.
2330 Either nil or number as value from Flookup_key
2331 means undefined. */
2332 GCPRO2 (sequence, binding);
2333 if (keymap_specified)
2335 binding = Flookup_key (keymap, sequence, Qnil);
2336 if (!NILP (binding) && !INTEGERP (binding))
2338 if (CONSP (definition))
2340 Lisp_Object tem;
2341 tem = Fequal (binding, definition);
2342 if (NILP (tem))
2343 RETURN_UNGCPRO (Qnil);
2345 else
2346 if (!EQ (binding, definition))
2347 RETURN_UNGCPRO (Qnil);
2350 else
2352 binding = Fkey_binding (sequence, Qnil);
2353 if (!EQ (binding, definition))
2354 RETURN_UNGCPRO (Qnil);
2357 RETURN_UNGCPRO (sequence);
2360 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2362 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
2363 "Show a list of all defined keys, and their definitions.\n\
2364 We put that list in a buffer, and display the buffer.\n\
2366 The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
2367 \(Ordinarily these are omitted from the output.)\n\
2368 The optional argument PREFIX, if non-nil, should be a key sequence;\n\
2369 then we display only bindings that start with that prefix.")
2370 (menus, prefix)
2371 Lisp_Object menus, prefix;
2373 register Lisp_Object thisbuf;
2374 XSETBUFFER (thisbuf, current_buffer);
2375 internal_with_output_to_temp_buffer ("*Help*",
2376 describe_buffer_bindings,
2377 list3 (thisbuf, prefix, menus));
2378 return Qnil;
2381 /* ARG is (BUFFER PREFIX MENU-FLAG). */
2383 static Lisp_Object
2384 describe_buffer_bindings (arg)
2385 Lisp_Object arg;
2387 Lisp_Object descbuf, prefix, shadow;
2388 int nomenu;
2389 register Lisp_Object start1;
2390 struct gcpro gcpro1;
2392 char *alternate_heading
2393 = "\
2394 Keyboard translations:\n\n\
2395 You type Translation\n\
2396 -------- -----------\n";
2398 descbuf = XCAR (arg);
2399 arg = XCDR (arg);
2400 prefix = XCAR (arg);
2401 arg = XCDR (arg);
2402 nomenu = NILP (XCAR (arg));
2404 shadow = Qnil;
2405 GCPRO1 (shadow);
2407 Fset_buffer (Vstandard_output);
2409 /* Report on alternates for keys. */
2410 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
2412 int c;
2413 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
2414 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
2416 for (c = 0; c < translate_len; c++)
2417 if (translate[c] != c)
2419 char buf[KEY_DESCRIPTION_SIZE];
2420 char *bufend;
2422 if (alternate_heading)
2424 insert_string (alternate_heading);
2425 alternate_heading = 0;
2428 bufend = push_key_description (translate[c], buf);
2429 insert (buf, bufend - buf);
2430 Findent_to (make_number (16), make_number (1));
2431 bufend = push_key_description (c, buf);
2432 insert (buf, bufend - buf);
2434 insert ("\n", 1);
2437 insert ("\n", 1);
2440 if (!NILP (Vkey_translation_map))
2441 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2442 "Key translations", nomenu, 1, 0);
2445 int i, nmaps;
2446 Lisp_Object *modes, *maps;
2448 /* Temporarily switch to descbuf, so that we can get that buffer's
2449 minor modes correctly. */
2450 Fset_buffer (descbuf);
2452 if (!NILP (current_kboard->Voverriding_terminal_local_map)
2453 || !NILP (Voverriding_local_map))
2454 nmaps = 0;
2455 else
2456 nmaps = current_minor_maps (&modes, &maps);
2457 Fset_buffer (Vstandard_output);
2459 /* Print the minor mode maps. */
2460 for (i = 0; i < nmaps; i++)
2462 /* The title for a minor mode keymap
2463 is constructed at run time.
2464 We let describe_map_tree do the actual insertion
2465 because it takes care of other features when doing so. */
2466 char *title, *p;
2468 if (!SYMBOLP (modes[i]))
2469 abort();
2471 p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size);
2472 *p++ = '\f';
2473 *p++ = '\n';
2474 *p++ = '`';
2475 bcopy (XSYMBOL (modes[i])->name->data, p,
2476 XSYMBOL (modes[i])->name->size);
2477 p += XSYMBOL (modes[i])->name->size;
2478 *p++ = '\'';
2479 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
2480 p += sizeof (" Minor Mode Bindings") - 1;
2481 *p = 0;
2483 describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
2484 shadow = Fcons (maps[i], shadow);
2488 /* Print the (major mode) local map. */
2489 if (!NILP (current_kboard->Voverriding_terminal_local_map))
2490 start1 = current_kboard->Voverriding_terminal_local_map;
2491 else if (!NILP (Voverriding_local_map))
2492 start1 = Voverriding_local_map;
2493 else
2494 start1 = XBUFFER (descbuf)->keymap;
2496 if (!NILP (start1))
2498 describe_map_tree (start1, 1, shadow, prefix,
2499 "\f\nMajor Mode Bindings", nomenu, 0, 0);
2500 shadow = Fcons (start1, shadow);
2503 describe_map_tree (current_global_map, 1, shadow, prefix,
2504 "\f\nGlobal Bindings", nomenu, 0, 1);
2506 /* Print the function-key-map translations under this prefix. */
2507 if (!NILP (Vfunction_key_map))
2508 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
2509 "\f\nFunction key map translations", nomenu, 1, 0);
2511 call0 (intern ("help-mode"));
2512 Fset_buffer (descbuf);
2513 UNGCPRO;
2514 return Qnil;
2517 /* Insert a description of the key bindings in STARTMAP,
2518 followed by those of all maps reachable through STARTMAP.
2519 If PARTIAL is nonzero, omit certain "uninteresting" commands
2520 (such as `undefined').
2521 If SHADOW is non-nil, it is a list of maps;
2522 don't mention keys which would be shadowed by any of them.
2523 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2524 TITLE, if not 0, is a string to insert at the beginning.
2525 TITLE should not end with a colon or a newline; we supply that.
2526 If NOMENU is not 0, then omit menu-bar commands.
2528 If TRANSL is nonzero, the definitions are actually key translations
2529 so print strings and vectors differently.
2531 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2532 to look through. */
2534 void
2535 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
2536 always_title)
2537 Lisp_Object startmap, shadow, prefix;
2538 int partial;
2539 char *title;
2540 int nomenu;
2541 int transl;
2542 int always_title;
2544 Lisp_Object maps, orig_maps, seen, sub_shadows;
2545 struct gcpro gcpro1, gcpro2, gcpro3;
2546 int something = 0;
2547 char *key_heading
2548 = "\
2549 key binding\n\
2550 --- -------\n";
2552 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
2553 seen = Qnil;
2554 sub_shadows = Qnil;
2555 GCPRO3 (maps, seen, sub_shadows);
2557 if (nomenu)
2559 Lisp_Object list;
2561 /* Delete from MAPS each element that is for the menu bar. */
2562 for (list = maps; !NILP (list); list = XCDR (list))
2564 Lisp_Object elt, prefix, tem;
2566 elt = Fcar (list);
2567 prefix = Fcar (elt);
2568 if (XVECTOR (prefix)->size >= 1)
2570 tem = Faref (prefix, make_number (0));
2571 if (EQ (tem, Qmenu_bar))
2572 maps = Fdelq (elt, maps);
2577 if (!NILP (maps) || always_title)
2579 if (title)
2581 insert_string (title);
2582 if (!NILP (prefix))
2584 insert_string (" Starting With ");
2585 insert1 (Fkey_description (prefix));
2587 insert_string (":\n");
2589 insert_string (key_heading);
2590 something = 1;
2593 for (; !NILP (maps); maps = Fcdr (maps))
2595 register Lisp_Object elt, prefix, tail;
2597 elt = Fcar (maps);
2598 prefix = Fcar (elt);
2600 sub_shadows = Qnil;
2602 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2604 Lisp_Object shmap;
2606 shmap = XCAR (tail);
2608 /* If the sequence by which we reach this keymap is zero-length,
2609 then the shadow map for this keymap is just SHADOW. */
2610 if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
2611 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
2613 /* If the sequence by which we reach this keymap actually has
2614 some elements, then the sequence's definition in SHADOW is
2615 what we should use. */
2616 else
2618 shmap = Flookup_key (shmap, Fcar (elt), Qt);
2619 if (INTEGERP (shmap))
2620 shmap = Qnil;
2623 /* If shmap is not nil and not a keymap,
2624 it completely shadows this map, so don't
2625 describe this map at all. */
2626 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
2627 goto skip;
2629 if (!NILP (shmap))
2630 sub_shadows = Fcons (shmap, sub_shadows);
2633 /* Maps we have already listed in this loop shadow this map. */
2634 for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
2636 Lisp_Object tem;
2637 tem = Fequal (Fcar (XCAR (tail)), prefix);
2638 if (! NILP (tem))
2639 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
2642 describe_map (Fcdr (elt), prefix,
2643 transl ? describe_translation : describe_command,
2644 partial, sub_shadows, &seen, nomenu);
2646 skip: ;
2649 if (something)
2650 insert_string ("\n");
2652 UNGCPRO;
2655 static int previous_description_column;
2657 static void
2658 describe_command (definition)
2659 Lisp_Object definition;
2661 register Lisp_Object tem1;
2662 int column = current_column ();
2663 int description_column;
2665 /* If column 16 is no good, go to col 32;
2666 but don't push beyond that--go to next line instead. */
2667 if (column > 30)
2669 insert_char ('\n');
2670 description_column = 32;
2672 else if (column > 14 || (column > 10 && previous_description_column == 32))
2673 description_column = 32;
2674 else
2675 description_column = 16;
2677 Findent_to (make_number (description_column), make_number (1));
2678 previous_description_column = description_column;
2680 if (SYMBOLP (definition))
2682 XSETSTRING (tem1, XSYMBOL (definition)->name);
2683 insert1 (tem1);
2684 insert_string ("\n");
2686 else if (STRINGP (definition) || VECTORP (definition))
2687 insert_string ("Keyboard Macro\n");
2688 else
2690 tem1 = Fkeymapp (definition);
2691 if (!NILP (tem1))
2692 insert_string ("Prefix Command\n");
2693 else
2694 insert_string ("??\n");
2698 static void
2699 describe_translation (definition)
2700 Lisp_Object definition;
2702 register Lisp_Object tem1;
2704 Findent_to (make_number (16), make_number (1));
2706 if (SYMBOLP (definition))
2708 XSETSTRING (tem1, XSYMBOL (definition)->name);
2709 insert1 (tem1);
2710 insert_string ("\n");
2712 else if (STRINGP (definition) || VECTORP (definition))
2714 insert1 (Fkey_description (definition));
2715 insert_string ("\n");
2717 else
2719 tem1 = Fkeymapp (definition);
2720 if (!NILP (tem1))
2721 insert_string ("Prefix Command\n");
2722 else
2723 insert_string ("??\n");
2727 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2728 Returns the first non-nil binding found in any of those maps. */
2730 static Lisp_Object
2731 shadow_lookup (shadow, key, flag)
2732 Lisp_Object shadow, key, flag;
2734 Lisp_Object tail, value;
2736 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2738 value = Flookup_key (XCAR (tail), key, flag);
2739 if (!NILP (value))
2740 return value;
2742 return Qnil;
2745 /* Describe the contents of map MAP, assuming that this map itself is
2746 reached by the sequence of prefix keys KEYS (a string or vector).
2747 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2749 static void
2750 describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
2751 register Lisp_Object map;
2752 Lisp_Object keys;
2753 void (*elt_describer) P_ ((Lisp_Object));
2754 int partial;
2755 Lisp_Object shadow;
2756 Lisp_Object *seen;
2757 int nomenu;
2759 Lisp_Object elt_prefix;
2760 Lisp_Object tail, definition, event;
2761 Lisp_Object tem;
2762 Lisp_Object suppress;
2763 Lisp_Object kludge;
2764 int first = 1;
2765 struct gcpro gcpro1, gcpro2, gcpro3;
2767 suppress = Qnil;
2769 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2771 /* Call Fkey_description first, to avoid GC bug for the other string. */
2772 tem = Fkey_description (keys);
2773 elt_prefix = concat2 (tem, build_string (" "));
2775 else
2776 elt_prefix = Qnil;
2778 if (partial)
2779 suppress = intern ("suppress-keymap");
2781 /* This vector gets used to present single keys to Flookup_key. Since
2782 that is done once per keymap element, we don't want to cons up a
2783 fresh vector every time. */
2784 kludge = Fmake_vector (make_number (1), Qnil);
2785 definition = Qnil;
2787 GCPRO3 (elt_prefix, definition, kludge);
2789 for (tail = map; CONSP (tail); tail = XCDR (tail))
2791 QUIT;
2793 if (VECTORP (XCAR (tail))
2794 || CHAR_TABLE_P (XCAR (tail)))
2795 describe_vector (XCAR (tail),
2796 elt_prefix, elt_describer, partial, shadow, map,
2797 (int *)0, 0);
2798 else if (CONSP (XCAR (tail)))
2800 event = XCAR (XCAR (tail));
2802 /* Ignore bindings whose "keys" are not really valid events.
2803 (We get these in the frames and buffers menu.) */
2804 if (! (SYMBOLP (event) || INTEGERP (event)))
2805 continue;
2807 if (nomenu && EQ (event, Qmenu_bar))
2808 continue;
2810 definition = get_keyelt (XCDR (XCAR (tail)), 0);
2812 /* Don't show undefined commands or suppressed commands. */
2813 if (NILP (definition)) continue;
2814 if (SYMBOLP (definition) && partial)
2816 tem = Fget (definition, suppress);
2817 if (!NILP (tem))
2818 continue;
2821 /* Don't show a command that isn't really visible
2822 because a local definition of the same key shadows it. */
2824 XVECTOR (kludge)->contents[0] = event;
2825 if (!NILP (shadow))
2827 tem = shadow_lookup (shadow, kludge, Qt);
2828 if (!NILP (tem)) continue;
2831 tem = Flookup_key (map, kludge, Qt);
2832 if (! EQ (tem, definition)) continue;
2834 if (first)
2836 previous_description_column = 0;
2837 insert ("\n", 1);
2838 first = 0;
2841 if (!NILP (elt_prefix))
2842 insert1 (elt_prefix);
2844 /* THIS gets the string to describe the character EVENT. */
2845 insert1 (Fsingle_key_description (event, Qnil));
2847 /* Print a description of the definition of this character.
2848 elt_describer will take care of spacing out far enough
2849 for alignment purposes. */
2850 (*elt_describer) (definition);
2852 else if (EQ (XCAR (tail), Qkeymap))
2854 /* The same keymap might be in the structure twice, if we're
2855 using an inherited keymap. So skip anything we've already
2856 encountered. */
2857 tem = Fassq (tail, *seen);
2858 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
2859 break;
2860 *seen = Fcons (Fcons (tail, keys), *seen);
2864 UNGCPRO;
2867 static void
2868 describe_vector_princ (elt)
2869 Lisp_Object elt;
2871 Findent_to (make_number (16), make_number (1));
2872 Fprinc (elt, Qnil);
2873 Fterpri (Qnil);
2876 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2877 "Insert a description of contents of VECTOR.\n\
2878 This is text showing the elements of vector matched against indices.")
2879 (vector)
2880 Lisp_Object vector;
2882 int count = specpdl_ptr - specpdl;
2884 specbind (Qstandard_output, Fcurrent_buffer ());
2885 CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
2886 describe_vector (vector, Qnil, describe_vector_princ, 0,
2887 Qnil, Qnil, (int *)0, 0);
2889 return unbind_to (count, Qnil);
2892 /* Insert in the current buffer a description of the contents of VECTOR.
2893 We call ELT_DESCRIBER to insert the description of one value found
2894 in VECTOR.
2896 ELT_PREFIX describes what "comes before" the keys or indices defined
2897 by this vector. This is a human-readable string whose size
2898 is not necessarily related to the situation.
2900 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2901 leads to this keymap.
2903 If the vector is a chartable, ELT_PREFIX is the vector
2904 of bytes that lead to the character set or portion of a character
2905 set described by this chartable.
2907 If PARTIAL is nonzero, it means do not mention suppressed commands
2908 (that assumes the vector is in a keymap).
2910 SHADOW is a list of keymaps that shadow this map.
2911 If it is non-nil, then we look up the key in those maps
2912 and we don't mention it now if it is defined by any of them.
2914 ENTIRE_MAP is the keymap in which this vector appears.
2915 If the definition in effect in the whole map does not match
2916 the one in this vector, we ignore this one.
2918 When describing a sub-char-table, INDICES is a list of
2919 indices at higher levels in this char-table,
2920 and CHAR_TABLE_DEPTH says how many levels down we have gone. */
2922 void
2923 describe_vector (vector, elt_prefix, elt_describer,
2924 partial, shadow, entire_map,
2925 indices, char_table_depth)
2926 register Lisp_Object vector;
2927 Lisp_Object elt_prefix;
2928 void (*elt_describer) P_ ((Lisp_Object));
2929 int partial;
2930 Lisp_Object shadow;
2931 Lisp_Object entire_map;
2932 int *indices;
2933 int char_table_depth;
2935 Lisp_Object definition;
2936 Lisp_Object tem2;
2937 register int i;
2938 Lisp_Object suppress;
2939 Lisp_Object kludge;
2940 int first = 1;
2941 struct gcpro gcpro1, gcpro2, gcpro3;
2942 /* Range of elements to be handled. */
2943 int from, to;
2944 /* A flag to tell if a leaf in this level of char-table is not a
2945 generic character (i.e. a complete multibyte character). */
2946 int complete_char;
2947 int character;
2948 int starting_i;
2950 suppress = Qnil;
2952 if (indices == 0)
2953 indices = (int *) alloca (3 * sizeof (int));
2955 definition = Qnil;
2957 /* This vector gets used to present single keys to Flookup_key. Since
2958 that is done once per vector element, we don't want to cons up a
2959 fresh vector every time. */
2960 kludge = Fmake_vector (make_number (1), Qnil);
2961 GCPRO3 (elt_prefix, definition, kludge);
2963 if (partial)
2964 suppress = intern ("suppress-keymap");
2966 if (CHAR_TABLE_P (vector))
2968 if (char_table_depth == 0)
2970 /* VECTOR is a top level char-table. */
2971 complete_char = 1;
2972 from = 0;
2973 to = CHAR_TABLE_ORDINARY_SLOTS;
2975 else
2977 /* VECTOR is a sub char-table. */
2978 if (char_table_depth >= 3)
2979 /* A char-table is never that deep. */
2980 error ("Too deep char table");
2982 complete_char
2983 = (CHARSET_VALID_P (indices[0])
2984 && ((CHARSET_DIMENSION (indices[0]) == 1
2985 && char_table_depth == 1)
2986 || char_table_depth == 2));
2988 /* Meaningful elements are from 32th to 127th. */
2989 from = 32;
2990 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
2993 else
2995 /* This does the right thing for ordinary vectors. */
2997 complete_char = 1;
2998 from = 0;
2999 to = XVECTOR (vector)->size;
3002 for (i = from; i < to; i++)
3004 QUIT;
3006 if (CHAR_TABLE_P (vector))
3008 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3009 complete_char = 0;
3011 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3012 && !CHARSET_DEFINED_P (i - 128))
3013 continue;
3015 definition
3016 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3018 else
3019 definition = get_keyelt (XVECTOR (vector)->contents[i], 0);
3021 if (NILP (definition)) continue;
3023 /* Don't mention suppressed commands. */
3024 if (SYMBOLP (definition) && partial)
3026 Lisp_Object tem;
3028 tem = Fget (definition, suppress);
3030 if (!NILP (tem)) continue;
3033 /* Set CHARACTER to the character this entry describes, if any.
3034 Also update *INDICES. */
3035 if (CHAR_TABLE_P (vector))
3037 indices[char_table_depth] = i;
3039 if (char_table_depth == 0)
3041 character = i;
3042 indices[0] = i - 128;
3044 else if (complete_char)
3046 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3048 else
3049 character = 0;
3051 else
3052 character = i;
3054 /* If this binding is shadowed by some other map, ignore it. */
3055 if (!NILP (shadow) && complete_char)
3057 Lisp_Object tem;
3059 XVECTOR (kludge)->contents[0] = make_number (character);
3060 tem = shadow_lookup (shadow, kludge, Qt);
3062 if (!NILP (tem)) continue;
3065 /* Ignore this definition if it is shadowed by an earlier
3066 one in the same keymap. */
3067 if (!NILP (entire_map) && complete_char)
3069 Lisp_Object tem;
3071 XVECTOR (kludge)->contents[0] = make_number (character);
3072 tem = Flookup_key (entire_map, kludge, Qt);
3074 if (! EQ (tem, definition))
3075 continue;
3078 if (first)
3080 if (char_table_depth == 0)
3081 insert ("\n", 1);
3082 first = 0;
3085 /* For a sub char-table, show the depth by indentation.
3086 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3087 if (char_table_depth > 0)
3088 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3090 /* Output the prefix that applies to every entry in this map. */
3091 if (!NILP (elt_prefix))
3092 insert1 (elt_prefix);
3094 /* Insert or describe the character this slot is for,
3095 or a description of what it is for. */
3096 if (SUB_CHAR_TABLE_P (vector))
3098 if (complete_char)
3099 insert_char (character);
3100 else
3102 /* We need an octal representation for this block of
3103 characters. */
3104 char work[16];
3105 sprintf (work, "(row %d)", i);
3106 insert (work, strlen (work));
3109 else if (CHAR_TABLE_P (vector))
3111 if (complete_char)
3112 insert1 (Fsingle_key_description (make_number (character), Qnil));
3113 else
3115 /* Print the information for this character set. */
3116 insert_string ("<");
3117 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3118 if (STRINGP (tem2))
3119 insert_from_string (tem2, 0, 0, XSTRING (tem2)->size,
3120 STRING_BYTES (XSTRING (tem2)), 0);
3121 else
3122 insert ("?", 1);
3123 insert (">", 1);
3126 else
3128 insert1 (Fsingle_key_description (make_number (character), Qnil));
3131 /* If we find a sub char-table within a char-table,
3132 scan it recursively; it defines the details for
3133 a character set or a portion of a character set. */
3134 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3136 insert ("\n", 1);
3137 describe_vector (definition, elt_prefix, elt_describer,
3138 partial, shadow, entire_map,
3139 indices, char_table_depth + 1);
3140 continue;
3143 starting_i = i;
3145 /* Find all consecutive characters or rows that have the same
3146 definition. But, for elements of a top level char table, if
3147 they are for charsets, we had better describe one by one even
3148 if they have the same definition. */
3149 if (CHAR_TABLE_P (vector))
3151 int limit = to;
3153 if (char_table_depth == 0)
3154 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3156 while (i + 1 < limit
3157 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3158 !NILP (tem2))
3159 && !NILP (Fequal (tem2, definition)))
3160 i++;
3162 else
3163 while (i + 1 < to
3164 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i + 1], 0),
3165 !NILP (tem2))
3166 && !NILP (Fequal (tem2, definition)))
3167 i++;
3170 /* If we have a range of more than one character,
3171 print where the range reaches to. */
3173 if (i != starting_i)
3175 insert (" .. ", 4);
3177 if (!NILP (elt_prefix))
3178 insert1 (elt_prefix);
3180 if (CHAR_TABLE_P (vector))
3182 if (char_table_depth == 0)
3184 insert1 (Fsingle_key_description (make_number (i), Qnil));
3186 else if (complete_char)
3188 indices[char_table_depth] = i;
3189 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3190 insert_char (character);
3192 else
3194 /* We need an octal representation for this block of
3195 characters. */
3196 char work[16];
3197 sprintf (work, "(row %d)", i);
3198 insert (work, strlen (work));
3201 else
3203 insert1 (Fsingle_key_description (make_number (i), Qnil));
3207 /* Print a description of the definition of this character.
3208 elt_describer will take care of spacing out far enough
3209 for alignment purposes. */
3210 (*elt_describer) (definition);
3213 /* For (sub) char-table, print `defalt' slot at last. */
3214 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3216 insert (" ", char_table_depth * 2);
3217 insert_string ("<<default>>");
3218 (*elt_describer) (XCHAR_TABLE (vector)->defalt);
3221 UNGCPRO;
3224 /* Apropos - finding all symbols whose names match a regexp. */
3225 Lisp_Object apropos_predicate;
3226 Lisp_Object apropos_accumulate;
3228 static void
3229 apropos_accum (symbol, string)
3230 Lisp_Object symbol, string;
3232 register Lisp_Object tem;
3234 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3235 if (!NILP (tem) && !NILP (apropos_predicate))
3236 tem = call1 (apropos_predicate, symbol);
3237 if (!NILP (tem))
3238 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3241 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3242 "Show all symbols whose names contain match for REGEXP.\n\
3243 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
3244 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
3245 Return list of symbols found.")
3246 (regexp, predicate)
3247 Lisp_Object regexp, predicate;
3249 struct gcpro gcpro1, gcpro2;
3250 CHECK_STRING (regexp, 0);
3251 apropos_predicate = predicate;
3252 GCPRO2 (apropos_predicate, apropos_accumulate);
3253 apropos_accumulate = Qnil;
3254 map_obarray (Vobarray, apropos_accum, regexp);
3255 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
3256 UNGCPRO;
3257 return apropos_accumulate;
3260 void
3261 syms_of_keymap ()
3263 Qkeymap = intern ("keymap");
3264 staticpro (&Qkeymap);
3266 /* Now we are ready to set up this property, so we can
3267 create char tables. */
3268 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3270 /* Initialize the keymaps standardly used.
3271 Each one is the value of a Lisp variable, and is also
3272 pointed to by a C variable */
3274 global_map = Fmake_keymap (Qnil);
3275 Fset (intern ("global-map"), global_map);
3277 current_global_map = global_map;
3278 staticpro (&global_map);
3279 staticpro (&current_global_map);
3281 meta_map = Fmake_keymap (Qnil);
3282 Fset (intern ("esc-map"), meta_map);
3283 Ffset (intern ("ESC-prefix"), meta_map);
3285 control_x_map = Fmake_keymap (Qnil);
3286 Fset (intern ("ctl-x-map"), control_x_map);
3287 Ffset (intern ("Control-X-prefix"), control_x_map);
3289 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3290 "List of commands given new key bindings recently.\n\
3291 This is used for internal purposes during Emacs startup;\n\
3292 don't alter it yourself.");
3293 Vdefine_key_rebound_commands = Qt;
3295 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3296 "Default keymap to use when reading from the minibuffer.");
3297 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3299 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3300 "Local keymap for the minibuffer when spaces are not allowed.");
3301 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3303 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3304 "Local keymap for minibuffer input with completion.");
3305 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3307 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
3308 "Local keymap for minibuffer input with completion, for exact match.");
3309 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3311 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
3312 "Alist of keymaps to use for minor modes.\n\
3313 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
3314 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
3315 If two active keymaps bind the same key, the keymap appearing earlier\n\
3316 in the list takes precedence.");
3317 Vminor_mode_map_alist = Qnil;
3319 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
3320 "Alist of keymaps to use for minor modes, in current major mode.\n\
3321 This variable is a alist just like `minor-mode-map-alist', and it is\n\
3322 used the same way (and before `minor-mode-map-alist'); however,\n\
3323 it is provided for major modes to bind locally.");
3324 Vminor_mode_overriding_map_alist = Qnil;
3326 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
3327 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
3328 This allows Emacs to recognize function keys sent from ASCII\n\
3329 terminals at any point in a key sequence.\n\
3331 The `read-key-sequence' function replaces any subsequence bound by\n\
3332 `function-key-map' with its binding. More precisely, when the active\n\
3333 keymaps have no binding for the current key sequence but\n\
3334 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
3335 `read-key-sequence' replaces the matching suffix with its binding, and\n\
3336 continues with the new sequence.\n\
3338 The events that come from bindings in `function-key-map' are not\n\
3339 themselves looked up in `function-key-map'.\n\
3341 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
3342 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
3343 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
3344 key, typing `ESC O P x' would return [f1 x].");
3345 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
3347 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
3348 "Keymap of key translations that can override keymaps.\n\
3349 This keymap works like `function-key-map', but comes after that,\n\
3350 and applies even for keys that have ordinary bindings.");
3351 Vkey_translation_map = Qnil;
3353 Qsingle_key_description = intern ("single-key-description");
3354 staticpro (&Qsingle_key_description);
3356 Qkey_description = intern ("key-description");
3357 staticpro (&Qkey_description);
3359 Qkeymapp = intern ("keymapp");
3360 staticpro (&Qkeymapp);
3362 Qnon_ascii = intern ("non-ascii");
3363 staticpro (&Qnon_ascii);
3365 Qmenu_item = intern ("menu-item");
3366 staticpro (&Qmenu_item);
3368 defsubr (&Skeymapp);
3369 defsubr (&Skeymap_parent);
3370 defsubr (&Sset_keymap_parent);
3371 defsubr (&Smake_keymap);
3372 defsubr (&Smake_sparse_keymap);
3373 defsubr (&Scopy_keymap);
3374 defsubr (&Skey_binding);
3375 defsubr (&Slocal_key_binding);
3376 defsubr (&Sglobal_key_binding);
3377 defsubr (&Sminor_mode_key_binding);
3378 defsubr (&Sdefine_key);
3379 defsubr (&Slookup_key);
3380 defsubr (&Sdefine_prefix_command);
3381 defsubr (&Suse_global_map);
3382 defsubr (&Suse_local_map);
3383 defsubr (&Scurrent_local_map);
3384 defsubr (&Scurrent_global_map);
3385 defsubr (&Scurrent_minor_mode_maps);
3386 defsubr (&Saccessible_keymaps);
3387 defsubr (&Skey_description);
3388 defsubr (&Sdescribe_vector);
3389 defsubr (&Ssingle_key_description);
3390 defsubr (&Stext_char_description);
3391 defsubr (&Swhere_is_internal);
3392 defsubr (&Sdescribe_bindings_internal);
3393 defsubr (&Sapropos_internal);
3396 void
3397 keys_of_keymap ()
3399 initial_define_key (global_map, 033, "ESC-prefix");
3400 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");