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