(Fsubstitute_command_keys): Pass keymap as that arg
[bpt/emacs.git] / src / keymap.c
CommitLineData
2c6f1a39 1/* Manipulation of keymaps
c6c5df7f 2 Copyright (C) 1985, 1986, 1987, 1988, 1993 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
2c6f1a39
JB
1460DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
1461 "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\
1462If KEYMAP is nil, search only KEYMAP1.\n\
1463If KEYMAP1 is nil, use the current global map.\n\
1464\n\
b8d584f6
RS
1465If optional 4th arg FIRSTONLY is non-nil, return the first key sequence found,\n\
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
JB
1471\n\
1472If optional 5th arg NOINDIRECT is non-nil, don't follow indirections\n\
1473to other keymaps or slots. This makes it possible to search for an\n\
1474indirect definition itself.")
1475 (definition, local_keymap, global_keymap, firstonly, noindirect)
1476 Lisp_Object definition, local_keymap, global_keymap;
1477 Lisp_Object firstonly, noindirect;
1478{
1479 register Lisp_Object maps;
1480 Lisp_Object found;
1481
265a9e55 1482 if (NILP (global_keymap))
2c6f1a39
JB
1483 global_keymap = current_global_map;
1484
265a9e55 1485 if (!NILP (local_keymap))
53c8f9fa
RS
1486 maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap), Qnil),
1487 Faccessible_keymaps (get_keymap (global_keymap), Qnil));
2c6f1a39 1488 else
53c8f9fa 1489 maps = Faccessible_keymaps (get_keymap (global_keymap), Qnil);
2c6f1a39
JB
1490
1491 found = Qnil;
1492
265a9e55 1493 for (; !NILP (maps); maps = Fcdr (maps))
2c6f1a39 1494 {
f5b79c1c
JB
1495 /* Key sequence to reach map */
1496 register Lisp_Object this = Fcar (Fcar (maps));
1497
1498 /* The map that it reaches */
1499 register Lisp_Object map = Fcdr (Fcar (maps));
1500
1501 /* If Fcar (map) is a VECTOR, the current element within that vector. */
1502 int i = 0;
2c6f1a39
JB
1503
1504 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1505 [M-CHAR] sequences, check if last character of the sequence
1506 is the meta-prefix char. */
1507 Lisp_Object last = make_number (XINT (Flength (this)) - 1);
1508 int last_is_meta = (XINT (last) >= 0
1509 && EQ (Faref (this, last), meta_prefix_char));
2c6f1a39 1510
fde3a52f
JB
1511 QUIT;
1512
f5b79c1c 1513 while (CONSP (map))
2c6f1a39 1514 {
f5b79c1c
JB
1515 /* Because the code we want to run on each binding is rather
1516 large, we don't want to have two separate loop bodies for
1517 sparse keymap bindings and tables; we want to iterate one
1518 loop body over both keymap and vector bindings.
1519
1520 For this reason, if Fcar (map) is a vector, we don't
1521 advance map to the next element until i indicates that we
1522 have finished off the vector. */
2c6f1a39 1523
f5b79c1c
JB
1524 Lisp_Object elt = XCONS (map)->car;
1525 Lisp_Object key, binding, sequence;
1526
fde3a52f
JB
1527 QUIT;
1528
f5b79c1c
JB
1529 /* Set key and binding to the current key and binding, and
1530 advance map and i to the next binding. */
1531 if (XTYPE (elt) == Lisp_Vector)
2c6f1a39
JB
1532 {
1533 /* In a vector, look at each element. */
f5b79c1c 1534 binding = XVECTOR (elt)->contents[i];
2c6f1a39
JB
1535 XFASTINT (key) = i;
1536 i++;
1537
f5b79c1c
JB
1538 /* If we've just finished scanning a vector, advance map
1539 to the next element, and reset i in anticipation of the
1540 next vector we may find. */
db6f9d95 1541 if (i >= XVECTOR (elt)->size)
2c6f1a39 1542 {
f5b79c1c
JB
1543 map = XCONS (map)->cdr;
1544 i = 0;
2c6f1a39 1545 }
f5b79c1c
JB
1546 }
1547 else if (CONSP (elt))
1548 {
2c6f1a39 1549 key = Fcar (Fcar (map));
f5b79c1c
JB
1550 binding = Fcdr (Fcar (map));
1551
1552 map = XCONS (map)->cdr;
2c6f1a39
JB
1553 }
1554 else
f5b79c1c
JB
1555 /* We want to ignore keymap elements that are neither
1556 vectors nor conses. */
fde3a52f
JB
1557 {
1558 map = XCONS (map)->cdr;
1559 continue;
1560 }
2c6f1a39
JB
1561
1562 /* Search through indirections unless that's not wanted. */
265a9e55 1563 if (NILP (noindirect))
2c6f1a39
JB
1564 binding = get_keyelt (binding);
1565
1566 /* End this iteration if this element does not match
1567 the target. */
1568
1569 if (XTYPE (definition) == Lisp_Cons)
1570 {
1571 Lisp_Object tem;
1572 tem = Fequal (binding, definition);
265a9e55 1573 if (NILP (tem))
2c6f1a39
JB
1574 continue;
1575 }
1576 else
1577 if (!EQ (binding, definition))
1578 continue;
1579
1580 /* We have found a match.
1581 Construct the key sequence where we found it. */
1582 if (XTYPE (key) == Lisp_Int && last_is_meta)
1583 {
1584 sequence = Fcopy_sequence (this);
0b8fc2d4 1585 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2c6f1a39
JB
1586 }
1587 else
1588 sequence = append_key (this, key);
1589
1590 /* Verify that this key binding is not shadowed by another
1591 binding for the same key, before we say it exists.
1592
1593 Mechanism: look for local definition of this key and if
1594 it is defined and does not match what we found then
1595 ignore this key.
1596
1597 Either nil or number as value from Flookup_key
1598 means undefined. */
265a9e55 1599 if (!NILP (local_keymap))
2c6f1a39 1600 {
7c140252 1601 binding = Flookup_key (local_keymap, sequence, Qnil);
265a9e55 1602 if (!NILP (binding) && XTYPE (binding) != Lisp_Int)
2c6f1a39
JB
1603 {
1604 if (XTYPE (definition) == Lisp_Cons)
1605 {
1606 Lisp_Object tem;
1607 tem = Fequal (binding, definition);
265a9e55 1608 if (NILP (tem))
2c6f1a39
JB
1609 continue;
1610 }
1611 else
1612 if (!EQ (binding, definition))
1613 continue;
1614 }
1615 }
1616
1617 /* It is a true unshadowed match. Record it. */
2fc66973 1618 found = Fcons (sequence, found);
2c6f1a39 1619
2fc66973
JB
1620 /* If firstonly is Qnon_ascii, then we can return the first
1621 binding we find. If firstonly is not Qnon_ascii but not
1622 nil, then we should return the first ascii-only binding
1623 we find. */
1624 if (EQ (firstonly, Qnon_ascii))
1625 return sequence;
1626 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
2c6f1a39 1627 return sequence;
2c6f1a39
JB
1628 }
1629 }
2fc66973
JB
1630
1631 found = Fnreverse (found);
1632
1633 /* firstonly may have been t, but we may have gone all the way through
1634 the keymaps without finding an all-ASCII key sequence. So just
1635 return the best we could find. */
1636 if (! NILP (firstonly))
1637 return Fcar (found);
1638
1639 return found;
2c6f1a39
JB
1640}
1641
1642/* Return a string listing the keys and buttons that run DEFINITION. */
1643
1644static Lisp_Object
1645where_is_string (definition)
1646 Lisp_Object definition;
1647{
1648 register Lisp_Object keys, keys1;
1649
1650 keys = Fwhere_is_internal (definition,
1651 current_buffer->keymap, Qnil, Qnil, Qnil);
1652 keys1 = Fmapconcat (Qkey_description, keys, build_string (", "));
1653
1654 return keys1;
1655}
1656
1657DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ",
1658 "Print message listing key sequences that invoke specified command.\n\
1659Argument is a command definition, usually a symbol with a function definition.")
1660 (definition)
1661 Lisp_Object definition;
1662{
1663 register Lisp_Object string;
1664
1665 CHECK_SYMBOL (definition, 0);
1666 string = where_is_string (definition);
1667
1668 if (XSTRING (string)->size)
1669 message ("%s is on %s", XSYMBOL (definition)->name->data,
1670 XSTRING (string)->data);
1671 else
1672 message ("%s is not on any key", XSYMBOL (definition)->name->data);
1673 return Qnil;
1674}
1675\f
cc0a8174
JB
1676/* describe-bindings - summarizing all the bindings in a set of keymaps. */
1677
53c8f9fa 1678DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
2c6f1a39 1679 "Show a list of all defined keys, and their definitions.\n\
53c8f9fa
RS
1680The list is put in a buffer, which is displayed.\n\
1681An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1682then we display only bindings that start with that prefix.")
1683 (prefix)
1684 Lisp_Object prefix;
2c6f1a39
JB
1685{
1686 register Lisp_Object thisbuf;
1687 XSET (thisbuf, Lisp_Buffer, current_buffer);
1688 internal_with_output_to_temp_buffer ("*Help*",
1689 describe_buffer_bindings,
53c8f9fa 1690 Fcons (thisbuf, prefix));
2c6f1a39
JB
1691 return Qnil;
1692}
1693
53c8f9fa
RS
1694/* ARG is (BUFFER . PREFIX). */
1695
2c6f1a39 1696static Lisp_Object
53c8f9fa
RS
1697describe_buffer_bindings (arg)
1698 Lisp_Object arg;
2c6f1a39 1699{
53c8f9fa 1700 Lisp_Object descbuf, prefix, shadow;
2c6f1a39
JB
1701 register Lisp_Object start1, start2;
1702
4726a9f1
JB
1703 char *alternate_heading
1704 = "\
1705Alternate Characters (use anywhere the nominal character is listed):\n\
1706nominal alternate\n\
1707------- ---------\n";
2c6f1a39 1708
53c8f9fa
RS
1709 descbuf = XCONS (arg)->car;
1710 prefix = XCONS (arg)->cdr;
a588e041 1711 shadow = Qnil;
53c8f9fa 1712
2c6f1a39
JB
1713 Fset_buffer (Vstandard_output);
1714
4726a9f1
JB
1715 /* Report on alternates for keys. */
1716 if (XTYPE (Vkeyboard_translate_table) == Lisp_String)
1717 {
1718 int c;
1719 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
1720 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
1721
1722 for (c = 0; c < translate_len; c++)
1723 if (translate[c] != c)
1724 {
1725 char buf[20];
1726 char *bufend;
1727
1728 if (alternate_heading)
1729 {
1730 insert_string (alternate_heading);
1731 alternate_heading = 0;
1732 }
1733
1734 bufend = push_key_description (translate[c], buf);
1735 insert (buf, bufend - buf);
1736 Findent_to (make_number (16), make_number (1));
1737 bufend = push_key_description (c, buf);
1738 insert (buf, bufend - buf);
1739
1740 insert ("\n", 1);
1741 }
1742
1743 insert ("\n", 1);
1744 }
1745
cc0a8174
JB
1746 {
1747 int i, nmaps;
1748 Lisp_Object *modes, *maps;
1749
4726a9f1
JB
1750 /* Temporarily switch to descbuf, so that we can get that buffer's
1751 minor modes correctly. */
1752 Fset_buffer (descbuf);
7d92e329
RS
1753 if (!NILP (Voverriding_local_map))
1754 nmaps = 0;
1755 else
1756 nmaps = current_minor_maps (&modes, &maps);
4726a9f1
JB
1757 Fset_buffer (Vstandard_output);
1758
53c8f9fa 1759 /* Print the minor mode maps. */
cc0a8174
JB
1760 for (i = 0; i < nmaps; i++)
1761 {
07f15dfd
RS
1762 /* Tht title for a minor mode keymap
1763 is constructed at run time.
1764 We let describe_map_tree do the actual insertion
1765 because it takes care of other features when doing so. */
1766 char *title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
1767 char *p = title;
1768
cc0a8174
JB
1769 if (XTYPE (modes[i]) == Lisp_Symbol)
1770 {
07f15dfd
RS
1771 *p++ = '`';
1772 bcopy (XSYMBOL (modes[i])->name->data, p,
1773 XSYMBOL (modes[i])->name->size);
1774 p += XSYMBOL (modes[i])->name->size;
1775 *p++ = '\'';
cc0a8174
JB
1776 }
1777 else
07f15dfd
RS
1778 {
1779 bcopy ("Strangely Named", p, sizeof ("Strangely Named"));
1780 p += sizeof ("Strangely Named");
1781 }
1782 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings"));
1783 p += sizeof (" Minor Mode Bindings");
1784 *p = 0;
1785
af1d6f09 1786 describe_map_tree (maps[i], 0, shadow, prefix, title, 0);
53c8f9fa 1787 shadow = Fcons (maps[i], shadow);
cc0a8174
JB
1788 }
1789 }
1790
53c8f9fa 1791 /* Print the (major mode) local map. */
7d92e329
RS
1792 if (!NILP (Voverriding_local_map))
1793 start1 = Voverriding_local_map;
1794 else
1795 start1 = XBUFFER (descbuf)->keymap;
1796
265a9e55 1797 if (!NILP (start1))
2c6f1a39 1798 {
53c8f9fa 1799 describe_map_tree (start1, 0, shadow, prefix,
af1d6f09 1800 "Major Mode Bindings", 0);
53c8f9fa 1801 shadow = Fcons (start1, shadow);
2c6f1a39
JB
1802 }
1803
53c8f9fa 1804 describe_map_tree (current_global_map, 0, shadow, prefix,
af1d6f09 1805 "Global Bindings", 0);
2c6f1a39
JB
1806
1807 Fset_buffer (descbuf);
1808 return Qnil;
1809}
1810
1811/* Insert a desription of the key bindings in STARTMAP,
1812 followed by those of all maps reachable through STARTMAP.
1813 If PARTIAL is nonzero, omit certain "uninteresting" commands
1814 (such as `undefined').
53c8f9fa
RS
1815 If SHADOW is non-nil, it is a list of maps;
1816 don't mention keys which would be shadowed by any of them.
1817 PREFIX, if non-nil, says mention only keys that start with PREFIX.
07f15dfd 1818 TITLE, if not 0, is a string to insert at the beginning.
af1d6f09
RS
1819 TITLE should not end with a colon or a newline; we supply that.
1820 If NOMENU is not 0, then omit menu-bar commands. */
2c6f1a39
JB
1821
1822void
af1d6f09 1823describe_map_tree (startmap, partial, shadow, prefix, title, nomenu)
53c8f9fa 1824 Lisp_Object startmap, shadow, prefix;
2c6f1a39 1825 int partial;
53c8f9fa 1826 char *title;
af1d6f09 1827 int nomenu;
2c6f1a39 1828{
2c6f1a39
JB
1829 Lisp_Object maps;
1830 struct gcpro gcpro1;
07f15dfd 1831 int something = 0;
53c8f9fa
RS
1832 char *key_heading
1833 = "\
1834key binding\n\
1835--- -------\n";
2c6f1a39 1836
53c8f9fa 1837 maps = Faccessible_keymaps (startmap, prefix);
2c6f1a39
JB
1838 GCPRO1 (maps);
1839
af1d6f09
RS
1840 if (nomenu)
1841 {
1842 Lisp_Object list;
1843
1844 /* Delete from MAPS each element that is for the menu bar. */
1845 for (list = maps; !NILP (list); list = XCONS (list)->cdr)
1846 {
1847 Lisp_Object elt, prefix, tem;
1848
1849 elt = Fcar (list);
1850 prefix = Fcar (elt);
1851 if (XVECTOR (prefix)->size >= 1)
1852 {
1853 tem = Faref (prefix, make_number (0));
1854 if (EQ (tem, Qmenu_bar))
1855 maps = Fdelq (elt, maps);
1856 }
1857 }
1858 }
1859
53c8f9fa
RS
1860 if (!NILP (maps))
1861 {
1862 if (title)
07f15dfd
RS
1863 {
1864 insert_string (title);
1865 if (!NILP (prefix))
1866 {
1867 insert_string (" Starting With ");
1868 insert1 (Fkey_description (prefix));
1869 }
1870 insert_string (":\n");
1871 }
53c8f9fa 1872 insert_string (key_heading);
07f15dfd 1873 something = 1;
53c8f9fa
RS
1874 }
1875
265a9e55 1876 for (; !NILP (maps); maps = Fcdr (maps))
2c6f1a39 1877 {
53c8f9fa
RS
1878 register Lisp_Object elt, prefix, sub_shadows, tail;
1879
2c6f1a39 1880 elt = Fcar (maps);
53c8f9fa
RS
1881 prefix = Fcar (elt);
1882
1883 sub_shadows = Qnil;
1884
1885 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2c6f1a39 1886 {
53c8f9fa
RS
1887 Lisp_Object shmap;
1888
1889 shmap = XCONS (tail)->car;
1890
1891 /* If the sequence by which we reach this keymap is zero-length,
1892 then the shadow map for this keymap is just SHADOW. */
1893 if ((XTYPE (prefix) == Lisp_String
1894 && XSTRING (prefix)->size == 0)
1895 || (XTYPE (prefix) == Lisp_Vector
1896 && XVECTOR (prefix)->size == 0))
1897 ;
1898 /* If the sequence by which we reach this keymap actually has
1899 some elements, then the sequence's definition in SHADOW is
1900 what we should use. */
1901 else
1902 {
1903 shmap = Flookup_key (shadow, Fcar (elt), Qt);
1904 if (XTYPE (shmap) == Lisp_Int)
1905 shmap = Qnil;
1906 }
1907
1908 /* If shmap is not nil and not a keymap,
1909 it completely shadows this map, so don't
1910 describe this map at all. */
1911 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
1912 goto skip;
1913
1914 if (!NILP (shmap))
1915 sub_shadows = Fcons (shmap, sub_shadows);
2c6f1a39
JB
1916 }
1917
53c8f9fa
RS
1918 describe_map (Fcdr (elt), Fcar (elt), partial, sub_shadows);
1919
1920 skip: ;
2c6f1a39
JB
1921 }
1922
07f15dfd
RS
1923 if (something)
1924 insert_string ("\n");
1925
2c6f1a39
JB
1926 UNGCPRO;
1927}
1928
1929static void
1930describe_command (definition)
1931 Lisp_Object definition;
1932{
1933 register Lisp_Object tem1;
1934
1935 Findent_to (make_number (16), make_number (1));
1936
1937 if (XTYPE (definition) == Lisp_Symbol)
1938 {
1939 XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
1940 insert1 (tem1);
1941 insert_string ("\n");
1942 }
24065b9c
RS
1943 else if (STRINGP (definition))
1944 insert_string ("Keyboard Macro\n");
2c6f1a39
JB
1945 else
1946 {
1947 tem1 = Fkeymapp (definition);
265a9e55 1948 if (!NILP (tem1))
2c6f1a39
JB
1949 insert_string ("Prefix Command\n");
1950 else
1951 insert_string ("??\n");
1952 }
1953}
1954
1955/* Describe the contents of map MAP, assuming that this map itself is
1956 reached by the sequence of prefix keys KEYS (a string or vector).
1957 PARTIAL, SHADOW is as in `describe_map_tree' above. */
1958
1959static void
1960describe_map (map, keys, partial, shadow)
1961 Lisp_Object map, keys;
1962 int partial;
1963 Lisp_Object shadow;
1964{
1965 register Lisp_Object keysdesc;
1966
d09b2024 1967 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
5cba3869
RS
1968 {
1969 Lisp_Object tem;
1970 /* Call Fkey_description first, to avoid GC bug for the other string. */
1971 tem = Fkey_description (keys);
1972 keysdesc = concat2 (tem, build_string (" "));
1973 }
2c6f1a39
JB
1974 else
1975 keysdesc = Qnil;
1976
f5b79c1c 1977 describe_map_2 (map, keysdesc, describe_command, partial, shadow);
2c6f1a39
JB
1978}
1979
53c8f9fa
RS
1980/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
1981 Returns the first non-nil binding found in any of those maps. */
1982
1983static Lisp_Object
1984shadow_lookup (shadow, key, flag)
1985 Lisp_Object shadow, key, flag;
1986{
1987 Lisp_Object tail, value;
1988
1989 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
1990 {
1991 value = Flookup_key (XCONS (tail)->car, key, flag);
1992 if (!NILP (value))
1993 return value;
1994 }
1995 return Qnil;
1996}
1997
f5b79c1c 1998/* Insert a description of KEYMAP into the current buffer. */
2c6f1a39
JB
1999
2000static void
f5b79c1c
JB
2001describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow)
2002 register Lisp_Object keymap;
2c6f1a39
JB
2003 Lisp_Object elt_prefix;
2004 int (*elt_describer) ();
2005 int partial;
2006 Lisp_Object shadow;
2007{
53c8f9fa 2008 Lisp_Object tail, definition, event;
99a225a9 2009 Lisp_Object tem;
2c6f1a39
JB
2010 Lisp_Object suppress;
2011 Lisp_Object kludge;
2012 int first = 1;
2013 struct gcpro gcpro1, gcpro2, gcpro3;
2014
2015 if (partial)
2016 suppress = intern ("suppress-keymap");
2017
2018 /* This vector gets used to present single keys to Flookup_key. Since
f5b79c1c 2019 that is done once per keymap element, we don't want to cons up a
2c6f1a39
JB
2020 fresh vector every time. */
2021 kludge = Fmake_vector (make_number (1), Qnil);
99a225a9 2022 definition = Qnil;
2c6f1a39 2023
99a225a9 2024 GCPRO3 (elt_prefix, definition, kludge);
2c6f1a39 2025
53c8f9fa 2026 for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = Fcdr (tail))
2c6f1a39
JB
2027 {
2028 QUIT;
2c6f1a39 2029
53c8f9fa
RS
2030 if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
2031 describe_vector (XCONS (tail)->car,
f5b79c1c
JB
2032 elt_prefix, elt_describer, partial, shadow);
2033 else
2c6f1a39 2034 {
53c8f9fa
RS
2035 event = Fcar_safe (Fcar (tail));
2036 definition = get_keyelt (Fcdr_safe (Fcar (tail)));
2c6f1a39 2037
f5b79c1c 2038 /* Don't show undefined commands or suppressed commands. */
99a225a9
RS
2039 if (NILP (definition)) continue;
2040 if (XTYPE (definition) == Lisp_Symbol && partial)
f5b79c1c 2041 {
99a225a9
RS
2042 tem = Fget (definition, suppress);
2043 if (!NILP (tem))
f5b79c1c
JB
2044 continue;
2045 }
2c6f1a39 2046
f5b79c1c
JB
2047 /* Don't show a command that isn't really visible
2048 because a local definition of the same key shadows it. */
2c6f1a39 2049
99a225a9 2050 XVECTOR (kludge)->contents[0] = event;
f5b79c1c
JB
2051 if (!NILP (shadow))
2052 {
53c8f9fa 2053 tem = shadow_lookup (shadow, kludge, Qt);
f5b79c1c
JB
2054 if (!NILP (tem)) continue;
2055 }
2056
53c8f9fa 2057 tem = Flookup_key (keymap, kludge, Qt);
99a225a9
RS
2058 if (! EQ (tem, definition)) continue;
2059
f5b79c1c
JB
2060 if (first)
2061 {
2062 insert ("\n", 1);
2063 first = 0;
2064 }
2c6f1a39 2065
f5b79c1c
JB
2066 if (!NILP (elt_prefix))
2067 insert1 (elt_prefix);
2c6f1a39 2068
99a225a9
RS
2069 /* THIS gets the string to describe the character EVENT. */
2070 insert1 (Fsingle_key_description (event));
2c6f1a39 2071
f5b79c1c
JB
2072 /* Print a description of the definition of this character.
2073 elt_describer will take care of spacing out far enough
2074 for alignment purposes. */
99a225a9 2075 (*elt_describer) (definition);
f5b79c1c 2076 }
2c6f1a39
JB
2077 }
2078
2079 UNGCPRO;
2080}
2081
2082static int
2083describe_vector_princ (elt)
2084 Lisp_Object elt;
2085{
81fa9e2f 2086 Findent_to (make_number (16), make_number (1));
2c6f1a39 2087 Fprinc (elt, Qnil);
ad4ec84a 2088 Fterpri (Qnil);
2c6f1a39
JB
2089}
2090
2091DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
ad4ec84a 2092 "Insert a description of contents of VECTOR.\n\
2c6f1a39
JB
2093This is text showing the elements of vector matched against indices.")
2094 (vector)
2095 Lisp_Object vector;
2096{
ad4ec84a
RS
2097 int count = specpdl_ptr - specpdl;
2098
2099 specbind (Qstandard_output, Fcurrent_buffer ());
2c6f1a39 2100 CHECK_VECTOR (vector, 0);
92cc37e8 2101 describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil);
ad4ec84a
RS
2102
2103 return unbind_to (count, Qnil);
2c6f1a39
JB
2104}
2105
2106describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
2107 register Lisp_Object vector;
2108 Lisp_Object elt_prefix;
2109 int (*elt_describer) ();
2110 int partial;
2111 Lisp_Object shadow;
2112{
2113 Lisp_Object this;
2114 Lisp_Object dummy;
2115 Lisp_Object tem1, tem2;
2116 register int i;
2117 Lisp_Object suppress;
2118 Lisp_Object kludge;
2119 int first = 1;
2120 struct gcpro gcpro1, gcpro2, gcpro3;
2121
2122 tem1 = Qnil;
2123
2124 /* This vector gets used to present single keys to Flookup_key. Since
2125 that is done once per vector element, we don't want to cons up a
2126 fresh vector every time. */
2127 kludge = Fmake_vector (make_number (1), Qnil);
2128 GCPRO3 (elt_prefix, tem1, kludge);
2129
2130 if (partial)
2131 suppress = intern ("suppress-keymap");
2132
db6f9d95 2133 for (i = 0; i < XVECTOR (vector)->size; i++)
2c6f1a39
JB
2134 {
2135 QUIT;
2136 tem1 = get_keyelt (XVECTOR (vector)->contents[i]);
2137
265a9e55 2138 if (NILP (tem1)) continue;
2c6f1a39
JB
2139
2140 /* Don't mention suppressed commands. */
2141 if (XTYPE (tem1) == Lisp_Symbol && partial)
2142 {
2143 this = Fget (tem1, suppress);
265a9e55 2144 if (!NILP (this))
2c6f1a39
JB
2145 continue;
2146 }
2147
2148 /* If this command in this map is shadowed by some other map,
2149 ignore it. */
265a9e55 2150 if (!NILP (shadow))
2c6f1a39
JB
2151 {
2152 Lisp_Object tem;
2153
2154 XVECTOR (kludge)->contents[0] = make_number (i);
53c8f9fa 2155 tem = shadow_lookup (shadow, kludge, Qt);
2c6f1a39 2156
265a9e55 2157 if (!NILP (tem)) continue;
2c6f1a39
JB
2158 }
2159
2160 if (first)
2161 {
2162 insert ("\n", 1);
2163 first = 0;
2164 }
2165
2166 /* Output the prefix that applies to every entry in this map. */
265a9e55 2167 if (!NILP (elt_prefix))
2c6f1a39
JB
2168 insert1 (elt_prefix);
2169
2170 /* Get the string to describe the character I, and print it. */
2171 XFASTINT (dummy) = i;
2172
2173 /* THIS gets the string to describe the character DUMMY. */
2174 this = Fsingle_key_description (dummy);
2175 insert1 (this);
2176
2177 /* Find all consecutive characters that have the same definition. */
db6f9d95 2178 while (i + 1 < XVECTOR (vector)->size
2c6f1a39
JB
2179 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]),
2180 EQ (tem2, tem1)))
2181 i++;
2182
2183 /* If we have a range of more than one character,
2184 print where the range reaches to. */
2185
2186 if (i != XINT (dummy))
2187 {
2188 insert (" .. ", 4);
265a9e55 2189 if (!NILP (elt_prefix))
2c6f1a39
JB
2190 insert1 (elt_prefix);
2191
2192 XFASTINT (dummy) = i;
2193 insert1 (Fsingle_key_description (dummy));
2194 }
2195
2196 /* Print a description of the definition of this character.
2197 elt_describer will take care of spacing out far enough
2198 for alignment purposes. */
2199 (*elt_describer) (tem1);
2200 }
2201
2202 UNGCPRO;
2203}
2204\f
cc0a8174 2205/* Apropos - finding all symbols whose names match a regexp. */
2c6f1a39
JB
2206Lisp_Object apropos_predicate;
2207Lisp_Object apropos_accumulate;
2208
2209static void
2210apropos_accum (symbol, string)
2211 Lisp_Object symbol, string;
2212{
2213 register Lisp_Object tem;
2214
2215 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
265a9e55 2216 if (!NILP (tem) && !NILP (apropos_predicate))
2c6f1a39 2217 tem = call1 (apropos_predicate, symbol);
265a9e55 2218 if (!NILP (tem))
2c6f1a39
JB
2219 apropos_accumulate = Fcons (symbol, apropos_accumulate);
2220}
2221
2222DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
2223 "Show all symbols whose names contain match for REGEXP.\n\
2224If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\
2225for each symbol and a symbol is mentioned only if that returns non-nil.\n\
2226Return list of symbols found.")
2227 (string, pred)
2228 Lisp_Object string, pred;
2229{
2230 struct gcpro gcpro1, gcpro2;
2231 CHECK_STRING (string, 0);
2232 apropos_predicate = pred;
2233 GCPRO2 (apropos_predicate, apropos_accumulate);
2234 apropos_accumulate = Qnil;
2235 map_obarray (Vobarray, apropos_accum, string);
2236 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
2237 UNGCPRO;
2238 return apropos_accumulate;
2239}
2240\f
2241syms_of_keymap ()
2242{
2243 Lisp_Object tem;
2244
2245 Qkeymap = intern ("keymap");
2246 staticpro (&Qkeymap);
2247
2248/* Initialize the keymaps standardly used.
2249 Each one is the value of a Lisp variable, and is also
2250 pointed to by a C variable */
2251
19eaeb86 2252 global_map = Fcons (Qkeymap,
1447c534 2253 Fcons (Fmake_vector (make_number (0400), Qnil), Qnil));
2c6f1a39
JB
2254 Fset (intern ("global-map"), global_map);
2255
ce6e5d0b 2256 meta_map = Fmake_keymap (Qnil);
2c6f1a39
JB
2257 Fset (intern ("esc-map"), meta_map);
2258 Ffset (intern ("ESC-prefix"), meta_map);
2259
ce6e5d0b 2260 control_x_map = Fmake_keymap (Qnil);
2c6f1a39
JB
2261 Fset (intern ("ctl-x-map"), control_x_map);
2262 Ffset (intern ("Control-X-prefix"), control_x_map);
2263
2264 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
2265 "Default keymap to use when reading from the minibuffer.");
ce6e5d0b 2266 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2267
2268 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
2269 "Local keymap for the minibuffer when spaces are not allowed.");
ce6e5d0b 2270 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2271
2272 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
2273 "Local keymap for minibuffer input with completion.");
ce6e5d0b 2274 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2275
2276 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
2277 "Local keymap for minibuffer input with completion, for exact match.");
ce6e5d0b 2278 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2279
2280 current_global_map = global_map;
2281
cc0a8174
JB
2282 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
2283 "Alist of keymaps to use for minor modes.\n\
2284Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
2285key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
2286If two active keymaps bind the same key, the keymap appearing earlier\n\
2287in the list takes precedence.");
2288 Vminor_mode_map_alist = Qnil;
2289
6bbbd9b0
JB
2290 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
2291 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
2292This allows Emacs to recognize function keys sent from ASCII\n\
2293terminals at any point in a key sequence.\n\
2294\n\
2295The read-key-sequence function replaces subsequences bound by\n\
2296function-key-map with their bindings. When the current local and global\n\
2297keymaps have no binding for the current key sequence but\n\
718ca51e 2298function-key-map binds a suffix of the sequence to a vector or string,\n\
6bbbd9b0
JB
2299read-key-sequence replaces the matching suffix with its binding, and\n\
2300continues with the new sequence.\n\
2301\n\
718ca51e
JB
2302For example, suppose function-key-map binds `ESC O P' to [f1].\n\
2303Typing `ESC O P' to read-key-sequence would return [f1]. Typing\n\
2304`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
2305key, typing `ESC O P x' would return [f1 x].");
ce6e5d0b 2306 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
6bbbd9b0 2307
2c6f1a39
JB
2308 Qsingle_key_description = intern ("single-key-description");
2309 staticpro (&Qsingle_key_description);
2310
2311 Qkey_description = intern ("key-description");
2312 staticpro (&Qkey_description);
2313
2314 Qkeymapp = intern ("keymapp");
2315 staticpro (&Qkeymapp);
2316
2fc66973
JB
2317 Qnon_ascii = intern ("non-ascii");
2318 staticpro (&Qnon_ascii);
2319
2c6f1a39
JB
2320 defsubr (&Skeymapp);
2321 defsubr (&Smake_keymap);
2322 defsubr (&Smake_sparse_keymap);
2323 defsubr (&Scopy_keymap);
2324 defsubr (&Skey_binding);
2325 defsubr (&Slocal_key_binding);
2326 defsubr (&Sglobal_key_binding);
cc0a8174 2327 defsubr (&Sminor_mode_key_binding);
2c6f1a39
JB
2328 defsubr (&Sglobal_set_key);
2329 defsubr (&Slocal_set_key);
2330 defsubr (&Sdefine_key);
2331 defsubr (&Slookup_key);
2332 defsubr (&Sglobal_unset_key);
2333 defsubr (&Slocal_unset_key);
2334 defsubr (&Sdefine_prefix_command);
2335 defsubr (&Suse_global_map);
2336 defsubr (&Suse_local_map);
2337 defsubr (&Scurrent_local_map);
2338 defsubr (&Scurrent_global_map);
cc0a8174 2339 defsubr (&Scurrent_minor_mode_maps);
2c6f1a39
JB
2340 defsubr (&Saccessible_keymaps);
2341 defsubr (&Skey_description);
2342 defsubr (&Sdescribe_vector);
2343 defsubr (&Ssingle_key_description);
2344 defsubr (&Stext_char_description);
2345 defsubr (&Swhere_is_internal);
2346 defsubr (&Swhere_is);
2347 defsubr (&Sdescribe_bindings);
2348 defsubr (&Sapropos_internal);
2349}
2350
2351keys_of_keymap ()
2352{
2353 Lisp_Object tem;
2354
2355 initial_define_key (global_map, 033, "ESC-prefix");
2356 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
2357}