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