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