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