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