Tried to make docstring less `colloquial'...
[bpt/emacs.git] / src / keymap.c
CommitLineData
2c6f1a39 1/* Manipulation of keymaps
0b5538bd
TTN
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
aaef169d 4 2005, 2006 Free Software Foundation, Inc.
2c6f1a39
JB
5
6This file is part of GNU Emacs.
7
8GNU Emacs is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
502ddf23 10the Free Software Foundation; either version 2, or (at your option)
2c6f1a39
JB
11any later version.
12
13GNU Emacs is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with GNU Emacs; see the file COPYING. If not, write to
4fc5845f
LK
20the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21Boston, MA 02110-1301, USA. */
2c6f1a39
JB
22
23
18160b98 24#include <config.h>
2c6f1a39 25#include <stdio.h>
2c6f1a39
JB
26#include "lisp.h"
27#include "commands.h"
28#include "buffer.h"
a98f1d1d 29#include "charset.h"
6bbbd9b0 30#include "keyboard.h"
6ba6e250 31#include "termhooks.h"
9ac0d9e0 32#include "blockinput.h"
d964248c 33#include "puresize.h"
93d2aa1c 34#include "intervals.h"
8feddab4 35#include "keymap.h"
2c6f1a39 36
f5b79c1c 37/* The number of elements in keymap vectors. */
2c6f1a39
JB
38#define DENSE_TABLE_SIZE (0200)
39
40/* Actually allocate storage for these variables */
41
42Lisp_Object current_global_map; /* Current global keymap */
43
44Lisp_Object global_map; /* default global key bindings */
45
46Lisp_Object meta_map; /* The keymap used for globally bound
47 ESC-prefixed default commands */
48
49Lisp_Object control_x_map; /* The keymap used for globally bound
50 C-x-prefixed default commands */
51
52/* was MinibufLocalMap */
53Lisp_Object Vminibuffer_local_map;
54 /* The keymap used by the minibuf for local
55 bindings when spaces are allowed in the
56 minibuf */
57
58/* was MinibufLocalNSMap */
d55627cc 59Lisp_Object Vminibuffer_local_ns_map;
2c6f1a39
JB
60 /* The keymap used by the minibuf for local
61 bindings when spaces are not encouraged
62 in the minibuf */
63
64/* keymap used for minibuffers when doing completion */
65/* was MinibufLocalCompletionMap */
66Lisp_Object Vminibuffer_local_completion_map;
67
3d866ceb
EZ
68/* keymap used for minibuffers when doing completion in filenames */
69Lisp_Object Vminibuffer_local_filename_completion_map;
70
71/* keymap used for minibuffers when doing completion in filenames
72 with require-match*/
73Lisp_Object Vminibuffer_local_must_match_filename_map;
74
2c6f1a39
JB
75/* keymap used for minibuffers when doing completion and require a match */
76/* was MinibufLocalMustMatchMap */
77Lisp_Object Vminibuffer_local_must_match_map;
78
cc0a8174
JB
79/* Alist of minor mode variables and keymaps. */
80Lisp_Object Vminor_mode_map_alist;
81
dd9cda06
RS
82/* Alist of major-mode-specific overrides for
83 minor mode variables and keymaps. */
84Lisp_Object Vminor_mode_overriding_map_alist;
85
99cbcaca
KS
86/* List of emulation mode keymap alists. */
87Lisp_Object Vemulation_mode_map_alists;
88
6bbbd9b0
JB
89/* Keymap mapping ASCII function key sequences onto their preferred forms.
90 Initialized by the terminal-specific lisp files. See DEFVAR for more
91 documentation. */
92Lisp_Object Vfunction_key_map;
93
d7bf9bf5
RS
94/* Keymap mapping ASCII function key sequences onto their preferred forms. */
95Lisp_Object Vkey_translation_map;
96
107fd03d
RS
97/* A list of all commands given new bindings since a certain time
98 when nil was stored here.
99 This is used to speed up recomputation of menu key equivalents
100 when Emacs starts up. t means don't record anything here. */
101Lisp_Object Vdefine_key_rebound_commands;
102
a1df473f 103Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
2c6f1a39 104
ade19cac
RS
105/* Alist of elements like (DEL . "\d"). */
106static Lisp_Object exclude_keys;
107
023b93f6
KS
108/* Pre-allocated 2-element vector for Fcommand_remapping to use. */
109static Lisp_Object command_remapping_vector;
a1df473f 110
3d248688
JB
111/* A char with the CHAR_META bit set in a vector or the 0200 bit set
112 in a string key sequence is equivalent to prefixing with this
113 character. */
2c6f1a39
JB
114extern Lisp_Object meta_prefix_char;
115
7d92e329
RS
116extern Lisp_Object Voverriding_local_map;
117
1e7d1ab0
SM
118/* Hash table used to cache a reverse-map to speed up calls to where-is. */
119static Lisp_Object where_is_cache;
120/* Which keymaps are reverse-stored in the cache. */
121static Lisp_Object where_is_cache_keymaps;
122
57495396
SM
123static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
124static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
125
126static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
d55627cc
SM
127static void describe_command P_ ((Lisp_Object, Lisp_Object));
128static void describe_translation P_ ((Lisp_Object, Lisp_Object));
57495396 129static void describe_map P_ ((Lisp_Object, Lisp_Object,
d55627cc 130 void (*) P_ ((Lisp_Object, Lisp_Object)),
b88e82fd 131 int, Lisp_Object, Lisp_Object*, int, int));
f8d8ba40
KS
132static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
133 void (*) (Lisp_Object, Lisp_Object), int,
b88e82fd
RS
134 Lisp_Object, Lisp_Object, int *,
135 int, int, int));
15fff01d 136static void silly_event_symbol_error P_ ((Lisp_Object));
2c6f1a39 137\f
cc0a8174
JB
138/* Keymap object support - constructors and predicates. */
139
ce6e5d0b 140DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
335c5470 141 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
2c0a0e38
LT
142CHARTABLE is a char-table that holds the bindings for all characters
143without modifiers. All entries in it are initially nil, meaning
144"command undefined". ALIST is an assoc-list which holds bindings for
145function keys, mouse events, and any other things that appear in the
146input stream. Initially, ALIST is nil.
335c5470
PJ
147
148The optional arg STRING supplies a menu name for the keymap
149in case you use it as a menu with `x-popup-menu'. */)
150 (string)
ce6e5d0b 151 Lisp_Object string;
2c6f1a39 152{
ce6e5d0b
RS
153 Lisp_Object tail;
154 if (!NILP (string))
155 tail = Fcons (string, Qnil);
156 else
157 tail = Qnil;
2c6f1a39 158 return Fcons (Qkeymap,
0403641f 159 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
2c6f1a39
JB
160}
161
ce6e5d0b 162DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
335c5470
PJ
163 doc: /* Construct and return a new sparse keymap.
164Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
165which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
166which binds the function key or mouse event SYMBOL to DEFINITION.
167Initially the alist is nil.
168
169The optional arg STRING supplies a menu name for the keymap
170in case you use it as a menu with `x-popup-menu'. */)
171 (string)
ce6e5d0b 172 Lisp_Object string;
2c6f1a39 173{
ce6e5d0b
RS
174 if (!NILP (string))
175 return Fcons (Qkeymap, Fcons (string, Qnil));
2c6f1a39
JB
176 return Fcons (Qkeymap, Qnil);
177}
178
179/* This function is used for installing the standard key bindings
180 at initialization time.
181
182 For example:
183
e25c4e44 184 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
2c6f1a39
JB
185
186void
187initial_define_key (keymap, key, defname)
188 Lisp_Object keymap;
189 int key;
190 char *defname;
191{
192 store_in_keymap (keymap, make_number (key), intern (defname));
193}
194
e25c4e44
JB
195void
196initial_define_lispy_key (keymap, keyname, defname)
197 Lisp_Object keymap;
198 char *keyname;
199 char *defname;
200{
201 store_in_keymap (keymap, intern (keyname), intern (defname));
202}
203
2c6f1a39 204DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
335c5470
PJ
205 doc: /* Return t if OBJECT is a keymap.
206
207A keymap is a list (keymap . ALIST),
208or a symbol whose function definition is itself a keymap.
209ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
210a vector of densely packed bindings for small character codes
211is also allowed as an element. */)
212 (object)
2c6f1a39
JB
213 Lisp_Object object;
214{
02067692 215 return (KEYMAPP (object) ? Qt : Qnil);
2c6f1a39
JB
216}
217
54cbc3d4 218DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
335c5470
PJ
219 doc: /* Return the prompt-string of a keymap MAP.
220If non-nil, the prompt is shown in the echo-area
221when reading a key-sequence to be looked-up in this keymap. */)
222 (map)
54cbc3d4
SM
223 Lisp_Object map;
224{
32e2fb04 225 map = get_keymap (map, 0, 0);
54cbc3d4
SM
226 while (CONSP (map))
227 {
32e2fb04 228 Lisp_Object tem = XCAR (map);
54cbc3d4
SM
229 if (STRINGP (tem))
230 return tem;
32e2fb04 231 map = XCDR (map);
54cbc3d4
SM
232 }
233 return Qnil;
234}
235
2c6f1a39 236/* Check that OBJECT is a keymap (after dereferencing through any
d09b2024
JB
237 symbols). If it is, return it.
238
239 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
240 is an autoload form, do the autoload and try again.
21a0d7a0 241 If AUTOLOAD is nonzero, callers must assume GC is possible.
d09b2024 242
02067692
SM
243 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
244 is zero as well), return Qt.
245
d09b2024
JB
246 ERROR controls how we respond if OBJECT isn't a keymap.
247 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
248
249 Note that most of the time, we don't want to pursue autoloads.
250 Functions like Faccessible_keymaps which scan entire keymap trees
251 shouldn't load every autoloaded keymap. I'm not sure about this,
252 but it seems to me that only read_key_sequence, Flookup_key, and
df75b1a3
GM
253 Fdefine_key should cause keymaps to be autoloaded.
254
255 This function can GC when AUTOLOAD is non-zero, because it calls
256 do_autoload which can GC. */
d09b2024 257
2c6f1a39 258Lisp_Object
02067692 259get_keymap (object, error, autoload)
2c6f1a39 260 Lisp_Object object;
d09b2024 261 int error, autoload;
2c6f1a39 262{
d09b2024 263 Lisp_Object tem;
2c6f1a39 264
d09b2024 265 autoload_retry:
b1314e15
KH
266 if (NILP (object))
267 goto end;
268 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
269 return object;
f5b79c1c 270
02067692
SM
271 tem = indirect_function (object);
272 if (CONSP (tem))
d09b2024 273 {
02067692
SM
274 if (EQ (XCAR (tem), Qkeymap))
275 return tem;
d09b2024 276
02067692
SM
277 /* Should we do an autoload? Autoload forms for keymaps have
278 Qkeymap as their fifth element. */
9ce78f7c
SM
279 if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
280 && SYMBOLP (object))
8e4dfd54 281 {
02067692 282 Lisp_Object tail;
d09b2024 283
02067692
SM
284 tail = Fnth (make_number (4), tem);
285 if (EQ (tail, Qkeymap))
286 {
287 if (autoload)
288 {
289 struct gcpro gcpro1, gcpro2;
31bea176 290
02067692
SM
291 GCPRO2 (tem, object);
292 do_autoload (tem, object);
293 UNGCPRO;
31bea176 294
02067692
SM
295 goto autoload_retry;
296 }
297 else
298 return Qt;
299 }
8e4dfd54 300 }
d09b2024
JB
301 }
302
b1314e15 303 end:
2c6f1a39
JB
304 if (error)
305 wrong_type_argument (Qkeymapp, object);
6bbd7a29 306 return Qnil;
2c6f1a39 307}
7d58ed99 308\f
31bea176
SM
309/* Return the parent map of KEYMAP, or nil if it has none.
310 We assume that KEYMAP is a valid keymap. */
7d58ed99 311
31bea176
SM
312Lisp_Object
313keymap_parent (keymap, autoload)
7d58ed99 314 Lisp_Object keymap;
31bea176 315 int autoload;
7d58ed99
RS
316{
317 Lisp_Object list;
318
31bea176 319 keymap = get_keymap (keymap, 1, autoload);
7d58ed99
RS
320
321 /* Skip past the initial element `keymap'. */
03699b14
KR
322 list = XCDR (keymap);
323 for (; CONSP (list); list = XCDR (list))
7d58ed99
RS
324 {
325 /* See if there is another `keymap'. */
57495396 326 if (KEYMAPP (list))
7d58ed99
RS
327 return list;
328 }
329
31bea176 330 return get_keymap (list, 0, autoload);
7d58ed99
RS
331}
332
31bea176
SM
333DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
334 doc: /* Return the parent keymap of KEYMAP. */)
335 (keymap)
336 Lisp_Object keymap;
337{
338 return keymap_parent (keymap, 1);
339}
3015eec0 340
b1904cd9
SM
341/* Check whether MAP is one of MAPS parents. */
342int
343keymap_memberp (map, maps)
344 Lisp_Object map, maps;
345{
7e05cdaf 346 if (NILP (map)) return 0;
b1904cd9 347 while (KEYMAPP (maps) && !EQ (map, maps))
31bea176 348 maps = keymap_parent (maps, 0);
b1904cd9
SM
349 return (EQ (map, maps));
350}
351
7d58ed99
RS
352/* Set the parent keymap of MAP to PARENT. */
353
354DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
335c5470 355 doc: /* Modify KEYMAP to set its parent map to PARENT.
14923440 356Return PARENT. PARENT should be nil or another keymap. */)
335c5470 357 (keymap, parent)
7d58ed99
RS
358 Lisp_Object keymap, parent;
359{
360 Lisp_Object list, prev;
31bea176 361 struct gcpro gcpro1, gcpro2;
7d58ed99 362 int i;
2c6f1a39 363
1e7d1ab0
SM
364 /* Force a keymap flush for the next call to where-is.
365 Since this can be called from within where-is, we don't set where_is_cache
366 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
367 be changed during where-is, while where_is_cache_keymaps is only used at
368 the very beginning of where-is and can thus be changed here without any
369 adverse effect.
370 This is a very minor correctness (rather than safety) issue. */
371 where_is_cache_keymaps = Qt;
372
31bea176 373 GCPRO2 (keymap, parent);
02067692 374 keymap = get_keymap (keymap, 1, 1);
31bea176 375
7d58ed99 376 if (!NILP (parent))
3015eec0 377 {
02067692 378 parent = get_keymap (parent, 1, 1);
3015eec0
GM
379
380 /* Check for cycles. */
b1904cd9 381 if (keymap_memberp (keymap, parent))
3015eec0
GM
382 error ("Cyclic keymap inheritance");
383 }
2c6f1a39 384
7d58ed99
RS
385 /* Skip past the initial element `keymap'. */
386 prev = keymap;
387 while (1)
388 {
03699b14 389 list = XCDR (prev);
7d58ed99
RS
390 /* If there is a parent keymap here, replace it.
391 If we came to the end, add the parent in PREV. */
54cbc3d4 392 if (!CONSP (list) || KEYMAPP (list))
7d58ed99 393 {
2a5af1cf
RS
394 /* If we already have the right parent, return now
395 so that we avoid the loops below. */
03699b14 396 if (EQ (XCDR (prev), parent))
df75b1a3 397 RETURN_UNGCPRO (parent);
2a5af1cf 398
49daa5b1 399 CHECK_IMPURE (prev);
f3fbd155 400 XSETCDR (prev, parent);
7d58ed99
RS
401 break;
402 }
403 prev = list;
404 }
405
406 /* Scan through for submaps, and set their parents too. */
407
03699b14 408 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
7d58ed99
RS
409 {
410 /* Stop the scan when we come to the parent. */
03699b14 411 if (EQ (XCAR (list), Qkeymap))
7d58ed99
RS
412 break;
413
414 /* If this element holds a prefix map, deal with it. */
03699b14
KR
415 if (CONSP (XCAR (list))
416 && CONSP (XCDR (XCAR (list))))
417 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
418 XCDR (XCAR (list)));
419
420 if (VECTORP (XCAR (list)))
421 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
422 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
7d58ed99 423 fix_submap_inheritance (keymap, make_number (i),
03699b14 424 XVECTOR (XCAR (list))->contents[i]);
0403641f 425
03699b14 426 if (CHAR_TABLE_P (XCAR (list)))
0403641f 427 {
23cf1efa 428 Lisp_Object indices[3];
0403641f 429
fe72189a
RS
430 map_char_table (fix_submap_inheritance, Qnil,
431 XCAR (list), XCAR (list),
0403641f
RS
432 keymap, 0, indices);
433 }
7d58ed99
RS
434 }
435
df75b1a3 436 RETURN_UNGCPRO (parent);
7d58ed99
RS
437}
438
439/* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
440 if EVENT is also a prefix in MAP's parent,
441 make sure that SUBMAP inherits that definition as its own parent. */
442
57495396 443static void
7d58ed99
RS
444fix_submap_inheritance (map, event, submap)
445 Lisp_Object map, event, submap;
446{
447 Lisp_Object map_parent, parent_entry;
448
449 /* SUBMAP is a cons that we found as a key binding.
450 Discard the other things found in a menu key binding. */
451
02067692 452 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
7d58ed99
RS
453
454 /* If it isn't a keymap now, there's no work to do. */
02067692 455 if (!CONSP (submap))
7d58ed99
RS
456 return;
457
31bea176 458 map_parent = keymap_parent (map, 0);
02067692 459 if (!NILP (map_parent))
320c9428 460 parent_entry =
02067692 461 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
7d58ed99
RS
462 else
463 parent_entry = Qnil;
464
3393c3f5 465 /* If MAP's parent has something other than a keymap,
9d0ffdd9 466 our own submap shadows it completely. */
02067692 467 if (!CONSP (parent_entry))
9d0ffdd9 468 return;
3393c3f5 469
7d58ed99 470 if (! EQ (parent_entry, submap))
61684f41
RS
471 {
472 Lisp_Object submap_parent;
473 submap_parent = submap;
474 while (1)
475 {
476 Lisp_Object tem;
9d0ffdd9 477
31bea176 478 tem = keymap_parent (submap_parent, 0);
9d0ffdd9
SM
479
480 if (KEYMAPP (tem))
481 {
482 if (keymap_memberp (tem, parent_entry))
483 /* Fset_keymap_parent could create a cycle. */
484 return;
485 submap_parent = tem;
486 }
61684f41
RS
487 else
488 break;
489 }
490 Fset_keymap_parent (submap_parent, parent_entry);
491 }
7d58ed99
RS
492}
493\f
2c6f1a39 494/* Look up IDX in MAP. IDX may be any sort of event.
f5b79c1c 495 Note that this does only one level of lookup; IDX must be a single
744cd66b 496 event, not a sequence.
e25c4e44
JB
497
498 If T_OK is non-zero, bindings for Qt are treated as default
499 bindings; any key left unmentioned by other tables and bindings is
744cd66b 500 given the binding of Qt.
e25c4e44 501
c07aec97
RS
502 If T_OK is zero, bindings for Qt are not treated specially.
503
504 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
2c6f1a39
JB
505
506Lisp_Object
db785038 507access_keymap (map, idx, t_ok, noinherit, autoload)
2c6f1a39
JB
508 Lisp_Object map;
509 Lisp_Object idx;
e25c4e44 510 int t_ok;
c07aec97 511 int noinherit;
db785038 512 int autoload;
2c6f1a39 513{
efb91645
RS
514 Lisp_Object val;
515
516 /* Qunbound in VAL means we have found no binding yet. */
517 val = Qunbound;
c07aec97 518
2c6f1a39
JB
519 /* If idx is a list (some sort of mouse click, perhaps?),
520 the index we want to use is the car of the list, which
521 ought to be a symbol. */
cebd887d 522 idx = EVENT_HEAD (idx);
2c6f1a39 523
f5b79c1c
JB
524 /* If idx is a symbol, it might have modifiers, which need to
525 be put in the canonical order. */
47684cd9 526 if (SYMBOLP (idx))
f5b79c1c 527 idx = reorder_modifiers (idx);
2732bdbb
RS
528 else if (INTEGERP (idx))
529 /* Clobber the high bits that can be present on a machine
530 with more than 24 bits of integer. */
6e344130 531 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
2c6f1a39 532
db785038
SM
533 /* Handle the special meta -> esc mapping. */
534 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
535 {
7396a36c
GM
536 /* See if there is a meta-map. If there's none, there is
537 no binding for IDX, unless a default binding exists in MAP. */
31bea176
SM
538 struct gcpro gcpro1;
539 Lisp_Object meta_map;
540 GCPRO1 (map);
7f3e8859
RS
541 /* A strange value in which Meta is set would cause
542 infinite recursion. Protect against that. */
996f9cde 543 if (XINT (meta_prefix_char) & CHAR_META)
7f3e8859 544 meta_prefix_char = make_number (27);
31bea176
SM
545 meta_map = get_keymap (access_keymap (map, meta_prefix_char,
546 t_ok, noinherit, autoload),
547 0, autoload);
548 UNGCPRO;
02067692 549 if (CONSP (meta_map))
7396a36c 550 {
9d0ffdd9 551 map = meta_map;
7396a36c
GM
552 idx = make_number (XUINT (idx) & ~meta_modifier);
553 }
554 else if (t_ok)
555 /* Set IDX to t, so that we only find a default binding. */
556 idx = Qt;
557 else
558 /* We know there is no binding. */
559 return Qnil;
db785038
SM
560 }
561
31bea176
SM
562 /* t_binding is where we put a default binding that applies,
563 to use in case we do not find a binding specifically
564 for this key sequence. */
f5b79c1c
JB
565 {
566 Lisp_Object tail;
31bea176
SM
567 Lisp_Object t_binding = Qnil;
568 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
efb91645 569
31bea176 570 GCPRO4 (map, tail, idx, t_binding);
845e4cf4
SM
571
572 /* If `t_ok' is 2, both `t' and generic-char bindings are accepted.
573 If it is 1, only generic-char bindings are accepted.
574 Otherwise, neither are. */
575 t_ok = t_ok ? 2 : 0;
2c6f1a39 576
db785038 577 for (tail = XCDR (map);
7396a36c 578 (CONSP (tail)
02067692 579 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
db785038 580 tail = XCDR (tail))
2c6f1a39 581 {
e9b6dfb0 582 Lisp_Object binding;
f5b79c1c 583
03699b14 584 binding = XCAR (tail);
783a2838 585 if (SYMBOLP (binding))
f5b79c1c 586 {
c07aec97
RS
587 /* If NOINHERIT, stop finding prefix definitions
588 after we pass a second occurrence of the `keymap' symbol. */
db785038 589 if (noinherit && EQ (binding, Qkeymap))
31bea176 590 RETURN_UNGCPRO (Qnil);
783a2838
KH
591 }
592 else if (CONSP (binding))
593 {
859ea4b8 594 Lisp_Object key = XCAR (binding);
744cd66b 595
859ea4b8 596 if (EQ (key, idx))
845e4cf4
SM
597 val = XCDR (binding);
598 else if (t_ok
599 && INTEGERP (idx)
62b366ff 600 && (XINT (idx) & CHAR_MODIFIER_MASK) == 0
859ea4b8 601 && INTEGERP (key)
62b366ff 602 && (XINT (key) & CHAR_MODIFIER_MASK) == 0
859ea4b8
GM
603 && !SINGLE_BYTE_CHAR_P (XINT (idx))
604 && !SINGLE_BYTE_CHAR_P (XINT (key))
605 && CHAR_VALID_P (XINT (key), 1)
606 && !CHAR_VALID_P (XINT (key), 0)
607 && (CHAR_CHARSET (XINT (key))
608 == CHAR_CHARSET (XINT (idx))))
609 {
610 /* KEY is the generic character of the charset of IDX.
611 Use KEY's binding if there isn't a binding for IDX
612 itself. */
845e4cf4
SM
613 t_binding = XCDR (binding);
614 t_ok = 0;
615 }
616 else if (t_ok > 1 && EQ (key, Qt))
617 {
618 t_binding = XCDR (binding);
619 t_ok = 1;
859ea4b8 620 }
783a2838
KH
621 }
622 else if (VECTORP (binding))
623 {
845e4cf4
SM
624 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
625 val = AREF (binding, XFASTINT (idx));
f5b79c1c 626 }
0403641f
RS
627 else if (CHAR_TABLE_P (binding))
628 {
6418ea16
RS
629 /* Character codes with modifiers
630 are not included in a char-table.
631 All character codes without modifiers are included. */
4dc3eb25
SM
632 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
633 {
634 val = Faref (binding, idx);
635 /* `nil' has a special meaning for char-tables, so
636 we use something else to record an explicitly
637 unbound entry. */
638 if (NILP (val))
639 val = Qunbound;
640 }
0403641f 641 }
20218e2f 642
845e4cf4
SM
643 /* If we found a binding, clean it up and return it. */
644 if (!EQ (val, Qunbound))
645 {
4dc3eb25
SM
646 if (EQ (val, Qt))
647 /* A Qt binding is just like an explicit nil binding
648 (i.e. it shadows any parent binding but not bindings in
649 keymaps of lower precedence). */
650 val = Qnil;
845e4cf4
SM
651 val = get_keyelt (val, autoload);
652 if (KEYMAPP (val))
653 fix_submap_inheritance (map, idx, val);
31bea176 654 RETURN_UNGCPRO (val);
845e4cf4 655 }
20218e2f 656 QUIT;
2c6f1a39 657 }
31bea176 658 UNGCPRO;
db785038 659 return get_keyelt (t_binding, autoload);
e25c4e44 660 }
2c6f1a39
JB
661}
662
9d3153eb
SM
663static void
664map_keymap_item (fun, args, key, val, data)
665 map_keymap_function_t fun;
666 Lisp_Object args, key, val;
667 void *data;
668{
669 /* We should maybe try to detect bindings shadowed by previous
670 ones and things like that. */
671 if (EQ (val, Qt))
672 val = Qnil;
673 (*fun) (key, val, args, data);
674}
675
676static void
677map_keymap_char_table_item (args, key, val)
678 Lisp_Object args, key, val;
679{
680 if (!NILP (val))
681 {
682 map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
683 args = XCDR (args);
684 map_keymap_item (fun, XCDR (args), key, val,
685 XSAVE_VALUE (XCAR (args))->pointer);
686 }
687}
688
689/* Call FUN for every binding in MAP.
edf505ce
SM
690 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
691 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
9d3153eb
SM
692void
693map_keymap (map, fun, args, data, autoload)
694 map_keymap_function_t fun;
695 Lisp_Object map, args;
696 void *data;
697 int autoload;
698{
699 struct gcpro gcpro1, gcpro2, gcpro3;
700 Lisp_Object tail;
701
702 GCPRO3 (map, args, tail);
703 map = get_keymap (map, 1, autoload);
704 for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
705 CONSP (tail) || (tail = get_keymap (tail, 0, autoload), CONSP (tail));
706 tail = XCDR (tail))
707 {
708 Lisp_Object binding = XCAR (tail);
f8d8ba40 709
9d3153eb
SM
710 if (CONSP (binding))
711 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
712 else if (VECTORP (binding))
713 {
714 /* Loop over the char values represented in the vector. */
715 int len = ASIZE (binding);
716 int c;
9d3153eb
SM
717 for (c = 0; c < len; c++)
718 {
719 Lisp_Object character;
720 XSETFASTINT (character, c);
721 map_keymap_item (fun, args, character, AREF (binding, c), data);
722 }
723 }
724 else if (CHAR_TABLE_P (binding))
725 {
726 Lisp_Object indices[3];
fe72189a 727 map_char_table (map_keymap_char_table_item, Qnil, binding, binding,
9d3153eb
SM
728 Fcons (make_save_value (fun, 0),
729 Fcons (make_save_value (data, 0),
730 args)),
731 0, indices);
732 }
733 }
734 UNGCPRO;
735}
736
737static void
738map_keymap_call (key, val, fun, dummy)
739 Lisp_Object key, val, fun;
740 void *dummy;
741{
742 call2 (fun, key, val);
743}
744
0ea6ae0a 745DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
bb9c8a99 746 doc: /* Call FUNCTION once for each event binding in KEYMAP.
05f5847b
RS
747FUNCTION is called with two arguments: the event that is bound, and
748the definition it is bound to.
749
2c0a0e38
LT
750If KEYMAP has a parent, the parent's bindings are included as well.
751This works recursively: if the parent has itself a parent, then the
0ea6ae0a
RS
752grandparent's bindings are also included and so on.
753usage: (map-keymap FUNCTION KEYMAP) */)
754 (function, keymap, sort_first)
755 Lisp_Object function, keymap, sort_first;
9d3153eb
SM
756{
757 if (INTEGERP (function))
758 /* We have to stop integers early since map_keymap gives them special
759 significance. */
760 Fsignal (Qinvalid_function, Fcons (function, Qnil));
0ea6ae0a
RS
761 if (! NILP (sort_first))
762 return call3 (intern ("map-keymap-internal"), function, keymap, Qt);
d6a31e9f 763
9d3153eb
SM
764 map_keymap (keymap, map_keymap_call, function, NULL, 1);
765 return Qnil;
766}
767
2c6f1a39
JB
768/* Given OBJECT which was found in a slot in a keymap,
769 trace indirect definitions to get the actual definition of that slot.
770 An indirect definition is a list of the form
771 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
772 and INDEX is the object to look up in KEYMAP to yield the definition.
773
774 Also if OBJECT has a menu string as the first element,
224a16e8
RS
775 remove that. Also remove a menu help string as second element.
776
777 If AUTOLOAD is nonzero, load autoloadable keymaps
18e2d91f
RS
778 that are referred to with indirection.
779
780 This can GC because menu_item_eval_property calls Feval. */
2c6f1a39
JB
781
782Lisp_Object
224a16e8 783get_keyelt (object, autoload)
31bea176 784 Lisp_Object object;
224a16e8 785 int autoload;
2c6f1a39
JB
786{
787 while (1)
788 {
b1314e15
KH
789 if (!(CONSP (object)))
790 /* This is really the value. */
791 return object;
2c6f1a39 792
b1314e15
KH
793 /* If the keymap contents looks like (keymap ...) or (lambda ...)
794 then use itself. */
795 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
796 return object;
797
798 /* If the keymap contents looks like (menu-item name . DEFN)
799 or (menu-item name DEFN ...) then use DEFN.
3fc720e4 800 This is a new format menu item. */
b1314e15 801 else if (EQ (XCAR (object), Qmenu_item))
0403641f 802 {
b1314e15 803 if (CONSP (XCDR (object)))
0403641f 804 {
3fc720e4
GM
805 Lisp_Object tem;
806
b1314e15 807 object = XCDR (XCDR (object));
3fc720e4 808 tem = object;
b1314e15
KH
809 if (CONSP (object))
810 object = XCAR (object);
3fc720e4
GM
811
812 /* If there's a `:filter FILTER', apply FILTER to the
813 menu-item's definition to get the real definition to
d5b3eb1b 814 use. */
3fc720e4 815 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
d5b3eb1b 816 if (EQ (XCAR (tem), QCfilter) && autoload)
3fc720e4
GM
817 {
818 Lisp_Object filter;
819 filter = XCAR (XCDR (tem));
820 filter = list2 (filter, list2 (Qquote, object));
821 object = menu_item_eval_property (filter);
822 break;
823 }
0403641f
RS
824 }
825 else
31bea176 826 /* Invalid keymap. */
b1314e15 827 return object;
0403641f
RS
828 }
829
b1314e15 830 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
2c6f1a39
JB
831 Keymap alist elements like (CHAR MENUSTRING . DEFN)
832 will be used by HierarKey menus. */
b1314e15 833 else if (STRINGP (XCAR (object)))
1a8c3f10 834 {
b1314e15 835 object = XCDR (object);
1a8c3f10
RS
836 /* Also remove a menu help string, if any,
837 following the menu item name. */
b1314e15
KH
838 if (CONSP (object) && STRINGP (XCAR (object)))
839 object = XCDR (object);
c6ec9f6e 840 /* Also remove the sublist that caches key equivalences, if any. */
b1314e15 841 if (CONSP (object) && CONSP (XCAR (object)))
ffab2bd6 842 {
c6ec9f6e 843 Lisp_Object carcar;
b1314e15 844 carcar = XCAR (XCAR (object));
c6ec9f6e 845 if (NILP (carcar) || VECTORP (carcar))
b1314e15 846 object = XCDR (object);
ffab2bd6 847 }
1a8c3f10 848 }
2c6f1a39 849
b1314e15
KH
850 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
851 else
a3fc8840 852 {
31bea176 853 struct gcpro gcpro1;
df75b1a3 854 Lisp_Object map;
31bea176 855 GCPRO1 (object);
02067692 856 map = get_keymap (Fcar_safe (object), 0, autoload);
31bea176 857 UNGCPRO;
02067692 858 return (!CONSP (map) ? object /* Invalid keymap */
db785038 859 : access_keymap (map, Fcdr (object), 0, 0, autoload));
a3fc8840 860 }
2c6f1a39
JB
861 }
862}
863
2d929694 864static Lisp_Object
2c6f1a39
JB
865store_in_keymap (keymap, idx, def)
866 Lisp_Object keymap;
867 register Lisp_Object idx;
868 register Lisp_Object def;
869{
1e7d1ab0
SM
870 /* Flush any reverse-map cache. */
871 where_is_cache = Qnil;
872 where_is_cache_keymaps = Qt;
873
dce4372a 874 /* If we are preparing to dump, and DEF is a menu element
a3fc8840
RS
875 with a menu item indicator, copy it to ensure it is not pure. */
876 if (CONSP (def) && PURE_P (def)
03699b14
KR
877 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
878 def = Fcons (XCAR (def), XCDR (def));
32ce36ad 879
54cbc3d4 880 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
f5b79c1c
JB
881 error ("attempt to define a key in a non-keymap");
882
2c6f1a39
JB
883 /* If idx is a list (some sort of mouse click, perhaps?),
884 the index we want to use is the car of the list, which
885 ought to be a symbol. */
cebd887d 886 idx = EVENT_HEAD (idx);
2c6f1a39 887
f5b79c1c
JB
888 /* If idx is a symbol, it might have modifiers, which need to
889 be put in the canonical order. */
416349ec 890 if (SYMBOLP (idx))
f5b79c1c 891 idx = reorder_modifiers (idx);
2732bdbb
RS
892 else if (INTEGERP (idx))
893 /* Clobber the high bits that can be present on a machine
894 with more than 24 bits of integer. */
6e344130 895 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
f5b79c1c
JB
896
897 /* Scan the keymap for a binding of idx. */
2c6f1a39 898 {
f5b79c1c 899 Lisp_Object tail;
2c6f1a39 900
f5b79c1c
JB
901 /* The cons after which we should insert new bindings. If the
902 keymap has a table element, we record its position here, so new
903 bindings will go after it; this way, the table will stay
904 towards the front of the alist and character lookups in dense
905 keymaps will remain fast. Otherwise, this just points at the
906 front of the keymap. */
e9b6dfb0 907 Lisp_Object insertion_point;
2c6f1a39 908
e9b6dfb0 909 insertion_point = keymap;
03699b14 910 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
2c6f1a39 911 {
e9b6dfb0 912 Lisp_Object elt;
f5b79c1c 913
03699b14 914 elt = XCAR (tail);
783a2838 915 if (VECTORP (elt))
f5b79c1c 916 {
49801145 917 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
f5b79c1c 918 {
49daa5b1 919 CHECK_IMPURE (elt);
49801145 920 ASET (elt, XFASTINT (idx), def);
f5b79c1c
JB
921 return def;
922 }
923 insertion_point = tail;
783a2838 924 }
0403641f
RS
925 else if (CHAR_TABLE_P (elt))
926 {
6418ea16
RS
927 /* Character codes with modifiers
928 are not included in a char-table.
929 All character codes without modifiers are included. */
4dc3eb25 930 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
0403641f 931 {
4dc3eb25
SM
932 Faset (elt, idx,
933 /* `nil' has a special meaning for char-tables, so
934 we use something else to record an explicitly
935 unbound entry. */
936 NILP (def) ? Qt : def);
0403641f
RS
937 return def;
938 }
939 insertion_point = tail;
940 }
783a2838
KH
941 else if (CONSP (elt))
942 {
03699b14 943 if (EQ (idx, XCAR (elt)))
f5b79c1c 944 {
49daa5b1 945 CHECK_IMPURE (elt);
f3fbd155 946 XSETCDR (elt, def);
f5b79c1c
JB
947 return def;
948 }
783a2838 949 }
49801145
SM
950 else if (EQ (elt, Qkeymap))
951 /* If we find a 'keymap' symbol in the spine of KEYMAP,
952 then we must have found the start of a second keymap
953 being used as the tail of KEYMAP, and a binding for IDX
954 should be inserted before it. */
955 goto keymap_end;
0188441d
JB
956
957 QUIT;
2c6f1a39 958 }
2c6f1a39 959
f5b79c1c
JB
960 keymap_end:
961 /* We have scanned the entire keymap, and not found a binding for
962 IDX. Let's add one. */
49daa5b1 963 CHECK_IMPURE (insertion_point);
f3fbd155
KR
964 XSETCDR (insertion_point,
965 Fcons (Fcons (idx, def), XCDR (insertion_point)));
f5b79c1c 966 }
31bea176 967
2c6f1a39
JB
968 return def;
969}
970
2b6748c0
SM
971EXFUN (Fcopy_keymap, 1);
972
31bea176
SM
973Lisp_Object
974copy_keymap_item (elt)
975 Lisp_Object elt;
976{
977 Lisp_Object res, tem;
978
979 if (!CONSP (elt))
980 return elt;
981
982 res = tem = elt;
983
984 /* Is this a new format menu item. */
985 if (EQ (XCAR (tem), Qmenu_item))
986 {
987 /* Copy cell with menu-item marker. */
988 res = elt = Fcons (XCAR (tem), XCDR (tem));
989 tem = XCDR (elt);
990 if (CONSP (tem))
991 {
992 /* Copy cell with menu-item name. */
993 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
994 elt = XCDR (elt);
995 tem = XCDR (elt);
996 }
997 if (CONSP (tem))
998 {
999 /* Copy cell with binding and if the binding is a keymap,
1000 copy that. */
1001 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1002 elt = XCDR (elt);
1003 tem = XCAR (elt);
1004 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1005 XSETCAR (elt, Fcopy_keymap (tem));
1006 tem = XCDR (elt);
1007 if (CONSP (tem) && CONSP (XCAR (tem)))
1008 /* Delete cache for key equivalences. */
1009 XSETCDR (elt, XCDR (tem));
1010 }
1011 }
1012 else
1013 {
1014 /* It may be an old fomat menu item.
1015 Skip the optional menu string. */
1016 if (STRINGP (XCAR (tem)))
1017 {
1018 /* Copy the cell, since copy-alist didn't go this deep. */
1019 res = elt = Fcons (XCAR (tem), XCDR (tem));
1020 tem = XCDR (elt);
1021 /* Also skip the optional menu help string. */
1022 if (CONSP (tem) && STRINGP (XCAR (tem)))
1023 {
1024 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1025 elt = XCDR (elt);
1026 tem = XCDR (elt);
1027 }
1028 /* There may also be a list that caches key equivalences.
1029 Just delete it for the new keymap. */
1030 if (CONSP (tem)
1031 && CONSP (XCAR (tem))
1032 && (NILP (XCAR (XCAR (tem)))
1033 || VECTORP (XCAR (XCAR (tem)))))
1034 {
1035 XSETCDR (elt, XCDR (tem));
1036 tem = XCDR (tem);
1037 }
1038 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1039 XSETCDR (elt, Fcopy_keymap (tem));
1040 }
1041 else if (EQ (XCAR (tem), Qkeymap))
1042 res = Fcopy_keymap (elt);
1043 }
1044 return res;
1045}
1046
80951487 1047static void
0403641f
RS
1048copy_keymap_1 (chartable, idx, elt)
1049 Lisp_Object chartable, idx, elt;
1050{
31bea176 1051 Faset (chartable, idx, copy_keymap_item (elt));
0403641f 1052}
f5b79c1c 1053
2c6f1a39 1054DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
335c5470
PJ
1055 doc: /* Return a copy of the keymap KEYMAP.
1056The copy starts out with the same definitions of KEYMAP,
1057but changing either the copy or KEYMAP does not affect the other.
1058Any key definitions that are subkeymaps are recursively copied.
1059However, a key definition which is a symbol whose definition is a keymap
1060is not copied. */)
1061 (keymap)
2c6f1a39
JB
1062 Lisp_Object keymap;
1063{
1064 register Lisp_Object copy, tail;
31bea176
SM
1065 keymap = get_keymap (keymap, 1, 0);
1066 copy = tail = Fcons (Qkeymap, Qnil);
1067 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
2c6f1a39 1068
31bea176 1069 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
2c6f1a39 1070 {
31bea176 1071 Lisp_Object elt = XCAR (keymap);
0403641f
RS
1072 if (CHAR_TABLE_P (elt))
1073 {
23cf1efa 1074 Lisp_Object indices[3];
0403641f 1075 elt = Fcopy_sequence (elt);
fe72189a 1076 map_char_table (copy_keymap_1, Qnil, elt, elt, elt, 0, indices);
0403641f
RS
1077 }
1078 else if (VECTORP (elt))
2c6f1a39 1079 {
f5b79c1c 1080 int i;
f5b79c1c 1081 elt = Fcopy_sequence (elt);
49801145 1082 for (i = 0; i < ASIZE (elt); i++)
31bea176 1083 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
d65a13c5 1084 }
31bea176
SM
1085 else if (CONSP (elt))
1086 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1087 XSETCDR (tail, Fcons (elt, Qnil));
1088 tail = XCDR (tail);
1089 keymap = XCDR (keymap);
2c6f1a39 1090 }
31bea176 1091 XSETCDR (tail, keymap);
2c6f1a39
JB
1092 return copy;
1093}
1094\f
cc0a8174
JB
1095/* Simple Keymap mutators and accessors. */
1096
21a0d7a0
RS
1097/* GC is possible in this function if it autoloads a keymap. */
1098
2c6f1a39 1099DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
2d772f45 1100 doc: /* In KEYMAP, define key sequence KEY as DEF.
0c412762
KS
1101KEYMAP is a keymap.
1102
1103KEY is a string or a vector of symbols and characters meaning a
1104sequence of keystrokes and events. Non-ASCII characters with codes
1105above 127 (such as ISO Latin-1) can be included if you use a vector.
bbc4541d 1106Using [t] for KEY creates a default definition, which applies to any
64239341 1107event type that has no other definition in this keymap.
0c412762 1108
335c5470
PJ
1109DEF is anything that can be a key's definition:
1110 nil (means key is undefined in this keymap),
f63fd14e 1111 a command (a Lisp function suitable for interactive calling),
335c5470
PJ
1112 a string (treated as a keyboard macro),
1113 a keymap (to define a prefix key),
f63fd14e 1114 a symbol (when the key is looked up, the symbol will stand for its
335c5470 1115 function definition, which should at that time be one of the above,
f63fd14e 1116 or another symbol whose function definition is used, etc.),
335c5470
PJ
1117 a cons (STRING . DEFN), meaning that DEFN is the definition
1118 (DEFN should be a valid definition in its own right),
f63fd14e 1119 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP.
335c5470 1120
3abeca61
KG
1121If KEYMAP is a sparse keymap with a binding for KEY, the existing
1122binding is altered. If there is no binding for KEY, the new pair
1123binding KEY to DEF is added at the front of KEYMAP. */)
335c5470 1124 (keymap, key, def)
d09b2024 1125 Lisp_Object keymap;
2c6f1a39
JB
1126 Lisp_Object key;
1127 Lisp_Object def;
1128{
1129 register int idx;
1130 register Lisp_Object c;
2c6f1a39
JB
1131 register Lisp_Object cmd;
1132 int metized = 0;
6ba6e250 1133 int meta_bit;
2c6f1a39 1134 int length;
d09b2024 1135 struct gcpro gcpro1, gcpro2, gcpro3;
2c6f1a39 1136
31bea176 1137 GCPRO3 (keymap, key, def);
02067692 1138 keymap = get_keymap (keymap, 1, 1);
2c6f1a39 1139
a1df473f 1140 if (!VECTORP (key) && !STRINGP (key))
31bea176 1141 key = wrong_type_argument (Qarrayp, key);
2c6f1a39 1142
d09b2024 1143 length = XFASTINT (Flength (key));
2c6f1a39 1144 if (length == 0)
31bea176 1145 RETURN_UNGCPRO (Qnil);
a1df473f 1146
107fd03d
RS
1147 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1148 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1149
31bea176 1150 meta_bit = VECTORP (key) ? meta_modifier : 0x80;
6ba6e250 1151
2c6f1a39
JB
1152 idx = 0;
1153 while (1)
1154 {
1155 c = Faref (key, make_number (idx));
1156
f09bc924 1157 if (CONSP (c) && lucid_event_type_list_p (c))
41015a19 1158 c = Fevent_convert_list (c);
f09bc924 1159
15fff01d
RS
1160 if (SYMBOLP (c))
1161 silly_event_symbol_error (c);
2fae9111 1162
416349ec 1163 if (INTEGERP (c)
6ba6e250 1164 && (XINT (c) & meta_bit)
2c6f1a39
JB
1165 && !metized)
1166 {
1167 c = meta_prefix_char;
1168 metized = 1;
1169 }
1170 else
1171 {
416349ec 1172 if (INTEGERP (c))
0b8fc2d4 1173 XSETINT (c, XINT (c) & ~meta_bit);
2c6f1a39
JB
1174
1175 metized = 0;
1176 idx++;
1177 }
1178
54cbc3d4 1179 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c))
2fae9111 1180 error ("Key sequence contains invalid event");
5907b863 1181
2c6f1a39 1182 if (idx == length)
d09b2024 1183 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
2c6f1a39 1184
db785038 1185 cmd = access_keymap (keymap, c, 0, 1, 1);
2c6f1a39 1186
c07aec97 1187 /* If this key is undefined, make it a prefix. */
265a9e55 1188 if (NILP (cmd))
c07aec97 1189 cmd = define_as_prefix (keymap, c);
2c6f1a39 1190
02067692
SM
1191 keymap = get_keymap (cmd, 0, 1);
1192 if (!CONSP (keymap))
e9b6dfb0
KH
1193 /* We must use Fkey_description rather than just passing key to
1194 error; key might be a vector, not a string. */
1195 error ("Key sequence %s uses invalid prefix characters",
f8d8ba40 1196 SDATA (Fkey_description (key, Qnil)));
2c6f1a39
JB
1197 }
1198}
1199
a1df473f
KS
1200/* This function may GC (it calls Fkey_binding). */
1201
023b93f6 1202DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 1, 0,
a1df473f 1203 doc: /* Return the remapping for command COMMAND in current keymaps.
078d0f38 1204Returns nil if COMMAND is not remapped (or not a symbol). */)
a1df473f
KS
1205 (command)
1206 Lisp_Object command;
1207{
078d0f38
KS
1208 if (!SYMBOLP (command))
1209 return Qnil;
1210
023b93f6
KS
1211 ASET (command_remapping_vector, 1, command);
1212 return Fkey_binding (command_remapping_vector, Qnil, Qt);
a1df473f
KS
1213}
1214
f0529b5b 1215/* Value is number if KEY is too long; nil if valid but has no definition. */
21a0d7a0 1216/* GC is possible in this function if it autoloads a keymap. */
2c6f1a39 1217
7c140252 1218DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
335c5470
PJ
1219 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1220nil means undefined. See doc of `define-key' for kinds of definitions.
1221
1222A number as value means KEY is "too long";
1223that is, characters or symbols in it except for the last one
1224fail to be a valid sequence of prefix characters in KEYMAP.
1225The number is how many characters at the front of KEY
49daa5b1 1226it takes to reach a non-prefix key.
335c5470
PJ
1227
1228Normally, `lookup-key' ignores bindings for t, which act as default
1229bindings, used when nothing else in the keymap applies; this makes it
1230usable as a general function for probing keymaps. However, if the
1231third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1232recognize the default bindings, just as `read-key-sequence' does. */)
1233 (keymap, key, accept_default)
31bea176 1234 Lisp_Object keymap;
2c6f1a39 1235 Lisp_Object key;
7c140252 1236 Lisp_Object accept_default;
2c6f1a39
JB
1237{
1238 register int idx;
2c6f1a39
JB
1239 register Lisp_Object cmd;
1240 register Lisp_Object c;
2c6f1a39 1241 int length;
54cbc3d4 1242 int t_ok = !NILP (accept_default);
31bea176 1243 struct gcpro gcpro1, gcpro2;
2c6f1a39 1244
31bea176 1245 GCPRO2 (keymap, key);
02067692 1246 keymap = get_keymap (keymap, 1, 1);
2c6f1a39 1247
416349ec 1248 if (!VECTORP (key) && !STRINGP (key))
2c6f1a39
JB
1249 key = wrong_type_argument (Qarrayp, key);
1250
d09b2024 1251 length = XFASTINT (Flength (key));
2c6f1a39 1252 if (length == 0)
31bea176 1253 RETURN_UNGCPRO (keymap);
21a0d7a0 1254
2c6f1a39
JB
1255 idx = 0;
1256 while (1)
1257 {
db785038 1258 c = Faref (key, make_number (idx++));
2c6f1a39 1259
f09bc924 1260 if (CONSP (c) && lucid_event_type_list_p (c))
41015a19 1261 c = Fevent_convert_list (c);
f09bc924 1262
db785038 1263 /* Turn the 8th bit of string chars into a meta modifier. */
38cbfed4 1264 if (INTEGERP (c) && XINT (c) & 0x80 && STRINGP (key))
db785038 1265 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
2c6f1a39 1266
5f245371
KS
1267 /* Allow string since binding for `menu-bar-select-buffer'
1268 includes the buffer name in the key sequence. */
1269 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
2fae9111
RS
1270 error ("Key sequence contains invalid event");
1271
db785038 1272 cmd = access_keymap (keymap, c, t_ok, 0, 1);
2c6f1a39 1273 if (idx == length)
21a0d7a0 1274 RETURN_UNGCPRO (cmd);
2c6f1a39 1275
02067692
SM
1276 keymap = get_keymap (cmd, 0, 1);
1277 if (!CONSP (keymap))
21a0d7a0 1278 RETURN_UNGCPRO (make_number (idx));
2c6f1a39 1279
2c6f1a39
JB
1280 QUIT;
1281 }
1282}
1283
c07aec97
RS
1284/* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1285 Assume that currently it does not define C at all.
1286 Return the keymap. */
1287
1288static Lisp_Object
1289define_as_prefix (keymap, c)
1290 Lisp_Object keymap, c;
1291{
db785038 1292 Lisp_Object cmd;
c07aec97
RS
1293
1294 cmd = Fmake_sparse_keymap (Qnil);
1295 /* If this key is defined as a prefix in an inherited keymap,
1296 make it a prefix in this map, and make its definition
1297 inherit the other prefix definition. */
db785038 1298 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
c07aec97
RS
1299 store_in_keymap (keymap, c, cmd);
1300
1301 return cmd;
1302}
1303
0b8fc2d4
RS
1304/* Append a key to the end of a key sequence. We always make a vector. */
1305
2c6f1a39
JB
1306Lisp_Object
1307append_key (key_sequence, key)
1308 Lisp_Object key_sequence, key;
1309{
1310 Lisp_Object args[2];
1311
1312 args[0] = key_sequence;
1313
0b8fc2d4
RS
1314 args[1] = Fcons (key, Qnil);
1315 return Fvconcat (2, args);
2c6f1a39
JB
1316}
1317
15fff01d
RS
1318/* Given a event type C which is a symbol,
1319 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1320
1321static void
1322silly_event_symbol_error (c)
1323 Lisp_Object c;
1324{
1325 Lisp_Object parsed, base, name, assoc;
1326 int modifiers;
744cd66b 1327
15fff01d
RS
1328 parsed = parse_modifiers (c);
1329 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1330 base = XCAR (parsed);
1331 name = Fsymbol_name (base);
1332 /* This alist includes elements such as ("RET" . "\\r"). */
1333 assoc = Fassoc (name, exclude_keys);
1334
1335 if (! NILP (assoc))
1336 {
1337 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1338 char *p = new_mods;
1339 Lisp_Object keystring;
1340 if (modifiers & alt_modifier)
1341 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1342 if (modifiers & ctrl_modifier)
1343 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1344 if (modifiers & hyper_modifier)
1345 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1346 if (modifiers & meta_modifier)
1347 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1348 if (modifiers & shift_modifier)
1349 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1350 if (modifiers & super_modifier)
1351 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1352 *p = 0;
1353
1354 c = reorder_modifiers (c);
1355 keystring = concat2 (build_string (new_mods), XCDR (assoc));
744cd66b 1356
15fff01d
RS
1357 error ((modifiers & ~meta_modifier
1358 ? "To bind the key %s, use [?%s], not [%s]"
1359 : "To bind the key %s, use \"%s\", not [%s]"),
d5db4077
KR
1360 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1361 SDATA (SYMBOL_NAME (c)));
15fff01d
RS
1362 }
1363}
2c6f1a39 1364\f
cc0a8174
JB
1365/* Global, local, and minor mode keymap stuff. */
1366
265a9e55 1367/* We can't put these variables inside current_minor_maps, since under
6bbbd9b0
JB
1368 some systems, static gets macro-defined to be the empty string.
1369 Ickypoo. */
cd6db61a
KS
1370static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1371static int cmm_size = 0;
265a9e55 1372
fbb90829
KH
1373/* Error handler used in current_minor_maps. */
1374static Lisp_Object
1375current_minor_maps_error ()
1376{
1377 return Qnil;
1378}
1379
cc0a8174
JB
1380/* Store a pointer to an array of the keymaps of the currently active
1381 minor modes in *buf, and return the number of maps it contains.
1382
1383 This function always returns a pointer to the same buffer, and may
1384 free or reallocate it, so if you want to keep it for a long time or
1385 hand it out to lisp code, copy it. This procedure will be called
1386 for every key sequence read, so the nice lispy approach (return a
1387 new assoclist, list, what have you) for each invocation would
1388 result in a lot of consing over time.
1389
1390 If we used xrealloc/xmalloc and ran out of memory, they would throw
1391 back to the command loop, which would try to read a key sequence,
1392 which would call this function again, resulting in an infinite
1393 loop. Instead, we'll use realloc/malloc and silently truncate the
1394 list, let the key sequence be read, and hope some other piece of
1395 code signals the error. */
1396int
1397current_minor_maps (modeptr, mapptr)
1398 Lisp_Object **modeptr, **mapptr;
1399{
cc0a8174 1400 int i = 0;
dd9cda06 1401 int list_number = 0;
6bbbd9b0 1402 Lisp_Object alist, assoc, var, val;
99cbcaca 1403 Lisp_Object emulation_alists;
dd9cda06
RS
1404 Lisp_Object lists[2];
1405
99cbcaca 1406 emulation_alists = Vemulation_mode_map_alists;
dd9cda06
RS
1407 lists[0] = Vminor_mode_overriding_map_alist;
1408 lists[1] = Vminor_mode_map_alist;
1409
1410 for (list_number = 0; list_number < 2; list_number++)
99cbcaca
KS
1411 {
1412 if (CONSP (emulation_alists))
dd9cda06 1413 {
99cbcaca
KS
1414 alist = XCAR (emulation_alists);
1415 emulation_alists = XCDR (emulation_alists);
1416 if (SYMBOLP (alist))
1417 alist = find_symbol_value (alist);
1418 list_number = -1;
1419 }
1420 else
1421 alist = lists[list_number];
cc0a8174 1422
99cbcaca
KS
1423 for ( ; CONSP (alist); alist = XCDR (alist))
1424 if ((assoc = XCAR (alist), CONSP (assoc))
1425 && (var = XCAR (assoc), SYMBOLP (var))
1426 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1427 && !NILP (val))
1428 {
1429 Lisp_Object temp;
64dd3629 1430
99cbcaca
KS
1431 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1432 and also an entry in Vminor_mode_map_alist,
1433 ignore the latter. */
1434 if (list_number == 1)
1435 {
1436 val = assq_no_quit (var, lists[0]);
1437 if (!NILP (val))
1438 continue;
1439 }
cc0a8174 1440
99cbcaca
KS
1441 if (i >= cmm_size)
1442 {
cd6db61a 1443 int newsize, allocsize;
99cbcaca 1444 Lisp_Object *newmodes, *newmaps;
cc0a8174 1445
cd6db61a
KS
1446 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1447 allocsize = newsize * sizeof *newmodes;
1448
744cd66b 1449 /* Use malloc here. See the comment above this function.
cd6db61a
KS
1450 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1451 BLOCK_INPUT;
1452 newmodes = (Lisp_Object *) malloc (allocsize);
1453 if (newmodes)
99cbcaca 1454 {
cd6db61a
KS
1455 if (cmm_modes)
1456 {
1457 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1458 free (cmm_modes);
1459 }
1460 cmm_modes = newmodes;
99cbcaca
KS
1461 }
1462
cd6db61a 1463 newmaps = (Lisp_Object *) malloc (allocsize);
99cbcaca 1464 if (newmaps)
cd6db61a
KS
1465 {
1466 if (cmm_maps)
1467 {
1468 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1469 free (cmm_maps);
1470 }
1471 cmm_maps = newmaps;
1472 }
1473 UNBLOCK_INPUT;
744cd66b 1474
99cbcaca
KS
1475 if (newmodes == NULL || newmaps == NULL)
1476 break;
cd6db61a 1477 cmm_size = newsize;
99cbcaca 1478 }
fbb90829 1479
99cbcaca
KS
1480 /* Get the keymap definition--or nil if it is not defined. */
1481 temp = internal_condition_case_1 (Findirect_function,
1482 XCDR (assoc),
1483 Qerror, current_minor_maps_error);
1484 if (!NILP (temp))
1485 {
1486 cmm_modes[i] = var;
1487 cmm_maps [i] = temp;
1488 i++;
1489 }
1490 }
1491 }
cc0a8174 1492
265a9e55
JB
1493 if (modeptr) *modeptr = cmm_modes;
1494 if (mapptr) *mapptr = cmm_maps;
cc0a8174
JB
1495 return i;
1496}
1497
54cbc3d4 1498DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
335c5470
PJ
1499 0, 1, 0,
1500 doc: /* Return a list of the currently active keymaps.
1501OLP if non-nil indicates that we should obey `overriding-local-map' and
1502`overriding-terminal-local-map'. */)
54cbc3d4
SM
1503 (olp)
1504 Lisp_Object olp;
1505{
1506 Lisp_Object keymaps = Fcons (current_global_map, Qnil);
1507
1508 if (!NILP (olp))
1509 {
54cbc3d4
SM
1510 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1511 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
d64cdc59
RS
1512 /* The doc said that overriding-terminal-local-map should
1513 override overriding-local-map. The code used them both,
1514 but it seems clearer to use just one. rms, jan 2005. */
1515 else if (!NILP (Voverriding_local_map))
1516 keymaps = Fcons (Voverriding_local_map, keymaps);
54cbc3d4
SM
1517 }
1518 if (NILP (XCDR (keymaps)))
1519 {
1520 Lisp_Object local;
1521 Lisp_Object *maps;
1522 int nmaps, i;
1523
d64cdc59
RS
1524 /* This usually returns the buffer's local map,
1525 but that can be overridden by a `local-map' property. */
54cbc3d4
SM
1526 local = get_local_map (PT, current_buffer, Qlocal_map);
1527 if (!NILP (local))
1528 keymaps = Fcons (local, keymaps);
1529
d64cdc59 1530 /* Now put all the minor mode keymaps on the list. */
54cbc3d4
SM
1531 nmaps = current_minor_maps (0, &maps);
1532
1533 for (i = --nmaps; i >= 0; i--)
1534 if (!NILP (maps[i]))
1535 keymaps = Fcons (maps[i], keymaps);
d1d070e3 1536
d64cdc59 1537 /* This returns nil unless there is a `keymap' property. */
d1d070e3
RS
1538 local = get_local_map (PT, current_buffer, Qkeymap);
1539 if (!NILP (local))
1540 keymaps = Fcons (local, keymaps);
54cbc3d4 1541 }
31bea176 1542
54cbc3d4
SM
1543 return keymaps;
1544}
1545
21a0d7a0
RS
1546/* GC is possible in this function if it autoloads a keymap. */
1547
0c412762 1548DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 3, 0,
335c5470
PJ
1549 doc: /* Return the binding for command KEY in current keymaps.
1550KEY is a string or vector, a sequence of keystrokes.
1551The binding is probably a symbol with a function definition.
1552
1553Normally, `key-binding' ignores bindings for t, which act as default
1554bindings, used when nothing else in the keymap applies; this makes it
1555usable as a general function for probing keymaps. However, if the
1556optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
0c412762
KS
1557recognize the default bindings, just as `read-key-sequence' does.
1558
1559Like the normal command loop, `key-binding' will remap the command
1560resulting from looking up KEY by looking up the command in the
35936c5c 1561current keymaps. However, if the optional third argument NO-REMAP
0c412762
KS
1562is non-nil, `key-binding' returns the unmapped command. */)
1563 (key, accept_default, no_remap)
1564 Lisp_Object key, accept_default, no_remap;
2c6f1a39 1565{
cc0a8174
JB
1566 Lisp_Object *maps, value;
1567 int nmaps, i;
21a0d7a0
RS
1568 struct gcpro gcpro1;
1569
1570 GCPRO1 (key);
cc0a8174 1571
e784236d
KH
1572 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1573 {
1574 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1575 key, accept_default);
1576 if (! NILP (value) && !INTEGERP (value))
0c412762 1577 goto done;
e784236d
KH
1578 }
1579 else if (!NILP (Voverriding_local_map))
2c6f1a39 1580 {
7d92e329 1581 value = Flookup_key (Voverriding_local_map, key, accept_default);
416349ec 1582 if (! NILP (value) && !INTEGERP (value))
0c412762 1583 goto done;
2c6f1a39 1584 }
7d92e329 1585 else
744cd66b 1586 {
d964248c
KH
1587 Lisp_Object local;
1588
d1d070e3
RS
1589 local = get_local_map (PT, current_buffer, Qkeymap);
1590 if (! NILP (local))
1591 {
1592 value = Flookup_key (local, key, accept_default);
1593 if (! NILP (value) && !INTEGERP (value))
0c412762 1594 goto done;
d1d070e3
RS
1595 }
1596
7d92e329 1597 nmaps = current_minor_maps (0, &maps);
21a0d7a0
RS
1598 /* Note that all these maps are GCPRO'd
1599 in the places where we found them. */
1600
7d92e329
RS
1601 for (i = 0; i < nmaps; i++)
1602 if (! NILP (maps[i]))
1603 {
1604 value = Flookup_key (maps[i], key, accept_default);
416349ec 1605 if (! NILP (value) && !INTEGERP (value))
0c412762 1606 goto done;
7d92e329
RS
1607 }
1608
4956d1ef 1609 local = get_local_map (PT, current_buffer, Qlocal_map);
d964248c 1610 if (! NILP (local))
7d92e329 1611 {
d964248c 1612 value = Flookup_key (local, key, accept_default);
416349ec 1613 if (! NILP (value) && !INTEGERP (value))
0c412762 1614 goto done;
7d92e329
RS
1615 }
1616 }
cc0a8174 1617
7c140252 1618 value = Flookup_key (current_global_map, key, accept_default);
0c412762
KS
1619
1620 done:
21a0d7a0 1621 UNGCPRO;
0c412762
KS
1622 if (NILP (value) || INTEGERP (value))
1623 return Qnil;
1624
1625 /* If the result of the ordinary keymap lookup is an interactive
1626 command, look for a key binding (ie. remapping) for that command. */
744cd66b 1627
a1df473f 1628 if (NILP (no_remap) && SYMBOLP (value))
0c412762
KS
1629 {
1630 Lisp_Object value1;
023b93f6 1631 if (value1 = Fcommand_remapping (value), !NILP (value1))
0c412762
KS
1632 value = value1;
1633 }
744cd66b 1634
0c412762 1635 return value;
2c6f1a39
JB
1636}
1637
21a0d7a0
RS
1638/* GC is possible in this function if it autoloads a keymap. */
1639
7c140252 1640DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
335c5470 1641 doc: /* Return the binding for command KEYS in current local keymap only.
7a093e87 1642KEYS is a string or vector, a sequence of keystrokes.
335c5470
PJ
1643The binding is probably a symbol with a function definition.
1644
1645If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1646bindings; see the description of `lookup-key' for more details about this. */)
1647 (keys, accept_default)
7c140252 1648 Lisp_Object keys, accept_default;
2c6f1a39
JB
1649{
1650 register Lisp_Object map;
1651 map = current_buffer->keymap;
265a9e55 1652 if (NILP (map))
2c6f1a39 1653 return Qnil;
7c140252 1654 return Flookup_key (map, keys, accept_default);
2c6f1a39
JB
1655}
1656
21a0d7a0
RS
1657/* GC is possible in this function if it autoloads a keymap. */
1658
7c140252 1659DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
335c5470 1660 doc: /* Return the binding for command KEYS in current global keymap only.
7a093e87 1661KEYS is a string or vector, a sequence of keystrokes.
335c5470 1662The binding is probably a symbol with a function definition.
23715ea6 1663This function's return values are the same as those of `lookup-key'
335c5470
PJ
1664\(which see).
1665
1666If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1667bindings; see the description of `lookup-key' for more details about this. */)
1668 (keys, accept_default)
7c140252 1669 Lisp_Object keys, accept_default;
2c6f1a39 1670{
7c140252 1671 return Flookup_key (current_global_map, keys, accept_default);
2c6f1a39
JB
1672}
1673
21a0d7a0
RS
1674/* GC is possible in this function if it autoloads a keymap. */
1675
7c140252 1676DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
335c5470 1677 doc: /* Find the visible minor mode bindings of KEY.
15fbe81f 1678Return an alist of pairs (MODENAME . BINDING), where MODENAME is
335c5470
PJ
1679the symbol which names the minor mode binding KEY, and BINDING is
1680KEY's definition in that mode. In particular, if KEY has no
1681minor-mode bindings, return nil. If the first binding is a
1682non-prefix, all subsequent bindings will be omitted, since they would
1683be ignored. Similarly, the list doesn't include non-prefix bindings
1684that come after prefix bindings.
1685
1686If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1687bindings; see the description of `lookup-key' for more details about this. */)
1688 (key, accept_default)
7c140252 1689 Lisp_Object key, accept_default;
cc0a8174
JB
1690{
1691 Lisp_Object *modes, *maps;
1692 int nmaps;
1693 Lisp_Object binding;
1694 int i, j;
21a0d7a0 1695 struct gcpro gcpro1, gcpro2;
cc0a8174
JB
1696
1697 nmaps = current_minor_maps (&modes, &maps);
21a0d7a0
RS
1698 /* Note that all these maps are GCPRO'd
1699 in the places where we found them. */
1700
1701 binding = Qnil;
1702 GCPRO2 (key, binding);
cc0a8174
JB
1703
1704 for (i = j = 0; i < nmaps; i++)
02067692
SM
1705 if (!NILP (maps[i])
1706 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
416349ec 1707 && !INTEGERP (binding))
cc0a8174 1708 {
02067692 1709 if (KEYMAPP (binding))
cc0a8174
JB
1710 maps[j++] = Fcons (modes[i], binding);
1711 else if (j == 0)
21a0d7a0 1712 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
cc0a8174
JB
1713 }
1714
21a0d7a0 1715 UNGCPRO;
cc0a8174
JB
1716 return Flist (j, maps);
1717}
1718
7f8f0e67 1719DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
335c5470
PJ
1720 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1721A new sparse keymap is stored as COMMAND's function definition and its value.
1722If a second optional argument MAPVAR is given, the map is stored as
1723its value instead of as COMMAND's value; but COMMAND is still defined
1724as a function.
1725The third optional argument NAME, if given, supplies a menu name
a523ade4
LT
1726string for the map. This is required to use the keymap as a menu.
1727This function returns COMMAND. */)
335c5470 1728 (command, mapvar, name)
7f8f0e67 1729 Lisp_Object command, mapvar, name;
2c6f1a39
JB
1730{
1731 Lisp_Object map;
7f8f0e67 1732 map = Fmake_sparse_keymap (name);
88539837 1733 Ffset (command, map);
265a9e55 1734 if (!NILP (mapvar))
2c6f1a39
JB
1735 Fset (mapvar, map);
1736 else
88539837
EN
1737 Fset (command, map);
1738 return command;
2c6f1a39
JB
1739}
1740
1741DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
335c5470
PJ
1742 doc: /* Select KEYMAP as the global keymap. */)
1743 (keymap)
2c6f1a39
JB
1744 Lisp_Object keymap;
1745{
02067692 1746 keymap = get_keymap (keymap, 1, 1);
2c6f1a39 1747 current_global_map = keymap;
6f27e7a2 1748
2c6f1a39
JB
1749 return Qnil;
1750}
1751
1752DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
335c5470
PJ
1753 doc: /* Select KEYMAP as the local keymap.
1754If KEYMAP is nil, that means no local keymap. */)
1755 (keymap)
2c6f1a39
JB
1756 Lisp_Object keymap;
1757{
265a9e55 1758 if (!NILP (keymap))
02067692 1759 keymap = get_keymap (keymap, 1, 1);
2c6f1a39
JB
1760
1761 current_buffer->keymap = keymap;
1762
1763 return Qnil;
1764}
1765
1766DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
335c5470
PJ
1767 doc: /* Return current buffer's local keymap, or nil if it has none. */)
1768 ()
2c6f1a39
JB
1769{
1770 return current_buffer->keymap;
1771}
1772
1773DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
335c5470
PJ
1774 doc: /* Return the current global keymap. */)
1775 ()
2c6f1a39
JB
1776{
1777 return current_global_map;
1778}
cc0a8174
JB
1779
1780DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
335c5470
PJ
1781 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
1782 ()
cc0a8174
JB
1783{
1784 Lisp_Object *maps;
1785 int nmaps = current_minor_maps (0, &maps);
1786
1787 return Flist (nmaps, maps);
1788}
2c6f1a39 1789\f
cc0a8174
JB
1790/* Help functions for describing and documenting keymaps. */
1791
54cbc3d4
SM
1792
1793static void
1794accessible_keymaps_1 (key, cmd, maps, tail, thisseq, is_metized)
1795 Lisp_Object maps, tail, thisseq, key, cmd;
1796 int is_metized; /* If 1, `key' is assumed to be INTEGERP. */
1797{
1798 Lisp_Object tem;
1799
73a4675c 1800 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
54cbc3d4
SM
1801 if (NILP (cmd))
1802 return;
1803
73a4675c
SM
1804 /* Look for and break cycles. */
1805 while (!NILP (tem = Frassq (cmd, maps)))
54cbc3d4 1806 {
73a4675c
SM
1807 Lisp_Object prefix = XCAR (tem);
1808 int lim = XINT (Flength (XCAR (tem)));
1809 if (lim <= XINT (Flength (thisseq)))
1810 { /* This keymap was already seen with a smaller prefix. */
1811 int i = 0;
1812 while (i < lim && EQ (Faref (prefix, make_number (i)),
1813 Faref (thisseq, make_number (i))))
1814 i++;
1815 if (i >= lim)
1816 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1817 return;
54cbc3d4 1818 }
73a4675c
SM
1819 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1820 but maybe `cmd' occurs again further down in `maps', so keep
1821 looking. */
1822 maps = XCDR (Fmemq (tem, maps));
1823 }
1824
1825 /* If the last key in thisseq is meta-prefix-char,
1826 turn it into a meta-ized keystroke. We know
1827 that the event we're about to append is an
1828 ascii keystroke since we're processing a
1829 keymap table. */
1830 if (is_metized)
1831 {
1832 int meta_bit = meta_modifier;
1833 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
1834 tem = Fcopy_sequence (thisseq);
f8d8ba40 1835
73a4675c 1836 Faset (tem, last, make_number (XINT (key) | meta_bit));
f8d8ba40 1837
73a4675c
SM
1838 /* This new sequence is the same length as
1839 thisseq, so stick it in the list right
1840 after this one. */
1841 XSETCDR (tail,
1842 Fcons (Fcons (tem, cmd), XCDR (tail)));
1843 }
1844 else
1845 {
1846 tem = append_key (thisseq, key);
1847 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
54cbc3d4
SM
1848 }
1849}
1850
1851static void
1852accessible_keymaps_char_table (args, index, cmd)
1853 Lisp_Object args, index, cmd;
1854{
1855 accessible_keymaps_1 (index, cmd,
1856 XCAR (XCAR (args)),
1857 XCAR (XCDR (args)),
1858 XCDR (XCDR (args)),
1859 XINT (XCDR (XCAR (args))));
1860}
0403641f 1861
21a0d7a0
RS
1862/* This function cannot GC. */
1863
2c6f1a39 1864DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
335c5470
PJ
1865 1, 2, 0,
1866 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
1867Returns a list of elements of the form (KEYS . MAP), where the sequence
1868KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1869so that the KEYS increase in length. The first element is ([] . KEYMAP).
1870An optional argument PREFIX, if non-nil, should be a key sequence;
1871then the value includes only maps for prefixes that start with PREFIX. */)
1872 (keymap, prefix)
88539837 1873 Lisp_Object keymap, prefix;
2c6f1a39 1874{
fad865a3 1875 Lisp_Object maps, tail;
53c8f9fa
RS
1876 int prefixlen = 0;
1877
21a0d7a0
RS
1878 /* no need for gcpro because we don't autoload any keymaps. */
1879
53c8f9fa
RS
1880 if (!NILP (prefix))
1881 prefixlen = XINT (Flength (prefix));
2c6f1a39 1882
44a4a59b
RS
1883 if (!NILP (prefix))
1884 {
1885 /* If a prefix was specified, start with the keymap (if any) for
1886 that prefix, so we don't waste time considering other prefixes. */
1887 Lisp_Object tem;
88539837 1888 tem = Flookup_key (keymap, prefix, Qt);
1ae2097f
RS
1889 /* Flookup_key may give us nil, or a number,
1890 if the prefix is not defined in this particular map.
1891 It might even give us a list that isn't a keymap. */
02067692
SM
1892 tem = get_keymap (tem, 0, 0);
1893 if (CONSP (tem))
67fc16a3
RS
1894 {
1895 /* Convert PREFIX to a vector now, so that later on
1896 we don't have to deal with the possibility of a string. */
1897 if (STRINGP (prefix))
1898 {
f3ba5409 1899 int i, i_byte, c;
67fc16a3
RS
1900 Lisp_Object copy;
1901
d5db4077
KR
1902 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
1903 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
67fc16a3 1904 {
f3ba5409 1905 int i_before = i;
54e03a4a
KH
1906
1907 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
1908 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1909 c ^= 0200 | meta_modifier;
49801145 1910 ASET (copy, i_before, make_number (c));
67fc16a3
RS
1911 }
1912 prefix = copy;
1913 }
1914 maps = Fcons (Fcons (prefix, tem), Qnil);
1915 }
44a4a59b
RS
1916 else
1917 return Qnil;
1918 }
1919 else
1920 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
02067692 1921 get_keymap (keymap, 1, 0)),
44a4a59b 1922 Qnil);
2c6f1a39
JB
1923
1924 /* For each map in the list maps,
1925 look at any other maps it points to,
1926 and stick them at the end if they are not already in the list.
1927
1928 This is a breadth-first traversal, where tail is the queue of
1929 nodes, and maps accumulates a list of all nodes visited. */
1930
03699b14 1931 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2c6f1a39 1932 {
e9b6dfb0
KH
1933 register Lisp_Object thisseq, thismap;
1934 Lisp_Object last;
2c6f1a39 1935 /* Does the current sequence end in the meta-prefix-char? */
e9b6dfb0
KH
1936 int is_metized;
1937
1938 thisseq = Fcar (Fcar (tail));
1939 thismap = Fcdr (Fcar (tail));
1940 last = make_number (XINT (Flength (thisseq)) - 1);
1941 is_metized = (XINT (last) >= 0
97ae4b89
RS
1942 /* Don't metize the last char of PREFIX. */
1943 && XINT (last) >= prefixlen
e9b6dfb0 1944 && EQ (Faref (thisseq, last), meta_prefix_char));
2c6f1a39 1945
03699b14 1946 for (; CONSP (thismap); thismap = XCDR (thismap))
2c6f1a39 1947 {
e9b6dfb0
KH
1948 Lisp_Object elt;
1949
03699b14 1950 elt = XCAR (thismap);
2c6f1a39 1951
f5b79c1c
JB
1952 QUIT;
1953
0403641f
RS
1954 if (CHAR_TABLE_P (elt))
1955 {
23cf1efa 1956 Lisp_Object indices[3];
0403641f 1957
fe72189a 1958 map_char_table (accessible_keymaps_char_table, Qnil, elt,
fc18e547 1959 elt, Fcons (Fcons (maps, make_number (is_metized)),
f58c6494 1960 Fcons (tail, thisseq)),
0403641f
RS
1961 0, indices);
1962 }
1963 else if (VECTORP (elt))
2c6f1a39
JB
1964 {
1965 register int i;
1966
1967 /* Vector keymap. Scan all the elements. */
49801145 1968 for (i = 0; i < ASIZE (elt); i++)
54cbc3d4
SM
1969 accessible_keymaps_1 (make_number (i), AREF (elt, i),
1970 maps, tail, thisseq, is_metized);
31bea176 1971
0403641f 1972 }
f5b79c1c 1973 else if (CONSP (elt))
54cbc3d4
SM
1974 accessible_keymaps_1 (XCAR (elt), XCDR (elt),
1975 maps, tail, thisseq,
1976 is_metized && INTEGERP (XCAR (elt)));
31bea176 1977
2c6f1a39 1978 }
2c6f1a39
JB
1979 }
1980
73a4675c 1981 return maps;
2c6f1a39 1982}
0403641f 1983\f
2c6f1a39
JB
1984Lisp_Object Qsingle_key_description, Qkey_description;
1985
21a0d7a0
RS
1986/* This function cannot GC. */
1987
f8d8ba40 1988DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
335c5470 1989 doc: /* Return a pretty description of key-sequence KEYS.
f8d8ba40 1990Optional arg PREFIX is the sequence of keys leading up to KEYS.
23715ea6 1991Control characters turn into "C-foo" sequences, meta into "M-foo",
335c5470 1992spaces are put between sequence elements, etc. */)
f8d8ba40
KS
1993 (keys, prefix)
1994 Lisp_Object keys, prefix;
2c6f1a39 1995{
6bbd7a29 1996 int len = 0;
f3ba5409 1997 int i, i_byte;
f8d8ba40 1998 Lisp_Object *args;
07f60146 1999 int size = XINT (Flength (keys));
f8d8ba40
KS
2000 Lisp_Object list;
2001 Lisp_Object sep = build_string (" ");
2002 Lisp_Object key;
2003 int add_meta = 0;
2004
2005 if (!NILP (prefix))
07f60146 2006 size += XINT (Flength (prefix));
f8d8ba40
KS
2007
2008 /* This has one extra element at the end that we don't pass to Fconcat. */
2009 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2010
2011 /* In effect, this computes
2012 (mapconcat 'single-key-description keys " ")
2013 but we shouldn't use mapconcat because it can do GC. */
4c7d5f13 2014
f8d8ba40
KS
2015 next_list:
2016 if (!NILP (prefix))
2017 list = prefix, prefix = Qnil;
2018 else if (!NILP (keys))
2019 list = keys, keys = Qnil;
2020 else
6ba6e250 2021 {
f8d8ba40 2022 if (add_meta)
6ba6e250 2023 {
f8d8ba40
KS
2024 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2025 len += 2;
6ba6e250 2026 }
f8d8ba40
KS
2027 else if (len == 0)
2028 return empty_string;
2029 return Fconcat (len - 1, args);
6ba6e250 2030 }
4c7d5f13 2031
f8d8ba40
KS
2032 if (STRINGP (list))
2033 size = SCHARS (list);
2034 else if (VECTORP (list))
2035 size = XVECTOR (list)->size;
2036 else if (CONSP (list))
07f60146 2037 size = XINT (Flength (list));
f8d8ba40
KS
2038 else
2039 wrong_type_argument (Qarrayp, list);
4c7d5f13 2040
f8d8ba40 2041 i = i_byte = 0;
4c7d5f13 2042
f8d8ba40
KS
2043 while (i < size)
2044 {
2045 if (STRINGP (list))
5c9c2c3f 2046 {
f8d8ba40
KS
2047 int c;
2048 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2049 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2050 c ^= 0200 | meta_modifier;
2051 XSETFASTINT (key, c);
2052 }
2053 else if (VECTORP (list))
2054 {
2055 key = AREF (list, i++);
2056 }
2057 else
2058 {
2059 key = XCAR (list);
2060 list = XCDR (list);
2061 i++;
5c9c2c3f 2062 }
5c9c2c3f 2063
f8d8ba40
KS
2064 if (add_meta)
2065 {
2066 if (!INTEGERP (key)
2067 || EQ (key, meta_prefix_char)
2068 || (XINT (key) & meta_modifier))
2069 {
2070 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2071 args[len++] = sep;
2072 if (EQ (key, meta_prefix_char))
2073 continue;
2074 }
2075 else
2076 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2077 add_meta = 0;
2078 }
2079 else if (EQ (key, meta_prefix_char))
5c9c2c3f 2080 {
f8d8ba40
KS
2081 add_meta = 1;
2082 continue;
5c9c2c3f 2083 }
f8d8ba40
KS
2084 args[len++] = Fsingle_key_description (key, Qnil);
2085 args[len++] = sep;
4c7d5f13 2086 }
f8d8ba40 2087 goto next_list;
2c6f1a39
JB
2088}
2089
f8d8ba40 2090
2c6f1a39 2091char *
f1cb0a25 2092push_key_description (c, p, force_multibyte)
2c6f1a39
JB
2093 register unsigned int c;
2094 register char *p;
f1cb0a25 2095 int force_multibyte;
2c6f1a39 2096{
bc89c609 2097 unsigned c2;
31bea176 2098
71ac885b
RS
2099 /* Clear all the meaningless bits above the meta bit. */
2100 c &= meta_modifier | ~ - meta_modifier;
bc89c609
GM
2101 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2102 | meta_modifier | shift_modifier | super_modifier);
71ac885b 2103
6ba6e250
RS
2104 if (c & alt_modifier)
2105 {
2106 *p++ = 'A';
2107 *p++ = '-';
2108 c -= alt_modifier;
2109 }
bc89c609
GM
2110 if ((c & ctrl_modifier) != 0
2111 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
6ba6e250
RS
2112 {
2113 *p++ = 'C';
2114 *p++ = '-';
bc89c609 2115 c &= ~ctrl_modifier;
6ba6e250
RS
2116 }
2117 if (c & hyper_modifier)
2118 {
2119 *p++ = 'H';
2120 *p++ = '-';
2121 c -= hyper_modifier;
2122 }
2123 if (c & meta_modifier)
2c6f1a39
JB
2124 {
2125 *p++ = 'M';
2126 *p++ = '-';
6ba6e250
RS
2127 c -= meta_modifier;
2128 }
2129 if (c & shift_modifier)
2130 {
2131 *p++ = 'S';
2132 *p++ = '-';
2133 c -= shift_modifier;
2134 }
2135 if (c & super_modifier)
2136 {
2137 *p++ = 's';
2138 *p++ = '-';
2139 c -= super_modifier;
2c6f1a39
JB
2140 }
2141 if (c < 040)
2142 {
2143 if (c == 033)
2144 {
2145 *p++ = 'E';
2146 *p++ = 'S';
2147 *p++ = 'C';
2148 }
6ba6e250 2149 else if (c == '\t')
2c6f1a39
JB
2150 {
2151 *p++ = 'T';
2152 *p++ = 'A';
2153 *p++ = 'B';
2154 }
b8cab006 2155 else if (c == Ctl ('M'))
2c6f1a39
JB
2156 {
2157 *p++ = 'R';
2158 *p++ = 'E';
2159 *p++ = 'T';
2160 }
2161 else
2162 {
bc89c609 2163 /* `C-' already added above. */
2c6f1a39
JB
2164 if (c > 0 && c <= Ctl ('Z'))
2165 *p++ = c + 0140;
2166 else
2167 *p++ = c + 0100;
2168 }
2169 }
2170 else if (c == 0177)
2171 {
2172 *p++ = 'D';
2173 *p++ = 'E';
2174 *p++ = 'L';
2175 }
2176 else if (c == ' ')
9fb71293 2177 {
2c6f1a39
JB
2178 *p++ = 'S';
2179 *p++ = 'P';
2180 *p++ = 'C';
2181 }
d3c00496
KH
2182 else if (c < 128
2183 || (NILP (current_buffer->enable_multibyte_characters)
f1cb0a25
GM
2184 && SINGLE_BYTE_CHAR_P (c)
2185 && !force_multibyte))
2186 {
2187 *p++ = c;
2188 }
6ba6e250
RS
2189 else
2190 {
f1cb0a25 2191 int valid_p = SINGLE_BYTE_CHAR_P (c) || char_valid_p (c, 0);
31bea176 2192
f1cb0a25
GM
2193 if (force_multibyte && valid_p)
2194 {
2195 if (SINGLE_BYTE_CHAR_P (c))
2196 c = unibyte_char_to_multibyte (c);
2197 p += CHAR_STRING (c, p);
2198 }
2199 else if (NILP (current_buffer->enable_multibyte_characters)
2200 || valid_p)
9fb71293
KH
2201 {
2202 int bit_offset;
2203 *p++ = '\\';
2204 /* The biggest character code uses 19 bits. */
2205 for (bit_offset = 18; bit_offset >= 0; bit_offset -= 3)
2206 {
2207 if (c >= (1 << bit_offset))
2208 *p++ = ((c & (7 << bit_offset)) >> bit_offset) + '0';
2209 }
2210 }
2211 else
f1cb0a25 2212 p += CHAR_STRING (c, p);
6ba6e250 2213 }
2c6f1a39 2214
d55627cc 2215 return p;
2c6f1a39
JB
2216}
2217
21a0d7a0
RS
2218/* This function cannot GC. */
2219
c1848a97
GM
2220DEFUN ("single-key-description", Fsingle_key_description,
2221 Ssingle_key_description, 1, 2, 0,
335c5470
PJ
2222 doc: /* Return a pretty description of command character KEY.
2223Control characters turn into C-whatever, etc.
2224Optional argument NO-ANGLES non-nil means don't put angle brackets
2225around function keys and event symbols. */)
2226 (key, no_angles)
c1848a97 2227 Lisp_Object key, no_angles;
2c6f1a39 2228{
5c9c2c3f
RS
2229 if (CONSP (key) && lucid_event_type_list_p (key))
2230 key = Fevent_convert_list (key);
2231
cebd887d 2232 key = EVENT_HEAD (key);
6bbbd9b0 2233
e958fd9a 2234 if (INTEGERP (key)) /* Normal character */
2c6f1a39 2235 {
47a18cef 2236 unsigned int charset, c1, c2;
f4977051 2237 int without_bits = XINT (key) & ~((-1) << CHARACTERBITS);
47a18cef 2238
f4977051 2239 if (SINGLE_BYTE_CHAR_P (without_bits))
47a18cef
RS
2240 charset = 0;
2241 else
54e03a4a 2242 SPLIT_CHAR (without_bits, charset, c1, c2);
47a18cef
RS
2243
2244 if (charset
9fb71293 2245 && CHARSET_DEFINED_P (charset)
47a18cef
RS
2246 && ((c1 >= 0 && c1 < 32)
2247 || (c2 >= 0 && c2 < 32)))
2248 {
2249 /* Handle a generic character. */
2250 Lisp_Object name;
2251 name = CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX);
b7826503 2252 CHECK_STRING (name);
47a18cef
RS
2253 return concat2 (build_string ("Character set "), name);
2254 }
2255 else
2256 {
3d9d7a9b
GM
2257 char tem[KEY_DESCRIPTION_SIZE], *end;
2258 int nbytes, nchars;
2259 Lisp_Object string;
2260
2261 end = push_key_description (XUINT (key), tem, 1);
2262 nbytes = end - tem;
2263 nchars = multibyte_chars_in_text (tem, nbytes);
2264 if (nchars == nbytes)
e15e2828
GM
2265 {
2266 *end = '\0';
2267 string = build_string (tem);
2268 }
3d9d7a9b
GM
2269 else
2270 string = make_multibyte_string (tem, nchars, nbytes);
2271 return string;
47a18cef 2272 }
2c6f1a39 2273 }
e958fd9a 2274 else if (SYMBOLP (key)) /* Function key or event-symbol */
c7edb960 2275 {
c1848a97
GM
2276 if (NILP (no_angles))
2277 {
2278 char *buffer
d5db4077
KR
2279 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2280 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
c1848a97
GM
2281 return build_string (buffer);
2282 }
2283 else
2284 return Fsymbol_name (key);
c7edb960 2285 }
e958fd9a
KH
2286 else if (STRINGP (key)) /* Buffer names in the menubar. */
2287 return Fcopy_sequence (key);
2288 else
2289 error ("KEY must be an integer, cons, symbol, or string");
6bbd7a29 2290 return Qnil;
2c6f1a39
JB
2291}
2292
2293char *
2294push_text_char_description (c, p)
2295 register unsigned int c;
2296 register char *p;
2297{
2298 if (c >= 0200)
2299 {
2300 *p++ = 'M';
2301 *p++ = '-';
2302 c -= 0200;
2303 }
2304 if (c < 040)
2305 {
2306 *p++ = '^';
2307 *p++ = c + 64; /* 'A' - 1 */
2308 }
2309 else if (c == 0177)
2310 {
2311 *p++ = '^';
2312 *p++ = '?';
2313 }
2314 else
2315 *p++ = c;
d55627cc 2316 return p;
2c6f1a39
JB
2317}
2318
21a0d7a0
RS
2319/* This function cannot GC. */
2320
2c6f1a39 2321DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
335c5470 2322 doc: /* Return a pretty description of file-character CHARACTER.
bda67d96
LT
2323Control characters turn into "^char", etc. This differs from
2324`single-key-description' which turns them into "C-char".
2325Also, this function recognizes the 2**7 bit as the Meta character,
2326whereas `single-key-description' uses the 2**27 bit for Meta.
2327See Info node `(elisp)Describing Characters' for examples. */)
335c5470 2328 (character)
88539837 2329 Lisp_Object character;
2c6f1a39 2330{
0a16479f
KH
2331 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2332 unsigned char str[6];
2333 int c;
2c6f1a39 2334
b7826503 2335 CHECK_NUMBER (character);
2c6f1a39 2336
0a16479f
KH
2337 c = XINT (character);
2338 if (!SINGLE_BYTE_CHAR_P (c))
a98f1d1d 2339 {
0a16479f 2340 int len = CHAR_STRING (c, str);
a98f1d1d 2341
f3ba5409 2342 return make_multibyte_string (str, 1, len);
a98f1d1d
KH
2343 }
2344
0a16479f 2345 *push_text_char_description (c & 0377, str) = 0;
2c6f1a39 2346
0a16479f 2347 return build_string (str);
2c6f1a39 2348}
2fc66973
JB
2349
2350/* Return non-zero if SEQ contains only ASCII characters, perhaps with
2351 a meta bit. */
2352static int
2353ascii_sequence_p (seq)
2354 Lisp_Object seq;
2355{
6e344130 2356 int i;
2fc66973 2357 int len = XINT (Flength (seq));
ffab2bd6 2358
6e344130 2359 for (i = 0; i < len; i++)
2fc66973 2360 {
6e344130 2361 Lisp_Object ii, elt;
ffab2bd6 2362
6e344130
KH
2363 XSETFASTINT (ii, i);
2364 elt = Faref (seq, ii);
2fc66973 2365
416349ec 2366 if (!INTEGERP (elt)
2fc66973
JB
2367 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2368 return 0;
2369 }
2370
2371 return 1;
2372}
2373
2c6f1a39 2374\f
cc0a8174
JB
2375/* where-is - finding a command in a set of keymaps. */
2376
0c412762 2377static Lisp_Object where_is_internal ();
0403641f 2378static Lisp_Object where_is_internal_1 ();
69248761 2379static void where_is_internal_2 ();
0403641f 2380
49801145
SM
2381/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2382 Returns the first non-nil binding found in any of those maps. */
2383
2384static Lisp_Object
2385shadow_lookup (shadow, key, flag)
2386 Lisp_Object shadow, key, flag;
2387{
2388 Lisp_Object tail, value;
2389
2390 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2391 {
2392 value = Flookup_key (XCAR (tail), key, flag);
d35f78c9
JL
2393 if (NATNUMP (value))
2394 {
d7c0be75
KR
2395 value = Flookup_key (XCAR (tail),
2396 Fsubstring (key, make_number (0), value), flag);
d35f78c9
JL
2397 if (!NILP (value))
2398 return Qnil;
2399 }
2400 else if (!NILP (value))
49801145
SM
2401 return value;
2402 }
2403 return Qnil;
2404}
2405
9d209cfe 2406static Lisp_Object Vmouse_events;
d378869e 2407
49801145
SM
2408/* This function can GC if Flookup_key autoloads any keymaps. */
2409
1e7d1ab0 2410static Lisp_Object
0c412762 2411where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
1e7d1ab0 2412 Lisp_Object definition, keymaps;
0c412762 2413 Lisp_Object firstonly, noindirect, no_remap;
2c6f1a39 2414{
49801145 2415 Lisp_Object maps = Qnil;
0403641f 2416 Lisp_Object found, sequences;
21a0d7a0 2417 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
0bc395d4
RS
2418 /* 1 means ignore all menu bindings entirely. */
2419 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2c6f1a39 2420
0c412762
KS
2421 /* If this command is remapped, then it has no key bindings
2422 of its own. */
a1df473f
KS
2423 if (NILP (no_remap) && SYMBOLP (definition))
2424 {
2425 Lisp_Object tem;
023b93f6 2426 if (tem = Fcommand_remapping (definition), !NILP (tem))
a1df473f
KS
2427 return Qnil;
2428 }
0c412762 2429
49801145
SM
2430 found = keymaps;
2431 while (CONSP (found))
93d2aa1c 2432 {
49801145 2433 maps =
02067692
SM
2434 nconc2 (maps,
2435 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
49801145 2436 found = XCDR (found);
93d2aa1c 2437 }
31bea176 2438
49801145 2439 GCPRO5 (definition, keymaps, maps, found, sequences);
2c6f1a39 2440 found = Qnil;
0403641f 2441 sequences = Qnil;
2c6f1a39 2442
265a9e55 2443 for (; !NILP (maps); maps = Fcdr (maps))
2c6f1a39 2444 {
e9b6dfb0 2445 /* Key sequence to reach map, and the map that it reaches */
d378869e 2446 register Lisp_Object this, map, tem;
f5b79c1c 2447
2c6f1a39
JB
2448 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2449 [M-CHAR] sequences, check if last character of the sequence
2450 is the meta-prefix char. */
e9b6dfb0
KH
2451 Lisp_Object last;
2452 int last_is_meta;
2453
2454 this = Fcar (Fcar (maps));
2455 map = Fcdr (Fcar (maps));
2456 last = make_number (XINT (Flength (this)) - 1);
2457 last_is_meta = (XINT (last) >= 0
2458 && EQ (Faref (this, last), meta_prefix_char));
2c6f1a39 2459
2ba11bbd 2460 /* if (nomenus && !ascii_sequence_p (this)) */
f58c6494 2461 if (nomenus && XINT (last) >= 0
d378869e 2462 && SYMBOLP (tem = Faref (this, make_number (0)))
9d209cfe 2463 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
88416888
SM
2464 /* If no menu entries should be returned, skip over the
2465 keymaps bound to `menu-bar' and `tool-bar' and other
2ba11bbd 2466 non-ascii prefixes like `C-down-mouse-2'. */
88416888 2467 continue;
31bea176 2468
fde3a52f
JB
2469 QUIT;
2470
f5b79c1c 2471 while (CONSP (map))
2c6f1a39 2472 {
f5b79c1c
JB
2473 /* Because the code we want to run on each binding is rather
2474 large, we don't want to have two separate loop bodies for
2475 sparse keymap bindings and tables; we want to iterate one
2476 loop body over both keymap and vector bindings.
2477
2478 For this reason, if Fcar (map) is a vector, we don't
2479 advance map to the next element until i indicates that we
2480 have finished off the vector. */
21a0d7a0 2481 Lisp_Object elt, key, binding;
03699b14
KR
2482 elt = XCAR (map);
2483 map = XCDR (map);
0403641f
RS
2484
2485 sequences = Qnil;
f5b79c1c 2486
fde3a52f
JB
2487 QUIT;
2488
f5b79c1c
JB
2489 /* Set key and binding to the current key and binding, and
2490 advance map and i to the next binding. */
416349ec 2491 if (VECTORP (elt))
2c6f1a39 2492 {
0403641f
RS
2493 Lisp_Object sequence;
2494 int i;
2c6f1a39 2495 /* In a vector, look at each element. */
0403641f 2496 for (i = 0; i < XVECTOR (elt)->size; i++)
2c6f1a39 2497 {
49801145 2498 binding = AREF (elt, i);
0403641f
RS
2499 XSETFASTINT (key, i);
2500 sequence = where_is_internal_1 (binding, key, definition,
49801145 2501 noindirect, this,
0403641f
RS
2502 last, nomenus, last_is_meta);
2503 if (!NILP (sequence))
2504 sequences = Fcons (sequence, sequences);
2c6f1a39 2505 }
f5b79c1c 2506 }
0403641f 2507 else if (CHAR_TABLE_P (elt))
f5b79c1c 2508 {
23cf1efa 2509 Lisp_Object indices[3];
0403641f 2510 Lisp_Object args;
23cf1efa 2511
0403641f 2512 args = Fcons (Fcons (Fcons (definition, noindirect),
49801145 2513 Qnil), /* Result accumulator. */
0403641f
RS
2514 Fcons (Fcons (this, last),
2515 Fcons (make_number (nomenus),
2516 make_number (last_is_meta))));
fe72189a 2517 map_char_table (where_is_internal_2, Qnil, elt, elt, args,
0403641f 2518 0, indices);
49801145 2519 sequences = XCDR (XCAR (args));
2c6f1a39 2520 }
0403641f 2521 else if (CONSP (elt))
fde3a52f 2522 {
0403641f 2523 Lisp_Object sequence;
2c6f1a39 2524
03699b14
KR
2525 key = XCAR (elt);
2526 binding = XCDR (elt);
2c6f1a39 2527
0403641f 2528 sequence = where_is_internal_1 (binding, key, definition,
49801145 2529 noindirect, this,
0403641f
RS
2530 last, nomenus, last_is_meta);
2531 if (!NILP (sequence))
2532 sequences = Fcons (sequence, sequences);
2c6f1a39 2533 }
2c6f1a39 2534
2c6f1a39 2535
0c412762 2536 while (!NILP (sequences))
2c6f1a39 2537 {
a1df473f 2538 Lisp_Object sequence, remapped, function;
0403641f 2539
03699b14 2540 sequence = XCAR (sequences);
0c412762
KS
2541 sequences = XCDR (sequences);
2542
a1df473f
KS
2543 /* If the current sequence is a command remapping with
2544 format [remap COMMAND], find the key sequences
2545 which run COMMAND, and use those sequences instead. */
0c412762
KS
2546 remapped = Qnil;
2547 if (NILP (no_remap)
a1df473f
KS
2548 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2549 && EQ (AREF (sequence, 0), Qremap)
2550 && (function = AREF (sequence, 1), SYMBOLP (function)))
0c412762 2551 {
a1df473f 2552 Lisp_Object remapped1;
0c412762 2553
a1df473f
KS
2554 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2555 if (CONSP (remapped1))
0c412762 2556 {
a1df473f
KS
2557 /* Verify that this key binding actually maps to the
2558 remapped command (see below). */
2559 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2560 continue;
2561 sequence = XCAR (remapped1);
2562 remapped = XCDR (remapped1);
2563 goto record_sequence;
0c412762
KS
2564 }
2565 }
0403641f 2566
49801145
SM
2567 /* Verify that this key binding is not shadowed by another
2568 binding for the same key, before we say it exists.
2569
2570 Mechanism: look for local definition of this key and if
2571 it is defined and does not match what we found then
2572 ignore this key.
2573
2574 Either nil or number as value from Flookup_key
2575 means undefined. */
1e7d1ab0 2576 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
49801145
SM
2577 continue;
2578
0c412762 2579 record_sequence:
18e2d91f
RS
2580 /* Don't annoy user with strings from a menu such as
2581 Select Paste. Change them all to "(any string)",
2582 so that there seems to be only one menu item
2583 to report. */
2584 if (! NILP (sequence))
2585 {
2586 Lisp_Object tem;
2587 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2588 if (STRINGP (tem))
2589 Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2590 build_string ("(any string)"));
2591 }
2592
0403641f
RS
2593 /* It is a true unshadowed match. Record it, unless it's already
2594 been seen (as could happen when inheriting keymaps). */
2595 if (NILP (Fmember (sequence, found)))
2596 found = Fcons (sequence, found);
2597
2598 /* If firstonly is Qnon_ascii, then we can return the first
2599 binding we find. If firstonly is not Qnon_ascii but not
2600 nil, then we should return the first ascii-only binding
2601 we find. */
2602 if (EQ (firstonly, Qnon_ascii))
2603 RETURN_UNGCPRO (sequence);
54cbc3d4 2604 else if (!NILP (firstonly) && ascii_sequence_p (sequence))
0403641f 2605 RETURN_UNGCPRO (sequence);
0c412762
KS
2606
2607 if (CONSP (remapped))
2608 {
2609 sequence = XCAR (remapped);
2610 remapped = XCDR (remapped);
2611 goto record_sequence;
2612 }
2c6f1a39 2613 }
2c6f1a39
JB
2614 }
2615 }
2fc66973 2616
21a0d7a0
RS
2617 UNGCPRO;
2618
2fc66973
JB
2619 found = Fnreverse (found);
2620
2621 /* firstonly may have been t, but we may have gone all the way through
2622 the keymaps without finding an all-ASCII key sequence. So just
2623 return the best we could find. */
54cbc3d4 2624 if (!NILP (firstonly))
2fc66973 2625 return Fcar (found);
31bea176 2626
2fc66973 2627 return found;
2c6f1a39 2628}
0403641f 2629
0c412762 2630DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
335c5470 2631 doc: /* Return list of keys that invoke DEFINITION.
2c0a0e38 2632If KEYMAP is a keymap, search only KEYMAP and the global keymap.
335c5470
PJ
2633If KEYMAP is nil, search all the currently active keymaps.
2634If KEYMAP is a list of keymaps, search only those keymaps.
2635
2636If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2637rather than a list of all possible key sequences.
2638If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2639no matter what it is.
2c0a0e38
LT
2640If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2641\(or their meta variants) and entirely reject menu bindings.
335c5470
PJ
2642
2643If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2644to other keymaps or slots. This makes it possible to search for an
0c412762
KS
2645indirect definition itself.
2646
2647If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2648that invoke a command which is remapped to DEFINITION, but include the
2649remapped command in the returned list. */)
2650 (definition, keymap, firstonly, noindirect, no_remap)
4956d1ef 2651 Lisp_Object definition, keymap;
0c412762 2652 Lisp_Object firstonly, noindirect, no_remap;
1e7d1ab0
SM
2653{
2654 Lisp_Object sequences, keymaps;
1e7d1ab0
SM
2655 /* 1 means ignore all menu bindings entirely. */
2656 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
f9aaedb6 2657 Lisp_Object result;
1e7d1ab0
SM
2658
2659 /* Find the relevant keymaps. */
4956d1ef
GM
2660 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2661 keymaps = keymap;
54cbc3d4 2662 else if (!NILP (keymap))
4956d1ef 2663 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
1e7d1ab0 2664 else
54cbc3d4 2665 keymaps = Fcurrent_active_maps (Qnil);
1e7d1ab0
SM
2666
2667 /* Only use caching for the menubar (i.e. called with (def nil t nil).
4956d1ef
GM
2668 We don't really need to check `keymap'. */
2669 if (nomenus && NILP (noindirect) && NILP (keymap))
1e7d1ab0 2670 {
f9aaedb6 2671 Lisp_Object *defns;
60dc6558 2672 int i, j, n;
0c412762 2673 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
744cd66b 2674
1e7d1ab0
SM
2675 /* Check heuristic-consistency of the cache. */
2676 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2677 where_is_cache = Qnil;
2678
2679 if (NILP (where_is_cache))
2680 {
2681 /* We need to create the cache. */
2682 Lisp_Object args[2];
2683 where_is_cache = Fmake_hash_table (0, args);
2684 where_is_cache_keymaps = Qt;
31bea176 2685
1e7d1ab0 2686 /* Fill in the cache. */
0c412762
KS
2687 GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2688 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
1e7d1ab0
SM
2689 UNGCPRO;
2690
2691 where_is_cache_keymaps = keymaps;
2692 }
2693
f9aaedb6
GM
2694 /* We want to process definitions from the last to the first.
2695 Instead of consing, copy definitions to a vector and step
2696 over that vector. */
1e7d1ab0 2697 sequences = Fgethash (definition, where_is_cache, Qnil);
f58c6494 2698 n = XINT (Flength (sequences));
f9aaedb6
GM
2699 defns = (Lisp_Object *) alloca (n * sizeof *defns);
2700 for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2701 defns[i++] = XCAR (sequences);
31bea176 2702
f9aaedb6
GM
2703 /* Verify that the key bindings are not shadowed. Note that
2704 the following can GC. */
2705 GCPRO2 (definition, keymaps);
2706 result = Qnil;
60dc6558 2707 j = -1;
f9aaedb6 2708 for (i = n - 1; i >= 0; --i)
60dc6558
SM
2709 if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2710 {
2711 if (ascii_sequence_p (defns[i]))
2712 break;
2713 else if (j < 0)
2714 j = i;
2715 }
f9aaedb6 2716
60dc6558 2717 result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
f9aaedb6 2718 UNGCPRO;
1e7d1ab0
SM
2719 }
2720 else
2721 {
2722 /* Kill the cache so that where_is_internal_1 doesn't think
2723 we're filling it up. */
2724 where_is_cache = Qnil;
0c412762 2725 result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
1e7d1ab0 2726 }
f9aaedb6
GM
2727
2728 return result;
1e7d1ab0
SM
2729}
2730
0403641f
RS
2731/* This is the function that Fwhere_is_internal calls using map_char_table.
2732 ARGS has the form
2733 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2734 .
2735 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2736 Since map_char_table doesn't really use the return value from this function,
df75b1a3
GM
2737 we the result append to RESULT, the slot in ARGS.
2738
2739 This function can GC because it calls where_is_internal_1 which can
2740 GC. */
0403641f 2741
69248761 2742static void
0403641f
RS
2743where_is_internal_2 (args, key, binding)
2744 Lisp_Object args, key, binding;
2745{
49801145 2746 Lisp_Object definition, noindirect, this, last;
0403641f
RS
2747 Lisp_Object result, sequence;
2748 int nomenus, last_is_meta;
df75b1a3 2749 struct gcpro gcpro1, gcpro2, gcpro3;
0403641f 2750
df75b1a3 2751 GCPRO3 (args, key, binding);
49801145 2752 result = XCDR (XCAR (args));
03699b14
KR
2753 definition = XCAR (XCAR (XCAR (args)));
2754 noindirect = XCDR (XCAR (XCAR (args)));
03699b14
KR
2755 this = XCAR (XCAR (XCDR (args)));
2756 last = XCDR (XCAR (XCDR (args)));
2757 nomenus = XFASTINT (XCAR (XCDR (XCDR (args))));
2758 last_is_meta = XFASTINT (XCDR (XCDR (XCDR (args))));
0403641f 2759
49801145 2760 sequence = where_is_internal_1 (binding, key, definition, noindirect,
0403641f
RS
2761 this, last, nomenus, last_is_meta);
2762
2763 if (!NILP (sequence))
f3fbd155 2764 XSETCDR (XCAR (args), Fcons (sequence, result));
df75b1a3
GM
2765
2766 UNGCPRO;
0403641f
RS
2767}
2768
df75b1a3 2769
18e2d91f 2770/* This function can GC because get_keyelt can. */
df75b1a3 2771
0403641f 2772static Lisp_Object
49801145 2773where_is_internal_1 (binding, key, definition, noindirect, this, last,
0403641f 2774 nomenus, last_is_meta)
49801145 2775 Lisp_Object binding, key, definition, noindirect, this, last;
0403641f
RS
2776 int nomenus, last_is_meta;
2777{
2778 Lisp_Object sequence;
0403641f
RS
2779
2780 /* Search through indirections unless that's not wanted. */
2781 if (NILP (noindirect))
35810b6f 2782 binding = get_keyelt (binding, 0);
0403641f
RS
2783
2784 /* End this iteration if this element does not match
2785 the target. */
2786
1e7d1ab0
SM
2787 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2788 || EQ (binding, definition)
2789 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2790 /* Doesn't match. */
2791 return Qnil;
0403641f 2792
1e7d1ab0 2793 /* We have found a match. Construct the key sequence where we found it. */
0403641f
RS
2794 if (INTEGERP (key) && last_is_meta)
2795 {
2796 sequence = Fcopy_sequence (this);
2797 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2798 }
2799 else
2800 sequence = append_key (this, key);
2801
1e7d1ab0
SM
2802 if (!NILP (where_is_cache))
2803 {
2804 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2805 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2806 return Qnil;
2807 }
2808 else
2809 return sequence;
0403641f 2810}
2c6f1a39 2811\f
cc0a8174
JB
2812/* describe-bindings - summarizing all the bindings in a set of keymaps. */
2813
54cbc3d4 2814DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
335c5470
PJ
2815 doc: /* Insert the list of all defined keys and their definitions.
2816The list is inserted in the current buffer, while the bindings are
2817looked up in BUFFER.
2818The optional argument PREFIX, if non-nil, should be a key sequence;
2819then we display only bindings that start with that prefix.
2820The optional argument MENUS, if non-nil, says to mention menu bindings.
2821\(Ordinarily these are omitted from the output.) */)
2822 (buffer, prefix, menus)
54cbc3d4 2823 Lisp_Object buffer, prefix, menus;
2c6f1a39 2824{
54cbc3d4
SM
2825 Lisp_Object outbuf, shadow;
2826 int nomenu = NILP (menus);
d7ab90a9
KH
2827 register Lisp_Object start1;
2828 struct gcpro gcpro1;
2c6f1a39 2829
4726a9f1
JB
2830 char *alternate_heading
2831 = "\
6cec169a
RS
2832Keyboard translations:\n\n\
2833You type Translation\n\
2834-------- -----------\n";
2c6f1a39 2835
a588e041 2836 shadow = Qnil;
d7ab90a9 2837 GCPRO1 (shadow);
53c8f9fa 2838
36ca6189 2839 outbuf = Fcurrent_buffer ();
2c6f1a39 2840
4726a9f1 2841 /* Report on alternates for keys. */
d7bf9bf5 2842 if (STRINGP (Vkeyboard_translate_table) && !NILP (prefix))
4726a9f1
JB
2843 {
2844 int c;
3141e0ab 2845 const unsigned char *translate = SDATA (Vkeyboard_translate_table);
d5db4077 2846 int translate_len = SCHARS (Vkeyboard_translate_table);
4726a9f1
JB
2847
2848 for (c = 0; c < translate_len; c++)
2849 if (translate[c] != c)
2850 {
d2d9586a 2851 char buf[KEY_DESCRIPTION_SIZE];
4726a9f1
JB
2852 char *bufend;
2853
2854 if (alternate_heading)
2855 {
2856 insert_string (alternate_heading);
2857 alternate_heading = 0;
2858 }
2859
f1cb0a25 2860 bufend = push_key_description (translate[c], buf, 1);
4726a9f1
JB
2861 insert (buf, bufend - buf);
2862 Findent_to (make_number (16), make_number (1));
f1cb0a25 2863 bufend = push_key_description (c, buf, 1);
4726a9f1
JB
2864 insert (buf, bufend - buf);
2865
2866 insert ("\n", 1);
d6a31e9f
KS
2867
2868 /* Insert calls signal_after_change which may GC. */
2869 translate = SDATA (Vkeyboard_translate_table);
4726a9f1
JB
2870 }
2871
2872 insert ("\n", 1);
2873 }
2874
d7bf9bf5
RS
2875 if (!NILP (Vkey_translation_map))
2876 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
b88e82fd 2877 "Key translations", nomenu, 1, 0, 0);
d7bf9bf5 2878
cc0a8174 2879
53c8f9fa 2880 /* Print the (major mode) local map. */
36ca6189 2881 start1 = Qnil;
e784236d
KH
2882 if (!NILP (current_kboard->Voverriding_terminal_local_map))
2883 start1 = current_kboard->Voverriding_terminal_local_map;
2884 else if (!NILP (Voverriding_local_map))
7d92e329 2885 start1 = Voverriding_local_map;
7d92e329 2886
265a9e55 2887 if (!NILP (start1))
2c6f1a39 2888 {
91f64ec2 2889 describe_map_tree (start1, 1, shadow, prefix,
b88e82fd 2890 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
53c8f9fa 2891 shadow = Fcons (start1, shadow);
2c6f1a39 2892 }
36ca6189
RS
2893 else
2894 {
2895 /* Print the minor mode and major mode keymaps. */
2896 int i, nmaps;
2897 Lisp_Object *modes, *maps;
2898
2899 /* Temporarily switch to `buffer', so that we can get that buffer's
2900 minor modes correctly. */
2901 Fset_buffer (buffer);
2902
2903 nmaps = current_minor_maps (&modes, &maps);
2904 Fset_buffer (outbuf);
2905
d1d070e3
RS
2906 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
2907 XBUFFER (buffer), Qkeymap);
2908 if (!NILP (start1))
2909 {
2910 describe_map_tree (start1, 1, shadow, prefix,
b88e82fd
RS
2911 "\f\n`keymap' Property Bindings", nomenu,
2912 0, 0, 0);
d1d070e3
RS
2913 shadow = Fcons (start1, shadow);
2914 }
2915
36ca6189
RS
2916 /* Print the minor mode maps. */
2917 for (i = 0; i < nmaps; i++)
2918 {
2919 /* The title for a minor mode keymap
2920 is constructed at run time.
2921 We let describe_map_tree do the actual insertion
2922 because it takes care of other features when doing so. */
2923 char *title, *p;
2924
2925 if (!SYMBOLP (modes[i]))
2926 abort();
2927
d5db4077 2928 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
36ca6189
RS
2929 *p++ = '\f';
2930 *p++ = '\n';
2931 *p++ = '`';
d5db4077
KR
2932 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
2933 SCHARS (SYMBOL_NAME (modes[i])));
2934 p += SCHARS (SYMBOL_NAME (modes[i]));
36ca6189
RS
2935 *p++ = '\'';
2936 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
2937 p += sizeof (" Minor Mode Bindings") - 1;
2938 *p = 0;
2939
b88e82fd
RS
2940 describe_map_tree (maps[i], 1, shadow, prefix,
2941 title, nomenu, 0, 0, 0);
36ca6189
RS
2942 shadow = Fcons (maps[i], shadow);
2943 }
2944
36ca6189
RS
2945 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
2946 XBUFFER (buffer), Qlocal_map);
2947 if (!NILP (start1))
2948 {
2949 if (EQ (start1, XBUFFER (buffer)->keymap))
2950 describe_map_tree (start1, 1, shadow, prefix,
b88e82fd 2951 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
36ca6189
RS
2952 else
2953 describe_map_tree (start1, 1, shadow, prefix,
d1d070e3 2954 "\f\n`local-map' Property Bindings",
b88e82fd 2955 nomenu, 0, 0, 0);
36ca6189
RS
2956
2957 shadow = Fcons (start1, shadow);
2958 }
2959 }
2c6f1a39 2960
91f64ec2 2961 describe_map_tree (current_global_map, 1, shadow, prefix,
b88e82fd 2962 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
d7bf9bf5
RS
2963
2964 /* Print the function-key-map translations under this prefix. */
2965 if (!NILP (Vfunction_key_map))
2966 describe_map_tree (Vfunction_key_map, 0, Qnil, prefix,
b88e82fd 2967 "\f\nFunction key map translations", nomenu, 1, 0, 0);
2c6f1a39 2968
d7ab90a9 2969 UNGCPRO;
2c6f1a39
JB
2970 return Qnil;
2971}
2972
b31a4218 2973/* Insert a description of the key bindings in STARTMAP,
2c6f1a39
JB
2974 followed by those of all maps reachable through STARTMAP.
2975 If PARTIAL is nonzero, omit certain "uninteresting" commands
2976 (such as `undefined').
53c8f9fa
RS
2977 If SHADOW is non-nil, it is a list of maps;
2978 don't mention keys which would be shadowed by any of them.
2979 PREFIX, if non-nil, says mention only keys that start with PREFIX.
07f15dfd 2980 TITLE, if not 0, is a string to insert at the beginning.
af1d6f09 2981 TITLE should not end with a colon or a newline; we supply that.
d7bf9bf5
RS
2982 If NOMENU is not 0, then omit menu-bar commands.
2983
2984 If TRANSL is nonzero, the definitions are actually key translations
c2b714de
RS
2985 so print strings and vectors differently.
2986
2987 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
b88e82fd
RS
2988 to look through.
2989
2990 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
2991 don't omit it; instead, mention it but say it is shadowed. */
2c6f1a39
JB
2992
2993void
c2b714de 2994describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
b88e82fd 2995 always_title, mention_shadow)
53c8f9fa 2996 Lisp_Object startmap, shadow, prefix;
2c6f1a39 2997 int partial;
53c8f9fa 2998 char *title;
af1d6f09 2999 int nomenu;
d7bf9bf5 3000 int transl;
c2b714de 3001 int always_title;
b88e82fd 3002 int mention_shadow;
2c6f1a39 3003{
e4b6f8e3 3004 Lisp_Object maps, orig_maps, seen, sub_shadows;
e3dfcd4e 3005 struct gcpro gcpro1, gcpro2, gcpro3;
07f15dfd 3006 int something = 0;
53c8f9fa
RS
3007 char *key_heading
3008 = "\
3009key binding\n\
3010--- -------\n";
2c6f1a39 3011
e4b6f8e3 3012 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
925083d1 3013 seen = Qnil;
e3dfcd4e
KH
3014 sub_shadows = Qnil;
3015 GCPRO3 (maps, seen, sub_shadows);
2c6f1a39 3016
af1d6f09
RS
3017 if (nomenu)
3018 {
3019 Lisp_Object list;
3020
3021 /* Delete from MAPS each element that is for the menu bar. */
03699b14 3022 for (list = maps; !NILP (list); list = XCDR (list))
af1d6f09
RS
3023 {
3024 Lisp_Object elt, prefix, tem;
3025
3026 elt = Fcar (list);
3027 prefix = Fcar (elt);
3028 if (XVECTOR (prefix)->size >= 1)
3029 {
3030 tem = Faref (prefix, make_number (0));
3031 if (EQ (tem, Qmenu_bar))
3032 maps = Fdelq (elt, maps);
3033 }
3034 }
3035 }
3036
c2b714de 3037 if (!NILP (maps) || always_title)
53c8f9fa
RS
3038 {
3039 if (title)
07f15dfd
RS
3040 {
3041 insert_string (title);
3042 if (!NILP (prefix))
3043 {
3044 insert_string (" Starting With ");
f8d8ba40 3045 insert1 (Fkey_description (prefix, Qnil));
07f15dfd
RS
3046 }
3047 insert_string (":\n");
3048 }
53c8f9fa 3049 insert_string (key_heading);
07f15dfd 3050 something = 1;
53c8f9fa
RS
3051 }
3052
265a9e55 3053 for (; !NILP (maps); maps = Fcdr (maps))
2c6f1a39 3054 {
e3dfcd4e 3055 register Lisp_Object elt, prefix, tail;
53c8f9fa 3056
2c6f1a39 3057 elt = Fcar (maps);
53c8f9fa
RS
3058 prefix = Fcar (elt);
3059
3060 sub_shadows = Qnil;
3061
03699b14 3062 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2c6f1a39 3063 {
53c8f9fa
RS
3064 Lisp_Object shmap;
3065
03699b14 3066 shmap = XCAR (tail);
53c8f9fa
RS
3067
3068 /* If the sequence by which we reach this keymap is zero-length,
3069 then the shadow map for this keymap is just SHADOW. */
d5db4077 3070 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
416349ec 3071 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
53c8f9fa
RS
3072 ;
3073 /* If the sequence by which we reach this keymap actually has
3074 some elements, then the sequence's definition in SHADOW is
3075 what we should use. */
3076 else
3077 {
98234407 3078 shmap = Flookup_key (shmap, Fcar (elt), Qt);
416349ec 3079 if (INTEGERP (shmap))
53c8f9fa
RS
3080 shmap = Qnil;
3081 }
3082
3083 /* If shmap is not nil and not a keymap,
3084 it completely shadows this map, so don't
3085 describe this map at all. */
02067692 3086 if (!NILP (shmap) && !KEYMAPP (shmap))
53c8f9fa
RS
3087 goto skip;
3088
3089 if (!NILP (shmap))
3090 sub_shadows = Fcons (shmap, sub_shadows);
2c6f1a39
JB
3091 }
3092
e4b6f8e3 3093 /* Maps we have already listed in this loop shadow this map. */
54cbc3d4 3094 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
e4b6f8e3
RS
3095 {
3096 Lisp_Object tem;
3097 tem = Fequal (Fcar (XCAR (tail)), prefix);
54cbc3d4 3098 if (!NILP (tem))
e4b6f8e3
RS
3099 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3100 }
3101
3102 describe_map (Fcdr (elt), prefix,
d7bf9bf5 3103 transl ? describe_translation : describe_command,
b88e82fd 3104 partial, sub_shadows, &seen, nomenu, mention_shadow);
53c8f9fa
RS
3105
3106 skip: ;
2c6f1a39
JB
3107 }
3108
07f15dfd
RS
3109 if (something)
3110 insert_string ("\n");
3111
2c6f1a39
JB
3112 UNGCPRO;
3113}
3114
c3f27064
KH
3115static int previous_description_column;
3116
2c6f1a39 3117static void
d55627cc
SM
3118describe_command (definition, args)
3119 Lisp_Object definition, args;
2c6f1a39
JB
3120{
3121 register Lisp_Object tem1;
744cd66b 3122 int column = (int) current_column (); /* iftc */
c3f27064 3123 int description_column;
2c6f1a39 3124
c3f27064
KH
3125 /* If column 16 is no good, go to col 32;
3126 but don't push beyond that--go to next line instead. */
3127 if (column > 30)
3128 {
3129 insert_char ('\n');
3130 description_column = 32;
3131 }
3132 else if (column > 14 || (column > 10 && previous_description_column == 32))
3133 description_column = 32;
3134 else
3135 description_column = 16;
3136
3137 Findent_to (make_number (description_column), make_number (1));
3138 previous_description_column = description_column;
2c6f1a39 3139
416349ec 3140 if (SYMBOLP (definition))
2c6f1a39 3141 {
c85d524c 3142 tem1 = SYMBOL_NAME (definition);
2c6f1a39 3143 insert1 (tem1);
055234ef 3144 insert_string ("\n");
2c6f1a39 3145 }
d7bf9bf5 3146 else if (STRINGP (definition) || VECTORP (definition))
24065b9c 3147 insert_string ("Keyboard Macro\n");
02067692
SM
3148 else if (KEYMAPP (definition))
3149 insert_string ("Prefix Command\n");
2c6f1a39 3150 else
02067692 3151 insert_string ("??\n");
2c6f1a39
JB
3152}
3153
d7bf9bf5 3154static void
d55627cc
SM
3155describe_translation (definition, args)
3156 Lisp_Object definition, args;
d7bf9bf5
RS
3157{
3158 register Lisp_Object tem1;
3159
3160 Findent_to (make_number (16), make_number (1));
3161
3162 if (SYMBOLP (definition))
3163 {
c85d524c 3164 tem1 = SYMBOL_NAME (definition);
d7bf9bf5
RS
3165 insert1 (tem1);
3166 insert_string ("\n");
3167 }
3168 else if (STRINGP (definition) || VECTORP (definition))
b902ac28 3169 {
f8d8ba40 3170 insert1 (Fkey_description (definition, Qnil));
b902ac28
RS
3171 insert_string ("\n");
3172 }
02067692
SM
3173 else if (KEYMAPP (definition))
3174 insert_string ("Prefix Command\n");
d7bf9bf5 3175 else
02067692 3176 insert_string ("??\n");
d7bf9bf5
RS
3177}
3178
c36238ee
RS
3179/* describe_map puts all the usable elements of a sparse keymap
3180 into an array of `struct describe_map_elt',
3181 then sorts them by the events. */
3182
3183struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3184
3185/* qsort comparison function for sorting `struct describe_map_elt' by
3186 the event field. */
3187
3188static int
3189describe_map_compare (aa, bb)
3190 const void *aa, *bb;
3191{
3192 const struct describe_map_elt *a = aa, *b = bb;
3193 if (INTEGERP (a->event) && INTEGERP (b->event))
3194 return ((XINT (a->event) > XINT (b->event))
3195 - (XINT (a->event) < XINT (b->event)));
3196 if (!INTEGERP (a->event) && INTEGERP (b->event))
3197 return 1;
3198 if (INTEGERP (a->event) && !INTEGERP (b->event))
3199 return -1;
3200 if (SYMBOLP (a->event) && SYMBOLP (b->event))
ccf0250b
SM
3201 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3202 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
c36238ee
RS
3203 : 0);
3204 return 0;
3205}
3206
c3c0ee93 3207/* Describe the contents of map MAP, assuming that this map itself is
f8d8ba40 3208 reached by the sequence of prefix keys PREFIX (a string or vector).
279a482a 3209 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
2c6f1a39
JB
3210
3211static void
b88e82fd
RS
3212describe_map (map, prefix, elt_describer, partial, shadow,
3213 seen, nomenu, mention_shadow)
c3c0ee93 3214 register Lisp_Object map;
f8d8ba40 3215 Lisp_Object prefix;
d55627cc 3216 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
2c6f1a39
JB
3217 int partial;
3218 Lisp_Object shadow;
925083d1 3219 Lisp_Object *seen;
279a482a 3220 int nomenu;
b88e82fd 3221 int mention_shadow;
2c6f1a39 3222{
53c8f9fa 3223 Lisp_Object tail, definition, event;
99a225a9 3224 Lisp_Object tem;
2c6f1a39
JB
3225 Lisp_Object suppress;
3226 Lisp_Object kludge;
3227 int first = 1;
3228 struct gcpro gcpro1, gcpro2, gcpro3;
3229
c36238ee
RS
3230 /* These accumulate the values from sparse keymap bindings,
3231 so we can sort them and handle them in order. */
3232 int length_needed = 0;
3233 struct describe_map_elt *vect;
3234 int slots_used = 0;
3235 int i;
3236
6bbd7a29
GM
3237 suppress = Qnil;
3238
2c6f1a39
JB
3239 if (partial)
3240 suppress = intern ("suppress-keymap");
3241
3242 /* This vector gets used to present single keys to Flookup_key. Since
f5b79c1c 3243 that is done once per keymap element, we don't want to cons up a
2c6f1a39
JB
3244 fresh vector every time. */
3245 kludge = Fmake_vector (make_number (1), Qnil);
99a225a9 3246 definition = Qnil;
2c6f1a39 3247
c36238ee
RS
3248 for (tail = map; CONSP (tail); tail = XCDR (tail))
3249 length_needed++;
3250
3251 vect = ((struct describe_map_elt *)
3252 alloca (sizeof (struct describe_map_elt) * length_needed));
3253
f8d8ba40 3254 GCPRO3 (prefix, definition, kludge);
2c6f1a39 3255
03699b14 3256 for (tail = map; CONSP (tail); tail = XCDR (tail))
2c6f1a39
JB
3257 {
3258 QUIT;
2c6f1a39 3259
03699b14
KR
3260 if (VECTORP (XCAR (tail))
3261 || CHAR_TABLE_P (XCAR (tail)))
3262 describe_vector (XCAR (tail),
f8d8ba40 3263 prefix, Qnil, elt_describer, partial, shadow, map,
b88e82fd 3264 (int *)0, 0, 1, mention_shadow);
03699b14 3265 else if (CONSP (XCAR (tail)))
2c6f1a39 3266 {
b88e82fd 3267 int this_shadowed = 0;
c36238ee 3268
03699b14 3269 event = XCAR (XCAR (tail));
2c3b35b0 3270
f8d8ba40 3271 /* Ignore bindings whose "prefix" are not really valid events.
2c3b35b0 3272 (We get these in the frames and buffers menu.) */
54cbc3d4 3273 if (!(SYMBOLP (event) || INTEGERP (event)))
c96dcc01 3274 continue;
2c3b35b0 3275
279a482a
KH
3276 if (nomenu && EQ (event, Qmenu_bar))
3277 continue;
3278
03699b14 3279 definition = get_keyelt (XCDR (XCAR (tail)), 0);
2c6f1a39 3280
f5b79c1c 3281 /* Don't show undefined commands or suppressed commands. */
99a225a9 3282 if (NILP (definition)) continue;
416349ec 3283 if (SYMBOLP (definition) && partial)
f5b79c1c 3284 {
99a225a9
RS
3285 tem = Fget (definition, suppress);
3286 if (!NILP (tem))
f5b79c1c
JB
3287 continue;
3288 }
2c6f1a39 3289
f5b79c1c
JB
3290 /* Don't show a command that isn't really visible
3291 because a local definition of the same key shadows it. */
2c6f1a39 3292
49801145 3293 ASET (kludge, 0, event);
f5b79c1c
JB
3294 if (!NILP (shadow))
3295 {
53c8f9fa 3296 tem = shadow_lookup (shadow, kludge, Qt);
b88e82fd
RS
3297 if (!NILP (tem))
3298 {
3299 if (mention_shadow)
3300 this_shadowed = 1;
3301 else
3302 continue;
3303 }
f5b79c1c
JB
3304 }
3305
c3c0ee93 3306 tem = Flookup_key (map, kludge, Qt);
54cbc3d4 3307 if (!EQ (tem, definition)) continue;
99a225a9 3308
c36238ee
RS
3309 vect[slots_used].event = event;
3310 vect[slots_used].definition = definition;
3311 vect[slots_used].shadowed = this_shadowed;
3312 slots_used++;
f5b79c1c 3313 }
03699b14 3314 else if (EQ (XCAR (tail), Qkeymap))
925083d1
KH
3315 {
3316 /* The same keymap might be in the structure twice, if we're
3317 using an inherited keymap. So skip anything we've already
3318 encountered. */
3319 tem = Fassq (tail, *seen);
f8d8ba40 3320 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
925083d1 3321 break;
f8d8ba40 3322 *seen = Fcons (Fcons (tail, prefix), *seen);
925083d1 3323 }
2c6f1a39
JB
3324 }
3325
c36238ee
RS
3326 /* If we found some sparse map events, sort them. */
3327
3328 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3329 describe_map_compare);
3330
3331 /* Now output them in sorted order. */
3332
3333 for (i = 0; i < slots_used; i++)
3334 {
3335 Lisp_Object start, end;
3336
3337 if (first)
3338 {
3339 previous_description_column = 0;
3340 insert ("\n", 1);
3341 first = 0;
3342 }
3343
3344 ASET (kludge, 0, vect[i].event);
3345 start = vect[i].event;
3346 end = start;
3347
3348 definition = vect[i].definition;
3349
3350 /* Find consecutive chars that are identically defined. */
3351 if (INTEGERP (vect[i].event))
3352 {
3353 while (i + 1 < slots_used
3354 && XINT (vect[i + 1].event) == XINT (vect[i].event) + 1
3355 && !NILP (Fequal (vect[i + 1].definition, definition))
3356 && vect[i].shadowed == vect[i + 1].shadowed)
3357 i++;
3358 end = vect[i].event;
3359 }
3360
3361 /* Now START .. END is the range to describe next. */
3362
3363 /* Insert the string to describe the event START. */
3364 insert1 (Fkey_description (kludge, prefix));
3365
3366 if (!EQ (start, end))
3367 {
3368 insert (" .. ", 4);
3369
3370 ASET (kludge, 0, end);
3371 /* Insert the string to describe the character END. */
3372 insert1 (Fkey_description (kludge, prefix));
3373 }
3374
3375 /* Print a description of the definition of this character.
3376 elt_describer will take care of spacing out far enough
3377 for alignment purposes. */
3378 (*elt_describer) (vect[i].definition, Qnil);
3379
3380 if (vect[i].shadowed)
3381 {
3382 SET_PT (PT - 1);
3383 insert_string (" (binding currently shadowed)");
3384 SET_PT (PT + 1);
3385 }
3386 }
3387
2c6f1a39
JB
3388 UNGCPRO;
3389}
3390
69248761 3391static void
d55627cc
SM
3392describe_vector_princ (elt, fun)
3393 Lisp_Object elt, fun;
2c6f1a39 3394{
81fa9e2f 3395 Findent_to (make_number (16), make_number (1));
d55627cc 3396 call1 (fun, elt);
ad4ec84a 3397 Fterpri (Qnil);
2c6f1a39
JB
3398}
3399
d55627cc 3400DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
335c5470 3401 doc: /* Insert a description of contents of VECTOR.
23715ea6
JB
3402This is text showing the elements of vector matched against indices.
3403DESCRIBER is the output function used; nil means use `princ'. */)
d55627cc
SM
3404 (vector, describer)
3405 Lisp_Object vector, describer;
2c6f1a39 3406{
aed13378 3407 int count = SPECPDL_INDEX ();
d55627cc
SM
3408 if (NILP (describer))
3409 describer = intern ("princ");
ad4ec84a 3410 specbind (Qstandard_output, Fcurrent_buffer ());
b7826503 3411 CHECK_VECTOR_OR_CHAR_TABLE (vector);
d55627cc 3412 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
b88e82fd 3413 Qnil, Qnil, (int *)0, 0, 0, 0);
ad4ec84a
RS
3414
3415 return unbind_to (count, Qnil);
2c6f1a39
JB
3416}
3417
352e5dea
RS
3418/* Insert in the current buffer a description of the contents of VECTOR.
3419 We call ELT_DESCRIBER to insert the description of one value found
3420 in VECTOR.
3421
3422 ELT_PREFIX describes what "comes before" the keys or indices defined
0403641f
RS
3423 by this vector. This is a human-readable string whose size
3424 is not necessarily related to the situation.
352e5dea
RS
3425
3426 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3427 leads to this keymap.
3428
3429 If the vector is a chartable, ELT_PREFIX is the vector
3430 of bytes that lead to the character set or portion of a character
3431 set described by this chartable.
3432
3433 If PARTIAL is nonzero, it means do not mention suppressed commands
3434 (that assumes the vector is in a keymap).
3435
3436 SHADOW is a list of keymaps that shadow this map.
3437 If it is non-nil, then we look up the key in those maps
3438 and we don't mention it now if it is defined by any of them.
3439
3440 ENTIRE_MAP is the keymap in which this vector appears.
3441 If the definition in effect in the whole map does not match
0403641f
RS
3442 the one in this vector, we ignore this one.
3443
3444 When describing a sub-char-table, INDICES is a list of
3445 indices at higher levels in this char-table,
d55627cc
SM
3446 and CHAR_TABLE_DEPTH says how many levels down we have gone.
3447
f8d8ba40
KS
3448 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3449
d55627cc 3450 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
352e5dea 3451
f8d8ba40
KS
3452static void
3453describe_vector (vector, prefix, args, elt_describer,
0403641f 3454 partial, shadow, entire_map,
b88e82fd
RS
3455 indices, char_table_depth, keymap_p,
3456 mention_shadow)
2c6f1a39 3457 register Lisp_Object vector;
f8d8ba40 3458 Lisp_Object prefix, args;
d55627cc 3459 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
2c6f1a39
JB
3460 int partial;
3461 Lisp_Object shadow;
32bfcae1 3462 Lisp_Object entire_map;
0403641f
RS
3463 int *indices;
3464 int char_table_depth;
f8d8ba40 3465 int keymap_p;
b88e82fd 3466 int mention_shadow;
2c6f1a39 3467{
32bfcae1
KH
3468 Lisp_Object definition;
3469 Lisp_Object tem2;
f8d8ba40 3470 Lisp_Object elt_prefix = Qnil;
2c6f1a39
JB
3471 register int i;
3472 Lisp_Object suppress;
3473 Lisp_Object kludge;
3474 int first = 1;
f8d8ba40 3475 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
a98f1d1d
KH
3476 /* Range of elements to be handled. */
3477 int from, to;
a98f1d1d
KH
3478 /* A flag to tell if a leaf in this level of char-table is not a
3479 generic character (i.e. a complete multibyte character). */
3480 int complete_char;
0403641f
RS
3481 int character;
3482 int starting_i;
3483
6bbd7a29
GM
3484 suppress = Qnil;
3485
0403641f 3486 if (indices == 0)
2e34157c 3487 indices = (int *) alloca (3 * sizeof (int));
2c6f1a39 3488
32bfcae1 3489 definition = Qnil;
2c6f1a39 3490
f8d8ba40
KS
3491 if (!keymap_p)
3492 {
3493 /* Call Fkey_description first, to avoid GC bug for the other string. */
3494 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3495 {
3496 Lisp_Object tem;
3497 tem = Fkey_description (prefix, Qnil);
3498 elt_prefix = concat2 (tem, build_string (" "));
3499 }
3500 prefix = Qnil;
3501 }
3502
2c6f1a39
JB
3503 /* This vector gets used to present single keys to Flookup_key. Since
3504 that is done once per vector element, we don't want to cons up a
3505 fresh vector every time. */
3506 kludge = Fmake_vector (make_number (1), Qnil);
f8d8ba40 3507 GCPRO4 (elt_prefix, prefix, definition, kludge);
2c6f1a39
JB
3508
3509 if (partial)
3510 suppress = intern ("suppress-keymap");
3511
a98f1d1d
KH
3512 if (CHAR_TABLE_P (vector))
3513 {
0403641f 3514 if (char_table_depth == 0)
a98f1d1d 3515 {
a1942d88 3516 /* VECTOR is a top level char-table. */
0403641f 3517 complete_char = 1;
a98f1d1d
KH
3518 from = 0;
3519 to = CHAR_TABLE_ORDINARY_SLOTS;
3520 }
3521 else
3522 {
a1942d88 3523 /* VECTOR is a sub char-table. */
0403641f
RS
3524 if (char_table_depth >= 3)
3525 /* A char-table is never that deep. */
a1942d88 3526 error ("Too deep char table");
a98f1d1d 3527
a98f1d1d 3528 complete_char
0403641f
RS
3529 = (CHARSET_VALID_P (indices[0])
3530 && ((CHARSET_DIMENSION (indices[0]) == 1
3531 && char_table_depth == 1)
3532 || char_table_depth == 2));
a98f1d1d
KH
3533
3534 /* Meaningful elements are from 32th to 127th. */
3535 from = 32;
a1942d88 3536 to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
a98f1d1d 3537 }
a98f1d1d
KH
3538 }
3539 else
3540 {
a98f1d1d 3541 /* This does the right thing for ordinary vectors. */
0403641f
RS
3542
3543 complete_char = 1;
3544 from = 0;
3545 to = XVECTOR (vector)->size;
a98f1d1d 3546 }
b5585f5c 3547
a98f1d1d 3548 for (i = from; i < to; i++)
2c6f1a39 3549 {
b88e82fd 3550 int this_shadowed = 0;
2c6f1a39 3551 QUIT;
2c6f1a39 3552
a1942d88
KH
3553 if (CHAR_TABLE_P (vector))
3554 {
0403641f
RS
3555 if (char_table_depth == 0 && i >= CHAR_TABLE_SINGLE_BYTE_SLOTS)
3556 complete_char = 0;
3557
a1942d88
KH
3558 if (i >= CHAR_TABLE_SINGLE_BYTE_SLOTS
3559 && !CHARSET_DEFINED_P (i - 128))
3560 continue;
0403641f
RS
3561
3562 definition
3563 = get_keyelt (XCHAR_TABLE (vector)->contents[i], 0);
a1942d88
KH
3564 }
3565 else
49801145 3566 definition = get_keyelt (AREF (vector, i), 0);
2c6f1a39 3567
d55627cc 3568 if (NILP (definition)) continue;
cc3e6465 3569
2c6f1a39 3570 /* Don't mention suppressed commands. */
32bfcae1 3571 if (SYMBOLP (definition) && partial)
2c6f1a39 3572 {
a98f1d1d
KH
3573 Lisp_Object tem;
3574
3575 tem = Fget (definition, suppress);
3576
3577 if (!NILP (tem)) continue;
2c6f1a39
JB
3578 }
3579
0403641f
RS
3580 /* Set CHARACTER to the character this entry describes, if any.
3581 Also update *INDICES. */
3582 if (CHAR_TABLE_P (vector))
3583 {
3584 indices[char_table_depth] = i;
3585
3586 if (char_table_depth == 0)
3587 {
3588 character = i;
3589 indices[0] = i - 128;
3590 }
3591 else if (complete_char)
3592 {
54e03a4a 3593 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
0403641f
RS
3594 }
3595 else
3596 character = 0;
3597 }
3598 else
3599 character = i;
3600
f8d8ba40
KS
3601 ASET (kludge, 0, make_number (character));
3602
32bfcae1 3603 /* If this binding is shadowed by some other map, ignore it. */
0403641f 3604 if (!NILP (shadow) && complete_char)
2c6f1a39
JB
3605 {
3606 Lisp_Object tem;
31bea176 3607
53c8f9fa 3608 tem = shadow_lookup (shadow, kludge, Qt);
2c6f1a39 3609
b88e82fd
RS
3610 if (!NILP (tem))
3611 {
3612 if (mention_shadow)
3613 this_shadowed = 1;
3614 else
3615 continue;
3616 }
2c6f1a39
JB
3617 }
3618
32bfcae1
KH
3619 /* Ignore this definition if it is shadowed by an earlier
3620 one in the same keymap. */
0403641f 3621 if (!NILP (entire_map) && complete_char)
32bfcae1
KH
3622 {
3623 Lisp_Object tem;
3624
32bfcae1
KH
3625 tem = Flookup_key (entire_map, kludge, Qt);
3626
54cbc3d4 3627 if (!EQ (tem, definition))
32bfcae1
KH
3628 continue;
3629 }
3630
2c6f1a39
JB
3631 if (first)
3632 {
0403641f 3633 if (char_table_depth == 0)
a98f1d1d 3634 insert ("\n", 1);
2c6f1a39
JB
3635 first = 0;
3636 }
3637
0403641f
RS
3638 /* For a sub char-table, show the depth by indentation.
3639 CHAR_TABLE_DEPTH can be greater than 0 only for a char-table. */
3640 if (char_table_depth > 0)
3641 insert (" ", char_table_depth * 2); /* depth is 1 or 2. */
a98f1d1d 3642
0403641f
RS
3643 /* Output the prefix that applies to every entry in this map. */
3644 if (!NILP (elt_prefix))
3645 insert1 (elt_prefix);
a98f1d1d 3646
0403641f
RS
3647 /* Insert or describe the character this slot is for,
3648 or a description of what it is for. */
3649 if (SUB_CHAR_TABLE_P (vector))
a1942d88 3650 {
0403641f
RS
3651 if (complete_char)
3652 insert_char (character);
3653 else
3654 {
3655 /* We need an octal representation for this block of
3656 characters. */
542d7fd2
RS
3657 char work[16];
3658 sprintf (work, "(row %d)", i);
3659 insert (work, strlen (work));
0403641f
RS
3660 }
3661 }
3662 else if (CHAR_TABLE_P (vector))
3663 {
3664 if (complete_char)
f8d8ba40 3665 insert1 (Fkey_description (kludge, prefix));
a1942d88
KH
3666 else
3667 {
3668 /* Print the information for this character set. */
3669 insert_string ("<");
3670 tem2 = CHARSET_TABLE_INFO (i - 128, CHARSET_SHORT_NAME_IDX);
3671 if (STRINGP (tem2))
d5db4077
KR
3672 insert_from_string (tem2, 0, 0, SCHARS (tem2),
3673 SBYTES (tem2), 0);
a1942d88
KH
3674 else
3675 insert ("?", 1);
3676 insert (">", 1);
3677 }
3678 }
352e5dea
RS
3679 else
3680 {
f8d8ba40 3681 insert1 (Fkey_description (kludge, prefix));
a98f1d1d 3682 }
352e5dea 3683
a1942d88 3684 /* If we find a sub char-table within a char-table,
a98f1d1d
KH
3685 scan it recursively; it defines the details for
3686 a character set or a portion of a character set. */
f3ba5409 3687 if (CHAR_TABLE_P (vector) && SUB_CHAR_TABLE_P (definition))
a98f1d1d 3688 {
a98f1d1d 3689 insert ("\n", 1);
f8d8ba40 3690 describe_vector (definition, prefix, args, elt_describer,
0403641f 3691 partial, shadow, entire_map,
b88e82fd
RS
3692 indices, char_table_depth + 1, keymap_p,
3693 mention_shadow);
a98f1d1d 3694 continue;
352e5dea 3695 }
2c6f1a39 3696
0403641f
RS
3697 starting_i = i;
3698
542d7fd2 3699 /* Find all consecutive characters or rows that have the same
a1942d88
KH
3700 definition. But, for elements of a top level char table, if
3701 they are for charsets, we had better describe one by one even
3702 if they have the same definition. */
3703 if (CHAR_TABLE_P (vector))
3704 {
0403641f
RS
3705 int limit = to;
3706
3707 if (char_table_depth == 0)
3708 limit = CHAR_TABLE_SINGLE_BYTE_SLOTS;
3709
3710 while (i + 1 < limit
3711 && (tem2 = get_keyelt (XCHAR_TABLE (vector)->contents[i + 1], 0),
3712 !NILP (tem2))
3713 && !NILP (Fequal (tem2, definition)))
3714 i++;
a1942d88
KH
3715 }
3716 else
0403641f 3717 while (i + 1 < to
49801145 3718 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
a1942d88
KH
3719 !NILP (tem2))
3720 && !NILP (Fequal (tem2, definition)))
3721 i++;
31bea176 3722
2c6f1a39
JB
3723
3724 /* If we have a range of more than one character,
3725 print where the range reaches to. */
3726
0403641f 3727 if (i != starting_i)
2c6f1a39
JB
3728 {
3729 insert (" .. ", 4);
0403641f 3730
f8d8ba40
KS
3731 ASET (kludge, 0, make_number (i));
3732
0403641f
RS
3733 if (!NILP (elt_prefix))
3734 insert1 (elt_prefix);
3735
352e5dea
RS
3736 if (CHAR_TABLE_P (vector))
3737 {
0403641f 3738 if (char_table_depth == 0)
a98f1d1d 3739 {
f8d8ba40 3740 insert1 (Fkey_description (kludge, prefix));
a98f1d1d 3741 }
0403641f 3742 else if (complete_char)
352e5dea 3743 {
0403641f 3744 indices[char_table_depth] = i;
54e03a4a 3745 character = MAKE_CHAR (indices[0], indices[1], indices[2]);
0403641f 3746 insert_char (character);
352e5dea
RS
3747 }
3748 else
3749 {
542d7fd2
RS
3750 /* We need an octal representation for this block of
3751 characters. */
3752 char work[16];
3753 sprintf (work, "(row %d)", i);
3754 insert (work, strlen (work));
352e5dea
RS
3755 }
3756 }
3757 else
3758 {
f8d8ba40 3759 insert1 (Fkey_description (kludge, prefix));
352e5dea 3760 }
2c6f1a39
JB
3761 }
3762
3763 /* Print a description of the definition of this character.
3764 elt_describer will take care of spacing out far enough
3765 for alignment purposes. */
d55627cc 3766 (*elt_describer) (definition, args);
b88e82fd
RS
3767
3768 if (this_shadowed)
3769 {
3770 SET_PT (PT - 1);
3771 insert_string (" (binding currently shadowed)");
3772 SET_PT (PT + 1);
3773 }
2c6f1a39
JB
3774 }
3775
a1942d88 3776 /* For (sub) char-table, print `defalt' slot at last. */
a98f1d1d
KH
3777 if (CHAR_TABLE_P (vector) && !NILP (XCHAR_TABLE (vector)->defalt))
3778 {
0403641f 3779 insert (" ", char_table_depth * 2);
a98f1d1d 3780 insert_string ("<<default>>");
d55627cc 3781 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
a98f1d1d
KH
3782 }
3783
2c6f1a39
JB
3784 UNGCPRO;
3785}
3786\f
cc0a8174 3787/* Apropos - finding all symbols whose names match a regexp. */
5d55ffd0
RS
3788static Lisp_Object apropos_predicate;
3789static Lisp_Object apropos_accumulate;
2c6f1a39
JB
3790
3791static void
3792apropos_accum (symbol, string)
3793 Lisp_Object symbol, string;
3794{
3795 register Lisp_Object tem;
3796
3797 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
265a9e55 3798 if (!NILP (tem) && !NILP (apropos_predicate))
2c6f1a39 3799 tem = call1 (apropos_predicate, symbol);
265a9e55 3800 if (!NILP (tem))
2c6f1a39
JB
3801 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3802}
3803
744cd66b 3804DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
335c5470
PJ
3805 doc: /* Show all symbols whose names contain match for REGEXP.
3806If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3807for each symbol and a symbol is mentioned only if that returns non-nil.
3808Return list of symbols found. */)
3809 (regexp, predicate)
88539837 3810 Lisp_Object regexp, predicate;
2c6f1a39 3811{
5d55ffd0 3812 Lisp_Object tem;
b7826503 3813 CHECK_STRING (regexp);
88539837 3814 apropos_predicate = predicate;
2c6f1a39 3815 apropos_accumulate = Qnil;
88539837 3816 map_obarray (Vobarray, apropos_accum, regexp);
5d55ffd0
RS
3817 tem = Fsort (apropos_accumulate, Qstring_lessp);
3818 apropos_accumulate = Qnil;
3819 apropos_predicate = Qnil;
3820 return tem;
2c6f1a39
JB
3821}
3822\f
dfcf069d 3823void
2c6f1a39
JB
3824syms_of_keymap ()
3825{
2c6f1a39
JB
3826 Qkeymap = intern ("keymap");
3827 staticpro (&Qkeymap);
5d55ffd0
RS
3828 staticpro (&apropos_predicate);
3829 staticpro (&apropos_accumulate);
3830 apropos_predicate = Qnil;
3831 apropos_accumulate = Qnil;
2c6f1a39 3832
0403641f
RS
3833 /* Now we are ready to set up this property, so we can
3834 create char tables. */
3835 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3836
3837 /* Initialize the keymaps standardly used.
3838 Each one is the value of a Lisp variable, and is also
3839 pointed to by a C variable */
2c6f1a39 3840
0403641f 3841 global_map = Fmake_keymap (Qnil);
2c6f1a39
JB
3842 Fset (intern ("global-map"), global_map);
3843
44bff953 3844 current_global_map = global_map;
a3e99933 3845 staticpro (&global_map);
44bff953
RS
3846 staticpro (&current_global_map);
3847
ce6e5d0b 3848 meta_map = Fmake_keymap (Qnil);
2c6f1a39
JB
3849 Fset (intern ("esc-map"), meta_map);
3850 Ffset (intern ("ESC-prefix"), meta_map);
3851
ce6e5d0b 3852 control_x_map = Fmake_keymap (Qnil);
2c6f1a39
JB
3853 Fset (intern ("ctl-x-map"), control_x_map);
3854 Ffset (intern ("Control-X-prefix"), control_x_map);
3855
2fae9111
RS
3856 exclude_keys
3857 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3858 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3859 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3860 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3861 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3862 Qnil)))));
3863 staticpro (&exclude_keys);
3864
107fd03d 3865 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
335c5470
PJ
3866 doc: /* List of commands given new key bindings recently.
3867This is used for internal purposes during Emacs startup;
3868don't alter it yourself. */);
107fd03d
RS
3869 Vdefine_key_rebound_commands = Qt;
3870
2c6f1a39 3871 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
335c5470 3872 doc: /* Default keymap to use when reading from the minibuffer. */);
ce6e5d0b 3873 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
2c6f1a39
JB
3874
3875 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
335c5470 3876 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
ce6e5d0b 3877 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
2b6748c0 3878 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
2c6f1a39
JB
3879
3880 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
335c5470 3881 doc: /* Local keymap for minibuffer input with completion. */);
ce6e5d0b 3882 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
2b6748c0 3883 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
2c6f1a39 3884
3d866ceb
EZ
3885 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
3886 &Vminibuffer_local_filename_completion_map,
3887 doc: /* Local keymap for minibuffer input with completion for filenames. */);
3888 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
3889 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
3890 Vminibuffer_local_completion_map);
3891
3892
2c6f1a39 3893 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
335c5470 3894 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
ce6e5d0b 3895 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
2b6748c0
SM
3896 Fset_keymap_parent (Vminibuffer_local_must_match_map,
3897 Vminibuffer_local_completion_map);
2c6f1a39 3898
3d866ceb
EZ
3899 DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
3900 &Vminibuffer_local_must_match_filename_map,
3901 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
3902 Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
3903 Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
3904 Vminibuffer_local_must_match_map);
3905
cc0a8174 3906 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
335c5470
PJ
3907 doc: /* Alist of keymaps to use for minor modes.
3908Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3909key sequences and look up bindings iff VARIABLE's value is non-nil.
3910If two active keymaps bind the same key, the keymap appearing earlier
3911in the list takes precedence. */);
cc0a8174
JB
3912 Vminor_mode_map_alist = Qnil;
3913
dd9cda06 3914 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
335c5470 3915 doc: /* Alist of keymaps to use for minor modes, in current major mode.
95296eac 3916This variable is an alist just like `minor-mode-map-alist', and it is
335c5470
PJ
3917used the same way (and before `minor-mode-map-alist'); however,
3918it is provided for major modes to bind locally. */);
dd9cda06
RS
3919 Vminor_mode_overriding_map_alist = Qnil;
3920
99cbcaca
KS
3921 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
3922 doc: /* List of keymap alists to use for emulations modes.
3923It is intended for modes or packages using multiple minor-mode keymaps.
3924Each element is a keymap alist just like `minor-mode-map-alist', or a
3925symbol with a variable binding which is a keymap alist, and it is used
3926the same way. The "active" keymaps in each alist are used before
744cd66b 3927`minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
99cbcaca
KS
3928 Vemulation_mode_map_alists = Qnil;
3929
3930
6bbbd9b0 3931 DEFVAR_LISP ("function-key-map", &Vfunction_key_map,
49daa5b1
RS
3932 doc: /* Keymap that translates key sequences to key sequences during input.
3933This is used mainly for mapping ASCII function key sequences into
3934real Emacs function key events (symbols).
335c5470
PJ
3935
3936The `read-key-sequence' function replaces any subsequence bound by
3937`function-key-map' with its binding. More precisely, when the active
3938keymaps have no binding for the current key sequence but
3939`function-key-map' binds a suffix of the sequence to a vector or string,
3940`read-key-sequence' replaces the matching suffix with its binding, and
3941continues with the new sequence.
3942
addcdb7c
SM
3943If the binding is a function, it is called with one argument (the prompt)
3944and its return value (a key sequence) is used.
3945
335c5470
PJ
3946The events that come from bindings in `function-key-map' are not
3947themselves looked up in `function-key-map'.
3948
3949For example, suppose `function-key-map' binds `ESC O P' to [f1].
3950Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3951`C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3952key, typing `ESC O P x' would return [f1 x]. */);
ce6e5d0b 3953 Vfunction_key_map = Fmake_sparse_keymap (Qnil);
6bbbd9b0 3954
d7bf9bf5 3955 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map,
335c5470
PJ
3956 doc: /* Keymap of key translations that can override keymaps.
3957This keymap works like `function-key-map', but comes after that,
7a093e87 3958and its non-prefix bindings override ordinary bindings. */);
d7bf9bf5
RS
3959 Vkey_translation_map = Qnil;
3960
9d209cfe
SM
3961 staticpro (&Vmouse_events);
3962 Vmouse_events = Fcons (intern ("menu-bar"),
3963 Fcons (intern ("tool-bar"),
3964 Fcons (intern ("header-line"),
3965 Fcons (intern ("mode-line"),
3966 Fcons (intern ("mouse-1"),
3967 Fcons (intern ("mouse-2"),
3968 Fcons (intern ("mouse-3"),
3969 Fcons (intern ("mouse-4"),
3970 Fcons (intern ("mouse-5"),
3971 Qnil)))))))));
d378869e
SM
3972
3973
2c6f1a39
JB
3974 Qsingle_key_description = intern ("single-key-description");
3975 staticpro (&Qsingle_key_description);
3976
3977 Qkey_description = intern ("key-description");
3978 staticpro (&Qkey_description);
3979
3980 Qkeymapp = intern ("keymapp");
3981 staticpro (&Qkeymapp);
3982
2fc66973
JB
3983 Qnon_ascii = intern ("non-ascii");
3984 staticpro (&Qnon_ascii);
3985
a3fc8840
RS
3986 Qmenu_item = intern ("menu-item");
3987 staticpro (&Qmenu_item);
3988
a1df473f
KS
3989 Qremap = intern ("remap");
3990 staticpro (&Qremap);
3991
023b93f6
KS
3992 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
3993 staticpro (&command_remapping_vector);
a1df473f 3994
1e7d1ab0
SM
3995 where_is_cache_keymaps = Qt;
3996 where_is_cache = Qnil;
3997 staticpro (&where_is_cache);
3998 staticpro (&where_is_cache_keymaps);
3999
2c6f1a39 4000 defsubr (&Skeymapp);
7d58ed99 4001 defsubr (&Skeymap_parent);
54cbc3d4 4002 defsubr (&Skeymap_prompt);
7d58ed99 4003 defsubr (&Sset_keymap_parent);
2c6f1a39
JB
4004 defsubr (&Smake_keymap);
4005 defsubr (&Smake_sparse_keymap);
9d3153eb 4006 defsubr (&Smap_keymap);
2c6f1a39 4007 defsubr (&Scopy_keymap);
023b93f6 4008 defsubr (&Scommand_remapping);
2c6f1a39
JB
4009 defsubr (&Skey_binding);
4010 defsubr (&Slocal_key_binding);
4011 defsubr (&Sglobal_key_binding);
cc0a8174 4012 defsubr (&Sminor_mode_key_binding);
2c6f1a39
JB
4013 defsubr (&Sdefine_key);
4014 defsubr (&Slookup_key);
2c6f1a39
JB
4015 defsubr (&Sdefine_prefix_command);
4016 defsubr (&Suse_global_map);
4017 defsubr (&Suse_local_map);
4018 defsubr (&Scurrent_local_map);
4019 defsubr (&Scurrent_global_map);
cc0a8174 4020 defsubr (&Scurrent_minor_mode_maps);
54cbc3d4 4021 defsubr (&Scurrent_active_maps);
2c6f1a39
JB
4022 defsubr (&Saccessible_keymaps);
4023 defsubr (&Skey_description);
4024 defsubr (&Sdescribe_vector);
4025 defsubr (&Ssingle_key_description);
4026 defsubr (&Stext_char_description);
4027 defsubr (&Swhere_is_internal);
54cbc3d4 4028 defsubr (&Sdescribe_buffer_bindings);
2c6f1a39
JB
4029 defsubr (&Sapropos_internal);
4030}
4031
dfcf069d 4032void
2c6f1a39
JB
4033keys_of_keymap ()
4034{
2c6f1a39
JB
4035 initial_define_key (global_map, 033, "ESC-prefix");
4036 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
4037}
ab5796a9
MB
4038
4039/* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4040 (do not change this comment) */