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