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