("latin-1-prefix"): Change ~s to give \e,A'\e(B and
[emacs.git] / src / keymap.c
blob3d6cf0c472375eabcf8a44595b44f703b799ad3c
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 *) xmalloc (cmm_size * sizeof (Lisp_Object));
1234 newmaps
1235 = (Lisp_Object *) xmalloc (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 Qnil);
1795 args[i * 2 + 1] = sep;
1798 else if (CONSP (keys))
1800 /* In effect, this computes
1801 (mapconcat 'single-key-description keys " ")
1802 but we shouldn't use mapconcat because it can do GC. */
1804 len = XFASTINT (Flength (keys));
1805 sep = build_string (" ");
1806 /* This has one extra element at the end that we don't pass to Fconcat. */
1807 args = (Lisp_Object *) alloca (len * 2 * sizeof (Lisp_Object));
1809 for (i = 0; i < len; i++)
1811 args[i * 2] = Fsingle_key_description (XCAR (keys), Qnil);
1812 args[i * 2 + 1] = sep;
1813 keys = XCDR (keys);
1816 else
1817 keys = wrong_type_argument (Qarrayp, keys);
1819 return Fconcat (len * 2 - 1, args);
1822 char *
1823 push_key_description (c, p)
1824 register unsigned int c;
1825 register char *p;
1827 unsigned c2;
1829 /* Clear all the meaningless bits above the meta bit. */
1830 c &= meta_modifier | ~ - meta_modifier;
1831 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
1832 | meta_modifier | shift_modifier | super_modifier);
1834 if (c & alt_modifier)
1836 *p++ = 'A';
1837 *p++ = '-';
1838 c -= alt_modifier;
1840 if ((c & ctrl_modifier) != 0
1841 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
1843 *p++ = 'C';
1844 *p++ = '-';
1845 c &= ~ctrl_modifier;
1847 if (c & hyper_modifier)
1849 *p++ = 'H';
1850 *p++ = '-';
1851 c -= hyper_modifier;
1853 if (c & meta_modifier)
1855 *p++ = 'M';
1856 *p++ = '-';
1857 c -= meta_modifier;
1859 if (c & shift_modifier)
1861 *p++ = 'S';
1862 *p++ = '-';
1863 c -= shift_modifier;
1865 if (c & super_modifier)
1867 *p++ = 's';
1868 *p++ = '-';
1869 c -= super_modifier;
1871 if (c < 040)
1873 if (c == 033)
1875 *p++ = 'E';
1876 *p++ = 'S';
1877 *p++ = 'C';
1879 else if (c == '\t')
1881 *p++ = 'T';
1882 *p++ = 'A';
1883 *p++ = 'B';
1885 else if (c == Ctl ('M'))
1887 *p++ = 'R';
1888 *p++ = 'E';
1889 *p++ = 'T';
1891 else
1893 /* `C-' already added above. */
1894 if (c > 0 && c <= Ctl ('Z'))
1895 *p++ = c + 0140;
1896 else
1897 *p++ = c + 0100;
1900 else if (c == 0177)
1902 *p++ = 'D';
1903 *p++ = 'E';
1904 *p++ = 'L';
1906 else if (c == ' ')
1908 *p++ = 'S';
1909 *p++ = 'P';
1910 *p++ = 'C';
1912 else if (c < 128
1913 || (NILP (current_buffer->enable_multibyte_characters)
1914 && SINGLE_BYTE_CHAR_P (c)))
1915 *p++ = c;
1916 else
1918 if (! NILP (current_buffer->enable_multibyte_characters))
1919 c = unibyte_char_to_multibyte (c);
1921 if (NILP (current_buffer->enable_multibyte_characters)
1922 || SINGLE_BYTE_CHAR_P (c)
1923 || ! char_valid_p (c, 0))
1925 int bit_offset;
1926 *p++ = '\\';
1927 /* The biggest character code uses 19 bits. */
1928 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
1930 if (c >= (1 << bit_offset))
1931 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
1934 else
1936 p += CHAR_STRING (c, p);
1940 return p;
1943 /* This function cannot GC. */
1945 DEFUN ("single-key-description", Fsingle_key_description,
1946 Ssingle_key_description, 1, 2, 0,
1947 "Return a pretty description of command character KEY.\n\
1948 Control characters turn into C-whatever, etc.\n\
1949 Optional argument NO-ANGLES non-nil means don't put angle brackets\n\
1950 around function keys and event symbols.")
1951 (key, no_angles)
1952 Lisp_Object key, no_angles;
1954 if (CONSP (key) && lucid_event_type_list_p (key))
1955 key = Fevent_convert_list (key);
1957 key = EVENT_HEAD (key);
1959 if (INTEGERP (key)) /* Normal character */
1961 unsigned int charset, c1, c2;
1962 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
1964 if (SINGLE_BYTE_CHAR_P (without_bits))
1965 charset = 0;
1966 else
1967 SPLIT_CHAR (without_bits, charset, c1, c2);
1969 if (charset
1970 && CHARSET_DEFINED_P (charset)
1971 && ((c1 >= 0 && c1 < 32)
1972 || (c2 >= 0 && c2 < 32)))
1974 /* Handle a generic character. */
1975 Lisp_Object name;
1976 name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
1977 CHECK_STRING (name, 0);
1978 return concat2 (build_string ("Character set "), name);
1980 else
1982 char tem[KEY_DESCRIPTION_SIZE];
1984 *push_key_description (XUINT (key), tem) = 0;
1985 return build_string (tem);
1988 else if (SYMBOLP (key)) /* Function key or event-symbol */
1990 if (NILP (no_angles))
1992 char *buffer
1993 = (char *) alloca (STRING_BYTES (XSYMBOL (key)->name) + 5);
1994 sprintf (buffer, "<%s>", XSYMBOL (key)->name->data);
1995 return build_string (buffer);
1997 else
1998 return Fsymbol_name (key);
2000 else if (STRINGP (key)) /* Buffer names in the menubar. */
2001 return Fcopy_sequence (key);
2002 else
2003 error ("KEY must be an integer, cons, symbol, or string");
2006 char *
2007 push_text_char_description (c, p)
2008 register unsigned int c;
2009 register char *p;
2011 if (c >= 0200)
2013 *p++ = 'M';
2014 *p++ = '-';
2015 c -= 0200;
2017 if (c < 040)
2019 *p++ = '^';
2020 *p++ = c + 64; /* 'A' - 1 */
2022 else if (c == 0177)
2024 *p++ = '^';
2025 *p++ = '?';
2027 else
2028 *p++ = c;
2029 return p;
2032 /* This function cannot GC. */
2034 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2035 "Return a pretty description of file-character CHARACTER.\n\
2036 Control characters turn into \"^char\", etc.")
2037 (character)
2038 Lisp_Object character;
2040 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2041 unsigned char str[6];
2042 int c;
2044 CHECK_NUMBER (character, 0);
2046 c = XINT (character);
2047 if (!SINGLE_BYTE_CHAR_P (c))
2049 int len = CHAR_STRING (c, str);
2051 return make_multibyte_string (str, 1, len);
2054 *push_text_char_description (c & 0377, str) = 0;
2056 return build_string (str);
2059 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2060 a meta bit. */
2061 static int
2062 ascii_sequence_p (seq)
2063 Lisp_Object seq;
2065 int i;
2066 int len = XINT (Flength (seq));
2068 for (i = 0; i < len; i++)
2070 Lisp_Object ii, elt;
2072 XSETFASTINT (ii, i);
2073 elt = Faref (seq, ii);
2075 if (!INTEGERP (elt)
2076 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2077 return 0;
2080 return 1;
2084 /* where-is - finding a command in a set of keymaps. */
2086 static Lisp_Object where_is_internal_1 ();
2087 static void where_is_internal_2 ();
2089 /* This function can GC if Flookup_key autoloads any keymaps. */
2091 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
2092 "Return list of keys that invoke DEFINITION.\n\
2093 If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
2094 If KEYMAP is nil, search all the currently active keymaps.\n\
2096 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
2097 rather than a list of all possible key sequences.\n\
2098 If FIRSTONLY is the symbol `non-ascii', return the first binding found,\n\
2099 no matter what it is.\n\
2100 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,\n\
2101 and entirely reject menu bindings.\n\
2103 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
2104 to other keymaps or slots. This makes it possible to search for an\n\
2105 indirect definition itself.")
2106 (definition, xkeymap, firstonly, noindirect)
2107 Lisp_Object definition, xkeymap;
2108 Lisp_Object firstonly, noindirect;
2110 Lisp_Object maps;
2111 Lisp_Object found, sequences;
2112 Lisp_Object keymap1;
2113 int keymap_specified = !NILP (xkeymap);
2114 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2115 /* 1 means ignore all menu bindings entirely. */
2116 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2118 /* Find keymaps accessible from `keymap' or the current
2119 context. But don't muck with the value of `keymap',
2120 because `where_is_internal_1' uses it to check for
2121 shadowed bindings. */
2122 keymap1 = xkeymap;
2123 if (! keymap_specified)
2124 keymap1 = get_local_map (PT, current_buffer, keymap);
2126 if (!NILP (keymap1))
2127 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
2128 Faccessible_keymaps (get_keymap (current_global_map),
2129 Qnil));
2130 else
2132 keymap1 = xkeymap;
2133 if (! keymap_specified)
2134 keymap1 = get_local_map (PT, current_buffer, local_map);
2136 if (!NILP (keymap1))
2137 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap1), Qnil),
2138 Faccessible_keymaps (get_keymap (current_global_map),
2139 Qnil));
2140 else
2141 maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
2144 /* Put the minor mode keymaps on the front. */
2145 if (! keymap_specified)
2147 Lisp_Object minors;
2148 minors = Fnreverse (Fcurrent_minor_mode_maps ());
2149 while (!NILP (minors))
2151 maps = nconc2 (Faccessible_keymaps (get_keymap (XCAR (minors)),
2152 Qnil),
2153 maps);
2154 minors = XCDR (minors);
2158 GCPRO5 (definition, xkeymap, maps, found, sequences);
2159 found = Qnil;
2160 sequences = Qnil;
2162 for (; !NILP (maps); maps = Fcdr (maps))
2164 /* Key sequence to reach map, and the map that it reaches */
2165 register Lisp_Object this, map;
2167 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2168 [M-CHAR] sequences, check if last character of the sequence
2169 is the meta-prefix char. */
2170 Lisp_Object last;
2171 int last_is_meta;
2173 this = Fcar (Fcar (maps));
2174 map = Fcdr (Fcar (maps));
2175 last = make_number (XINT (Flength (this)) - 1);
2176 last_is_meta = (XINT (last) >= 0
2177 && EQ (Faref (this, last), meta_prefix_char));
2179 QUIT;
2181 while (CONSP (map))
2183 /* Because the code we want to run on each binding is rather
2184 large, we don't want to have two separate loop bodies for
2185 sparse keymap bindings and tables; we want to iterate one
2186 loop body over both keymap and vector bindings.
2188 For this reason, if Fcar (map) is a vector, we don't
2189 advance map to the next element until i indicates that we
2190 have finished off the vector. */
2191 Lisp_Object elt, key, binding;
2192 elt = XCAR (map);
2193 map = XCDR (map);
2195 sequences = Qnil;
2197 QUIT;
2199 /* Set key and binding to the current key and binding, and
2200 advance map and i to the next binding. */
2201 if (VECTORP (elt))
2203 Lisp_Object sequence;
2204 int i;
2205 /* In a vector, look at each element. */
2206 for (i = 0; i < XVECTOR (elt)->size; i++)
2208 binding = XVECTOR (elt)->contents[i];
2209 XSETFASTINT (key, i);
2210 sequence = where_is_internal_1 (binding, key, definition,
2211 noindirect, xkeymap, this,
2212 last, nomenus, last_is_meta);
2213 if (!NILP (sequence))
2214 sequences = Fcons (sequence, sequences);
2217 else if (CHAR_TABLE_P (elt))
2219 Lisp_Object indices[3];
2220 Lisp_Object args;
2222 args = Fcons (Fcons (Fcons (definition, noindirect),
2223 Fcons (xkeymap, Qnil)),
2224 Fcons (Fcons (this, last),
2225 Fcons (make_number (nomenus),
2226 make_number (last_is_meta))));
2227 map_char_table (where_is_internal_2, Qnil, elt, args,
2228 0, indices);
2229 sequences = XCDR (XCDR (XCAR (args)));
2231 else if (CONSP (elt))
2233 Lisp_Object sequence;
2235 key = XCAR (elt);
2236 binding = XCDR (elt);
2238 sequence = where_is_internal_1 (binding, key, definition,
2239 noindirect, xkeymap, this,
2240 last, nomenus, last_is_meta);
2241 if (!NILP (sequence))
2242 sequences = Fcons (sequence, sequences);
2246 for (; ! NILP (sequences); sequences = XCDR (sequences))
2248 Lisp_Object sequence;
2250 sequence = XCAR (sequences);
2252 /* It is a true unshadowed match. Record it, unless it's already
2253 been seen (as could happen when inheriting keymaps). */
2254 if (NILP (Fmember (sequence, found)))
2255 found = Fcons (sequence, found);
2257 /* If firstonly is Qnon_ascii, then we can return the first
2258 binding we find. If firstonly is not Qnon_ascii but not
2259 nil, then we should return the first ascii-only binding
2260 we find. */
2261 if (EQ (firstonly, Qnon_ascii))
2262 RETURN_UNGCPRO (sequence);
2263 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
2264 RETURN_UNGCPRO (sequence);
2269 UNGCPRO;
2271 found = Fnreverse (found);
2273 /* firstonly may have been t, but we may have gone all the way through
2274 the keymaps without finding an all-ASCII key sequence. So just
2275 return the best we could find. */
2276 if (! NILP (firstonly))
2277 return Fcar (found);
2279 return found;
2282 /* This is the function that Fwhere_is_internal calls using map_char_table.
2283 ARGS has the form
2284 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2286 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2287 Since map_char_table doesn't really use the return value from this function,
2288 we the result append to RESULT, the slot in ARGS.
2290 This function can GC because it calls where_is_internal_1 which can
2291 GC. */
2293 static void
2294 where_is_internal_2 (args, key, binding)
2295 Lisp_Object args, key, binding;
2297 Lisp_Object definition, noindirect, keymap, this, last;
2298 Lisp_Object result, sequence;
2299 int nomenus, last_is_meta;
2300 struct gcpro gcpro1, gcpro2, gcpro3;
2302 GCPRO3 (args, key, binding);
2303 result = XCDR (XCDR (XCAR (args)));
2304 definition = XCAR (XCAR (XCAR (args)));
2305 noindirect = XCDR (XCAR (XCAR (args)));
2306 keymap = XCAR (XCDR (XCAR (args)));
2307 this = XCAR (XCAR (XCDR (args)));
2308 last = XCDR (XCAR (XCDR (args)));
2309 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2310 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
2312 sequence = where_is_internal_1 (binding, key, definition, noindirect, keymap,
2313 this, last, nomenus, last_is_meta);
2315 if (!NILP (sequence))
2316 XCDR (XCDR (XCAR (args))) = Fcons (sequence, result);
2318 UNGCPRO;
2322 /* This function can GC.because Flookup_key calls get_keymap_1 with
2323 non-zero argument AUTOLOAD. */
2325 static Lisp_Object
2326 where_is_internal_1 (binding, key, definition, noindirect, keymap, this, last,
2327 nomenus, last_is_meta)
2328 Lisp_Object binding, key, definition, noindirect, keymap, this, last;
2329 int nomenus, last_is_meta;
2331 Lisp_Object sequence;
2332 int keymap_specified = !NILP (keymap);
2333 struct gcpro gcpro1, gcpro2;
2335 /* Search through indirections unless that's not wanted. */
2336 if (NILP (noindirect))
2338 if (nomenus)
2340 while (1)
2342 Lisp_Object map, tem;
2343 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
2344 map = get_keymap_1 (Fcar_safe (definition), 0, 0);
2345 tem = Fkeymapp (map);
2346 if (!NILP (tem))
2347 definition = access_keymap (map, Fcdr (definition), 0, 0);
2348 else
2349 break;
2351 /* If the contents are (menu-item ...) or (STRING ...), reject. */
2352 if (CONSP (definition)
2353 && (EQ (XCAR (definition),Qmenu_item)
2354 || STRINGP (XCAR (definition))))
2355 return Qnil;
2357 else
2358 binding = get_keyelt (binding, 0);
2361 /* End this iteration if this element does not match
2362 the target. */
2364 if (CONSP (definition))
2366 Lisp_Object tem;
2367 tem = Fequal (binding, definition);
2368 if (NILP (tem))
2369 return Qnil;
2371 else
2372 if (!EQ (binding, definition))
2373 return Qnil;
2375 /* We have found a match.
2376 Construct the key sequence where we found it. */
2377 if (INTEGERP (key) && last_is_meta)
2379 sequence = Fcopy_sequence (this);
2380 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2382 else
2383 sequence = append_key (this, key);
2385 /* Verify that this key binding is not shadowed by another
2386 binding for the same key, before we say it exists.
2388 Mechanism: look for local definition of this key and if
2389 it is defined and does not match what we found then
2390 ignore this key.
2392 Either nil or number as value from Flookup_key
2393 means undefined. */
2394 GCPRO2 (sequence, binding);
2395 if (keymap_specified)
2397 binding = Flookup_key (keymap, sequence, Qnil);
2398 if (!NILP (binding) && !INTEGERP (binding))
2400 if (CONSP (definition))
2402 Lisp_Object tem;
2403 tem = Fequal (binding, definition);
2404 if (NILP (tem))
2405 RETURN_UNGCPRO (Qnil);
2407 else
2408 if (!EQ (binding, definition))
2409 RETURN_UNGCPRO (Qnil);
2412 else
2414 binding = Fkey_binding (sequence, Qnil);
2415 if (!EQ (binding, definition))
2416 RETURN_UNGCPRO (Qnil);
2419 RETURN_UNGCPRO (sequence);
2422 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2424 DEFUN ("describe-bindings-internal", Fdescribe_bindings_internal, Sdescribe_bindings_internal, 0, 2, "",
2425 "Show a list of all defined keys, and their definitions.\n\
2426 We put that list in a buffer, and display the buffer.\n\
2428 The optional argument MENUS, if non-nil, says to mention menu bindings.\n\
2429 \(Ordinarily these are omitted from the output.)\n\
2430 The optional argument PREFIX, if non-nil, should be a key sequence;\n\
2431 then we display only bindings that start with that prefix.")
2432 (menus, prefix)
2433 Lisp_Object menus, prefix;
2435 register Lisp_Object thisbuf;
2436 XSETBUFFER (thisbuf, current_buffer);
2437 internal_with_output_to_temp_buffer ("*Help*",
2438 describe_buffer_bindings,
2439 list3 (thisbuf, prefix, menus));
2440 return Qnil;
2443 /* ARG is (BUFFER PREFIX MENU-FLAG). */
2445 static Lisp_Object
2446 describe_buffer_bindings (arg)
2447 Lisp_Object arg;
2449 Lisp_Object descbuf, prefix, shadow;
2450 int nomenu;
2451 register Lisp_Object start1;
2452 struct gcpro gcpro1;
2454 char *alternate_heading
2455 = "\
2456 Keyboard translations:\n\n\
2457 You type Translation\n\
2458 -------- -----------\n";
2460 descbuf = XCAR (arg);
2461 arg = XCDR (arg);
2462 prefix = XCAR (arg);
2463 arg = XCDR (arg);
2464 nomenu = NILP (XCAR (arg));
2466 shadow = Qnil;
2467 GCPRO1 (shadow);
2469 Fset_buffer (Vstandard_output);
2471 /* Report on alternates for keys. */
2472 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
2474 int c;
2475 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
2476 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
2478 for (c = 0; c < translate_len; c++)
2479 if (translate[c] != c)
2481 char buf[KEY_DESCRIPTION_SIZE];
2482 char *bufend;
2484 if (alternate_heading)
2486 insert_string (alternate_heading);
2487 alternate_heading = 0;
2490 bufend = push_key_description (translate[c], buf);
2491 insert (buf, bufend - buf);
2492 Findent_to (make_number (16), make_number (1));
2493 bufend = push_key_description (c, buf);
2494 insert (buf, bufend - buf);
2496 insert ("\n", 1);
2499 insert ("\n", 1);
2502 if (!NILP (Vkey_translation_map))
2503 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2504 "Key translations", nomenu, 1, 0);
2507 int i, nmaps;
2508 Lisp_Object *modes, *maps;
2510 /* Temporarily switch to descbuf, so that we can get that buffer's
2511 minor modes correctly. */
2512 Fset_buffer (descbuf);
2514 if (!NILP (current_kboard->Voverriding_terminal_local_map)
2515 || !NILP (Voverriding_local_map))
2516 nmaps = 0;
2517 else
2518 nmaps = current_minor_maps (&modes, &maps);
2519 Fset_buffer (Vstandard_output);
2521 /* Print the minor mode maps. */
2522 for (i = 0; i < nmaps; i++)
2524 /* The title for a minor mode keymap
2525 is constructed at run time.
2526 We let describe_map_tree do the actual insertion
2527 because it takes care of other features when doing so. */
2528 char *title, *p;
2530 if (!SYMBOLP (modes[i]))
2531 abort();
2533 p = title = (char *) alloca (42 + XSYMBOL (modes[i])->name->size);
2534 *p++ = '\f';
2535 *p++ = '\n';
2536 *p++ = '`';
2537 bcopy (XSYMBOL (modes[i])->name->data, p,
2538 XSYMBOL (modes[i])->name->size);
2539 p += XSYMBOL (modes[i])->name->size;
2540 *p++ = '\'';
2541 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
2542 p += sizeof (" Minor Mode Bindings") - 1;
2543 *p = 0;
2545 describe_map_tree (maps[i], 1, shadow, prefix, title, nomenu, 0, 0);
2546 shadow = Fcons (maps[i], shadow);
2550 /* Print the (major mode) local map. */
2551 if (!NILP (current_kboard->Voverriding_terminal_local_map))
2552 start1 = current_kboard->Voverriding_terminal_local_map;
2553 else if (!NILP (Voverriding_local_map))
2554 start1 = Voverriding_local_map;
2555 else
2556 start1 = XBUFFER (descbuf)->keymap;
2558 if (!NILP (start1))
2560 describe_map_tree (start1, 1, shadow, prefix,
2561 "\f\nMajor Mode Bindings", nomenu, 0, 0);
2562 shadow = Fcons (start1, shadow);
2565 describe_map_tree (current_global_map, 1, shadow, prefix,
2566 "\f\nGlobal Bindings", nomenu, 0, 1);
2568 /* Print the function-key-map translations under this prefix. */
2569 if (!NILP (Vfunction_key_map))
2570 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
2571 "\f\nFunction key map translations", nomenu, 1, 0);
2573 call0 (intern ("help-mode"));
2574 Fset_buffer (descbuf);
2575 UNGCPRO;
2576 return Qnil;
2579 /* Insert a description of the key bindings in STARTMAP,
2580 followed by those of all maps reachable through STARTMAP.
2581 If PARTIAL is nonzero, omit certain "uninteresting" commands
2582 (such as `undefined').
2583 If SHADOW is non-nil, it is a list of maps;
2584 don't mention keys which would be shadowed by any of them.
2585 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2586 TITLE, if not 0, is a string to insert at the beginning.
2587 TITLE should not end with a colon or a newline; we supply that.
2588 If NOMENU is not 0, then omit menu-bar commands.
2590 If TRANSL is nonzero, the definitions are actually key translations
2591 so print strings and vectors differently.
2593 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2594 to look through. */
2596 void
2597 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
2598 always_title)
2599 Lisp_Object startmap, shadow, prefix;
2600 int partial;
2601 char *title;
2602 int nomenu;
2603 int transl;
2604 int always_title;
2606 Lisp_Object maps, orig_maps, seen, sub_shadows;
2607 struct gcpro gcpro1, gcpro2, gcpro3;
2608 int something = 0;
2609 char *key_heading
2610 = "\
2611 key binding\n\
2612 --- -------\n";
2614 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
2615 seen = Qnil;
2616 sub_shadows = Qnil;
2617 GCPRO3 (maps, seen, sub_shadows);
2619 if (nomenu)
2621 Lisp_Object list;
2623 /* Delete from MAPS each element that is for the menu bar. */
2624 for (list = maps; !NILP (list); list = XCDR (list))
2626 Lisp_Object elt, prefix, tem;
2628 elt = Fcar (list);
2629 prefix = Fcar (elt);
2630 if (XVECTOR (prefix)->size >= 1)
2632 tem = Faref (prefix, make_number (0));
2633 if (EQ (tem, Qmenu_bar))
2634 maps = Fdelq (elt, maps);
2639 if (!NILP (maps) || always_title)
2641 if (title)
2643 insert_string (title);
2644 if (!NILP (prefix))
2646 insert_string (" Starting With ");
2647 insert1 (Fkey_description (prefix));
2649 insert_string (":\n");
2651 insert_string (key_heading);
2652 something = 1;
2655 for (; !NILP (maps); maps = Fcdr (maps))
2657 register Lisp_Object elt, prefix, tail;
2659 elt = Fcar (maps);
2660 prefix = Fcar (elt);
2662 sub_shadows = Qnil;
2664 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2666 Lisp_Object shmap;
2668 shmap = XCAR (tail);
2670 /* If the sequence by which we reach this keymap is zero-length,
2671 then the shadow map for this keymap is just SHADOW. */
2672 if ((STRINGP (prefix) && XSTRING (prefix)->size == 0)
2673 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
2675 /* If the sequence by which we reach this keymap actually has
2676 some elements, then the sequence's definition in SHADOW is
2677 what we should use. */
2678 else
2680 shmap = Flookup_key (shmap, Fcar (elt), Qt);
2681 if (INTEGERP (shmap))
2682 shmap = Qnil;
2685 /* If shmap is not nil and not a keymap,
2686 it completely shadows this map, so don't
2687 describe this map at all. */
2688 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
2689 goto skip;
2691 if (!NILP (shmap))
2692 sub_shadows = Fcons (shmap, sub_shadows);
2695 /* Maps we have already listed in this loop shadow this map. */
2696 for (tail = orig_maps; ! EQ (tail, maps); tail = XCDR (tail))
2698 Lisp_Object tem;
2699 tem = Fequal (Fcar (XCAR (tail)), prefix);
2700 if (! NILP (tem))
2701 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
2704 describe_map (Fcdr (elt), prefix,
2705 transl ? describe_translation : describe_command,
2706 partial, sub_shadows, &seen, nomenu);
2708 skip: ;
2711 if (something)
2712 insert_string ("\n");
2714 UNGCPRO;
2717 static int previous_description_column;
2719 static void
2720 describe_command (definition)
2721 Lisp_Object definition;
2723 register Lisp_Object tem1;
2724 int column = current_column ();
2725 int description_column;
2727 /* If column 16 is no good, go to col 32;
2728 but don't push beyond that--go to next line instead. */
2729 if (column > 30)
2731 insert_char ('\n');
2732 description_column = 32;
2734 else if (column > 14 || (column > 10 && previous_description_column == 32))
2735 description_column = 32;
2736 else
2737 description_column = 16;
2739 Findent_to (make_number (description_column), make_number (1));
2740 previous_description_column = description_column;
2742 if (SYMBOLP (definition))
2744 XSETSTRING (tem1, XSYMBOL (definition)->name);
2745 insert1 (tem1);
2746 insert_string ("\n");
2748 else if (STRINGP (definition) || VECTORP (definition))
2749 insert_string ("Keyboard Macro\n");
2750 else
2752 tem1 = Fkeymapp (definition);
2753 if (!NILP (tem1))
2754 insert_string ("Prefix Command\n");
2755 else
2756 insert_string ("??\n");
2760 static void
2761 describe_translation (definition)
2762 Lisp_Object definition;
2764 register Lisp_Object tem1;
2766 Findent_to (make_number (16), make_number (1));
2768 if (SYMBOLP (definition))
2770 XSETSTRING (tem1, XSYMBOL (definition)->name);
2771 insert1 (tem1);
2772 insert_string ("\n");
2774 else if (STRINGP (definition) || VECTORP (definition))
2776 insert1 (Fkey_description (definition));
2777 insert_string ("\n");
2779 else
2781 tem1 = Fkeymapp (definition);
2782 if (!NILP (tem1))
2783 insert_string ("Prefix Command\n");
2784 else
2785 insert_string ("??\n");
2789 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2790 Returns the first non-nil binding found in any of those maps. */
2792 static Lisp_Object
2793 shadow_lookup (shadow, key, flag)
2794 Lisp_Object shadow, key, flag;
2796 Lisp_Object tail, value;
2798 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2800 value = Flookup_key (XCAR (tail), key, flag);
2801 if (!NILP (value))
2802 return value;
2804 return Qnil;
2807 /* Describe the contents of map MAP, assuming that this map itself is
2808 reached by the sequence of prefix keys KEYS (a string or vector).
2809 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2811 static void
2812 describe_map (map, keys, elt_describer, partial, shadow, seen, nomenu)
2813 register Lisp_Object map;
2814 Lisp_Object keys;
2815 void (*elt_describer) P_ ((Lisp_Object));
2816 int partial;
2817 Lisp_Object shadow;
2818 Lisp_Object *seen;
2819 int nomenu;
2821 Lisp_Object elt_prefix;
2822 Lisp_Object tail, definition, event;
2823 Lisp_Object tem;
2824 Lisp_Object suppress;
2825 Lisp_Object kludge;
2826 int first = 1;
2827 struct gcpro gcpro1, gcpro2, gcpro3;
2829 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
2831 /* Call Fkey_description first, to avoid GC bug for the other string. */
2832 tem = Fkey_description (keys);
2833 elt_prefix = concat2 (tem, build_string (" "));
2835 else
2836 elt_prefix = Qnil;
2838 if (partial)
2839 suppress = intern ("suppress-keymap");
2841 /* This vector gets used to present single keys to Flookup_key. Since
2842 that is done once per keymap element, we don't want to cons up a
2843 fresh vector every time. */
2844 kludge = Fmake_vector (make_number (1), Qnil);
2845 definition = Qnil;
2847 GCPRO3 (elt_prefix, definition, kludge);
2849 for (tail = map; CONSP (tail); tail = XCDR (tail))
2851 QUIT;
2853 if (VECTORP (XCAR (tail))
2854 || CHAR_TABLE_P (XCAR (tail)))
2855 describe_vector (XCAR (tail),
2856 elt_prefix, elt_describer, partial, shadow, map,
2857 (int *)0, 0);
2858 else if (CONSP (XCAR (tail)))
2860 event = XCAR (XCAR (tail));
2862 /* Ignore bindings whose "keys" are not really valid events.
2863 (We get these in the frames and buffers menu.) */
2864 if (! (SYMBOLP (event) || INTEGERP (event)))
2865 continue;
2867 if (nomenu && EQ (event, Qmenu_bar))
2868 continue;
2870 definition = get_keyelt (XCDR (XCAR (tail)), 0);
2872 /* Don't show undefined commands or suppressed commands. */
2873 if (NILP (definition)) continue;
2874 if (SYMBOLP (definition) && partial)
2876 tem = Fget (definition, suppress);
2877 if (!NILP (tem))
2878 continue;
2881 /* Don't show a command that isn't really visible
2882 because a local definition of the same key shadows it. */
2884 XVECTOR (kludge)->contents[0] = event;
2885 if (!NILP (shadow))
2887 tem = shadow_lookup (shadow, kludge, Qt);
2888 if (!NILP (tem)) continue;
2891 tem = Flookup_key (map, kludge, Qt);
2892 if (! EQ (tem, definition)) continue;
2894 if (first)
2896 previous_description_column = 0;
2897 insert ("\n", 1);
2898 first = 0;
2901 if (!NILP (elt_prefix))
2902 insert1 (elt_prefix);
2904 /* THIS gets the string to describe the character EVENT. */
2905 insert1 (Fsingle_key_description (event, Qnil));
2907 /* Print a description of the definition of this character.
2908 elt_describer will take care of spacing out far enough
2909 for alignment purposes. */
2910 (*elt_describer) (definition);
2912 else if (EQ (XCAR (tail), Qkeymap))
2914 /* The same keymap might be in the structure twice, if we're
2915 using an inherited keymap. So skip anything we've already
2916 encountered. */
2917 tem = Fassq (tail, *seen);
2918 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), keys)))
2919 break;
2920 *seen = Fcons (Fcons (tail, keys), *seen);
2924 UNGCPRO;
2927 static void
2928 describe_vector_princ (elt)
2929 Lisp_Object elt;
2931 Findent_to (make_number (16), make_number (1));
2932 Fprinc (elt, Qnil);
2933 Fterpri (Qnil);
2936 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
2937 "Insert a description of contents of VECTOR.\n\
2938 This is text showing the elements of vector matched against indices.")
2939 (vector)
2940 Lisp_Object vector;
2942 int count = specpdl_ptr - specpdl;
2944 specbind (Qstandard_output, Fcurrent_buffer ());
2945 CHECK_VECTOR_OR_CHAR_TABLE (vector, 0);
2946 describe_vector (vector, Qnil, describe_vector_princ, 0,
2947 Qnil, Qnil, (int *)0, 0);
2949 return unbind_to (count, Qnil);
2952 /* Insert in the current buffer a description of the contents of VECTOR.
2953 We call ELT_DESCRIBER to insert the description of one value found
2954 in VECTOR.
2956 ELT_PREFIX describes what "comes before" the keys or indices defined
2957 by this vector. This is a human-readable string whose size
2958 is not necessarily related to the situation.
2960 If the vector is in a keymap, ELT_PREFIX is a prefix key which
2961 leads to this keymap.
2963 If the vector is a chartable, ELT_PREFIX is the vector
2964 of bytes that lead to the character set or portion of a character
2965 set described by this chartable.
2967 If PARTIAL is nonzero, it means do not mention suppressed commands
2968 (that assumes the vector is in a keymap).
2970 SHADOW is a list of keymaps that shadow this map.
2971 If it is non-nil, then we look up the key in those maps
2972 and we don't mention it now if it is defined by any of them.
2974 ENTIRE_MAP is the keymap in which this vector appears.
2975 If the definition in effect in the whole map does not match
2976 the one in this vector, we ignore this one.
2978 When describing a sub-char-table, INDICES is a list of
2979 indices at higher levels in this char-table,
2980 and CHAR_TABLE_DEPTH says how many levels down we have gone. */
2982 void
2983 describe_vector (vector, elt_prefix, elt_describer,
2984 partial, shadow, entire_map,
2985 indices, char_table_depth)
2986 register Lisp_Object vector;
2987 Lisp_Object elt_prefix;
2988 void (*elt_describer) P_ ((Lisp_Object));
2989 int partial;
2990 Lisp_Object shadow;
2991 Lisp_Object entire_map;
2992 int *indices;
2993 int char_table_depth;
2995 Lisp_Object definition;
2996 Lisp_Object tem2;
2997 register int i;
2998 Lisp_Object suppress;
2999 Lisp_Object kludge;
3000 int first = 1;
3001 struct gcpro gcpro1, gcpro2, gcpro3;
3002 /* Range of elements to be handled. */
3003 int from, to;
3004 /* A flag to tell if a leaf in this level of char-table is not a
3005 generic character (i.e. a complete multibyte character). */
3006 int complete_char;
3007 int character;
3008 int starting_i;
3010 if (indices == 0)
3011 indices = (int *) alloca (3 * sizeof (int));
3013 definition = Qnil;
3015 /* This vector gets used to present single keys to Flookup_key. Since
3016 that is done once per vector element, we don't want to cons up a
3017 fresh vector every time. */
3018 kludge = Fmake_vector (make_number (1), Qnil);
3019 GCPRO3 (elt_prefix, definition, kludge);
3021 if (partial)
3022 suppress = intern ("suppress-keymap");
3024 if (CHAR_TABLE_P (vector))
3026 if (char_table_depth == 0)
3028 /* VECTOR is a top level char-table. */
3029 complete_char = 1;
3030 from = 0;
3031 to = CHAR_TABLE_ORDINARY_SLOTS;
3033 else
3035 /* VECTOR is a sub char-table. */
3036 if (char_table_depth >= 3)
3037 /* A char-table is never that deep. */
3038 error ("Too deep char table");
3040 complete_char
3041 = (CHARSET_VALID_P (indices[0])
3042 && ((CHARSET_DIMENSION (indices[0]) == 1
3043 && char_table_depth == 1)
3044 || char_table_depth == 2));
3046 /* Meaningful elements are from 32th to 127th. */
3047 from = 32;
3048 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
3051 else
3053 /* This does the right thing for ordinary vectors. */
3055 complete_char = 1;
3056 from = 0;
3057 to = XVECTOR (vector)->size;
3060 for (i = from; i < to; i++)
3062 QUIT;
3064 if (CHAR_TABLE_P (vector))
3066 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3067 complete_char = 0;
3069 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3070 && !CHARSET_DEFINED_P (i - 128))
3071 continue;
3073 definition
3074 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
3076 else
3077 definition = get_keyelt (XVECTOR (vector)->contents[i], 0);
3079 if (NILP (definition)) continue;
3081 /* Don't mention suppressed commands. */
3082 if (SYMBOLP (definition) && partial)
3084 Lisp_Object tem;
3086 tem = Fget (definition, suppress);
3088 if (!NILP (tem)) continue;
3091 /* Set CHARACTER to the character this entry describes, if any.
3092 Also update *INDICES. */
3093 if (CHAR_TABLE_P (vector))
3095 indices[char_table_depth] = i;
3097 if (char_table_depth == 0)
3099 character = i;
3100 indices[0] = i - 128;
3102 else if (complete_char)
3104 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3106 else
3107 character = 0;
3109 else
3110 character = i;
3112 /* If this binding is shadowed by some other map, ignore it. */
3113 if (!NILP (shadow) && complete_char)
3115 Lisp_Object tem;
3117 XVECTOR (kludge)->contents[0] = make_number (character);
3118 tem = shadow_lookup (shadow, kludge, Qt);
3120 if (!NILP (tem)) continue;
3123 /* Ignore this definition if it is shadowed by an earlier
3124 one in the same keymap. */
3125 if (!NILP (entire_map) && complete_char)
3127 Lisp_Object tem;
3129 XVECTOR (kludge)->contents[0] = make_number (character);
3130 tem = Flookup_key (entire_map, kludge, Qt);
3132 if (! EQ (tem, definition))
3133 continue;
3136 if (first)
3138 if (char_table_depth == 0)
3139 insert ("\n", 1);
3140 first = 0;
3143 /* For a sub char-table, show the depth by indentation.
3144 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3145 if (char_table_depth > 0)
3146 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
3148 /* Output the prefix that applies to every entry in this map. */
3149 if (!NILP (elt_prefix))
3150 insert1 (elt_prefix);
3152 /* Insert or describe the character this slot is for,
3153 or a description of what it is for. */
3154 if (SUB_CHAR_TABLE_P (vector))
3156 if (complete_char)
3157 insert_char (character);
3158 else
3160 /* We need an octal representation for this block of
3161 characters. */
3162 char work[16];
3163 sprintf (work, "(row %d)", i);
3164 insert (work, strlen (work));
3167 else if (CHAR_TABLE_P (vector))
3169 if (complete_char)
3170 insert1 (Fsingle_key_description (make_number (character), Qnil));
3171 else
3173 /* Print the information for this character set. */
3174 insert_string ("<");
3175 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3176 if (STRINGP (tem2))
3177 insert_from_string (tem2, 0, 0, XSTRING (tem2)->size,
3178 STRING_BYTES (XSTRING (tem2)), 0);
3179 else
3180 insert ("?", 1);
3181 insert (">", 1);
3184 else
3186 insert1 (Fsingle_key_description (make_number (character), Qnil));
3189 /* If we find a sub char-table within a char-table,
3190 scan it recursively; it defines the details for
3191 a character set or a portion of a character set. */
3192 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
3194 insert ("\n", 1);
3195 describe_vector (definition, elt_prefix, elt_describer,
3196 partial, shadow, entire_map,
3197 indices, char_table_depth + 1);
3198 continue;
3201 starting_i = i;
3203 /* Find all consecutive characters or rows that have the same
3204 definition. But, for elements of a top level char table, if
3205 they are for charsets, we had better describe one by one even
3206 if they have the same definition. */
3207 if (CHAR_TABLE_P (vector))
3209 int limit = to;
3211 if (char_table_depth == 0)
3212 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3214 while (i + 1 < limit
3215 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3216 !NILP (tem2))
3217 && !NILP (Fequal (tem2, definition)))
3218 i++;
3220 else
3221 while (i + 1 < to
3222 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i + 1], 0),
3223 !NILP (tem2))
3224 && !NILP (Fequal (tem2, definition)))
3225 i++;
3228 /* If we have a range of more than one character,
3229 print where the range reaches to. */
3231 if (i != starting_i)
3233 insert (" .. ", 4);
3235 if (!NILP (elt_prefix))
3236 insert1 (elt_prefix);
3238 if (CHAR_TABLE_P (vector))
3240 if (char_table_depth == 0)
3242 insert1 (Fsingle_key_description (make_number (i), Qnil));
3244 else if (complete_char)
3246 indices[char_table_depth] = i;
3247 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
3248 insert_char (character);
3250 else
3252 /* We need an octal representation for this block of
3253 characters. */
3254 char work[16];
3255 sprintf (work, "(row %d)", i);
3256 insert (work, strlen (work));
3259 else
3261 insert1 (Fsingle_key_description (make_number (i), Qnil));
3265 /* Print a description of the definition of this character.
3266 elt_describer will take care of spacing out far enough
3267 for alignment purposes. */
3268 (*elt_describer) (definition);
3271 /* For (sub) char-table, print `defalt' slot at last. */
3272 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3274 insert (" ", char_table_depth * 2);
3275 insert_string ("<<default>>");
3276 (*elt_describer) (XCHAR_TABLE (vector)->defalt);
3279 UNGCPRO;
3282 /* Apropos - finding all symbols whose names match a regexp. */
3283 Lisp_Object apropos_predicate;
3284 Lisp_Object apropos_accumulate;
3286 static void
3287 apropos_accum (symbol, string)
3288 Lisp_Object symbol, string;
3290 register Lisp_Object tem;
3292 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3293 if (!NILP (tem) && !NILP (apropos_predicate))
3294 tem = call1 (apropos_predicate, symbol);
3295 if (!NILP (tem))
3296 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3299 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3300 "Show all symbols whose names contain match for REGEXP.\n\
3301 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done\n\
3302 for each symbol and a symbol is mentioned only if that returns non-nil.\n\
3303 Return list of symbols found.")
3304 (regexp, predicate)
3305 Lisp_Object regexp, predicate;
3307 struct gcpro gcpro1, gcpro2;
3308 CHECK_STRING (regexp, 0);
3309 apropos_predicate = predicate;
3310 GCPRO2 (apropos_predicate, apropos_accumulate);
3311 apropos_accumulate = Qnil;
3312 map_obarray (Vobarray, apropos_accum, regexp);
3313 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
3314 UNGCPRO;
3315 return apropos_accumulate;
3318 void
3319 syms_of_keymap ()
3321 Qkeymap = intern ("keymap");
3322 staticpro (&Qkeymap);
3324 /* Now we are ready to set up this property, so we can
3325 create char tables. */
3326 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3328 /* Initialize the keymaps standardly used.
3329 Each one is the value of a Lisp variable, and is also
3330 pointed to by a C variable */
3332 global_map = Fmake_keymap (Qnil);
3333 Fset (intern ("global-map"), global_map);
3335 current_global_map = global_map;
3336 staticpro (&global_map);
3337 staticpro (&current_global_map);
3339 meta_map = Fmake_keymap (Qnil);
3340 Fset (intern ("esc-map"), meta_map);
3341 Ffset (intern ("ESC-prefix"), meta_map);
3343 control_x_map = Fmake_keymap (Qnil);
3344 Fset (intern ("ctl-x-map"), control_x_map);
3345 Ffset (intern ("Control-X-prefix"), control_x_map);
3347 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3348 "List of commands given new key bindings recently.\n\
3349 This is used for internal purposes during Emacs startup;\n\
3350 don't alter it yourself.");
3351 Vdefine_key_rebound_commands = Qt;
3353 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3354 "Default keymap to use when reading from the minibuffer.");
3355 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3357 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3358 "Local keymap for the minibuffer when spaces are not allowed.");
3359 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3361 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3362 "Local keymap for minibuffer input with completion.");
3363 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3365 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
3366 "Local keymap for minibuffer input with completion, for exact match.");
3367 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3369 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
3370 "Alist of keymaps to use for minor modes.\n\
3371 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
3372 key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
3373 If two active keymaps bind the same key, the keymap appearing earlier\n\
3374 in the list takes precedence.");
3375 Vminor_mode_map_alist = Qnil;
3377 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
3378 "Alist of keymaps to use for minor modes, in current major mode.\n\
3379 This variable is a alist just like `minor-mode-map-alist', and it is\n\
3380 used the same way (and before `minor-mode-map-alist'); however,\n\
3381 it is provided for major modes to bind locally.");
3382 Vminor_mode_overriding_map_alist = Qnil;
3384 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
3385 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
3386 This allows Emacs to recognize function keys sent from ASCII\n\
3387 terminals at any point in a key sequence.\n\
3389 The `read-key-sequence' function replaces any subsequence bound by\n\
3390 `function-key-map' with its binding. More precisely, when the active\n\
3391 keymaps have no binding for the current key sequence but\n\
3392 `function-key-map' binds a suffix of the sequence to a vector or string,\n\
3393 `read-key-sequence' replaces the matching suffix with its binding, and\n\
3394 continues with the new sequence.\n\
3396 The events that come from bindings in `function-key-map' are not\n\
3397 themselves looked up in `function-key-map'.\n\
3399 For example, suppose `function-key-map' binds `ESC O P' to [f1].\n\
3400 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing\n\
3401 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
3402 key, typing `ESC O P x' would return [f1 x].");
3403 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
3405 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
3406 "Keymap of key translations that can override keymaps.\n\
3407 This keymap works like `function-key-map', but comes after that,\n\
3408 and applies even for keys that have ordinary bindings.");
3409 Vkey_translation_map = Qnil;
3411 Qsingle_key_description = intern ("single-key-description");
3412 staticpro (&Qsingle_key_description);
3414 Qkey_description = intern ("key-description");
3415 staticpro (&Qkey_description);
3417 Qkeymapp = intern ("keymapp");
3418 staticpro (&Qkeymapp);
3420 Qnon_ascii = intern ("non-ascii");
3421 staticpro (&Qnon_ascii);
3423 Qmenu_item = intern ("menu-item");
3424 staticpro (&Qmenu_item);
3426 defsubr (&Skeymapp);
3427 defsubr (&Skeymap_parent);
3428 defsubr (&Sset_keymap_parent);
3429 defsubr (&Smake_keymap);
3430 defsubr (&Smake_sparse_keymap);
3431 defsubr (&Scopy_keymap);
3432 defsubr (&Skey_binding);
3433 defsubr (&Slocal_key_binding);
3434 defsubr (&Sglobal_key_binding);
3435 defsubr (&Sminor_mode_key_binding);
3436 defsubr (&Sdefine_key);
3437 defsubr (&Slookup_key);
3438 defsubr (&Sdefine_prefix_command);
3439 defsubr (&Suse_global_map);
3440 defsubr (&Suse_local_map);
3441 defsubr (&Scurrent_local_map);
3442 defsubr (&Scurrent_global_map);
3443 defsubr (&Scurrent_minor_mode_maps);
3444 defsubr (&Saccessible_keymaps);
3445 defsubr (&Skey_description);
3446 defsubr (&Sdescribe_vector);
3447 defsubr (&Ssingle_key_description);
3448 defsubr (&Stext_char_description);
3449 defsubr (&Swhere_is_internal);
3450 defsubr (&Sdescribe_bindings_internal);
3451 defsubr (&Sapropos_internal);
3454 void
3455 keys_of_keymap ()
3457 initial_define_key (global_map, 033, "ESC-prefix");
3458 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");