Find and display keyboard equivalents of menu items.
[bpt/emacs.git] / src / keymap.c
CommitLineData
2c6f1a39 1/* Manipulation of keymaps
f0148b5e 2 Copyright (C) 1985, 86, 87, 88, 93, 94 Free Software Foundation, Inc.
2c6f1a39
JB
3
4This file is part of GNU Emacs.
5
6GNU Emacs is free software; you can redistribute it and/or modify
7it under the terms of the GNU General Public License as published by
502ddf23 8the Free Software Foundation; either version 2, or (at your option)
2c6f1a39
JB
9any later version.
10
11GNU Emacs is distributed in the hope that it will be useful,
12but WITHOUT ANY WARRANTY; without even the implied warranty of
13MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14GNU General Public License for more details.
15
16You should have received a copy of the GNU General Public License
17along with GNU Emacs; see the file COPYING. If not, write to
18the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
19
20
18160b98 21#include <config.h>
2c6f1a39
JB
22#include <stdio.h>
23#undef NULL
24#include "lisp.h"
25#include "commands.h"
26#include "buffer.h"
6bbbd9b0 27#include "keyboard.h"
6ba6e250 28#include "termhooks.h"
9ac0d9e0 29#include "blockinput.h"
2c6f1a39
JB
30
31#define min(a, b) ((a) < (b) ? (a) : (b))
32
f5b79c1c 33/* The number of elements in keymap vectors. */
2c6f1a39
JB
34#define DENSE_TABLE_SIZE (0200)
35
36/* Actually allocate storage for these variables */
37
38Lisp_Object current_global_map; /* Current global keymap */
39
40Lisp_Object global_map; /* default global key bindings */
41
42Lisp_Object meta_map; /* The keymap used for globally bound
43 ESC-prefixed default commands */
44
45Lisp_Object control_x_map; /* The keymap used for globally bound
46 C-x-prefixed default commands */
47
48/* was MinibufLocalMap */
49Lisp_Object Vminibuffer_local_map;
50 /* The keymap used by the minibuf for local
51 bindings when spaces are allowed in the
52 minibuf */
53
54/* was MinibufLocalNSMap */
55Lisp_Object Vminibuffer_local_ns_map;
56 /* The keymap used by the minibuf for local
57 bindings when spaces are not encouraged
58 in the minibuf */
59
60/* keymap used for minibuffers when doing completion */
61/* was MinibufLocalCompletionMap */
62Lisp_Object Vminibuffer_local_completion_map;
63
64/* keymap used for minibuffers when doing completion and require a match */
65/* was MinibufLocalMustMatchMap */
66Lisp_Object Vminibuffer_local_must_match_map;
67
cc0a8174
JB
68/* Alist of minor mode variables and keymaps. */
69Lisp_Object Vminor_mode_map_alist;
70
6bbbd9b0
JB
71/* Keymap mapping ASCII function key sequences onto their preferred forms.
72 Initialized by the terminal-specific lisp files. See DEFVAR for more
73 documentation. */
74Lisp_Object Vfunction_key_map;
75
2fc66973 76Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii;
2c6f1a39 77
3d248688
JB
78/* A char with the CHAR_META bit set in a vector or the 0200 bit set
79 in a string key sequence is equivalent to prefixing with this
80 character. */
2c6f1a39
JB
81extern Lisp_Object meta_prefix_char;
82
7d92e329
RS
83extern Lisp_Object Voverriding_local_map;
84
2c6f1a39 85void describe_map_tree ();
c07aec97 86static Lisp_Object define_as_prefix ();
2c6f1a39
JB
87static Lisp_Object describe_buffer_bindings ();
88static void describe_command ();
89static void describe_map ();
f5b79c1c 90static void describe_map_2 ();
2c6f1a39 91\f
cc0a8174
JB
92/* Keymap object support - constructors and predicates. */
93
ce6e5d0b 94DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
2c6f1a39 95 "Construct and return a new keymap, of the form (keymap VECTOR . ALIST).\n\
926a64aa 96VECTOR is a vector which holds the bindings for the ASCII\n\
2c6f1a39
JB
97characters. ALIST is an assoc-list which holds bindings for function keys,\n\
98mouse events, and any other things that appear in the input stream.\n\
ce6e5d0b
RS
99All entries in it are initially nil, meaning \"command undefined\".\n\n\
100The optional arg STRING supplies a menu name for the keymap\n\
101in case you use it as a menu with `x-popup-menu'.")
102 (string)
103 Lisp_Object string;
2c6f1a39 104{
ce6e5d0b
RS
105 Lisp_Object tail;
106 if (!NILP (string))
107 tail = Fcons (string, Qnil);
108 else
109 tail = Qnil;
2c6f1a39
JB
110 return Fcons (Qkeymap,
111 Fcons (Fmake_vector (make_number (DENSE_TABLE_SIZE), Qnil),
ce6e5d0b 112 tail));
2c6f1a39
JB
113}
114
ce6e5d0b 115DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
2c6f1a39
JB
116 "Construct and return a new sparse-keymap list.\n\
117Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),\n\
118which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),\n\
119which binds the function key or mouse event SYMBOL to DEFINITION.\n\
ce6e5d0b
RS
120Initially the alist is nil.\n\n\
121The optional arg STRING supplies a menu name for the keymap\n\
122in case you use it as a menu with `x-popup-menu'.")
123 (string)
124 Lisp_Object string;
2c6f1a39 125{
ce6e5d0b
RS
126 if (!NILP (string))
127 return Fcons (Qkeymap, Fcons (string, Qnil));
2c6f1a39
JB
128 return Fcons (Qkeymap, Qnil);
129}
130
131/* This function is used for installing the standard key bindings
132 at initialization time.
133
134 For example:
135
e25c4e44 136 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
2c6f1a39
JB
137
138void
139initial_define_key (keymap, key, defname)
140 Lisp_Object keymap;
141 int key;
142 char *defname;
143{
144 store_in_keymap (keymap, make_number (key), intern (defname));
145}
146
e25c4e44
JB
147void
148initial_define_lispy_key (keymap, keyname, defname)
149 Lisp_Object keymap;
150 char *keyname;
151 char *defname;
152{
153 store_in_keymap (keymap, intern (keyname), intern (defname));
154}
155
2c6f1a39
JB
156/* Define character fromchar in map frommap as an alias for character
157 tochar in map tomap. Subsequent redefinitions of the latter WILL
158 affect the former. */
159
160#if 0
161void
162synkey (frommap, fromchar, tomap, tochar)
163 struct Lisp_Vector *frommap, *tomap;
164 int fromchar, tochar;
165{
166 Lisp_Object v, c;
167 XSET (v, Lisp_Vector, tomap);
168 XFASTINT (c) = tochar;
169 frommap->contents[fromchar] = Fcons (v, c);
170}
171#endif /* 0 */
172
173DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
174 "Return t if ARG is a keymap.\n\
1d8d96fa 175\n\
926a64aa 176A keymap is a list (keymap . ALIST),\n\
1d8d96fa
JB
177or a symbol whose function definition is a keymap is itself a keymap.\n\
178ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);\n\
926a64aa
RS
179a vector of densely packed bindings for small character codes\n\
180is also allowed as an element.")
2c6f1a39
JB
181 (object)
182 Lisp_Object object;
183{
d09b2024 184 return (NILP (get_keymap_1 (object, 0, 0)) ? Qnil : Qt);
2c6f1a39
JB
185}
186
187/* Check that OBJECT is a keymap (after dereferencing through any
d09b2024
JB
188 symbols). If it is, return it.
189
190 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
191 is an autoload form, do the autoload and try again.
192
193 ERROR controls how we respond if OBJECT isn't a keymap.
194 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
195
196 Note that most of the time, we don't want to pursue autoloads.
197 Functions like Faccessible_keymaps which scan entire keymap trees
198 shouldn't load every autoloaded keymap. I'm not sure about this,
199 but it seems to me that only read_key_sequence, Flookup_key, and
200 Fdefine_key should cause keymaps to be autoloaded. */
201
2c6f1a39 202Lisp_Object
d09b2024 203get_keymap_1 (object, error, autoload)
2c6f1a39 204 Lisp_Object object;
d09b2024 205 int error, autoload;
2c6f1a39 206{
d09b2024 207 Lisp_Object tem;
2c6f1a39 208
d09b2024 209 autoload_retry:
502ddf23 210 tem = indirect_function (object);
2c6f1a39
JB
211 if (CONSP (tem) && EQ (XCONS (tem)->car, Qkeymap))
212 return tem;
f5b79c1c 213
8e4dfd54
JB
214 /* Should we do an autoload? Autoload forms for keymaps have
215 Qkeymap as their fifth element. */
d09b2024
JB
216 if (autoload
217 && XTYPE (object) == Lisp_Symbol
218 && CONSP (tem)
219 && EQ (XCONS (tem)->car, Qautoload))
220 {
8e4dfd54 221 Lisp_Object tail;
d09b2024 222
8e4dfd54
JB
223 tail = Fnth (make_number (4), tem);
224 if (EQ (tail, Qkeymap))
225 {
226 struct gcpro gcpro1, gcpro2;
d09b2024 227
81fa9e2f
RS
228 GCPRO2 (tem, object);
229 do_autoload (tem, object);
8e4dfd54
JB
230 UNGCPRO;
231
232 goto autoload_retry;
233 }
d09b2024
JB
234 }
235
2c6f1a39
JB
236 if (error)
237 wrong_type_argument (Qkeymapp, object);
cc0a8174
JB
238 else
239 return Qnil;
2c6f1a39
JB
240}
241
d09b2024
JB
242
243/* Follow any symbol chaining, and return the keymap denoted by OBJECT.
244 If OBJECT doesn't denote a keymap at all, signal an error. */
2c6f1a39
JB
245Lisp_Object
246get_keymap (object)
247 Lisp_Object object;
248{
d09b2024 249 return get_keymap_1 (object, 0, 0);
2c6f1a39
JB
250}
251
252
2c6f1a39 253/* Look up IDX in MAP. IDX may be any sort of event.
f5b79c1c 254 Note that this does only one level of lookup; IDX must be a single
e25c4e44
JB
255 event, not a sequence.
256
257 If T_OK is non-zero, bindings for Qt are treated as default
258 bindings; any key left unmentioned by other tables and bindings is
259 given the binding of Qt.
260
c07aec97
RS
261 If T_OK is zero, bindings for Qt are not treated specially.
262
263 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
2c6f1a39
JB
264
265Lisp_Object
c07aec97 266access_keymap (map, idx, t_ok, noinherit)
2c6f1a39
JB
267 Lisp_Object map;
268 Lisp_Object idx;
e25c4e44 269 int t_ok;
c07aec97 270 int noinherit;
2c6f1a39 271{
c07aec97
RS
272 int noprefix = 0;
273 Lisp_Object val;
274
2c6f1a39
JB
275 /* If idx is a list (some sort of mouse click, perhaps?),
276 the index we want to use is the car of the list, which
277 ought to be a symbol. */
cebd887d 278 idx = EVENT_HEAD (idx);
2c6f1a39 279
f5b79c1c
JB
280 /* If idx is a symbol, it might have modifiers, which need to
281 be put in the canonical order. */
0b8fc2d4 282 if (XTYPE (idx) == Lisp_Symbol)
f5b79c1c 283 idx = reorder_modifiers (idx);
2732bdbb
RS
284 else if (INTEGERP (idx))
285 /* Clobber the high bits that can be present on a machine
286 with more than 24 bits of integer. */
ad4ec84a 287 XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1));
2c6f1a39 288
f5b79c1c
JB
289 {
290 Lisp_Object tail;
e25c4e44 291 Lisp_Object t_binding = Qnil;
2c6f1a39 292
f5b79c1c 293 for (tail = map; CONSP (tail); tail = XCONS (tail)->cdr)
2c6f1a39 294 {
f5b79c1c
JB
295 Lisp_Object binding = XCONS (tail)->car;
296
297 switch (XTYPE (binding))
298 {
c07aec97
RS
299 case Lisp_Symbol:
300 /* If NOINHERIT, stop finding prefix definitions
301 after we pass a second occurrence of the `keymap' symbol. */
302 if (noinherit && EQ (binding, Qkeymap) && ! EQ (tail, map))
303 noprefix = 1;
304 break;
305
f5b79c1c
JB
306 case Lisp_Cons:
307 if (EQ (XCONS (binding)->car, idx))
c07aec97
RS
308 {
309 val = XCONS (binding)->cdr;
310 if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
311 return Qnil;
312 return val;
313 }
e25c4e44
JB
314 if (t_ok && EQ (XCONS (binding)->car, Qt))
315 t_binding = XCONS (binding)->cdr;
f5b79c1c
JB
316 break;
317
318 case Lisp_Vector:
926a64aa 319 if (XTYPE (idx) == Lisp_Int
0b8fc2d4 320 && XINT (idx) >= 0
926a64aa 321 && XINT (idx) < XVECTOR (binding)->size)
c07aec97
RS
322 {
323 val = XVECTOR (binding)->contents[XINT (idx)];
324 if (noprefix && CONSP (val) && EQ (XCONS (val)->car, Qkeymap))
325 return Qnil;
326 return val;
327 }
f5b79c1c
JB
328 break;
329 }
20218e2f
JB
330
331 QUIT;
2c6f1a39 332 }
fde3a52f 333
e25c4e44
JB
334 return t_binding;
335 }
2c6f1a39
JB
336}
337
338/* Given OBJECT which was found in a slot in a keymap,
339 trace indirect definitions to get the actual definition of that slot.
340 An indirect definition is a list of the form
341 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
342 and INDEX is the object to look up in KEYMAP to yield the definition.
343
344 Also if OBJECT has a menu string as the first element,
1a8c3f10 345 remove that. Also remove a menu help string as second element. */
2c6f1a39
JB
346
347Lisp_Object
348get_keyelt (object)
349 register Lisp_Object object;
350{
351 while (1)
352 {
353 register Lisp_Object map, tem;
354
fde3a52f 355 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
d09b2024 356 map = get_keymap_1 (Fcar_safe (object), 0, 0);
2c6f1a39 357 tem = Fkeymapp (map);
265a9e55 358 if (!NILP (tem))
c07aec97 359 object = access_keymap (map, Fcdr (object), 0, 0);
2c6f1a39
JB
360
361 /* If the keymap contents looks like (STRING . DEFN),
362 use DEFN.
363 Keymap alist elements like (CHAR MENUSTRING . DEFN)
364 will be used by HierarKey menus. */
365 else if (XTYPE (object) == Lisp_Cons
366 && XTYPE (XCONS (object)->car) == Lisp_String)
1a8c3f10
RS
367 {
368 object = XCONS (object)->cdr;
369 /* Also remove a menu help string, if any,
370 following the menu item name. */
371 if (XTYPE (object) == Lisp_Cons
372 && XTYPE (XCONS (object)->car) == Lisp_String)
373 object = XCONS (object)->cdr;
374 }
2c6f1a39
JB
375
376 else
377 /* Anything else is really the value. */
378 return object;
379 }
380}
381
382Lisp_Object
383store_in_keymap (keymap, idx, def)
384 Lisp_Object keymap;
385 register Lisp_Object idx;
386 register Lisp_Object def;
387{
f5b79c1c
JB
388 if (XTYPE (keymap) != Lisp_Cons
389 || ! EQ (XCONS (keymap)->car, Qkeymap))
390 error ("attempt to define a key in a non-keymap");
391
2c6f1a39
JB
392 /* If idx is a list (some sort of mouse click, perhaps?),
393 the index we want to use is the car of the list, which
394 ought to be a symbol. */
cebd887d 395 idx = EVENT_HEAD (idx);
2c6f1a39 396
f5b79c1c
JB
397 /* If idx is a symbol, it might have modifiers, which need to
398 be put in the canonical order. */
0b8fc2d4 399 if (XTYPE (idx) == Lisp_Symbol)
f5b79c1c 400 idx = reorder_modifiers (idx);
2732bdbb
RS
401 else if (INTEGERP (idx))
402 /* Clobber the high bits that can be present on a machine
403 with more than 24 bits of integer. */
ad4ec84a 404 XFASTINT (idx) = XINT (idx) & (CHAR_META | (CHAR_META - 1));
f5b79c1c
JB
405
406 /* Scan the keymap for a binding of idx. */
2c6f1a39 407 {
f5b79c1c 408 Lisp_Object tail;
2c6f1a39 409
f5b79c1c
JB
410 /* The cons after which we should insert new bindings. If the
411 keymap has a table element, we record its position here, so new
412 bindings will go after it; this way, the table will stay
413 towards the front of the alist and character lookups in dense
414 keymaps will remain fast. Otherwise, this just points at the
415 front of the keymap. */
416 Lisp_Object insertion_point = keymap;
2c6f1a39 417
f5b79c1c 418 for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = XCONS (tail)->cdr)
2c6f1a39 419 {
f5b79c1c
JB
420 Lisp_Object elt = XCONS (tail)->car;
421
422 switch (XTYPE (elt))
423 {
424 case Lisp_Vector:
0b8fc2d4 425 if (XTYPE (idx) == Lisp_Int
926a64aa 426 && XINT (idx) >= 0 && XINT (idx) < XVECTOR (elt)->size)
f5b79c1c
JB
427 {
428 XVECTOR (elt)->contents[XFASTINT (idx)] = def;
429 return def;
430 }
431 insertion_point = tail;
432 break;
433
434 case Lisp_Cons:
435 if (EQ (idx, XCONS (elt)->car))
436 {
437 XCONS (elt)->cdr = def;
438 return def;
439 }
440 break;
441
442 case Lisp_Symbol:
443 /* If we find a 'keymap' symbol in the spine of KEYMAP,
444 then we must have found the start of a second keymap
445 being used as the tail of KEYMAP, and a binding for IDX
446 should be inserted before it. */
447 if (EQ (elt, Qkeymap))
448 goto keymap_end;
449 break;
450 }
0188441d
JB
451
452 QUIT;
2c6f1a39 453 }
2c6f1a39 454
f5b79c1c
JB
455 keymap_end:
456 /* We have scanned the entire keymap, and not found a binding for
457 IDX. Let's add one. */
458 XCONS (insertion_point)->cdr =
459 Fcons (Fcons (idx, def), XCONS (insertion_point)->cdr);
460 }
461
2c6f1a39
JB
462 return def;
463}
464
f5b79c1c 465
2c6f1a39
JB
466DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
467 "Return a copy of the keymap KEYMAP.\n\
468The copy starts out with the same definitions of KEYMAP,\n\
469but changing either the copy or KEYMAP does not affect the other.\n\
1d8d96fa
JB
470Any key definitions that are subkeymaps are recursively copied.\n\
471However, a key definition which is a symbol whose definition is a keymap\n\
472is not copied.")
2c6f1a39
JB
473 (keymap)
474 Lisp_Object keymap;
475{
476 register Lisp_Object copy, tail;
477
478 copy = Fcopy_alist (get_keymap (keymap));
2c6f1a39 479
f5b79c1c 480 for (tail = copy; CONSP (tail); tail = XCONS (tail)->cdr)
2c6f1a39 481 {
f5b79c1c 482 Lisp_Object elt = XCONS (tail)->car;
2c6f1a39 483
926a64aa 484 if (XTYPE (elt) == Lisp_Vector)
2c6f1a39 485 {
f5b79c1c 486 int i;
2c6f1a39 487
f5b79c1c
JB
488 elt = Fcopy_sequence (elt);
489 XCONS (tail)->car = elt;
2c6f1a39 490
926a64aa 491 for (i = 0; i < XVECTOR (elt)->size; i++)
f5b79c1c 492 if (XTYPE (XVECTOR (elt)->contents[i]) != Lisp_Symbol
98006242 493 && ! NILP (Fkeymapp (XVECTOR (elt)->contents[i])))
f5b79c1c
JB
494 XVECTOR (elt)->contents[i] =
495 Fcopy_keymap (XVECTOR (elt)->contents[i]);
2c6f1a39 496 }
f5b79c1c
JB
497 else if (CONSP (elt)
498 && XTYPE (XCONS (elt)->cdr) != Lisp_Symbol
499 && ! NILP (Fkeymapp (XCONS (elt)->cdr)))
2c6f1a39 500 XCONS (elt)->cdr = Fcopy_keymap (XCONS (elt)->cdr);
2c6f1a39
JB
501 }
502
503 return copy;
504}
505\f
cc0a8174
JB
506/* Simple Keymap mutators and accessors. */
507
2c6f1a39
JB
508DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
509 "Args KEYMAP, KEY, DEF. Define key sequence KEY, in KEYMAP, as DEF.\n\
510KEYMAP is a keymap. KEY is a string or a vector of symbols and characters\n\
511meaning a sequence of keystrokes and events.\n\
c818754b
RS
512Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
513can be included if you use a vector.\n\
2c6f1a39
JB
514DEF is anything that can be a key's definition:\n\
515 nil (means key is undefined in this keymap),\n\
516 a command (a Lisp function suitable for interactive calling)\n\
517 a string (treated as a keyboard macro),\n\
518 a keymap (to define a prefix key),\n\
519 a symbol. When the key is looked up, the symbol will stand for its\n\
520 function definition, which should at that time be one of the above,\n\
521 or another symbol whose function definition is used, etc.\n\
522 a cons (STRING . DEFN), meaning that DEFN is the definition\n\
523 (DEFN should be a valid definition in its own right),\n\
6e8290aa
JB
524 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.\n\
525\n\
526If KEYMAP is a sparse keymap, the pair binding KEY to DEF is added at\n\
527the front of KEYMAP.")
2c6f1a39 528 (keymap, key, def)
d09b2024 529 Lisp_Object keymap;
2c6f1a39
JB
530 Lisp_Object key;
531 Lisp_Object def;
532{
533 register int idx;
534 register Lisp_Object c;
535 register Lisp_Object tem;
536 register Lisp_Object cmd;
537 int metized = 0;
6ba6e250 538 int meta_bit;
2c6f1a39 539 int length;
d09b2024 540 struct gcpro gcpro1, gcpro2, gcpro3;
2c6f1a39
JB
541
542 keymap = get_keymap (keymap);
543
544 if (XTYPE (key) != Lisp_Vector
545 && XTYPE (key) != Lisp_String)
546 key = wrong_type_argument (Qarrayp, key);
547
d09b2024 548 length = XFASTINT (Flength (key));
2c6f1a39
JB
549 if (length == 0)
550 return Qnil;
551
d09b2024
JB
552 GCPRO3 (keymap, key, def);
553
6ba6e250
RS
554 if (XTYPE (key) == Lisp_Vector)
555 meta_bit = meta_modifier;
556 else
557 meta_bit = 0x80;
558
2c6f1a39
JB
559 idx = 0;
560 while (1)
561 {
562 c = Faref (key, make_number (idx));
563
564 if (XTYPE (c) == Lisp_Int
6ba6e250 565 && (XINT (c) & meta_bit)
2c6f1a39
JB
566 && !metized)
567 {
568 c = meta_prefix_char;
569 metized = 1;
570 }
571 else
572 {
573 if (XTYPE (c) == Lisp_Int)
0b8fc2d4 574 XSETINT (c, XINT (c) & ~meta_bit);
2c6f1a39
JB
575
576 metized = 0;
577 idx++;
578 }
579
580 if (idx == length)
d09b2024 581 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
2c6f1a39 582
c07aec97 583 cmd = get_keyelt (access_keymap (keymap, c, 0, 1));
2c6f1a39 584
c07aec97 585 /* If this key is undefined, make it a prefix. */
265a9e55 586 if (NILP (cmd))
c07aec97 587 cmd = define_as_prefix (keymap, c);
2c6f1a39 588
d09b2024
JB
589 keymap = get_keymap_1 (cmd, 0, 1);
590 if (NILP (keymap))
dbc4e1c1
JB
591 {
592 /* We must use Fkey_description rather than just passing key to
593 error; key might be a vector, not a string. */
594 Lisp_Object description = Fkey_description (key);
595
596 error ("Key sequence %s uses invalid prefix characters",
597 XSTRING (description)->data);
598 }
2c6f1a39
JB
599 }
600}
601
602/* Value is number if KEY is too long; NIL if valid but has no definition. */
603
7c140252 604DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
2c6f1a39
JB
605 "In keymap KEYMAP, look up key sequence KEY. Return the definition.\n\
606nil means undefined. See doc of `define-key' for kinds of definitions.\n\
7c140252 607\n\
2c6f1a39
JB
608A number as value means KEY is \"too long\";\n\
609that is, characters or symbols in it except for the last one\n\
610fail to be a valid sequence of prefix characters in KEYMAP.\n\
611The number is how many characters at the front of KEY\n\
7c140252
JB
612it takes to reach a non-prefix command.\n\
613\n\
614Normally, `lookup-key' ignores bindings for t, which act as default\n\
615bindings, used when nothing else in the keymap applies; this makes it\n\
616useable as a general function for probing keymaps. However, if the\n\
617third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will\n\
618recognize the default bindings, just as `read-key-sequence' does.")
619 (keymap, key, accept_default)
2c6f1a39
JB
620 register Lisp_Object keymap;
621 Lisp_Object key;
7c140252 622 Lisp_Object accept_default;
2c6f1a39
JB
623{
624 register int idx;
625 register Lisp_Object tem;
626 register Lisp_Object cmd;
627 register Lisp_Object c;
628 int metized = 0;
629 int length;
7c140252 630 int t_ok = ! NILP (accept_default);
6ba6e250 631 int meta_bit;
2c6f1a39
JB
632
633 keymap = get_keymap (keymap);
634
635 if (XTYPE (key) != Lisp_Vector
636 && XTYPE (key) != Lisp_String)
637 key = wrong_type_argument (Qarrayp, key);
638
d09b2024 639 length = XFASTINT (Flength (key));
2c6f1a39
JB
640 if (length == 0)
641 return keymap;
642
6ba6e250
RS
643 if (XTYPE (key) == Lisp_Vector)
644 meta_bit = meta_modifier;
645 else
646 meta_bit = 0x80;
647
2c6f1a39
JB
648 idx = 0;
649 while (1)
650 {
651 c = Faref (key, make_number (idx));
652
653 if (XTYPE (c) == Lisp_Int
6ba6e250 654 && (XINT (c) & meta_bit)
2c6f1a39
JB
655 && !metized)
656 {
657 c = meta_prefix_char;
658 metized = 1;
659 }
660 else
661 {
662 if (XTYPE (c) == Lisp_Int)
6ba6e250 663 XSETINT (c, XINT (c) & ~meta_bit);
2c6f1a39
JB
664
665 metized = 0;
666 idx++;
667 }
668
c07aec97 669 cmd = get_keyelt (access_keymap (keymap, c, t_ok, 0));
2c6f1a39
JB
670 if (idx == length)
671 return cmd;
672
d09b2024
JB
673 keymap = get_keymap_1 (cmd, 0, 0);
674 if (NILP (keymap))
2c6f1a39
JB
675 return make_number (idx);
676
2c6f1a39
JB
677 QUIT;
678 }
679}
680
c07aec97
RS
681/* Make KEYMAP define event C as a keymap (i.e., as a prefix).
682 Assume that currently it does not define C at all.
683 Return the keymap. */
684
685static Lisp_Object
686define_as_prefix (keymap, c)
687 Lisp_Object keymap, c;
688{
689 Lisp_Object inherit, cmd;
690
691 cmd = Fmake_sparse_keymap (Qnil);
692 /* If this key is defined as a prefix in an inherited keymap,
693 make it a prefix in this map, and make its definition
694 inherit the other prefix definition. */
695 inherit = access_keymap (keymap, c, 0, 0);
696 if (NILP (inherit))
697 {
698 /* If there's an inherited keymap
699 and it doesn't define this key,
700 make it define this key. */
701 Lisp_Object tail;
702
703 for (tail = Fcdr (keymap); CONSP (tail); tail = XCONS (tail)->cdr)
704 if (EQ (XCONS (tail)->car, Qkeymap))
705 break;
706
707 if (!NILP (tail))
708 inherit = define_as_prefix (tail, c);
709 }
710
711 cmd = nconc2 (cmd, inherit);
712 store_in_keymap (keymap, c, cmd);
713
714 return cmd;
715}
716
0b8fc2d4
RS
717/* Append a key to the end of a key sequence. We always make a vector. */
718
2c6f1a39
JB
719Lisp_Object
720append_key (key_sequence, key)
721 Lisp_Object key_sequence, key;
722{
723 Lisp_Object args[2];
724
725 args[0] = key_sequence;
726
0b8fc2d4
RS
727 args[1] = Fcons (key, Qnil);
728 return Fvconcat (2, args);
2c6f1a39
JB
729}
730
731\f
cc0a8174
JB
732/* Global, local, and minor mode keymap stuff. */
733
265a9e55 734/* We can't put these variables inside current_minor_maps, since under
6bbbd9b0
JB
735 some systems, static gets macro-defined to be the empty string.
736 Ickypoo. */
265a9e55
JB
737static Lisp_Object *cmm_modes, *cmm_maps;
738static int cmm_size;
739
cc0a8174
JB
740/* Store a pointer to an array of the keymaps of the currently active
741 minor modes in *buf, and return the number of maps it contains.
742
743 This function always returns a pointer to the same buffer, and may
744 free or reallocate it, so if you want to keep it for a long time or
745 hand it out to lisp code, copy it. This procedure will be called
746 for every key sequence read, so the nice lispy approach (return a
747 new assoclist, list, what have you) for each invocation would
748 result in a lot of consing over time.
749
750 If we used xrealloc/xmalloc and ran out of memory, they would throw
751 back to the command loop, which would try to read a key sequence,
752 which would call this function again, resulting in an infinite
753 loop. Instead, we'll use realloc/malloc and silently truncate the
754 list, let the key sequence be read, and hope some other piece of
755 code signals the error. */
756int
757current_minor_maps (modeptr, mapptr)
758 Lisp_Object **modeptr, **mapptr;
759{
cc0a8174 760 int i = 0;
6bbbd9b0 761 Lisp_Object alist, assoc, var, val;
cc0a8174
JB
762
763 for (alist = Vminor_mode_map_alist;
764 CONSP (alist);
765 alist = XCONS (alist)->cdr)
766 if (CONSP (assoc = XCONS (alist)->car)
767 && XTYPE (var = XCONS (assoc)->car) == Lisp_Symbol
6bbbd9b0
JB
768 && ! EQ ((val = find_symbol_value (var)), Qunbound)
769 && ! NILP (val))
cc0a8174 770 {
265a9e55 771 if (i >= cmm_size)
cc0a8174
JB
772 {
773 Lisp_Object *newmodes, *newmaps;
774
265a9e55 775 if (cmm_maps)
cc0a8174 776 {
9ac0d9e0 777 BLOCK_INPUT;
e58077c8 778 cmm_size *= 2;
64116ad5
RS
779 newmodes
780 = (Lisp_Object *) realloc (cmm_modes,
781 cmm_size * sizeof (Lisp_Object));
782 newmaps
783 = (Lisp_Object *) realloc (cmm_maps,
784 cmm_size * sizeof (Lisp_Object));
9ac0d9e0 785 UNBLOCK_INPUT;
cc0a8174
JB
786 }
787 else
788 {
9ac0d9e0 789 BLOCK_INPUT;
e58077c8 790 cmm_size = 30;
64116ad5
RS
791 newmodes
792 = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
793 newmaps
794 = (Lisp_Object *) malloc (cmm_size * sizeof (Lisp_Object));
9ac0d9e0 795 UNBLOCK_INPUT;
cc0a8174
JB
796 }
797
798 if (newmaps && newmodes)
799 {
265a9e55
JB
800 cmm_modes = newmodes;
801 cmm_maps = newmaps;
cc0a8174
JB
802 }
803 else
804 break;
805 }
265a9e55 806 cmm_modes[i] = var;
992984b2 807 cmm_maps [i] = Findirect_function (XCONS (assoc)->cdr);
cc0a8174
JB
808 i++;
809 }
810
265a9e55
JB
811 if (modeptr) *modeptr = cmm_modes;
812 if (mapptr) *mapptr = cmm_maps;
cc0a8174
JB
813 return i;
814}
815
7c140252 816DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
2c6f1a39 817 "Return the binding for command KEY in current keymaps.\n\
7c140252
JB
818KEY is a string or vector, a sequence of keystrokes.\n\
819The binding is probably a symbol with a function definition.\n\
820\n\
821Normally, `key-binding' ignores bindings for t, which act as default\n\
822bindings, used when nothing else in the keymap applies; this makes it\n\
d831234b
RS
823usable as a general function for probing keymaps. However, if the\n\
824optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
7c140252
JB
825recognize the default bindings, just as `read-key-sequence' does.")
826 (key, accept_default)
2c6f1a39
JB
827 Lisp_Object key;
828{
cc0a8174
JB
829 Lisp_Object *maps, value;
830 int nmaps, i;
831
7d92e329 832 if (!NILP (Voverriding_local_map))
2c6f1a39 833 {
7d92e329 834 value = Flookup_key (Voverriding_local_map, key, accept_default);
265a9e55 835 if (! NILP (value) && XTYPE (value) != Lisp_Int)
2c6f1a39
JB
836 return value;
837 }
7d92e329
RS
838 else
839 {
840 nmaps = current_minor_maps (0, &maps);
841 for (i = 0; i < nmaps; i++)
842 if (! NILP (maps[i]))
843 {
844 value = Flookup_key (maps[i], key, accept_default);
845 if (! NILP (value) && XTYPE (value) != Lisp_Int)
846 return value;
847 }
848
849 if (! NILP (current_buffer->keymap))
850 {
851 value = Flookup_key (current_buffer->keymap, key, accept_default);
852 if (! NILP (value) && XTYPE (value) != Lisp_Int)
853 return value;
854 }
855 }
cc0a8174 856
7c140252 857 value = Flookup_key (current_global_map, key, accept_default);
265a9e55 858 if (! NILP (value) && XTYPE (value) != Lisp_Int)
cc0a8174
JB
859 return value;
860
861 return Qnil;
2c6f1a39
JB
862}
863
7c140252 864DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
2c6f1a39
JB
865 "Return the binding for command KEYS in current local keymap only.\n\
866KEYS is a string, a sequence of keystrokes.\n\
7c140252
JB
867The binding is probably a symbol with a function definition.\n\
868\n\
869If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
870bindings; see the description of `lookup-key' for more details about this.")
871 (keys, accept_default)
872 Lisp_Object keys, accept_default;
2c6f1a39
JB
873{
874 register Lisp_Object map;
875 map = current_buffer->keymap;
265a9e55 876 if (NILP (map))
2c6f1a39 877 return Qnil;
7c140252 878 return Flookup_key (map, keys, accept_default);
2c6f1a39
JB
879}
880
7c140252 881DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
2c6f1a39
JB
882 "Return the binding for command KEYS in current global keymap only.\n\
883KEYS is a string, a sequence of keystrokes.\n\
6bbbd9b0
JB
884The binding is probably a symbol with a function definition.\n\
885This function's return values are the same as those of lookup-key\n\
7c140252
JB
886(which see).\n\
887\n\
888If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
889bindings; see the description of `lookup-key' for more details about this.")
890 (keys, accept_default)
891 Lisp_Object keys, accept_default;
2c6f1a39 892{
7c140252 893 return Flookup_key (current_global_map, keys, accept_default);
2c6f1a39
JB
894}
895
7c140252 896DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
cc0a8174
JB
897 "Find the visible minor mode bindings of KEY.\n\
898Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
899the symbol which names the minor mode binding KEY, and BINDING is\n\
900KEY's definition in that mode. In particular, if KEY has no\n\
901minor-mode bindings, return nil. If the first binding is a\n\
902non-prefix, all subsequent bindings will be omitted, since they would\n\
903be ignored. Similarly, the list doesn't include non-prefix bindings\n\
7c140252
JB
904that come after prefix bindings.\n\
905\n\
906If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
907bindings; see the description of `lookup-key' for more details about this.")
908 (key, accept_default)
909 Lisp_Object key, accept_default;
cc0a8174
JB
910{
911 Lisp_Object *modes, *maps;
912 int nmaps;
913 Lisp_Object binding;
914 int i, j;
915
916 nmaps = current_minor_maps (&modes, &maps);
917
918 for (i = j = 0; i < nmaps; i++)
265a9e55 919 if (! NILP (maps[i])
7c140252 920 && ! NILP (binding = Flookup_key (maps[i], key, accept_default))
cc0a8174
JB
921 && XTYPE (binding) != Lisp_Int)
922 {
d09b2024 923 if (! NILP (get_keymap (binding)))
cc0a8174
JB
924 maps[j++] = Fcons (modes[i], binding);
925 else if (j == 0)
926 return Fcons (Fcons (modes[i], binding), Qnil);
927 }
928
929 return Flist (j, maps);
930}
931
2c6f1a39
JB
932DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
933 "kSet key globally: \nCSet key %s to command: ",
934 "Give KEY a global binding as COMMAND.\n\
935COMMAND is a symbol naming an interactively-callable function.\n\
2fa8c0b5 936KEY is a key sequence (a string or vector of characters or event types).\n\
c818754b
RS
937Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
938can be included if you use a vector.\n\
2c6f1a39
JB
939Note that if KEY has a local binding in the current buffer\n\
940that local binding will continue to shadow any global binding.")
941 (keys, function)
942 Lisp_Object keys, function;
943{
944 if (XTYPE (keys) != Lisp_Vector
945 && XTYPE (keys) != Lisp_String)
946 keys = wrong_type_argument (Qarrayp, keys);
947
948 Fdefine_key (current_global_map, keys, function);
949 return Qnil;
950}
951
952DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2,
953 "kSet key locally: \nCSet key %s locally to command: ",
954 "Give KEY a local binding as COMMAND.\n\
955COMMAND is a symbol naming an interactively-callable function.\n\
2fa8c0b5 956KEY is a key sequence (a string or vector of characters or event types).\n\
c818754b
RS
957Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
958can be included if you use a vector.\n\
2c6f1a39 959The binding goes in the current buffer's local map,\n\
af1d6f09 960which in most cases is shared with all other buffers in the same major mode.")
2c6f1a39
JB
961 (keys, function)
962 Lisp_Object keys, function;
963{
964 register Lisp_Object map;
965 map = current_buffer->keymap;
265a9e55 966 if (NILP (map))
2c6f1a39 967 {
ce6e5d0b 968 map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
969 current_buffer->keymap = map;
970 }
971
972 if (XTYPE (keys) != Lisp_Vector
973 && XTYPE (keys) != Lisp_String)
974 keys = wrong_type_argument (Qarrayp, keys);
975
976 Fdefine_key (map, keys, function);
977 return Qnil;
978}
979
980DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key,
981 1, 1, "kUnset key globally: ",
982 "Remove global binding of KEY.\n\
983KEY is a string representing a sequence of keystrokes.")
984 (keys)
985 Lisp_Object keys;
986{
987 return Fglobal_set_key (keys, Qnil);
988}
989
990DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1,
991 "kUnset key locally: ",
992 "Remove local binding of KEY.\n\
993KEY is a string representing a sequence of keystrokes.")
994 (keys)
995 Lisp_Object keys;
996{
265a9e55 997 if (!NILP (current_buffer->keymap))
2c6f1a39
JB
998 Flocal_set_key (keys, Qnil);
999 return Qnil;
1000}
1001
1002DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0,
cd8520b9 1003 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
2c6f1a39 1004A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1d8d96fa
JB
1005If a second optional argument MAPVAR is given, the map is stored as\n\
1006its value instead of as COMMAND's value; but COMMAND is still defined\n\
1007as a function.")
2c6f1a39
JB
1008 (name, mapvar)
1009 Lisp_Object name, mapvar;
1010{
1011 Lisp_Object map;
ce6e5d0b 1012 map = Fmake_sparse_keymap (Qnil);
2c6f1a39 1013 Ffset (name, map);
265a9e55 1014 if (!NILP (mapvar))
2c6f1a39
JB
1015 Fset (mapvar, map);
1016 else
1017 Fset (name, map);
1018 return name;
1019}
1020
1021DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1022 "Select KEYMAP as the global keymap.")
1023 (keymap)
1024 Lisp_Object keymap;
1025{
1026 keymap = get_keymap (keymap);
1027 current_global_map = keymap;
1028 return Qnil;
1029}
1030
1031DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1032 "Select KEYMAP as the local keymap.\n\
1033If KEYMAP is nil, that means no local keymap.")
1034 (keymap)
1035 Lisp_Object keymap;
1036{
265a9e55 1037 if (!NILP (keymap))
2c6f1a39
JB
1038 keymap = get_keymap (keymap);
1039
1040 current_buffer->keymap = keymap;
1041
1042 return Qnil;
1043}
1044
1045DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1046 "Return current buffer's local keymap, or nil if it has none.")
1047 ()
1048{
1049 return current_buffer->keymap;
1050}
1051
1052DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1053 "Return the current global keymap.")
1054 ()
1055{
1056 return current_global_map;
1057}
cc0a8174
JB
1058
1059DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1060 "Return a list of keymaps for the minor modes of the current buffer.")
1061 ()
1062{
1063 Lisp_Object *maps;
1064 int nmaps = current_minor_maps (0, &maps);
1065
1066 return Flist (nmaps, maps);
1067}
2c6f1a39 1068\f
cc0a8174
JB
1069/* Help functions for describing and documenting keymaps. */
1070
2c6f1a39 1071DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
53c8f9fa 1072 1, 2, 0,
2c6f1a39
JB
1073 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1074Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1075KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
f66ef185
RS
1076so that the KEYS increase in length. The first element is (\"\" . KEYMAP).\n\
1077An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1078then the value includes only maps for prefixes that start with PREFIX.")
53c8f9fa
RS
1079 (startmap, prefix)
1080 Lisp_Object startmap, prefix;
2c6f1a39 1081{
53c8f9fa
RS
1082 Lisp_Object maps, good_maps, tail;
1083 int prefixlen = 0;
1084
1085 if (!NILP (prefix))
1086 prefixlen = XINT (Flength (prefix));
2c6f1a39 1087
0b8fc2d4
RS
1088 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1089 get_keymap (startmap)),
1090 Qnil);
2c6f1a39
JB
1091
1092 /* For each map in the list maps,
1093 look at any other maps it points to,
1094 and stick them at the end if they are not already in the list.
1095
1096 This is a breadth-first traversal, where tail is the queue of
1097 nodes, and maps accumulates a list of all nodes visited. */
1098
f5b79c1c 1099 for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr)
2c6f1a39
JB
1100 {
1101 register Lisp_Object thisseq = Fcar (Fcar (tail));
1102 register Lisp_Object thismap = Fcdr (Fcar (tail));
1103 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
1104
1105 /* Does the current sequence end in the meta-prefix-char? */
1106 int is_metized = (XINT (last) >= 0
1107 && EQ (Faref (thisseq, last), meta_prefix_char));
1108
f5b79c1c 1109 for (; CONSP (thismap); thismap = XCONS (thismap)->cdr)
2c6f1a39 1110 {
f5b79c1c 1111 Lisp_Object elt = XCONS (thismap)->car;
2c6f1a39 1112
f5b79c1c
JB
1113 QUIT;
1114
1115 if (XTYPE (elt) == Lisp_Vector)
2c6f1a39
JB
1116 {
1117 register int i;
1118
1119 /* Vector keymap. Scan all the elements. */
db6f9d95 1120 for (i = 0; i < XVECTOR (elt)->size; i++)
2c6f1a39
JB
1121 {
1122 register Lisp_Object tem;
1123 register Lisp_Object cmd;
1124
f5b79c1c 1125 cmd = get_keyelt (XVECTOR (elt)->contents[i]);
265a9e55 1126 if (NILP (cmd)) continue;
2c6f1a39 1127 tem = Fkeymapp (cmd);
265a9e55 1128 if (!NILP (tem))
2c6f1a39
JB
1129 {
1130 cmd = get_keymap (cmd);
1131 /* Ignore keymaps that are already added to maps. */
1132 tem = Frassq (cmd, maps);
265a9e55 1133 if (NILP (tem))
2c6f1a39
JB
1134 {
1135 /* If the last key in thisseq is meta-prefix-char,
1136 turn it into a meta-ized keystroke. We know
1137 that the event we're about to append is an
f5b79c1c
JB
1138 ascii keystroke since we're processing a
1139 keymap table. */
2c6f1a39
JB
1140 if (is_metized)
1141 {
0b8fc2d4 1142 int meta_bit = meta_modifier;
2c6f1a39 1143 tem = Fcopy_sequence (thisseq);
0b8fc2d4
RS
1144
1145 Faset (tem, last, make_number (i | meta_bit));
2c6f1a39
JB
1146
1147 /* This new sequence is the same length as
1148 thisseq, so stick it in the list right
1149 after this one. */
0b8fc2d4
RS
1150 XCONS (tail)->cdr
1151 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
2c6f1a39
JB
1152 }
1153 else
1154 {
1155 tem = append_key (thisseq, make_number (i));
1156 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1157 }
1158 }
1159 }
1160 }
f5b79c1c
JB
1161 }
1162 else if (CONSP (elt))
2c6f1a39
JB
1163 {
1164 register Lisp_Object cmd = get_keyelt (XCONS (elt)->cdr);
53c8f9fa 1165 register Lisp_Object tem, filter;
2c6f1a39
JB
1166
1167 /* Ignore definitions that aren't keymaps themselves. */
1168 tem = Fkeymapp (cmd);
265a9e55 1169 if (!NILP (tem))
2c6f1a39
JB
1170 {
1171 /* Ignore keymaps that have been seen already. */
1172 cmd = get_keymap (cmd);
1173 tem = Frassq (cmd, maps);
265a9e55 1174 if (NILP (tem))
2c6f1a39 1175 {
53c8f9fa 1176 /* Let elt be the event defined by this map entry. */
2c6f1a39
JB
1177 elt = XCONS (elt)->car;
1178
1179 /* If the last key in thisseq is meta-prefix-char, and
1180 this entry is a binding for an ascii keystroke,
1181 turn it into a meta-ized keystroke. */
1182 if (is_metized && XTYPE (elt) == Lisp_Int)
1183 {
1184 tem = Fcopy_sequence (thisseq);
0b8fc2d4
RS
1185 Faset (tem, last,
1186 make_number (XINT (elt) | meta_modifier));
2c6f1a39
JB
1187
1188 /* This new sequence is the same length as
1189 thisseq, so stick it in the list right
1190 after this one. */
53c8f9fa
RS
1191 XCONS (tail)->cdr
1192 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
2c6f1a39
JB
1193 }
1194 else
1195 nconc2 (tail,
1196 Fcons (Fcons (append_key (thisseq, elt), cmd),
1197 Qnil));
1198 }
1199 }
1200 }
2c6f1a39 1201 }
2c6f1a39
JB
1202 }
1203
53c8f9fa
RS
1204 if (NILP (prefix))
1205 return maps;
1206
1207 /* Now find just the maps whose access prefixes start with PREFIX. */
1208
1209 good_maps = Qnil;
1210 for (; CONSP (maps); maps = XCONS (maps)->cdr)
1211 {
1212 Lisp_Object elt, thisseq;
1213 elt = XCONS (maps)->car;
1214 thisseq = XCONS (elt)->car;
1215 /* The access prefix must be at least as long as PREFIX,
1216 and the first elements must match those of PREFIX. */
1217 if (XINT (Flength (thisseq)) >= prefixlen)
1218 {
1219 int i;
1220 for (i = 0; i < prefixlen; i++)
1221 {
1222 Lisp_Object i1;
1223 XFASTINT (i1) = i;
1224 if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1225 break;
1226 }
1227 if (i == prefixlen)
1228 good_maps = Fcons (elt, good_maps);
1229 }
1230 }
1231
1232 return Fnreverse (good_maps);
2c6f1a39
JB
1233}
1234
1235Lisp_Object Qsingle_key_description, Qkey_description;
1236
1237DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1238 "Return a pretty description of key-sequence KEYS.\n\
1239Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1240spaces are put between sequence elements, etc.")
1241 (keys)
1242 Lisp_Object keys;
1243{
6ba6e250
RS
1244 if (XTYPE (keys) == Lisp_String)
1245 {
1246 Lisp_Object vector;
1247 int i;
1248 vector = Fmake_vector (Flength (keys), Qnil);
1249 for (i = 0; i < XSTRING (keys)->size; i++)
1250 {
1251 if (XSTRING (keys)->data[i] & 0x80)
1252 XFASTINT (XVECTOR (vector)->contents[i])
1253 = meta_modifier | (XSTRING (keys)->data[i] & ~0x80);
1254 else
1255 XFASTINT (XVECTOR (vector)->contents[i])
1256 = XSTRING (keys)->data[i];
1257 }
1258 keys = vector;
1259 }
2c6f1a39
JB
1260 return Fmapconcat (Qsingle_key_description, keys, build_string (" "));
1261}
1262
1263char *
1264push_key_description (c, p)
1265 register unsigned int c;
1266 register char *p;
1267{
71ac885b
RS
1268 /* Clear all the meaningless bits above the meta bit. */
1269 c &= meta_modifier | ~ - meta_modifier;
1270
6ba6e250
RS
1271 if (c & alt_modifier)
1272 {
1273 *p++ = 'A';
1274 *p++ = '-';
1275 c -= alt_modifier;
1276 }
1277 if (c & ctrl_modifier)
1278 {
1279 *p++ = 'C';
1280 *p++ = '-';
1281 c -= ctrl_modifier;
1282 }
1283 if (c & hyper_modifier)
1284 {
1285 *p++ = 'H';
1286 *p++ = '-';
1287 c -= hyper_modifier;
1288 }
1289 if (c & meta_modifier)
2c6f1a39
JB
1290 {
1291 *p++ = 'M';
1292 *p++ = '-';
6ba6e250
RS
1293 c -= meta_modifier;
1294 }
1295 if (c & shift_modifier)
1296 {
1297 *p++ = 'S';
1298 *p++ = '-';
1299 c -= shift_modifier;
1300 }
1301 if (c & super_modifier)
1302 {
1303 *p++ = 's';
1304 *p++ = '-';
1305 c -= super_modifier;
2c6f1a39
JB
1306 }
1307 if (c < 040)
1308 {
1309 if (c == 033)
1310 {
1311 *p++ = 'E';
1312 *p++ = 'S';
1313 *p++ = 'C';
1314 }
6ba6e250 1315 else if (c == '\t')
2c6f1a39
JB
1316 {
1317 *p++ = 'T';
1318 *p++ = 'A';
1319 *p++ = 'B';
1320 }
1321 else if (c == Ctl('J'))
1322 {
1323 *p++ = 'L';
1324 *p++ = 'F';
1325 *p++ = 'D';
1326 }
1327 else if (c == Ctl('M'))
1328 {
1329 *p++ = 'R';
1330 *p++ = 'E';
1331 *p++ = 'T';
1332 }
1333 else
1334 {
1335 *p++ = 'C';
1336 *p++ = '-';
1337 if (c > 0 && c <= Ctl ('Z'))
1338 *p++ = c + 0140;
1339 else
1340 *p++ = c + 0100;
1341 }
1342 }
1343 else if (c == 0177)
1344 {
1345 *p++ = 'D';
1346 *p++ = 'E';
1347 *p++ = 'L';
1348 }
1349 else if (c == ' ')
1350 {
1351 *p++ = 'S';
1352 *p++ = 'P';
1353 *p++ = 'C';
1354 }
6ba6e250 1355 else if (c < 256)
2c6f1a39 1356 *p++ = c;
6ba6e250
RS
1357 else
1358 {
1359 *p++ = '\\';
1360 *p++ = (7 & (c >> 15)) + '0';
1361 *p++ = (7 & (c >> 12)) + '0';
1362 *p++ = (7 & (c >> 9)) + '0';
1363 *p++ = (7 & (c >> 6)) + '0';
1364 *p++ = (7 & (c >> 3)) + '0';
1365 *p++ = (7 & (c >> 0)) + '0';
1366 }
2c6f1a39
JB
1367
1368 return p;
1369}
1370
1371DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
1372 "Return a pretty description of command character KEY.\n\
1373Control characters turn into C-whatever, etc.")
1374 (key)
1375 Lisp_Object key;
1376{
6ba6e250 1377 char tem[20];
2c6f1a39 1378
cebd887d 1379 key = EVENT_HEAD (key);
6bbbd9b0 1380
2c6f1a39
JB
1381 switch (XTYPE (key))
1382 {
1383 case Lisp_Int: /* Normal character */
6ba6e250 1384 *push_key_description (XUINT (key), tem) = 0;
2c6f1a39
JB
1385 return build_string (tem);
1386
1387 case Lisp_Symbol: /* Function key or event-symbol */
1388 return Fsymbol_name (key);
1389
2c6f1a39
JB
1390 default:
1391 error ("KEY must be an integer, cons, or symbol.");
1392 }
1393}
1394
1395char *
1396push_text_char_description (c, p)
1397 register unsigned int c;
1398 register char *p;
1399{
1400 if (c >= 0200)
1401 {
1402 *p++ = 'M';
1403 *p++ = '-';
1404 c -= 0200;
1405 }
1406 if (c < 040)
1407 {
1408 *p++ = '^';
1409 *p++ = c + 64; /* 'A' - 1 */
1410 }
1411 else if (c == 0177)
1412 {
1413 *p++ = '^';
1414 *p++ = '?';
1415 }
1416 else
1417 *p++ = c;
1418 return p;
1419}
1420
1421DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1422 "Return a pretty description of file-character CHAR.\n\
1423Control characters turn into \"^char\", etc.")
1424 (chr)
1425 Lisp_Object chr;
1426{
1427 char tem[6];
1428
1429 CHECK_NUMBER (chr, 0);
1430
1431 *push_text_char_description (XINT (chr) & 0377, tem) = 0;
1432
1433 return build_string (tem);
1434}
2fc66973
JB
1435
1436/* Return non-zero if SEQ contains only ASCII characters, perhaps with
1437 a meta bit. */
1438static int
1439ascii_sequence_p (seq)
1440 Lisp_Object seq;
1441{
1442 Lisp_Object i;
1443 int len = XINT (Flength (seq));
1444
1445 for (XFASTINT (i) = 0; XFASTINT (i) < len; XFASTINT (i)++)
1446 {
1447 Lisp_Object elt = Faref (seq, i);
1448
1449 if (XTYPE (elt) != Lisp_Int
1450 || (XUINT (elt) & ~CHAR_META) >= 0x80)
1451 return 0;
1452 }
1453
1454 return 1;
1455}
1456
2c6f1a39 1457\f
cc0a8174
JB
1458/* where-is - finding a command in a set of keymaps. */
1459
f0148b5e
RS
1460DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 4, 0,
1461 "Return list of keys that invoke DEFINITION.\n\
1462If KEYMAP is non-nil, search only KEYMAP and the global keymap.\n\
1463If KEYMAP is nil, search all the currently active keymaps.\n\
2c6f1a39 1464\n\
f0148b5e 1465If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,\n\
b8d584f6
RS
1466rather than a list of all possible key sequences.\n\
1467If FIRSTONLY is t, avoid key sequences which use non-ASCII\n\
2fc66973
JB
1468keys and therefore may not be usable on ASCII terminals. If FIRSTONLY\n\
1469is the symbol `non-ascii', return the first binding found, no matter\n\
1470what its components.\n\
2c6f1a39 1471\n\
f0148b5e 1472If optional 4th arg NOINDIRECT is non-nil, don't follow indirections\n\
2c6f1a39
JB
1473to other keymaps or slots. This makes it possible to search for an\n\
1474indirect definition itself.")
f0148b5e
RS
1475 (definition, keymap, firstonly, noindirect)
1476 Lisp_Object definition, keymap;
2c6f1a39
JB
1477 Lisp_Object firstonly, noindirect;
1478{
1479 register Lisp_Object maps;
1480 Lisp_Object found;
f0148b5e 1481 int keymap_specified = !NILP (keymap);
2c6f1a39 1482
f0148b5e
RS
1483 if (! keymap_specified)
1484 {
1485#ifdef USE_TEXT_PROPERTIES
1486 keymap = get_local_map (PT, current_buffer);
1487#else
1488 keymap = current_buffer->keymap;
1489#endif
1490 }
2c6f1a39 1491
f0148b5e
RS
1492 if (!NILP (keymap))
1493 maps = nconc2 (Faccessible_keymaps (get_keymap (keymap), Qnil),
1494 Faccessible_keymaps (get_keymap (current_global_map),
1495 Qnil));
2c6f1a39 1496 else
f0148b5e
RS
1497 maps = Faccessible_keymaps (get_keymap (current_global_map), Qnil);
1498
1499 /* Put the minor mode keymaps on the front. */
1500 if (! keymap_specified)
1501 {
1502 Lisp_Object minors;
1503 minors = Fnreverse (Fcurrent_minor_mode_maps ());
1504 while (!NILP (minors))
1505 {
1506 maps = nconc2 (Faccessible_keymaps (get_keymap (XCONS (minors)->car),
1507 Qnil),
1508 maps);
1509 minors = XCONS (minors)->cdr;
1510 }
1511 }
2c6f1a39
JB
1512
1513 found = Qnil;
1514
265a9e55 1515 for (; !NILP (maps); maps = Fcdr (maps))
2c6f1a39 1516 {
f5b79c1c
JB
1517 /* Key sequence to reach map */
1518 register Lisp_Object this = Fcar (Fcar (maps));
1519
1520 /* The map that it reaches */
1521 register Lisp_Object map = Fcdr (Fcar (maps));
1522
1523 /* If Fcar (map) is a VECTOR, the current element within that vector. */
1524 int i = 0;
2c6f1a39
JB
1525
1526 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1527 [M-CHAR] sequences, check if last character of the sequence
1528 is the meta-prefix char. */
1529 Lisp_Object last = make_number (XINT (Flength (this)) - 1);
1530 int last_is_meta = (XINT (last) >= 0
1531 && EQ (Faref (this, last), meta_prefix_char));
2c6f1a39 1532
fde3a52f
JB
1533 QUIT;
1534
f5b79c1c 1535 while (CONSP (map))
2c6f1a39 1536 {
f5b79c1c
JB
1537 /* Because the code we want to run on each binding is rather
1538 large, we don't want to have two separate loop bodies for
1539 sparse keymap bindings and tables; we want to iterate one
1540 loop body over both keymap and vector bindings.
1541
1542 For this reason, if Fcar (map) is a vector, we don't
1543 advance map to the next element until i indicates that we
1544 have finished off the vector. */
2c6f1a39 1545
f5b79c1c
JB
1546 Lisp_Object elt = XCONS (map)->car;
1547 Lisp_Object key, binding, sequence;
1548
fde3a52f
JB
1549 QUIT;
1550
f5b79c1c
JB
1551 /* Set key and binding to the current key and binding, and
1552 advance map and i to the next binding. */
1553 if (XTYPE (elt) == Lisp_Vector)
2c6f1a39
JB
1554 {
1555 /* In a vector, look at each element. */
f5b79c1c 1556 binding = XVECTOR (elt)->contents[i];
2c6f1a39
JB
1557 XFASTINT (key) = i;
1558 i++;
1559
f5b79c1c
JB
1560 /* If we've just finished scanning a vector, advance map
1561 to the next element, and reset i in anticipation of the
1562 next vector we may find. */
db6f9d95 1563 if (i >= XVECTOR (elt)->size)
2c6f1a39 1564 {
f5b79c1c
JB
1565 map = XCONS (map)->cdr;
1566 i = 0;
2c6f1a39 1567 }
f5b79c1c
JB
1568 }
1569 else if (CONSP (elt))
1570 {
2c6f1a39 1571 key = Fcar (Fcar (map));
f5b79c1c
JB
1572 binding = Fcdr (Fcar (map));
1573
1574 map = XCONS (map)->cdr;
2c6f1a39
JB
1575 }
1576 else
f5b79c1c
JB
1577 /* We want to ignore keymap elements that are neither
1578 vectors nor conses. */
fde3a52f
JB
1579 {
1580 map = XCONS (map)->cdr;
1581 continue;
1582 }
2c6f1a39
JB
1583
1584 /* Search through indirections unless that's not wanted. */
265a9e55 1585 if (NILP (noindirect))
2c6f1a39
JB
1586 binding = get_keyelt (binding);
1587
1588 /* End this iteration if this element does not match
1589 the target. */
1590
1591 if (XTYPE (definition) == Lisp_Cons)
1592 {
1593 Lisp_Object tem;
1594 tem = Fequal (binding, definition);
265a9e55 1595 if (NILP (tem))
2c6f1a39
JB
1596 continue;
1597 }
1598 else
1599 if (!EQ (binding, definition))
1600 continue;
1601
1602 /* We have found a match.
1603 Construct the key sequence where we found it. */
1604 if (XTYPE (key) == Lisp_Int && last_is_meta)
1605 {
1606 sequence = Fcopy_sequence (this);
0b8fc2d4 1607 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2c6f1a39
JB
1608 }
1609 else
1610 sequence = append_key (this, key);
1611
1612 /* Verify that this key binding is not shadowed by another
1613 binding for the same key, before we say it exists.
1614
1615 Mechanism: look for local definition of this key and if
1616 it is defined and does not match what we found then
1617 ignore this key.
1618
1619 Either nil or number as value from Flookup_key
1620 means undefined. */
f0148b5e 1621 if (keymap_specified)
2c6f1a39 1622 {
f0148b5e 1623 binding = Flookup_key (keymap, sequence, Qnil);
265a9e55 1624 if (!NILP (binding) && XTYPE (binding) != Lisp_Int)
2c6f1a39
JB
1625 {
1626 if (XTYPE (definition) == Lisp_Cons)
1627 {
1628 Lisp_Object tem;
1629 tem = Fequal (binding, definition);
265a9e55 1630 if (NILP (tem))
2c6f1a39
JB
1631 continue;
1632 }
1633 else
1634 if (!EQ (binding, definition))
1635 continue;
1636 }
1637 }
f0148b5e
RS
1638 else
1639 {
1640 binding = Fkey_binding (sequence, Qnil);
1641 if (!EQ (binding, definition))
1642 continue;
1643 }
2c6f1a39
JB
1644
1645 /* It is a true unshadowed match. Record it. */
2fc66973 1646 found = Fcons (sequence, found);
2c6f1a39 1647
2fc66973
JB
1648 /* If firstonly is Qnon_ascii, then we can return the first
1649 binding we find. If firstonly is not Qnon_ascii but not
1650 nil, then we should return the first ascii-only binding
1651 we find. */
1652 if (EQ (firstonly, Qnon_ascii))
1653 return sequence;
1654 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
2c6f1a39 1655 return sequence;
2c6f1a39
JB
1656 }
1657 }
2fc66973
JB
1658
1659 found = Fnreverse (found);
1660
1661 /* firstonly may have been t, but we may have gone all the way through
1662 the keymaps without finding an all-ASCII key sequence. So just
1663 return the best we could find. */
1664 if (! NILP (firstonly))
1665 return Fcar (found);
1666
1667 return found;
2c6f1a39
JB
1668}
1669
1670/* Return a string listing the keys and buttons that run DEFINITION. */
1671
1672static Lisp_Object
1673where_is_string (definition)
1674 Lisp_Object definition;
1675{
1676 register Lisp_Object keys, keys1;
1677
f0148b5e 1678 keys = Fwhere_is_internal (definition, Voverriding_local_map, Qnil, Qnil);
2c6f1a39
JB
1679 keys1 = Fmapconcat (Qkey_description, keys, build_string (", "));
1680
1681 return keys1;
1682}
1683
1684DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ",
1685 "Print message listing key sequences that invoke specified command.\n\
1686Argument is a command definition, usually a symbol with a function definition.")
1687 (definition)
1688 Lisp_Object definition;
1689{
1690 register Lisp_Object string;
1691
1692 CHECK_SYMBOL (definition, 0);
1693 string = where_is_string (definition);
1694
1695 if (XSTRING (string)->size)
1696 message ("%s is on %s", XSYMBOL (definition)->name->data,
1697 XSTRING (string)->data);
1698 else
1699 message ("%s is not on any key", XSYMBOL (definition)->name->data);
1700 return Qnil;
1701}
1702\f
cc0a8174
JB
1703/* describe-bindings - summarizing all the bindings in a set of keymaps. */
1704
53c8f9fa 1705DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
2c6f1a39 1706 "Show a list of all defined keys, and their definitions.\n\
53c8f9fa
RS
1707The list is put in a buffer, which is displayed.\n\
1708An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1709then we display only bindings that start with that prefix.")
1710 (prefix)
1711 Lisp_Object prefix;
2c6f1a39
JB
1712{
1713 register Lisp_Object thisbuf;
1714 XSET (thisbuf, Lisp_Buffer, current_buffer);
1715 internal_with_output_to_temp_buffer ("*Help*",
1716 describe_buffer_bindings,
53c8f9fa 1717 Fcons (thisbuf, prefix));
2c6f1a39
JB
1718 return Qnil;
1719}
1720
53c8f9fa
RS
1721/* ARG is (BUFFER . PREFIX). */
1722
2c6f1a39 1723static Lisp_Object
53c8f9fa
RS
1724describe_buffer_bindings (arg)
1725 Lisp_Object arg;
2c6f1a39 1726{
53c8f9fa 1727 Lisp_Object descbuf, prefix, shadow;
2c6f1a39
JB
1728 register Lisp_Object start1, start2;
1729
4726a9f1
JB
1730 char *alternate_heading
1731 = "\
1732Alternate Characters (use anywhere the nominal character is listed):\n\
1733nominal alternate\n\
1734------- ---------\n";
2c6f1a39 1735
53c8f9fa
RS
1736 descbuf = XCONS (arg)->car;
1737 prefix = XCONS (arg)->cdr;
a588e041 1738 shadow = Qnil;
53c8f9fa 1739
2c6f1a39
JB
1740 Fset_buffer (Vstandard_output);
1741
4726a9f1
JB
1742 /* Report on alternates for keys. */
1743 if (XTYPE (Vkeyboard_translate_table) == Lisp_String)
1744 {
1745 int c;
1746 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
1747 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
1748
1749 for (c = 0; c < translate_len; c++)
1750 if (translate[c] != c)
1751 {
1752 char buf[20];
1753 char *bufend;
1754
1755 if (alternate_heading)
1756 {
1757 insert_string (alternate_heading);
1758 alternate_heading = 0;
1759 }
1760
1761 bufend = push_key_description (translate[c], buf);
1762 insert (buf, bufend - buf);
1763 Findent_to (make_number (16), make_number (1));
1764 bufend = push_key_description (c, buf);
1765 insert (buf, bufend - buf);
1766
1767 insert ("\n", 1);
1768 }
1769
1770 insert ("\n", 1);
1771 }
1772
cc0a8174
JB
1773 {
1774 int i, nmaps;
1775 Lisp_Object *modes, *maps;
1776
4726a9f1
JB
1777 /* Temporarily switch to descbuf, so that we can get that buffer's
1778 minor modes correctly. */
1779 Fset_buffer (descbuf);
7d92e329
RS
1780 if (!NILP (Voverriding_local_map))
1781 nmaps = 0;
1782 else
1783 nmaps = current_minor_maps (&modes, &maps);
4726a9f1
JB
1784 Fset_buffer (Vstandard_output);
1785
53c8f9fa 1786 /* Print the minor mode maps. */
cc0a8174
JB
1787 for (i = 0; i < nmaps; i++)
1788 {
07f15dfd
RS
1789 /* Tht title for a minor mode keymap
1790 is constructed at run time.
1791 We let describe_map_tree do the actual insertion
1792 because it takes care of other features when doing so. */
1793 char *title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
1794 char *p = title;
1795
cc0a8174
JB
1796 if (XTYPE (modes[i]) == Lisp_Symbol)
1797 {
07f15dfd
RS
1798 *p++ = '`';
1799 bcopy (XSYMBOL (modes[i])->name->data, p,
1800 XSYMBOL (modes[i])->name->size);
1801 p += XSYMBOL (modes[i])->name->size;
1802 *p++ = '\'';
cc0a8174
JB
1803 }
1804 else
07f15dfd
RS
1805 {
1806 bcopy ("Strangely Named", p, sizeof ("Strangely Named"));
1807 p += sizeof ("Strangely Named");
1808 }
1809 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings"));
1810 p += sizeof (" Minor Mode Bindings");
1811 *p = 0;
1812
af1d6f09 1813 describe_map_tree (maps[i], 0, shadow, prefix, title, 0);
53c8f9fa 1814 shadow = Fcons (maps[i], shadow);
cc0a8174
JB
1815 }
1816 }
1817
53c8f9fa 1818 /* Print the (major mode) local map. */
7d92e329
RS
1819 if (!NILP (Voverriding_local_map))
1820 start1 = Voverriding_local_map;
1821 else
1822 start1 = XBUFFER (descbuf)->keymap;
1823
265a9e55 1824 if (!NILP (start1))
2c6f1a39 1825 {
53c8f9fa 1826 describe_map_tree (start1, 0, shadow, prefix,
af1d6f09 1827 "Major Mode Bindings", 0);
53c8f9fa 1828 shadow = Fcons (start1, shadow);
2c6f1a39
JB
1829 }
1830
53c8f9fa 1831 describe_map_tree (current_global_map, 0, shadow, prefix,
af1d6f09 1832 "Global Bindings", 0);
2c6f1a39
JB
1833
1834 Fset_buffer (descbuf);
1835 return Qnil;
1836}
1837
1838/* Insert a desription of the key bindings in STARTMAP,
1839 followed by those of all maps reachable through STARTMAP.
1840 If PARTIAL is nonzero, omit certain "uninteresting" commands
1841 (such as `undefined').
53c8f9fa
RS
1842 If SHADOW is non-nil, it is a list of maps;
1843 don't mention keys which would be shadowed by any of them.
1844 PREFIX, if non-nil, says mention only keys that start with PREFIX.
07f15dfd 1845 TITLE, if not 0, is a string to insert at the beginning.
af1d6f09
RS
1846 TITLE should not end with a colon or a newline; we supply that.
1847 If NOMENU is not 0, then omit menu-bar commands. */
2c6f1a39
JB
1848
1849void
af1d6f09 1850describe_map_tree (startmap, partial, shadow, prefix, title, nomenu)
53c8f9fa 1851 Lisp_Object startmap, shadow, prefix;
2c6f1a39 1852 int partial;
53c8f9fa 1853 char *title;
af1d6f09 1854 int nomenu;
2c6f1a39 1855{
2c6f1a39
JB
1856 Lisp_Object maps;
1857 struct gcpro gcpro1;
07f15dfd 1858 int something = 0;
53c8f9fa
RS
1859 char *key_heading
1860 = "\
1861key binding\n\
1862--- -------\n";
2c6f1a39 1863
53c8f9fa 1864 maps = Faccessible_keymaps (startmap, prefix);
2c6f1a39
JB
1865 GCPRO1 (maps);
1866
af1d6f09
RS
1867 if (nomenu)
1868 {
1869 Lisp_Object list;
1870
1871 /* Delete from MAPS each element that is for the menu bar. */
1872 for (list = maps; !NILP (list); list = XCONS (list)->cdr)
1873 {
1874 Lisp_Object elt, prefix, tem;
1875
1876 elt = Fcar (list);
1877 prefix = Fcar (elt);
1878 if (XVECTOR (prefix)->size >= 1)
1879 {
1880 tem = Faref (prefix, make_number (0));
1881 if (EQ (tem, Qmenu_bar))
1882 maps = Fdelq (elt, maps);
1883 }
1884 }
1885 }
1886
53c8f9fa
RS
1887 if (!NILP (maps))
1888 {
1889 if (title)
07f15dfd
RS
1890 {
1891 insert_string (title);
1892 if (!NILP (prefix))
1893 {
1894 insert_string (" Starting With ");
1895 insert1 (Fkey_description (prefix));
1896 }
1897 insert_string (":\n");
1898 }
53c8f9fa 1899 insert_string (key_heading);
07f15dfd 1900 something = 1;
53c8f9fa
RS
1901 }
1902
265a9e55 1903 for (; !NILP (maps); maps = Fcdr (maps))
2c6f1a39 1904 {
53c8f9fa
RS
1905 register Lisp_Object elt, prefix, sub_shadows, tail;
1906
2c6f1a39 1907 elt = Fcar (maps);
53c8f9fa
RS
1908 prefix = Fcar (elt);
1909
1910 sub_shadows = Qnil;
1911
1912 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2c6f1a39 1913 {
53c8f9fa
RS
1914 Lisp_Object shmap;
1915
1916 shmap = XCONS (tail)->car;
1917
1918 /* If the sequence by which we reach this keymap is zero-length,
1919 then the shadow map for this keymap is just SHADOW. */
1920 if ((XTYPE (prefix) == Lisp_String
1921 && XSTRING (prefix)->size == 0)
1922 || (XTYPE (prefix) == Lisp_Vector
1923 && XVECTOR (prefix)->size == 0))
1924 ;
1925 /* If the sequence by which we reach this keymap actually has
1926 some elements, then the sequence's definition in SHADOW is
1927 what we should use. */
1928 else
1929 {
1930 shmap = Flookup_key (shadow, Fcar (elt), Qt);
1931 if (XTYPE (shmap) == Lisp_Int)
1932 shmap = Qnil;
1933 }
1934
1935 /* If shmap is not nil and not a keymap,
1936 it completely shadows this map, so don't
1937 describe this map at all. */
1938 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
1939 goto skip;
1940
1941 if (!NILP (shmap))
1942 sub_shadows = Fcons (shmap, sub_shadows);
2c6f1a39
JB
1943 }
1944
53c8f9fa
RS
1945 describe_map (Fcdr (elt), Fcar (elt), partial, sub_shadows);
1946
1947 skip: ;
2c6f1a39
JB
1948 }
1949
07f15dfd
RS
1950 if (something)
1951 insert_string ("\n");
1952
2c6f1a39
JB
1953 UNGCPRO;
1954}
1955
1956static void
1957describe_command (definition)
1958 Lisp_Object definition;
1959{
1960 register Lisp_Object tem1;
1961
1962 Findent_to (make_number (16), make_number (1));
1963
1964 if (XTYPE (definition) == Lisp_Symbol)
1965 {
1966 XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
1967 insert1 (tem1);
1968 insert_string ("\n");
1969 }
24065b9c
RS
1970 else if (STRINGP (definition))
1971 insert_string ("Keyboard Macro\n");
2c6f1a39
JB
1972 else
1973 {
1974 tem1 = Fkeymapp (definition);
265a9e55 1975 if (!NILP (tem1))
2c6f1a39
JB
1976 insert_string ("Prefix Command\n");
1977 else
1978 insert_string ("??\n");
1979 }
1980}
1981
1982/* Describe the contents of map MAP, assuming that this map itself is
1983 reached by the sequence of prefix keys KEYS (a string or vector).
1984 PARTIAL, SHADOW is as in `describe_map_tree' above. */
1985
1986static void
1987describe_map (map, keys, partial, shadow)
1988 Lisp_Object map, keys;
1989 int partial;
1990 Lisp_Object shadow;
1991{
1992 register Lisp_Object keysdesc;
1993
d09b2024 1994 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
5cba3869
RS
1995 {
1996 Lisp_Object tem;
1997 /* Call Fkey_description first, to avoid GC bug for the other string. */
1998 tem = Fkey_description (keys);
1999 keysdesc = concat2 (tem, build_string (" "));
2000 }
2c6f1a39
JB
2001 else
2002 keysdesc = Qnil;
2003
f5b79c1c 2004 describe_map_2 (map, keysdesc, describe_command, partial, shadow);
2c6f1a39
JB
2005}
2006
53c8f9fa
RS
2007/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2008 Returns the first non-nil binding found in any of those maps. */
2009
2010static Lisp_Object
2011shadow_lookup (shadow, key, flag)
2012 Lisp_Object shadow, key, flag;
2013{
2014 Lisp_Object tail, value;
2015
2016 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2017 {
2018 value = Flookup_key (XCONS (tail)->car, key, flag);
2019 if (!NILP (value))
2020 return value;
2021 }
2022 return Qnil;
2023}
2024
f5b79c1c 2025/* Insert a description of KEYMAP into the current buffer. */
2c6f1a39
JB
2026
2027static void
f5b79c1c
JB
2028describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow)
2029 register Lisp_Object keymap;
2c6f1a39
JB
2030 Lisp_Object elt_prefix;
2031 int (*elt_describer) ();
2032 int partial;
2033 Lisp_Object shadow;
2034{
53c8f9fa 2035 Lisp_Object tail, definition, event;
99a225a9 2036 Lisp_Object tem;
2c6f1a39
JB
2037 Lisp_Object suppress;
2038 Lisp_Object kludge;
2039 int first = 1;
2040 struct gcpro gcpro1, gcpro2, gcpro3;
2041
2042 if (partial)
2043 suppress = intern ("suppress-keymap");
2044
2045 /* This vector gets used to present single keys to Flookup_key. Since
f5b79c1c 2046 that is done once per keymap element, we don't want to cons up a
2c6f1a39
JB
2047 fresh vector every time. */
2048 kludge = Fmake_vector (make_number (1), Qnil);
99a225a9 2049 definition = Qnil;
2c6f1a39 2050
99a225a9 2051 GCPRO3 (elt_prefix, definition, kludge);
2c6f1a39 2052
53c8f9fa 2053 for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = Fcdr (tail))
2c6f1a39
JB
2054 {
2055 QUIT;
2c6f1a39 2056
53c8f9fa
RS
2057 if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
2058 describe_vector (XCONS (tail)->car,
f5b79c1c
JB
2059 elt_prefix, elt_describer, partial, shadow);
2060 else
2c6f1a39 2061 {
53c8f9fa
RS
2062 event = Fcar_safe (Fcar (tail));
2063 definition = get_keyelt (Fcdr_safe (Fcar (tail)));
2c6f1a39 2064
f5b79c1c 2065 /* Don't show undefined commands or suppressed commands. */
99a225a9
RS
2066 if (NILP (definition)) continue;
2067 if (XTYPE (definition) == Lisp_Symbol && partial)
f5b79c1c 2068 {
99a225a9
RS
2069 tem = Fget (definition, suppress);
2070 if (!NILP (tem))
f5b79c1c
JB
2071 continue;
2072 }
2c6f1a39 2073
f5b79c1c
JB
2074 /* Don't show a command that isn't really visible
2075 because a local definition of the same key shadows it. */
2c6f1a39 2076
99a225a9 2077 XVECTOR (kludge)->contents[0] = event;
f5b79c1c
JB
2078 if (!NILP (shadow))
2079 {
53c8f9fa 2080 tem = shadow_lookup (shadow, kludge, Qt);
f5b79c1c
JB
2081 if (!NILP (tem)) continue;
2082 }
2083
53c8f9fa 2084 tem = Flookup_key (keymap, kludge, Qt);
99a225a9
RS
2085 if (! EQ (tem, definition)) continue;
2086
f5b79c1c
JB
2087 if (first)
2088 {
2089 insert ("\n", 1);
2090 first = 0;
2091 }
2c6f1a39 2092
f5b79c1c
JB
2093 if (!NILP (elt_prefix))
2094 insert1 (elt_prefix);
2c6f1a39 2095
99a225a9
RS
2096 /* THIS gets the string to describe the character EVENT. */
2097 insert1 (Fsingle_key_description (event));
2c6f1a39 2098
f5b79c1c
JB
2099 /* Print a description of the definition of this character.
2100 elt_describer will take care of spacing out far enough
2101 for alignment purposes. */
99a225a9 2102 (*elt_describer) (definition);
f5b79c1c 2103 }
2c6f1a39
JB
2104 }
2105
2106 UNGCPRO;
2107}
2108
2109static int
2110describe_vector_princ (elt)
2111 Lisp_Object elt;
2112{
81fa9e2f 2113 Findent_to (make_number (16), make_number (1));
2c6f1a39 2114 Fprinc (elt, Qnil);
ad4ec84a 2115 Fterpri (Qnil);
2c6f1a39
JB
2116}
2117
2118DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
ad4ec84a 2119 "Insert a description of contents of VECTOR.\n\
2c6f1a39
JB
2120This is text showing the elements of vector matched against indices.")
2121 (vector)
2122 Lisp_Object vector;
2123{
ad4ec84a
RS
2124 int count = specpdl_ptr - specpdl;
2125
2126 specbind (Qstandard_output, Fcurrent_buffer ());
2c6f1a39 2127 CHECK_VECTOR (vector, 0);
92cc37e8 2128 describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil);
ad4ec84a
RS
2129
2130 return unbind_to (count, Qnil);
2c6f1a39
JB
2131}
2132
2133describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
2134 register Lisp_Object vector;
2135 Lisp_Object elt_prefix;
2136 int (*elt_describer) ();
2137 int partial;
2138 Lisp_Object shadow;
2139{
2140 Lisp_Object this;
2141 Lisp_Object dummy;
2142 Lisp_Object tem1, tem2;
2143 register int i;
2144 Lisp_Object suppress;
2145 Lisp_Object kludge;
2146 int first = 1;
2147 struct gcpro gcpro1, gcpro2, gcpro3;
2148
2149 tem1 = Qnil;
2150
2151 /* This vector gets used to present single keys to Flookup_key. Since
2152 that is done once per vector element, we don't want to cons up a
2153 fresh vector every time. */
2154 kludge = Fmake_vector (make_number (1), Qnil);
2155 GCPRO3 (elt_prefix, tem1, kludge);
2156
2157 if (partial)
2158 suppress = intern ("suppress-keymap");
2159
db6f9d95 2160 for (i = 0; i < XVECTOR (vector)->size; i++)
2c6f1a39
JB
2161 {
2162 QUIT;
2163 tem1 = get_keyelt (XVECTOR (vector)->contents[i]);
2164
265a9e55 2165 if (NILP (tem1)) continue;
2c6f1a39
JB
2166
2167 /* Don't mention suppressed commands. */
2168 if (XTYPE (tem1) == Lisp_Symbol && partial)
2169 {
2170 this = Fget (tem1, suppress);
265a9e55 2171 if (!NILP (this))
2c6f1a39
JB
2172 continue;
2173 }
2174
2175 /* If this command in this map is shadowed by some other map,
2176 ignore it. */
265a9e55 2177 if (!NILP (shadow))
2c6f1a39
JB
2178 {
2179 Lisp_Object tem;
2180
2181 XVECTOR (kludge)->contents[0] = make_number (i);
53c8f9fa 2182 tem = shadow_lookup (shadow, kludge, Qt);
2c6f1a39 2183
265a9e55 2184 if (!NILP (tem)) continue;
2c6f1a39
JB
2185 }
2186
2187 if (first)
2188 {
2189 insert ("\n", 1);
2190 first = 0;
2191 }
2192
2193 /* Output the prefix that applies to every entry in this map. */
265a9e55 2194 if (!NILP (elt_prefix))
2c6f1a39
JB
2195 insert1 (elt_prefix);
2196
2197 /* Get the string to describe the character I, and print it. */
2198 XFASTINT (dummy) = i;
2199
2200 /* THIS gets the string to describe the character DUMMY. */
2201 this = Fsingle_key_description (dummy);
2202 insert1 (this);
2203
2204 /* Find all consecutive characters that have the same definition. */
db6f9d95 2205 while (i + 1 < XVECTOR (vector)->size
2c6f1a39
JB
2206 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]),
2207 EQ (tem2, tem1)))
2208 i++;
2209
2210 /* If we have a range of more than one character,
2211 print where the range reaches to. */
2212
2213 if (i != XINT (dummy))
2214 {
2215 insert (" .. ", 4);
265a9e55 2216 if (!NILP (elt_prefix))
2c6f1a39
JB
2217 insert1 (elt_prefix);
2218
2219 XFASTINT (dummy) = i;
2220 insert1 (Fsingle_key_description (dummy));
2221 }
2222
2223 /* Print a description of the definition of this character.
2224 elt_describer will take care of spacing out far enough
2225 for alignment purposes. */
2226 (*elt_describer) (tem1);
2227 }
2228
2229 UNGCPRO;
2230}
2231\f
cc0a8174 2232/* Apropos - finding all symbols whose names match a regexp. */
2c6f1a39
JB
2233Lisp_Object apropos_predicate;
2234Lisp_Object apropos_accumulate;
2235
2236static void
2237apropos_accum (symbol, string)
2238 Lisp_Object symbol, string;
2239{
2240 register Lisp_Object tem;
2241
2242 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
265a9e55 2243 if (!NILP (tem) && !NILP (apropos_predicate))
2c6f1a39 2244 tem = call1 (apropos_predicate, symbol);
265a9e55 2245 if (!NILP (tem))
2c6f1a39
JB
2246 apropos_accumulate = Fcons (symbol, apropos_accumulate);
2247}
2248
2249DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
2250 "Show all symbols whose names contain match for REGEXP.\n\
2251If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\
2252for each symbol and a symbol is mentioned only if that returns non-nil.\n\
2253Return list of symbols found.")
2254 (string, pred)
2255 Lisp_Object string, pred;
2256{
2257 struct gcpro gcpro1, gcpro2;
2258 CHECK_STRING (string, 0);
2259 apropos_predicate = pred;
2260 GCPRO2 (apropos_predicate, apropos_accumulate);
2261 apropos_accumulate = Qnil;
2262 map_obarray (Vobarray, apropos_accum, string);
2263 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
2264 UNGCPRO;
2265 return apropos_accumulate;
2266}
2267\f
2268syms_of_keymap ()
2269{
2270 Lisp_Object tem;
2271
2272 Qkeymap = intern ("keymap");
2273 staticpro (&Qkeymap);
2274
2275/* Initialize the keymaps standardly used.
2276 Each one is the value of a Lisp variable, and is also
2277 pointed to by a C variable */
2278
19eaeb86 2279 global_map = Fcons (Qkeymap,
1447c534 2280 Fcons (Fmake_vector (make_number (0400), Qnil), Qnil));
2c6f1a39
JB
2281 Fset (intern ("global-map"), global_map);
2282
ce6e5d0b 2283 meta_map = Fmake_keymap (Qnil);
2c6f1a39
JB
2284 Fset (intern ("esc-map"), meta_map);
2285 Ffset (intern ("ESC-prefix"), meta_map);
2286
ce6e5d0b 2287 control_x_map = Fmake_keymap (Qnil);
2c6f1a39
JB
2288 Fset (intern ("ctl-x-map"), control_x_map);
2289 Ffset (intern ("Control-X-prefix"), control_x_map);
2290
2291 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
2292 "Default keymap to use when reading from the minibuffer.");
ce6e5d0b 2293 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2294
2295 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
2296 "Local keymap for the minibuffer when spaces are not allowed.");
ce6e5d0b 2297 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2298
2299 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
2300 "Local keymap for minibuffer input with completion.");
ce6e5d0b 2301 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2302
2303 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
2304 "Local keymap for minibuffer input with completion, for exact match.");
ce6e5d0b 2305 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2306
2307 current_global_map = global_map;
2308
cc0a8174
JB
2309 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
2310 "Alist of keymaps to use for minor modes.\n\
2311Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
2312key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
2313If two active keymaps bind the same key, the keymap appearing earlier\n\
2314in the list takes precedence.");
2315 Vminor_mode_map_alist = Qnil;
2316
6bbbd9b0
JB
2317 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
2318 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
2319This allows Emacs to recognize function keys sent from ASCII\n\
2320terminals at any point in a key sequence.\n\
2321\n\
2322The read-key-sequence function replaces subsequences bound by\n\
2323function-key-map with their bindings. When the current local and global\n\
2324keymaps have no binding for the current key sequence but\n\
718ca51e 2325function-key-map binds a suffix of the sequence to a vector or string,\n\
6bbbd9b0
JB
2326read-key-sequence replaces the matching suffix with its binding, and\n\
2327continues with the new sequence.\n\
2328\n\
718ca51e
JB
2329For example, suppose function-key-map binds `ESC O P' to [f1].\n\
2330Typing `ESC O P' to read-key-sequence would return [f1]. Typing\n\
2331`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
2332key, typing `ESC O P x' would return [f1 x].");
ce6e5d0b 2333 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
6bbbd9b0 2334
2c6f1a39
JB
2335 Qsingle_key_description = intern ("single-key-description");
2336 staticpro (&Qsingle_key_description);
2337
2338 Qkey_description = intern ("key-description");
2339 staticpro (&Qkey_description);
2340
2341 Qkeymapp = intern ("keymapp");
2342 staticpro (&Qkeymapp);
2343
2fc66973
JB
2344 Qnon_ascii = intern ("non-ascii");
2345 staticpro (&Qnon_ascii);
2346
2c6f1a39
JB
2347 defsubr (&Skeymapp);
2348 defsubr (&Smake_keymap);
2349 defsubr (&Smake_sparse_keymap);
2350 defsubr (&Scopy_keymap);
2351 defsubr (&Skey_binding);
2352 defsubr (&Slocal_key_binding);
2353 defsubr (&Sglobal_key_binding);
cc0a8174 2354 defsubr (&Sminor_mode_key_binding);
2c6f1a39
JB
2355 defsubr (&Sglobal_set_key);
2356 defsubr (&Slocal_set_key);
2357 defsubr (&Sdefine_key);
2358 defsubr (&Slookup_key);
2359 defsubr (&Sglobal_unset_key);
2360 defsubr (&Slocal_unset_key);
2361 defsubr (&Sdefine_prefix_command);
2362 defsubr (&Suse_global_map);
2363 defsubr (&Suse_local_map);
2364 defsubr (&Scurrent_local_map);
2365 defsubr (&Scurrent_global_map);
cc0a8174 2366 defsubr (&Scurrent_minor_mode_maps);
2c6f1a39
JB
2367 defsubr (&Saccessible_keymaps);
2368 defsubr (&Skey_description);
2369 defsubr (&Sdescribe_vector);
2370 defsubr (&Ssingle_key_description);
2371 defsubr (&Stext_char_description);
2372 defsubr (&Swhere_is_internal);
2373 defsubr (&Swhere_is);
2374 defsubr (&Sdescribe_bindings);
2375 defsubr (&Sapropos_internal);
2376}
2377
2378keys_of_keymap ()
2379{
2380 Lisp_Object tem;
2381
2382 initial_define_key (global_map, 033, "ESC-prefix");
2383 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
2384}