(XtApplyToWidgets): Cast args of lwlib_bcopy.
[emacs.git] / src / keymap.c
blob5bd628bc16f084a432937fa63849209d5a837c83
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"
33 #include "intervals.h"
35 #define min(a, b) ((a) < (b) ? (a) : (b))
37 /* The number of elements in keymap vectors. */
38 #define DENSE_TABLE_SIZE (0200)
40 /* Actually allocate storage for these variables */
42 Lisp_Object current_global_map; /* Current global keymap */
44 Lisp_Object global_map; /* default global key bindings */
46 Lisp_Object meta_map; /* The keymap used for globally bound
47 ESC-prefixed default commands */
49 Lisp_Object control_x_map; /* The keymap used for globally bound
50 C-x-prefixed default commands */
52 /* was MinibufLocalMap */
53 Lisp_Object Vminibuffer_local_map;
54 /* The keymap used by the minibuf for local
55 bindings when spaces are allowed in the
56 minibuf */
58 /* was MinibufLocalNSMap */
59 Lisp_Object Vminibuffer_local_ns_map;
60 /* The keymap used by the minibuf for local
61 bindings when spaces are not encouraged
62 in the minibuf */
64 /* keymap used for minibuffers when doing completion */
65 /* was MinibufLocalCompletionMap */
66 Lisp_Object Vminibuffer_local_completion_map;
68 /* keymap used for minibuffers when doing completion and require a match */
69 /* was MinibufLocalMustMatchMap */
70 Lisp_Object Vminibuffer_local_must_match_map;
72 /* Alist of minor mode variables and keymaps. */
73 Lisp_Object Vminor_mode_map_alist;
75 /* Alist of major-mode-specific overrides for
76 minor mode variables and keymaps. */
77 Lisp_Object Vminor_mode_overriding_map_alist;
79 /* Keymap mapping ASCII function key sequences onto their preferred forms.
80 Initialized by the terminal-specific lisp files. See DEFVAR for more
81 documentation. */
82 Lisp_Object Vfunction_key_map;
84 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
85 Lisp_Object Vkey_translation_map;
87 /* A list of all commands given new bindings since a certain time
88 when nil was stored here.
89 This is used to speed up recomputation of menu key equivalents
90 when Emacs starts up. t means don't record anything here. */
91 Lisp_Object Vdefine_key_rebound_commands;
93 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item;
95 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
96 in a string key sequence is equivalent to prefixing with this
97 character. */
98 extern Lisp_Object meta_prefix_char;
100 extern Lisp_Object Voverriding_local_map;
102 static Lisp_Object define_as_prefix ();
103 static Lisp_Object describe_buffer_bindings ();
104 static void describe_command (), describe_translation ();
105 static void describe_map ();
107 /* Keymap object support - constructors and predicates. */
109 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
110 "Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).\n\
111 CHARTABLE is a char-table that holds the bindings for the ASCII\n\
112 characters. ALIST is an assoc-list which holds bindings for function keys,\n\
113 mouse events, and any other things that appear in the input stream.\n\
114 All entries in it are initially nil, meaning \"command undefined\".\n\n\
115 The optional arg STRING supplies a menu name for the keymap\n\
116 in case you use it as a menu with `x-popup-menu'.")
117 (string)
118 Lisp_Object string;
120 Lisp_Object tail;
121 if (!NILP (string))
122 tail = Fcons (string, Qnil);
123 else
124 tail = Qnil;
125 return Fcons (Qkeymap,
126 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
129 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
130 "Construct and return a new sparse-keymap list.\n\
131 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
132 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
133 which binds the function key or mouse event SYMBOL to DEFINITION.\n\
134 Initially the alist is nil.\n\n\
135 The optional arg STRING supplies a menu name for the keymap\n\
136 in case you use it as a menu with `x-popup-menu'.")
137 (string)
138 Lisp_Object string;
140 if (!NILP (string))
141 return Fcons (Qkeymap, Fcons (string, Qnil));
142 return Fcons (Qkeymap, Qnil);
145 /* This function is used for installing the standard key bindings
146 at initialization time.
148 For example:
150 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
152 void
153 initial_define_key (keymap, key, defname)
154 Lisp_Object keymap;
155 int key;
156 char *defname;
158 store_in_keymap (keymap, make_number (key), intern (defname));
161 void
162 initial_define_lispy_key (keymap, keyname, defname)
163 Lisp_Object keymap;
164 char *keyname;
165 char *defname;
167 store_in_keymap (keymap, intern (keyname), intern (defname));
170 /* Define character fromchar in map frommap as an alias for character
171 tochar in map tomap. Subsequent redefinitions of the latter WILL
172 affect the former. */
174 #if 0
175 void
176 synkey (frommap, fromchar, tomap, tochar)
177 struct Lisp_Vector *frommap, *tomap;
178 int fromchar, tochar;
180 Lisp_Object v, c;
181 XSETVECTOR (v, tomap);
182 XSETFASTINT (c, tochar);
183 frommap->contents[fromchar] = Fcons (v, c);
185 #endif /* 0 */
187 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
188 "Return t if OBJECT is a keymap.\n\
190 A keymap is a list (keymap . ALIST),\n\
191 or a symbol whose function definition is itself a keymap.\n\
192 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
193 a vector of densely packed bindings for small character codes\n\
194 is also allowed as an element.")
195 (object)
196 Lisp_Object object;
198 return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
201 /* Check that OBJECT is a keymap (after dereferencing through any
202 symbols). If it is, return it.
204 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
205 is an autoload form, do the autoload and try again.
206 If AUTOLOAD is nonzero, callers must assume GC is possible.
208 ERROR controls how we respond if OBJECT isn't a keymap.
209 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
211 Note that most of the time, we don't want to pursue autoloads.
212 Functions like Faccessible_keymaps which scan entire keymap trees
213 shouldn't load every autoloaded keymap. I'm not sure about this,
214 but it seems to me that only read_key_sequence, Flookup_key, and
215 Fdefine_key should cause keymaps to be autoloaded.
217 This function can GC when AUTOLOAD is non-zero, because it calls
218 do_autoload which can GC. */
220 Lisp_Object
221 get_keymap_1 (object, error, autoload)
222 Lisp_Object object;
223 int error, autoload;
225 Lisp_Object tem;
227 autoload_retry:
228 if (NILP (object))
229 goto end;
230 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
231 return object;
232 else
234 tem = indirect_function (object);
235 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
236 return tem;
239 /* Should we do an autoload? Autoload forms for keymaps have
240 Qkeymap as their fifth element. */
241 if (autoload
242 && SYMBOLP (object)
243 && CONSP (tem)
244 && EQ (XCAR (tem), Qautoload))
246 Lisp_Object tail;
248 tail = Fnth (make_number (4), tem);
249 if (EQ (tail, Qkeymap))
251 struct gcpro gcpro1, gcpro2;
253 GCPRO2 (tem, object);
254 do_autoload (tem, object);
255 UNGCPRO;
257 goto autoload_retry;
261 end:
262 if (error)
263 wrong_type_argument (Qkeymapp, object);
264 else
265 return Qnil;
269 /* Follow any symbol chaining, and return the keymap denoted by OBJECT.
270 If OBJECT doesn't denote a keymap at all, signal an error. */
271 Lisp_Object
272 get_keymap (object)
273 Lisp_Object object;
275 return get_keymap_1 (object, 1, 0);
278 /* Return the parent map of the keymap MAP, or nil if it has none.
279 We assume that MAP is a valid keymap. */
281 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
282 "Return the parent keymap of KEYMAP.")
283 (keymap)
284 Lisp_Object keymap;
286 Lisp_Object list;
288 keymap = get_keymap_1 (keymap, 1, 1);
290 /* Skip past the initial element `keymap'. */
291 list = XCDR (keymap);
292 for (; CONSP (list); list = XCDR (list))
294 /* See if there is another `keymap'. */
295 if (EQ (Qkeymap, XCAR (list)))
296 return list;
299 return Qnil;
302 /* Set the parent keymap of MAP to PARENT. */
304 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
305 "Modify KEYMAP to set its parent map to PARENT.\n\
306 PARENT should be nil or another keymap.")
307 (keymap, parent)
308 Lisp_Object keymap, parent;
310 Lisp_Object list, prev;
311 struct gcpro gcpro1;
312 int i;
314 keymap = get_keymap_1 (keymap, 1, 1);
315 GCPRO1 (keymap);
317 if (!NILP (parent))
318 parent = get_keymap_1 (parent, 1, 1);
320 /* Skip past the initial element `keymap'. */
321 prev = keymap;
322 while (1)
324 list = XCDR (prev);
325 /* If there is a parent keymap here, replace it.
326 If we came to the end, add the parent in PREV. */
327 if (! CONSP (list) || EQ (Qkeymap, XCAR (list)))
329 /* If we already have the right parent, return now
330 so that we avoid the loops below. */
331 if (EQ (XCDR (prev), parent))
332 RETURN_UNGCPRO (parent);
334 XCDR (prev) = parent;
335 break;
337 prev = list;
340 /* Scan through for submaps, and set their parents too. */
342 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
344 /* Stop the scan when we come to the parent. */
345 if (EQ (XCAR (list), Qkeymap))
346 break;
348 /* If this element holds a prefix map, deal with it. */
349 if (CONSP (XCAR (list))
350 && CONSP (XCDR (XCAR (list))))
351 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
352 XCDR (XCAR (list)));
354 if (VECTORP (XCAR (list)))
355 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
356 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
357 fix_submap_inheritance (keymap, make_number (i),
358 XVECTOR (XCAR (list))->contents[i]);
360 if (CHAR_TABLE_P (XCAR (list)))
362 Lisp_Object indices[3];
364 map_char_table (fix_submap_inheritance, Qnil, XCAR (list),
365 keymap, 0, indices);
369 RETURN_UNGCPRO (parent);
372 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
373 if EVENT is also a prefix in MAP's parent,
374 make sure that SUBMAP inherits that definition as its own parent. */
376 void
377 fix_submap_inheritance (map, event, submap)
378 Lisp_Object map, event, submap;
380 Lisp_Object map_parent, parent_entry;
382 /* SUBMAP is a cons that we found as a key binding.
383 Discard the other things found in a menu key binding. */
385 if (CONSP (submap))
387 /* May be an old format menu item */
388 if (STRINGP (XCAR (submap)))
390 submap = XCDR (submap);
391 /* Also remove a menu help string, if any,
392 following the menu item name. */
393 if (CONSP (submap) && STRINGP (XCAR (submap)))
394 submap = XCDR (submap);
395 /* Also remove the sublist that caches key equivalences, if any. */
396 if (CONSP (submap)
397 && CONSP (XCAR (submap)))
399 Lisp_Object carcar;
400 carcar = XCAR (XCAR (submap));
401 if (NILP (carcar) || VECTORP (carcar))
402 submap = XCDR (submap);
406 /* Or a new format menu item */
407 else if (EQ (XCAR (submap), Qmenu_item)
408 && CONSP (XCDR (submap)))
410 submap = XCDR (XCDR (submap));
411 if (CONSP (submap))
412 submap = XCAR (submap);
416 /* If it isn't a keymap now, there's no work to do. */
417 if (! CONSP (submap)
418 || ! EQ (XCAR (submap), Qkeymap))
419 return;
421 map_parent = Fkeymap_parent (map);
422 if (! NILP (map_parent))
423 parent_entry = access_keymap (map_parent, event, 0, 0);
424 else
425 parent_entry = Qnil;
427 /* If MAP's parent has something other than a keymap,
428 our own submap shadows it completely, so use nil as SUBMAP's parent. */
429 if (! (CONSP (parent_entry) && EQ (XCAR (parent_entry), Qkeymap)))
430 parent_entry = Qnil;
432 if (! EQ (parent_entry, submap))
434 Lisp_Object submap_parent;
435 submap_parent = submap;
436 while (1)
438 Lisp_Object tem;
439 tem = Fkeymap_parent (submap_parent);
440 if (EQ (tem, parent_entry))
441 return;
442 if (CONSP (tem)
443 && EQ (XCAR (tem), Qkeymap))
444 submap_parent = tem;
445 else
446 break;
448 Fset_keymap_parent (submap_parent, parent_entry);
452 /* Look up IDX in MAP. IDX may be any sort of event.
453 Note that this does only one level of lookup; IDX must be a single
454 event, not a sequence.
456 If T_OK is non-zero, bindings for Qt are treated as default
457 bindings; any key left unmentioned by other tables and bindings is
458 given the binding of Qt.
460 If T_OK is zero, bindings for Qt are not treated specially.
462 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
464 Lisp_Object
465 access_keymap (map, idx, t_ok, noinherit)
466 Lisp_Object map;
467 Lisp_Object idx;
468 int t_ok;
469 int noinherit;
471 int noprefix = 0;
472 Lisp_Object val;
474 /* If idx is a list (some sort of mouse click, perhaps?),
475 the index we want to use is the car of the list, which
476 ought to be a symbol. */
477 idx = EVENT_HEAD (idx);
479 /* If idx is a symbol, it might have modifiers, which need to
480 be put in the canonical order. */
481 if (SYMBOLP (idx))
482 idx = reorder_modifiers (idx);
483 else if (INTEGERP (idx))
484 /* Clobber the high bits that can be present on a machine
485 with more than 24 bits of integer. */
486 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
489 Lisp_Object tail;
490 Lisp_Object t_binding;
492 t_binding = Qnil;
493 for (tail = map; CONSP (tail); tail = XCDR (tail))
495 Lisp_Object binding;
497 binding = XCAR (tail);
498 if (SYMBOLP (binding))
500 /* If NOINHERIT, stop finding prefix definitions
501 after we pass a second occurrence of the `keymap' symbol. */
502 if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
503 noprefix = 1;
505 else if (CONSP (binding))
507 if (EQ (XCAR (binding), idx))
509 val = XCDR (binding);
510 if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
511 return Qnil;
512 if (CONSP (val))
513 fix_submap_inheritance (map, idx, val);
514 return val;
516 if (t_ok && EQ (XCAR (binding), Qt))
517 t_binding = XCDR (binding);
519 else if (VECTORP (binding))
521 if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (binding)->size)
523 val = XVECTOR (binding)->contents[XFASTINT (idx)];
524 if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
525 return Qnil;
526 if (CONSP (val))
527 fix_submap_inheritance (map, idx, val);
528 return val;
531 else if (CHAR_TABLE_P (binding))
533 /* Character codes with modifiers
534 are not included in a char-table.
535 All character codes without modifiers are included. */
536 if (NATNUMP (idx)
537 && ! (XFASTINT (idx)
538 & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
539 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
541 val = Faref (binding, idx);
542 if (noprefix && CONSP (val) && EQ (XCAR (val), Qkeymap))
543 return Qnil;
544 if (CONSP (val))
545 fix_submap_inheritance (map, idx, val);
546 return val;
550 QUIT;
553 return t_binding;
557 /* Given OBJECT which was found in a slot in a keymap,
558 trace indirect definitions to get the actual definition of that slot.
559 An indirect definition is a list of the form
560 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
561 and INDEX is the object to look up in KEYMAP to yield the definition.
563 Also if OBJECT has a menu string as the first element,
564 remove that. Also remove a menu help string as second element.
566 If AUTOLOAD is nonzero, load autoloadable keymaps
567 that are referred to with indirection. */
569 Lisp_Object
570 get_keyelt (object, autoload)
571 register Lisp_Object object;
572 int autoload;
574 while (1)
576 if (!(CONSP (object)))
577 /* This is really the value. */
578 return object;
580 /* If the keymap contents looks like (keymap ...) or (lambda ...)
581 then use itself. */
582 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
583 return object;
585 /* If the keymap contents looks like (menu-item name . DEFN)
586 or (menu-item name DEFN ...) then use DEFN.
587 This is a new format menu item. */
588 else if (EQ (XCAR (object), Qmenu_item))
590 if (CONSP (XCDR (object)))
592 Lisp_Object tem;
594 object = XCDR (XCDR (object));
595 tem = object;
596 if (CONSP (object))
597 object = XCAR (object);
599 /* If there's a `:filter FILTER', apply FILTER to the
600 menu-item's definition to get the real definition to
601 use. Temporarily inhibit GC while evaluating FILTER,
602 because not functions calling get_keyelt are prepared
603 for a GC. */
604 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
605 if (EQ (XCAR (tem), QCfilter))
607 int count = inhibit_garbage_collection ();
608 Lisp_Object filter;
609 filter = XCAR (XCDR (tem));
610 filter = list2 (filter, list2 (Qquote, object));
611 object = menu_item_eval_property (filter);
612 unbind_to (count, Qnil);
613 break;
616 else
617 /* Invalid keymap */
618 return object;
621 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
622 Keymap alist elements like (CHAR MENUSTRING . DEFN)
623 will be used by HierarKey menus. */
624 else if (STRINGP (XCAR (object)))
626 object = XCDR (object);
627 /* Also remove a menu help string, if any,
628 following the menu item name. */
629 if (CONSP (object) && STRINGP (XCAR (object)))
630 object = XCDR (object);
631 /* Also remove the sublist that caches key equivalences, if any. */
632 if (CONSP (object) && CONSP (XCAR (object)))
634 Lisp_Object carcar;
635 carcar = XCAR (XCAR (object));
636 if (NILP (carcar) || VECTORP (carcar))
637 object = XCDR (object);
641 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
642 else
644 Lisp_Object map;
646 map = get_keymap_1 (Fcar_safe (object), 0, autoload);
647 if (NILP (map))
648 /* Invalid keymap */
649 return object;
650 else
652 Lisp_Object key;
653 key = Fcdr (object);
654 if (INTEGERP (key) && (XUINT (key) & meta_modifier))
656 object = access_keymap (map, meta_prefix_char, 0, 0);
657 map = get_keymap_1 (object, 0, autoload);
658 object = access_keymap (map, make_number (XINT (key)
659 & ~meta_modifier),
660 0, 0);
662 else
663 object = access_keymap (map, key, 0, 0);
669 Lisp_Object
670 store_in_keymap (keymap, idx, def)
671 Lisp_Object keymap;
672 register Lisp_Object idx;
673 register Lisp_Object def;
675 /* If we are preparing to dump, and DEF is a menu element
676 with a menu item indicator, copy it to ensure it is not pure. */
677 if (CONSP (def) && PURE_P (def)
678 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
679 def = Fcons (XCAR (def), XCDR (def));
681 if (!CONSP (keymap) || ! EQ (XCAR (keymap), Qkeymap))
682 error ("attempt to define a key in a non-keymap");
684 /* If idx is a list (some sort of mouse click, perhaps?),
685 the index we want to use is the car of the list, which
686 ought to be a symbol. */
687 idx = EVENT_HEAD (idx);
689 /* If idx is a symbol, it might have modifiers, which need to
690 be put in the canonical order. */
691 if (SYMBOLP (idx))
692 idx = reorder_modifiers (idx);
693 else if (INTEGERP (idx))
694 /* Clobber the high bits that can be present on a machine
695 with more than 24 bits of integer. */
696 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
698 /* Scan the keymap for a binding of idx. */
700 Lisp_Object tail;
702 /* The cons after which we should insert new bindings. If the
703 keymap has a table element, we record its position here, so new
704 bindings will go after it; this way, the table will stay
705 towards the front of the alist and character lookups in dense
706 keymaps will remain fast. Otherwise, this just points at the
707 front of the keymap. */
708 Lisp_Object insertion_point;
710 insertion_point = keymap;
711 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
713 Lisp_Object elt;
715 elt = XCAR (tail);
716 if (VECTORP (elt))
718 if (NATNUMP (idx) && XFASTINT (idx) < XVECTOR (elt)->size)
720 XVECTOR (elt)->contents[XFASTINT (idx)] = def;
721 return def;
723 insertion_point = tail;
725 else if (CHAR_TABLE_P (elt))
727 /* Character codes with modifiers
728 are not included in a char-table.
729 All character codes without modifiers are included. */
730 if (NATNUMP (idx)
731 && ! (XFASTINT (idx)
732 & (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
733 | CHAR_SHIFT | CHAR_CTL | CHAR_META)))
735 Faset (elt, idx, def);
736 return def;
738 insertion_point = tail;
740 else if (CONSP (elt))
742 if (EQ (idx, XCAR (elt)))
744 XCDR (elt) = def;
745 return def;
748 else if (SYMBOLP (elt))
750 /* If we find a 'keymap' symbol in the spine of KEYMAP,
751 then we must have found the start of a second keymap
752 being used as the tail of KEYMAP, and a binding for IDX
753 should be inserted before it. */
754 if (EQ (elt, Qkeymap))
755 goto keymap_end;
758 QUIT;
761 keymap_end:
762 /* We have scanned the entire keymap, and not found a binding for
763 IDX. Let's add one. */
764 XCDR (insertion_point)
765 = Fcons (Fcons (idx, def), XCDR (insertion_point));
768 return def;
771 void
772 copy_keymap_1 (chartable, idx, elt)
773 Lisp_Object chartable, idx, elt;
775 if (!SYMBOLP (elt) && ! NILP (Fkeymapp (elt)))
776 Faset (chartable, idx, Fcopy_keymap (elt));
779 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
780 "Return a copy of the keymap KEYMAP.\n\
781 The copy starts out with the same definitions of KEYMAP,\n\
782 but changing either the copy or KEYMAP does not affect the other.\n\
783 Any key definitions that are subkeymaps are recursively copied.\n\
784 However, a key definition which is a symbol whose definition is a keymap\n\
785 is not copied.")
786 (keymap)
787 Lisp_Object keymap;
789 register Lisp_Object copy, tail;
791 copy = Fcopy_alist (get_keymap (keymap));
793 for (tail = copy; CONSP (tail); tail = XCDR (tail))
795 Lisp_Object elt;
797 elt = XCAR (tail);
798 if (CHAR_TABLE_P (elt))
800 Lisp_Object indices[3];
802 elt = Fcopy_sequence (elt);
803 XCAR (tail) = elt;
805 map_char_table (copy_keymap_1, Qnil, elt, elt, 0, indices);
807 else if (VECTORP (elt))
809 int i;
811 elt = Fcopy_sequence (elt);
812 XCAR (tail) = elt;
814 for (i = 0; i < XVECTOR (elt)->size; i++)
815 if (!SYMBOLP (XVECTOR (elt)->contents[i])
816 && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i])))
817 XVECTOR (elt)->contents[i]
818 = Fcopy_keymap (XVECTOR (elt)->contents[i]);
820 else if (CONSP (elt) && CONSP (XCDR (elt)))
822 Lisp_Object tem;
823 tem = XCDR (elt);
825 /* Is this a new format menu item. */
826 if (EQ (XCAR (tem),Qmenu_item))
828 /* Copy cell with menu-item marker. */
829 XCDR (elt)
830 = Fcons (XCAR (tem), XCDR (tem));
831 elt = XCDR (elt);
832 tem = XCDR (elt);
833 if (CONSP (tem))
835 /* Copy cell with menu-item name. */
836 XCDR (elt)
837 = Fcons (XCAR (tem), XCDR (tem));
838 elt = XCDR (elt);
839 tem = XCDR (elt);
841 if (CONSP (tem))
843 /* Copy cell with binding and if the binding is a keymap,
844 copy that. */
845 XCDR (elt)
846 = Fcons (XCAR (tem), XCDR (tem));
847 elt = XCDR (elt);
848 tem = XCAR (elt);
849 if (!(SYMBOLP (tem) || NILP (Fkeymapp (tem))))
850 XCAR (elt) = Fcopy_keymap (tem);
851 tem = XCDR (elt);
852 if (CONSP (tem) && CONSP (XCAR (tem)))
853 /* Delete cache for key equivalences. */
854 XCDR (elt) = XCDR (tem);
857 else
859 /* It may be an old fomat menu item.
860 Skip the optional menu string.
862 if (STRINGP (XCAR (tem)))
864 /* Copy the cell, since copy-alist didn't go this deep. */
865 XCDR (elt)
866 = Fcons (XCAR (tem), XCDR (tem));
867 elt = XCDR (elt);
868 tem = XCDR (elt);
869 /* Also skip the optional menu help string. */
870 if (CONSP (tem) && STRINGP (XCAR (tem)))
872 XCDR (elt)
873 = Fcons (XCAR (tem), XCDR (tem));
874 elt = XCDR (elt);
875 tem = XCDR (elt);
877 /* There may also be a list that caches key equivalences.
878 Just delete it for the new keymap. */
879 if (CONSP (tem)
880 && CONSP (XCAR (tem))
881 && (NILP (XCAR (XCAR (tem)))
882 || VECTORP (XCAR (XCAR (tem)))))
883 XCDR (elt) = XCDR (tem);
885 if (CONSP (elt)
886 && ! SYMBOLP (XCDR (elt))
887 && ! NILP (Fkeymapp (XCDR (elt))))
888 XCDR (elt) = Fcopy_keymap (XCDR (elt));
894 return copy;
897 /* Simple Keymap mutators and accessors. */
899 /* GC is possible in this function if it autoloads a keymap. */
901 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
902 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
903 KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
904 meaning a sequence of keystrokes and events.\n\
905 Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
906 can be included if you use a vector.\n\
907 DEF is anything that can be a key's definition:\n\
908 nil (means key is undefined in this keymap),\n\
909 a command (a Lisp function suitable for interactive calling)\n\
910 a string (treated as a keyboard macro),\n\
911 a keymap (to define a prefix key),\n\
912 a symbol. When the key is looked up, the symbol will stand for its\n\
913 function definition, which should at that time be one of the above,\n\
914 or another symbol whose function definition is used, etc.\n\
915 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
916 (DEFN should be a valid definition in its own right),\n\
917 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
919 If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
920 the front of KEYMAP.")
921 (keymap, key, def)
922 Lisp_Object keymap;
923 Lisp_Object key;
924 Lisp_Object def;
926 register int idx;
927 register Lisp_Object c;
928 register Lisp_Object cmd;
929 int metized = 0;
930 int meta_bit;
931 int length;
932 struct gcpro gcpro1, gcpro2, gcpro3;
934 keymap = get_keymap_1 (keymap, 1, 1);
936 if (!VECTORP (key) && !STRINGP (key))
937 key = wrong_type_argument (Qarrayp, key);
939 length = XFASTINT (Flength (key));
940 if (length == 0)
941 return Qnil;
943 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
944 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
946 GCPRO3 (keymap, key, def);
948 if (VECTORP (key))
949 meta_bit = meta_modifier;
950 else
951 meta_bit = 0x80;
953 idx = 0;
954 while (1)
956 c = Faref (key, make_number (idx));
958 if (CONSP (c) && lucid_event_type_list_p (c))
959 c = Fevent_convert_list (c);
961 if (INTEGERP (c)
962 && (XINT (c) & meta_bit)
963 && !metized)
965 c = meta_prefix_char;
966 metized = 1;
968 else
970 if (INTEGERP (c))
971 XSETINT (c, XINT (c) & ~meta_bit);
973 metized = 0;
974 idx++;
977 if (! INTEGERP (c) && ! SYMBOLP (c) && ! CONSP (c))
978 error ("Key sequence contains invalid events");
980 if (idx == length)
981 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
983 cmd = get_keyelt (access_keymap (keymap, c, 0, 1), 1);
985 /* If this key is undefined, make it a prefix. */
986 if (NILP (cmd))
987 cmd = define_as_prefix (keymap, c);
989 keymap = get_keymap_1 (cmd, 0, 1);
990 if (NILP (keymap))
991 /* We must use Fkey_description rather than just passing key to
992 error; key might be a vector, not a string. */
993 error ("Key sequence %s uses invalid prefix characters",
994 XSTRING (Fkey_description (key))->data);
998 /* Value is number if KEY is too long; NIL if valid but has no definition. */
999 /* GC is possible in this function if it autoloads a keymap. */
1001 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1002 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
1003 nil means undefined. See doc of `define-key' for kinds of definitions.\n\
1005 A number as value means KEY is \"too long\";\n\
1006 that is, characters or symbols in it except for the last one\n\
1007 fail to be a valid sequence of prefix characters in KEYMAP.\n\
1008 The number is how many characters at the front of KEY\n\
1009 it takes to reach a non-prefix command.\n\
1011 Normally, `lookup-key' ignores bindings for t, which act as default\n\
1012 bindings, used when nothing else in the keymap applies; this makes it\n\
1013 usable as a general function for probing keymaps. However, if the\n\
1014 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
1015 recognize the default bindings, just as `read-key-sequence' does.")
1016 (keymap, key, accept_default)
1017 register Lisp_Object keymap;
1018 Lisp_Object key;
1019 Lisp_Object accept_default;
1021 register int idx;
1022 register Lisp_Object cmd;
1023 register Lisp_Object c;
1024 int metized = 0;
1025 int length;
1026 int t_ok = ! NILP (accept_default);
1027 int meta_bit;
1028 struct gcpro gcpro1;
1030 keymap = get_keymap_1 (keymap, 1, 1);
1032 if (!VECTORP (key) && !STRINGP (key))
1033 key = wrong_type_argument (Qarrayp, key);
1035 length = XFASTINT (Flength (key));
1036 if (length == 0)
1037 return keymap;
1039 if (VECTORP (key))
1040 meta_bit = meta_modifier;
1041 else
1042 meta_bit = 0x80;
1044 GCPRO1 (key);
1046 idx = 0;
1047 while (1)
1049 c = Faref (key, make_number (idx));
1051 if (CONSP (c) && lucid_event_type_list_p (c))
1052 c = Fevent_convert_list (c);
1054 if (INTEGERP (c)
1055 && (XINT (c) & meta_bit)
1056 && !metized)
1058 c = meta_prefix_char;
1059 metized = 1;
1061 else
1063 if (INTEGERP (c))
1064 XSETINT (c, XINT (c) & ~meta_bit);
1066 metized = 0;
1067 idx++;
1070 cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0), 1);
1071 if (idx == length)
1072 RETURN_UNGCPRO (cmd);
1074 keymap = get_keymap_1 (cmd, 0, 1);
1075 if (NILP (keymap))
1076 RETURN_UNGCPRO (make_number (idx));
1078 QUIT;
1082 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1083 Assume that currently it does not define C at all.
1084 Return the keymap. */
1086 static Lisp_Object
1087 define_as_prefix (keymap, c)
1088 Lisp_Object keymap, c;
1090 Lisp_Object inherit, cmd;
1092 cmd = Fmake_sparse_keymap (Qnil);
1093 /* If this key is defined as a prefix in an inherited keymap,
1094 make it a prefix in this map, and make its definition
1095 inherit the other prefix definition. */
1096 inherit = access_keymap (keymap, c, 0, 0);
1097 #if 0
1098 /* This code is needed to do the right thing in the following case:
1099 keymap A inherits from B,
1100 you define KEY as a prefix in A,
1101 then later you define KEY as a prefix in B.
1102 We want the old prefix definition in A to inherit from that in B.
1103 It is hard to do that retroactively, so this code
1104 creates the prefix in B right away.
1106 But it turns out that this code causes problems immediately
1107 when the prefix in A is defined: it causes B to define KEY
1108 as a prefix with no subcommands.
1110 So I took out this code. */
1111 if (NILP (inherit))
1113 /* If there's an inherited keymap
1114 and it doesn't define this key,
1115 make it define this key. */
1116 Lisp_Object tail;
1118 for (tail = Fcdr (keymap); CONSP (tail); tail = XCDR (tail))
1119 if (EQ (XCAR (tail), Qkeymap))
1120 break;
1122 if (!NILP (tail))
1123 inherit = define_as_prefix (tail, c);
1125 #endif
1127 cmd = nconc2 (cmd, inherit);
1128 store_in_keymap (keymap, c, cmd);
1130 return cmd;
1133 /* Append a key to the end of a key sequence. We always make a vector. */
1135 Lisp_Object
1136 append_key (key_sequence, key)
1137 Lisp_Object key_sequence, key;
1139 Lisp_Object args[2];
1141 args[0] = key_sequence;
1143 args[1] = Fcons (key, Qnil);
1144 return Fvconcat (2, args);
1148 /* Global, local, and minor mode keymap stuff. */
1150 /* We can't put these variables inside current_minor_maps, since under
1151 some systems, static gets macro-defined to be the empty string.
1152 Ickypoo. */
1153 static Lisp_Object *cmm_modes, *cmm_maps;
1154 static int cmm_size;
1156 /* Error handler used in current_minor_maps. */
1157 static Lisp_Object
1158 current_minor_maps_error ()
1160 return Qnil;
1163 /* Store a pointer to an array of the keymaps of the currently active
1164 minor modes in *buf, and return the number of maps it contains.
1166 This function always returns a pointer to the same buffer, and may
1167 free or reallocate it, so if you want to keep it for a long time or
1168 hand it out to lisp code, copy it. This procedure will be called
1169 for every key sequence read, so the nice lispy approach (return a
1170 new assoclist, list, what have you) for each invocation would
1171 result in a lot of consing over time.
1173 If we used xrealloc/xmalloc and ran out of memory, they would throw
1174 back to the command loop, which would try to read a key sequence,
1175 which would call this function again, resulting in an infinite
1176 loop. Instead, we'll use realloc/malloc and silently truncate the
1177 list, let the key sequence be read, and hope some other piece of
1178 code signals the error. */
1180 current_minor_maps (modeptr, mapptr)
1181 Lisp_Object **modeptr, **mapptr;
1183 int i = 0;
1184 int list_number = 0;
1185 Lisp_Object alist, assoc, var, val;
1186 Lisp_Object lists[2];
1188 lists[0] = Vminor_mode_overriding_map_alist;
1189 lists[1] = Vminor_mode_map_alist;
1191 for (list_number = 0; list_number < 2; list_number++)
1192 for (alist = lists[list_number];
1193 CONSP (alist);
1194 alist = XCDR (alist))
1195 if ((assoc = XCAR (alist), CONSP (assoc))
1196 && (var = XCAR (assoc), SYMBOLP (var))
1197 && (val = find_symbol_value (var), ! EQ (val, Qunbound))
1198 && ! NILP (val))
1200 Lisp_Object temp;
1202 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1203 and also an entry in Vminor_mode_map_alist,
1204 ignore the latter. */
1205 if (list_number == 1)
1207 val = assq_no_quit (var, lists[0]);
1208 if (!NILP (val))
1209 break;
1212 if (i >= cmm_size)
1214 Lisp_Object *newmodes, *newmaps;
1216 if (cmm_maps)
1218 BLOCK_INPUT;
1219 cmm_size *= 2;
1220 newmodes
1221 = (Lisp_Object *) realloc (cmm_modes,
1222 cmm_size * sizeof (Lisp_Object));
1223 newmaps
1224 = (Lisp_Object *) realloc (cmm_maps,
1225 cmm_size * sizeof (Lisp_Object));
1226 UNBLOCK_INPUT;
1228 else
1230 BLOCK_INPUT;
1231 cmm_size = 30;
1232 newmodes
1233 = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
1234 newmaps
1235 = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
1236 UNBLOCK_INPUT;
1239 if (newmaps && newmodes)
1241 cmm_modes = newmodes;
1242 cmm_maps = newmaps;
1244 else
1245 break;
1248 /* Get the keymap definition--or nil if it is not defined. */
1249 temp = internal_condition_case_1 (Findirect_function,
1250 XCDR (assoc),
1251 Qerror, current_minor_maps_error);
1252 if (!NILP (temp))
1254 cmm_modes[i] = var;
1255 cmm_maps [i] = temp;
1256 i++;
1260 if (modeptr) *modeptr = cmm_modes;
1261 if (mapptr) *mapptr = cmm_maps;
1262 return i;
1265 /* GC is possible in this function if it autoloads a keymap. */
1267 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
1268 "Return the binding for command KEY in current keymaps.\n\
1269 KEY is a string or vector, a sequence of keystrokes.\n\
1270 The binding is probably a symbol with a function definition.\n\
1272 Normally, `key-binding' ignores bindings for t, which act as default\n\
1273 bindings, used when nothing else in the keymap applies; this makes it\n\
1274 usable as a general function for probing keymaps. However, if the\n\
1275 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
1276 recognize the default bindings, just as `read-key-sequence' does.")
1277 (key, accept_default)
1278 Lisp_Object key, accept_default;
1280 Lisp_Object *maps, value;
1281 int nmaps, i;
1282 struct gcpro gcpro1;
1284 GCPRO1 (key);
1286 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1288 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1289 key, accept_default);
1290 if (! NILP (value) && !INTEGERP (value))
1291 RETURN_UNGCPRO (value);
1293 else if (!NILP (Voverriding_local_map))
1295 value = Flookup_key (Voverriding_local_map, key, accept_default);
1296 if (! NILP (value) && !INTEGERP (value))
1297 RETURN_UNGCPRO (value);
1299 else
1301 Lisp_Object local;
1303 nmaps = current_minor_maps (0, &maps);
1304 /* Note that all these maps are GCPRO'd
1305 in the places where we found them. */
1307 for (i = 0; i < nmaps; i++)
1308 if (! NILP (maps[i]))
1310 value = Flookup_key (maps[i], key, accept_default);
1311 if (! NILP (value) && !INTEGERP (value))
1312 RETURN_UNGCPRO (value);
1315 local = get_local_map (PT, current_buffer, keymap);
1316 if (! NILP (local))
1318 value = Flookup_key (local, key, accept_default);
1319 if (! NILP (value) && !INTEGERP (value))
1320 RETURN_UNGCPRO (value);
1323 local = get_local_map (PT, current_buffer, local_map);
1325 if (! NILP (local))
1327 value = Flookup_key (local, key, accept_default);
1328 if (! NILP (value) && !INTEGERP (value))
1329 RETURN_UNGCPRO (value);
1333 value = Flookup_key (current_global_map, key, accept_default);
1334 UNGCPRO;
1335 if (! NILP (value) && !INTEGERP (value))
1336 return value;
1338 return Qnil;
1341 /* GC is possible in this function if it autoloads a keymap. */
1343 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1344 "Return the binding for command KEYS in current local keymap only.\n\
1345 KEYS is a string, a sequence of keystrokes.\n\
1346 The binding is probably a symbol with a function definition.\n\
1348 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1349 bindings; see the description of `lookup-key' for more details about this.")
1350 (keys, accept_default)
1351 Lisp_Object keys, accept_default;
1353 register Lisp_Object map;
1354 map = current_buffer->keymap;
1355 if (NILP (map))
1356 return Qnil;
1357 return Flookup_key (map, keys, accept_default);
1360 /* GC is possible in this function if it autoloads a keymap. */
1362 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1363 "Return the binding for command KEYS in current global keymap only.\n\
1364 KEYS is a string, a sequence of keystrokes.\n\
1365 The binding is probably a symbol with a function definition.\n\
1366 This function's return values are the same as those of lookup-key\n\
1367 \(which see).\n\
1369 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1370 bindings; see the description of `lookup-key' for more details about this.")
1371 (keys, accept_default)
1372 Lisp_Object keys, accept_default;
1374 return Flookup_key (current_global_map, keys, accept_default);
1377 /* GC is possible in this function if it autoloads a keymap. */
1379 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1380 "Find the visible minor mode bindings of KEY.\n\
1381 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
1382 the symbol which names the minor mode binding KEY, and BINDING is\n\
1383 KEY's definition in that mode. In particular, if KEY has no\n\
1384 minor-mode bindings, return nil. If the first binding is a\n\
1385 non-prefix, all subsequent bindings will be omitted, since they would\n\
1386 be ignored. Similarly, the list doesn't include non-prefix bindings\n\
1387 that come after prefix bindings.\n\
1389 If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
1390 bindings; see the description of `lookup-key' for more details about this.")
1391 (key, accept_default)
1392 Lisp_Object key, accept_default;
1394 Lisp_Object *modes, *maps;
1395 int nmaps;
1396 Lisp_Object binding;
1397 int i, j;
1398 struct gcpro gcpro1, gcpro2;
1400 nmaps = current_minor_maps (&modes, &maps);
1401 /* Note that all these maps are GCPRO'd
1402 in the places where we found them. */
1404 binding = Qnil;
1405 GCPRO2 (key, binding);
1407 for (i = j = 0; i < nmaps; i++)
1408 if (! NILP (maps[i])
1409 && ! NILP (binding = Flookup_key (maps[i], key, accept_default))
1410 && !INTEGERP (binding))
1412 if (! NILP (get_keymap (binding)))
1413 maps[j++] = Fcons (modes[i], binding);
1414 else if (j == 0)
1415 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1418 UNGCPRO;
1419 return Flist (j, maps);
1422 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1423 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
1424 A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1425 If a second optional argument MAPVAR is given, the map is stored as\n\
1426 its value instead of as COMMAND's value; but COMMAND is still defined\n\
1427 as a function.\n\
1428 The third optional argument NAME, if given, supplies a menu name\n\
1429 string for the map. This is required to use the keymap as a menu.")
1430 (command, mapvar, name)
1431 Lisp_Object command, mapvar, name;
1433 Lisp_Object map;
1434 map = Fmake_sparse_keymap (name);
1435 Ffset (command, map);
1436 if (!NILP (mapvar))
1437 Fset (mapvar, map);
1438 else
1439 Fset (command, map);
1440 return command;
1443 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1444 "Select KEYMAP as the global keymap.")
1445 (keymap)
1446 Lisp_Object keymap;
1448 keymap = get_keymap (keymap);
1449 current_global_map = keymap;
1451 return Qnil;
1454 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1455 "Select KEYMAP as the local keymap.\n\
1456 If KEYMAP is nil, that means no local keymap.")
1457 (keymap)
1458 Lisp_Object keymap;
1460 if (!NILP (keymap))
1461 keymap = get_keymap (keymap);
1463 current_buffer->keymap = keymap;
1465 return Qnil;
1468 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1469 "Return current buffer's local keymap, or nil if it has none.")
1472 return current_buffer->keymap;
1475 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1476 "Return the current global keymap.")
1479 return current_global_map;
1482 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1483 "Return a list of keymaps for the minor modes of the current buffer.")
1486 Lisp_Object *maps;
1487 int nmaps = current_minor_maps (0, &maps);
1489 return Flist (nmaps, maps);
1492 /* Help functions for describing and documenting keymaps. */
1494 static void accessible_keymaps_char_table ();
1496 /* This function cannot GC. */
1498 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1499 1, 2, 0,
1500 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1501 Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1502 KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
1503 so that the KEYS increase in length. The first element is ([] . KEYMAP).\n\
1504 An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1505 then the value includes only maps for prefixes that start with PREFIX.")
1506 (keymap, prefix)
1507 Lisp_Object keymap, prefix;
1509 Lisp_Object maps, good_maps, tail;
1510 int prefixlen = 0;
1512 /* no need for gcpro because we don't autoload any keymaps. */
1514 if (!NILP (prefix))
1515 prefixlen = XINT (Flength (prefix));
1517 if (!NILP (prefix))
1519 /* If a prefix was specified, start with the keymap (if any) for
1520 that prefix, so we don't waste time considering other prefixes. */
1521 Lisp_Object tem;
1522 tem = Flookup_key (keymap, prefix, Qt);
1523 /* Flookup_key may give us nil, or a number,
1524 if the prefix is not defined in this particular map.
1525 It might even give us a list that isn't a keymap. */
1526 tem = get_keymap_1 (tem, 0, 0);
1527 if (!NILP (tem))
1529 /* Convert PREFIX to a vector now, so that later on
1530 we don't have to deal with the possibility of a string. */
1531 if (STRINGP (prefix))
1533 int i, i_byte, c;
1534 Lisp_Object copy;
1536 copy = Fmake_vector (make_number (XSTRING (prefix)->size), Qnil);
1537 for (i = 0, i_byte = 0; i < XSTRING (prefix)->size;)
1539 int i_before = i;
1541 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
1542 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1543 c ^= 0200 | meta_modifier;
1544 XVECTOR (copy)->contents[i_before] = make_number (c);
1546 prefix = copy;
1548 maps = Fcons (Fcons (prefix, tem), Qnil);
1550 else
1551 return Qnil;
1553 else
1554 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1555 get_keymap (keymap)),
1556 Qnil);
1558 /* For each map in the list maps,
1559 look at any other maps it points to,
1560 and stick them at the end if they are not already in the list.
1562 This is a breadth-first traversal, where tail is the queue of
1563 nodes, and maps accumulates a list of all nodes visited. */
1565 for (tail = maps; CONSP (tail); tail = XCDR (tail))
1567 register Lisp_Object thisseq, thismap;
1568 Lisp_Object last;
1569 /* Does the current sequence end in the meta-prefix-char? */
1570 int is_metized;
1572 thisseq = Fcar (Fcar (tail));
1573 thismap = Fcdr (Fcar (tail));
1574 last = make_number (XINT (Flength (thisseq)) - 1);
1575 is_metized = (XINT (last) >= 0
1576 /* Don't metize the last char of PREFIX. */
1577 && XINT (last) >= prefixlen
1578 && EQ (Faref (thisseq, last), meta_prefix_char));
1580 for (; CONSP (thismap); thismap = XCDR (thismap))
1582 Lisp_Object elt;
1584 elt = XCAR (thismap);
1586 QUIT;
1588 if (CHAR_TABLE_P (elt))
1590 Lisp_Object indices[3];
1592 map_char_table (accessible_keymaps_char_table, Qnil,
1593 elt, Fcons (maps, Fcons (tail, thisseq)),
1594 0, indices);
1596 else if (VECTORP (elt))
1598 register int i;
1600 /* Vector keymap. Scan all the elements. */
1601 for (i = 0; i < XVECTOR (elt)->size; i++)
1603 register Lisp_Object tem;
1604 register Lisp_Object cmd;
1606 cmd = get_keyelt (XVECTOR (elt)->contents[i], 0);
1607 if (NILP (cmd)) continue;
1608 tem = Fkeymapp (cmd);
1609 if (!NILP (tem))
1611 cmd = get_keymap (cmd);
1612 /* Ignore keymaps that are already added to maps. */
1613 tem = Frassq (cmd, maps);
1614 if (NILP (tem))
1616 /* If the last key in thisseq is meta-prefix-char,
1617 turn it into a meta-ized keystroke. We know
1618 that the event we're about to append is an
1619 ascii keystroke since we're processing a
1620 keymap table. */
1621 if (is_metized)
1623 int meta_bit = meta_modifier;
1624 tem = Fcopy_sequence (thisseq);
1626 Faset (tem, last, make_number (i | meta_bit));
1628 /* This new sequence is the same length as
1629 thisseq, so stick it in the list right
1630 after this one. */
1631 XCDR (tail)
1632 = Fcons (Fcons (tem, cmd), XCDR (tail));
1634 else
1636 tem = append_key (thisseq, make_number (i));
1637 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1643 else if (CONSP (elt))
1645 register Lisp_Object cmd, tem;
1647 cmd = get_keyelt (XCDR (elt), 0);
1648 /* Ignore definitions that aren't keymaps themselves. */
1649 tem = Fkeymapp (cmd);
1650 if (!NILP (tem))
1652 /* Ignore keymaps that have been seen already. */
1653 cmd = get_keymap (cmd);
1654 tem = Frassq (cmd, maps);
1655 if (NILP (tem))
1657 /* Let elt be the event defined by this map entry. */
1658 elt = XCAR (elt);
1660 /* If the last key in thisseq is meta-prefix-char, and
1661 this entry is a binding for an ascii keystroke,
1662 turn it into a meta-ized keystroke. */
1663 if (is_metized && INTEGERP (elt))
1665 Lisp_Object element;
1667 element = thisseq;
1668 tem = Fvconcat (1, &element);
1669 XSETFASTINT (XVECTOR (tem)->contents[XINT (last)],
1670 XINT (elt) | meta_modifier);
1672 /* This new sequence is the same length as
1673 thisseq, so stick it in the list right
1674 after this one. */
1675 XCDR (tail)
1676 = Fcons (Fcons (tem, cmd), XCDR (tail));
1678 else
1679 nconc2 (tail,
1680 Fcons (Fcons (append_key (thisseq, elt), cmd),
1681 Qnil));
1688 if (NILP (prefix))
1689 return maps;
1691 /* Now find just the maps whose access prefixes start with PREFIX. */
1693 good_maps = Qnil;
1694 for (; CONSP (maps); maps = XCDR (maps))
1696 Lisp_Object elt, thisseq;
1697 elt = XCAR (maps);
1698 thisseq = XCAR (elt);
1699 /* The access prefix must be at least as long as PREFIX,
1700 and the first elements must match those of PREFIX. */
1701 if (XINT (Flength (thisseq)) >= prefixlen)
1703 int i;
1704 for (i = 0; i < prefixlen; i++)
1706 Lisp_Object i1;
1707 XSETFASTINT (i1, i);
1708 if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1709 break;
1711 if (i == prefixlen)
1712 good_maps = Fcons (elt, good_maps);
1716 return Fnreverse (good_maps);
1719 static void
1720 accessible_keymaps_char_table (args, index, cmd)
1721 Lisp_Object args, index, cmd;
1723 Lisp_Object tem;
1724 Lisp_Object maps, tail, thisseq;
1726 if (NILP (cmd))
1727 return;
1729 maps = XCAR (args);
1730 tail = XCAR (XCDR (args));
1731 thisseq = XCDR (XCDR (args));
1733 tem = Fkeymapp (cmd);
1734 if (!NILP (tem))
1736 cmd = get_keymap (cmd);
1737 /* Ignore keymaps that are already added to maps. */
1738 tem = Frassq (cmd, maps);
1739 if (NILP (tem))
1741 tem = append_key (thisseq, index);
1742 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1747 Lisp_Object Qsingle_key_description, Qkey_description;
1749 /* This function cannot GC. */
1751 DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1752 "Return a pretty description of key-sequence KEYS.\n\
1753 Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1754 spaces are put between sequence elements, etc.")
1755 (keys)
1756 Lisp_Object keys;
1758 int len;
1759 int i, i_byte;
1760 Lisp_Object sep;
1761 Lisp_Object *args;
1763 if (STRINGP (keys))
1765 Lisp_Object vector;
1766 vector = Fmake_vector (Flength (keys), Qnil);
1767 for (i = 0, i_byte = 0; i < XSTRING (keys)->size; )
1769 int c;
1770 int i_before = i;
1772 FETCH_STRING_CHAR_ADVANCE (c, keys, i, i_byte);
1773 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1774 c ^= 0200 | meta_modifier;
1775 XSETFASTINT (XVECTOR (vector)->contents[i_before], c);
1777 keys = vector;
1780 if (VECTORP (keys))
1782 /* In effect, this computes
1783 (mapconcat 'single-key-description keys " ")
1784 but we shouldn't use mapconcat because it can do GC. */
1786 len = XVECTOR (keys)->size;
1787 sep = build_string (" ");
1788 /* This has one extra element at the end that we don't pass to Fconcat. */
1789 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1791 for (i = 0; i < len; i++)
1793 args[i * 2] = Fsingle_key_description (XVECTOR (keys)->contents[i]);
1794 args[i * 2 + 1] = sep;
1797 else if (CONSP (keys))
1799 /* In effect, this computes
1800 (mapconcat 'single-key-description keys " ")
1801 but we shouldn't use mapconcat because it can do GC. */
1803 len = XFASTINT (Flength (keys));
1804 sep = build_string (" ");
1805 /* This has one extra element at the end that we don't pass to Fconcat. */
1806 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1808 for (i = 0; i < len; i++)
1810 args[i * 2] = Fsingle_key_description (XCAR (keys));
1811 args[i * 2 + 1] = sep;
1812 keys = XCDR (keys);
1815 else
1816 keys = wrong_type_argument (Qarrayp, keys);
1818 return Fconcat (len * 2 - 1, args);
1821 char *
1822 push_key_description (c, p)
1823 register unsigned int c;
1824 register char *p;
1826 /* Clear all the meaningless bits above the meta bit. */
1827 c &= meta_modifier | ~ - meta_modifier;
1829 if (c & alt_modifier)
1831 *p++ = 'A';
1832 *p++ = '-';
1833 c -= alt_modifier;
1835 if (c & ctrl_modifier)
1837 *p++ = 'C';
1838 *p++ = '-';
1839 c -= ctrl_modifier;
1841 if (c & hyper_modifier)
1843 *p++ = 'H';
1844 *p++ = '-';
1845 c -= hyper_modifier;
1847 if (c & meta_modifier)
1849 *p++ = 'M';
1850 *p++ = '-';
1851 c -= meta_modifier;
1853 if (c & shift_modifier)
1855 *p++ = 'S';
1856 *p++ = '-';
1857 c -= shift_modifier;
1859 if (c & super_modifier)
1861 *p++ = 's';
1862 *p++ = '-';
1863 c -= super_modifier;
1865 if (c < 040)
1867 if (c == 033)
1869 *p++ = 'E';
1870 *p++ = 'S';
1871 *p++ = 'C';
1873 else if (c == '\t')
1875 *p++ = 'T';
1876 *p++ = 'A';
1877 *p++ = 'B';
1879 else if (c == Ctl ('M'))
1881 *p++ = 'R';
1882 *p++ = 'E';
1883 *p++ = 'T';
1885 else
1887 *p++ = 'C';
1888 *p++ = '-';
1889 if (c > 0 && c <= Ctl ('Z'))
1890 *p++ = c + 0140;
1891 else
1892 *p++ = c + 0100;
1895 else if (c == 0177)
1897 *p++ = 'D';
1898 *p++ = 'E';
1899 *p++ = 'L';
1901 else if (c == ' ')
1903 *p++ = 'S';
1904 *p++ = 'P';
1905 *p++ = 'C';
1907 else if (c < 128
1908 || (NILP (current_buffer->enable_multibyte_characters)
1909 && SINGLE_BYTE_CHAR_P (c)))
1910 *p++ = c;
1911 else
1913 if (! NILP (current_buffer->enable_multibyte_characters))
1914 c = unibyte_char_to_multibyte (c);
1916 if (NILP (current_buffer->enable_multibyte_characters)
1917 || SINGLE_BYTE_CHAR_P (c)
1918 || ! char_valid_p (c, 0))
1920 int bit_offset;
1921 *p++ = '\\';
1922 /* The biggest character code uses 19 bits. */
1923 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
1925 if (c >= (1 << bit_offset))
1926 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
1929 else
1931 p += CHAR_STRING (c, p);
1935 return p;
1938 /* This function cannot GC. */
1940 DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
1941 "Return a pretty description of command character KEY.\n\
1942 Control characters turn into C-whatever, etc.")
1943 (key)
1944 Lisp_Object key;
1946 if (CONSP (key) && lucid_event_type_list_p (key))
1947 key = Fevent_convert_list (key);
1949 key = EVENT_HEAD (key);
1951 if (INTEGERP (key)) /* Normal character */
1953 unsigned int charset, c1, c2;
1954 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
1956 if (SINGLE_BYTE_CHAR_P (without_bits))
1957 charset = 0;
1958 else
1959 SPLIT_CHAR (without_bits, charset, c1, c2);
1961 if (charset
1962 && CHARSET_DEFINED_P (charset)
1963 && ((c1 >= 0 && c1 < 32)
1964 || (c2 >= 0 && c2 < 32)))
1966 /* Handle a generic character. */
1967 Lisp_Object name;
1968 name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
1969 CHECK_STRING (name, 0);
1970 return concat2 (build_string ("Character set "), name);
1972 else
1974 char tem[KEY_DESCRIPTION_SIZE];
1976 *push_key_description (XUINT (key), tem) = 0;
1977 return build_string (tem);
1980 else if (SYMBOLP (key)) /* Function key or event-symbol */
1982 char *buffer = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
1983 sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
1984 return build_string (buffer);
1986 else if (STRINGP (key)) /* Buffer names in the menubar. */
1987 return Fcopy_sequence (key);
1988 else
1989 error ("KEY must be an integer, cons, symbol, or string");
1992 char *
1993 push_text_char_description (c, p)
1994 register unsigned int c;
1995 register char *p;
1997 if (c >= 0200)
1999 *p++ = 'M';
2000 *p++ = '-';
2001 c -= 0200;
2003 if (c < 040)
2005 *p++ = '^';
2006 *p++ = c + 64; /* 'A' - 1 */
2008 else if (c == 0177)
2010 *p++ = '^';
2011 *p++ = '?';
2013 else
2014 *p++ = c;
2015 return p;
2018 /* This function cannot GC. */
2020 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2021 "Return a pretty description of file-character CHARACTER.\n\
2022 Control characters turn into \"^char\", etc.")
2023 (character)
2024 Lisp_Object character;
2026 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2027 unsigned char str[6];
2028 int c;
2030 CHECK_NUMBER (character, 0);
2032 c = XINT (character);
2033 if (!SINGLE_BYTE_CHAR_P (c))
2035 int len = CHAR_STRING (c, str);
2037 return make_multibyte_string (str, 1, len);
2040 *push_text_char_description (c & 0377, str) = 0;
2042 return build_string (str);
2045 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2046 a meta bit. */
2047 static int
2048 ascii_sequence_p (seq)
2049 Lisp_Object seq;
2051 int i;
2052 int len = XINT (Flength (seq));
2054 for (i = 0; i < len; i++)
2056 Lisp_Object ii, elt;
2058 XSETFASTINT (ii, i);
2059 elt = Faref (seq, ii);
2061 if (!INTEGERP (elt)
2062 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2063 return 0;
2066 return 1;
2070 /* where-is - finding a command in a set of keymaps. */
2072 static Lisp_Object where_is_internal_1 ();
2073 static void where_is_internal_2 ();
2075 /* This function can GC if Flookup_key autoloads any keymaps. */
2077 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
2078 "Return list of keys that invoke DEFINITION.\n\
2079 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
2080 If KEYMAP is nil, search all the currently active keymaps.\n\
2082 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
2083 rather than a list of all possible key sequences.\n\
2084 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
2085 no matter what it is.\n\
2086 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
2087 and entirely reject menu bindings.\n\
2089 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
2090 to other keymaps or slots. This makes it possible to search for an\n\
2091 indirect definition itself.")
2092 (definition, xkeymap, firstonly, noindirect)
2093 Lisp_Object definition, xkeymap;
2094 Lisp_Object firstonly, noindirect;
2096 Lisp_Object maps;
2097 Lisp_Object found, sequences;
2098 Lisp_Object keymap1;
2099 int keymap_specified = !NILP (xkeymap);
2100 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2101 /* 1 means ignore all menu bindings entirely. */
2102 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2104 /* Find keymaps accessible from `keymap' or the current
2105 context. But don't muck with the value of `keymap',
2106 because `where_is_internal_1' uses it to check for
2107 shadowed bindings. */
2108 keymap1 = xkeymap;
2109 if (! keymap_specified)
2110 keymap1 = get_local_map (PT, current_buffer, keymap);
2112 if (!NILP (keymap1))
2113 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
2114 Faccessible_keymaps (get_keymap (current_global_map),
2115 Qnil));
2116 else
2118 keymap1 = xkeymap;
2119 if (! keymap_specified)
2120 keymap1 = get_local_map (PT, current_buffer, local_map);
2122 if (!NILP (keymap1))
2123 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
2124 Faccessible_keymaps (get_keymap (current_global_map),
2125 Qnil));
2126 else
2127 maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
2130 /* Put the minor mode keymaps on the front. */
2131 if (! keymap_specified)
2133 Lisp_Object minors;
2134 minors = Fnreverse (Fcurrent_minor_mode_maps ());
2135 while (!NILP (minors))
2137 maps = nconc2 (Faccessible_keymaps (get_keymap (XCAR (minors)),
2138 Qnil),
2139 maps);
2140 minors = XCDR (minors);
2144 GCPRO5 (definition, xkeymap, maps, found, sequences);
2145 found = Qnil;
2146 sequences = Qnil;
2148 for (; !NILP (maps); maps = Fcdr (maps))
2150 /* Key sequence to reach map, and the map that it reaches */
2151 register Lisp_Object this, map;
2153 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2154 [M-CHAR] sequences, check if last character of the sequence
2155 is the meta-prefix char. */
2156 Lisp_Object last;
2157 int last_is_meta;
2159 this = Fcar (Fcar (maps));
2160 map = Fcdr (Fcar (maps));
2161 last = make_number (XINT (Flength (this)) - 1);
2162 last_is_meta = (XINT (last) >= 0
2163 && EQ (Faref (this, last), meta_prefix_char));
2165 QUIT;
2167 while (CONSP (map))
2169 /* Because the code we want to run on each binding is rather
2170 large, we don't want to have two separate loop bodies for
2171 sparse keymap bindings and tables; we want to iterate one
2172 loop body over both keymap and vector bindings.
2174 For this reason, if Fcar (map) is a vector, we don't
2175 advance map to the next element until i indicates that we
2176 have finished off the vector. */
2177 Lisp_Object elt, key, binding;
2178 elt = XCAR (map);
2179 map = XCDR (map);
2181 sequences = Qnil;
2183 QUIT;
2185 /* Set key and binding to the current key and binding, and
2186 advance map and i to the next binding. */
2187 if (VECTORP (elt))
2189 Lisp_Object sequence;
2190 int i;
2191 /* In a vector, look at each element. */
2192 for (i = 0; i < XVECTOR (elt)->size; i++)
2194 binding = XVECTOR (elt)->contents[i];
2195 XSETFASTINT (key, i);
2196 sequence = where_is_internal_1 (binding, key, definition,
2197 noindirect, xkeymap, this,
2198 last, nomenus, last_is_meta);
2199 if (!NILP (sequence))
2200 sequences = Fcons (sequence, sequences);
2203 else if (CHAR_TABLE_P (elt))
2205 Lisp_Object indices[3];
2206 Lisp_Object args;
2208 args = Fcons (Fcons (Fcons (definition, noindirect),
2209 Fcons (xkeymap, Qnil)),
2210 Fcons (Fcons (this, last),
2211 Fcons (make_number (nomenus),
2212 make_number (last_is_meta))));
2213 map_char_table (where_is_internal_2, Qnil, elt, args,
2214 0, indices);
2215 sequences = XCDR (XCDR (XCAR (args)));
2217 else if (CONSP (elt))
2219 Lisp_Object sequence;
2221 key = XCAR (elt);
2222 binding = XCDR (elt);
2224 sequence = where_is_internal_1 (binding, key, definition,
2225 noindirect, xkeymap, this,
2226 last, nomenus, last_is_meta);
2227 if (!NILP (sequence))
2228 sequences = Fcons (sequence, sequences);
2232 for (; ! NILP (sequences); sequences = XCDR (sequences))
2234 Lisp_Object sequence;
2236 sequence = XCAR (sequences);
2238 /* It is a true unshadowed match. Record it, unless it's already
2239 been seen (as could happen when inheriting keymaps). */
2240 if (NILP (Fmember (sequence, found)))
2241 found = Fcons (sequence, found);
2243 /* If firstonly is Qnon_ascii, then we can return the first
2244 binding we find. If firstonly is not Qnon_ascii but not
2245 nil, then we should return the first ascii-only binding
2246 we find. */
2247 if (EQ (firstonly, Qnon_ascii))
2248 RETURN_UNGCPRO (sequence);
2249 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
2250 RETURN_UNGCPRO (sequence);
2255 UNGCPRO;
2257 found = Fnreverse (found);
2259 /* firstonly may have been t, but we may have gone all the way through
2260 the keymaps without finding an all-ASCII key sequence. So just
2261 return the best we could find. */
2262 if (! NILP (firstonly))
2263 return Fcar (found);
2265 return found;
2268 /* This is the function that Fwhere_is_internal calls using map_char_table.
2269 ARGS has the form
2270 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2272 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2273 Since map_char_table doesn't really use the return value from this function,
2274 we the result append to RESULT, the slot in ARGS.
2276 This function can GC because it calls where_is_internal_1 which can
2277 GC. */
2279 static void
2280 where_is_internal_2 (args, key, binding)
2281 Lisp_Object args, key, binding;
2283 Lisp_Object definition, noindirect, keymap, this, last;
2284 Lisp_Object result, sequence;
2285 int nomenus, last_is_meta;
2286 struct gcpro gcpro1, gcpro2, gcpro3;
2288 GCPRO3 (args, key, binding);
2289 result = XCDR (XCDR (XCAR (args)));
2290 definition = XCAR (XCAR (XCAR (args)));
2291 noindirect = XCDR (XCAR (XCAR (args)));
2292 keymap = XCAR (XCDR (XCAR (args)));
2293 this = XCAR (XCAR (XCDR (args)));
2294 last = XCDR (XCAR (XCDR (args)));
2295 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2296 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2298 sequence = where_is_internal_1 (binding, key, definition, noindirect, keymap,
2299 this, last, nomenus, last_is_meta);
2301 if (!NILP (sequence))
2302 XCDR (XCDR (XCAR (args))) = Fcons (sequence, result);
2304 UNGCPRO;
2308 /* This function can GC.because Flookup_key calls get_keymap_1 with
2309 non-zero argument AUTOLOAD. */
2311 static Lisp_Object
2312 where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
2313 nomenus, last_is_meta)
2314 Lisp_Object binding, key, definition, noindirect, keymap, this, last;
2315 int nomenus, last_is_meta;
2317 Lisp_Object sequence;
2318 int keymap_specified = !NILP (keymap);
2319 struct gcpro gcpro1, gcpro2;
2321 /* Search through indirections unless that's not wanted. */
2322 if (NILP (noindirect))
2324 if (nomenus)
2326 while (1)
2328 Lisp_Object map, tem;
2329 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
2330 map = get_keymap_1 (Fcar_safe (definition), 0, 0);
2331 tem = Fkeymapp (map);
2332 if (!NILP (tem))
2333 definition = access_keymap (map, Fcdr (definition), 0, 0);
2334 else
2335 break;
2337 /* If the contents are (menu-item ...) or (STRING ...), reject. */
2338 if (CONSP (definition)
2339 && (EQ (XCAR (definition),Qmenu_item)
2340 || STRINGP (XCAR (definition))))
2341 return Qnil;
2343 else
2344 binding = get_keyelt (binding, 0);
2347 /* End this iteration if this element does not match
2348 the target. */
2350 if (CONSP (definition))
2352 Lisp_Object tem;
2353 tem = Fequal (binding, definition);
2354 if (NILP (tem))
2355 return Qnil;
2357 else
2358 if (!EQ (binding, definition))
2359 return Qnil;
2361 /* We have found a match.
2362 Construct the key sequence where we found it. */
2363 if (INTEGERP (key) && last_is_meta)
2365 sequence = Fcopy_sequence (this);
2366 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2368 else
2369 sequence = append_key (this, key);
2371 /* Verify that this key binding is not shadowed by another
2372 binding for the same key, before we say it exists.
2374 Mechanism: look for local definition of this key and if
2375 it is defined and does not match what we found then
2376 ignore this key.
2378 Either nil or number as value from Flookup_key
2379 means undefined. */
2380 GCPRO2 (sequence, binding);
2381 if (keymap_specified)
2383 binding = Flookup_key (keymap, sequence, Qnil);
2384 if (!NILP (binding) && !INTEGERP (binding))
2386 if (CONSP (definition))
2388 Lisp_Object tem;
2389 tem = Fequal (binding, definition);
2390 if (NILP (tem))
2391 RETURN_UNGCPRO (Qnil);
2393 else
2394 if (!EQ (binding, definition))
2395 RETURN_UNGCPRO (Qnil);
2398 else
2400 binding = Fkey_binding (sequence, Qnil);
2401 if (!EQ (binding, definition))
2402 RETURN_UNGCPRO (Qnil);
2405 RETURN_UNGCPRO (sequence);
2408 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2410 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
2411 "Show a list of all defined keys, and their definitions.\n\
2412 We put that list in a buffer, and display the buffer.\n\
2414 The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
2415 \(Ordinarily these are omitted from the output.)\n\
2416 The optional argument PREFIX, if non-nil, should be a key sequence;\n\
2417 then we display only bindings that start with that prefix.")
2418 (menus, prefix)
2419 Lisp_Object menus, prefix;
2421 register Lisp_Object thisbuf;
2422 XSETBUFFER (thisbuf, current_buffer);
2423 internal_with_output_to_temp_buffer ("*Help*",
2424 describe_buffer_bindings,
2425 list3 (thisbuf, prefix, menus));
2426 return Qnil;
2429 /* ARG is (BUFFER PREFIX MENU-FLAG). */
2431 static Lisp_Object
2432 describe_buffer_bindings (arg)
2433 Lisp_Object arg;
2435 Lisp_Object descbuf, prefix, shadow;
2436 int nomenu;
2437 register Lisp_Object start1;
2438 struct gcpro gcpro1;
2440 char *alternate_heading
2441 = "\
2442 Keyboard translations:\n\n\
2443 You type Translation\n\
2444 -------- -----------\n";
2446 descbuf = XCAR (arg);
2447 arg = XCDR (arg);
2448 prefix = XCAR (arg);
2449 arg = XCDR (arg);
2450 nomenu = NILP (XCAR (arg));
2452 shadow = Qnil;
2453 GCPRO1 (shadow);
2455 Fset_buffer (Vstandard_output);
2457 /* Report on alternates for keys. */
2458 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
2460 int c;
2461 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
2462 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
2464 for (c = 0; c < translate_len; c++)
2465 if (translate[c] != c)
2467 char buf[KEY_DESCRIPTION_SIZE];
2468 char *bufend;
2470 if (alternate_heading)
2472 insert_string (alternate_heading);
2473 alternate_heading = 0;
2476 bufend = push_key_description (translate[c], buf);
2477 insert (buf, bufend - buf);
2478 Findent_to (make_number (16), make_number (1));
2479 bufend = push_key_description (c, buf);
2480 insert (buf, bufend - buf);
2482 insert ("\n", 1);
2485 insert ("\n", 1);
2488 if (!NILP (Vkey_translation_map))
2489 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2490 "Key translations", nomenu, 1, 0);
2493 int i, nmaps;
2494 Lisp_Object *modes, *maps;
2496 /* Temporarily switch to descbuf, so that we can get that buffer's
2497 minor modes correctly. */
2498 Fset_buffer (descbuf);
2500 if (!NILP (current_kboard->Voverriding_terminal_local_map)
2501 || !NILP (Voverriding_local_map))
2502 nmaps = 0;
2503 else
2504 nmaps = current_minor_maps (&modes, &maps);
2505 Fset_buffer (Vstandard_output);
2507 /* Print the minor mode maps. */
2508 for (i = 0; i < nmaps; i++)
2510 /* The title for a minor mode keymap
2511 is constructed at run time.
2512 We let describe_map_tree do the actual insertion
2513 because it takes care of other features when doing so. */
2514 char *title, *p;
2516 if (!SYMBOLP (modes[i]))
2517 abort();
2519 p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size);
2520 *p++ = '\f';
2521 *p++ = '\n';
2522 *p++ = '`';
2523 bcopy (XSYMBOL (modes[i])->name->data, p,
2524 XSYMBOL (modes[i])->name->size);
2525 p += XSYMBOL (modes[i])->name->size;
2526 *p++ = '\'';
2527 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
2528 p += sizeof (" Minor Mode Bindings") - 1;
2529 *p = 0;
2531 describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
2532 shadow = Fcons (maps[i], shadow);
2536 /* Print the (major mode) local map. */
2537 if (!NILP (current_kboard->Voverriding_terminal_local_map))
2538 start1 = current_kboard->Voverriding_terminal_local_map;
2539 else if (!NILP (Voverriding_local_map))
2540 start1 = Voverriding_local_map;
2541 else
2542 start1 = XBUFFER (descbuf)->keymap;
2544 if (!NILP (start1))
2546 describe_map_tree (start1, 1, shadow, prefix,
2547 "\f\nMajor Mode Bindings", nomenu, 0, 0);
2548 shadow = Fcons (start1, shadow);
2551 describe_map_tree (current_global_map, 1, shadow, prefix,
2552 "\f\nGlobal Bindings", nomenu, 0, 1);
2554 /* Print the function-key-map translations under this prefix. */
2555 if (!NILP (Vfunction_key_map))
2556 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
2557 "\f\nFunction key map translations", nomenu, 1, 0);
2559 call0 (intern ("help-mode"));
2560 Fset_buffer (descbuf);
2561 UNGCPRO;
2562 return Qnil;
2565 /* Insert a description of the key bindings in STARTMAP,
2566 followed by those of all maps reachable through STARTMAP.
2567 If PARTIAL is nonzero, omit certain "uninteresting" commands
2568 (such as `undefined').
2569 If SHADOW is non-nil, it is a list of maps;
2570 don't mention keys which would be shadowed by any of them.
2571 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2572 TITLE, if not 0, is a string to insert at the beginning.
2573 TITLE should not end with a colon or a newline; we supply that.
2574 If NOMENU is not 0, then omit menu-bar commands.
2576 If TRANSL is nonzero, the definitions are actually key translations
2577 so print strings and vectors differently.
2579 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2580 to look through. */
2582 void
2583 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
2584 always_title)
2585 Lisp_Object startmap, shadow, prefix;
2586 int partial;
2587 char *title;
2588 int nomenu;
2589 int transl;
2590 int always_title;
2592 Lisp_Object maps, orig_maps, seen, sub_shadows;
2593 struct gcpro gcpro1, gcpro2, gcpro3;
2594 int something = 0;
2595 char *key_heading
2596 = "\
2597 key binding\n\
2598 --- -------\n";
2600 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
2601 seen = Qnil;
2602 sub_shadows = Qnil;
2603 GCPRO3 (maps, seen, sub_shadows);
2605 if (nomenu)
2607 Lisp_Object list;
2609 /* Delete from MAPS each element that is for the menu bar. */
2610 for (list = maps; !NILP (list); list = XCDR (list))
2612 Lisp_Object elt, prefix, tem;
2614 elt = Fcar (list);
2615 prefix = Fcar (elt);
2616 if (XVECTOR (prefix)->size >= 1)
2618 tem = Faref (prefix, make_number (0));
2619 if (EQ (tem, Qmenu_bar))
2620 maps = Fdelq (elt, maps);
2625 if (!NILP (maps) || always_title)
2627 if (title)
2629 insert_string (title);
2630 if (!NILP (prefix))
2632 insert_string (" Starting With ");
2633 insert1 (Fkey_description (prefix));
2635 insert_string (":\n");
2637 insert_string (key_heading);
2638 something = 1;
2641 for (; !NILP (maps); maps = Fcdr (maps))
2643 register Lisp_Object elt, prefix, tail;
2645 elt = Fcar (maps);
2646 prefix = Fcar (elt);
2648 sub_shadows = Qnil;
2650 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2652 Lisp_Object shmap;
2654 shmap = XCAR (tail);
2656 /* If the sequence by which we reach this keymap is zero-length,
2657 then the shadow map for this keymap is just SHADOW. */
2658 if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
2659 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
2661 /* If the sequence by which we reach this keymap actually has
2662 some elements, then the sequence's definition in SHADOW is
2663 what we should use. */
2664 else
2666 shmap = Flookup_key (shmap, Fcar (elt), Qt);
2667 if (INTEGERP (shmap))
2668 shmap = Qnil;
2671 /* If shmap is not nil and not a keymap,
2672 it completely shadows this map, so don't
2673 describe this map at all. */
2674 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
2675 goto skip;
2677 if (!NILP (shmap))
2678 sub_shadows = Fcons (shmap, sub_shadows);
2681 /* Maps we have already listed in this loop shadow this map. */
2682 for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
2684 Lisp_Object tem;
2685 tem = Fequal (Fcar (XCAR (tail)), prefix);
2686 if (! NILP (tem))
2687 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
2690 describe_map (Fcdr (elt), prefix,
2691 transl ? describe_translation : describe_command,
2692 partial, sub_shadows, &seen, nomenu);
2694 skip: ;
2697 if (something)
2698 insert_string ("\n");
2700 UNGCPRO;
2703 static int previous_description_column;
2705 static void
2706 describe_command (definition)
2707 Lisp_Object definition;
2709 register Lisp_Object tem1;
2710 int column = current_column ();
2711 int description_column;
2713 /* If column 16 is no good, go to col 32;
2714 but don't push beyond that--go to next line instead. */
2715 if (column > 30)
2717 insert_char ('\n');
2718 description_column = 32;
2720 else if (column > 14 || (column > 10 && previous_description_column == 32))
2721 description_column = 32;
2722 else
2723 description_column = 16;
2725 Findent_to (make_number (description_column), make_number (1));
2726 previous_description_column = description_column;
2728 if (SYMBOLP (definition))
2730 XSETSTRING (tem1, XSYMBOL (definition)->name);
2731 insert1 (tem1);
2732 insert_string ("\n");
2734 else if (STRINGP (definition) || VECTORP (definition))
2735 insert_string ("Keyboard Macro\n");
2736 else
2738 tem1 = Fkeymapp (definition);
2739 if (!NILP (tem1))
2740 insert_string ("Prefix Command\n");
2741 else
2742 insert_string ("??\n");
2746 static void
2747 describe_translation (definition)
2748 Lisp_Object definition;
2750 register Lisp_Object tem1;
2752 Findent_to (make_number (16), make_number (1));
2754 if (SYMBOLP (definition))
2756 XSETSTRING (tem1, XSYMBOL (definition)->name);
2757 insert1 (tem1);
2758 insert_string ("\n");
2760 else if (STRINGP (definition) || VECTORP (definition))
2762 insert1 (Fkey_description (definition));
2763 insert_string ("\n");
2765 else
2767 tem1 = Fkeymapp (definition);
2768 if (!NILP (tem1))
2769 insert_string ("Prefix Command\n");
2770 else
2771 insert_string ("??\n");
2775 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2776 Returns the first non-nil binding found in any of those maps. */
2778 static Lisp_Object
2779 shadow_lookup (shadow, key, flag)
2780 Lisp_Object shadow, key, flag;
2782 Lisp_Object tail, value;
2784 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2786 value = Flookup_key (XCAR (tail), key, flag);
2787 if (!NILP (value))
2788 return value;
2790 return Qnil;
2793 /* Describe the contents of map MAP, assuming that this map itself is
2794 reached by the sequence of prefix keys KEYS (a string or vector).
2795 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2797 static void
2798 describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
2799 register Lisp_Object map;
2800 Lisp_Object keys;
2801 void (*elt_describer) P_ ((Lisp_Object));
2802 int partial;
2803 Lisp_Object shadow;
2804 Lisp_Object *seen;
2805 int nomenu;
2807 Lisp_Object elt_prefix;
2808 Lisp_Object tail, definition, event;
2809 Lisp_Object tem;
2810 Lisp_Object suppress;
2811 Lisp_Object kludge;
2812 int first = 1;
2813 struct gcpro gcpro1, gcpro2, gcpro3;
2815 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2817 /* Call Fkey_description first, to avoid GC bug for the other string. */
2818 tem = Fkey_description (keys);
2819 elt_prefix = concat2 (tem, build_string (" "));
2821 else
2822 elt_prefix = Qnil;
2824 if (partial)
2825 suppress = intern ("suppress-keymap");
2827 /* This vector gets used to present single keys to Flookup_key. Since
2828 that is done once per keymap element, we don't want to cons up a
2829 fresh vector every time. */
2830 kludge = Fmake_vector (make_number (1), Qnil);
2831 definition = Qnil;
2833 GCPRO3 (elt_prefix, definition, kludge);
2835 for (tail = map; CONSP (tail); tail = XCDR (tail))
2837 QUIT;
2839 if (VECTORP (XCAR (tail))
2840 || CHAR_TABLE_P (XCAR (tail)))
2841 describe_vector (XCAR (tail),
2842 elt_prefix, elt_describer, partial, shadow, map,
2843 (int *)0, 0);
2844 else if (CONSP (XCAR (tail)))
2846 event = XCAR (XCAR (tail));
2848 /* Ignore bindings whose "keys" are not really valid events.
2849 (We get these in the frames and buffers menu.) */
2850 if (! (SYMBOLP (event) || INTEGERP (event)))
2851 continue;
2853 if (nomenu && EQ (event, Qmenu_bar))
2854 continue;
2856 definition = get_keyelt (XCDR (XCAR (tail)), 0);
2858 /* Don't show undefined commands or suppressed commands. */
2859 if (NILP (definition)) continue;
2860 if (SYMBOLP (definition) && partial)
2862 tem = Fget (definition, suppress);
2863 if (!NILP (tem))
2864 continue;
2867 /* Don't show a command that isn't really visible
2868 because a local definition of the same key shadows it. */
2870 XVECTOR (kludge)->contents[0] = event;
2871 if (!NILP (shadow))
2873 tem = shadow_lookup (shadow, kludge, Qt);
2874 if (!NILP (tem)) continue;
2877 tem = Flookup_key (map, kludge, Qt);
2878 if (! EQ (tem, definition)) continue;
2880 if (first)
2882 previous_description_column = 0;
2883 insert ("\n", 1);
2884 first = 0;
2887 if (!NILP (elt_prefix))
2888 insert1 (elt_prefix);
2890 /* THIS gets the string to describe the character EVENT. */
2891 insert1 (Fsingle_key_description (event));
2893 /* Print a description of the definition of this character.
2894 elt_describer will take care of spacing out far enough
2895 for alignment purposes. */
2896 (*elt_describer) (definition);
2898 else if (EQ (XCAR (tail), Qkeymap))
2900 /* The same keymap might be in the structure twice, if we're
2901 using an inherited keymap. So skip anything we've already
2902 encountered. */
2903 tem = Fassq (tail, *seen);
2904 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
2905 break;
2906 *seen = Fcons (Fcons (tail, keys), *seen);
2910 UNGCPRO;
2913 static void
2914 describe_vector_princ (elt)
2915 Lisp_Object elt;
2917 Findent_to (make_number (16), make_number (1));
2918 Fprinc (elt, Qnil);
2919 Fterpri (Qnil);
2922 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2923 "Insert a description of contents of VECTOR.\n\
2924 This is text showing the elements of vector matched against indices.")
2925 (vector)
2926 Lisp_Object vector;
2928 int count = specpdl_ptr - specpdl;
2930 specbind (Qstandard_output, Fcurrent_buffer ());
2931 CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
2932 describe_vector (vector, Qnil, describe_vector_princ, 0,
2933 Qnil, Qnil, (int *)0, 0);
2935 return unbind_to (count, Qnil);
2938 /* Insert in the current buffer a description of the contents of VECTOR.
2939 We call ELT_DESCRIBER to insert the description of one value found
2940 in VECTOR.
2942 ELT_PREFIX describes what "comes before" the keys or indices defined
2943 by this vector. This is a human-readable string whose size
2944 is not necessarily related to the situation.
2946 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2947 leads to this keymap.
2949 If the vector is a chartable, ELT_PREFIX is the vector
2950 of bytes that lead to the character set or portion of a character
2951 set described by this chartable.
2953 If PARTIAL is nonzero, it means do not mention suppressed commands
2954 (that assumes the vector is in a keymap).
2956 SHADOW is a list of keymaps that shadow this map.
2957 If it is non-nil, then we look up the key in those maps
2958 and we don't mention it now if it is defined by any of them.
2960 ENTIRE_MAP is the keymap in which this vector appears.
2961 If the definition in effect in the whole map does not match
2962 the one in this vector, we ignore this one.
2964 When describing a sub-char-table, INDICES is a list of
2965 indices at higher levels in this char-table,
2966 and CHAR_TABLE_DEPTH says how many levels down we have gone. */
2968 void
2969 describe_vector (vector, elt_prefix, elt_describer,
2970 partial, shadow, entire_map,
2971 indices, char_table_depth)
2972 register Lisp_Object vector;
2973 Lisp_Object elt_prefix;
2974 void (*elt_describer) P_ ((Lisp_Object));
2975 int partial;
2976 Lisp_Object shadow;
2977 Lisp_Object entire_map;
2978 int *indices;
2979 int char_table_depth;
2981 Lisp_Object definition;
2982 Lisp_Object tem2;
2983 register int i;
2984 Lisp_Object suppress;
2985 Lisp_Object kludge;
2986 int first = 1;
2987 struct gcpro gcpro1, gcpro2, gcpro3;
2988 /* Range of elements to be handled. */
2989 int from, to;
2990 /* A flag to tell if a leaf in this level of char-table is not a
2991 generic character (i.e. a complete multibyte character). */
2992 int complete_char;
2993 int character;
2994 int starting_i;
2996 if (indices == 0)
2997 indices = (int *) alloca (3 * sizeof (int));
2999 definition = Qnil;
3001 /* This vector gets used to present single keys to Flookup_key. Since
3002 that is done once per vector element, we don't want to cons up a
3003 fresh vector every time. */
3004 kludge = Fmake_vector (make_number (1), Qnil);
3005 GCPRO3 (elt_prefix, definition, kludge);
3007 if (partial)
3008 suppress = intern ("suppress-keymap");
3010 if (CHAR_TABLE_P (vector))
3012 if (char_table_depth == 0)
3014 /* VECTOR is a top level char-table. */
3015 complete_char = 1;
3016 from = 0;
3017 to = CHAR_TABLE_ORDINARY_SLOTS;
3019 else
3021 /* VECTOR is a sub char-table. */
3022 if (char_table_depth >= 3)
3023 /* A char-table is never that deep. */
3024 error ("Too deep char table");
3026 complete_char
3027 = (CHARSET_VALID_P (indices[0])
3028 && ((CHARSET_DIMENSION (indices[0]) == 1
3029 && char_table_depth == 1)
3030 || char_table_depth == 2));
3032 /* Meaningful elements are from 32th to 127th. */
3033 from = 32;
3034 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3037 else
3039 /* This does the right thing for ordinary vectors. */
3041 complete_char = 1;
3042 from = 0;
3043 to = XVECTOR (vector)->size;
3046 for (i = from; i < to; i++)
3048 QUIT;
3050 if (CHAR_TABLE_P (vector))
3052 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3053 complete_char = 0;
3055 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3056 && !CHARSET_DEFINED_P (i - 128))
3057 continue;
3059 definition
3060 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3062 else
3063 definition = get_keyelt (XVECTOR (vector)->contents[i], 0);
3065 if (NILP (definition)) continue;
3067 /* Don't mention suppressed commands. */
3068 if (SYMBOLP (definition) && partial)
3070 Lisp_Object tem;
3072 tem = Fget (definition, suppress);
3074 if (!NILP (tem)) continue;
3077 /* Set CHARACTER to the character this entry describes, if any.
3078 Also update *INDICES. */
3079 if (CHAR_TABLE_P (vector))
3081 indices[char_table_depth] = i;
3083 if (char_table_depth == 0)
3085 character = i;
3086 indices[0] = i - 128;
3088 else if (complete_char)
3090 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3092 else
3093 character = 0;
3095 else
3096 character = i;
3098 /* If this binding is shadowed by some other map, ignore it. */
3099 if (!NILP (shadow) && complete_char)
3101 Lisp_Object tem;
3103 XVECTOR (kludge)->contents[0] = make_number (character);
3104 tem = shadow_lookup (shadow, kludge, Qt);
3106 if (!NILP (tem)) continue;
3109 /* Ignore this definition if it is shadowed by an earlier
3110 one in the same keymap. */
3111 if (!NILP (entire_map) && complete_char)
3113 Lisp_Object tem;
3115 XVECTOR (kludge)->contents[0] = make_number (character);
3116 tem = Flookup_key (entire_map, kludge, Qt);
3118 if (! EQ (tem, definition))
3119 continue;
3122 if (first)
3124 if (char_table_depth == 0)
3125 insert ("\n", 1);
3126 first = 0;
3129 /* For a sub char-table, show the depth by indentation.
3130 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3131 if (char_table_depth > 0)
3132 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3134 /* Output the prefix that applies to every entry in this map. */
3135 if (!NILP (elt_prefix))
3136 insert1 (elt_prefix);
3138 /* Insert or describe the character this slot is for,
3139 or a description of what it is for. */
3140 if (SUB_CHAR_TABLE_P (vector))
3142 if (complete_char)
3143 insert_char (character);
3144 else
3146 /* We need an octal representation for this block of
3147 characters. */
3148 char work[16];
3149 sprintf (work, "(row %d)", i);
3150 insert (work, strlen (work));
3153 else if (CHAR_TABLE_P (vector))
3155 if (complete_char)
3156 insert1 (Fsingle_key_description (make_number (character)));
3157 else
3159 /* Print the information for this character set. */
3160 insert_string ("<");
3161 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3162 if (STRINGP (tem2))
3163 insert_from_string (tem2, 0, 0, XSTRING (tem2)->size,
3164 STRING_BYTES (XSTRING (tem2)), 0);
3165 else
3166 insert ("?", 1);
3167 insert (">", 1);
3170 else
3172 insert1 (Fsingle_key_description (make_number (character)));
3175 /* If we find a sub char-table within a char-table,
3176 scan it recursively; it defines the details for
3177 a character set or a portion of a character set. */
3178 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3180 insert ("\n", 1);
3181 describe_vector (definition, elt_prefix, elt_describer,
3182 partial, shadow, entire_map,
3183 indices, char_table_depth + 1);
3184 continue;
3187 starting_i = i;
3189 /* Find all consecutive characters or rows that have the same
3190 definition. But, for elements of a top level char table, if
3191 they are for charsets, we had better describe one by one even
3192 if they have the same definition. */
3193 if (CHAR_TABLE_P (vector))
3195 int limit = to;
3197 if (char_table_depth == 0)
3198 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3200 while (i + 1 < limit
3201 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3202 !NILP (tem2))
3203 && !NILP (Fequal (tem2, definition)))
3204 i++;
3206 else
3207 while (i + 1 < to
3208 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i + 1], 0),
3209 !NILP (tem2))
3210 && !NILP (Fequal (tem2, definition)))
3211 i++;
3214 /* If we have a range of more than one character,
3215 print where the range reaches to. */
3217 if (i != starting_i)
3219 insert (" .. ", 4);
3221 if (!NILP (elt_prefix))
3222 insert1 (elt_prefix);
3224 if (CHAR_TABLE_P (vector))
3226 if (char_table_depth == 0)
3228 insert1 (Fsingle_key_description (make_number (i)));
3230 else if (complete_char)
3232 indices[char_table_depth] = i;
3233 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3234 insert_char (character);
3236 else
3238 /* We need an octal representation for this block of
3239 characters. */
3240 char work[16];
3241 sprintf (work, "(row %d)", i);
3242 insert (work, strlen (work));
3245 else
3247 insert1 (Fsingle_key_description (make_number (i)));
3251 /* Print a description of the definition of this character.
3252 elt_describer will take care of spacing out far enough
3253 for alignment purposes. */
3254 (*elt_describer) (definition);
3257 /* For (sub) char-table, print `defalt' slot at last. */
3258 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3260 insert (" ", char_table_depth * 2);
3261 insert_string ("<<default>>");
3262 (*elt_describer) (XCHAR_TABLE (vector)->defalt);
3265 UNGCPRO;
3268 /* Apropos - finding all symbols whose names match a regexp. */
3269 Lisp_Object apropos_predicate;
3270 Lisp_Object apropos_accumulate;
3272 static void
3273 apropos_accum (symbol, string)
3274 Lisp_Object symbol, string;
3276 register Lisp_Object tem;
3278 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3279 if (!NILP (tem) && !NILP (apropos_predicate))
3280 tem = call1 (apropos_predicate, symbol);
3281 if (!NILP (tem))
3282 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3285 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3286 "Show all symbols whose names contain match for REGEXP.\n\
3287 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
3288 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
3289 Return list of symbols found.")
3290 (regexp, predicate)
3291 Lisp_Object regexp, predicate;
3293 struct gcpro gcpro1, gcpro2;
3294 CHECK_STRING (regexp, 0);
3295 apropos_predicate = predicate;
3296 GCPRO2 (apropos_predicate, apropos_accumulate);
3297 apropos_accumulate = Qnil;
3298 map_obarray (Vobarray, apropos_accum, regexp);
3299 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
3300 UNGCPRO;
3301 return apropos_accumulate;
3304 void
3305 syms_of_keymap ()
3307 Qkeymap = intern ("keymap");
3308 staticpro (&Qkeymap);
3310 /* Now we are ready to set up this property, so we can
3311 create char tables. */
3312 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3314 /* Initialize the keymaps standardly used.
3315 Each one is the value of a Lisp variable, and is also
3316 pointed to by a C variable */
3318 global_map = Fmake_keymap (Qnil);
3319 Fset (intern ("global-map"), global_map);
3321 current_global_map = global_map;
3322 staticpro (&global_map);
3323 staticpro (&current_global_map);
3325 meta_map = Fmake_keymap (Qnil);
3326 Fset (intern ("esc-map"), meta_map);
3327 Ffset (intern ("ESC-prefix"), meta_map);
3329 control_x_map = Fmake_keymap (Qnil);
3330 Fset (intern ("ctl-x-map"), control_x_map);
3331 Ffset (intern ("Control-X-prefix"), control_x_map);
3333 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3334 "List of commands given new key bindings recently.\n\
3335 This is used for internal purposes during Emacs startup;\n\
3336 don't alter it yourself.");
3337 Vdefine_key_rebound_commands = Qt;
3339 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3340 "Default keymap to use when reading from the minibuffer.");
3341 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3343 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3344 "Local keymap for the minibuffer when spaces are not allowed.");
3345 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3347 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3348 "Local keymap for minibuffer input with completion.");
3349 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3351 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
3352 "Local keymap for minibuffer input with completion, for exact match.");
3353 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3355 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
3356 "Alist of keymaps to use for minor modes.\n\
3357 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
3358 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
3359 If two active keymaps bind the same key, the keymap appearing earlier\n\
3360 in the list takes precedence.");
3361 Vminor_mode_map_alist = Qnil;
3363 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
3364 "Alist of keymaps to use for minor modes, in current major mode.\n\
3365 This variable is a alist just like `minor-mode-map-alist', and it is\n\
3366 used the same way (and before `minor-mode-map-alist'); however,\n\
3367 it is provided for major modes to bind locally.");
3368 Vminor_mode_overriding_map_alist = Qnil;
3370 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
3371 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
3372 This allows Emacs to recognize function keys sent from ASCII\n\
3373 terminals at any point in a key sequence.\n\
3375 The `read-key-sequence' function replaces any subsequence bound by\n\
3376 `function-key-map' with its binding. More precisely, when the active\n\
3377 keymaps have no binding for the current key sequence but\n\
3378 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
3379 `read-key-sequence' replaces the matching suffix with its binding, and\n\
3380 continues with the new sequence.\n\
3382 The events that come from bindings in `function-key-map' are not\n\
3383 themselves looked up in `function-key-map'.\n\
3385 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
3386 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
3387 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
3388 key, typing `ESC O P x' would return [f1 x].");
3389 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
3391 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
3392 "Keymap of key translations that can override keymaps.\n\
3393 This keymap works like `function-key-map', but comes after that,\n\
3394 and applies even for keys that have ordinary bindings.");
3395 Vkey_translation_map = Qnil;
3397 Qsingle_key_description = intern ("single-key-description");
3398 staticpro (&Qsingle_key_description);
3400 Qkey_description = intern ("key-description");
3401 staticpro (&Qkey_description);
3403 Qkeymapp = intern ("keymapp");
3404 staticpro (&Qkeymapp);
3406 Qnon_ascii = intern ("non-ascii");
3407 staticpro (&Qnon_ascii);
3409 Qmenu_item = intern ("menu-item");
3410 staticpro (&Qmenu_item);
3412 defsubr (&Skeymapp);
3413 defsubr (&Skeymap_parent);
3414 defsubr (&Sset_keymap_parent);
3415 defsubr (&Smake_keymap);
3416 defsubr (&Smake_sparse_keymap);
3417 defsubr (&Scopy_keymap);
3418 defsubr (&Skey_binding);
3419 defsubr (&Slocal_key_binding);
3420 defsubr (&Sglobal_key_binding);
3421 defsubr (&Sminor_mode_key_binding);
3422 defsubr (&Sdefine_key);
3423 defsubr (&Slookup_key);
3424 defsubr (&Sdefine_prefix_command);
3425 defsubr (&Suse_global_map);
3426 defsubr (&Suse_local_map);
3427 defsubr (&Scurrent_local_map);
3428 defsubr (&Scurrent_global_map);
3429 defsubr (&Scurrent_minor_mode_maps);
3430 defsubr (&Saccessible_keymaps);
3431 defsubr (&Skey_description);
3432 defsubr (&Sdescribe_vector);
3433 defsubr (&Ssingle_key_description);
3434 defsubr (&Stext_char_description);
3435 defsubr (&Swhere_is_internal);
3436 defsubr (&Sdescribe_bindings_internal);
3437 defsubr (&Sapropos_internal);
3440 void
3441 keys_of_keymap ()
3443 initial_define_key (global_map, 033, "ESC-prefix");
3444 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");