(esc-map): Change ; to comment-dwim and use the new function
[emacs.git] / src / keymap.c
blob2a6114907f9c05232113a086315cec7f2c0872f2
1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 2, or (at your option)
9 any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
22 #include <config.h>
23 #include <stdio.h>
24 #undef NULL
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"
34 #define min(a, b) ((a) < (b) ? (a) : (b))
36 /* The number of elements in keymap vectors. */
37 #define DENSE_TABLE_SIZE (0200)
39 /* Actually allocate storage for these variables */
41 Lisp_Object current_global_map; /* Current global keymap */
43 Lisp_Object global_map; /* default global key bindings */
45 Lisp_Object meta_map; /* The keymap used for globally bound
46 ESC-prefixed default commands */
48 Lisp_Object control_x_map; /* The keymap used for globally bound
49 C-x-prefixed default commands */
51 /* was MinibufLocalMap */
52 Lisp_Object Vminibuffer_local_map;
53 /* The keymap used by the minibuf for local
54 bindings when spaces are allowed in the
55 minibuf */
57 /* was MinibufLocalNSMap */
58 Lisp_Object Vminibuffer_local_ns_map;
59 /* The keymap used by the minibuf for local
60 bindings when spaces are not encouraged
61 in the minibuf */
63 /* keymap used for minibuffers when doing completion */
64 /* was MinibufLocalCompletionMap */
65 Lisp_Object Vminibuffer_local_completion_map;
67 /* keymap used for minibuffers when doing completion and require a match */
68 /* was MinibufLocalMustMatchMap */
69 Lisp_Object Vminibuffer_local_must_match_map;
71 /* Alist of minor mode variables and keymaps. */
72 Lisp_Object Vminor_mode_map_alist;
74 /* Alist of major-mode-specific overrides for
75 minor mode variables and keymaps. */
76 Lisp_Object Vminor_mode_overriding_map_alist;
78 /* Keymap mapping ASCII function key sequences onto their preferred forms.
79 Initialized by the terminal-specific lisp files. See DEFVAR for more
80 documentation. */
81 Lisp_Object Vfunction_key_map;
83 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
84 Lisp_Object Vkey_translation_map;
86 /* A list of all commands given new bindings since a certain time
87 when nil was stored here.
88 This is used to speed up recomputation of menu key equivalents
89 when Emacs starts up. t means don't record anything here. */
90 Lisp_Object Vdefine_key_rebound_commands;
92 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
94 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
95 in a string key sequence is equivalent to prefixing with this
96 character. */
97 extern Lisp_Object meta_prefix_char;
99 extern Lisp_Object Voverriding_local_map;
101 static Lisp_Object define_as_prefix ();
102 static Lisp_Object describe_buffer_bindings ();
103 static void describe_command (), describe_translation ();
104 static void describe_map ();
106 /* Keymap object support - constructors and predicates. */
108 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
109 "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
110 CHARTABLE is a char-table that holds the bindings for the ASCII\n\
111 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
112 mouse events, and any other things that appear in the input stream.\n\
113 All entries in it are initially nil, meaning \"command undefined\".\n\n\
114 The optional arg STRING supplies a menu name for the keymap\n\
115 in case you use it as a menu with `x-popup-menu'.")
116 (string)
117 Lisp_Object string;
119 Lisp_Object tail;
120 if (!NILP (string))
121 tail = Fcons (string, Qnil);
122 else
123 tail = Qnil;
124 return Fcons (Qkeymap,
125 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
128 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
129 "Construct and return a new sparse-keymap list.\n\
130 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
131 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
132 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
133 Initially the alist is nil.\n\n\
134 The optional arg STRING supplies a menu name for the keymap\n\
135 in case you use it as a menu with `x-popup-menu'.")
136 (string)
137 Lisp_Object string;
139 if (!NILP (string))
140 return Fcons (Qkeymap, Fcons (string, Qnil));
141 return Fcons (Qkeymap, Qnil);
144 /* This function is used for installing the standard key bindings
145 at initialization time.
147 For example:
149 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
151 void
152 initial_define_key (keymap, key, defname)
153 Lisp_Object keymap;
154 int key;
155 char *defname;
157 store_in_keymap (keymap, make_number (key), intern (defname));
160 void
161 initial_define_lispy_key (keymap, keyname, defname)
162 Lisp_Object keymap;
163 char *keyname;
164 char *defname;
166 store_in_keymap (keymap, intern (keyname), intern (defname));
169 /* Define character fromchar in map frommap as an alias for character
170 tochar in map tomap. Subsequent redefinitions of the latter WILL
171 affect the former. */
173 #if 0
174 void
175 synkey (frommap, fromchar, tomap, tochar)
176 struct Lisp_Vector *frommap, *tomap;
177 int fromchar, tochar;
179 Lisp_Object v, c;
180 XSETVECTOR (v, tomap);
181 XSETFASTINT (c, tochar);
182 frommap->contents[fromchar] = Fcons (v, c);
184 #endif /* 0 */
186 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
187 "Return t if OBJECT is a keymap.\n\
189 A keymap is a list (keymap . ALIST),\n\
190 or a symbol whose function definition is itself a keymap.\n\
191 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
192 a vector of densely packed bindings for small character codes\n\
193 is also allowed as an element.")
194 (object)
195 Lisp_Object object;
197 return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
200 /* Check that OBJECT is a keymap (after dereferencing through any
201 symbols). If it is, return it.
203 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
204 is an autoload form, do the autoload and try again.
205 If AUTOLOAD is nonzero, callers must assume GC is possible.
207 ERROR controls how we respond if OBJECT isn't a keymap.
208 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
210 Note that most of the time, we don't want to pursue autoloads.
211 Functions like Faccessible_keymaps which scan entire keymap trees
212 shouldn't load every autoloaded keymap. I'm not sure about this,
213 but it seems to me that only read_key_sequence, Flookup_key, and
214 Fdefine_key should cause keymaps to be autoloaded. */
216 Lisp_Object
217 get_keymap_1 (object, error, autoload)
218 Lisp_Object object;
219 int error, autoload;
221 Lisp_Object tem;
223 autoload_retry:
224 if (NILP (object))
225 goto end;
226 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
227 return object;
228 else
230 tem = indirect_function (object);
231 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
232 return tem;
235 /* Should we do an autoload? Autoload forms for keymaps have
236 Qkeymap as their fifth element. */
237 if (autoload
238 && SYMBOLP (object)
239 && CONSP (tem)
240 && EQ (XCAR (tem), Qautoload))
242 Lisp_Object tail;
244 tail = Fnth (make_number (4), tem);
245 if (EQ (tail, Qkeymap))
247 struct gcpro gcpro1, gcpro2;
249 GCPRO2 (tem, object);
250 do_autoload (tem, object);
251 UNGCPRO;
253 goto autoload_retry;
257 end:
258 if (error)
259 wrong_type_argument (Qkeymapp, object);
260 else
261 return Qnil;
265 /* Follow any symbol chaining, and return the keymap denoted by OBJECT.
266 If OBJECT doesn't denote a keymap at all, signal an error. */
267 Lisp_Object
268 get_keymap (object)
269 Lisp_Object object;
271 return get_keymap_1 (object, 1, 0);
274 /* Return the parent map of the keymap MAP, or nil if it has none.
275 We assume that MAP is a valid keymap. */
277 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
278 "Return the parent keymap of KEYMAP.")
279 (keymap)
280 Lisp_Object keymap;
282 Lisp_Object list;
284 keymap = get_keymap_1 (keymap, 1, 1);
286 /* Skip past the initial element `keymap'. */
287 list = XCDR (keymap);
288 for (; CONSP (list); list = XCDR (list))
290 /* See if there is another `keymap'. */
291 if (EQ (Qkeymap, XCAR (list)))
292 return list;
295 return Qnil;
298 /* Set the parent keymap of MAP to PARENT. */
300 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
301 "Modify KEYMAP to set its parent map to PARENT.\n\
302 PARENT should be nil or another keymap.")
303 (keymap, parent)
304 Lisp_Object keymap, parent;
306 Lisp_Object list, prev;
307 int i;
309 keymap = get_keymap_1 (keymap, 1, 1);
310 if (!NILP (parent))
311 parent = get_keymap_1 (parent, 1, 1);
313 /* Skip past the initial element `keymap'. */
314 prev = keymap;
315 while (1)
317 list = XCDR (prev);
318 /* If there is a parent keymap here, replace it.
319 If we came to the end, add the parent in PREV. */
320 if (! CONSP (list) || EQ (Qkeymap, XCAR (list)))
322 /* If we already have the right parent, return now
323 so that we avoid the loops below. */
324 if (EQ (XCDR (prev), parent))
325 return parent;
327 XCDR (prev) = parent;
328 break;
330 prev = list;
333 /* Scan through for submaps, and set their parents too. */
335 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
337 /* Stop the scan when we come to the parent. */
338 if (EQ (XCAR (list), Qkeymap))
339 break;
341 /* If this element holds a prefix map, deal with it. */
342 if (CONSP (XCAR (list))
343 && CONSP (XCDR (XCAR (list))))
344 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
345 XCDR (XCAR (list)));
347 if (VECTORP (XCAR (list)))
348 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
349 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
350 fix_submap_inheritance (keymap, make_number (i),
351 XVECTOR (XCAR (list))->contents[i]);
353 if (CHAR_TABLE_P (XCAR (list)))
355 Lisp_Object indices[3];
357 map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
358 keymap, 0, indices);
362 return parent;
365 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
366 if EVENT is also a prefix in MAP's parent,
367 make sure that SUBMAP inherits that definition as its own parent. */
369 void
370 fix_submap_inheritance (map, event, submap)
371 Lisp_Object map, event, submap;
373 Lisp_Object map_parent, parent_entry;
375 /* SUBMAP is a cons that we found as a key binding.
376 Discard the other things found in a menu key binding. */
378 if (CONSP (submap))
380 /* May be an old format menu item */
381 if (STRINGP (XCAR (submap)))
383 submap = XCDR (submap);
384 /* Also remove a menu help string, if any,
385 following the menu item name. */
386 if (CONSP (submap) && STRINGP (XCAR (submap)))
387 submap = XCDR (submap);
388 /* Also remove the sublist that caches key equivalences, if any. */
389 if (CONSP (submap)
390 && CONSP (XCAR (submap)))
392 Lisp_Object carcar;
393 carcar = XCAR (XCAR (submap));
394 if (NILP (carcar) || VECTORP (carcar))
395 submap = XCDR (submap);
399 /* Or a new format menu item */
400 else if (EQ (XCAR (submap), Qmenu_item)
401 && CONSP (XCDR (submap)))
403 submap = XCDR (XCDR (submap));
404 if (CONSP (submap))
405 submap = XCAR (submap);
409 /* If it isn't a keymap now, there's no work to do. */
410 if (! CONSP (submap)
411 || ! EQ (XCAR (submap), Qkeymap))
412 return;
414 map_parent = Fkeymap_parent (map);
415 if (! NILP (map_parent))
416 parent_entry = access_keymap (map_parent, event, 0, 0);
417 else
418 parent_entry = Qnil;
420 /* If MAP's parent has something other than a keymap,
421 our own submap shadows it completely, so use nil as SUBMAP's parent. */
422 if (! (CONSP (parent_entry) && EQ (XCAR (parent_entry), Qkeymap)))
423 parent_entry = Qnil;
425 if (! EQ (parent_entry, submap))
427 Lisp_Object submap_parent;
428 submap_parent = submap;
429 while (1)
431 Lisp_Object tem;
432 tem = Fkeymap_parent (submap_parent);
433 if (EQ (tem, parent_entry))
434 return;
435 if (CONSP (tem)
436 && EQ (XCAR (tem), Qkeymap))
437 submap_parent = tem;
438 else
439 break;
441 Fset_keymap_parent (submap_parent, parent_entry);
445 /* Look up IDX in MAP. IDX may be any sort of event.
446 Note that this does only one level of lookup; IDX must be a single
447 event, not a sequence.
449 If T_OK is non-zero, bindings for Qt are treated as default
450 bindings; any key left unmentioned by other tables and bindings is
451 given the binding of Qt.
453 If T_OK is zero, bindings for Qt are not treated specially.
455 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
457 Lisp_Object
458 access_keymap (map, idx, t_ok, noinherit)
459 Lisp_Object map;
460 Lisp_Object idx;
461 int t_ok;
462 int noinherit;
464 int noprefix = 0;
465 Lisp_Object val;
467 /* If idx is a list (some sort of mouse click, perhaps?),
468 the index we want to use is the car of the list, which
469 ought to be a symbol. */
470 idx = EVENT_HEAD (idx);
472 /* If idx is a symbol, it might have modifiers, which need to
473 be put in the canonical order. */
474 if (SYMBOLP (idx))
475 idx = reorder_modifiers (idx);
476 else if (INTEGERP (idx))
477 /* Clobber the high bits that can be present on a machine
478 with more than 24 bits of integer. */
479 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
482 Lisp_Object tail;
483 Lisp_Object t_binding;
485 t_binding = Qnil;
486 for (tail = map; CONSP (tail); tail = XCDR (tail))
488 Lisp_Object binding;
490 binding = XCAR (tail);
491 if (SYMBOLP (binding))
493 /* If NOINHERIT, stop finding prefix definitions
494 after we pass a second occurrence of the `keymap' symbol. */
495 if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
496 noprefix = 1;
498 else if (CONSP (binding))
500 if (EQ (XCAR (binding), idx))
502 val = XCDR (binding);
503 if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
504 return Qnil;
505 if (CONSP (val))
506 fix_submap_inheritance (map, idx, val);
507 return val;
509 if (t_ok && EQ (XCAR (binding), Qt))
510 t_binding = XCDR (binding);
512 else if (VECTORP (binding))
514 if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
516 val = XVECTOR (binding)->contents[XFASTINT (idx)];
517 if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
518 return Qnil;
519 if (CONSP (val))
520 fix_submap_inheritance (map, idx, val);
521 return val;
524 else if (CHAR_TABLE_P (binding))
526 /* Character codes with modifiers
527 are not included in a char-table.
528 All character codes without modifiers are included. */
529 if (NATNUMP (idx)
530 && ! (XFASTINT (idx)
531 & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
532 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
534 val = Faref (binding, idx);
535 if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
536 return Qnil;
537 if (CONSP (val))
538 fix_submap_inheritance (map, idx, val);
539 return val;
543 QUIT;
546 return t_binding;
550 /* Given OBJECT which was found in a slot in a keymap,
551 trace indirect definitions to get the actual definition of that slot.
552 An indirect definition is a list of the form
553 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
554 and INDEX is the object to look up in KEYMAP to yield the definition.
556 Also if OBJECT has a menu string as the first element,
557 remove that. Also remove a menu help string as second element.
559 If AUTOLOAD is nonzero, load autoloadable keymaps
560 that are referred to with indirection. */
562 Lisp_Object
563 get_keyelt (object, autoload)
564 register Lisp_Object object;
565 int autoload;
567 while (1)
569 if (!(CONSP (object)))
570 /* This is really the value. */
571 return object;
573 /* If the keymap contents looks like (keymap ...) or (lambda ...)
574 then use itself. */
575 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
576 return object;
578 /* If the keymap contents looks like (menu-item name . DEFN)
579 or (menu-item name DEFN ...) then use DEFN.
580 This is a new format menu item.
582 else if (EQ (XCAR (object), Qmenu_item))
584 if (CONSP (XCDR (object)))
586 object = XCDR (XCDR (object));
587 if (CONSP (object))
588 object = XCAR (object);
590 else
591 /* Invalid keymap */
592 return object;
595 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
596 Keymap alist elements like (CHAR MENUSTRING . DEFN)
597 will be used by HierarKey menus. */
598 else if (STRINGP (XCAR (object)))
600 object = XCDR (object);
601 /* Also remove a menu help string, if any,
602 following the menu item name. */
603 if (CONSP (object) && STRINGP (XCAR (object)))
604 object = XCDR (object);
605 /* Also remove the sublist that caches key equivalences, if any. */
606 if (CONSP (object) && CONSP (XCAR (object)))
608 Lisp_Object carcar;
609 carcar = XCAR (XCAR (object));
610 if (NILP (carcar) || VECTORP (carcar))
611 object = XCDR (object);
615 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
616 else
618 register Lisp_Object map;
619 map = get_keymap_1 (Fcar_safe (object), 0, autoload);
620 if (NILP (map))
621 /* Invalid keymap */
622 return object;
623 else
625 Lisp_Object key;
626 key = Fcdr (object);
627 if (INTEGERP (key) && (XINT (key) & meta_modifier))
629 object = access_keymap (map, meta_prefix_char, 0, 0);
630 map = get_keymap_1 (object, 0, autoload);
631 object = access_keymap (map, make_number (XINT (key)
632 & ~meta_modifier),
633 0, 0);
635 else
636 object = access_keymap (map, key, 0, 0);
642 Lisp_Object
643 store_in_keymap (keymap, idx, def)
644 Lisp_Object keymap;
645 register Lisp_Object idx;
646 register Lisp_Object def;
648 /* If we are preparing to dump, and DEF is a menu element
649 with a menu item indicator, copy it to ensure it is not pure. */
650 if (CONSP (def) && PURE_P (def)
651 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
652 def = Fcons (XCAR (def), XCDR (def));
654 if (!CONSP (keymap) || ! EQ (XCAR (keymap), Qkeymap))
655 error ("attempt to define a key in a non-keymap");
657 /* If idx is a list (some sort of mouse click, perhaps?),
658 the index we want to use is the car of the list, which
659 ought to be a symbol. */
660 idx = EVENT_HEAD (idx);
662 /* If idx is a symbol, it might have modifiers, which need to
663 be put in the canonical order. */
664 if (SYMBOLP (idx))
665 idx = reorder_modifiers (idx);
666 else if (INTEGERP (idx))
667 /* Clobber the high bits that can be present on a machine
668 with more than 24 bits of integer. */
669 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
671 /* Scan the keymap for a binding of idx. */
673 Lisp_Object tail;
675 /* The cons after which we should insert new bindings. If the
676 keymap has a table element, we record its position here, so new
677 bindings will go after it; this way, the table will stay
678 towards the front of the alist and character lookups in dense
679 keymaps will remain fast. Otherwise, this just points at the
680 front of the keymap. */
681 Lisp_Object insertion_point;
683 insertion_point = keymap;
684 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
686 Lisp_Object elt;
688 elt = XCAR (tail);
689 if (VECTORP (elt))
691 if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (elt)->size)
693 XVECTOR (elt)->contents[XFASTINT (idx)] = def;
694 return def;
696 insertion_point = tail;
698 else if (CHAR_TABLE_P (elt))
700 /* Character codes with modifiers
701 are not included in a char-table.
702 All character codes without modifiers are included. */
703 if (NATNUMP (idx)
704 && ! (XFASTINT (idx)
705 & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
706 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
708 Faset (elt, idx, def);
709 return def;
711 insertion_point = tail;
713 else if (CONSP (elt))
715 if (EQ (idx, XCAR (elt)))
717 XCDR (elt) = def;
718 return def;
721 else if (SYMBOLP (elt))
723 /* If we find a 'keymap' symbol in the spine of KEYMAP,
724 then we must have found the start of a second keymap
725 being used as the tail of KEYMAP, and a binding for IDX
726 should be inserted before it. */
727 if (EQ (elt, Qkeymap))
728 goto keymap_end;
731 QUIT;
734 keymap_end:
735 /* We have scanned the entire keymap, and not found a binding for
736 IDX. Let's add one. */
737 XCDR (insertion_point)
738 = Fcons (Fcons (idx, def), XCDR (insertion_point));
741 return def;
744 void
745 copy_keymap_1 (chartable, idx, elt)
746 Lisp_Object chartable, idx, elt;
748 if (!SYMBOLP (elt) && ! NILP (Fkeymapp (elt)))
749 Faset (chartable, idx, Fcopy_keymap (elt));
752 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
753 "Return a copy of the keymap KEYMAP.\n\
754 The copy starts out with the same definitions of KEYMAP,\n\
755 but changing either the copy or KEYMAP does not affect the other.\n\
756 Any key definitions that are subkeymaps are recursively copied.\n\
757 However, a key definition which is a symbol whose definition is a keymap\n\
758 is not copied.")
759 (keymap)
760 Lisp_Object keymap;
762 register Lisp_Object copy, tail;
764 copy = Fcopy_alist (get_keymap (keymap));
766 for (tail = copy; CONSP (tail); tail = XCDR (tail))
768 Lisp_Object elt;
770 elt = XCAR (tail);
771 if (CHAR_TABLE_P (elt))
773 Lisp_Object indices[3];
775 elt = Fcopy_sequence (elt);
776 XCAR (tail) = elt;
778 map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
780 else if (VECTORP (elt))
782 int i;
784 elt = Fcopy_sequence (elt);
785 XCAR (tail) = elt;
787 for (i = 0; i < XVECTOR (elt)->size; i++)
788 if (!SYMBOLP (XVECTOR (elt)->contents[i])
789 && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i])))
790 XVECTOR (elt)->contents[i]
791 = Fcopy_keymap (XVECTOR (elt)->contents[i]);
793 else if (CONSP (elt) && CONSP (XCDR (elt)))
795 Lisp_Object tem;
796 tem = XCDR (elt);
798 /* Is this a new format menu item. */
799 if (EQ (XCAR (tem),Qmenu_item))
801 /* Copy cell with menu-item marker. */
802 XCDR (elt)
803 = Fcons (XCAR (tem), XCDR (tem));
804 elt = XCDR (elt);
805 tem = XCDR (elt);
806 if (CONSP (tem))
808 /* Copy cell with menu-item name. */
809 XCDR (elt)
810 = Fcons (XCAR (tem), XCDR (tem));
811 elt = XCDR (elt);
812 tem = XCDR (elt);
814 if (CONSP (tem))
816 /* Copy cell with binding and if the binding is a keymap,
817 copy that. */
818 XCDR (elt)
819 = Fcons (XCAR (tem), XCDR (tem));
820 elt = XCDR (elt);
821 tem = XCAR (elt);
822 if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem))))
823 XCAR (elt) = Fcopy_keymap (tem);
824 tem = XCDR (elt);
825 if (CONSP (tem) && CONSP (XCAR (tem)))
826 /* Delete cache for key equivalences. */
827 XCDR (elt) = XCDR (tem);
830 else
832 /* It may be an old fomat menu item.
833 Skip the optional menu string.
835 if (STRINGP (XCAR (tem)))
837 /* Copy the cell, since copy-alist didn't go this deep. */
838 XCDR (elt)
839 = Fcons (XCAR (tem), XCDR (tem));
840 elt = XCDR (elt);
841 tem = XCDR (elt);
842 /* Also skip the optional menu help string. */
843 if (CONSP (tem) && STRINGP (XCAR (tem)))
845 XCDR (elt)
846 = Fcons (XCAR (tem), XCDR (tem));
847 elt = XCDR (elt);
848 tem = XCDR (elt);
850 /* There may also be a list that caches key equivalences.
851 Just delete it for the new keymap. */
852 if (CONSP (tem)
853 && CONSP (XCAR (tem))
854 && (NILP (XCAR (XCAR (tem)))
855 || VECTORP (XCAR (XCAR (tem)))))
856 XCDR (elt) = XCDR (tem);
858 if (CONSP (elt)
859 && ! SYMBOLP (XCDR (elt))
860 && ! NILP (Fkeymapp (XCDR (elt))))
861 XCDR (elt) = Fcopy_keymap (XCDR (elt));
867 return copy;
870 /* Simple Keymap mutators and accessors. */
872 /* GC is possible in this function if it autoloads a keymap. */
874 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
875 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
876 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
877 meaning a sequence of keystrokes and events.\n\
878 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
879 can be included if you use a vector.\n\
880 DEF is anything that can be a key's definition:\n\
881 nil (means key is undefined in this keymap),\n\
882 a command (a Lisp function suitable for interactive calling)\n\
883 a string (treated as a keyboard macro),\n\
884 a keymap (to define a prefix key),\n\
885 a symbol. When the key is looked up, the symbol will stand for its\n\
886 function definition, which should at that time be one of the above,\n\
887 or another symbol whose function definition is used, etc.\n\
888 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
889 (DEFN should be a valid definition in its own right),\n\
890 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
892 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
893 the front of KEYMAP.")
894 (keymap, key, def)
895 Lisp_Object keymap;
896 Lisp_Object key;
897 Lisp_Object def;
899 register int idx;
900 register Lisp_Object c;
901 register Lisp_Object cmd;
902 int metized = 0;
903 int meta_bit;
904 int length;
905 struct gcpro gcpro1, gcpro2, gcpro3;
907 keymap = get_keymap_1 (keymap, 1, 1);
909 if (!VECTORP (key) && !STRINGP (key))
910 key = wrong_type_argument (Qarrayp, key);
912 length = XFASTINT (Flength (key));
913 if (length == 0)
914 return Qnil;
916 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
917 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
919 GCPRO3 (keymap, key, def);
921 if (VECTORP (key))
922 meta_bit = meta_modifier;
923 else
924 meta_bit = 0x80;
926 idx = 0;
927 while (1)
929 c = Faref (key, make_number (idx));
931 if (CONSP (c) && lucid_event_type_list_p (c))
932 c = Fevent_convert_list (c);
934 if (INTEGERP (c)
935 && (XINT (c) & meta_bit)
936 && !metized)
938 c = meta_prefix_char;
939 metized = 1;
941 else
943 if (INTEGERP (c))
944 XSETINT (c, XINT (c) & ~meta_bit);
946 metized = 0;
947 idx++;
950 if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
951 error ("Key sequence contains invalid events");
953 if (idx == length)
954 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
956 cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1);
958 /* If this key is undefined, make it a prefix. */
959 if (NILP (cmd))
960 cmd = define_as_prefix (keymap, c);
962 keymap = get_keymap_1 (cmd, 0, 1);
963 if (NILP (keymap))
964 /* We must use Fkey_description rather than just passing key to
965 error; key might be a vector, not a string. */
966 error ("Key sequence %s uses invalid prefix characters",
967 XSTRING (Fkey_description (key))->data);
971 /* Value is number if KEY is too long; NIL if valid but has no definition. */
972 /* GC is possible in this function if it autoloads a keymap. */
974 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
975 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
976 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
978 A number as value means KEY is \"too long\";\n\
979 that is, characters or symbols in it except for the last one\n\
980 fail to be a valid sequence of prefix characters in KEYMAP.\n\
981 The number is how many characters at the front of KEY\n\
982 it takes to reach a non-prefix command.\n\
984 Normally, `lookup-key' ignores bindings for t, which act as default\n\
985 bindings, used when nothing else in the keymap applies; this makes it\n\
986 usable as a general function for probing keymaps. However, if the\n\
987 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
988 recognize the default bindings, just as `read-key-sequence' does.")
989 (keymap, key, accept_default)
990 register Lisp_Object keymap;
991 Lisp_Object key;
992 Lisp_Object accept_default;
994 register int idx;
995 register Lisp_Object cmd;
996 register Lisp_Object c;
997 int metized = 0;
998 int length;
999 int t_ok = ! NILP (accept_default);
1000 int meta_bit;
1001 struct gcpro gcpro1;
1003 keymap = get_keymap_1 (keymap, 1, 1);
1005 if (!VECTORP (key) && !STRINGP (key))
1006 key = wrong_type_argument (Qarrayp, key);
1008 length = XFASTINT (Flength (key));
1009 if (length == 0)
1010 return keymap;
1012 if (VECTORP (key))
1013 meta_bit = meta_modifier;
1014 else
1015 meta_bit = 0x80;
1017 GCPRO1 (key);
1019 idx = 0;
1020 while (1)
1022 c = Faref (key, make_number (idx));
1024 if (CONSP (c) && lucid_event_type_list_p (c))
1025 c = Fevent_convert_list (c);
1027 if (INTEGERP (c)
1028 && (XINT (c) & meta_bit)
1029 && !metized)
1031 c = meta_prefix_char;
1032 metized = 1;
1034 else
1036 if (INTEGERP (c))
1037 XSETINT (c, XINT (c) & ~meta_bit);
1039 metized = 0;
1040 idx++;
1043 cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1);
1044 if (idx == length)
1045 RETURN_UNGCPRO (cmd);
1047 keymap = get_keymap_1 (cmd, 0, 1);
1048 if (NILP (keymap))
1049 RETURN_UNGCPRO (make_number (idx));
1051 QUIT;
1055 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1056 Assume that currently it does not define C at all.
1057 Return the keymap. */
1059 static Lisp_Object
1060 define_as_prefix (keymap, c)
1061 Lisp_Object keymap, c;
1063 Lisp_Object inherit, cmd;
1065 cmd = Fmake_sparse_keymap (Qnil);
1066 /* If this key is defined as a prefix in an inherited keymap,
1067 make it a prefix in this map, and make its definition
1068 inherit the other prefix definition. */
1069 inherit = access_keymap (keymap, c, 0, 0);
1070 #if 0
1071 /* This code is needed to do the right thing in the following case:
1072 keymap A inherits from B,
1073 you define KEY as a prefix in A,
1074 then later you define KEY as a prefix in B.
1075 We want the old prefix definition in A to inherit from that in B.
1076 It is hard to do that retroactively, so this code
1077 creates the prefix in B right away.
1079 But it turns out that this code causes problems immediately
1080 when the prefix in A is defined: it causes B to define KEY
1081 as a prefix with no subcommands.
1083 So I took out this code. */
1084 if (NILP (inherit))
1086 /* If there's an inherited keymap
1087 and it doesn't define this key,
1088 make it define this key. */
1089 Lisp_Object tail;
1091 for (tail = Fcdr (keymap); CONSP (tail); tail = XCDR (tail))
1092 if (EQ (XCAR (tail), Qkeymap))
1093 break;
1095 if (!NILP (tail))
1096 inherit = define_as_prefix (tail, c);
1098 #endif
1100 cmd = nconc2 (cmd, inherit);
1101 store_in_keymap (keymap, c, cmd);
1103 return cmd;
1106 /* Append a key to the end of a key sequence. We always make a vector. */
1108 Lisp_Object
1109 append_key (key_sequence, key)
1110 Lisp_Object key_sequence, key;
1112 Lisp_Object args[2];
1114 args[0] = key_sequence;
1116 args[1] = Fcons (key, Qnil);
1117 return Fvconcat (2, args);
1121 /* Global, local, and minor mode keymap stuff. */
1123 /* We can't put these variables inside current_minor_maps, since under
1124 some systems, static gets macro-defined to be the empty string.
1125 Ickypoo. */
1126 static Lisp_Object *cmm_modes, *cmm_maps;
1127 static int cmm_size;
1129 /* Error handler used in current_minor_maps. */
1130 static Lisp_Object
1131 current_minor_maps_error ()
1133 return Qnil;
1136 /* Store a pointer to an array of the keymaps of the currently active
1137 minor modes in *buf, and return the number of maps it contains.
1139 This function always returns a pointer to the same buffer, and may
1140 free or reallocate it, so if you want to keep it for a long time or
1141 hand it out to lisp code, copy it. This procedure will be called
1142 for every key sequence read, so the nice lispy approach (return a
1143 new assoclist, list, what have you) for each invocation would
1144 result in a lot of consing over time.
1146 If we used xrealloc/xmalloc and ran out of memory, they would throw
1147 back to the command loop, which would try to read a key sequence,
1148 which would call this function again, resulting in an infinite
1149 loop. Instead, we'll use realloc/malloc and silently truncate the
1150 list, let the key sequence be read, and hope some other piece of
1151 code signals the error. */
1153 current_minor_maps (modeptr, mapptr)
1154 Lisp_Object **modeptr, **mapptr;
1156 int i = 0;
1157 int list_number = 0;
1158 Lisp_Object alist, assoc, var, val;
1159 Lisp_Object lists[2];
1161 lists[0] = Vminor_mode_overriding_map_alist;
1162 lists[1] = Vminor_mode_map_alist;
1164 for (list_number = 0; list_number < 2; list_number++)
1165 for (alist = lists[list_number];
1166 CONSP (alist);
1167 alist = XCDR (alist))
1168 if ((assoc = XCAR (alist), CONSP (assoc))
1169 && (var = XCAR (assoc), SYMBOLP (var))
1170 && (val = find_symbol_value (var), ! EQ (val, Qunbound))
1171 && ! NILP (val))
1173 Lisp_Object temp;
1175 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1176 and also an entry in Vminor_mode_map_alist,
1177 ignore the latter. */
1178 if (list_number == 1)
1180 val = assq_no_quit (var, lists[0]);
1181 if (!NILP (val))
1182 break;
1185 if (i >= cmm_size)
1187 Lisp_Object *newmodes, *newmaps;
1189 if (cmm_maps)
1191 BLOCK_INPUT;
1192 cmm_size *= 2;
1193 newmodes
1194 = (Lisp_Object *) realloc (cmm_modes,
1195 cmm_size * sizeof (Lisp_Object));
1196 newmaps
1197 = (Lisp_Object *) realloc (cmm_maps,
1198 cmm_size * sizeof (Lisp_Object));
1199 UNBLOCK_INPUT;
1201 else
1203 BLOCK_INPUT;
1204 cmm_size = 30;
1205 newmodes
1206 = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
1207 newmaps
1208 = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
1209 UNBLOCK_INPUT;
1212 if (newmaps && newmodes)
1214 cmm_modes = newmodes;
1215 cmm_maps = newmaps;
1217 else
1218 break;
1221 /* Get the keymap definition--or nil if it is not defined. */
1222 temp = internal_condition_case_1 (Findirect_function,
1223 XCDR (assoc),
1224 Qerror, current_minor_maps_error);
1225 if (!NILP (temp))
1227 cmm_modes[i] = var;
1228 cmm_maps [i] = temp;
1229 i++;
1233 if (modeptr) *modeptr = cmm_modes;
1234 if (mapptr) *mapptr = cmm_maps;
1235 return i;
1238 /* GC is possible in this function if it autoloads a keymap. */
1240 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
1241 "Return the binding for command KEY in current keymaps.\n\
1242 KEY is a string or vector, a sequence of keystrokes.\n\
1243 The binding is probably a symbol with a function definition.\n\
1245 Normally, `key-binding' ignores bindings for t, which act as default\n\
1246 bindings, used when nothing else in the keymap applies; this makes it\n\
1247 usable as a general function for probing keymaps. However, if the\n\
1248 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
1249 recognize the default bindings, just as `read-key-sequence' does.")
1250 (key, accept_default)
1251 Lisp_Object key, accept_default;
1253 Lisp_Object *maps, value;
1254 int nmaps, i;
1255 struct gcpro gcpro1;
1257 GCPRO1 (key);
1259 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1261 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1262 key, accept_default);
1263 if (! NILP (value) && !INTEGERP (value))
1264 RETURN_UNGCPRO (value);
1266 else if (!NILP (Voverriding_local_map))
1268 value = Flookup_key (Voverriding_local_map, key, accept_default);
1269 if (! NILP (value) && !INTEGERP (value))
1270 RETURN_UNGCPRO (value);
1272 else
1274 Lisp_Object local;
1276 nmaps = current_minor_maps (0, &maps);
1277 /* Note that all these maps are GCPRO'd
1278 in the places where we found them. */
1280 for (i = 0; i < nmaps; i++)
1281 if (! NILP (maps[i]))
1283 value = Flookup_key (maps[i], key, accept_default);
1284 if (! NILP (value) && !INTEGERP (value))
1285 RETURN_UNGCPRO (value);
1288 local = get_local_map (PT, current_buffer);
1290 if (! NILP (local))
1292 value = Flookup_key (local, key, accept_default);
1293 if (! NILP (value) && !INTEGERP (value))
1294 RETURN_UNGCPRO (value);
1298 value = Flookup_key (current_global_map, key, accept_default);
1299 UNGCPRO;
1300 if (! NILP (value) && !INTEGERP (value))
1301 return value;
1303 return Qnil;
1306 /* GC is possible in this function if it autoloads a keymap. */
1308 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1309 "Return the binding for command KEYS in current local keymap only.\n\
1310 KEYS is a string, a sequence of keystrokes.\n\
1311 The binding is probably a symbol with a function definition.\n\
1313 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1314 bindings; see the description of `lookup-key' for more details about this.")
1315 (keys, accept_default)
1316 Lisp_Object keys, accept_default;
1318 register Lisp_Object map;
1319 map = current_buffer->keymap;
1320 if (NILP (map))
1321 return Qnil;
1322 return Flookup_key (map, keys, accept_default);
1325 /* GC is possible in this function if it autoloads a keymap. */
1327 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1328 "Return the binding for command KEYS in current global keymap only.\n\
1329 KEYS is a string, a sequence of keystrokes.\n\
1330 The binding is probably a symbol with a function definition.\n\
1331 This function's return values are the same as those of lookup-key\n\
1332 \(which see).\n\
1334 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1335 bindings; see the description of `lookup-key' for more details about this.")
1336 (keys, accept_default)
1337 Lisp_Object keys, accept_default;
1339 return Flookup_key (current_global_map, keys, accept_default);
1342 /* GC is possible in this function if it autoloads a keymap. */
1344 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1345 "Find the visible minor mode bindings of KEY.\n\
1346 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
1347 the symbol which names the minor mode binding KEY, and BINDING is\n\
1348 KEY's definition in that mode. In particular, if KEY has no\n\
1349 minor-mode bindings, return nil. If the first binding is a\n\
1350 non-prefix, all subsequent bindings will be omitted, since they would\n\
1351 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
1352 that come after prefix bindings.\n\
1354 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1355 bindings; see the description of `lookup-key' for more details about this.")
1356 (key, accept_default)
1357 Lisp_Object key, accept_default;
1359 Lisp_Object *modes, *maps;
1360 int nmaps;
1361 Lisp_Object binding;
1362 int i, j;
1363 struct gcpro gcpro1, gcpro2;
1365 nmaps = current_minor_maps (&modes, &maps);
1366 /* Note that all these maps are GCPRO'd
1367 in the places where we found them. */
1369 binding = Qnil;
1370 GCPRO2 (key, binding);
1372 for (i = j = 0; i < nmaps; i++)
1373 if (! NILP (maps[i])
1374 && ! NILP (binding = Flookup_key (maps[i], key, accept_default))
1375 && !INTEGERP (binding))
1377 if (! NILP (get_keymap (binding)))
1378 maps[j++] = Fcons (modes[i], binding);
1379 else if (j == 0)
1380 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1383 UNGCPRO;
1384 return Flist (j, maps);
1387 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1388 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
1389 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1390 If a second optional argument MAPVAR is given, the map is stored as\n\
1391 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1392 as a function.\n\
1393 The third optional argument NAME, if given, supplies a menu name\n\
1394 string for the map. This is required to use the keymap as a menu.")
1395 (command, mapvar, name)
1396 Lisp_Object command, mapvar, name;
1398 Lisp_Object map;
1399 map = Fmake_sparse_keymap (name);
1400 Ffset (command, map);
1401 if (!NILP (mapvar))
1402 Fset (mapvar, map);
1403 else
1404 Fset (command, map);
1405 return command;
1408 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1409 "Select KEYMAP as the global keymap.")
1410 (keymap)
1411 Lisp_Object keymap;
1413 keymap = get_keymap (keymap);
1414 current_global_map = keymap;
1416 return Qnil;
1419 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1420 "Select KEYMAP as the local keymap.\n\
1421 If KEYMAP is nil, that means no local keymap.")
1422 (keymap)
1423 Lisp_Object keymap;
1425 if (!NILP (keymap))
1426 keymap = get_keymap (keymap);
1428 current_buffer->keymap = keymap;
1430 return Qnil;
1433 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1434 "Return current buffer's local keymap, or nil if it has none.")
1437 return current_buffer->keymap;
1440 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1441 "Return the current global keymap.")
1444 return current_global_map;
1447 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1448 "Return a list of keymaps for the minor modes of the current buffer.")
1451 Lisp_Object *maps;
1452 int nmaps = current_minor_maps (0, &maps);
1454 return Flist (nmaps, maps);
1457 /* Help functions for describing and documenting keymaps. */
1459 static void accessible_keymaps_char_table ();
1461 /* This function cannot GC. */
1463 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1464 1, 2, 0,
1465 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1466 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1467 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1468 so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
1469 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1470 then the value includes only maps for prefixes that start with PREFIX.")
1471 (keymap, prefix)
1472 Lisp_Object keymap, prefix;
1474 Lisp_Object maps, good_maps, tail;
1475 int prefixlen = 0;
1477 /* no need for gcpro because we don't autoload any keymaps. */
1479 if (!NILP (prefix))
1480 prefixlen = XINT (Flength (prefix));
1482 if (!NILP (prefix))
1484 /* If a prefix was specified, start with the keymap (if any) for
1485 that prefix, so we don't waste time considering other prefixes. */
1486 Lisp_Object tem;
1487 tem = Flookup_key (keymap, prefix, Qt);
1488 /* Flookup_key may give us nil, or a number,
1489 if the prefix is not defined in this particular map.
1490 It might even give us a list that isn't a keymap. */
1491 tem = get_keymap_1 (tem, 0, 0);
1492 if (!NILP (tem))
1494 /* Convert PREFIX to a vector now, so that later on
1495 we don't have to deal with the possibility of a string. */
1496 if (STRINGP (prefix))
1498 int i, i_byte, c;
1499 Lisp_Object copy;
1501 copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
1502 for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
1504 int i_before = i;
1506 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
1507 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1508 c ^= 0200 | meta_modifier;
1509 XVECTOR (copy)->contents[i_before] = make_number (c);
1511 prefix = copy;
1513 maps = Fcons (Fcons (prefix, tem), Qnil);
1515 else
1516 return Qnil;
1518 else
1519 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1520 get_keymap (keymap)),
1521 Qnil);
1523 /* For each map in the list maps,
1524 look at any other maps it points to,
1525 and stick them at the end if they are not already in the list.
1527 This is a breadth-first traversal, where tail is the queue of
1528 nodes, and maps accumulates a list of all nodes visited. */
1530 for (tail = maps; CONSP (tail); tail = XCDR (tail))
1532 register Lisp_Object thisseq, thismap;
1533 Lisp_Object last;
1534 /* Does the current sequence end in the meta-prefix-char? */
1535 int is_metized;
1537 thisseq = Fcar (Fcar (tail));
1538 thismap = Fcdr (Fcar (tail));
1539 last = make_number (XINT (Flength (thisseq)) - 1);
1540 is_metized = (XINT (last) >= 0
1541 /* Don't metize the last char of PREFIX. */
1542 && XINT (last) >= prefixlen
1543 && EQ (Faref (thisseq, last), meta_prefix_char));
1545 for (; CONSP (thismap); thismap = XCDR (thismap))
1547 Lisp_Object elt;
1549 elt = XCAR (thismap);
1551 QUIT;
1553 if (CHAR_TABLE_P (elt))
1555 Lisp_Object indices[3];
1557 map_char_table (accessible_keymaps_char_table, Qnil,
1558 elt, Fcons (maps, Fcons (tail, thisseq)),
1559 0, indices);
1561 else if (VECTORP (elt))
1563 register int i;
1565 /* Vector keymap. Scan all the elements. */
1566 for (i = 0; i < XVECTOR (elt)->size; i++)
1568 register Lisp_Object tem;
1569 register Lisp_Object cmd;
1571 cmd = get_keyelt (XVECTOR (elt)->contents[i], 0);
1572 if (NILP (cmd)) continue;
1573 tem = Fkeymapp (cmd);
1574 if (!NILP (tem))
1576 cmd = get_keymap (cmd);
1577 /* Ignore keymaps that are already added to maps. */
1578 tem = Frassq (cmd, maps);
1579 if (NILP (tem))
1581 /* If the last key in thisseq is meta-prefix-char,
1582 turn it into a meta-ized keystroke. We know
1583 that the event we're about to append is an
1584 ascii keystroke since we're processing a
1585 keymap table. */
1586 if (is_metized)
1588 int meta_bit = meta_modifier;
1589 tem = Fcopy_sequence (thisseq);
1591 Faset (tem, last, make_number (i | meta_bit));
1593 /* This new sequence is the same length as
1594 thisseq, so stick it in the list right
1595 after this one. */
1596 XCDR (tail)
1597 = Fcons (Fcons (tem, cmd), XCDR (tail));
1599 else
1601 tem = append_key (thisseq, make_number (i));
1602 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1608 else if (CONSP (elt))
1610 register Lisp_Object cmd, tem;
1612 cmd = get_keyelt (XCDR (elt), 0);
1613 /* Ignore definitions that aren't keymaps themselves. */
1614 tem = Fkeymapp (cmd);
1615 if (!NILP (tem))
1617 /* Ignore keymaps that have been seen already. */
1618 cmd = get_keymap (cmd);
1619 tem = Frassq (cmd, maps);
1620 if (NILP (tem))
1622 /* Let elt be the event defined by this map entry. */
1623 elt = XCAR (elt);
1625 /* If the last key in thisseq is meta-prefix-char, and
1626 this entry is a binding for an ascii keystroke,
1627 turn it into a meta-ized keystroke. */
1628 if (is_metized && INTEGERP (elt))
1630 Lisp_Object element;
1632 element = thisseq;
1633 tem = Fvconcat (1, &element);
1634 XSETFASTINT (XVECTOR (tem)->contents[XINT (last)],
1635 XINT (elt) | meta_modifier);
1637 /* This new sequence is the same length as
1638 thisseq, so stick it in the list right
1639 after this one. */
1640 XCDR (tail)
1641 = Fcons (Fcons (tem, cmd), XCDR (tail));
1643 else
1644 nconc2 (tail,
1645 Fcons (Fcons (append_key (thisseq, elt), cmd),
1646 Qnil));
1653 if (NILP (prefix))
1654 return maps;
1656 /* Now find just the maps whose access prefixes start with PREFIX. */
1658 good_maps = Qnil;
1659 for (; CONSP (maps); maps = XCDR (maps))
1661 Lisp_Object elt, thisseq;
1662 elt = XCAR (maps);
1663 thisseq = XCAR (elt);
1664 /* The access prefix must be at least as long as PREFIX,
1665 and the first elements must match those of PREFIX. */
1666 if (XINT (Flength (thisseq)) >= prefixlen)
1668 int i;
1669 for (i = 0; i < prefixlen; i++)
1671 Lisp_Object i1;
1672 XSETFASTINT (i1, i);
1673 if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1674 break;
1676 if (i == prefixlen)
1677 good_maps = Fcons (elt, good_maps);
1681 return Fnreverse (good_maps);
1684 static void
1685 accessible_keymaps_char_table (args, index, cmd)
1686 Lisp_Object args, index, cmd;
1688 Lisp_Object tem;
1689 Lisp_Object maps, tail, thisseq;
1691 if (NILP (cmd))
1692 return;
1694 maps = XCAR (args);
1695 tail = XCAR (XCDR (args));
1696 thisseq = XCDR (XCDR (args));
1698 tem = Fkeymapp (cmd);
1699 if (!NILP (tem))
1701 cmd = get_keymap (cmd);
1702 /* Ignore keymaps that are already added to maps. */
1703 tem = Frassq (cmd, maps);
1704 if (NILP (tem))
1706 tem = append_key (thisseq, index);
1707 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1712 Lisp_Object Qsingle_key_description, Qkey_description;
1714 /* This function cannot GC. */
1716 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1717 "Return a pretty description of key-sequence KEYS.\n\
1718 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1719 spaces are put between sequence elements, etc.")
1720 (keys)
1721 Lisp_Object keys;
1723 int len;
1724 int i, i_byte;
1725 Lisp_Object sep;
1726 Lisp_Object *args;
1728 if (STRINGP (keys))
1730 Lisp_Object vector;
1731 vector = Fmake_vector (Flength (keys), Qnil);
1732 for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
1734 int c;
1735 int i_before = i;
1737 FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
1738 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1739 c ^= 0200 | meta_modifier;
1740 XSETFASTINT (XVECTOR (vector)->contents[i_before], c);
1742 keys = vector;
1745 if (VECTORP (keys))
1747 /* In effect, this computes
1748 (mapconcat 'single-key-description keys " ")
1749 but we shouldn't use mapconcat because it can do GC. */
1751 len = XVECTOR (keys)->size;
1752 sep = build_string (" ");
1753 /* This has one extra element at the end that we don't pass to Fconcat. */
1754 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1756 for (i = 0; i < len; i++)
1758 args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
1759 args[i * 2 + 1] = sep;
1762 else if (CONSP (keys))
1764 /* In effect, this computes
1765 (mapconcat 'single-key-description keys " ")
1766 but we shouldn't use mapconcat because it can do GC. */
1768 len = XFASTINT (Flength (keys));
1769 sep = build_string (" ");
1770 /* This has one extra element at the end that we don't pass to Fconcat. */
1771 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1773 for (i = 0; i < len; i++)
1775 args[i * 2] = Fsingle_key_description (XCAR (keys));
1776 args[i * 2 + 1] = sep;
1777 keys = XCDR (keys);
1780 else
1781 keys = wrong_type_argument (Qarrayp, keys);
1783 return Fconcat (len * 2 - 1, args);
1786 char *
1787 push_key_description (c, p)
1788 register unsigned int c;
1789 register char *p;
1791 /* Clear all the meaningless bits above the meta bit. */
1792 c &= meta_modifier | ~ - meta_modifier;
1794 if (c & alt_modifier)
1796 *p++ = 'A';
1797 *p++ = '-';
1798 c -= alt_modifier;
1800 if (c & ctrl_modifier)
1802 *p++ = 'C';
1803 *p++ = '-';
1804 c -= ctrl_modifier;
1806 if (c & hyper_modifier)
1808 *p++ = 'H';
1809 *p++ = '-';
1810 c -= hyper_modifier;
1812 if (c & meta_modifier)
1814 *p++ = 'M';
1815 *p++ = '-';
1816 c -= meta_modifier;
1818 if (c & shift_modifier)
1820 *p++ = 'S';
1821 *p++ = '-';
1822 c -= shift_modifier;
1824 if (c & super_modifier)
1826 *p++ = 's';
1827 *p++ = '-';
1828 c -= super_modifier;
1830 if (c < 040)
1832 if (c == 033)
1834 *p++ = 'E';
1835 *p++ = 'S';
1836 *p++ = 'C';
1838 else if (c == '\t')
1840 *p++ = 'T';
1841 *p++ = 'A';
1842 *p++ = 'B';
1844 else if (c == Ctl ('M'))
1846 *p++ = 'R';
1847 *p++ = 'E';
1848 *p++ = 'T';
1850 else
1852 *p++ = 'C';
1853 *p++ = '-';
1854 if (c > 0 && c <= Ctl ('Z'))
1855 *p++ = c + 0140;
1856 else
1857 *p++ = c + 0100;
1860 else if (c == 0177)
1862 *p++ = 'D';
1863 *p++ = 'E';
1864 *p++ = 'L';
1866 else if (c == ' ')
1868 *p++ = 'S';
1869 *p++ = 'P';
1870 *p++ = 'C';
1872 else if (c < 128
1873 || (NILP (current_buffer->enable_multibyte_characters)
1874 && SINGLE_BYTE_CHAR_P (c)))
1875 *p++ = c;
1876 else
1878 if (! NILP (current_buffer->enable_multibyte_characters))
1879 c = unibyte_char_to_multibyte (c);
1881 if (NILP (current_buffer->enable_multibyte_characters)
1882 || SINGLE_BYTE_CHAR_P (c)
1883 || ! char_valid_p (c, 0))
1885 int bit_offset;
1886 *p++ = '\\';
1887 /* The biggest character code uses 19 bits. */
1888 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
1890 if (c >= (1 << bit_offset))
1891 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
1894 else
1896 p += CHAR_STRING (c, p);
1900 return p;
1903 /* This function cannot GC. */
1905 DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
1906 "Return a pretty description of command character KEY.\n\
1907 Control characters turn into C-whatever, etc.")
1908 (key)
1909 Lisp_Object key;
1911 if (CONSP (key) && lucid_event_type_list_p (key))
1912 key = Fevent_convert_list (key);
1914 key = EVENT_HEAD (key);
1916 if (INTEGERP (key)) /* Normal character */
1918 unsigned int charset, c1, c2;
1919 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
1921 if (SINGLE_BYTE_CHAR_P (without_bits))
1922 charset = 0;
1923 else
1924 SPLIT_CHAR (without_bits, charset, c1, c2);
1926 if (charset
1927 && CHARSET_DEFINED_P (charset)
1928 && ((c1 >= 0 && c1 < 32)
1929 || (c2 >= 0 && c2 < 32)))
1931 /* Handle a generic character. */
1932 Lisp_Object name;
1933 name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
1934 CHECK_STRING (name, 0);
1935 return concat2 (build_string ("Character set "), name);
1937 else
1939 char tem[KEY_DESCRIPTION_SIZE];
1941 *push_key_description (XUINT (key), tem) = 0;
1942 return build_string (tem);
1945 else if (SYMBOLP (key)) /* Function key or event-symbol */
1946 return Fsymbol_name (key);
1947 else if (STRINGP (key)) /* Buffer names in the menubar. */
1948 return Fcopy_sequence (key);
1949 else
1950 error ("KEY must be an integer, cons, symbol, or string");
1953 char *
1954 push_text_char_description (c, p)
1955 register unsigned int c;
1956 register char *p;
1958 if (c >= 0200)
1960 *p++ = 'M';
1961 *p++ = '-';
1962 c -= 0200;
1964 if (c < 040)
1966 *p++ = '^';
1967 *p++ = c + 64; /* 'A' - 1 */
1969 else if (c == 0177)
1971 *p++ = '^';
1972 *p++ = '?';
1974 else
1975 *p++ = c;
1976 return p;
1979 /* This function cannot GC. */
1981 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1982 "Return a pretty description of file-character CHARACTER.\n\
1983 Control characters turn into \"^char\", etc.")
1984 (character)
1985 Lisp_Object character;
1987 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
1988 unsigned char str[6];
1989 int c;
1991 CHECK_NUMBER (character, 0);
1993 c = XINT (character);
1994 if (!SINGLE_BYTE_CHAR_P (c))
1996 int len = CHAR_STRING (c, str);
1998 return make_multibyte_string (str, 1, len);
2001 *push_text_char_description (c & 0377, str) = 0;
2003 return build_string (str);
2006 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2007 a meta bit. */
2008 static int
2009 ascii_sequence_p (seq)
2010 Lisp_Object seq;
2012 int i;
2013 int len = XINT (Flength (seq));
2015 for (i = 0; i < len; i++)
2017 Lisp_Object ii, elt;
2019 XSETFASTINT (ii, i);
2020 elt = Faref (seq, ii);
2022 if (!INTEGERP (elt)
2023 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2024 return 0;
2027 return 1;
2031 /* where-is - finding a command in a set of keymaps. */
2033 static Lisp_Object where_is_internal_1 ();
2034 static void where_is_internal_2 ();
2036 /* This function can GC if Flookup_key autoloads any keymaps. */
2038 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
2039 "Return list of keys that invoke DEFINITION.\n\
2040 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
2041 If KEYMAP is nil, search all the currently active keymaps.\n\
2043 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
2044 rather than a list of all possible key sequences.\n\
2045 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
2046 no matter what it is.\n\
2047 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
2048 and entirely reject menu bindings.\n\
2050 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
2051 to other keymaps or slots. This makes it possible to search for an\n\
2052 indirect definition itself.")
2053 (definition, keymap, firstonly, noindirect)
2054 Lisp_Object definition, keymap;
2055 Lisp_Object firstonly, noindirect;
2057 Lisp_Object maps;
2058 Lisp_Object found, sequences;
2059 Lisp_Object keymap1;
2060 int keymap_specified = !NILP (keymap);
2061 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2062 /* 1 means ignore all menu bindings entirely. */
2063 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2065 /* Find keymaps accessible from `keymap' or the current
2066 context. But don't muck with the value of `keymap',
2067 because `where_is_internal_1' uses it to check for
2068 shadowed bindings. */
2069 keymap1 = keymap;
2070 if (! keymap_specified)
2071 keymap1 = get_local_map (PT, current_buffer);
2073 if (!NILP (keymap1))
2074 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
2075 Faccessible_keymaps (get_keymap (current_global_map),
2076 Qnil));
2077 else
2078 maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
2080 /* Put the minor mode keymaps on the front. */
2081 if (! keymap_specified)
2083 Lisp_Object minors;
2084 minors = Fnreverse (Fcurrent_minor_mode_maps ());
2085 while (!NILP (minors))
2087 maps = nconc2 (Faccessible_keymaps (get_keymap (XCAR (minors)),
2088 Qnil),
2089 maps);
2090 minors = XCDR (minors);
2094 GCPRO5 (definition, keymap, maps, found, sequences);
2095 found = Qnil;
2096 sequences = Qnil;
2098 for (; !NILP (maps); maps = Fcdr (maps))
2100 /* Key sequence to reach map, and the map that it reaches */
2101 register Lisp_Object this, map;
2103 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2104 [M-CHAR] sequences, check if last character of the sequence
2105 is the meta-prefix char. */
2106 Lisp_Object last;
2107 int last_is_meta;
2109 this = Fcar (Fcar (maps));
2110 map = Fcdr (Fcar (maps));
2111 last = make_number (XINT (Flength (this)) - 1);
2112 last_is_meta = (XINT (last) >= 0
2113 && EQ (Faref (this, last), meta_prefix_char));
2115 QUIT;
2117 while (CONSP (map))
2119 /* Because the code we want to run on each binding is rather
2120 large, we don't want to have two separate loop bodies for
2121 sparse keymap bindings and tables; we want to iterate one
2122 loop body over both keymap and vector bindings.
2124 For this reason, if Fcar (map) is a vector, we don't
2125 advance map to the next element until i indicates that we
2126 have finished off the vector. */
2127 Lisp_Object elt, key, binding;
2128 elt = XCAR (map);
2129 map = XCDR (map);
2131 sequences = Qnil;
2133 QUIT;
2135 /* Set key and binding to the current key and binding, and
2136 advance map and i to the next binding. */
2137 if (VECTORP (elt))
2139 Lisp_Object sequence;
2140 int i;
2141 /* In a vector, look at each element. */
2142 for (i = 0; i < XVECTOR (elt)->size; i++)
2144 binding = XVECTOR (elt)->contents[i];
2145 XSETFASTINT (key, i);
2146 sequence = where_is_internal_1 (binding, key, definition,
2147 noindirect, keymap, this,
2148 last, nomenus, last_is_meta);
2149 if (!NILP (sequence))
2150 sequences = Fcons (sequence, sequences);
2153 else if (CHAR_TABLE_P (elt))
2155 Lisp_Object indices[3];
2156 Lisp_Object args;
2158 args = Fcons (Fcons (Fcons (definition, noindirect),
2159 Fcons (keymap, Qnil)),
2160 Fcons (Fcons (this, last),
2161 Fcons (make_number (nomenus),
2162 make_number (last_is_meta))));
2164 map_char_table (where_is_internal_2, Qnil, elt, args,
2165 0, indices);
2166 sequences = XCDR (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, keymap, 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 /* It is a true unshadowed match. Record it, unless it's already
2190 been seen (as could happen when inheriting keymaps). */
2191 if (NILP (Fmember (sequence, found)))
2192 found = Fcons (sequence, found);
2194 /* If firstonly is Qnon_ascii, then we can return the first
2195 binding we find. If firstonly is not Qnon_ascii but not
2196 nil, then we should return the first ascii-only binding
2197 we find. */
2198 if (EQ (firstonly, Qnon_ascii))
2199 RETURN_UNGCPRO (sequence);
2200 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
2201 RETURN_UNGCPRO (sequence);
2206 UNGCPRO;
2208 found = Fnreverse (found);
2210 /* firstonly may have been t, but we may have gone all the way through
2211 the keymaps without finding an all-ASCII key sequence. So just
2212 return the best we could find. */
2213 if (! NILP (firstonly))
2214 return Fcar (found);
2216 return found;
2219 /* This is the function that Fwhere_is_internal calls using map_char_table.
2220 ARGS has the form
2221 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2223 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2224 Since map_char_table doesn't really use the return value from this function,
2225 we the result append to RESULT, the slot in ARGS. */
2227 static void
2228 where_is_internal_2 (args, key, binding)
2229 Lisp_Object args, key, binding;
2231 Lisp_Object definition, noindirect, keymap, this, last;
2232 Lisp_Object result, sequence;
2233 int nomenus, last_is_meta;
2235 result = XCDR (XCDR (XCAR (args)));
2236 definition = XCAR (XCAR (XCAR (args)));
2237 noindirect = XCDR (XCAR (XCAR (args)));
2238 keymap = XCAR (XCDR (XCAR (args)));
2239 this = XCAR (XCAR (XCDR (args)));
2240 last = XCDR (XCAR (XCDR (args)));
2241 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2242 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2244 sequence = where_is_internal_1 (binding, key, definition, noindirect, keymap,
2245 this, last, nomenus, last_is_meta);
2247 if (!NILP (sequence))
2248 XCDR (XCDR (XCAR (args)))
2249 = Fcons (sequence, result);
2252 static Lisp_Object
2253 where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
2254 nomenus, last_is_meta)
2255 Lisp_Object binding, key, definition, noindirect, keymap, this, last;
2256 int nomenus, last_is_meta;
2258 Lisp_Object sequence;
2259 int keymap_specified = !NILP (keymap);
2261 /* Search through indirections unless that's not wanted. */
2262 if (NILP (noindirect))
2264 if (nomenus)
2266 while (1)
2268 Lisp_Object map, tem;
2269 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
2270 map = get_keymap_1 (Fcar_safe (definition), 0, 0);
2271 tem = Fkeymapp (map);
2272 if (!NILP (tem))
2273 definition = access_keymap (map, Fcdr (definition), 0, 0);
2274 else
2275 break;
2277 /* If the contents are (menu-item ...) or (STRING ...), reject. */
2278 if (CONSP (definition)
2279 && (EQ (XCAR (definition),Qmenu_item)
2280 || STRINGP (XCAR (definition))))
2281 return Qnil;
2283 else
2284 binding = get_keyelt (binding, 0);
2287 /* End this iteration if this element does not match
2288 the target. */
2290 if (CONSP (definition))
2292 Lisp_Object tem;
2293 tem = Fequal (binding, definition);
2294 if (NILP (tem))
2295 return Qnil;
2297 else
2298 if (!EQ (binding, definition))
2299 return Qnil;
2301 /* We have found a match.
2302 Construct the key sequence where we found it. */
2303 if (INTEGERP (key) && last_is_meta)
2305 sequence = Fcopy_sequence (this);
2306 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2308 else
2309 sequence = append_key (this, key);
2311 /* Verify that this key binding is not shadowed by another
2312 binding for the same key, before we say it exists.
2314 Mechanism: look for local definition of this key and if
2315 it is defined and does not match what we found then
2316 ignore this key.
2318 Either nil or number as value from Flookup_key
2319 means undefined. */
2320 if (keymap_specified)
2322 binding = Flookup_key (keymap, sequence, Qnil);
2323 if (!NILP (binding) && !INTEGERP (binding))
2325 if (CONSP (definition))
2327 Lisp_Object tem;
2328 tem = Fequal (binding, definition);
2329 if (NILP (tem))
2330 return Qnil;
2332 else
2333 if (!EQ (binding, definition))
2334 return Qnil;
2337 else
2339 binding = Fkey_binding (sequence, Qnil);
2340 if (!EQ (binding, definition))
2341 return Qnil;
2344 return sequence;
2347 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2349 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
2350 "Show a list of all defined keys, and their definitions.\n\
2351 We put that list in a buffer, and display the buffer.\n\
2353 The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
2354 \(Ordinarily these are omitted from the output.)\n\
2355 The optional argument PREFIX, if non-nil, should be a key sequence;\n\
2356 then we display only bindings that start with that prefix.")
2357 (menus, prefix)
2358 Lisp_Object menus, prefix;
2360 register Lisp_Object thisbuf;
2361 XSETBUFFER (thisbuf, current_buffer);
2362 internal_with_output_to_temp_buffer ("*Help*",
2363 describe_buffer_bindings,
2364 list3 (thisbuf, prefix, menus));
2365 return Qnil;
2368 /* ARG is (BUFFER PREFIX MENU-FLAG). */
2370 static Lisp_Object
2371 describe_buffer_bindings (arg)
2372 Lisp_Object arg;
2374 Lisp_Object descbuf, prefix, shadow;
2375 int nomenu;
2376 register Lisp_Object start1;
2377 struct gcpro gcpro1;
2379 char *alternate_heading
2380 = "\
2381 Keyboard translations:\n\n\
2382 You type Translation\n\
2383 -------- -----------\n";
2385 descbuf = XCAR (arg);
2386 arg = XCDR (arg);
2387 prefix = XCAR (arg);
2388 arg = XCDR (arg);
2389 nomenu = NILP (XCAR (arg));
2391 shadow = Qnil;
2392 GCPRO1 (shadow);
2394 Fset_buffer (Vstandard_output);
2396 /* Report on alternates for keys. */
2397 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
2399 int c;
2400 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
2401 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
2403 for (c = 0; c < translate_len; c++)
2404 if (translate[c] != c)
2406 char buf[KEY_DESCRIPTION_SIZE];
2407 char *bufend;
2409 if (alternate_heading)
2411 insert_string (alternate_heading);
2412 alternate_heading = 0;
2415 bufend = push_key_description (translate[c], buf);
2416 insert (buf, bufend - buf);
2417 Findent_to (make_number (16), make_number (1));
2418 bufend = push_key_description (c, buf);
2419 insert (buf, bufend - buf);
2421 insert ("\n", 1);
2424 insert ("\n", 1);
2427 if (!NILP (Vkey_translation_map))
2428 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2429 "Key translations", nomenu, 1, 0);
2432 int i, nmaps;
2433 Lisp_Object *modes, *maps;
2435 /* Temporarily switch to descbuf, so that we can get that buffer's
2436 minor modes correctly. */
2437 Fset_buffer (descbuf);
2439 if (!NILP (current_kboard->Voverriding_terminal_local_map)
2440 || !NILP (Voverriding_local_map))
2441 nmaps = 0;
2442 else
2443 nmaps = current_minor_maps (&modes, &maps);
2444 Fset_buffer (Vstandard_output);
2446 /* Print the minor mode maps. */
2447 for (i = 0; i < nmaps; i++)
2449 /* The title for a minor mode keymap
2450 is constructed at run time.
2451 We let describe_map_tree do the actual insertion
2452 because it takes care of other features when doing so. */
2453 char *title, *p;
2455 if (!SYMBOLP (modes[i]))
2456 abort();
2458 p = title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
2459 *p++ = '`';
2460 bcopy (XSYMBOL (modes[i])->name->data, p,
2461 XSYMBOL (modes[i])->name->size);
2462 p += XSYMBOL (modes[i])->name->size;
2463 *p++ = '\'';
2464 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
2465 p += sizeof (" Minor Mode Bindings") - 1;
2466 *p = 0;
2468 describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
2469 shadow = Fcons (maps[i], shadow);
2473 /* Print the (major mode) local map. */
2474 if (!NILP (current_kboard->Voverriding_terminal_local_map))
2475 start1 = current_kboard->Voverriding_terminal_local_map;
2476 else if (!NILP (Voverriding_local_map))
2477 start1 = Voverriding_local_map;
2478 else
2479 start1 = XBUFFER (descbuf)->keymap;
2481 if (!NILP (start1))
2483 describe_map_tree (start1, 1, shadow, prefix,
2484 "Major Mode Bindings", nomenu, 0, 0);
2485 shadow = Fcons (start1, shadow);
2488 describe_map_tree (current_global_map, 1, shadow, prefix,
2489 "Global Bindings", nomenu, 0, 1);
2491 /* Print the function-key-map translations under this prefix. */
2492 if (!NILP (Vfunction_key_map))
2493 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
2494 "Function key map translations", nomenu, 1, 0);
2496 call0 (intern ("help-mode"));
2497 Fset_buffer (descbuf);
2498 UNGCPRO;
2499 return Qnil;
2502 /* Insert a description of the key bindings in STARTMAP,
2503 followed by those of all maps reachable through STARTMAP.
2504 If PARTIAL is nonzero, omit certain "uninteresting" commands
2505 (such as `undefined').
2506 If SHADOW is non-nil, it is a list of maps;
2507 don't mention keys which would be shadowed by any of them.
2508 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2509 TITLE, if not 0, is a string to insert at the beginning.
2510 TITLE should not end with a colon or a newline; we supply that.
2511 If NOMENU is not 0, then omit menu-bar commands.
2513 If TRANSL is nonzero, the definitions are actually key translations
2514 so print strings and vectors differently.
2516 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2517 to look through. */
2519 void
2520 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
2521 always_title)
2522 Lisp_Object startmap, shadow, prefix;
2523 int partial;
2524 char *title;
2525 int nomenu;
2526 int transl;
2527 int always_title;
2529 Lisp_Object maps, orig_maps, seen, sub_shadows;
2530 struct gcpro gcpro1, gcpro2, gcpro3;
2531 int something = 0;
2532 char *key_heading
2533 = "\
2534 key binding\n\
2535 --- -------\n";
2537 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
2538 seen = Qnil;
2539 sub_shadows = Qnil;
2540 GCPRO3 (maps, seen, sub_shadows);
2542 if (nomenu)
2544 Lisp_Object list;
2546 /* Delete from MAPS each element that is for the menu bar. */
2547 for (list = maps; !NILP (list); list = XCDR (list))
2549 Lisp_Object elt, prefix, tem;
2551 elt = Fcar (list);
2552 prefix = Fcar (elt);
2553 if (XVECTOR (prefix)->size >= 1)
2555 tem = Faref (prefix, make_number (0));
2556 if (EQ (tem, Qmenu_bar))
2557 maps = Fdelq (elt, maps);
2562 if (!NILP (maps) || always_title)
2564 if (title)
2566 insert_string (title);
2567 if (!NILP (prefix))
2569 insert_string (" Starting With ");
2570 insert1 (Fkey_description (prefix));
2572 insert_string (":\n");
2574 insert_string (key_heading);
2575 something = 1;
2578 for (; !NILP (maps); maps = Fcdr (maps))
2580 register Lisp_Object elt, prefix, tail;
2582 elt = Fcar (maps);
2583 prefix = Fcar (elt);
2585 sub_shadows = Qnil;
2587 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2589 Lisp_Object shmap;
2591 shmap = XCAR (tail);
2593 /* If the sequence by which we reach this keymap is zero-length,
2594 then the shadow map for this keymap is just SHADOW. */
2595 if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
2596 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
2598 /* If the sequence by which we reach this keymap actually has
2599 some elements, then the sequence's definition in SHADOW is
2600 what we should use. */
2601 else
2603 shmap = Flookup_key (shmap, Fcar (elt), Qt);
2604 if (INTEGERP (shmap))
2605 shmap = Qnil;
2608 /* If shmap is not nil and not a keymap,
2609 it completely shadows this map, so don't
2610 describe this map at all. */
2611 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
2612 goto skip;
2614 if (!NILP (shmap))
2615 sub_shadows = Fcons (shmap, sub_shadows);
2618 /* Maps we have already listed in this loop shadow this map. */
2619 for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
2621 Lisp_Object tem;
2622 tem = Fequal (Fcar (XCAR (tail)), prefix);
2623 if (! NILP (tem))
2624 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
2627 describe_map (Fcdr (elt), prefix,
2628 transl ? describe_translation : describe_command,
2629 partial, sub_shadows, &seen, nomenu);
2631 skip: ;
2634 if (something)
2635 insert_string ("\n");
2637 UNGCPRO;
2640 static int previous_description_column;
2642 static void
2643 describe_command (definition)
2644 Lisp_Object definition;
2646 register Lisp_Object tem1;
2647 int column = current_column ();
2648 int description_column;
2650 /* If column 16 is no good, go to col 32;
2651 but don't push beyond that--go to next line instead. */
2652 if (column > 30)
2654 insert_char ('\n');
2655 description_column = 32;
2657 else if (column > 14 || (column > 10 && previous_description_column == 32))
2658 description_column = 32;
2659 else
2660 description_column = 16;
2662 Findent_to (make_number (description_column), make_number (1));
2663 previous_description_column = description_column;
2665 if (SYMBOLP (definition))
2667 XSETSTRING (tem1, XSYMBOL (definition)->name);
2668 insert1 (tem1);
2669 insert_string ("\n");
2671 else if (STRINGP (definition) || VECTORP (definition))
2672 insert_string ("Keyboard Macro\n");
2673 else
2675 tem1 = Fkeymapp (definition);
2676 if (!NILP (tem1))
2677 insert_string ("Prefix Command\n");
2678 else
2679 insert_string ("??\n");
2683 static void
2684 describe_translation (definition)
2685 Lisp_Object definition;
2687 register Lisp_Object tem1;
2689 Findent_to (make_number (16), make_number (1));
2691 if (SYMBOLP (definition))
2693 XSETSTRING (tem1, XSYMBOL (definition)->name);
2694 insert1 (tem1);
2695 insert_string ("\n");
2697 else if (STRINGP (definition) || VECTORP (definition))
2699 insert1 (Fkey_description (definition));
2700 insert_string ("\n");
2702 else
2704 tem1 = Fkeymapp (definition);
2705 if (!NILP (tem1))
2706 insert_string ("Prefix Command\n");
2707 else
2708 insert_string ("??\n");
2712 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2713 Returns the first non-nil binding found in any of those maps. */
2715 static Lisp_Object
2716 shadow_lookup (shadow, key, flag)
2717 Lisp_Object shadow, key, flag;
2719 Lisp_Object tail, value;
2721 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2723 value = Flookup_key (XCAR (tail), key, flag);
2724 if (!NILP (value))
2725 return value;
2727 return Qnil;
2730 /* Describe the contents of map MAP, assuming that this map itself is
2731 reached by the sequence of prefix keys KEYS (a string or vector).
2732 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2734 static void
2735 describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
2736 register Lisp_Object map;
2737 Lisp_Object keys;
2738 void (*elt_describer) P_ ((Lisp_Object));
2739 int partial;
2740 Lisp_Object shadow;
2741 Lisp_Object *seen;
2742 int nomenu;
2744 Lisp_Object elt_prefix;
2745 Lisp_Object tail, definition, event;
2746 Lisp_Object tem;
2747 Lisp_Object suppress;
2748 Lisp_Object kludge;
2749 int first = 1;
2750 struct gcpro gcpro1, gcpro2, gcpro3;
2752 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2754 /* Call Fkey_description first, to avoid GC bug for the other string. */
2755 tem = Fkey_description (keys);
2756 elt_prefix = concat2 (tem, build_string (" "));
2758 else
2759 elt_prefix = Qnil;
2761 if (partial)
2762 suppress = intern ("suppress-keymap");
2764 /* This vector gets used to present single keys to Flookup_key. Since
2765 that is done once per keymap element, we don't want to cons up a
2766 fresh vector every time. */
2767 kludge = Fmake_vector (make_number (1), Qnil);
2768 definition = Qnil;
2770 GCPRO3 (elt_prefix, definition, kludge);
2772 for (tail = map; CONSP (tail); tail = XCDR (tail))
2774 QUIT;
2776 if (VECTORP (XCAR (tail))
2777 || CHAR_TABLE_P (XCAR (tail)))
2778 describe_vector (XCAR (tail),
2779 elt_prefix, elt_describer, partial, shadow, map,
2780 (int *)0, 0);
2781 else if (CONSP (XCAR (tail)))
2783 event = XCAR (XCAR (tail));
2785 /* Ignore bindings whose "keys" are not really valid events.
2786 (We get these in the frames and buffers menu.) */
2787 if (! (SYMBOLP (event) || INTEGERP (event)))
2788 continue;
2790 if (nomenu && EQ (event, Qmenu_bar))
2791 continue;
2793 definition = get_keyelt (XCDR (XCAR (tail)), 0);
2795 /* Don't show undefined commands or suppressed commands. */
2796 if (NILP (definition)) continue;
2797 if (SYMBOLP (definition) && partial)
2799 tem = Fget (definition, suppress);
2800 if (!NILP (tem))
2801 continue;
2804 /* Don't show a command that isn't really visible
2805 because a local definition of the same key shadows it. */
2807 XVECTOR (kludge)->contents[0] = event;
2808 if (!NILP (shadow))
2810 tem = shadow_lookup (shadow, kludge, Qt);
2811 if (!NILP (tem)) continue;
2814 tem = Flookup_key (map, kludge, Qt);
2815 if (! EQ (tem, definition)) continue;
2817 if (first)
2819 previous_description_column = 0;
2820 insert ("\n", 1);
2821 first = 0;
2824 if (!NILP (elt_prefix))
2825 insert1 (elt_prefix);
2827 /* THIS gets the string to describe the character EVENT. */
2828 insert1 (Fsingle_key_description (event));
2830 /* Print a description of the definition of this character.
2831 elt_describer will take care of spacing out far enough
2832 for alignment purposes. */
2833 (*elt_describer) (definition);
2835 else if (EQ (XCAR (tail), Qkeymap))
2837 /* The same keymap might be in the structure twice, if we're
2838 using an inherited keymap. So skip anything we've already
2839 encountered. */
2840 tem = Fassq (tail, *seen);
2841 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
2842 break;
2843 *seen = Fcons (Fcons (tail, keys), *seen);
2847 UNGCPRO;
2850 static void
2851 describe_vector_princ (elt)
2852 Lisp_Object elt;
2854 Findent_to (make_number (16), make_number (1));
2855 Fprinc (elt, Qnil);
2856 Fterpri (Qnil);
2859 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2860 "Insert a description of contents of VECTOR.\n\
2861 This is text showing the elements of vector matched against indices.")
2862 (vector)
2863 Lisp_Object vector;
2865 int count = specpdl_ptr - specpdl;
2867 specbind (Qstandard_output, Fcurrent_buffer ());
2868 CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
2869 describe_vector (vector, Qnil, describe_vector_princ, 0,
2870 Qnil, Qnil, (int *)0, 0);
2872 return unbind_to (count, Qnil);
2875 /* Insert in the current buffer a description of the contents of VECTOR.
2876 We call ELT_DESCRIBER to insert the description of one value found
2877 in VECTOR.
2879 ELT_PREFIX describes what "comes before" the keys or indices defined
2880 by this vector. This is a human-readable string whose size
2881 is not necessarily related to the situation.
2883 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2884 leads to this keymap.
2886 If the vector is a chartable, ELT_PREFIX is the vector
2887 of bytes that lead to the character set or portion of a character
2888 set described by this chartable.
2890 If PARTIAL is nonzero, it means do not mention suppressed commands
2891 (that assumes the vector is in a keymap).
2893 SHADOW is a list of keymaps that shadow this map.
2894 If it is non-nil, then we look up the key in those maps
2895 and we don't mention it now if it is defined by any of them.
2897 ENTIRE_MAP is the keymap in which this vector appears.
2898 If the definition in effect in the whole map does not match
2899 the one in this vector, we ignore this one.
2901 When describing a sub-char-table, INDICES is a list of
2902 indices at higher levels in this char-table,
2903 and CHAR_TABLE_DEPTH says how many levels down we have gone. */
2905 void
2906 describe_vector (vector, elt_prefix, elt_describer,
2907 partial, shadow, entire_map,
2908 indices, char_table_depth)
2909 register Lisp_Object vector;
2910 Lisp_Object elt_prefix;
2911 void (*elt_describer) P_ ((Lisp_Object));
2912 int partial;
2913 Lisp_Object shadow;
2914 Lisp_Object entire_map;
2915 int *indices;
2916 int char_table_depth;
2918 Lisp_Object definition;
2919 Lisp_Object tem2;
2920 register int i;
2921 Lisp_Object suppress;
2922 Lisp_Object kludge;
2923 int first = 1;
2924 struct gcpro gcpro1, gcpro2, gcpro3;
2925 /* Range of elements to be handled. */
2926 int from, to;
2927 /* A flag to tell if a leaf in this level of char-table is not a
2928 generic character (i.e. a complete multibyte character). */
2929 int complete_char;
2930 int character;
2931 int starting_i;
2933 if (indices == 0)
2934 indices = (int *) alloca (3 * sizeof (int));
2936 definition = Qnil;
2938 /* This vector gets used to present single keys to Flookup_key. Since
2939 that is done once per vector element, we don't want to cons up a
2940 fresh vector every time. */
2941 kludge = Fmake_vector (make_number (1), Qnil);
2942 GCPRO3 (elt_prefix, definition, kludge);
2944 if (partial)
2945 suppress = intern ("suppress-keymap");
2947 if (CHAR_TABLE_P (vector))
2949 if (char_table_depth == 0)
2951 /* VECTOR is a top level char-table. */
2952 complete_char = 1;
2953 from = 0;
2954 to = CHAR_TABLE_ORDINARY_SLOTS;
2956 else
2958 /* VECTOR is a sub char-table. */
2959 if (char_table_depth >= 3)
2960 /* A char-table is never that deep. */
2961 error ("Too deep char table");
2963 complete_char
2964 = (CHARSET_VALID_P (indices[0])
2965 && ((CHARSET_DIMENSION (indices[0]) == 1
2966 && char_table_depth == 1)
2967 || char_table_depth == 2));
2969 /* Meaningful elements are from 32th to 127th. */
2970 from = 32;
2971 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
2974 else
2976 /* This does the right thing for ordinary vectors. */
2978 complete_char = 1;
2979 from = 0;
2980 to = XVECTOR (vector)->size;
2983 for (i = from; i < to; i++)
2985 QUIT;
2987 if (CHAR_TABLE_P (vector))
2989 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
2990 complete_char = 0;
2992 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
2993 && !CHARSET_DEFINED_P (i - 128))
2994 continue;
2996 definition
2997 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
2999 else
3000 definition = get_keyelt (XVECTOR (vector)->contents[i], 0);
3002 if (NILP (definition)) continue;
3004 /* Don't mention suppressed commands. */
3005 if (SYMBOLP (definition) && partial)
3007 Lisp_Object tem;
3009 tem = Fget (definition, suppress);
3011 if (!NILP (tem)) continue;
3014 /* Set CHARACTER to the character this entry describes, if any.
3015 Also update *INDICES. */
3016 if (CHAR_TABLE_P (vector))
3018 indices[char_table_depth] = i;
3020 if (char_table_depth == 0)
3022 character = i;
3023 indices[0] = i - 128;
3025 else if (complete_char)
3027 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3029 else
3030 character = 0;
3032 else
3033 character = i;
3035 /* If this binding is shadowed by some other map, ignore it. */
3036 if (!NILP (shadow) && complete_char)
3038 Lisp_Object tem;
3040 XVECTOR (kludge)->contents[0] = make_number (character);
3041 tem = shadow_lookup (shadow, kludge, Qt);
3043 if (!NILP (tem)) continue;
3046 /* Ignore this definition if it is shadowed by an earlier
3047 one in the same keymap. */
3048 if (!NILP (entire_map) && complete_char)
3050 Lisp_Object tem;
3052 XVECTOR (kludge)->contents[0] = make_number (character);
3053 tem = Flookup_key (entire_map, kludge, Qt);
3055 if (! EQ (tem, definition))
3056 continue;
3059 if (first)
3061 if (char_table_depth == 0)
3062 insert ("\n", 1);
3063 first = 0;
3066 /* For a sub char-table, show the depth by indentation.
3067 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3068 if (char_table_depth > 0)
3069 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3071 /* Output the prefix that applies to every entry in this map. */
3072 if (!NILP (elt_prefix))
3073 insert1 (elt_prefix);
3075 /* Insert or describe the character this slot is for,
3076 or a description of what it is for. */
3077 if (SUB_CHAR_TABLE_P (vector))
3079 if (complete_char)
3080 insert_char (character);
3081 else
3083 /* We need an octal representation for this block of
3084 characters. */
3085 char work[16];
3086 sprintf (work, "(row %d)", i);
3087 insert (work, strlen (work));
3090 else if (CHAR_TABLE_P (vector))
3092 if (complete_char)
3093 insert1 (Fsingle_key_description (make_number (character)));
3094 else
3096 /* Print the information for this character set. */
3097 insert_string ("<");
3098 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3099 if (STRINGP (tem2))
3100 insert_from_string (tem2, 0, 0, XSTRING (tem2)->size,
3101 STRING_BYTES (XSTRING (tem2)), 0);
3102 else
3103 insert ("?", 1);
3104 insert (">", 1);
3107 else
3109 insert1 (Fsingle_key_description (make_number (character)));
3112 /* If we find a sub char-table within a char-table,
3113 scan it recursively; it defines the details for
3114 a character set or a portion of a character set. */
3115 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3117 insert ("\n", 1);
3118 describe_vector (definition, elt_prefix, elt_describer,
3119 partial, shadow, entire_map,
3120 indices, char_table_depth + 1);
3121 continue;
3124 starting_i = i;
3126 /* Find all consecutive characters or rows that have the same
3127 definition. But, for elements of a top level char table, if
3128 they are for charsets, we had better describe one by one even
3129 if they have the same definition. */
3130 if (CHAR_TABLE_P (vector))
3132 int limit = to;
3134 if (char_table_depth == 0)
3135 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3137 while (i + 1 < limit
3138 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3139 !NILP (tem2))
3140 && !NILP (Fequal (tem2, definition)))
3141 i++;
3143 else
3144 while (i + 1 < to
3145 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i + 1], 0),
3146 !NILP (tem2))
3147 && !NILP (Fequal (tem2, definition)))
3148 i++;
3151 /* If we have a range of more than one character,
3152 print where the range reaches to. */
3154 if (i != starting_i)
3156 insert (" .. ", 4);
3158 if (!NILP (elt_prefix))
3159 insert1 (elt_prefix);
3161 if (CHAR_TABLE_P (vector))
3163 if (char_table_depth == 0)
3165 insert1 (Fsingle_key_description (make_number (i)));
3167 else if (complete_char)
3169 indices[char_table_depth] = i;
3170 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3171 insert_char (character);
3173 else
3175 /* We need an octal representation for this block of
3176 characters. */
3177 char work[16];
3178 sprintf (work, "(row %d)", i);
3179 insert (work, strlen (work));
3182 else
3184 insert1 (Fsingle_key_description (make_number (i)));
3188 /* Print a description of the definition of this character.
3189 elt_describer will take care of spacing out far enough
3190 for alignment purposes. */
3191 (*elt_describer) (definition);
3194 /* For (sub) char-table, print `defalt' slot at last. */
3195 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3197 insert (" ", char_table_depth * 2);
3198 insert_string ("<<default>>");
3199 (*elt_describer) (XCHAR_TABLE (vector)->defalt);
3202 UNGCPRO;
3205 /* Apropos - finding all symbols whose names match a regexp. */
3206 Lisp_Object apropos_predicate;
3207 Lisp_Object apropos_accumulate;
3209 static void
3210 apropos_accum (symbol, string)
3211 Lisp_Object symbol, string;
3213 register Lisp_Object tem;
3215 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3216 if (!NILP (tem) && !NILP (apropos_predicate))
3217 tem = call1 (apropos_predicate, symbol);
3218 if (!NILP (tem))
3219 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3222 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3223 "Show all symbols whose names contain match for REGEXP.\n\
3224 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
3225 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
3226 Return list of symbols found.")
3227 (regexp, predicate)
3228 Lisp_Object regexp, predicate;
3230 struct gcpro gcpro1, gcpro2;
3231 CHECK_STRING (regexp, 0);
3232 apropos_predicate = predicate;
3233 GCPRO2 (apropos_predicate, apropos_accumulate);
3234 apropos_accumulate = Qnil;
3235 map_obarray (Vobarray, apropos_accum, regexp);
3236 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
3237 UNGCPRO;
3238 return apropos_accumulate;
3241 void
3242 syms_of_keymap ()
3244 Qkeymap = intern ("keymap");
3245 staticpro (&Qkeymap);
3247 /* Now we are ready to set up this property, so we can
3248 create char tables. */
3249 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3251 /* Initialize the keymaps standardly used.
3252 Each one is the value of a Lisp variable, and is also
3253 pointed to by a C variable */
3255 global_map = Fmake_keymap (Qnil);
3256 Fset (intern ("global-map"), global_map);
3258 current_global_map = global_map;
3259 staticpro (&global_map);
3260 staticpro (&current_global_map);
3262 meta_map = Fmake_keymap (Qnil);
3263 Fset (intern ("esc-map"), meta_map);
3264 Ffset (intern ("ESC-prefix"), meta_map);
3266 control_x_map = Fmake_keymap (Qnil);
3267 Fset (intern ("ctl-x-map"), control_x_map);
3268 Ffset (intern ("Control-X-prefix"), control_x_map);
3270 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3271 "List of commands given new key bindings recently.\n\
3272 This is used for internal purposes during Emacs startup;\n\
3273 don't alter it yourself.");
3274 Vdefine_key_rebound_commands = Qt;
3276 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3277 "Default keymap to use when reading from the minibuffer.");
3278 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3280 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3281 "Local keymap for the minibuffer when spaces are not allowed.");
3282 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3284 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3285 "Local keymap for minibuffer input with completion.");
3286 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3288 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
3289 "Local keymap for minibuffer input with completion, for exact match.");
3290 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3292 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
3293 "Alist of keymaps to use for minor modes.\n\
3294 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
3295 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
3296 If two active keymaps bind the same key, the keymap appearing earlier\n\
3297 in the list takes precedence.");
3298 Vminor_mode_map_alist = Qnil;
3300 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
3301 "Alist of keymaps to use for minor modes, in current major mode.\n\
3302 This variable is a alist just like `minor-mode-map-alist', and it is\n\
3303 used the same way (and before `minor-mode-map-alist'); however,\n\
3304 it is provided for major modes to bind locally.");
3305 Vminor_mode_overriding_map_alist = Qnil;
3307 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
3308 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
3309 This allows Emacs to recognize function keys sent from ASCII\n\
3310 terminals at any point in a key sequence.\n\
3312 The `read-key-sequence' function replaces any subsequence bound by\n\
3313 `function-key-map' with its binding. More precisely, when the active\n\
3314 keymaps have no binding for the current key sequence but\n\
3315 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
3316 `read-key-sequence' replaces the matching suffix with its binding, and\n\
3317 continues with the new sequence.\n\
3319 The events that come from bindings in `function-key-map' are not\n\
3320 themselves looked up in `function-key-map'.\n\
3322 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
3323 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
3324 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
3325 key, typing `ESC O P x' would return [f1 x].");
3326 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
3328 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
3329 "Keymap of key translations that can override keymaps.\n\
3330 This keymap works like `function-key-map', but comes after that,\n\
3331 and applies even for keys that have ordinary bindings.");
3332 Vkey_translation_map = Qnil;
3334 Qsingle_key_description = intern ("single-key-description");
3335 staticpro (&Qsingle_key_description);
3337 Qkey_description = intern ("key-description");
3338 staticpro (&Qkey_description);
3340 Qkeymapp = intern ("keymapp");
3341 staticpro (&Qkeymapp);
3343 Qnon_ascii = intern ("non-ascii");
3344 staticpro (&Qnon_ascii);
3346 Qmenu_item = intern ("menu-item");
3347 staticpro (&Qmenu_item);
3349 defsubr (&Skeymapp);
3350 defsubr (&Skeymap_parent);
3351 defsubr (&Sset_keymap_parent);
3352 defsubr (&Smake_keymap);
3353 defsubr (&Smake_sparse_keymap);
3354 defsubr (&Scopy_keymap);
3355 defsubr (&Skey_binding);
3356 defsubr (&Slocal_key_binding);
3357 defsubr (&Sglobal_key_binding);
3358 defsubr (&Sminor_mode_key_binding);
3359 defsubr (&Sdefine_key);
3360 defsubr (&Slookup_key);
3361 defsubr (&Sdefine_prefix_command);
3362 defsubr (&Suse_global_map);
3363 defsubr (&Suse_local_map);
3364 defsubr (&Scurrent_local_map);
3365 defsubr (&Scurrent_global_map);
3366 defsubr (&Scurrent_minor_mode_maps);
3367 defsubr (&Saccessible_keymaps);
3368 defsubr (&Skey_description);
3369 defsubr (&Sdescribe_vector);
3370 defsubr (&Ssingle_key_description);
3371 defsubr (&Stext_char_description);
3372 defsubr (&Swhere_is_internal);
3373 defsubr (&Sdescribe_bindings_internal);
3374 defsubr (&Sapropos_internal);
3377 void
3378 keys_of_keymap ()
3380 initial_define_key (global_map, 033, "ESC-prefix");
3381 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");