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