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