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