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