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