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