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