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