Whitespace change.
[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
KH
778 cmm_size *= 2;
779 newmodes = (Lisp_Object *)
780 realloc (cmm_modes, cmm_size * sizeof (Lisp_Object));
781 newmaps = (Lisp_Object *)
782 realloc (cmm_maps, cmm_size * sizeof (Lisp_Object));
9ac0d9e0 783 UNBLOCK_INPUT;
cc0a8174
JB
784 }
785 else
786 {
9ac0d9e0 787 BLOCK_INPUT;
e58077c8
KH
788 cmm_size = 30;
789 newmodes = (Lisp_Object *)
790 malloc (cmm_size * sizeof (Lisp_Object));
791 newmaps = (Lisp_Object *)
792 malloc (cmm_size * sizeof (Lisp_Object));
9ac0d9e0 793 UNBLOCK_INPUT;
cc0a8174
JB
794 }
795
796 if (newmaps && newmodes)
797 {
265a9e55
JB
798 cmm_modes = newmodes;
799 cmm_maps = newmaps;
cc0a8174
JB
800 }
801 else
802 break;
803 }
265a9e55 804 cmm_modes[i] = var;
992984b2 805 cmm_maps [i] = Findirect_function (XCONS (assoc)->cdr);
cc0a8174
JB
806 i++;
807 }
808
265a9e55
JB
809 if (modeptr) *modeptr = cmm_modes;
810 if (mapptr) *mapptr = cmm_maps;
cc0a8174
JB
811 return i;
812}
813
7c140252 814DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 2, 0,
2c6f1a39 815 "Return the binding for command KEY in current keymaps.\n\
7c140252
JB
816KEY is a string or vector, a sequence of keystrokes.\n\
817The binding is probably a symbol with a function definition.\n\
818\n\
819Normally, `key-binding' ignores bindings for t, which act as default\n\
820bindings, used when nothing else in the keymap applies; this makes it\n\
d831234b
RS
821usable as a general function for probing keymaps. However, if the\n\
822optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does\n\
7c140252
JB
823recognize the default bindings, just as `read-key-sequence' does.")
824 (key, accept_default)
2c6f1a39
JB
825 Lisp_Object key;
826{
cc0a8174
JB
827 Lisp_Object *maps, value;
828 int nmaps, i;
829
7d92e329 830 if (!NILP (Voverriding_local_map))
2c6f1a39 831 {
7d92e329 832 value = Flookup_key (Voverriding_local_map, key, accept_default);
265a9e55 833 if (! NILP (value) && XTYPE (value) != Lisp_Int)
2c6f1a39
JB
834 return value;
835 }
7d92e329
RS
836 else
837 {
838 nmaps = current_minor_maps (0, &maps);
839 for (i = 0; i < nmaps; i++)
840 if (! NILP (maps[i]))
841 {
842 value = Flookup_key (maps[i], key, accept_default);
843 if (! NILP (value) && XTYPE (value) != Lisp_Int)
844 return value;
845 }
846
847 if (! NILP (current_buffer->keymap))
848 {
849 value = Flookup_key (current_buffer->keymap, key, accept_default);
850 if (! NILP (value) && XTYPE (value) != Lisp_Int)
851 return value;
852 }
853 }
cc0a8174 854
7c140252 855 value = Flookup_key (current_global_map, key, accept_default);
265a9e55 856 if (! NILP (value) && XTYPE (value) != Lisp_Int)
cc0a8174
JB
857 return value;
858
859 return Qnil;
2c6f1a39
JB
860}
861
7c140252 862DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
2c6f1a39
JB
863 "Return the binding for command KEYS in current local keymap only.\n\
864KEYS is a string, a sequence of keystrokes.\n\
7c140252
JB
865The binding is probably a symbol with a function definition.\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
JB
871{
872 register Lisp_Object map;
873 map = current_buffer->keymap;
265a9e55 874 if (NILP (map))
2c6f1a39 875 return Qnil;
7c140252 876 return Flookup_key (map, keys, accept_default);
2c6f1a39
JB
877}
878
7c140252 879DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
2c6f1a39
JB
880 "Return the binding for command KEYS in current global keymap only.\n\
881KEYS is a string, a sequence of keystrokes.\n\
6bbbd9b0
JB
882The binding is probably a symbol with a function definition.\n\
883This function's return values are the same as those of lookup-key\n\
7c140252
JB
884(which see).\n\
885\n\
886If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
887bindings; see the description of `lookup-key' for more details about this.")
888 (keys, accept_default)
889 Lisp_Object keys, accept_default;
2c6f1a39 890{
7c140252 891 return Flookup_key (current_global_map, keys, accept_default);
2c6f1a39
JB
892}
893
7c140252 894DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
cc0a8174
JB
895 "Find the visible minor mode bindings of KEY.\n\
896Return an alist of pairs (MODENAME . BINDING), where MODENAME is the\n\
897the symbol which names the minor mode binding KEY, and BINDING is\n\
898KEY's definition in that mode. In particular, if KEY has no\n\
899minor-mode bindings, return nil. If the first binding is a\n\
900non-prefix, all subsequent bindings will be omitted, since they would\n\
901be ignored. Similarly, the list doesn't include non-prefix bindings\n\
7c140252
JB
902that come after prefix bindings.\n\
903\n\
904If optional argument ACCEPT-DEFAULT is non-nil, recognize default\n\
905bindings; see the description of `lookup-key' for more details about this.")
906 (key, accept_default)
907 Lisp_Object key, accept_default;
cc0a8174
JB
908{
909 Lisp_Object *modes, *maps;
910 int nmaps;
911 Lisp_Object binding;
912 int i, j;
913
914 nmaps = current_minor_maps (&modes, &maps);
915
916 for (i = j = 0; i < nmaps; i++)
265a9e55 917 if (! NILP (maps[i])
7c140252 918 && ! NILP (binding = Flookup_key (maps[i], key, accept_default))
cc0a8174
JB
919 && XTYPE (binding) != Lisp_Int)
920 {
d09b2024 921 if (! NILP (get_keymap (binding)))
cc0a8174
JB
922 maps[j++] = Fcons (modes[i], binding);
923 else if (j == 0)
924 return Fcons (Fcons (modes[i], binding), Qnil);
925 }
926
927 return Flist (j, maps);
928}
929
2c6f1a39
JB
930DEFUN ("global-set-key", Fglobal_set_key, Sglobal_set_key, 2, 2,
931 "kSet key globally: \nCSet key %s to command: ",
932 "Give KEY a global binding as COMMAND.\n\
933COMMAND is a symbol naming an interactively-callable function.\n\
2fa8c0b5 934KEY is a key sequence (a string or vector of characters or event types).\n\
c818754b
RS
935Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
936can be included if you use a vector.\n\
2c6f1a39
JB
937Note that if KEY has a local binding in the current buffer\n\
938that local binding will continue to shadow any global binding.")
939 (keys, function)
940 Lisp_Object keys, function;
941{
942 if (XTYPE (keys) != Lisp_Vector
943 && XTYPE (keys) != Lisp_String)
944 keys = wrong_type_argument (Qarrayp, keys);
945
946 Fdefine_key (current_global_map, keys, function);
947 return Qnil;
948}
949
950DEFUN ("local-set-key", Flocal_set_key, Slocal_set_key, 2, 2,
951 "kSet key locally: \nCSet key %s locally to command: ",
952 "Give KEY a local binding as COMMAND.\n\
953COMMAND is a symbol naming an interactively-callable function.\n\
2fa8c0b5 954KEY is a key sequence (a string or vector of characters or event types).\n\
c818754b
RS
955Non-ASCII characters with codes above 127 (such as ISO Latin-1)\n\
956can be included if you use a vector.\n\
2c6f1a39 957The binding goes in the current buffer's local map,\n\
af1d6f09 958which in most cases is shared with all other buffers in the same major mode.")
2c6f1a39
JB
959 (keys, function)
960 Lisp_Object keys, function;
961{
962 register Lisp_Object map;
963 map = current_buffer->keymap;
265a9e55 964 if (NILP (map))
2c6f1a39 965 {
ce6e5d0b 966 map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
967 current_buffer->keymap = map;
968 }
969
970 if (XTYPE (keys) != Lisp_Vector
971 && XTYPE (keys) != Lisp_String)
972 keys = wrong_type_argument (Qarrayp, keys);
973
974 Fdefine_key (map, keys, function);
975 return Qnil;
976}
977
978DEFUN ("global-unset-key", Fglobal_unset_key, Sglobal_unset_key,
979 1, 1, "kUnset key globally: ",
980 "Remove global binding of KEY.\n\
981KEY is a string representing a sequence of keystrokes.")
982 (keys)
983 Lisp_Object keys;
984{
985 return Fglobal_set_key (keys, Qnil);
986}
987
988DEFUN ("local-unset-key", Flocal_unset_key, Slocal_unset_key, 1, 1,
989 "kUnset key locally: ",
990 "Remove local binding of KEY.\n\
991KEY is a string representing a sequence of keystrokes.")
992 (keys)
993 Lisp_Object keys;
994{
265a9e55 995 if (!NILP (current_buffer->keymap))
2c6f1a39
JB
996 Flocal_set_key (keys, Qnil);
997 return Qnil;
998}
999
1000DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 2, 0,
cd8520b9 1001 "Define COMMAND as a prefix command. COMMAND should be a symbol.\n\
2c6f1a39 1002A new sparse keymap is stored as COMMAND's function definition and its value.\n\
1d8d96fa
JB
1003If a second optional argument MAPVAR is given, the map is stored as\n\
1004its value instead of as COMMAND's value; but COMMAND is still defined\n\
1005as a function.")
2c6f1a39
JB
1006 (name, mapvar)
1007 Lisp_Object name, mapvar;
1008{
1009 Lisp_Object map;
ce6e5d0b 1010 map = Fmake_sparse_keymap (Qnil);
2c6f1a39 1011 Ffset (name, map);
265a9e55 1012 if (!NILP (mapvar))
2c6f1a39
JB
1013 Fset (mapvar, map);
1014 else
1015 Fset (name, map);
1016 return name;
1017}
1018
1019DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1020 "Select KEYMAP as the global keymap.")
1021 (keymap)
1022 Lisp_Object keymap;
1023{
1024 keymap = get_keymap (keymap);
1025 current_global_map = keymap;
1026 return Qnil;
1027}
1028
1029DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1030 "Select KEYMAP as the local keymap.\n\
1031If KEYMAP is nil, that means no local keymap.")
1032 (keymap)
1033 Lisp_Object keymap;
1034{
265a9e55 1035 if (!NILP (keymap))
2c6f1a39
JB
1036 keymap = get_keymap (keymap);
1037
1038 current_buffer->keymap = keymap;
1039
1040 return Qnil;
1041}
1042
1043DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1044 "Return current buffer's local keymap, or nil if it has none.")
1045 ()
1046{
1047 return current_buffer->keymap;
1048}
1049
1050DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1051 "Return the current global keymap.")
1052 ()
1053{
1054 return current_global_map;
1055}
cc0a8174
JB
1056
1057DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1058 "Return a list of keymaps for the minor modes of the current buffer.")
1059 ()
1060{
1061 Lisp_Object *maps;
1062 int nmaps = current_minor_maps (0, &maps);
1063
1064 return Flist (nmaps, maps);
1065}
2c6f1a39 1066\f
cc0a8174
JB
1067/* Help functions for describing and documenting keymaps. */
1068
2c6f1a39 1069DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
53c8f9fa 1070 1, 2, 0,
2c6f1a39
JB
1071 "Find all keymaps accessible via prefix characters from KEYMAP.\n\
1072Returns a list of elements of the form (KEYS . MAP), where the sequence\n\
1073KEYS starting from KEYMAP gets you to MAP. These elements are ordered\n\
f66ef185
RS
1074so that the KEYS increase in length. The first element is (\"\" . KEYMAP).\n\
1075An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1076then the value includes only maps for prefixes that start with PREFIX.")
53c8f9fa
RS
1077 (startmap, prefix)
1078 Lisp_Object startmap, prefix;
2c6f1a39 1079{
53c8f9fa
RS
1080 Lisp_Object maps, good_maps, tail;
1081 int prefixlen = 0;
1082
1083 if (!NILP (prefix))
1084 prefixlen = XINT (Flength (prefix));
2c6f1a39 1085
0b8fc2d4
RS
1086 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
1087 get_keymap (startmap)),
1088 Qnil);
2c6f1a39
JB
1089
1090 /* For each map in the list maps,
1091 look at any other maps it points to,
1092 and stick them at the end if they are not already in the list.
1093
1094 This is a breadth-first traversal, where tail is the queue of
1095 nodes, and maps accumulates a list of all nodes visited. */
1096
f5b79c1c 1097 for (tail = maps; CONSP (tail); tail = XCONS (tail)->cdr)
2c6f1a39
JB
1098 {
1099 register Lisp_Object thisseq = Fcar (Fcar (tail));
1100 register Lisp_Object thismap = Fcdr (Fcar (tail));
1101 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
1102
1103 /* Does the current sequence end in the meta-prefix-char? */
1104 int is_metized = (XINT (last) >= 0
1105 && EQ (Faref (thisseq, last), meta_prefix_char));
1106
f5b79c1c 1107 for (; CONSP (thismap); thismap = XCONS (thismap)->cdr)
2c6f1a39 1108 {
f5b79c1c 1109 Lisp_Object elt = XCONS (thismap)->car;
2c6f1a39 1110
f5b79c1c
JB
1111 QUIT;
1112
1113 if (XTYPE (elt) == Lisp_Vector)
2c6f1a39
JB
1114 {
1115 register int i;
1116
1117 /* Vector keymap. Scan all the elements. */
db6f9d95 1118 for (i = 0; i < XVECTOR (elt)->size; i++)
2c6f1a39
JB
1119 {
1120 register Lisp_Object tem;
1121 register Lisp_Object cmd;
1122
f5b79c1c 1123 cmd = get_keyelt (XVECTOR (elt)->contents[i]);
265a9e55 1124 if (NILP (cmd)) continue;
2c6f1a39 1125 tem = Fkeymapp (cmd);
265a9e55 1126 if (!NILP (tem))
2c6f1a39
JB
1127 {
1128 cmd = get_keymap (cmd);
1129 /* Ignore keymaps that are already added to maps. */
1130 tem = Frassq (cmd, maps);
265a9e55 1131 if (NILP (tem))
2c6f1a39
JB
1132 {
1133 /* If the last key in thisseq is meta-prefix-char,
1134 turn it into a meta-ized keystroke. We know
1135 that the event we're about to append is an
f5b79c1c
JB
1136 ascii keystroke since we're processing a
1137 keymap table. */
2c6f1a39
JB
1138 if (is_metized)
1139 {
0b8fc2d4 1140 int meta_bit = meta_modifier;
2c6f1a39 1141 tem = Fcopy_sequence (thisseq);
0b8fc2d4
RS
1142
1143 Faset (tem, last, make_number (i | meta_bit));
2c6f1a39
JB
1144
1145 /* This new sequence is the same length as
1146 thisseq, so stick it in the list right
1147 after this one. */
0b8fc2d4
RS
1148 XCONS (tail)->cdr
1149 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
2c6f1a39
JB
1150 }
1151 else
1152 {
1153 tem = append_key (thisseq, make_number (i));
1154 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1155 }
1156 }
1157 }
1158 }
f5b79c1c
JB
1159 }
1160 else if (CONSP (elt))
2c6f1a39
JB
1161 {
1162 register Lisp_Object cmd = get_keyelt (XCONS (elt)->cdr);
53c8f9fa 1163 register Lisp_Object tem, filter;
2c6f1a39
JB
1164
1165 /* Ignore definitions that aren't keymaps themselves. */
1166 tem = Fkeymapp (cmd);
265a9e55 1167 if (!NILP (tem))
2c6f1a39
JB
1168 {
1169 /* Ignore keymaps that have been seen already. */
1170 cmd = get_keymap (cmd);
1171 tem = Frassq (cmd, maps);
265a9e55 1172 if (NILP (tem))
2c6f1a39 1173 {
53c8f9fa 1174 /* Let elt be the event defined by this map entry. */
2c6f1a39
JB
1175 elt = XCONS (elt)->car;
1176
1177 /* If the last key in thisseq is meta-prefix-char, and
1178 this entry is a binding for an ascii keystroke,
1179 turn it into a meta-ized keystroke. */
1180 if (is_metized && XTYPE (elt) == Lisp_Int)
1181 {
1182 tem = Fcopy_sequence (thisseq);
0b8fc2d4
RS
1183 Faset (tem, last,
1184 make_number (XINT (elt) | meta_modifier));
2c6f1a39
JB
1185
1186 /* This new sequence is the same length as
1187 thisseq, so stick it in the list right
1188 after this one. */
53c8f9fa
RS
1189 XCONS (tail)->cdr
1190 = Fcons (Fcons (tem, cmd), XCONS (tail)->cdr);
2c6f1a39
JB
1191 }
1192 else
1193 nconc2 (tail,
1194 Fcons (Fcons (append_key (thisseq, elt), cmd),
1195 Qnil));
1196 }
1197 }
1198 }
2c6f1a39 1199 }
2c6f1a39
JB
1200 }
1201
53c8f9fa
RS
1202 if (NILP (prefix))
1203 return maps;
1204
1205 /* Now find just the maps whose access prefixes start with PREFIX. */
1206
1207 good_maps = Qnil;
1208 for (; CONSP (maps); maps = XCONS (maps)->cdr)
1209 {
1210 Lisp_Object elt, thisseq;
1211 elt = XCONS (maps)->car;
1212 thisseq = XCONS (elt)->car;
1213 /* The access prefix must be at least as long as PREFIX,
1214 and the first elements must match those of PREFIX. */
1215 if (XINT (Flength (thisseq)) >= prefixlen)
1216 {
1217 int i;
1218 for (i = 0; i < prefixlen; i++)
1219 {
1220 Lisp_Object i1;
1221 XFASTINT (i1) = i;
1222 if (!EQ (Faref (thisseq, i1), Faref (prefix, i1)))
1223 break;
1224 }
1225 if (i == prefixlen)
1226 good_maps = Fcons (elt, good_maps);
1227 }
1228 }
1229
1230 return Fnreverse (good_maps);
2c6f1a39
JB
1231}
1232
1233Lisp_Object Qsingle_key_description, Qkey_description;
1234
1235DEFUN ("key-description", Fkey_description, Skey_description, 1, 1, 0,
1236 "Return a pretty description of key-sequence KEYS.\n\
1237Control characters turn into \"C-foo\" sequences, meta into \"M-foo\"\n\
1238spaces are put between sequence elements, etc.")
1239 (keys)
1240 Lisp_Object keys;
1241{
6ba6e250
RS
1242 if (XTYPE (keys) == Lisp_String)
1243 {
1244 Lisp_Object vector;
1245 int i;
1246 vector = Fmake_vector (Flength (keys), Qnil);
1247 for (i = 0; i < XSTRING (keys)->size; i++)
1248 {
1249 if (XSTRING (keys)->data[i] & 0x80)
1250 XFASTINT (XVECTOR (vector)->contents[i])
1251 = meta_modifier | (XSTRING (keys)->data[i] & ~0x80);
1252 else
1253 XFASTINT (XVECTOR (vector)->contents[i])
1254 = XSTRING (keys)->data[i];
1255 }
1256 keys = vector;
1257 }
2c6f1a39
JB
1258 return Fmapconcat (Qsingle_key_description, keys, build_string (" "));
1259}
1260
1261char *
1262push_key_description (c, p)
1263 register unsigned int c;
1264 register char *p;
1265{
71ac885b
RS
1266 /* Clear all the meaningless bits above the meta bit. */
1267 c &= meta_modifier | ~ - meta_modifier;
1268
6ba6e250
RS
1269 if (c & alt_modifier)
1270 {
1271 *p++ = 'A';
1272 *p++ = '-';
1273 c -= alt_modifier;
1274 }
1275 if (c & ctrl_modifier)
1276 {
1277 *p++ = 'C';
1278 *p++ = '-';
1279 c -= ctrl_modifier;
1280 }
1281 if (c & hyper_modifier)
1282 {
1283 *p++ = 'H';
1284 *p++ = '-';
1285 c -= hyper_modifier;
1286 }
1287 if (c & meta_modifier)
2c6f1a39
JB
1288 {
1289 *p++ = 'M';
1290 *p++ = '-';
6ba6e250
RS
1291 c -= meta_modifier;
1292 }
1293 if (c & shift_modifier)
1294 {
1295 *p++ = 'S';
1296 *p++ = '-';
1297 c -= shift_modifier;
1298 }
1299 if (c & super_modifier)
1300 {
1301 *p++ = 's';
1302 *p++ = '-';
1303 c -= super_modifier;
2c6f1a39
JB
1304 }
1305 if (c < 040)
1306 {
1307 if (c == 033)
1308 {
1309 *p++ = 'E';
1310 *p++ = 'S';
1311 *p++ = 'C';
1312 }
6ba6e250 1313 else if (c == '\t')
2c6f1a39
JB
1314 {
1315 *p++ = 'T';
1316 *p++ = 'A';
1317 *p++ = 'B';
1318 }
1319 else if (c == Ctl('J'))
1320 {
1321 *p++ = 'L';
1322 *p++ = 'F';
1323 *p++ = 'D';
1324 }
1325 else if (c == Ctl('M'))
1326 {
1327 *p++ = 'R';
1328 *p++ = 'E';
1329 *p++ = 'T';
1330 }
1331 else
1332 {
1333 *p++ = 'C';
1334 *p++ = '-';
1335 if (c > 0 && c <= Ctl ('Z'))
1336 *p++ = c + 0140;
1337 else
1338 *p++ = c + 0100;
1339 }
1340 }
1341 else if (c == 0177)
1342 {
1343 *p++ = 'D';
1344 *p++ = 'E';
1345 *p++ = 'L';
1346 }
1347 else if (c == ' ')
1348 {
1349 *p++ = 'S';
1350 *p++ = 'P';
1351 *p++ = 'C';
1352 }
6ba6e250 1353 else if (c < 256)
2c6f1a39 1354 *p++ = c;
6ba6e250
RS
1355 else
1356 {
1357 *p++ = '\\';
1358 *p++ = (7 & (c >> 15)) + '0';
1359 *p++ = (7 & (c >> 12)) + '0';
1360 *p++ = (7 & (c >> 9)) + '0';
1361 *p++ = (7 & (c >> 6)) + '0';
1362 *p++ = (7 & (c >> 3)) + '0';
1363 *p++ = (7 & (c >> 0)) + '0';
1364 }
2c6f1a39
JB
1365
1366 return p;
1367}
1368
1369DEFUN ("single-key-description", Fsingle_key_description, Ssingle_key_description, 1, 1, 0,
1370 "Return a pretty description of command character KEY.\n\
1371Control characters turn into C-whatever, etc.")
1372 (key)
1373 Lisp_Object key;
1374{
6ba6e250 1375 char tem[20];
2c6f1a39 1376
cebd887d 1377 key = EVENT_HEAD (key);
6bbbd9b0 1378
2c6f1a39
JB
1379 switch (XTYPE (key))
1380 {
1381 case Lisp_Int: /* Normal character */
6ba6e250 1382 *push_key_description (XUINT (key), tem) = 0;
2c6f1a39
JB
1383 return build_string (tem);
1384
1385 case Lisp_Symbol: /* Function key or event-symbol */
1386 return Fsymbol_name (key);
1387
2c6f1a39
JB
1388 default:
1389 error ("KEY must be an integer, cons, or symbol.");
1390 }
1391}
1392
1393char *
1394push_text_char_description (c, p)
1395 register unsigned int c;
1396 register char *p;
1397{
1398 if (c >= 0200)
1399 {
1400 *p++ = 'M';
1401 *p++ = '-';
1402 c -= 0200;
1403 }
1404 if (c < 040)
1405 {
1406 *p++ = '^';
1407 *p++ = c + 64; /* 'A' - 1 */
1408 }
1409 else if (c == 0177)
1410 {
1411 *p++ = '^';
1412 *p++ = '?';
1413 }
1414 else
1415 *p++ = c;
1416 return p;
1417}
1418
1419DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
1420 "Return a pretty description of file-character CHAR.\n\
1421Control characters turn into \"^char\", etc.")
1422 (chr)
1423 Lisp_Object chr;
1424{
1425 char tem[6];
1426
1427 CHECK_NUMBER (chr, 0);
1428
1429 *push_text_char_description (XINT (chr) & 0377, tem) = 0;
1430
1431 return build_string (tem);
1432}
2fc66973
JB
1433
1434/* Return non-zero if SEQ contains only ASCII characters, perhaps with
1435 a meta bit. */
1436static int
1437ascii_sequence_p (seq)
1438 Lisp_Object seq;
1439{
1440 Lisp_Object i;
1441 int len = XINT (Flength (seq));
1442
1443 for (XFASTINT (i) = 0; XFASTINT (i) < len; XFASTINT (i)++)
1444 {
1445 Lisp_Object elt = Faref (seq, i);
1446
1447 if (XTYPE (elt) != Lisp_Int
1448 || (XUINT (elt) & ~CHAR_META) >= 0x80)
1449 return 0;
1450 }
1451
1452 return 1;
1453}
1454
2c6f1a39 1455\f
cc0a8174
JB
1456/* where-is - finding a command in a set of keymaps. */
1457
2c6f1a39
JB
1458DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
1459 "Return list of keys that invoke DEFINITION in KEYMAP or KEYMAP1.\n\
1460If KEYMAP is nil, search only KEYMAP1.\n\
1461If KEYMAP1 is nil, use the current global map.\n\
1462\n\
b8d584f6
RS
1463If optional 4th arg FIRSTONLY is non-nil, return the first key sequence found,\n\
1464rather than a list of all possible key sequences.\n\
1465If FIRSTONLY is t, avoid key sequences which use non-ASCII\n\
2fc66973
JB
1466keys and therefore may not be usable on ASCII terminals. If FIRSTONLY\n\
1467is the symbol `non-ascii', return the first binding found, no matter\n\
1468what its components.\n\
2c6f1a39
JB
1469\n\
1470If optional 5th arg NOINDIRECT is non-nil, don't follow indirections\n\
1471to other keymaps or slots. This makes it possible to search for an\n\
1472indirect definition itself.")
1473 (definition, local_keymap, global_keymap, firstonly, noindirect)
1474 Lisp_Object definition, local_keymap, global_keymap;
1475 Lisp_Object firstonly, noindirect;
1476{
1477 register Lisp_Object maps;
1478 Lisp_Object found;
1479
265a9e55 1480 if (NILP (global_keymap))
2c6f1a39
JB
1481 global_keymap = current_global_map;
1482
265a9e55 1483 if (!NILP (local_keymap))
53c8f9fa
RS
1484 maps = nconc2 (Faccessible_keymaps (get_keymap (local_keymap), Qnil),
1485 Faccessible_keymaps (get_keymap (global_keymap), Qnil));
2c6f1a39 1486 else
53c8f9fa 1487 maps = Faccessible_keymaps (get_keymap (global_keymap), Qnil);
2c6f1a39
JB
1488
1489 found = Qnil;
1490
265a9e55 1491 for (; !NILP (maps); maps = Fcdr (maps))
2c6f1a39 1492 {
f5b79c1c
JB
1493 /* Key sequence to reach map */
1494 register Lisp_Object this = Fcar (Fcar (maps));
1495
1496 /* The map that it reaches */
1497 register Lisp_Object map = Fcdr (Fcar (maps));
1498
1499 /* If Fcar (map) is a VECTOR, the current element within that vector. */
1500 int i = 0;
2c6f1a39
JB
1501
1502 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
1503 [M-CHAR] sequences, check if last character of the sequence
1504 is the meta-prefix char. */
1505 Lisp_Object last = make_number (XINT (Flength (this)) - 1);
1506 int last_is_meta = (XINT (last) >= 0
1507 && EQ (Faref (this, last), meta_prefix_char));
2c6f1a39 1508
fde3a52f
JB
1509 QUIT;
1510
f5b79c1c 1511 while (CONSP (map))
2c6f1a39 1512 {
f5b79c1c
JB
1513 /* Because the code we want to run on each binding is rather
1514 large, we don't want to have two separate loop bodies for
1515 sparse keymap bindings and tables; we want to iterate one
1516 loop body over both keymap and vector bindings.
1517
1518 For this reason, if Fcar (map) is a vector, we don't
1519 advance map to the next element until i indicates that we
1520 have finished off the vector. */
2c6f1a39 1521
f5b79c1c
JB
1522 Lisp_Object elt = XCONS (map)->car;
1523 Lisp_Object key, binding, sequence;
1524
fde3a52f
JB
1525 QUIT;
1526
f5b79c1c
JB
1527 /* Set key and binding to the current key and binding, and
1528 advance map and i to the next binding. */
1529 if (XTYPE (elt) == Lisp_Vector)
2c6f1a39
JB
1530 {
1531 /* In a vector, look at each element. */
f5b79c1c 1532 binding = XVECTOR (elt)->contents[i];
2c6f1a39
JB
1533 XFASTINT (key) = i;
1534 i++;
1535
f5b79c1c
JB
1536 /* If we've just finished scanning a vector, advance map
1537 to the next element, and reset i in anticipation of the
1538 next vector we may find. */
db6f9d95 1539 if (i >= XVECTOR (elt)->size)
2c6f1a39 1540 {
f5b79c1c
JB
1541 map = XCONS (map)->cdr;
1542 i = 0;
2c6f1a39 1543 }
f5b79c1c
JB
1544 }
1545 else if (CONSP (elt))
1546 {
2c6f1a39 1547 key = Fcar (Fcar (map));
f5b79c1c
JB
1548 binding = Fcdr (Fcar (map));
1549
1550 map = XCONS (map)->cdr;
2c6f1a39
JB
1551 }
1552 else
f5b79c1c
JB
1553 /* We want to ignore keymap elements that are neither
1554 vectors nor conses. */
fde3a52f
JB
1555 {
1556 map = XCONS (map)->cdr;
1557 continue;
1558 }
2c6f1a39
JB
1559
1560 /* Search through indirections unless that's not wanted. */
265a9e55 1561 if (NILP (noindirect))
2c6f1a39
JB
1562 binding = get_keyelt (binding);
1563
1564 /* End this iteration if this element does not match
1565 the target. */
1566
1567 if (XTYPE (definition) == Lisp_Cons)
1568 {
1569 Lisp_Object tem;
1570 tem = Fequal (binding, definition);
265a9e55 1571 if (NILP (tem))
2c6f1a39
JB
1572 continue;
1573 }
1574 else
1575 if (!EQ (binding, definition))
1576 continue;
1577
1578 /* We have found a match.
1579 Construct the key sequence where we found it. */
1580 if (XTYPE (key) == Lisp_Int && last_is_meta)
1581 {
1582 sequence = Fcopy_sequence (this);
0b8fc2d4 1583 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2c6f1a39
JB
1584 }
1585 else
1586 sequence = append_key (this, key);
1587
1588 /* Verify that this key binding is not shadowed by another
1589 binding for the same key, before we say it exists.
1590
1591 Mechanism: look for local definition of this key and if
1592 it is defined and does not match what we found then
1593 ignore this key.
1594
1595 Either nil or number as value from Flookup_key
1596 means undefined. */
265a9e55 1597 if (!NILP (local_keymap))
2c6f1a39 1598 {
7c140252 1599 binding = Flookup_key (local_keymap, sequence, Qnil);
265a9e55 1600 if (!NILP (binding) && XTYPE (binding) != Lisp_Int)
2c6f1a39
JB
1601 {
1602 if (XTYPE (definition) == Lisp_Cons)
1603 {
1604 Lisp_Object tem;
1605 tem = Fequal (binding, definition);
265a9e55 1606 if (NILP (tem))
2c6f1a39
JB
1607 continue;
1608 }
1609 else
1610 if (!EQ (binding, definition))
1611 continue;
1612 }
1613 }
1614
1615 /* It is a true unshadowed match. Record it. */
2fc66973 1616 found = Fcons (sequence, found);
2c6f1a39 1617
2fc66973
JB
1618 /* If firstonly is Qnon_ascii, then we can return the first
1619 binding we find. If firstonly is not Qnon_ascii but not
1620 nil, then we should return the first ascii-only binding
1621 we find. */
1622 if (EQ (firstonly, Qnon_ascii))
1623 return sequence;
1624 else if (! NILP (firstonly) && ascii_sequence_p (sequence))
2c6f1a39 1625 return sequence;
2c6f1a39
JB
1626 }
1627 }
2fc66973
JB
1628
1629 found = Fnreverse (found);
1630
1631 /* firstonly may have been t, but we may have gone all the way through
1632 the keymaps without finding an all-ASCII key sequence. So just
1633 return the best we could find. */
1634 if (! NILP (firstonly))
1635 return Fcar (found);
1636
1637 return found;
2c6f1a39
JB
1638}
1639
1640/* Return a string listing the keys and buttons that run DEFINITION. */
1641
1642static Lisp_Object
1643where_is_string (definition)
1644 Lisp_Object definition;
1645{
1646 register Lisp_Object keys, keys1;
1647
1648 keys = Fwhere_is_internal (definition,
1649 current_buffer->keymap, Qnil, Qnil, Qnil);
1650 keys1 = Fmapconcat (Qkey_description, keys, build_string (", "));
1651
1652 return keys1;
1653}
1654
1655DEFUN ("where-is", Fwhere_is, Swhere_is, 1, 1, "CWhere is command: ",
1656 "Print message listing key sequences that invoke specified command.\n\
1657Argument is a command definition, usually a symbol with a function definition.")
1658 (definition)
1659 Lisp_Object definition;
1660{
1661 register Lisp_Object string;
1662
1663 CHECK_SYMBOL (definition, 0);
1664 string = where_is_string (definition);
1665
1666 if (XSTRING (string)->size)
1667 message ("%s is on %s", XSYMBOL (definition)->name->data,
1668 XSTRING (string)->data);
1669 else
1670 message ("%s is not on any key", XSYMBOL (definition)->name->data);
1671 return Qnil;
1672}
1673\f
cc0a8174
JB
1674/* describe-bindings - summarizing all the bindings in a set of keymaps. */
1675
53c8f9fa 1676DEFUN ("describe-bindings", Fdescribe_bindings, Sdescribe_bindings, 0, 1, "",
2c6f1a39 1677 "Show a list of all defined keys, and their definitions.\n\
53c8f9fa
RS
1678The list is put in a buffer, which is displayed.\n\
1679An optional argument PREFIX, if non-nil, should be a key sequence;\n\
1680then we display only bindings that start with that prefix.")
1681 (prefix)
1682 Lisp_Object prefix;
2c6f1a39
JB
1683{
1684 register Lisp_Object thisbuf;
1685 XSET (thisbuf, Lisp_Buffer, current_buffer);
1686 internal_with_output_to_temp_buffer ("*Help*",
1687 describe_buffer_bindings,
53c8f9fa 1688 Fcons (thisbuf, prefix));
2c6f1a39
JB
1689 return Qnil;
1690}
1691
53c8f9fa
RS
1692/* ARG is (BUFFER . PREFIX). */
1693
2c6f1a39 1694static Lisp_Object
53c8f9fa
RS
1695describe_buffer_bindings (arg)
1696 Lisp_Object arg;
2c6f1a39 1697{
53c8f9fa 1698 Lisp_Object descbuf, prefix, shadow;
2c6f1a39
JB
1699 register Lisp_Object start1, start2;
1700
4726a9f1
JB
1701 char *alternate_heading
1702 = "\
1703Alternate Characters (use anywhere the nominal character is listed):\n\
1704nominal alternate\n\
1705------- ---------\n";
2c6f1a39 1706
53c8f9fa
RS
1707 descbuf = XCONS (arg)->car;
1708 prefix = XCONS (arg)->cdr;
a588e041 1709 shadow = Qnil;
53c8f9fa 1710
2c6f1a39
JB
1711 Fset_buffer (Vstandard_output);
1712
4726a9f1
JB
1713 /* Report on alternates for keys. */
1714 if (XTYPE (Vkeyboard_translate_table) == Lisp_String)
1715 {
1716 int c;
1717 unsigned char *translate = XSTRING (Vkeyboard_translate_table)->data;
1718 int translate_len = XSTRING (Vkeyboard_translate_table)->size;
1719
1720 for (c = 0; c < translate_len; c++)
1721 if (translate[c] != c)
1722 {
1723 char buf[20];
1724 char *bufend;
1725
1726 if (alternate_heading)
1727 {
1728 insert_string (alternate_heading);
1729 alternate_heading = 0;
1730 }
1731
1732 bufend = push_key_description (translate[c], buf);
1733 insert (buf, bufend - buf);
1734 Findent_to (make_number (16), make_number (1));
1735 bufend = push_key_description (c, buf);
1736 insert (buf, bufend - buf);
1737
1738 insert ("\n", 1);
1739 }
1740
1741 insert ("\n", 1);
1742 }
1743
cc0a8174
JB
1744 {
1745 int i, nmaps;
1746 Lisp_Object *modes, *maps;
1747
4726a9f1
JB
1748 /* Temporarily switch to descbuf, so that we can get that buffer's
1749 minor modes correctly. */
1750 Fset_buffer (descbuf);
7d92e329
RS
1751 if (!NILP (Voverriding_local_map))
1752 nmaps = 0;
1753 else
1754 nmaps = current_minor_maps (&modes, &maps);
4726a9f1
JB
1755 Fset_buffer (Vstandard_output);
1756
53c8f9fa 1757 /* Print the minor mode maps. */
cc0a8174
JB
1758 for (i = 0; i < nmaps; i++)
1759 {
07f15dfd
RS
1760 /* Tht title for a minor mode keymap
1761 is constructed at run time.
1762 We let describe_map_tree do the actual insertion
1763 because it takes care of other features when doing so. */
1764 char *title = (char *) alloca (40 + XSYMBOL (modes[i])->name->size);
1765 char *p = title;
1766
cc0a8174
JB
1767 if (XTYPE (modes[i]) == Lisp_Symbol)
1768 {
07f15dfd
RS
1769 *p++ = '`';
1770 bcopy (XSYMBOL (modes[i])->name->data, p,
1771 XSYMBOL (modes[i])->name->size);
1772 p += XSYMBOL (modes[i])->name->size;
1773 *p++ = '\'';
cc0a8174
JB
1774 }
1775 else
07f15dfd
RS
1776 {
1777 bcopy ("Strangely Named", p, sizeof ("Strangely Named"));
1778 p += sizeof ("Strangely Named");
1779 }
1780 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings"));
1781 p += sizeof (" Minor Mode Bindings");
1782 *p = 0;
1783
af1d6f09 1784 describe_map_tree (maps[i], 0, shadow, prefix, title, 0);
53c8f9fa 1785 shadow = Fcons (maps[i], shadow);
cc0a8174
JB
1786 }
1787 }
1788
53c8f9fa 1789 /* Print the (major mode) local map. */
7d92e329
RS
1790 if (!NILP (Voverriding_local_map))
1791 start1 = Voverriding_local_map;
1792 else
1793 start1 = XBUFFER (descbuf)->keymap;
1794
265a9e55 1795 if (!NILP (start1))
2c6f1a39 1796 {
53c8f9fa 1797 describe_map_tree (start1, 0, shadow, prefix,
af1d6f09 1798 "Major Mode Bindings", 0);
53c8f9fa 1799 shadow = Fcons (start1, shadow);
2c6f1a39
JB
1800 }
1801
53c8f9fa 1802 describe_map_tree (current_global_map, 0, shadow, prefix,
af1d6f09 1803 "Global Bindings", 0);
2c6f1a39
JB
1804
1805 Fset_buffer (descbuf);
1806 return Qnil;
1807}
1808
1809/* Insert a desription of the key bindings in STARTMAP,
1810 followed by those of all maps reachable through STARTMAP.
1811 If PARTIAL is nonzero, omit certain "uninteresting" commands
1812 (such as `undefined').
53c8f9fa
RS
1813 If SHADOW is non-nil, it is a list of maps;
1814 don't mention keys which would be shadowed by any of them.
1815 PREFIX, if non-nil, says mention only keys that start with PREFIX.
07f15dfd 1816 TITLE, if not 0, is a string to insert at the beginning.
af1d6f09
RS
1817 TITLE should not end with a colon or a newline; we supply that.
1818 If NOMENU is not 0, then omit menu-bar commands. */
2c6f1a39
JB
1819
1820void
af1d6f09 1821describe_map_tree (startmap, partial, shadow, prefix, title, nomenu)
53c8f9fa 1822 Lisp_Object startmap, shadow, prefix;
2c6f1a39 1823 int partial;
53c8f9fa 1824 char *title;
af1d6f09 1825 int nomenu;
2c6f1a39 1826{
2c6f1a39
JB
1827 Lisp_Object maps;
1828 struct gcpro gcpro1;
07f15dfd 1829 int something = 0;
53c8f9fa
RS
1830 char *key_heading
1831 = "\
1832key binding\n\
1833--- -------\n";
2c6f1a39 1834
53c8f9fa 1835 maps = Faccessible_keymaps (startmap, prefix);
2c6f1a39
JB
1836 GCPRO1 (maps);
1837
af1d6f09
RS
1838 if (nomenu)
1839 {
1840 Lisp_Object list;
1841
1842 /* Delete from MAPS each element that is for the menu bar. */
1843 for (list = maps; !NILP (list); list = XCONS (list)->cdr)
1844 {
1845 Lisp_Object elt, prefix, tem;
1846
1847 elt = Fcar (list);
1848 prefix = Fcar (elt);
1849 if (XVECTOR (prefix)->size >= 1)
1850 {
1851 tem = Faref (prefix, make_number (0));
1852 if (EQ (tem, Qmenu_bar))
1853 maps = Fdelq (elt, maps);
1854 }
1855 }
1856 }
1857
53c8f9fa
RS
1858 if (!NILP (maps))
1859 {
1860 if (title)
07f15dfd
RS
1861 {
1862 insert_string (title);
1863 if (!NILP (prefix))
1864 {
1865 insert_string (" Starting With ");
1866 insert1 (Fkey_description (prefix));
1867 }
1868 insert_string (":\n");
1869 }
53c8f9fa 1870 insert_string (key_heading);
07f15dfd 1871 something = 1;
53c8f9fa
RS
1872 }
1873
265a9e55 1874 for (; !NILP (maps); maps = Fcdr (maps))
2c6f1a39 1875 {
53c8f9fa
RS
1876 register Lisp_Object elt, prefix, sub_shadows, tail;
1877
2c6f1a39 1878 elt = Fcar (maps);
53c8f9fa
RS
1879 prefix = Fcar (elt);
1880
1881 sub_shadows = Qnil;
1882
1883 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
2c6f1a39 1884 {
53c8f9fa
RS
1885 Lisp_Object shmap;
1886
1887 shmap = XCONS (tail)->car;
1888
1889 /* If the sequence by which we reach this keymap is zero-length,
1890 then the shadow map for this keymap is just SHADOW. */
1891 if ((XTYPE (prefix) == Lisp_String
1892 && XSTRING (prefix)->size == 0)
1893 || (XTYPE (prefix) == Lisp_Vector
1894 && XVECTOR (prefix)->size == 0))
1895 ;
1896 /* If the sequence by which we reach this keymap actually has
1897 some elements, then the sequence's definition in SHADOW is
1898 what we should use. */
1899 else
1900 {
1901 shmap = Flookup_key (shadow, Fcar (elt), Qt);
1902 if (XTYPE (shmap) == Lisp_Int)
1903 shmap = Qnil;
1904 }
1905
1906 /* If shmap is not nil and not a keymap,
1907 it completely shadows this map, so don't
1908 describe this map at all. */
1909 if (!NILP (shmap) && NILP (Fkeymapp (shmap)))
1910 goto skip;
1911
1912 if (!NILP (shmap))
1913 sub_shadows = Fcons (shmap, sub_shadows);
2c6f1a39
JB
1914 }
1915
53c8f9fa
RS
1916 describe_map (Fcdr (elt), Fcar (elt), partial, sub_shadows);
1917
1918 skip: ;
2c6f1a39
JB
1919 }
1920
07f15dfd
RS
1921 if (something)
1922 insert_string ("\n");
1923
2c6f1a39
JB
1924 UNGCPRO;
1925}
1926
1927static void
1928describe_command (definition)
1929 Lisp_Object definition;
1930{
1931 register Lisp_Object tem1;
1932
1933 Findent_to (make_number (16), make_number (1));
1934
1935 if (XTYPE (definition) == Lisp_Symbol)
1936 {
1937 XSET (tem1, Lisp_String, XSYMBOL (definition)->name);
1938 insert1 (tem1);
1939 insert_string ("\n");
1940 }
24065b9c
RS
1941 else if (STRINGP (definition))
1942 insert_string ("Keyboard Macro\n");
2c6f1a39
JB
1943 else
1944 {
1945 tem1 = Fkeymapp (definition);
265a9e55 1946 if (!NILP (tem1))
2c6f1a39
JB
1947 insert_string ("Prefix Command\n");
1948 else
1949 insert_string ("??\n");
1950 }
1951}
1952
1953/* Describe the contents of map MAP, assuming that this map itself is
1954 reached by the sequence of prefix keys KEYS (a string or vector).
1955 PARTIAL, SHADOW is as in `describe_map_tree' above. */
1956
1957static void
1958describe_map (map, keys, partial, shadow)
1959 Lisp_Object map, keys;
1960 int partial;
1961 Lisp_Object shadow;
1962{
1963 register Lisp_Object keysdesc;
1964
d09b2024 1965 if (!NILP (keys) && XFASTINT (Flength (keys)) > 0)
5cba3869
RS
1966 {
1967 Lisp_Object tem;
1968 /* Call Fkey_description first, to avoid GC bug for the other string. */
1969 tem = Fkey_description (keys);
1970 keysdesc = concat2 (tem, build_string (" "));
1971 }
2c6f1a39
JB
1972 else
1973 keysdesc = Qnil;
1974
f5b79c1c 1975 describe_map_2 (map, keysdesc, describe_command, partial, shadow);
2c6f1a39
JB
1976}
1977
53c8f9fa
RS
1978/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
1979 Returns the first non-nil binding found in any of those maps. */
1980
1981static Lisp_Object
1982shadow_lookup (shadow, key, flag)
1983 Lisp_Object shadow, key, flag;
1984{
1985 Lisp_Object tail, value;
1986
1987 for (tail = shadow; CONSP (tail); tail = XCONS (tail)->cdr)
1988 {
1989 value = Flookup_key (XCONS (tail)->car, key, flag);
1990 if (!NILP (value))
1991 return value;
1992 }
1993 return Qnil;
1994}
1995
f5b79c1c 1996/* Insert a description of KEYMAP into the current buffer. */
2c6f1a39
JB
1997
1998static void
f5b79c1c
JB
1999describe_map_2 (keymap, elt_prefix, elt_describer, partial, shadow)
2000 register Lisp_Object keymap;
2c6f1a39
JB
2001 Lisp_Object elt_prefix;
2002 int (*elt_describer) ();
2003 int partial;
2004 Lisp_Object shadow;
2005{
53c8f9fa 2006 Lisp_Object tail, definition, event;
99a225a9 2007 Lisp_Object tem;
2c6f1a39
JB
2008 Lisp_Object suppress;
2009 Lisp_Object kludge;
2010 int first = 1;
2011 struct gcpro gcpro1, gcpro2, gcpro3;
2012
2013 if (partial)
2014 suppress = intern ("suppress-keymap");
2015
2016 /* This vector gets used to present single keys to Flookup_key. Since
f5b79c1c 2017 that is done once per keymap element, we don't want to cons up a
2c6f1a39
JB
2018 fresh vector every time. */
2019 kludge = Fmake_vector (make_number (1), Qnil);
99a225a9 2020 definition = Qnil;
2c6f1a39 2021
99a225a9 2022 GCPRO3 (elt_prefix, definition, kludge);
2c6f1a39 2023
53c8f9fa 2024 for (tail = XCONS (keymap)->cdr; CONSP (tail); tail = Fcdr (tail))
2c6f1a39
JB
2025 {
2026 QUIT;
2c6f1a39 2027
53c8f9fa
RS
2028 if (XTYPE (XCONS (tail)->car) == Lisp_Vector)
2029 describe_vector (XCONS (tail)->car,
f5b79c1c
JB
2030 elt_prefix, elt_describer, partial, shadow);
2031 else
2c6f1a39 2032 {
53c8f9fa
RS
2033 event = Fcar_safe (Fcar (tail));
2034 definition = get_keyelt (Fcdr_safe (Fcar (tail)));
2c6f1a39 2035
f5b79c1c 2036 /* Don't show undefined commands or suppressed commands. */
99a225a9
RS
2037 if (NILP (definition)) continue;
2038 if (XTYPE (definition) == Lisp_Symbol && partial)
f5b79c1c 2039 {
99a225a9
RS
2040 tem = Fget (definition, suppress);
2041 if (!NILP (tem))
f5b79c1c
JB
2042 continue;
2043 }
2c6f1a39 2044
f5b79c1c
JB
2045 /* Don't show a command that isn't really visible
2046 because a local definition of the same key shadows it. */
2c6f1a39 2047
99a225a9 2048 XVECTOR (kludge)->contents[0] = event;
f5b79c1c
JB
2049 if (!NILP (shadow))
2050 {
53c8f9fa 2051 tem = shadow_lookup (shadow, kludge, Qt);
f5b79c1c
JB
2052 if (!NILP (tem)) continue;
2053 }
2054
53c8f9fa 2055 tem = Flookup_key (keymap, kludge, Qt);
99a225a9
RS
2056 if (! EQ (tem, definition)) continue;
2057
f5b79c1c
JB
2058 if (first)
2059 {
2060 insert ("\n", 1);
2061 first = 0;
2062 }
2c6f1a39 2063
f5b79c1c
JB
2064 if (!NILP (elt_prefix))
2065 insert1 (elt_prefix);
2c6f1a39 2066
99a225a9
RS
2067 /* THIS gets the string to describe the character EVENT. */
2068 insert1 (Fsingle_key_description (event));
2c6f1a39 2069
f5b79c1c
JB
2070 /* Print a description of the definition of this character.
2071 elt_describer will take care of spacing out far enough
2072 for alignment purposes. */
99a225a9 2073 (*elt_describer) (definition);
f5b79c1c 2074 }
2c6f1a39
JB
2075 }
2076
2077 UNGCPRO;
2078}
2079
2080static int
2081describe_vector_princ (elt)
2082 Lisp_Object elt;
2083{
81fa9e2f 2084 Findent_to (make_number (16), make_number (1));
2c6f1a39 2085 Fprinc (elt, Qnil);
ad4ec84a 2086 Fterpri (Qnil);
2c6f1a39
JB
2087}
2088
2089DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 1, 0,
ad4ec84a 2090 "Insert a description of contents of VECTOR.\n\
2c6f1a39
JB
2091This is text showing the elements of vector matched against indices.")
2092 (vector)
2093 Lisp_Object vector;
2094{
ad4ec84a
RS
2095 int count = specpdl_ptr - specpdl;
2096
2097 specbind (Qstandard_output, Fcurrent_buffer ());
2c6f1a39 2098 CHECK_VECTOR (vector, 0);
92cc37e8 2099 describe_vector (vector, Qnil, describe_vector_princ, 0, Qnil);
ad4ec84a
RS
2100
2101 return unbind_to (count, Qnil);
2c6f1a39
JB
2102}
2103
2104describe_vector (vector, elt_prefix, elt_describer, partial, shadow)
2105 register Lisp_Object vector;
2106 Lisp_Object elt_prefix;
2107 int (*elt_describer) ();
2108 int partial;
2109 Lisp_Object shadow;
2110{
2111 Lisp_Object this;
2112 Lisp_Object dummy;
2113 Lisp_Object tem1, tem2;
2114 register int i;
2115 Lisp_Object suppress;
2116 Lisp_Object kludge;
2117 int first = 1;
2118 struct gcpro gcpro1, gcpro2, gcpro3;
2119
2120 tem1 = Qnil;
2121
2122 /* This vector gets used to present single keys to Flookup_key. Since
2123 that is done once per vector element, we don't want to cons up a
2124 fresh vector every time. */
2125 kludge = Fmake_vector (make_number (1), Qnil);
2126 GCPRO3 (elt_prefix, tem1, kludge);
2127
2128 if (partial)
2129 suppress = intern ("suppress-keymap");
2130
db6f9d95 2131 for (i = 0; i < XVECTOR (vector)->size; i++)
2c6f1a39
JB
2132 {
2133 QUIT;
2134 tem1 = get_keyelt (XVECTOR (vector)->contents[i]);
2135
265a9e55 2136 if (NILP (tem1)) continue;
2c6f1a39
JB
2137
2138 /* Don't mention suppressed commands. */
2139 if (XTYPE (tem1) == Lisp_Symbol && partial)
2140 {
2141 this = Fget (tem1, suppress);
265a9e55 2142 if (!NILP (this))
2c6f1a39
JB
2143 continue;
2144 }
2145
2146 /* If this command in this map is shadowed by some other map,
2147 ignore it. */
265a9e55 2148 if (!NILP (shadow))
2c6f1a39
JB
2149 {
2150 Lisp_Object tem;
2151
2152 XVECTOR (kludge)->contents[0] = make_number (i);
53c8f9fa 2153 tem = shadow_lookup (shadow, kludge, Qt);
2c6f1a39 2154
265a9e55 2155 if (!NILP (tem)) continue;
2c6f1a39
JB
2156 }
2157
2158 if (first)
2159 {
2160 insert ("\n", 1);
2161 first = 0;
2162 }
2163
2164 /* Output the prefix that applies to every entry in this map. */
265a9e55 2165 if (!NILP (elt_prefix))
2c6f1a39
JB
2166 insert1 (elt_prefix);
2167
2168 /* Get the string to describe the character I, and print it. */
2169 XFASTINT (dummy) = i;
2170
2171 /* THIS gets the string to describe the character DUMMY. */
2172 this = Fsingle_key_description (dummy);
2173 insert1 (this);
2174
2175 /* Find all consecutive characters that have the same definition. */
db6f9d95 2176 while (i + 1 < XVECTOR (vector)->size
2c6f1a39
JB
2177 && (tem2 = get_keyelt (XVECTOR (vector)->contents[i+1]),
2178 EQ (tem2, tem1)))
2179 i++;
2180
2181 /* If we have a range of more than one character,
2182 print where the range reaches to. */
2183
2184 if (i != XINT (dummy))
2185 {
2186 insert (" .. ", 4);
265a9e55 2187 if (!NILP (elt_prefix))
2c6f1a39
JB
2188 insert1 (elt_prefix);
2189
2190 XFASTINT (dummy) = i;
2191 insert1 (Fsingle_key_description (dummy));
2192 }
2193
2194 /* Print a description of the definition of this character.
2195 elt_describer will take care of spacing out far enough
2196 for alignment purposes. */
2197 (*elt_describer) (tem1);
2198 }
2199
2200 UNGCPRO;
2201}
2202\f
cc0a8174 2203/* Apropos - finding all symbols whose names match a regexp. */
2c6f1a39
JB
2204Lisp_Object apropos_predicate;
2205Lisp_Object apropos_accumulate;
2206
2207static void
2208apropos_accum (symbol, string)
2209 Lisp_Object symbol, string;
2210{
2211 register Lisp_Object tem;
2212
2213 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
265a9e55 2214 if (!NILP (tem) && !NILP (apropos_predicate))
2c6f1a39 2215 tem = call1 (apropos_predicate, symbol);
265a9e55 2216 if (!NILP (tem))
2c6f1a39
JB
2217 apropos_accumulate = Fcons (symbol, apropos_accumulate);
2218}
2219
2220DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
2221 "Show all symbols whose names contain match for REGEXP.\n\
2222If optional 2nd arg PRED is non-nil, (funcall PRED SYM) is done\n\
2223for each symbol and a symbol is mentioned only if that returns non-nil.\n\
2224Return list of symbols found.")
2225 (string, pred)
2226 Lisp_Object string, pred;
2227{
2228 struct gcpro gcpro1, gcpro2;
2229 CHECK_STRING (string, 0);
2230 apropos_predicate = pred;
2231 GCPRO2 (apropos_predicate, apropos_accumulate);
2232 apropos_accumulate = Qnil;
2233 map_obarray (Vobarray, apropos_accum, string);
2234 apropos_accumulate = Fsort (apropos_accumulate, Qstring_lessp);
2235 UNGCPRO;
2236 return apropos_accumulate;
2237}
2238\f
2239syms_of_keymap ()
2240{
2241 Lisp_Object tem;
2242
2243 Qkeymap = intern ("keymap");
2244 staticpro (&Qkeymap);
2245
2246/* Initialize the keymaps standardly used.
2247 Each one is the value of a Lisp variable, and is also
2248 pointed to by a C variable */
2249
19eaeb86 2250 global_map = Fcons (Qkeymap,
1447c534 2251 Fcons (Fmake_vector (make_number (0400), Qnil), Qnil));
2c6f1a39
JB
2252 Fset (intern ("global-map"), global_map);
2253
ce6e5d0b 2254 meta_map = Fmake_keymap (Qnil);
2c6f1a39
JB
2255 Fset (intern ("esc-map"), meta_map);
2256 Ffset (intern ("ESC-prefix"), meta_map);
2257
ce6e5d0b 2258 control_x_map = Fmake_keymap (Qnil);
2c6f1a39
JB
2259 Fset (intern ("ctl-x-map"), control_x_map);
2260 Ffset (intern ("Control-X-prefix"), control_x_map);
2261
2262 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
2263 "Default keymap to use when reading from the minibuffer.");
ce6e5d0b 2264 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2265
2266 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
2267 "Local keymap for the minibuffer when spaces are not allowed.");
ce6e5d0b 2268 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2269
2270 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
2271 "Local keymap for minibuffer input with completion.");
ce6e5d0b 2272 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2273
2274 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
2275 "Local keymap for minibuffer input with completion, for exact match.");
ce6e5d0b 2276 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
2277
2278 current_global_map = global_map;
2279
cc0a8174
JB
2280 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
2281 "Alist of keymaps to use for minor modes.\n\
2282Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read\n\
2283key sequences and look up bindings iff VARIABLE's value is non-nil.\n\
2284If two active keymaps bind the same key, the keymap appearing earlier\n\
2285in the list takes precedence.");
2286 Vminor_mode_map_alist = Qnil;
2287
6bbbd9b0
JB
2288 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
2289 "Keymap mapping ASCII function key sequences onto their preferred forms.\n\
2290This allows Emacs to recognize function keys sent from ASCII\n\
2291terminals at any point in a key sequence.\n\
2292\n\
2293The read-key-sequence function replaces subsequences bound by\n\
2294function-key-map with their bindings. When the current local and global\n\
2295keymaps have no binding for the current key sequence but\n\
718ca51e 2296function-key-map binds a suffix of the sequence to a vector or string,\n\
6bbbd9b0
JB
2297read-key-sequence replaces the matching suffix with its binding, and\n\
2298continues with the new sequence.\n\
2299\n\
718ca51e
JB
2300For example, suppose function-key-map binds `ESC O P' to [f1].\n\
2301Typing `ESC O P' to read-key-sequence would return [f1]. Typing\n\
2302`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix\n\
2303key, typing `ESC O P x' would return [f1 x].");
ce6e5d0b 2304 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
6bbbd9b0 2305
2c6f1a39
JB
2306 Qsingle_key_description = intern ("single-key-description");
2307 staticpro (&Qsingle_key_description);
2308
2309 Qkey_description = intern ("key-description");
2310 staticpro (&Qkey_description);
2311
2312 Qkeymapp = intern ("keymapp");
2313 staticpro (&Qkeymapp);
2314
2fc66973
JB
2315 Qnon_ascii = intern ("non-ascii");
2316 staticpro (&Qnon_ascii);
2317
2c6f1a39
JB
2318 defsubr (&Skeymapp);
2319 defsubr (&Smake_keymap);
2320 defsubr (&Smake_sparse_keymap);
2321 defsubr (&Scopy_keymap);
2322 defsubr (&Skey_binding);
2323 defsubr (&Slocal_key_binding);
2324 defsubr (&Sglobal_key_binding);
cc0a8174 2325 defsubr (&Sminor_mode_key_binding);
2c6f1a39
JB
2326 defsubr (&Sglobal_set_key);
2327 defsubr (&Slocal_set_key);
2328 defsubr (&Sdefine_key);
2329 defsubr (&Slookup_key);
2330 defsubr (&Sglobal_unset_key);
2331 defsubr (&Slocal_unset_key);
2332 defsubr (&Sdefine_prefix_command);
2333 defsubr (&Suse_global_map);
2334 defsubr (&Suse_local_map);
2335 defsubr (&Scurrent_local_map);
2336 defsubr (&Scurrent_global_map);
cc0a8174 2337 defsubr (&Scurrent_minor_mode_maps);
2c6f1a39
JB
2338 defsubr (&Saccessible_keymaps);
2339 defsubr (&Skey_description);
2340 defsubr (&Sdescribe_vector);
2341 defsubr (&Ssingle_key_description);
2342 defsubr (&Stext_char_description);
2343 defsubr (&Swhere_is_internal);
2344 defsubr (&Swhere_is);
2345 defsubr (&Sdescribe_bindings);
2346 defsubr (&Sapropos_internal);
2347}
2348
2349keys_of_keymap ()
2350{
2351 Lisp_Object tem;
2352
2353 initial_define_key (global_map, 033, "ESC-prefix");
2354 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
2355}