(standard-latex-block-names): Add "math".
[emacs.git] / src / keymap.c
blobc24bb66b6251fa2fe524647b0843152c74f69449
1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 #include <config.h>
24 #include <stdio.h>
25 #include "lisp.h"
26 #include "commands.h"
27 #include "buffer.h"
28 #include "charset.h"
29 #include "keyboard.h"
30 #include "termhooks.h"
31 #include "blockinput.h"
32 #include "puresize.h"
33 #include "intervals.h"
35 #define min(a, b) ((a) < (b) ? (a) : (b))
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 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
103 static Lisp_Object where_is_cache;
104 /* Which keymaps are reverse-stored in the cache. */
105 static Lisp_Object where_is_cache_keymaps;
107 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
108 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
110 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
111 static Lisp_Object describe_buffer_bindings P_ ((Lisp_Object));
112 static void describe_command P_ ((Lisp_Object));
113 static void describe_translation P_ ((Lisp_Object));
114 static void describe_map P_ ((Lisp_Object, Lisp_Object,
115 void (*) P_ ((Lisp_Object)),
116 int, Lisp_Object, Lisp_Object*, int));
118 /* Keymap object support - constructors and predicates. */
120 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
121 "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
122 CHARTABLE is a char-table that holds the bindings for the ASCII\n\
123 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
124 mouse events, and any other things that appear in the input stream.\n\
125 All entries in it are initially nil, meaning \"command undefined\".\n\n\
126 The optional arg STRING supplies a menu name for the keymap\n\
127 in case you use it as a menu with `x-popup-menu'.")
128 (string)
129 Lisp_Object string;
131 Lisp_Object tail;
132 if (!NILP (string))
133 tail = Fcons (string, Qnil);
134 else
135 tail = Qnil;
136 return Fcons (Qkeymap,
137 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
140 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
141 "Construct and return a new sparse keymap.\n\
142 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
143 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
144 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
145 Initially the alist is nil.\n\n\
146 The optional arg STRING supplies a menu name for the keymap\n\
147 in case you use it as a menu with `x-popup-menu'.")
148 (string)
149 Lisp_Object string;
151 if (!NILP (string))
152 return Fcons (Qkeymap, Fcons (string, Qnil));
153 return Fcons (Qkeymap, Qnil);
156 /* This function is used for installing the standard key bindings
157 at initialization time.
159 For example:
161 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
163 void
164 initial_define_key (keymap, key, defname)
165 Lisp_Object keymap;
166 int key;
167 char *defname;
169 store_in_keymap (keymap, make_number (key), intern (defname));
172 void
173 initial_define_lispy_key (keymap, keyname, defname)
174 Lisp_Object keymap;
175 char *keyname;
176 char *defname;
178 store_in_keymap (keymap, intern (keyname), intern (defname));
181 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
182 "Return t if OBJECT is a keymap.\n\
184 A keymap is a list (keymap . ALIST),\n\
185 or a symbol whose function definition is itself a keymap.\n\
186 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
187 a vector of densely packed bindings for small character codes\n\
188 is also allowed as an element.")
189 (object)
190 Lisp_Object object;
192 return (KEYMAPP (object) ? Qt : Qnil);
195 /* Check that OBJECT is a keymap (after dereferencing through any
196 symbols). If it is, return it.
198 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
199 is an autoload form, do the autoload and try again.
200 If AUTOLOAD is nonzero, callers must assume GC is possible.
202 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
203 is zero as well), return Qt.
205 ERROR controls how we respond if OBJECT isn't a keymap.
206 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
208 Note that most of the time, we don't want to pursue autoloads.
209 Functions like Faccessible_keymaps which scan entire keymap trees
210 shouldn't load every autoloaded keymap. I'm not sure about this,
211 but it seems to me that only read_key_sequence, Flookup_key, and
212 Fdefine_key should cause keymaps to be autoloaded.
214 This function can GC when AUTOLOAD is non-zero, because it calls
215 do_autoload which can GC. */
217 Lisp_Object
218 get_keymap (object, error, autoload)
219 Lisp_Object object;
220 int error, autoload;
222 Lisp_Object tem;
224 autoload_retry:
225 if (NILP (object))
226 goto end;
227 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
228 return object;
230 tem = indirect_function (object);
231 if (CONSP (tem))
233 if (EQ (XCAR (tem), Qkeymap))
234 return tem;
236 /* Should we do an autoload? Autoload forms for keymaps have
237 Qkeymap as their fifth element. */
238 if ((autoload || !error) && EQ (XCAR (tem), Qautoload))
240 Lisp_Object tail;
242 tail = Fnth (make_number (4), tem);
243 if (EQ (tail, Qkeymap))
245 if (autoload)
247 struct gcpro gcpro1, gcpro2;
249 GCPRO2 (tem, object);
250 do_autoload (tem, object);
251 UNGCPRO;
253 goto autoload_retry;
255 else
256 return Qt;
261 end:
262 if (error)
263 wrong_type_argument (Qkeymapp, object);
264 return Qnil;
267 /* Return the parent map of the keymap MAP, or nil if it has none.
268 We assume that MAP is a valid keymap. */
270 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
271 "Return the parent keymap of KEYMAP.")
272 (keymap)
273 Lisp_Object keymap;
275 Lisp_Object list;
277 keymap = get_keymap (keymap, 1, 1);
279 /* Skip past the initial element `keymap'. */
280 list = XCDR (keymap);
281 for (; CONSP (list); list = XCDR (list))
283 /* See if there is another `keymap'. */
284 if (KEYMAPP (list))
285 return list;
288 return get_keymap (list, 0, 1);
292 /* Check whether MAP is one of MAPS parents. */
294 keymap_memberp (map, maps)
295 Lisp_Object map, maps;
297 if (NILP (map)) return 0;
298 while (KEYMAPP (maps) && !EQ (map, maps))
299 maps = Fkeymap_parent (maps);
300 return (EQ (map, maps));
303 /* Set the parent keymap of MAP to PARENT. */
305 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
306 "Modify KEYMAP to set its parent map to PARENT.\n\
307 PARENT should be nil or another keymap.")
308 (keymap, parent)
309 Lisp_Object keymap, parent;
311 Lisp_Object list, prev;
312 struct gcpro gcpro1;
313 int i;
315 /* Force a keymap flush for the next call to where-is.
316 Since this can be called from within where-is, we don't set where_is_cache
317 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
318 be changed during where-is, while where_is_cache_keymaps is only used at
319 the very beginning of where-is and can thus be changed here without any
320 adverse effect.
321 This is a very minor correctness (rather than safety) issue. */
322 where_is_cache_keymaps = Qt;
324 keymap = get_keymap (keymap, 1, 1);
325 GCPRO1 (keymap);
327 if (!NILP (parent))
329 parent = get_keymap (parent, 1, 1);
331 /* Check for cycles. */
332 if (keymap_memberp (keymap, parent))
333 error ("Cyclic keymap inheritance");
336 /* Skip past the initial element `keymap'. */
337 prev = keymap;
338 while (1)
340 list = XCDR (prev);
341 /* If there is a parent keymap here, replace it.
342 If we came to the end, add the parent in PREV. */
343 if (! CONSP (list) || KEYMAPP (list))
345 /* If we already have the right parent, return now
346 so that we avoid the loops below. */
347 if (EQ (XCDR (prev), parent))
348 RETURN_UNGCPRO (parent);
350 XCDR (prev) = parent;
351 break;
353 prev = list;
356 /* Scan through for submaps, and set their parents too. */
358 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
360 /* Stop the scan when we come to the parent. */
361 if (EQ (XCAR (list), Qkeymap))
362 break;
364 /* If this element holds a prefix map, deal with it. */
365 if (CONSP (XCAR (list))
366 && CONSP (XCDR (XCAR (list))))
367 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
368 XCDR (XCAR (list)));
370 if (VECTORP (XCAR (list)))
371 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
372 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
373 fix_submap_inheritance (keymap, make_number (i),
374 XVECTOR (XCAR (list))->contents[i]);
376 if (CHAR_TABLE_P (XCAR (list)))
378 Lisp_Object indices[3];
380 map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
381 keymap, 0, indices);
385 RETURN_UNGCPRO (parent);
388 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
389 if EVENT is also a prefix in MAP's parent,
390 make sure that SUBMAP inherits that definition as its own parent. */
392 static void
393 fix_submap_inheritance (map, event, submap)
394 Lisp_Object map, event, submap;
396 Lisp_Object map_parent, parent_entry;
398 /* SUBMAP is a cons that we found as a key binding.
399 Discard the other things found in a menu key binding. */
401 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
403 /* If it isn't a keymap now, there's no work to do. */
404 if (!CONSP (submap))
405 return;
407 map_parent = Fkeymap_parent (map);
408 if (!NILP (map_parent))
409 parent_entry =
410 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
411 else
412 parent_entry = Qnil;
414 /* If MAP's parent has something other than a keymap,
415 our own submap shadows it completely. */
416 if (!CONSP (parent_entry))
417 return;
419 if (! EQ (parent_entry, submap))
421 Lisp_Object submap_parent;
422 submap_parent = submap;
423 while (1)
425 Lisp_Object tem;
427 tem = Fkeymap_parent (submap_parent);
429 if (KEYMAPP (tem))
431 if (keymap_memberp (tem, parent_entry))
432 /* Fset_keymap_parent could create a cycle. */
433 return;
434 submap_parent = tem;
436 else
437 break;
439 Fset_keymap_parent (submap_parent, parent_entry);
443 /* Look up IDX in MAP. IDX may be any sort of event.
444 Note that this does only one level of lookup; IDX must be a single
445 event, not a sequence.
447 If T_OK is non-zero, bindings for Qt are treated as default
448 bindings; any key left unmentioned by other tables and bindings is
449 given the binding of Qt.
451 If T_OK is zero, bindings for Qt are not treated specially.
453 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
455 Lisp_Object
456 access_keymap (map, idx, t_ok, noinherit, autoload)
457 Lisp_Object map;
458 Lisp_Object idx;
459 int t_ok;
460 int noinherit;
461 int autoload;
463 int noprefix = 0;
464 Lisp_Object val;
466 /* If idx is a list (some sort of mouse click, perhaps?),
467 the index we want to use is the car of the list, which
468 ought to be a symbol. */
469 idx = EVENT_HEAD (idx);
471 /* If idx is a symbol, it might have modifiers, which need to
472 be put in the canonical order. */
473 if (SYMBOLP (idx))
474 idx = reorder_modifiers (idx);
475 else if (INTEGERP (idx))
476 /* Clobber the high bits that can be present on a machine
477 with more than 24 bits of integer. */
478 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
480 /* Handle the special meta -> esc mapping. */
481 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
483 /* See if there is a meta-map. If there's none, there is
484 no binding for IDX, unless a default binding exists in MAP. */
485 Lisp_Object meta_map =
486 get_keymap (access_keymap (map, meta_prefix_char,
487 t_ok, noinherit, autoload),
488 0, autoload);
489 if (CONSP (meta_map))
491 map = meta_map;
492 idx = make_number (XUINT (idx) & ~meta_modifier);
494 else if (t_ok)
495 /* Set IDX to t, so that we only find a default binding. */
496 idx = Qt;
497 else
498 /* We know there is no binding. */
499 return Qnil;
503 Lisp_Object tail;
504 Lisp_Object t_binding;
506 t_binding = Qnil;
507 for (tail = XCDR (map);
508 (CONSP (tail)
509 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
510 tail = XCDR (tail))
512 Lisp_Object binding;
514 binding = XCAR (tail);
515 if (SYMBOLP (binding))
517 /* If NOINHERIT, stop finding prefix definitions
518 after we pass a second occurrence of the `keymap' symbol. */
519 if (noinherit && EQ (binding, Qkeymap))
520 noprefix = 1;
522 else if (CONSP (binding))
524 if (EQ (XCAR (binding), idx))
526 val = XCDR (binding);
527 if (noprefix && KEYMAPP (val))
528 return Qnil;
529 if (CONSP (val))
530 fix_submap_inheritance (map, idx, val);
531 return get_keyelt (val, autoload);
533 if (t_ok && EQ (XCAR (binding), Qt))
534 t_binding = XCDR (binding);
536 else if (VECTORP (binding))
538 if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
540 val = XVECTOR (binding)->contents[XFASTINT (idx)];
541 if (noprefix && KEYMAPP (val))
542 return Qnil;
543 if (CONSP (val))
544 fix_submap_inheritance (map, idx, val);
545 return get_keyelt (val, autoload);
548 else if (CHAR_TABLE_P (binding))
550 /* Character codes with modifiers
551 are not included in a char-table.
552 All character codes without modifiers are included. */
553 if (NATNUMP (idx)
554 && ! (XFASTINT (idx)
555 & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
556 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
558 val = Faref (binding, idx);
559 if (noprefix && KEYMAPP (val))
560 return Qnil;
561 if (CONSP (val))
562 fix_submap_inheritance (map, idx, val);
563 return get_keyelt (val, autoload);
567 QUIT;
570 return get_keyelt (t_binding, autoload);
574 /* Given OBJECT which was found in a slot in a keymap,
575 trace indirect definitions to get the actual definition of that slot.
576 An indirect definition is a list of the form
577 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
578 and INDEX is the object to look up in KEYMAP to yield the definition.
580 Also if OBJECT has a menu string as the first element,
581 remove that. Also remove a menu help string as second element.
583 If AUTOLOAD is nonzero, load autoloadable keymaps
584 that are referred to with indirection. */
586 Lisp_Object
587 get_keyelt (object, autoload)
588 register Lisp_Object object;
589 int autoload;
591 while (1)
593 if (!(CONSP (object)))
594 /* This is really the value. */
595 return object;
597 /* If the keymap contents looks like (keymap ...) or (lambda ...)
598 then use itself. */
599 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
600 return object;
602 /* If the keymap contents looks like (menu-item name . DEFN)
603 or (menu-item name DEFN ...) then use DEFN.
604 This is a new format menu item. */
605 else if (EQ (XCAR (object), Qmenu_item))
607 if (CONSP (XCDR (object)))
609 Lisp_Object tem;
611 object = XCDR (XCDR (object));
612 tem = object;
613 if (CONSP (object))
614 object = XCAR (object);
616 /* If there's a `:filter FILTER', apply FILTER to the
617 menu-item's definition to get the real definition to
618 use. Temporarily inhibit GC while evaluating FILTER,
619 because not functions calling get_keyelt are prepared
620 for a GC. */
621 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
622 if (EQ (XCAR (tem), QCfilter))
624 int count = inhibit_garbage_collection ();
625 Lisp_Object filter;
626 filter = XCAR (XCDR (tem));
627 filter = list2 (filter, list2 (Qquote, object));
628 object = menu_item_eval_property (filter);
629 unbind_to (count, Qnil);
630 break;
633 else
634 /* Invalid keymap */
635 return object;
638 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
639 Keymap alist elements like (CHAR MENUSTRING . DEFN)
640 will be used by HierarKey menus. */
641 else if (STRINGP (XCAR (object)))
643 object = XCDR (object);
644 /* Also remove a menu help string, if any,
645 following the menu item name. */
646 if (CONSP (object) && STRINGP (XCAR (object)))
647 object = XCDR (object);
648 /* Also remove the sublist that caches key equivalences, if any. */
649 if (CONSP (object) && CONSP (XCAR (object)))
651 Lisp_Object carcar;
652 carcar = XCAR (XCAR (object));
653 if (NILP (carcar) || VECTORP (carcar))
654 object = XCDR (object);
658 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
659 else
661 Lisp_Object map;
662 map = get_keymap (Fcar_safe (object), 0, autoload);
663 return (!CONSP (map) ? object /* Invalid keymap */
664 : access_keymap (map, Fcdr (object), 0, 0, autoload));
669 static Lisp_Object
670 store_in_keymap (keymap, idx, def)
671 Lisp_Object keymap;
672 register Lisp_Object idx;
673 register Lisp_Object def;
675 /* Flush any reverse-map cache. */
676 where_is_cache = Qnil;
677 where_is_cache_keymaps = Qt;
679 /* If we are preparing to dump, and DEF is a menu element
680 with a menu item indicator, copy it to ensure it is not pure. */
681 if (CONSP (def) && PURE_P (def)
682 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
683 def = Fcons (XCAR (def), XCDR (def));
685 if (!CONSP (keymap) || ! EQ (XCAR (keymap), Qkeymap))
686 error ("attempt to define a key in a non-keymap");
688 /* If idx is a list (some sort of mouse click, perhaps?),
689 the index we want to use is the car of the list, which
690 ought to be a symbol. */
691 idx = EVENT_HEAD (idx);
693 /* If idx is a symbol, it might have modifiers, which need to
694 be put in the canonical order. */
695 if (SYMBOLP (idx))
696 idx = reorder_modifiers (idx);
697 else if (INTEGERP (idx))
698 /* Clobber the high bits that can be present on a machine
699 with more than 24 bits of integer. */
700 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
702 /* Scan the keymap for a binding of idx. */
704 Lisp_Object tail;
706 /* The cons after which we should insert new bindings. If the
707 keymap has a table element, we record its position here, so new
708 bindings will go after it; this way, the table will stay
709 towards the front of the alist and character lookups in dense
710 keymaps will remain fast. Otherwise, this just points at the
711 front of the keymap. */
712 Lisp_Object insertion_point;
714 insertion_point = keymap;
715 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
717 Lisp_Object elt;
719 elt = XCAR (tail);
720 if (VECTORP (elt))
722 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
724 ASET (elt, XFASTINT (idx), def);
725 return def;
727 insertion_point = tail;
729 else if (CHAR_TABLE_P (elt))
731 /* Character codes with modifiers
732 are not included in a char-table.
733 All character codes without modifiers are included. */
734 if (NATNUMP (idx)
735 && ! (XFASTINT (idx)
736 & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
737 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
739 Faset (elt, idx, def);
740 return def;
742 insertion_point = tail;
744 else if (CONSP (elt))
746 if (EQ (idx, XCAR (elt)))
748 XCDR (elt) = def;
749 return def;
752 else if (EQ (elt, Qkeymap))
753 /* If we find a 'keymap' symbol in the spine of KEYMAP,
754 then we must have found the start of a second keymap
755 being used as the tail of KEYMAP, and a binding for IDX
756 should be inserted before it. */
757 goto keymap_end;
759 QUIT;
762 keymap_end:
763 /* We have scanned the entire keymap, and not found a binding for
764 IDX. Let's add one. */
765 XCDR (insertion_point)
766 = Fcons (Fcons (idx, def), XCDR (insertion_point));
769 return def;
772 void
773 copy_keymap_1 (chartable, idx, elt)
774 Lisp_Object chartable, idx, elt;
776 if (CONSP (elt) && EQ (XCAR (elt), Qkeymap))
777 Faset (chartable, idx, Fcopy_keymap (elt));
780 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
781 "Return a copy of the keymap KEYMAP.\n\
782 The copy starts out with the same definitions of KEYMAP,\n\
783 but changing either the copy or KEYMAP does not affect the other.\n\
784 Any key definitions that are subkeymaps are recursively copied.\n\
785 However, a key definition which is a symbol whose definition is a keymap\n\
786 is not copied.")
787 (keymap)
788 Lisp_Object keymap;
790 register Lisp_Object copy, tail;
792 copy = Fcopy_alist (get_keymap (keymap, 1, 0));
794 for (tail = copy; CONSP (tail); tail = XCDR (tail))
796 Lisp_Object elt;
798 elt = XCAR (tail);
799 if (CHAR_TABLE_P (elt))
801 Lisp_Object indices[3];
803 elt = Fcopy_sequence (elt);
804 XCAR (tail) = elt;
806 map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
808 else if (VECTORP (elt))
810 int i;
812 elt = Fcopy_sequence (elt);
813 XCAR (tail) = elt;
815 for (i = 0; i < ASIZE (elt); i++)
816 if (CONSP (AREF (elt, i)) && EQ (XCAR (AREF (elt, i)), Qkeymap))
817 ASET (elt, i, Fcopy_keymap (AREF (elt, i)));
819 else if (CONSP (elt) && CONSP (XCDR (elt)))
821 Lisp_Object tem;
822 tem = XCDR (elt);
824 /* Is this a new format menu item. */
825 if (EQ (XCAR (tem),Qmenu_item))
827 /* Copy cell with menu-item marker. */
828 XCDR (elt)
829 = Fcons (XCAR (tem), XCDR (tem));
830 elt = XCDR (elt);
831 tem = XCDR (elt);
832 if (CONSP (tem))
834 /* Copy cell with menu-item name. */
835 XCDR (elt)
836 = Fcons (XCAR (tem), XCDR (tem));
837 elt = XCDR (elt);
838 tem = XCDR (elt);
840 if (CONSP (tem))
842 /* Copy cell with binding and if the binding is a keymap,
843 copy that. */
844 XCDR (elt)
845 = Fcons (XCAR (tem), XCDR (tem));
846 elt = XCDR (elt);
847 tem = XCAR (elt);
848 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
849 XCAR (elt) = Fcopy_keymap (tem);
850 tem = XCDR (elt);
851 if (CONSP (tem) && CONSP (XCAR (tem)))
852 /* Delete cache for key equivalences. */
853 XCDR (elt) = XCDR (tem);
856 else
858 /* It may be an old fomat menu item.
859 Skip the optional menu string.
861 if (STRINGP (XCAR (tem)))
863 /* Copy the cell, since copy-alist didn't go this deep. */
864 XCDR (elt)
865 = Fcons (XCAR (tem), XCDR (tem));
866 elt = XCDR (elt);
867 tem = XCDR (elt);
868 /* Also skip the optional menu help string. */
869 if (CONSP (tem) && STRINGP (XCAR (tem)))
871 XCDR (elt)
872 = Fcons (XCAR (tem), XCDR (tem));
873 elt = XCDR (elt);
874 tem = XCDR (elt);
876 /* There may also be a list that caches key equivalences.
877 Just delete it for the new keymap. */
878 if (CONSP (tem)
879 && CONSP (XCAR (tem))
880 && (NILP (XCAR (XCAR (tem)))
881 || VECTORP (XCAR (XCAR (tem)))))
882 XCDR (elt) = XCDR (tem);
884 if (CONSP (elt)
885 && CONSP (XCDR (elt))
886 && EQ (XCAR (XCDR (elt)), Qkeymap))
887 XCDR (elt) = Fcopy_keymap (XCDR (elt));
893 return copy;
896 /* Simple Keymap mutators and accessors. */
898 /* GC is possible in this function if it autoloads a keymap. */
900 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
901 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
902 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
903 meaning a sequence of keystrokes and events.\n\
904 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
905 can be included if you use a vector.\n\
906 DEF is anything that can be a key's definition:\n\
907 nil (means key is undefined in this keymap),\n\
908 a command (a Lisp function suitable for interactive calling)\n\
909 a string (treated as a keyboard macro),\n\
910 a keymap (to define a prefix key),\n\
911 a symbol. When the key is looked up, the symbol will stand for its\n\
912 function definition, which should at that time be one of the above,\n\
913 or another symbol whose function definition is used, etc.\n\
914 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
915 (DEFN should be a valid definition in its own right),\n\
916 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
918 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
919 the front of KEYMAP.")
920 (keymap, key, def)
921 Lisp_Object keymap;
922 Lisp_Object key;
923 Lisp_Object def;
925 register int idx;
926 register Lisp_Object c;
927 register Lisp_Object cmd;
928 int metized = 0;
929 int meta_bit;
930 int length;
931 struct gcpro gcpro1, gcpro2, gcpro3;
933 keymap = get_keymap (keymap, 1, 1);
935 if (!VECTORP (key) && !STRINGP (key))
936 key = wrong_type_argument (Qarrayp, key);
938 length = XFASTINT (Flength (key));
939 if (length == 0)
940 return Qnil;
942 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
943 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
945 GCPRO3 (keymap, key, def);
947 if (VECTORP (key))
948 meta_bit = meta_modifier;
949 else
950 meta_bit = 0x80;
952 idx = 0;
953 while (1)
955 c = Faref (key, make_number (idx));
957 if (CONSP (c) && lucid_event_type_list_p (c))
958 c = Fevent_convert_list (c);
960 if (INTEGERP (c)
961 && (XINT (c) & meta_bit)
962 && !metized)
964 c = meta_prefix_char;
965 metized = 1;
967 else
969 if (INTEGERP (c))
970 XSETINT (c, XINT (c) & ~meta_bit);
972 metized = 0;
973 idx++;
976 if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
977 error ("Key sequence contains invalid events");
979 if (idx == length)
980 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
982 cmd = access_keymap (keymap, c, 0, 1, 1);
984 /* If this key is undefined, make it a prefix. */
985 if (NILP (cmd))
986 cmd = define_as_prefix (keymap, c);
988 keymap = get_keymap (cmd, 0, 1);
989 if (!CONSP (keymap))
990 /* We must use Fkey_description rather than just passing key to
991 error; key might be a vector, not a string. */
992 error ("Key sequence %s uses invalid prefix characters",
993 XSTRING (Fkey_description (key))->data);
997 /* Value is number if KEY is too long; NIL if valid but has no definition. */
998 /* GC is possible in this function if it autoloads a keymap. */
1000 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1001 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
1002 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
1004 A number as value means KEY is \"too long\";\n\
1005 that is, characters or symbols in it except for the last one\n\
1006 fail to be a valid sequence of prefix characters in KEYMAP.\n\
1007 The number is how many characters at the front of KEY\n\
1008 it takes to reach a non-prefix command.\n\
1010 Normally, `lookup-key' ignores bindings for t, which act as default\n\
1011 bindings, used when nothing else in the keymap applies; this makes it\n\
1012 usable as a general function for probing keymaps. However, if the\n\
1013 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
1014 recognize the default bindings, just as `read-key-sequence' does.")
1015 (keymap, key, accept_default)
1016 register Lisp_Object keymap;
1017 Lisp_Object key;
1018 Lisp_Object accept_default;
1020 register int idx;
1021 register Lisp_Object cmd;
1022 register Lisp_Object c;
1023 int length;
1024 int t_ok = ! NILP (accept_default);
1025 struct gcpro gcpro1;
1027 keymap = get_keymap (keymap, 1, 1);
1029 if (!VECTORP (key) && !STRINGP (key))
1030 key = wrong_type_argument (Qarrayp, key);
1032 length = XFASTINT (Flength (key));
1033 if (length == 0)
1034 return keymap;
1036 GCPRO1 (key);
1038 idx = 0;
1039 while (1)
1041 c = Faref (key, make_number (idx++));
1043 if (CONSP (c) && lucid_event_type_list_p (c))
1044 c = Fevent_convert_list (c);
1046 /* Turn the 8th bit of string chars into a meta modifier. */
1047 if (XINT (c) & 0x80 && STRINGP (key))
1048 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1050 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1051 if (idx == length)
1052 RETURN_UNGCPRO (cmd);
1054 keymap = get_keymap (cmd, 0, 1);
1055 if (!CONSP (keymap))
1056 RETURN_UNGCPRO (make_number (idx));
1058 QUIT;
1062 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1063 Assume that currently it does not define C at all.
1064 Return the keymap. */
1066 static Lisp_Object
1067 define_as_prefix (keymap, c)
1068 Lisp_Object keymap, c;
1070 Lisp_Object cmd;
1072 cmd = Fmake_sparse_keymap (Qnil);
1073 /* If this key is defined as a prefix in an inherited keymap,
1074 make it a prefix in this map, and make its definition
1075 inherit the other prefix definition. */
1076 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1077 store_in_keymap (keymap, c, cmd);
1079 return cmd;
1082 /* Append a key to the end of a key sequence. We always make a vector. */
1084 Lisp_Object
1085 append_key (key_sequence, key)
1086 Lisp_Object key_sequence, key;
1088 Lisp_Object args[2];
1090 args[0] = key_sequence;
1092 args[1] = Fcons (key, Qnil);
1093 return Fvconcat (2, args);
1097 /* Global, local, and minor mode keymap stuff. */
1099 /* We can't put these variables inside current_minor_maps, since under
1100 some systems, static gets macro-defined to be the empty string.
1101 Ickypoo. */
1102 static Lisp_Object *cmm_modes, *cmm_maps;
1103 static int cmm_size;
1105 /* Error handler used in current_minor_maps. */
1106 static Lisp_Object
1107 current_minor_maps_error ()
1109 return Qnil;
1112 /* Store a pointer to an array of the keymaps of the currently active
1113 minor modes in *buf, and return the number of maps it contains.
1115 This function always returns a pointer to the same buffer, and may
1116 free or reallocate it, so if you want to keep it for a long time or
1117 hand it out to lisp code, copy it. This procedure will be called
1118 for every key sequence read, so the nice lispy approach (return a
1119 new assoclist, list, what have you) for each invocation would
1120 result in a lot of consing over time.
1122 If we used xrealloc/xmalloc and ran out of memory, they would throw
1123 back to the command loop, which would try to read a key sequence,
1124 which would call this function again, resulting in an infinite
1125 loop. Instead, we'll use realloc/malloc and silently truncate the
1126 list, let the key sequence be read, and hope some other piece of
1127 code signals the error. */
1129 current_minor_maps (modeptr, mapptr)
1130 Lisp_Object **modeptr, **mapptr;
1132 int i = 0;
1133 int list_number = 0;
1134 Lisp_Object alist, assoc, var, val;
1135 Lisp_Object lists[2];
1137 lists[0] = Vminor_mode_overriding_map_alist;
1138 lists[1] = Vminor_mode_map_alist;
1140 for (list_number = 0; list_number < 2; list_number++)
1141 for (alist = lists[list_number];
1142 CONSP (alist);
1143 alist = XCDR (alist))
1144 if ((assoc = XCAR (alist), CONSP (assoc))
1145 && (var = XCAR (assoc), SYMBOLP (var))
1146 && (val = find_symbol_value (var), ! EQ (val, Qunbound))
1147 && ! NILP (val))
1149 Lisp_Object temp;
1151 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1152 and also an entry in Vminor_mode_map_alist,
1153 ignore the latter. */
1154 if (list_number == 1)
1156 val = assq_no_quit (var, lists[0]);
1157 if (!NILP (val))
1158 break;
1161 if (i >= cmm_size)
1163 Lisp_Object *newmodes, *newmaps;
1165 if (cmm_maps)
1167 BLOCK_INPUT;
1168 cmm_size *= 2;
1169 newmodes
1170 = (Lisp_Object *) realloc (cmm_modes,
1171 cmm_size * sizeof (Lisp_Object));
1172 newmaps
1173 = (Lisp_Object *) realloc (cmm_maps,
1174 cmm_size * sizeof (Lisp_Object));
1175 UNBLOCK_INPUT;
1177 else
1179 BLOCK_INPUT;
1180 cmm_size = 30;
1181 newmodes
1182 = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object));
1183 newmaps
1184 = (Lisp_Object *) xmalloc (cmm_size * sizeof (Lisp_Object));
1185 UNBLOCK_INPUT;
1188 if (newmaps && newmodes)
1190 cmm_modes = newmodes;
1191 cmm_maps = newmaps;
1193 else
1194 break;
1197 /* Get the keymap definition--or nil if it is not defined. */
1198 temp = internal_condition_case_1 (Findirect_function,
1199 XCDR (assoc),
1200 Qerror, current_minor_maps_error);
1201 if (!NILP (temp))
1203 cmm_modes[i] = var;
1204 cmm_maps [i] = temp;
1205 i++;
1209 if (modeptr) *modeptr = cmm_modes;
1210 if (mapptr) *mapptr = cmm_maps;
1211 return i;
1214 /* GC is possible in this function if it autoloads a keymap. */
1216 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
1217 "Return the binding for command KEY in current keymaps.\n\
1218 KEY is a string or vector, a sequence of keystrokes.\n\
1219 The binding is probably a symbol with a function definition.\n\
1221 Normally, `key-binding' ignores bindings for t, which act as default\n\
1222 bindings, used when nothing else in the keymap applies; this makes it\n\
1223 usable as a general function for probing keymaps. However, if the\n\
1224 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
1225 recognize the default bindings, just as `read-key-sequence' does.")
1226 (key, accept_default)
1227 Lisp_Object key, accept_default;
1229 Lisp_Object *maps, value;
1230 int nmaps, i;
1231 struct gcpro gcpro1;
1233 GCPRO1 (key);
1235 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1237 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1238 key, accept_default);
1239 if (! NILP (value) && !INTEGERP (value))
1240 RETURN_UNGCPRO (value);
1242 else if (!NILP (Voverriding_local_map))
1244 value = Flookup_key (Voverriding_local_map, key, accept_default);
1245 if (! NILP (value) && !INTEGERP (value))
1246 RETURN_UNGCPRO (value);
1248 else
1250 Lisp_Object local;
1252 nmaps = current_minor_maps (0, &maps);
1253 /* Note that all these maps are GCPRO'd
1254 in the places where we found them. */
1256 for (i = 0; i < nmaps; i++)
1257 if (! NILP (maps[i]))
1259 value = Flookup_key (maps[i], key, accept_default);
1260 if (! NILP (value) && !INTEGERP (value))
1261 RETURN_UNGCPRO (value);
1264 local = get_local_map (PT, current_buffer, keymap);
1265 if (! NILP (local))
1267 value = Flookup_key (local, key, accept_default);
1268 if (! NILP (value) && !INTEGERP (value))
1269 RETURN_UNGCPRO (value);
1272 local = get_local_map (PT, current_buffer, local_map);
1274 if (! NILP (local))
1276 value = Flookup_key (local, key, accept_default);
1277 if (! NILP (value) && !INTEGERP (value))
1278 RETURN_UNGCPRO (value);
1282 value = Flookup_key (current_global_map, key, accept_default);
1283 UNGCPRO;
1284 if (! NILP (value) && !INTEGERP (value))
1285 return value;
1287 return Qnil;
1290 /* GC is possible in this function if it autoloads a keymap. */
1292 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1293 "Return the binding for command KEYS in current local keymap only.\n\
1294 KEYS is a string, a sequence of keystrokes.\n\
1295 The binding is probably a symbol with a function definition.\n\
1297 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1298 bindings; see the description of `lookup-key' for more details about this.")
1299 (keys, accept_default)
1300 Lisp_Object keys, accept_default;
1302 register Lisp_Object map;
1303 map = current_buffer->keymap;
1304 if (NILP (map))
1305 return Qnil;
1306 return Flookup_key (map, keys, accept_default);
1309 /* GC is possible in this function if it autoloads a keymap. */
1311 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1312 "Return the binding for command KEYS in current global keymap only.\n\
1313 KEYS is a string, a sequence of keystrokes.\n\
1314 The binding is probably a symbol with a function definition.\n\
1315 This function's return values are the same as those of lookup-key\n\
1316 \(which see).\n\
1318 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1319 bindings; see the description of `lookup-key' for more details about this.")
1320 (keys, accept_default)
1321 Lisp_Object keys, accept_default;
1323 return Flookup_key (current_global_map, keys, accept_default);
1326 /* GC is possible in this function if it autoloads a keymap. */
1328 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1329 "Find the visible minor mode bindings of KEY.\n\
1330 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
1331 the symbol which names the minor mode binding KEY, and BINDING is\n\
1332 KEY's definition in that mode. In particular, if KEY has no\n\
1333 minor-mode bindings, return nil. If the first binding is a\n\
1334 non-prefix, all subsequent bindings will be omitted, since they would\n\
1335 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
1336 that come after prefix bindings.\n\
1338 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1339 bindings; see the description of `lookup-key' for more details about this.")
1340 (key, accept_default)
1341 Lisp_Object key, accept_default;
1343 Lisp_Object *modes, *maps;
1344 int nmaps;
1345 Lisp_Object binding;
1346 int i, j;
1347 struct gcpro gcpro1, gcpro2;
1349 nmaps = current_minor_maps (&modes, &maps);
1350 /* Note that all these maps are GCPRO'd
1351 in the places where we found them. */
1353 binding = Qnil;
1354 GCPRO2 (key, binding);
1356 for (i = j = 0; i < nmaps; i++)
1357 if (!NILP (maps[i])
1358 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1359 && !INTEGERP (binding))
1361 if (KEYMAPP (binding))
1362 maps[j++] = Fcons (modes[i], binding);
1363 else if (j == 0)
1364 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1367 UNGCPRO;
1368 return Flist (j, maps);
1371 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1372 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
1373 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1374 If a second optional argument MAPVAR is given, the map is stored as\n\
1375 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1376 as a function.\n\
1377 The third optional argument NAME, if given, supplies a menu name\n\
1378 string for the map. This is required to use the keymap as a menu.")
1379 (command, mapvar, name)
1380 Lisp_Object command, mapvar, name;
1382 Lisp_Object map;
1383 map = Fmake_sparse_keymap (name);
1384 Ffset (command, map);
1385 if (!NILP (mapvar))
1386 Fset (mapvar, map);
1387 else
1388 Fset (command, map);
1389 return command;
1392 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1393 "Select KEYMAP as the global keymap.")
1394 (keymap)
1395 Lisp_Object keymap;
1397 keymap = get_keymap (keymap, 1, 1);
1398 current_global_map = keymap;
1400 return Qnil;
1403 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1404 "Select KEYMAP as the local keymap.\n\
1405 If KEYMAP is nil, that means no local keymap.")
1406 (keymap)
1407 Lisp_Object keymap;
1409 if (!NILP (keymap))
1410 keymap = get_keymap (keymap, 1, 1);
1412 current_buffer->keymap = keymap;
1414 return Qnil;
1417 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1418 "Return current buffer's local keymap, or nil if it has none.")
1421 return current_buffer->keymap;
1424 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1425 "Return the current global keymap.")
1428 return current_global_map;
1431 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1432 "Return a list of keymaps for the minor modes of the current buffer.")
1435 Lisp_Object *maps;
1436 int nmaps = current_minor_maps (0, &maps);
1438 return Flist (nmaps, maps);
1441 /* Help functions for describing and documenting keymaps. */
1443 static void accessible_keymaps_char_table ();
1445 /* This function cannot GC. */
1447 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1448 1, 2, 0,
1449 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1450 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1451 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1452 so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
1453 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1454 then the value includes only maps for prefixes that start with PREFIX.")
1455 (keymap, prefix)
1456 Lisp_Object keymap, prefix;
1458 Lisp_Object maps, good_maps, tail;
1459 int prefixlen = 0;
1461 /* no need for gcpro because we don't autoload any keymaps. */
1463 if (!NILP (prefix))
1464 prefixlen = XINT (Flength (prefix));
1466 if (!NILP (prefix))
1468 /* If a prefix was specified, start with the keymap (if any) for
1469 that prefix, so we don't waste time considering other prefixes. */
1470 Lisp_Object tem;
1471 tem = Flookup_key (keymap, prefix, Qt);
1472 /* Flookup_key may give us nil, or a number,
1473 if the prefix is not defined in this particular map.
1474 It might even give us a list that isn't a keymap. */
1475 tem = get_keymap (tem, 0, 0);
1476 if (CONSP (tem))
1478 /* Convert PREFIX to a vector now, so that later on
1479 we don't have to deal with the possibility of a string. */
1480 if (STRINGP (prefix))
1482 int i, i_byte, c;
1483 Lisp_Object copy;
1485 copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
1486 for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
1488 int i_before = i;
1490 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
1491 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1492 c ^= 0200 | meta_modifier;
1493 ASET (copy, i_before, make_number (c));
1495 prefix = copy;
1497 maps = Fcons (Fcons (prefix, tem), Qnil);
1499 else
1500 return Qnil;
1502 else
1503 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1504 get_keymap (keymap, 1, 0)),
1505 Qnil);
1507 /* For each map in the list maps,
1508 look at any other maps it points to,
1509 and stick them at the end if they are not already in the list.
1511 This is a breadth-first traversal, where tail is the queue of
1512 nodes, and maps accumulates a list of all nodes visited. */
1514 for (tail = maps; CONSP (tail); tail = XCDR (tail))
1516 register Lisp_Object thisseq, thismap;
1517 Lisp_Object last;
1518 /* Does the current sequence end in the meta-prefix-char? */
1519 int is_metized;
1521 thisseq = Fcar (Fcar (tail));
1522 thismap = Fcdr (Fcar (tail));
1523 last = make_number (XINT (Flength (thisseq)) - 1);
1524 is_metized = (XINT (last) >= 0
1525 /* Don't metize the last char of PREFIX. */
1526 && XINT (last) >= prefixlen
1527 && EQ (Faref (thisseq, last), meta_prefix_char));
1529 for (; CONSP (thismap); thismap = XCDR (thismap))
1531 Lisp_Object elt;
1533 elt = XCAR (thismap);
1535 QUIT;
1537 if (CHAR_TABLE_P (elt))
1539 Lisp_Object indices[3];
1541 map_char_table (accessible_keymaps_char_table, Qnil,
1542 elt, Fcons (maps, Fcons (tail, thisseq)),
1543 0, indices);
1545 else if (VECTORP (elt))
1547 register int i;
1549 /* Vector keymap. Scan all the elements. */
1550 for (i = 0; i < ASIZE (elt); i++)
1552 register Lisp_Object tem;
1553 register Lisp_Object cmd;
1555 cmd = get_keyelt (AREF (elt, i), 0);
1556 if (NILP (cmd)) continue;
1557 tem = get_keymap (cmd, 0, 0);
1558 if (CONSP (tem))
1560 cmd = tem;
1561 /* Ignore keymaps that are already added to maps. */
1562 tem = Frassq (cmd, maps);
1563 if (NILP (tem))
1565 /* If the last key in thisseq is meta-prefix-char,
1566 turn it into a meta-ized keystroke. We know
1567 that the event we're about to append is an
1568 ascii keystroke since we're processing a
1569 keymap table. */
1570 if (is_metized)
1572 int meta_bit = meta_modifier;
1573 tem = Fcopy_sequence (thisseq);
1575 Faset (tem, last, make_number (i | meta_bit));
1577 /* This new sequence is the same length as
1578 thisseq, so stick it in the list right
1579 after this one. */
1580 XCDR (tail)
1581 = Fcons (Fcons (tem, cmd), XCDR (tail));
1583 else
1585 tem = append_key (thisseq, make_number (i));
1586 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1592 else if (CONSP (elt))
1594 register Lisp_Object cmd, tem;
1596 cmd = get_keyelt (XCDR (elt), 0);
1597 /* Ignore definitions that aren't keymaps themselves. */
1598 tem = get_keymap (cmd, 0, 0);
1599 if (CONSP (tem))
1601 /* Ignore keymaps that have been seen already. */
1602 cmd = tem;
1603 tem = Frassq (cmd, maps);
1604 if (NILP (tem))
1606 /* Let elt be the event defined by this map entry. */
1607 elt = XCAR (elt);
1609 /* If the last key in thisseq is meta-prefix-char, and
1610 this entry is a binding for an ascii keystroke,
1611 turn it into a meta-ized keystroke. */
1612 if (is_metized && INTEGERP (elt))
1614 Lisp_Object element;
1616 element = thisseq;
1617 tem = Fvconcat (1, &element);
1618 XSETFASTINT (AREF (tem, XINT (last)),
1619 XINT (elt) | meta_modifier);
1621 /* This new sequence is the same length as
1622 thisseq, so stick it in the list right
1623 after this one. */
1624 XCDR (tail)
1625 = Fcons (Fcons (tem, cmd), XCDR (tail));
1627 else
1628 nconc2 (tail,
1629 Fcons (Fcons (append_key (thisseq, elt), cmd),
1630 Qnil));
1637 if (NILP (prefix))
1638 return maps;
1640 /* Now find just the maps whose access prefixes start with PREFIX. */
1642 good_maps = Qnil;
1643 for (; CONSP (maps); maps = XCDR (maps))
1645 Lisp_Object elt, thisseq;
1646 elt = XCAR (maps);
1647 thisseq = XCAR (elt);
1648 /* The access prefix must be at least as long as PREFIX,
1649 and the first elements must match those of PREFIX. */
1650 if (XINT (Flength (thisseq)) >= prefixlen)
1652 int i;
1653 for (i = 0; i < prefixlen; i++)
1655 Lisp_Object i1;
1656 XSETFASTINT (i1, i);
1657 if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1658 break;
1660 if (i == prefixlen)
1661 good_maps = Fcons (elt, good_maps);
1665 return Fnreverse (good_maps);
1668 static void
1669 accessible_keymaps_char_table (args, index, cmd)
1670 Lisp_Object args, index, cmd;
1672 Lisp_Object tem;
1673 Lisp_Object maps, tail, thisseq;
1675 if (NILP (cmd))
1676 return;
1678 maps = XCAR (args);
1679 tail = XCAR (XCDR (args));
1680 thisseq = XCDR (XCDR (args));
1682 tem = get_keymap (cmd, 0, 0);
1683 if (CONSP (tem))
1685 cmd = tem;
1686 /* Ignore keymaps that are already added to maps. */
1687 tem = Frassq (cmd, maps);
1688 if (NILP (tem))
1690 tem = append_key (thisseq, index);
1691 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1696 Lisp_Object Qsingle_key_description, Qkey_description;
1698 /* This function cannot GC. */
1700 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1701 "Return a pretty description of key-sequence KEYS.\n\
1702 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1703 spaces are put between sequence elements, etc.")
1704 (keys)
1705 Lisp_Object keys;
1707 int len = 0;
1708 int i, i_byte;
1709 Lisp_Object sep;
1710 Lisp_Object *args = NULL;
1712 if (STRINGP (keys))
1714 Lisp_Object vector;
1715 vector = Fmake_vector (Flength (keys), Qnil);
1716 for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
1718 int c;
1719 int i_before = i;
1721 FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
1722 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1723 c ^= 0200 | meta_modifier;
1724 XSETFASTINT (AREF (vector, i_before), c);
1726 keys = vector;
1729 if (VECTORP (keys))
1731 /* In effect, this computes
1732 (mapconcat 'single-key-description keys " ")
1733 but we shouldn't use mapconcat because it can do GC. */
1735 len = XVECTOR (keys)->size;
1736 sep = build_string (" ");
1737 /* This has one extra element at the end that we don't pass to Fconcat. */
1738 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1740 for (i = 0; i < len; i++)
1742 args[i * 2] = Fsingle_key_description (AREF (keys, i), Qnil);
1743 args[i * 2 + 1] = sep;
1746 else if (CONSP (keys))
1748 /* In effect, this computes
1749 (mapconcat 'single-key-description keys " ")
1750 but we shouldn't use mapconcat because it can do GC. */
1752 len = XFASTINT (Flength (keys));
1753 sep = build_string (" ");
1754 /* This has one extra element at the end that we don't pass to Fconcat. */
1755 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1757 for (i = 0; i < len; i++)
1759 args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
1760 args[i * 2 + 1] = sep;
1761 keys = XCDR (keys);
1764 else
1765 keys = wrong_type_argument (Qarrayp, keys);
1767 return Fconcat (len * 2 - 1, args);
1770 char *
1771 push_key_description (c, p)
1772 register unsigned int c;
1773 register char *p;
1775 unsigned c2;
1777 /* Clear all the meaningless bits above the meta bit. */
1778 c &= meta_modifier | ~ - meta_modifier;
1779 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
1780 | meta_modifier | shift_modifier | super_modifier);
1782 if (c & alt_modifier)
1784 *p++ = 'A';
1785 *p++ = '-';
1786 c -= alt_modifier;
1788 if ((c & ctrl_modifier) != 0
1789 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
1791 *p++ = 'C';
1792 *p++ = '-';
1793 c &= ~ctrl_modifier;
1795 if (c & hyper_modifier)
1797 *p++ = 'H';
1798 *p++ = '-';
1799 c -= hyper_modifier;
1801 if (c & meta_modifier)
1803 *p++ = 'M';
1804 *p++ = '-';
1805 c -= meta_modifier;
1807 if (c & shift_modifier)
1809 *p++ = 'S';
1810 *p++ = '-';
1811 c -= shift_modifier;
1813 if (c & super_modifier)
1815 *p++ = 's';
1816 *p++ = '-';
1817 c -= super_modifier;
1819 if (c < 040)
1821 if (c == 033)
1823 *p++ = 'E';
1824 *p++ = 'S';
1825 *p++ = 'C';
1827 else if (c == '\t')
1829 *p++ = 'T';
1830 *p++ = 'A';
1831 *p++ = 'B';
1833 else if (c == Ctl ('M'))
1835 *p++ = 'R';
1836 *p++ = 'E';
1837 *p++ = 'T';
1839 else
1841 /* `C-' already added above. */
1842 if (c > 0 && c <= Ctl ('Z'))
1843 *p++ = c + 0140;
1844 else
1845 *p++ = c + 0100;
1848 else if (c == 0177)
1850 *p++ = 'D';
1851 *p++ = 'E';
1852 *p++ = 'L';
1854 else if (c == ' ')
1856 *p++ = 'S';
1857 *p++ = 'P';
1858 *p++ = 'C';
1860 else if (c < 128
1861 || (NILP (current_buffer->enable_multibyte_characters)
1862 && SINGLE_BYTE_CHAR_P (c)))
1863 *p++ = c;
1864 else
1866 if (! NILP (current_buffer->enable_multibyte_characters))
1867 c = unibyte_char_to_multibyte (c);
1869 if (NILP (current_buffer->enable_multibyte_characters)
1870 || SINGLE_BYTE_CHAR_P (c)
1871 || ! char_valid_p (c, 0))
1873 int bit_offset;
1874 *p++ = '\\';
1875 /* The biggest character code uses 19 bits. */
1876 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
1878 if (c >= (1 << bit_offset))
1879 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
1882 else
1884 p += CHAR_STRING (c, p);
1888 return p;
1891 /* This function cannot GC. */
1893 DEFUN ("single-key-description", Fsingle_key_description,
1894 Ssingle_key_description, 1, 2, 0,
1895 "Return a pretty description of command character KEY.\n\
1896 Control characters turn into C-whatever, etc.\n\
1897 Optional argument NO-ANGLES non-nil means don't put angle brackets\n\
1898 around function keys and event symbols.")
1899 (key, no_angles)
1900 Lisp_Object key, no_angles;
1902 if (CONSP (key) && lucid_event_type_list_p (key))
1903 key = Fevent_convert_list (key);
1905 key = EVENT_HEAD (key);
1907 if (INTEGERP (key)) /* Normal character */
1909 unsigned int charset, c1, c2;
1910 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
1912 if (SINGLE_BYTE_CHAR_P (without_bits))
1913 charset = 0;
1914 else
1915 SPLIT_CHAR (without_bits, charset, c1, c2);
1917 if (charset
1918 && CHARSET_DEFINED_P (charset)
1919 && ((c1 >= 0 && c1 < 32)
1920 || (c2 >= 0 && c2 < 32)))
1922 /* Handle a generic character. */
1923 Lisp_Object name;
1924 name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
1925 CHECK_STRING (name, 0);
1926 return concat2 (build_string ("Character set "), name);
1928 else
1930 char tem[KEY_DESCRIPTION_SIZE];
1932 *push_key_description (XUINT (key), tem) = 0;
1933 return build_string (tem);
1936 else if (SYMBOLP (key)) /* Function key or event-symbol */
1938 if (NILP (no_angles))
1940 char *buffer
1941 = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
1942 sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
1943 return build_string (buffer);
1945 else
1946 return Fsymbol_name (key);
1948 else if (STRINGP (key)) /* Buffer names in the menubar. */
1949 return Fcopy_sequence (key);
1950 else
1951 error ("KEY must be an integer, cons, symbol, or string");
1952 return Qnil;
1955 char *
1956 push_text_char_description (c, p)
1957 register unsigned int c;
1958 register char *p;
1960 if (c >= 0200)
1962 *p++ = 'M';
1963 *p++ = '-';
1964 c -= 0200;
1966 if (c < 040)
1968 *p++ = '^';
1969 *p++ = c + 64; /* 'A' - 1 */
1971 else if (c == 0177)
1973 *p++ = '^';
1974 *p++ = '?';
1976 else
1977 *p++ = c;
1978 return p;
1981 /* This function cannot GC. */
1983 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1984 "Return a pretty description of file-character CHARACTER.\n\
1985 Control characters turn into \"^char\", etc.")
1986 (character)
1987 Lisp_Object character;
1989 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
1990 unsigned char str[6];
1991 int c;
1993 CHECK_NUMBER (character, 0);
1995 c = XINT (character);
1996 if (!SINGLE_BYTE_CHAR_P (c))
1998 int len = CHAR_STRING (c, str);
2000 return make_multibyte_string (str, 1, len);
2003 *push_text_char_description (c & 0377, str) = 0;
2005 return build_string (str);
2008 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2009 a meta bit. */
2010 static int
2011 ascii_sequence_p (seq)
2012 Lisp_Object seq;
2014 int i;
2015 int len = XINT (Flength (seq));
2017 for (i = 0; i < len; i++)
2019 Lisp_Object ii, elt;
2021 XSETFASTINT (ii, i);
2022 elt = Faref (seq, ii);
2024 if (!INTEGERP (elt)
2025 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2026 return 0;
2029 return 1;
2033 /* where-is - finding a command in a set of keymaps. */
2035 static Lisp_Object where_is_internal_1 ();
2036 static void where_is_internal_2 ();
2038 static INLINE int
2039 menu_item_p (item)
2040 Lisp_Object item;
2042 return (CONSP (item)
2043 && (EQ (XCAR (item),Qmenu_item)
2044 || STRINGP (XCAR (item))));
2047 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2048 Returns the first non-nil binding found in any of those maps. */
2050 static Lisp_Object
2051 shadow_lookup (shadow, key, flag)
2052 Lisp_Object shadow, key, flag;
2054 Lisp_Object tail, value;
2056 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2058 value = Flookup_key (XCAR (tail), key, flag);
2059 if (!NILP (value) && !NATNUMP (value))
2060 return value;
2062 return Qnil;
2065 /* This function can GC if Flookup_key autoloads any keymaps. */
2067 static Lisp_Object
2068 where_is_internal (definition, keymaps, firstonly, noindirect)
2069 Lisp_Object definition, keymaps;
2070 Lisp_Object firstonly, noindirect;
2072 Lisp_Object maps = Qnil;
2073 Lisp_Object found, sequences;
2074 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2075 /* 1 means ignore all menu bindings entirely. */
2076 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2078 found = keymaps;
2079 while (CONSP (found))
2081 maps =
2082 nconc2 (maps,
2083 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2084 found = XCDR (found);
2087 GCPRO5 (definition, keymaps, maps, found, sequences);
2088 found = Qnil;
2089 sequences = Qnil;
2091 for (; !NILP (maps); maps = Fcdr (maps))
2093 /* Key sequence to reach map, and the map that it reaches */
2094 register Lisp_Object this, map;
2096 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2097 [M-CHAR] sequences, check if last character of the sequence
2098 is the meta-prefix char. */
2099 Lisp_Object last;
2100 int last_is_meta;
2102 this = Fcar (Fcar (maps));
2103 map = Fcdr (Fcar (maps));
2104 last = make_number (XINT (Flength (this)) - 1);
2105 last_is_meta = (XINT (last) >= 0
2106 && EQ (Faref (this, last), meta_prefix_char));
2108 if (nomenus && XINT (last) >= 0)
2109 { /* If no menu entries should be returned, skip over the
2110 keymaps bound to `menu-bar' and `tool-bar'. */
2111 Lisp_Object tem = Faref (this, make_number (0));
2112 if (EQ (tem, Qmenu_bar) || EQ (tem, Qtool_bar))
2113 continue;
2116 QUIT;
2118 while (CONSP (map))
2120 /* Because the code we want to run on each binding is rather
2121 large, we don't want to have two separate loop bodies for
2122 sparse keymap bindings and tables; we want to iterate one
2123 loop body over both keymap and vector bindings.
2125 For this reason, if Fcar (map) is a vector, we don't
2126 advance map to the next element until i indicates that we
2127 have finished off the vector. */
2128 Lisp_Object elt, key, binding;
2129 elt = XCAR (map);
2130 map = XCDR (map);
2132 sequences = Qnil;
2134 QUIT;
2136 /* Set key and binding to the current key and binding, and
2137 advance map and i to the next binding. */
2138 if (VECTORP (elt))
2140 Lisp_Object sequence;
2141 int i;
2142 /* In a vector, look at each element. */
2143 for (i = 0; i < XVECTOR (elt)->size; i++)
2145 binding = AREF (elt, i);
2146 XSETFASTINT (key, i);
2147 sequence = where_is_internal_1 (binding, key, definition,
2148 noindirect, this,
2149 last, nomenus, last_is_meta);
2150 if (!NILP (sequence))
2151 sequences = Fcons (sequence, sequences);
2154 else if (CHAR_TABLE_P (elt))
2156 Lisp_Object indices[3];
2157 Lisp_Object args;
2159 args = Fcons (Fcons (Fcons (definition, noindirect),
2160 Qnil), /* Result accumulator. */
2161 Fcons (Fcons (this, last),
2162 Fcons (make_number (nomenus),
2163 make_number (last_is_meta))));
2164 map_char_table (where_is_internal_2, Qnil, elt, args,
2165 0, indices);
2166 sequences = XCDR (XCAR (args));
2168 else if (CONSP (elt))
2170 Lisp_Object sequence;
2172 key = XCAR (elt);
2173 binding = XCDR (elt);
2175 sequence = where_is_internal_1 (binding, key, definition,
2176 noindirect, this,
2177 last, nomenus, last_is_meta);
2178 if (!NILP (sequence))
2179 sequences = Fcons (sequence, sequences);
2183 for (; ! NILP (sequences); sequences = XCDR (sequences))
2185 Lisp_Object sequence;
2187 sequence = XCAR (sequences);
2189 /* Verify that this key binding is not shadowed by another
2190 binding for the same key, before we say it exists.
2192 Mechanism: look for local definition of this key and if
2193 it is defined and does not match what we found then
2194 ignore this key.
2196 Either nil or number as value from Flookup_key
2197 means undefined. */
2198 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2199 continue;
2201 /* It is a true unshadowed match. Record it, unless it's already
2202 been seen (as could happen when inheriting keymaps). */
2203 if (NILP (Fmember (sequence, found)))
2204 found = Fcons (sequence, found);
2206 /* If firstonly is Qnon_ascii, then we can return the first
2207 binding we find. If firstonly is not Qnon_ascii but not
2208 nil, then we should return the first ascii-only binding
2209 we find. */
2210 if (EQ (firstonly, Qnon_ascii))
2211 RETURN_UNGCPRO (sequence);
2212 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
2213 RETURN_UNGCPRO (sequence);
2218 UNGCPRO;
2220 found = Fnreverse (found);
2222 /* firstonly may have been t, but we may have gone all the way through
2223 the keymaps without finding an all-ASCII key sequence. So just
2224 return the best we could find. */
2225 if (! NILP (firstonly))
2226 return Fcar (found);
2228 return found;
2231 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
2232 "Return list of keys that invoke DEFINITION.\n\
2233 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
2234 If KEYMAP is nil, search all the currently active keymaps.\n\
2235 If KEYMAP is a list of keymaps, search only those keymaps.\n\
2237 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
2238 rather than a list of all possible key sequences.\n\
2239 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
2240 no matter what it is.\n\
2241 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
2242 and entirely reject menu bindings.\n\
2244 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
2245 to other keymaps or slots. This makes it possible to search for an\n\
2246 indirect definition itself.")
2247 (definition, xkeymap, firstonly, noindirect)
2248 Lisp_Object definition, xkeymap;
2249 Lisp_Object firstonly, noindirect;
2251 Lisp_Object sequences, keymaps;
2252 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
2253 /* 1 means ignore all menu bindings entirely. */
2254 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2256 /* Find the relevant keymaps. */
2257 if (CONSP (xkeymap) && KEYMAPP (XCAR (xkeymap)))
2258 keymaps = xkeymap;
2259 else if (! NILP (xkeymap))
2260 keymaps = Fcons (xkeymap, Fcons (current_global_map, Qnil));
2261 else
2262 keymaps =
2263 Fdelq (Qnil,
2264 nconc2 (Fcurrent_minor_mode_maps (),
2265 Fcons (get_local_map (PT, current_buffer, keymap),
2266 Fcons (get_local_map (PT, current_buffer, local_map),
2267 Fcons (current_global_map, Qnil)))));
2269 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2270 We don't really need to check `xkeymap'. */
2271 if (nomenus && NILP (noindirect) && NILP (xkeymap))
2273 /* Check heuristic-consistency of the cache. */
2274 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2275 where_is_cache = Qnil;
2277 if (NILP (where_is_cache))
2279 /* We need to create the cache. */
2280 Lisp_Object args[2];
2281 where_is_cache = Fmake_hash_table (0, args);
2282 where_is_cache_keymaps = Qt;
2284 /* Fill in the cache. */
2285 GCPRO4 (definition, keymaps, firstonly, noindirect);
2286 where_is_internal (definition, keymaps, firstonly, noindirect);
2287 UNGCPRO;
2289 where_is_cache_keymaps = keymaps;
2292 sequences = Fgethash (definition, where_is_cache, Qnil);
2293 /* Verify that the key bindings are not shadowed. */
2294 /* key-binding can GC. */
2295 GCPRO3 (definition, sequences, keymaps);
2296 for (sequences = Fnreverse (sequences);
2297 CONSP (sequences);
2298 sequences = XCDR (sequences))
2299 if (EQ (shadow_lookup (keymaps, XCAR (sequences), Qnil), definition))
2300 RETURN_UNGCPRO (XCAR (sequences));
2301 RETURN_UNGCPRO (Qnil);
2303 else
2305 /* Kill the cache so that where_is_internal_1 doesn't think
2306 we're filling it up. */
2307 where_is_cache = Qnil;
2308 return where_is_internal (definition, keymaps, firstonly, noindirect);
2312 /* This is the function that Fwhere_is_internal calls using map_char_table.
2313 ARGS has the form
2314 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2316 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2317 Since map_char_table doesn't really use the return value from this function,
2318 we the result append to RESULT, the slot in ARGS.
2320 This function can GC because it calls where_is_internal_1 which can
2321 GC. */
2323 static void
2324 where_is_internal_2 (args, key, binding)
2325 Lisp_Object args, key, binding;
2327 Lisp_Object definition, noindirect, this, last;
2328 Lisp_Object result, sequence;
2329 int nomenus, last_is_meta;
2330 struct gcpro gcpro1, gcpro2, gcpro3;
2332 GCPRO3 (args, key, binding);
2333 result = XCDR (XCAR (args));
2334 definition = XCAR (XCAR (XCAR (args)));
2335 noindirect = XCDR (XCAR (XCAR (args)));
2336 this = XCAR (XCAR (XCDR (args)));
2337 last = XCDR (XCAR (XCDR (args)));
2338 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2339 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2341 sequence = where_is_internal_1 (binding, key, definition, noindirect,
2342 this, last, nomenus, last_is_meta);
2344 if (!NILP (sequence))
2345 XCDR (XCAR (args)) = Fcons (sequence, result);
2347 UNGCPRO;
2351 /* This function cannot GC. */
2353 static Lisp_Object
2354 where_is_internal_1 (binding, key, definition, noindirect, this, last,
2355 nomenus, last_is_meta)
2356 Lisp_Object binding, key, definition, noindirect, this, last;
2357 int nomenus, last_is_meta;
2359 Lisp_Object sequence;
2361 /* Skip left-over menu-items.
2362 These can appear in a keymap bound to a mouse click, for example. */
2363 if (nomenus && menu_item_p (binding))
2364 return Qnil;
2365 /* Search through indirections unless that's not wanted. */
2366 if (NILP (noindirect))
2367 binding = get_keyelt (binding, 0);
2369 /* End this iteration if this element does not match
2370 the target. */
2372 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2373 || EQ (binding, definition)
2374 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2375 /* Doesn't match. */
2376 return Qnil;
2378 /* We have found a match. Construct the key sequence where we found it. */
2379 if (INTEGERP (key) && last_is_meta)
2381 sequence = Fcopy_sequence (this);
2382 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2384 else
2385 sequence = append_key (this, key);
2387 if (!NILP (where_is_cache))
2389 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2390 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2391 return Qnil;
2393 else
2394 return sequence;
2397 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2399 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
2400 "Show a list of all defined keys, and their definitions.\n\
2401 We put that list in a buffer, and display the buffer.\n\
2403 The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
2404 \(Ordinarily these are omitted from the output.)\n\
2405 The optional argument PREFIX, if non-nil, should be a key sequence;\n\
2406 then we display only bindings that start with that prefix.")
2407 (menus, prefix)
2408 Lisp_Object menus, prefix;
2410 register Lisp_Object thisbuf;
2411 XSETBUFFER (thisbuf, current_buffer);
2412 internal_with_output_to_temp_buffer ("*Help*",
2413 describe_buffer_bindings,
2414 list3 (thisbuf, prefix, menus));
2415 return Qnil;
2418 /* ARG is (BUFFER PREFIX MENU-FLAG). */
2420 static Lisp_Object
2421 describe_buffer_bindings (arg)
2422 Lisp_Object arg;
2424 Lisp_Object descbuf, prefix, shadow;
2425 int nomenu;
2426 register Lisp_Object start1;
2427 struct gcpro gcpro1;
2429 char *alternate_heading
2430 = "\
2431 Keyboard translations:\n\n\
2432 You type Translation\n\
2433 -------- -----------\n";
2435 descbuf = XCAR (arg);
2436 arg = XCDR (arg);
2437 prefix = XCAR (arg);
2438 arg = XCDR (arg);
2439 nomenu = NILP (XCAR (arg));
2441 shadow = Qnil;
2442 GCPRO1 (shadow);
2444 Fset_buffer (Vstandard_output);
2446 /* Report on alternates for keys. */
2447 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
2449 int c;
2450 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
2451 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
2453 for (c = 0; c < translate_len; c++)
2454 if (translate[c] != c)
2456 char buf[KEY_DESCRIPTION_SIZE];
2457 char *bufend;
2459 if (alternate_heading)
2461 insert_string (alternate_heading);
2462 alternate_heading = 0;
2465 bufend = push_key_description (translate[c], buf);
2466 insert (buf, bufend - buf);
2467 Findent_to (make_number (16), make_number (1));
2468 bufend = push_key_description (c, buf);
2469 insert (buf, bufend - buf);
2471 insert ("\n", 1);
2474 insert ("\n", 1);
2477 if (!NILP (Vkey_translation_map))
2478 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2479 "Key translations", nomenu, 1, 0);
2482 int i, nmaps;
2483 Lisp_Object *modes, *maps;
2485 /* Temporarily switch to descbuf, so that we can get that buffer's
2486 minor modes correctly. */
2487 Fset_buffer (descbuf);
2489 if (!NILP (current_kboard->Voverriding_terminal_local_map)
2490 || !NILP (Voverriding_local_map))
2491 nmaps = 0;
2492 else
2493 nmaps = current_minor_maps (&modes, &maps);
2494 Fset_buffer (Vstandard_output);
2496 /* Print the minor mode maps. */
2497 for (i = 0; i < nmaps; i++)
2499 /* The title for a minor mode keymap
2500 is constructed at run time.
2501 We let describe_map_tree do the actual insertion
2502 because it takes care of other features when doing so. */
2503 char *title, *p;
2505 if (!SYMBOLP (modes[i]))
2506 abort();
2508 p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size);
2509 *p++ = '\f';
2510 *p++ = '\n';
2511 *p++ = '`';
2512 bcopy (XSYMBOL (modes[i])->name->data, p,
2513 XSYMBOL (modes[i])->name->size);
2514 p += XSYMBOL (modes[i])->name->size;
2515 *p++ = '\'';
2516 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
2517 p += sizeof (" Minor Mode Bindings") - 1;
2518 *p = 0;
2520 describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
2521 shadow = Fcons (maps[i], shadow);
2525 /* Print the (major mode) local map. */
2526 if (!NILP (current_kboard->Voverriding_terminal_local_map))
2527 start1 = current_kboard->Voverriding_terminal_local_map;
2528 else if (!NILP (Voverriding_local_map))
2529 start1 = Voverriding_local_map;
2530 else
2531 start1 = XBUFFER (descbuf)->keymap;
2533 if (!NILP (start1))
2535 describe_map_tree (start1, 1, shadow, prefix,
2536 "\f\nMajor Mode Bindings", nomenu, 0, 0);
2537 shadow = Fcons (start1, shadow);
2540 describe_map_tree (current_global_map, 1, shadow, prefix,
2541 "\f\nGlobal Bindings", nomenu, 0, 1);
2543 /* Print the function-key-map translations under this prefix. */
2544 if (!NILP (Vfunction_key_map))
2545 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
2546 "\f\nFunction key map translations", nomenu, 1, 0);
2548 call0 (intern ("help-mode"));
2549 Fset_buffer (descbuf);
2550 UNGCPRO;
2551 return Qnil;
2554 /* Insert a description of the key bindings in STARTMAP,
2555 followed by those of all maps reachable through STARTMAP.
2556 If PARTIAL is nonzero, omit certain "uninteresting" commands
2557 (such as `undefined').
2558 If SHADOW is non-nil, it is a list of maps;
2559 don't mention keys which would be shadowed by any of them.
2560 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2561 TITLE, if not 0, is a string to insert at the beginning.
2562 TITLE should not end with a colon or a newline; we supply that.
2563 If NOMENU is not 0, then omit menu-bar commands.
2565 If TRANSL is nonzero, the definitions are actually key translations
2566 so print strings and vectors differently.
2568 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2569 to look through. */
2571 void
2572 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
2573 always_title)
2574 Lisp_Object startmap, shadow, prefix;
2575 int partial;
2576 char *title;
2577 int nomenu;
2578 int transl;
2579 int always_title;
2581 Lisp_Object maps, orig_maps, seen, sub_shadows;
2582 struct gcpro gcpro1, gcpro2, gcpro3;
2583 int something = 0;
2584 char *key_heading
2585 = "\
2586 key binding\n\
2587 --- -------\n";
2589 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
2590 seen = Qnil;
2591 sub_shadows = Qnil;
2592 GCPRO3 (maps, seen, sub_shadows);
2594 if (nomenu)
2596 Lisp_Object list;
2598 /* Delete from MAPS each element that is for the menu bar. */
2599 for (list = maps; !NILP (list); list = XCDR (list))
2601 Lisp_Object elt, prefix, tem;
2603 elt = Fcar (list);
2604 prefix = Fcar (elt);
2605 if (XVECTOR (prefix)->size >= 1)
2607 tem = Faref (prefix, make_number (0));
2608 if (EQ (tem, Qmenu_bar))
2609 maps = Fdelq (elt, maps);
2614 if (!NILP (maps) || always_title)
2616 if (title)
2618 insert_string (title);
2619 if (!NILP (prefix))
2621 insert_string (" Starting With ");
2622 insert1 (Fkey_description (prefix));
2624 insert_string (":\n");
2626 insert_string (key_heading);
2627 something = 1;
2630 for (; !NILP (maps); maps = Fcdr (maps))
2632 register Lisp_Object elt, prefix, tail;
2634 elt = Fcar (maps);
2635 prefix = Fcar (elt);
2637 sub_shadows = Qnil;
2639 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2641 Lisp_Object shmap;
2643 shmap = XCAR (tail);
2645 /* If the sequence by which we reach this keymap is zero-length,
2646 then the shadow map for this keymap is just SHADOW. */
2647 if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
2648 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
2650 /* If the sequence by which we reach this keymap actually has
2651 some elements, then the sequence's definition in SHADOW is
2652 what we should use. */
2653 else
2655 shmap = Flookup_key (shmap, Fcar (elt), Qt);
2656 if (INTEGERP (shmap))
2657 shmap = Qnil;
2660 /* If shmap is not nil and not a keymap,
2661 it completely shadows this map, so don't
2662 describe this map at all. */
2663 if (!NILP (shmap) && !KEYMAPP (shmap))
2664 goto skip;
2666 if (!NILP (shmap))
2667 sub_shadows = Fcons (shmap, sub_shadows);
2670 /* Maps we have already listed in this loop shadow this map. */
2671 for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
2673 Lisp_Object tem;
2674 tem = Fequal (Fcar (XCAR (tail)), prefix);
2675 if (! NILP (tem))
2676 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
2679 describe_map (Fcdr (elt), prefix,
2680 transl ? describe_translation : describe_command,
2681 partial, sub_shadows, &seen, nomenu);
2683 skip: ;
2686 if (something)
2687 insert_string ("\n");
2689 UNGCPRO;
2692 static int previous_description_column;
2694 static void
2695 describe_command (definition)
2696 Lisp_Object definition;
2698 register Lisp_Object tem1;
2699 int column = current_column ();
2700 int description_column;
2702 /* If column 16 is no good, go to col 32;
2703 but don't push beyond that--go to next line instead. */
2704 if (column > 30)
2706 insert_char ('\n');
2707 description_column = 32;
2709 else if (column > 14 || (column > 10 && previous_description_column == 32))
2710 description_column = 32;
2711 else
2712 description_column = 16;
2714 Findent_to (make_number (description_column), make_number (1));
2715 previous_description_column = description_column;
2717 if (SYMBOLP (definition))
2719 XSETSTRING (tem1, XSYMBOL (definition)->name);
2720 insert1 (tem1);
2721 insert_string ("\n");
2723 else if (STRINGP (definition) || VECTORP (definition))
2724 insert_string ("Keyboard Macro\n");
2725 else if (KEYMAPP (definition))
2726 insert_string ("Prefix Command\n");
2727 else
2728 insert_string ("??\n");
2731 static void
2732 describe_translation (definition)
2733 Lisp_Object definition;
2735 register Lisp_Object tem1;
2737 Findent_to (make_number (16), make_number (1));
2739 if (SYMBOLP (definition))
2741 XSETSTRING (tem1, XSYMBOL (definition)->name);
2742 insert1 (tem1);
2743 insert_string ("\n");
2745 else if (STRINGP (definition) || VECTORP (definition))
2747 insert1 (Fkey_description (definition));
2748 insert_string ("\n");
2750 else if (KEYMAPP (definition))
2751 insert_string ("Prefix Command\n");
2752 else
2753 insert_string ("??\n");
2756 /* Describe the contents of map MAP, assuming that this map itself is
2757 reached by the sequence of prefix keys KEYS (a string or vector).
2758 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2760 static void
2761 describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
2762 register Lisp_Object map;
2763 Lisp_Object keys;
2764 void (*elt_describer) P_ ((Lisp_Object));
2765 int partial;
2766 Lisp_Object shadow;
2767 Lisp_Object *seen;
2768 int nomenu;
2770 Lisp_Object elt_prefix;
2771 Lisp_Object tail, definition, event;
2772 Lisp_Object tem;
2773 Lisp_Object suppress;
2774 Lisp_Object kludge;
2775 int first = 1;
2776 struct gcpro gcpro1, gcpro2, gcpro3;
2778 suppress = Qnil;
2780 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2782 /* Call Fkey_description first, to avoid GC bug for the other string. */
2783 tem = Fkey_description (keys);
2784 elt_prefix = concat2 (tem, build_string (" "));
2786 else
2787 elt_prefix = Qnil;
2789 if (partial)
2790 suppress = intern ("suppress-keymap");
2792 /* This vector gets used to present single keys to Flookup_key. Since
2793 that is done once per keymap element, we don't want to cons up a
2794 fresh vector every time. */
2795 kludge = Fmake_vector (make_number (1), Qnil);
2796 definition = Qnil;
2798 GCPRO3 (elt_prefix, definition, kludge);
2800 for (tail = map; CONSP (tail); tail = XCDR (tail))
2802 QUIT;
2804 if (VECTORP (XCAR (tail))
2805 || CHAR_TABLE_P (XCAR (tail)))
2806 describe_vector (XCAR (tail),
2807 elt_prefix, elt_describer, partial, shadow, map,
2808 (int *)0, 0);
2809 else if (CONSP (XCAR (tail)))
2811 event = XCAR (XCAR (tail));
2813 /* Ignore bindings whose "keys" are not really valid events.
2814 (We get these in the frames and buffers menu.) */
2815 if (! (SYMBOLP (event) || INTEGERP (event)))
2816 continue;
2818 if (nomenu && EQ (event, Qmenu_bar))
2819 continue;
2821 definition = get_keyelt (XCDR (XCAR (tail)), 0);
2823 /* Don't show undefined commands or suppressed commands. */
2824 if (NILP (definition)) continue;
2825 if (SYMBOLP (definition) && partial)
2827 tem = Fget (definition, suppress);
2828 if (!NILP (tem))
2829 continue;
2832 /* Don't show a command that isn't really visible
2833 because a local definition of the same key shadows it. */
2835 ASET (kludge, 0, event);
2836 if (!NILP (shadow))
2838 tem = shadow_lookup (shadow, kludge, Qt);
2839 if (!NILP (tem)) continue;
2842 tem = Flookup_key (map, kludge, Qt);
2843 if (! EQ (tem, definition)) continue;
2845 if (first)
2847 previous_description_column = 0;
2848 insert ("\n", 1);
2849 first = 0;
2852 if (!NILP (elt_prefix))
2853 insert1 (elt_prefix);
2855 /* THIS gets the string to describe the character EVENT. */
2856 insert1 (Fsingle_key_description (event, Qnil));
2858 /* Print a description of the definition of this character.
2859 elt_describer will take care of spacing out far enough
2860 for alignment purposes. */
2861 (*elt_describer) (definition);
2863 else if (EQ (XCAR (tail), Qkeymap))
2865 /* The same keymap might be in the structure twice, if we're
2866 using an inherited keymap. So skip anything we've already
2867 encountered. */
2868 tem = Fassq (tail, *seen);
2869 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
2870 break;
2871 *seen = Fcons (Fcons (tail, keys), *seen);
2875 UNGCPRO;
2878 static void
2879 describe_vector_princ (elt)
2880 Lisp_Object elt;
2882 Findent_to (make_number (16), make_number (1));
2883 Fprinc (elt, Qnil);
2884 Fterpri (Qnil);
2887 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2888 "Insert a description of contents of VECTOR.\n\
2889 This is text showing the elements of vector matched against indices.")
2890 (vector)
2891 Lisp_Object vector;
2893 int count = specpdl_ptr - specpdl;
2895 specbind (Qstandard_output, Fcurrent_buffer ());
2896 CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
2897 describe_vector (vector, Qnil, describe_vector_princ, 0,
2898 Qnil, Qnil, (int *)0, 0);
2900 return unbind_to (count, Qnil);
2903 /* Insert in the current buffer a description of the contents of VECTOR.
2904 We call ELT_DESCRIBER to insert the description of one value found
2905 in VECTOR.
2907 ELT_PREFIX describes what "comes before" the keys or indices defined
2908 by this vector. This is a human-readable string whose size
2909 is not necessarily related to the situation.
2911 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2912 leads to this keymap.
2914 If the vector is a chartable, ELT_PREFIX is the vector
2915 of bytes that lead to the character set or portion of a character
2916 set described by this chartable.
2918 If PARTIAL is nonzero, it means do not mention suppressed commands
2919 (that assumes the vector is in a keymap).
2921 SHADOW is a list of keymaps that shadow this map.
2922 If it is non-nil, then we look up the key in those maps
2923 and we don't mention it now if it is defined by any of them.
2925 ENTIRE_MAP is the keymap in which this vector appears.
2926 If the definition in effect in the whole map does not match
2927 the one in this vector, we ignore this one.
2929 When describing a sub-char-table, INDICES is a list of
2930 indices at higher levels in this char-table,
2931 and CHAR_TABLE_DEPTH says how many levels down we have gone. */
2933 void
2934 describe_vector (vector, elt_prefix, elt_describer,
2935 partial, shadow, entire_map,
2936 indices, char_table_depth)
2937 register Lisp_Object vector;
2938 Lisp_Object elt_prefix;
2939 void (*elt_describer) P_ ((Lisp_Object));
2940 int partial;
2941 Lisp_Object shadow;
2942 Lisp_Object entire_map;
2943 int *indices;
2944 int char_table_depth;
2946 Lisp_Object definition;
2947 Lisp_Object tem2;
2948 register int i;
2949 Lisp_Object suppress;
2950 Lisp_Object kludge;
2951 int first = 1;
2952 struct gcpro gcpro1, gcpro2, gcpro3;
2953 /* Range of elements to be handled. */
2954 int from, to;
2955 /* A flag to tell if a leaf in this level of char-table is not a
2956 generic character (i.e. a complete multibyte character). */
2957 int complete_char;
2958 int character;
2959 int starting_i;
2961 suppress = Qnil;
2963 if (indices == 0)
2964 indices = (int *) alloca (3 * sizeof (int));
2966 definition = Qnil;
2968 /* This vector gets used to present single keys to Flookup_key. Since
2969 that is done once per vector element, we don't want to cons up a
2970 fresh vector every time. */
2971 kludge = Fmake_vector (make_number (1), Qnil);
2972 GCPRO3 (elt_prefix, definition, kludge);
2974 if (partial)
2975 suppress = intern ("suppress-keymap");
2977 if (CHAR_TABLE_P (vector))
2979 if (char_table_depth == 0)
2981 /* VECTOR is a top level char-table. */
2982 complete_char = 1;
2983 from = 0;
2984 to = CHAR_TABLE_ORDINARY_SLOTS;
2986 else
2988 /* VECTOR is a sub char-table. */
2989 if (char_table_depth >= 3)
2990 /* A char-table is never that deep. */
2991 error ("Too deep char table");
2993 complete_char
2994 = (CHARSET_VALID_P (indices[0])
2995 && ((CHARSET_DIMENSION (indices[0]) == 1
2996 && char_table_depth == 1)
2997 || char_table_depth == 2));
2999 /* Meaningful elements are from 32th to 127th. */
3000 from = 32;
3001 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3004 else
3006 /* This does the right thing for ordinary vectors. */
3008 complete_char = 1;
3009 from = 0;
3010 to = XVECTOR (vector)->size;
3013 for (i = from; i < to; i++)
3015 QUIT;
3017 if (CHAR_TABLE_P (vector))
3019 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3020 complete_char = 0;
3022 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3023 && !CHARSET_DEFINED_P (i - 128))
3024 continue;
3026 definition
3027 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3029 else
3030 definition = get_keyelt (AREF (vector, i), 0);
3032 if (NILP (definition)) continue;
3034 /* Don't mention suppressed commands. */
3035 if (SYMBOLP (definition) && partial)
3037 Lisp_Object tem;
3039 tem = Fget (definition, suppress);
3041 if (!NILP (tem)) continue;
3044 /* Set CHARACTER to the character this entry describes, if any.
3045 Also update *INDICES. */
3046 if (CHAR_TABLE_P (vector))
3048 indices[char_table_depth] = i;
3050 if (char_table_depth == 0)
3052 character = i;
3053 indices[0] = i - 128;
3055 else if (complete_char)
3057 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3059 else
3060 character = 0;
3062 else
3063 character = i;
3065 /* If this binding is shadowed by some other map, ignore it. */
3066 if (!NILP (shadow) && complete_char)
3068 Lisp_Object tem;
3070 ASET (kludge, 0, make_number (character));
3071 tem = shadow_lookup (shadow, kludge, Qt);
3073 if (!NILP (tem)) continue;
3076 /* Ignore this definition if it is shadowed by an earlier
3077 one in the same keymap. */
3078 if (!NILP (entire_map) && complete_char)
3080 Lisp_Object tem;
3082 ASET (kludge, 0, make_number (character));
3083 tem = Flookup_key (entire_map, kludge, Qt);
3085 if (! EQ (tem, definition))
3086 continue;
3089 if (first)
3091 if (char_table_depth == 0)
3092 insert ("\n", 1);
3093 first = 0;
3096 /* For a sub char-table, show the depth by indentation.
3097 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3098 if (char_table_depth > 0)
3099 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3101 /* Output the prefix that applies to every entry in this map. */
3102 if (!NILP (elt_prefix))
3103 insert1 (elt_prefix);
3105 /* Insert or describe the character this slot is for,
3106 or a description of what it is for. */
3107 if (SUB_CHAR_TABLE_P (vector))
3109 if (complete_char)
3110 insert_char (character);
3111 else
3113 /* We need an octal representation for this block of
3114 characters. */
3115 char work[16];
3116 sprintf (work, "(row %d)", i);
3117 insert (work, strlen (work));
3120 else if (CHAR_TABLE_P (vector))
3122 if (complete_char)
3123 insert1 (Fsingle_key_description (make_number (character), Qnil));
3124 else
3126 /* Print the information for this character set. */
3127 insert_string ("<");
3128 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3129 if (STRINGP (tem2))
3130 insert_from_string (tem2, 0, 0, XSTRING (tem2)->size,
3131 STRING_BYTES (XSTRING (tem2)), 0);
3132 else
3133 insert ("?", 1);
3134 insert (">", 1);
3137 else
3139 insert1 (Fsingle_key_description (make_number (character), Qnil));
3142 /* If we find a sub char-table within a char-table,
3143 scan it recursively; it defines the details for
3144 a character set or a portion of a character set. */
3145 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3147 insert ("\n", 1);
3148 describe_vector (definition, elt_prefix, elt_describer,
3149 partial, shadow, entire_map,
3150 indices, char_table_depth + 1);
3151 continue;
3154 starting_i = i;
3156 /* Find all consecutive characters or rows that have the same
3157 definition. But, for elements of a top level char table, if
3158 they are for charsets, we had better describe one by one even
3159 if they have the same definition. */
3160 if (CHAR_TABLE_P (vector))
3162 int limit = to;
3164 if (char_table_depth == 0)
3165 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3167 while (i + 1 < limit
3168 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3169 !NILP (tem2))
3170 && !NILP (Fequal (tem2, definition)))
3171 i++;
3173 else
3174 while (i + 1 < to
3175 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3176 !NILP (tem2))
3177 && !NILP (Fequal (tem2, definition)))
3178 i++;
3181 /* If we have a range of more than one character,
3182 print where the range reaches to. */
3184 if (i != starting_i)
3186 insert (" .. ", 4);
3188 if (!NILP (elt_prefix))
3189 insert1 (elt_prefix);
3191 if (CHAR_TABLE_P (vector))
3193 if (char_table_depth == 0)
3195 insert1 (Fsingle_key_description (make_number (i), Qnil));
3197 else if (complete_char)
3199 indices[char_table_depth] = i;
3200 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3201 insert_char (character);
3203 else
3205 /* We need an octal representation for this block of
3206 characters. */
3207 char work[16];
3208 sprintf (work, "(row %d)", i);
3209 insert (work, strlen (work));
3212 else
3214 insert1 (Fsingle_key_description (make_number (i), Qnil));
3218 /* Print a description of the definition of this character.
3219 elt_describer will take care of spacing out far enough
3220 for alignment purposes. */
3221 (*elt_describer) (definition);
3224 /* For (sub) char-table, print `defalt' slot at last. */
3225 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3227 insert (" ", char_table_depth * 2);
3228 insert_string ("<<default>>");
3229 (*elt_describer) (XCHAR_TABLE (vector)->defalt);
3232 UNGCPRO;
3235 /* Apropos - finding all symbols whose names match a regexp. */
3236 Lisp_Object apropos_predicate;
3237 Lisp_Object apropos_accumulate;
3239 static void
3240 apropos_accum (symbol, string)
3241 Lisp_Object symbol, string;
3243 register Lisp_Object tem;
3245 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3246 if (!NILP (tem) && !NILP (apropos_predicate))
3247 tem = call1 (apropos_predicate, symbol);
3248 if (!NILP (tem))
3249 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3252 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3253 "Show all symbols whose names contain match for REGEXP.\n\
3254 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
3255 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
3256 Return list of symbols found.")
3257 (regexp, predicate)
3258 Lisp_Object regexp, predicate;
3260 struct gcpro gcpro1, gcpro2;
3261 CHECK_STRING (regexp, 0);
3262 apropos_predicate = predicate;
3263 GCPRO2 (apropos_predicate, apropos_accumulate);
3264 apropos_accumulate = Qnil;
3265 map_obarray (Vobarray, apropos_accum, regexp);
3266 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
3267 UNGCPRO;
3268 return apropos_accumulate;
3271 void
3272 syms_of_keymap ()
3274 Qkeymap = intern ("keymap");
3275 staticpro (&Qkeymap);
3277 /* Now we are ready to set up this property, so we can
3278 create char tables. */
3279 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3281 /* Initialize the keymaps standardly used.
3282 Each one is the value of a Lisp variable, and is also
3283 pointed to by a C variable */
3285 global_map = Fmake_keymap (Qnil);
3286 Fset (intern ("global-map"), global_map);
3288 current_global_map = global_map;
3289 staticpro (&global_map);
3290 staticpro (&current_global_map);
3292 meta_map = Fmake_keymap (Qnil);
3293 Fset (intern ("esc-map"), meta_map);
3294 Ffset (intern ("ESC-prefix"), meta_map);
3296 control_x_map = Fmake_keymap (Qnil);
3297 Fset (intern ("ctl-x-map"), control_x_map);
3298 Ffset (intern ("Control-X-prefix"), control_x_map);
3300 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3301 "List of commands given new key bindings recently.\n\
3302 This is used for internal purposes during Emacs startup;\n\
3303 don't alter it yourself.");
3304 Vdefine_key_rebound_commands = Qt;
3306 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3307 "Default keymap to use when reading from the minibuffer.");
3308 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3310 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3311 "Local keymap for the minibuffer when spaces are not allowed.");
3312 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3314 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3315 "Local keymap for minibuffer input with completion.");
3316 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3318 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
3319 "Local keymap for minibuffer input with completion, for exact match.");
3320 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3322 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
3323 "Alist of keymaps to use for minor modes.\n\
3324 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
3325 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
3326 If two active keymaps bind the same key, the keymap appearing earlier\n\
3327 in the list takes precedence.");
3328 Vminor_mode_map_alist = Qnil;
3330 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
3331 "Alist of keymaps to use for minor modes, in current major mode.\n\
3332 This variable is a alist just like `minor-mode-map-alist', and it is\n\
3333 used the same way (and before `minor-mode-map-alist'); however,\n\
3334 it is provided for major modes to bind locally.");
3335 Vminor_mode_overriding_map_alist = Qnil;
3337 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
3338 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
3339 This allows Emacs to recognize function keys sent from ASCII\n\
3340 terminals at any point in a key sequence.\n\
3342 The `read-key-sequence' function replaces any subsequence bound by\n\
3343 `function-key-map' with its binding. More precisely, when the active\n\
3344 keymaps have no binding for the current key sequence but\n\
3345 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
3346 `read-key-sequence' replaces the matching suffix with its binding, and\n\
3347 continues with the new sequence.\n\
3349 The events that come from bindings in `function-key-map' are not\n\
3350 themselves looked up in `function-key-map'.\n\
3352 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
3353 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
3354 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
3355 key, typing `ESC O P x' would return [f1 x].");
3356 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
3358 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
3359 "Keymap of key translations that can override keymaps.\n\
3360 This keymap works like `function-key-map', but comes after that,\n\
3361 and applies even for keys that have ordinary bindings.");
3362 Vkey_translation_map = Qnil;
3364 Qsingle_key_description = intern ("single-key-description");
3365 staticpro (&Qsingle_key_description);
3367 Qkey_description = intern ("key-description");
3368 staticpro (&Qkey_description);
3370 Qkeymapp = intern ("keymapp");
3371 staticpro (&Qkeymapp);
3373 Qnon_ascii = intern ("non-ascii");
3374 staticpro (&Qnon_ascii);
3376 Qmenu_item = intern ("menu-item");
3377 staticpro (&Qmenu_item);
3379 where_is_cache_keymaps = Qt;
3380 where_is_cache = Qnil;
3381 staticpro (&where_is_cache);
3382 staticpro (&where_is_cache_keymaps);
3384 defsubr (&Skeymapp);
3385 defsubr (&Skeymap_parent);
3386 defsubr (&Sset_keymap_parent);
3387 defsubr (&Smake_keymap);
3388 defsubr (&Smake_sparse_keymap);
3389 defsubr (&Scopy_keymap);
3390 defsubr (&Skey_binding);
3391 defsubr (&Slocal_key_binding);
3392 defsubr (&Sglobal_key_binding);
3393 defsubr (&Sminor_mode_key_binding);
3394 defsubr (&Sdefine_key);
3395 defsubr (&Slookup_key);
3396 defsubr (&Sdefine_prefix_command);
3397 defsubr (&Suse_global_map);
3398 defsubr (&Suse_local_map);
3399 defsubr (&Scurrent_local_map);
3400 defsubr (&Scurrent_global_map);
3401 defsubr (&Scurrent_minor_mode_maps);
3402 defsubr (&Saccessible_keymaps);
3403 defsubr (&Skey_description);
3404 defsubr (&Sdescribe_vector);
3405 defsubr (&Ssingle_key_description);
3406 defsubr (&Stext_char_description);
3407 defsubr (&Swhere_is_internal);
3408 defsubr (&Sdescribe_bindings_internal);
3409 defsubr (&Sapropos_internal);
3412 void
3413 keys_of_keymap ()
3415 initial_define_key (global_map, 033, "ESC-prefix");
3416 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");