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