Fix cursor display when several display strings follow each other.
[emacs.git] / src / keymap.c
blobfbdd31e0de302f6692e335951d4fb35e60e1f091
1 /* Manipulation of keymaps
2 Copyright (C) 1985-1988, 1993-1995, 1998-2012 Free Software Foundation, Inc.
4 This file is part of GNU Emacs.
6 GNU Emacs is free software: you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation, either version 3 of the License, or
9 (at your option) any later version.
11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
16 You should have received a copy of the GNU General Public License
17 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
19 /* Old BUGS:
20 - [M-C-a] != [?\M-\C-a]
21 - [M-f2] != [?\e f2].
22 - (define-key map [menu-bar foo] <bla>) does not always place <bla>
23 at the head of the menu (if `foo' was already bound earlier and
24 then unbound, for example).
25 TODO:
26 - allow many more Meta -> ESC mappings (like Hyper -> C-e for Emacspeak)
27 - Think about the various defaulting that's currently hard-coded in
28 keyboard.c (uppercase->lowercase, char->charset, button-events, ...)
29 and make it more generic. Maybe we should allow mappings of the
30 form (PREDICATE . BINDING) as generalization of the default binding,
31 tho probably a cleaner way to attack this is to allow functional
32 keymaps (i.e. keymaps that are implemented as functions that implement
33 a few different methods like `lookup', `map', ...).
34 - Make [a] equivalent to [?a].
35 BEWARE:
36 - map-keymap should work meaningfully even if entries are added/removed
37 to the keymap while iterating through it:
38 start - removed <= visited <= start + added
41 #include <config.h>
42 #include <stdio.h>
44 #include "lisp.h"
45 #include "commands.h"
46 #include "character.h"
47 #include "buffer.h"
48 #include "charset.h"
49 #include "keyboard.h"
50 #include "frame.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"
58 /* Actually allocate storage for these variables */
60 Lisp_Object current_global_map; /* Current global keymap */
62 Lisp_Object global_map; /* default global key bindings */
64 Lisp_Object meta_map; /* The keymap used for globally bound
65 ESC-prefixed default commands */
67 Lisp_Object control_x_map; /* The keymap used for globally bound
68 C-x-prefixed default commands */
70 /* The keymap used by the minibuf for local
71 bindings when spaces are allowed in the
72 minibuf */
74 /* The keymap used by the minibuf for local
75 bindings when spaces are not encouraged
76 in the minibuf */
78 /* keymap used for minibuffers when doing completion */
79 /* keymap used for minibuffers when doing completion and require a match */
80 static Lisp_Object Qkeymapp, Qnon_ascii;
81 Lisp_Object Qkeymap, Qmenu_item, Qremap;
82 static Lisp_Object QCadvertised_binding;
84 /* Alist of elements like (DEL . "\d"). */
85 static Lisp_Object exclude_keys;
87 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
88 static Lisp_Object command_remapping_vector;
90 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
91 static Lisp_Object where_is_cache;
92 /* Which keymaps are reverse-stored in the cache. */
93 static Lisp_Object where_is_cache_keymaps;
95 static Lisp_Object store_in_keymap (Lisp_Object, Lisp_Object, Lisp_Object);
97 static Lisp_Object define_as_prefix (Lisp_Object, Lisp_Object);
98 static void describe_command (Lisp_Object, Lisp_Object);
99 static void describe_translation (Lisp_Object, Lisp_Object);
100 static void describe_map (Lisp_Object, Lisp_Object,
101 void (*) (Lisp_Object, Lisp_Object),
102 bool, Lisp_Object, Lisp_Object*, bool, bool);
103 static void describe_vector (Lisp_Object, Lisp_Object, Lisp_Object,
104 void (*) (Lisp_Object, Lisp_Object), bool,
105 Lisp_Object, Lisp_Object, bool, bool);
106 static void silly_event_symbol_error (Lisp_Object);
107 static Lisp_Object get_keyelt (Lisp_Object, bool);
109 /* Keymap object support - constructors and predicates. */
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.
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)
123 Lisp_Object tail;
124 if (!NILP (string))
125 tail = Fcons (string, Qnil);
126 else
127 tail = Qnil;
128 return Fcons (Qkeymap,
129 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
132 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
133 doc: /* Construct and return a new sparse keymap.
134 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
135 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
136 which binds the function key or mouse event SYMBOL to DEFINITION.
137 Initially the alist is nil.
139 The optional arg STRING supplies a menu name for the keymap
140 in case you use it as a menu with `x-popup-menu'. */)
141 (Lisp_Object string)
143 if (!NILP (string))
145 if (!NILP (Vpurify_flag))
146 string = Fpurecopy (string);
147 return Fcons (Qkeymap, Fcons (string, Qnil));
149 return Fcons (Qkeymap, Qnil);
152 /* This function is used for installing the standard key bindings
153 at initialization time.
155 For example:
157 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
159 void
160 initial_define_key (Lisp_Object keymap, int key, const char *defname)
162 store_in_keymap (keymap, make_number (key), intern_c_string (defname));
165 void
166 initial_define_lispy_key (Lisp_Object keymap, const char *keyname, const char *defname)
168 store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
171 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
172 doc: /* Return t if OBJECT is a keymap.
174 A keymap is a list (keymap . ALIST),
175 or a symbol whose function definition is itself a keymap.
176 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
177 a vector of densely packed bindings for small character codes
178 is also allowed as an element. */)
179 (Lisp_Object object)
181 return (KEYMAPP (object) ? Qt : Qnil);
184 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
185 doc: /* Return the prompt-string of a keymap MAP.
186 If non-nil, the prompt is shown in the echo-area
187 when reading a key-sequence to be looked-up in this keymap. */)
188 (Lisp_Object map)
190 map = get_keymap (map, 0, 0);
191 while (CONSP (map))
193 Lisp_Object tem = XCAR (map);
194 if (STRINGP (tem))
195 return tem;
196 else if (KEYMAPP (tem))
198 tem = Fkeymap_prompt (tem);
199 if (!NILP (tem))
200 return tem;
202 map = XCDR (map);
204 return Qnil;
207 /* Check that OBJECT is a keymap (after dereferencing through any
208 symbols). If it is, return it.
210 If AUTOLOAD and if OBJECT is a symbol whose function value
211 is an autoload form, do the autoload and try again.
212 If AUTOLOAD, callers must assume GC is possible.
214 ERROR_IF_NOT_KEYMAP controls how we respond if OBJECT isn't a keymap.
215 If ERROR_IF_NOT_KEYMAP, signal an error; otherwise,
216 just return Qnil.
218 Note that most of the time, we don't want to pursue autoloads.
219 Functions like Faccessible_keymaps which scan entire keymap trees
220 shouldn't load every autoloaded keymap. I'm not sure about this,
221 but it seems to me that only read_key_sequence, Flookup_key, and
222 Fdefine_key should cause keymaps to be autoloaded.
224 This function can GC when AUTOLOAD is true, because it calls
225 Fautoload_do_load which can GC. */
227 Lisp_Object
228 get_keymap (Lisp_Object object, bool error_if_not_keymap, bool autoload)
230 Lisp_Object tem;
232 autoload_retry:
233 if (NILP (object))
234 goto end;
235 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
236 return object;
238 tem = indirect_function (object);
239 if (CONSP (tem))
241 if (EQ (XCAR (tem), Qkeymap))
242 return tem;
244 /* Should we do an autoload? Autoload forms for keymaps have
245 Qkeymap as their fifth element. */
246 if ((autoload || !error_if_not_keymap) && EQ (XCAR (tem), Qautoload)
247 && SYMBOLP (object))
249 Lisp_Object tail;
251 tail = Fnth (make_number (4), tem);
252 if (EQ (tail, Qkeymap))
254 if (autoload)
256 struct gcpro gcpro1, gcpro2;
258 GCPRO2 (tem, object);
259 Fautoload_do_load (tem, object, Qnil);
260 UNGCPRO;
262 goto autoload_retry;
264 else
265 return object;
270 end:
271 if (error_if_not_keymap)
272 wrong_type_argument (Qkeymapp, object);
273 return Qnil;
276 /* Return the parent map of KEYMAP, or nil if it has none.
277 We assume that KEYMAP is a valid keymap. */
279 static Lisp_Object
280 keymap_parent (Lisp_Object keymap, bool autoload)
282 Lisp_Object list;
284 keymap = get_keymap (keymap, 1, autoload);
286 /* Skip past the initial element `keymap'. */
287 list = XCDR (keymap);
288 for (; CONSP (list); list = XCDR (list))
290 /* See if there is another `keymap'. */
291 if (KEYMAPP (list))
292 return list;
295 return get_keymap (list, 0, autoload);
298 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
299 doc: /* Return the parent keymap of KEYMAP.
300 If KEYMAP has no parent, return nil. */)
301 (Lisp_Object keymap)
303 return keymap_parent (keymap, 1);
306 /* Check whether MAP is one of MAPS parents. */
307 static bool
308 keymap_memberp (Lisp_Object map, Lisp_Object maps)
310 if (NILP (map)) return 0;
311 while (KEYMAPP (maps) && !EQ (map, maps))
312 maps = keymap_parent (maps, 0);
313 return (EQ (map, maps));
316 /* Set the parent keymap of MAP to PARENT. */
318 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
319 doc: /* Modify KEYMAP to set its parent map to PARENT.
320 Return PARENT. PARENT should be nil or another keymap. */)
321 (Lisp_Object keymap, Lisp_Object parent)
323 Lisp_Object list, prev;
324 struct gcpro gcpro1, gcpro2;
326 /* Flush any reverse-map cache. */
327 where_is_cache = Qnil; where_is_cache_keymaps = Qt;
329 GCPRO2 (keymap, parent);
330 keymap = get_keymap (keymap, 1, 1);
332 if (!NILP (parent))
334 parent = get_keymap (parent, 1, 0);
336 /* Check for cycles. */
337 if (keymap_memberp (keymap, parent))
338 error ("Cyclic keymap inheritance");
341 /* Skip past the initial element `keymap'. */
342 prev = keymap;
343 while (1)
345 list = XCDR (prev);
346 /* If there is a parent keymap here, replace it.
347 If we came to the end, add the parent in PREV. */
348 if (!CONSP (list) || KEYMAPP (list))
350 CHECK_IMPURE (prev);
351 XSETCDR (prev, parent);
352 RETURN_UNGCPRO (parent);
354 prev = list;
359 /* Look up IDX in MAP. IDX may be any sort of event.
360 Note that this does only one level of lookup; IDX must be a single
361 event, not a sequence.
363 MAP must be a keymap or a list of keymaps.
365 If T_OK, bindings for Qt are treated as default
366 bindings; any key left unmentioned by other tables and bindings is
367 given the binding of Qt.
369 If not T_OK, bindings for Qt are not treated specially.
371 If NOINHERIT, don't accept a subkeymap found in an inherited keymap.
373 Return Qunbound if no binding was found (and return Qnil if a nil
374 binding was found). */
376 static Lisp_Object
377 access_keymap_1 (Lisp_Object map, Lisp_Object idx,
378 bool t_ok, bool noinherit, bool autoload)
380 /* If idx is a list (some sort of mouse click, perhaps?),
381 the index we want to use is the car of the list, which
382 ought to be a symbol. */
383 idx = EVENT_HEAD (idx);
385 /* If idx is a symbol, it might have modifiers, which need to
386 be put in the canonical order. */
387 if (SYMBOLP (idx))
388 idx = reorder_modifiers (idx);
389 else if (INTEGERP (idx))
390 /* Clobber the high bits that can be present on a machine
391 with more than 24 bits of integer. */
392 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
394 /* Handle the special meta -> esc mapping. */
395 if (INTEGERP (idx) && XFASTINT (idx) & meta_modifier)
397 /* See if there is a meta-map. If there's none, there is
398 no binding for IDX, unless a default binding exists in MAP. */
399 struct gcpro gcpro1;
400 Lisp_Object event_meta_binding, event_meta_map;
401 GCPRO1 (map);
402 /* A strange value in which Meta is set would cause
403 infinite recursion. Protect against that. */
404 if (XINT (meta_prefix_char) & CHAR_META)
405 meta_prefix_char = make_number (27);
406 event_meta_binding = access_keymap_1 (map, meta_prefix_char, t_ok,
407 noinherit, autoload);
408 event_meta_map = get_keymap (event_meta_binding, 0, autoload);
409 UNGCPRO;
410 if (CONSP (event_meta_map))
412 map = event_meta_map;
413 idx = make_number (XFASTINT (idx) & ~meta_modifier);
415 else if (t_ok)
416 /* Set IDX to t, so that we only find a default binding. */
417 idx = Qt;
418 else
419 /* An explicit nil binding, or no binding at all. */
420 return NILP (event_meta_binding) ? Qnil : Qunbound;
423 /* t_binding is where we put a default binding that applies,
424 to use in case we do not find a binding specifically
425 for this key sequence. */
427 Lisp_Object tail;
428 Lisp_Object t_binding = Qunbound;
429 Lisp_Object retval = Qunbound;
430 Lisp_Object retval_tail = Qnil;
431 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
433 GCPRO4 (tail, idx, t_binding, retval);
435 for (tail = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
436 (CONSP (tail)
437 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
438 tail = XCDR (tail))
440 /* Qunbound in VAL means we have found no binding. */
441 Lisp_Object val = Qunbound;
442 Lisp_Object binding = XCAR (tail);
443 Lisp_Object submap = get_keymap (binding, 0, autoload);
445 if (EQ (binding, Qkeymap))
447 if (noinherit || NILP (retval))
448 /* If NOINHERIT, stop here, the rest is inherited. */
449 break;
450 else if (!EQ (retval, Qunbound))
452 Lisp_Object parent_entry;
453 eassert (KEYMAPP (retval));
454 parent_entry
455 = get_keymap (access_keymap_1 (tail, idx,
456 t_ok, 0, autoload),
457 0, autoload);
458 if (KEYMAPP (parent_entry))
460 if (CONSP (retval_tail))
461 XSETCDR (retval_tail, parent_entry);
462 else
464 retval_tail = Fcons (retval, parent_entry);
465 retval = Fcons (Qkeymap, retval_tail);
468 break;
471 else if (CONSP (submap))
473 val = access_keymap_1 (submap, idx, t_ok, noinherit, autoload);
475 else if (CONSP (binding))
477 Lisp_Object key = XCAR (binding);
479 if (EQ (key, idx))
480 val = XCDR (binding);
481 else if (t_ok && EQ (key, Qt))
483 t_binding = XCDR (binding);
484 t_ok = 0;
487 else if (VECTORP (binding))
489 if (INTEGERP (idx) && XFASTINT (idx) < ASIZE (binding))
490 val = AREF (binding, XFASTINT (idx));
492 else if (CHAR_TABLE_P (binding))
494 /* Character codes with modifiers
495 are not included in a char-table.
496 All character codes without modifiers are included. */
497 if (INTEGERP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
499 val = Faref (binding, idx);
500 /* `nil' has a special meaning for char-tables, so
501 we use something else to record an explicitly
502 unbound entry. */
503 if (NILP (val))
504 val = Qunbound;
508 /* If we found a binding, clean it up and return it. */
509 if (!EQ (val, Qunbound))
511 if (EQ (val, Qt))
512 /* A Qt binding is just like an explicit nil binding
513 (i.e. it shadows any parent binding but not bindings in
514 keymaps of lower precedence). */
515 val = Qnil;
517 val = get_keyelt (val, autoload);
519 if (!KEYMAPP (val))
521 if (NILP (retval) || EQ (retval, Qunbound))
522 retval = val;
523 if (!NILP (val))
524 break; /* Shadows everything that follows. */
526 else if (NILP (retval) || EQ (retval, Qunbound))
527 retval = val;
528 else if (CONSP (retval_tail))
530 XSETCDR (retval_tail, Fcons (val, Qnil));
531 retval_tail = XCDR (retval_tail);
533 else
535 retval_tail = Fcons (val, Qnil);
536 retval = Fcons (Qkeymap, Fcons (retval, retval_tail));
539 QUIT;
541 UNGCPRO;
542 return EQ (Qunbound, retval) ? get_keyelt (t_binding, autoload) : retval;
546 Lisp_Object
547 access_keymap (Lisp_Object map, Lisp_Object idx,
548 bool t_ok, bool noinherit, bool autoload)
550 Lisp_Object val = access_keymap_1 (map, idx, t_ok, noinherit, autoload);
551 return EQ (val, Qunbound) ? Qnil : val;
554 static void
555 map_keymap_item (map_keymap_function_t fun, Lisp_Object args, Lisp_Object key, Lisp_Object val, void *data)
557 if (EQ (val, Qt))
558 val = Qnil;
559 (*fun) (key, val, args, data);
562 static void
563 map_keymap_char_table_item (Lisp_Object args, Lisp_Object key, Lisp_Object val)
565 if (!NILP (val))
567 map_keymap_function_t fun
568 = (map_keymap_function_t) XSAVE_VALUE (XCAR (args))->pointer;
569 args = XCDR (args);
570 /* If the key is a range, make a copy since map_char_table modifies
571 it in place. */
572 if (CONSP (key))
573 key = Fcons (XCAR (key), XCDR (key));
574 map_keymap_item (fun, XCDR (args), key, val,
575 XSAVE_VALUE (XCAR (args))->pointer);
579 /* Call FUN for every binding in MAP and stop at (and return) the parent.
580 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA). */
581 static Lisp_Object
582 map_keymap_internal (Lisp_Object map,
583 map_keymap_function_t fun,
584 Lisp_Object args,
585 void *data)
587 struct gcpro gcpro1, gcpro2, gcpro3;
588 Lisp_Object tail
589 = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
591 GCPRO3 (map, args, tail);
592 for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
594 Lisp_Object binding = XCAR (tail);
596 if (KEYMAPP (binding)) /* An embedded parent. */
597 break;
598 else if (CONSP (binding))
599 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
600 else if (VECTORP (binding))
602 /* Loop over the char values represented in the vector. */
603 int len = ASIZE (binding);
604 int c;
605 for (c = 0; c < len; c++)
607 Lisp_Object character;
608 XSETFASTINT (character, c);
609 map_keymap_item (fun, args, character, AREF (binding, c), data);
612 else if (CHAR_TABLE_P (binding))
614 map_char_table (map_keymap_char_table_item, Qnil, binding,
615 Fcons (make_save_value ((void *) fun, 0),
616 Fcons (make_save_value (data, 0),
617 args)));
620 UNGCPRO;
621 return tail;
624 static void
625 map_keymap_call (Lisp_Object key, Lisp_Object val, Lisp_Object fun, void *dummy)
627 call2 (fun, key, val);
630 /* Same as map_keymap_internal, but traverses parent keymaps as well.
631 AUTOLOAD indicates that autoloaded keymaps should be loaded. */
632 void
633 map_keymap (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args,
634 void *data, bool autoload)
636 struct gcpro gcpro1;
637 GCPRO1 (args);
638 map = get_keymap (map, 1, autoload);
639 while (CONSP (map))
641 if (KEYMAPP (XCAR (map)))
643 map_keymap (XCAR (map), fun, args, data, autoload);
644 map = XCDR (map);
646 else
647 map = map_keymap_internal (map, fun, args, data);
648 if (!CONSP (map))
649 map = get_keymap (map, 0, autoload);
651 UNGCPRO;
654 static Lisp_Object Qkeymap_canonicalize;
656 /* Same as map_keymap, but does it right, properly eliminating duplicate
657 bindings due to inheritance. */
658 void
659 map_keymap_canonical (Lisp_Object map, map_keymap_function_t fun, Lisp_Object args, void *data)
661 struct gcpro gcpro1;
662 GCPRO1 (args);
663 /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
664 so be careful to ignore errors and to inhibit redisplay. */
665 map = safe_call1 (Qkeymap_canonicalize, map);
666 /* No need to use `map_keymap' here because canonical map has no parent. */
667 map_keymap_internal (map, fun, args, data);
668 UNGCPRO;
671 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
672 doc: /* Call FUNCTION once for each event binding in KEYMAP.
673 FUNCTION is called with two arguments: the event that is bound, and
674 the definition it is bound to. The event may be a character range.
675 If KEYMAP has a parent, this function returns it without processing it. */)
676 (Lisp_Object function, Lisp_Object keymap)
678 struct gcpro gcpro1;
679 GCPRO1 (function);
680 keymap = get_keymap (keymap, 1, 1);
681 keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
682 UNGCPRO;
683 return keymap;
686 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
687 doc: /* Call FUNCTION once for each event binding in KEYMAP.
688 FUNCTION is called with two arguments: the event that is bound, and
689 the definition it is bound to. The event may be a character range.
691 If KEYMAP has a parent, the parent's bindings are included as well.
692 This works recursively: if the parent has itself a parent, then the
693 grandparent's bindings are also included and so on.
694 usage: (map-keymap FUNCTION KEYMAP) */)
695 (Lisp_Object function, Lisp_Object keymap, Lisp_Object sort_first)
697 if (! NILP (sort_first))
698 return call2 (intern ("map-keymap-sorted"), function, keymap);
700 map_keymap (keymap, map_keymap_call, function, NULL, 1);
701 return Qnil;
704 /* Given OBJECT which was found in a slot in a keymap,
705 trace indirect definitions to get the actual definition of that slot.
706 An indirect definition is a list of the form
707 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
708 and INDEX is the object to look up in KEYMAP to yield the definition.
710 Also if OBJECT has a menu string as the first element,
711 remove that. Also remove a menu help string as second element.
713 If AUTOLOAD, load autoloadable keymaps
714 that are referred to with indirection.
716 This can GC because menu_item_eval_property calls Feval. */
718 static Lisp_Object
719 get_keyelt (Lisp_Object object, bool autoload)
721 while (1)
723 if (!(CONSP (object)))
724 /* This is really the value. */
725 return object;
727 /* If the keymap contents looks like (keymap ...) or (lambda ...)
728 then use itself. */
729 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
730 return object;
732 /* If the keymap contents looks like (menu-item name . DEFN)
733 or (menu-item name DEFN ...) then use DEFN.
734 This is a new format menu item. */
735 else if (EQ (XCAR (object), Qmenu_item))
737 if (CONSP (XCDR (object)))
739 Lisp_Object tem;
741 object = XCDR (XCDR (object));
742 tem = object;
743 if (CONSP (object))
744 object = XCAR (object);
746 /* If there's a `:filter FILTER', apply FILTER to the
747 menu-item's definition to get the real definition to
748 use. */
749 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
750 if (EQ (XCAR (tem), QCfilter) && autoload)
752 Lisp_Object filter;
753 filter = XCAR (XCDR (tem));
754 filter = list2 (filter, list2 (Qquote, object));
755 object = menu_item_eval_property (filter);
756 break;
759 else
760 /* Invalid keymap. */
761 return object;
764 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
765 Keymap alist elements like (CHAR MENUSTRING . DEFN)
766 will be used by HierarKey menus. */
767 else if (STRINGP (XCAR (object)))
769 object = XCDR (object);
770 /* Also remove a menu help string, if any,
771 following the menu item name. */
772 if (CONSP (object) && STRINGP (XCAR (object)))
773 object = XCDR (object);
774 /* Also remove the sublist that caches key equivalences, if any. */
775 if (CONSP (object) && CONSP (XCAR (object)))
777 Lisp_Object carcar;
778 carcar = XCAR (XCAR (object));
779 if (NILP (carcar) || VECTORP (carcar))
780 object = XCDR (object);
784 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
785 else if (KEYMAPP (XCAR (object)))
786 error ("Wow, indirect keymap entry!!");
787 else
788 return object;
792 static Lisp_Object
793 store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def)
795 /* Flush any reverse-map cache. */
796 where_is_cache = Qnil;
797 where_is_cache_keymaps = Qt;
799 if (EQ (idx, Qkeymap))
800 error ("`keymap' is reserved for embedded parent maps");
802 /* If we are preparing to dump, and DEF is a menu element
803 with a menu item indicator, copy it to ensure it is not pure. */
804 if (CONSP (def) && PURE_P (def)
805 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
806 def = Fcons (XCAR (def), XCDR (def));
808 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
809 error ("attempt to define a key in a non-keymap");
811 /* If idx is a cons, and the car part is a character, idx must be of
812 the form (FROM-CHAR . TO-CHAR). */
813 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
814 CHECK_CHARACTER_CDR (idx);
815 else
816 /* If idx is a list (some sort of mouse click, perhaps?),
817 the index we want to use is the car of the list, which
818 ought to be a symbol. */
819 idx = EVENT_HEAD (idx);
821 /* If idx is a symbol, it might have modifiers, which need to
822 be put in the canonical order. */
823 if (SYMBOLP (idx))
824 idx = reorder_modifiers (idx);
825 else if (INTEGERP (idx))
826 /* Clobber the high bits that can be present on a machine
827 with more than 24 bits of integer. */
828 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
830 /* Scan the keymap for a binding of idx. */
832 Lisp_Object tail;
834 /* The cons after which we should insert new bindings. If the
835 keymap has a table element, we record its position here, so new
836 bindings will go after it; this way, the table will stay
837 towards the front of the alist and character lookups in dense
838 keymaps will remain fast. Otherwise, this just points at the
839 front of the keymap. */
840 Lisp_Object insertion_point;
842 insertion_point = keymap;
843 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
845 Lisp_Object elt;
847 elt = XCAR (tail);
848 if (VECTORP (elt))
850 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
852 CHECK_IMPURE (elt);
853 ASET (elt, XFASTINT (idx), def);
854 return def;
856 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
858 int from = XFASTINT (XCAR (idx));
859 int to = XFASTINT (XCDR (idx));
861 if (to >= ASIZE (elt))
862 to = ASIZE (elt) - 1;
863 for (; from <= to; from++)
864 ASET (elt, from, def);
865 if (to == XFASTINT (XCDR (idx)))
866 /* We have defined all keys in IDX. */
867 return def;
869 insertion_point = tail;
871 else if (CHAR_TABLE_P (elt))
873 /* Character codes with modifiers
874 are not included in a char-table.
875 All character codes without modifiers are included. */
876 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
878 Faset (elt, idx,
879 /* `nil' has a special meaning for char-tables, so
880 we use something else to record an explicitly
881 unbound entry. */
882 NILP (def) ? Qt : def);
883 return def;
885 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
887 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
888 return def;
890 insertion_point = tail;
892 else if (CONSP (elt))
894 if (EQ (Qkeymap, XCAR (elt)))
895 { /* A sub keymap. This might be due to a lookup that found
896 two matching bindings (maybe because of a sub keymap).
897 It almost never happens (since the second binding normally
898 only happens in the inherited part of the keymap), but
899 if it does, we want to update the sub-keymap since the
900 main one might be temporary (built by access_keymap). */
901 tail = insertion_point = elt;
903 else if (EQ (idx, XCAR (elt)))
905 CHECK_IMPURE (elt);
906 XSETCDR (elt, def);
907 return def;
909 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
911 int from = XFASTINT (XCAR (idx));
912 int to = XFASTINT (XCDR (idx));
914 if (from <= XFASTINT (XCAR (elt))
915 && to >= XFASTINT (XCAR (elt)))
917 XSETCDR (elt, def);
918 if (from == to)
919 return def;
923 else if (EQ (elt, Qkeymap))
924 /* If we find a 'keymap' symbol in the spine of KEYMAP,
925 then we must have found the start of a second keymap
926 being used as the tail of KEYMAP, and a binding for IDX
927 should be inserted before it. */
928 goto keymap_end;
930 QUIT;
933 keymap_end:
934 /* We have scanned the entire keymap, and not found a binding for
935 IDX. Let's add one. */
937 Lisp_Object elt;
939 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
941 /* IDX specifies a range of characters, and not all of them
942 were handled yet, which means this keymap doesn't have a
943 char-table. So, we insert a char-table now. */
944 elt = Fmake_char_table (Qkeymap, Qnil);
945 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
947 else
948 elt = Fcons (idx, def);
949 CHECK_IMPURE (insertion_point);
950 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
954 return def;
957 static Lisp_Object
958 copy_keymap_item (Lisp_Object elt)
960 Lisp_Object res, tem;
962 if (!CONSP (elt))
963 return elt;
965 res = tem = elt;
967 /* Is this a new format menu item. */
968 if (EQ (XCAR (tem), Qmenu_item))
970 /* Copy cell with menu-item marker. */
971 res = elt = Fcons (XCAR (tem), XCDR (tem));
972 tem = XCDR (elt);
973 if (CONSP (tem))
975 /* Copy cell with menu-item name. */
976 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
977 elt = XCDR (elt);
978 tem = XCDR (elt);
980 if (CONSP (tem))
982 /* Copy cell with binding and if the binding is a keymap,
983 copy that. */
984 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
985 elt = XCDR (elt);
986 tem = XCAR (elt);
987 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
988 XSETCAR (elt, Fcopy_keymap (tem));
989 tem = XCDR (elt);
990 if (CONSP (tem) && CONSP (XCAR (tem)))
991 /* Delete cache for key equivalences. */
992 XSETCDR (elt, XCDR (tem));
995 else
997 /* It may be an old format menu item.
998 Skip the optional menu string. */
999 if (STRINGP (XCAR (tem)))
1001 /* Copy the cell, since copy-alist didn't go this deep. */
1002 res = elt = Fcons (XCAR (tem), XCDR (tem));
1003 tem = XCDR (elt);
1004 /* Also skip the optional menu help string. */
1005 if (CONSP (tem) && STRINGP (XCAR (tem)))
1007 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1008 elt = XCDR (elt);
1009 tem = XCDR (elt);
1011 /* There may also be a list that caches key equivalences.
1012 Just delete it for the new keymap. */
1013 if (CONSP (tem)
1014 && CONSP (XCAR (tem))
1015 && (NILP (XCAR (XCAR (tem)))
1016 || VECTORP (XCAR (XCAR (tem)))))
1018 XSETCDR (elt, XCDR (tem));
1019 tem = XCDR (tem);
1021 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1022 XSETCDR (elt, Fcopy_keymap (tem));
1024 else if (EQ (XCAR (tem), Qkeymap))
1025 res = Fcopy_keymap (elt);
1027 return res;
1030 static void
1031 copy_keymap_1 (Lisp_Object chartable, Lisp_Object idx, Lisp_Object elt)
1033 Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
1036 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1037 doc: /* Return a copy of the keymap KEYMAP.
1038 The copy starts out with the same definitions of KEYMAP,
1039 but changing either the copy or KEYMAP does not affect the other.
1040 Any key definitions that are subkeymaps are recursively copied.
1041 However, a key definition which is a symbol whose definition is a keymap
1042 is not copied. */)
1043 (Lisp_Object keymap)
1045 register Lisp_Object copy, tail;
1046 keymap = get_keymap (keymap, 1, 0);
1047 copy = tail = Fcons (Qkeymap, Qnil);
1048 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1050 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1052 Lisp_Object elt = XCAR (keymap);
1053 if (CHAR_TABLE_P (elt))
1055 elt = Fcopy_sequence (elt);
1056 map_char_table (copy_keymap_1, Qnil, elt, elt);
1058 else if (VECTORP (elt))
1060 int i;
1061 elt = Fcopy_sequence (elt);
1062 for (i = 0; i < ASIZE (elt); i++)
1063 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1065 else if (CONSP (elt))
1067 if (EQ (XCAR (elt), Qkeymap))
1068 /* This is a sub keymap. */
1069 elt = Fcopy_keymap (elt);
1070 else
1071 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1073 XSETCDR (tail, Fcons (elt, Qnil));
1074 tail = XCDR (tail);
1075 keymap = XCDR (keymap);
1077 XSETCDR (tail, keymap);
1078 return copy;
1081 /* Simple Keymap mutators and accessors. */
1083 /* GC is possible in this function if it autoloads a keymap. */
1085 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1086 doc: /* In KEYMAP, define key sequence KEY as DEF.
1087 KEYMAP is a keymap.
1089 KEY is a string or a vector of symbols and characters, representing a
1090 sequence of keystrokes and events. Non-ASCII characters with codes
1091 above 127 (such as ISO Latin-1) can be represented by vectors.
1092 Two types of vector have special meanings:
1093 [remap COMMAND] remaps any key binding for COMMAND.
1094 [t] creates a default definition, which applies to any event with no
1095 other definition in KEYMAP.
1097 DEF is anything that can be a key's definition:
1098 nil (means key is undefined in this keymap),
1099 a command (a Lisp function suitable for interactive calling),
1100 a string (treated as a keyboard macro),
1101 a keymap (to define a prefix key),
1102 a symbol (when the key is looked up, the symbol will stand for its
1103 function definition, which should at that time be one of the above,
1104 or another symbol whose function definition is used, etc.),
1105 a cons (STRING . DEFN), meaning that DEFN is the definition
1106 (DEFN should be a valid definition in its own right),
1107 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1108 or an extended menu item definition.
1109 (See info node `(elisp)Extended Menu Items'.)
1111 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1112 binding is altered. If there is no binding for KEY, the new pair
1113 binding KEY to DEF is added at the front of KEYMAP. */)
1114 (Lisp_Object keymap, Lisp_Object key, Lisp_Object def)
1116 ptrdiff_t idx;
1117 Lisp_Object c;
1118 Lisp_Object cmd;
1119 bool metized = 0;
1120 int meta_bit;
1121 ptrdiff_t length;
1122 struct gcpro gcpro1, gcpro2, gcpro3;
1124 GCPRO3 (keymap, key, def);
1125 keymap = get_keymap (keymap, 1, 1);
1127 CHECK_VECTOR_OR_STRING (key);
1129 length = XFASTINT (Flength (key));
1130 if (length == 0)
1131 RETURN_UNGCPRO (Qnil);
1133 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1134 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1136 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1137 ? meta_modifier : 0x80);
1139 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1140 { /* DEF is apparently an XEmacs-style keyboard macro. */
1141 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1142 ptrdiff_t i = ASIZE (def);
1143 while (--i >= 0)
1145 Lisp_Object defi = AREF (def, i);
1146 if (CONSP (defi) && lucid_event_type_list_p (defi))
1147 defi = Fevent_convert_list (defi);
1148 ASET (tmp, i, defi);
1150 def = tmp;
1153 idx = 0;
1154 while (1)
1156 c = Faref (key, make_number (idx));
1158 if (CONSP (c))
1160 /* C may be a Lucid style event type list or a cons (FROM .
1161 TO) specifying a range of characters. */
1162 if (lucid_event_type_list_p (c))
1163 c = Fevent_convert_list (c);
1164 else if (CHARACTERP (XCAR (c)))
1165 CHECK_CHARACTER_CDR (c);
1168 if (SYMBOLP (c))
1169 silly_event_symbol_error (c);
1171 if (INTEGERP (c)
1172 && (XINT (c) & meta_bit)
1173 && !metized)
1175 c = meta_prefix_char;
1176 metized = 1;
1178 else
1180 if (INTEGERP (c))
1181 XSETINT (c, XINT (c) & ~meta_bit);
1183 metized = 0;
1184 idx++;
1187 if (!INTEGERP (c) && !SYMBOLP (c)
1188 && (!CONSP (c)
1189 /* If C is a range, it must be a leaf. */
1190 || (INTEGERP (XCAR (c)) && idx != length)))
1191 message_with_string ("Key sequence contains invalid event %s", c, 1);
1193 if (idx == length)
1194 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1196 cmd = access_keymap (keymap, c, 0, 1, 1);
1198 /* If this key is undefined, make it a prefix. */
1199 if (NILP (cmd))
1200 cmd = define_as_prefix (keymap, c);
1202 keymap = get_keymap (cmd, 0, 1);
1203 if (!CONSP (keymap))
1205 const char *trailing_esc = ((EQ (c, meta_prefix_char) && metized)
1206 ? (idx == 0 ? "ESC" : " ESC")
1207 : "");
1209 /* We must use Fkey_description rather than just passing key to
1210 error; key might be a vector, not a string. */
1211 error ("Key sequence %s starts with non-prefix key %s%s",
1212 SDATA (Fkey_description (key, Qnil)),
1213 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1214 make_number (idx)),
1215 Qnil)),
1216 trailing_esc);
1221 /* This function may GC (it calls Fkey_binding). */
1223 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1224 doc: /* Return the remapping for command COMMAND.
1225 Returns nil if COMMAND is not remapped (or not a symbol).
1227 If the optional argument POSITION is non-nil, it specifies a mouse
1228 position as returned by `event-start' and `event-end', and the
1229 remapping occurs in the keymaps associated with it. It can also be a
1230 number or marker, in which case the keymap properties at the specified
1231 buffer position instead of point are used. The KEYMAPS argument is
1232 ignored if POSITION is non-nil.
1234 If the optional argument KEYMAPS is non-nil, it should be a list of
1235 keymaps to search for command remapping. Otherwise, search for the
1236 remapping in all currently active keymaps. */)
1237 (Lisp_Object command, Lisp_Object position, Lisp_Object keymaps)
1239 if (!SYMBOLP (command))
1240 return Qnil;
1242 ASET (command_remapping_vector, 1, command);
1244 if (NILP (keymaps))
1245 command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1246 else
1247 command = Flookup_key (Fcons (Qkeymap, keymaps),
1248 command_remapping_vector, Qnil);
1249 return INTEGERP (command) ? Qnil : command;
1252 /* Value is number if KEY is too long; nil if valid but has no definition. */
1253 /* GC is possible in this function. */
1255 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1256 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1257 A value of nil means undefined. See doc of `define-key'
1258 for kinds of definitions.
1260 A number as value means KEY is "too long";
1261 that is, characters or symbols in it except for the last one
1262 fail to be a valid sequence of prefix characters in KEYMAP.
1263 The number is how many characters at the front of KEY
1264 it takes to reach a non-prefix key.
1266 Normally, `lookup-key' ignores bindings for t, which act as default
1267 bindings, used when nothing else in the keymap applies; this makes it
1268 usable as a general function for probing keymaps. However, if the
1269 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1270 recognize the default bindings, just as `read-key-sequence' does. */)
1271 (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default)
1273 ptrdiff_t idx;
1274 Lisp_Object cmd;
1275 Lisp_Object c;
1276 ptrdiff_t length;
1277 bool t_ok = !NILP (accept_default);
1278 struct gcpro gcpro1, gcpro2;
1280 GCPRO2 (keymap, key);
1281 keymap = get_keymap (keymap, 1, 1);
1283 CHECK_VECTOR_OR_STRING (key);
1285 length = XFASTINT (Flength (key));
1286 if (length == 0)
1287 RETURN_UNGCPRO (keymap);
1289 idx = 0;
1290 while (1)
1292 c = Faref (key, make_number (idx++));
1294 if (CONSP (c) && lucid_event_type_list_p (c))
1295 c = Fevent_convert_list (c);
1297 /* Turn the 8th bit of string chars into a meta modifier. */
1298 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1299 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1301 /* Allow string since binding for `menu-bar-select-buffer'
1302 includes the buffer name in the key sequence. */
1303 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1304 message_with_string ("Key sequence contains invalid event %s", c, 1);
1306 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1307 if (idx == length)
1308 RETURN_UNGCPRO (cmd);
1310 keymap = get_keymap (cmd, 0, 1);
1311 if (!CONSP (keymap))
1312 RETURN_UNGCPRO (make_number (idx));
1314 QUIT;
1318 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1319 Assume that currently it does not define C at all.
1320 Return the keymap. */
1322 static Lisp_Object
1323 define_as_prefix (Lisp_Object keymap, Lisp_Object c)
1325 Lisp_Object cmd;
1327 cmd = Fmake_sparse_keymap (Qnil);
1328 store_in_keymap (keymap, c, cmd);
1330 return cmd;
1333 /* Append a key to the end of a key sequence. We always make a vector. */
1335 static Lisp_Object
1336 append_key (Lisp_Object key_sequence, Lisp_Object key)
1338 Lisp_Object args[2];
1340 args[0] = key_sequence;
1342 args[1] = Fcons (key, Qnil);
1343 return Fvconcat (2, args);
1346 /* Given a event type C which is a symbol,
1347 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1349 static void
1350 silly_event_symbol_error (Lisp_Object c)
1352 Lisp_Object parsed, base, name, assoc;
1353 int modifiers;
1355 parsed = parse_modifiers (c);
1356 modifiers = XFASTINT (XCAR (XCDR (parsed)));
1357 base = XCAR (parsed);
1358 name = Fsymbol_name (base);
1359 /* This alist includes elements such as ("RET" . "\\r"). */
1360 assoc = Fassoc (name, exclude_keys);
1362 if (! NILP (assoc))
1364 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1365 char *p = new_mods;
1366 Lisp_Object keystring;
1367 if (modifiers & alt_modifier)
1368 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1369 if (modifiers & ctrl_modifier)
1370 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1371 if (modifiers & hyper_modifier)
1372 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1373 if (modifiers & meta_modifier)
1374 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1375 if (modifiers & shift_modifier)
1376 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1377 if (modifiers & super_modifier)
1378 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1379 *p = 0;
1381 c = reorder_modifiers (c);
1382 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1384 error ((modifiers & ~meta_modifier
1385 ? "To bind the key %s, use [?%s], not [%s]"
1386 : "To bind the key %s, use \"%s\", not [%s]"),
1387 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1388 SDATA (SYMBOL_NAME (c)));
1392 /* Global, local, and minor mode keymap stuff. */
1394 /* We can't put these variables inside current_minor_maps, since under
1395 some systems, static gets macro-defined to be the empty string.
1396 Ickypoo. */
1397 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1398 static ptrdiff_t cmm_size = 0;
1400 /* Store a pointer to an array of the currently active minor modes in
1401 *modeptr, a pointer to an array of the keymaps of the currently
1402 active minor modes in *mapptr, and return the number of maps
1403 *mapptr contains.
1405 This function always returns a pointer to the same buffer, and may
1406 free or reallocate it, so if you want to keep it for a long time or
1407 hand it out to lisp code, copy it. This procedure will be called
1408 for every key sequence read, so the nice lispy approach (return a
1409 new assoclist, list, what have you) for each invocation would
1410 result in a lot of consing over time.
1412 If we used xrealloc/xmalloc and ran out of memory, they would throw
1413 back to the command loop, which would try to read a key sequence,
1414 which would call this function again, resulting in an infinite
1415 loop. Instead, we'll use realloc/malloc and silently truncate the
1416 list, let the key sequence be read, and hope some other piece of
1417 code signals the error. */
1418 ptrdiff_t
1419 current_minor_maps (Lisp_Object **modeptr, Lisp_Object **mapptr)
1421 ptrdiff_t i = 0;
1422 int list_number = 0;
1423 Lisp_Object alist, assoc, var, val;
1424 Lisp_Object emulation_alists;
1425 Lisp_Object lists[2];
1427 emulation_alists = Vemulation_mode_map_alists;
1428 lists[0] = Vminor_mode_overriding_map_alist;
1429 lists[1] = Vminor_mode_map_alist;
1431 for (list_number = 0; list_number < 2; list_number++)
1433 if (CONSP (emulation_alists))
1435 alist = XCAR (emulation_alists);
1436 emulation_alists = XCDR (emulation_alists);
1437 if (SYMBOLP (alist))
1438 alist = find_symbol_value (alist);
1439 list_number = -1;
1441 else
1442 alist = lists[list_number];
1444 for ( ; CONSP (alist); alist = XCDR (alist))
1445 if ((assoc = XCAR (alist), CONSP (assoc))
1446 && (var = XCAR (assoc), SYMBOLP (var))
1447 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1448 && !NILP (val))
1450 Lisp_Object temp;
1452 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1453 and also an entry in Vminor_mode_map_alist,
1454 ignore the latter. */
1455 if (list_number == 1)
1457 val = assq_no_quit (var, lists[0]);
1458 if (!NILP (val))
1459 continue;
1462 if (i >= cmm_size)
1464 ptrdiff_t newsize, allocsize;
1465 Lisp_Object *newmodes, *newmaps;
1467 /* Check for size calculation overflow. Other code
1468 (e.g., read_key_sequence) adds 3 to the count
1469 later, so subtract 3 from the limit here. */
1470 if (min (PTRDIFF_MAX, SIZE_MAX) / (2 * sizeof *newmodes) - 3
1471 < cmm_size)
1472 break;
1474 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1475 allocsize = newsize * sizeof *newmodes;
1477 /* Use malloc here. See the comment above this function.
1478 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1479 block_input ();
1480 newmodes = malloc (allocsize);
1481 if (newmodes)
1483 if (cmm_modes)
1485 memcpy (newmodes, cmm_modes,
1486 cmm_size * sizeof cmm_modes[0]);
1487 free (cmm_modes);
1489 cmm_modes = newmodes;
1492 newmaps = malloc (allocsize);
1493 if (newmaps)
1495 if (cmm_maps)
1497 memcpy (newmaps, cmm_maps,
1498 cmm_size * sizeof cmm_maps[0]);
1499 free (cmm_maps);
1501 cmm_maps = newmaps;
1503 unblock_input ();
1505 if (newmodes == NULL || newmaps == NULL)
1506 break;
1507 cmm_size = newsize;
1510 /* Get the keymap definition--or nil if it is not defined. */
1511 temp = Findirect_function (XCDR (assoc), Qt);
1512 if (!NILP (temp))
1514 cmm_modes[i] = var;
1515 cmm_maps [i] = temp;
1516 i++;
1521 if (modeptr) *modeptr = cmm_modes;
1522 if (mapptr) *mapptr = cmm_maps;
1523 return i;
1526 /* Return the offset of POSITION, a click position, in the style of
1527 the respective argument of Fkey_binding. */
1528 static ptrdiff_t
1529 click_position (Lisp_Object position)
1531 EMACS_INT pos = (INTEGERP (position) ? XINT (position)
1532 : MARKERP (position) ? marker_position (position)
1533 : PT);
1534 if (! (BEGV <= pos && pos <= ZV))
1535 args_out_of_range (Fcurrent_buffer (), position);
1536 return pos;
1539 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1540 0, 2, 0,
1541 doc: /* Return a list of the currently active keymaps.
1542 OLP if non-nil indicates that we should obey `overriding-local-map' and
1543 `overriding-terminal-local-map'. POSITION can specify a click position
1544 like in the respective argument of `key-binding'. */)
1545 (Lisp_Object olp, Lisp_Object position)
1547 ptrdiff_t count = SPECPDL_INDEX ();
1549 Lisp_Object keymaps = Fcons (current_global_map, Qnil);
1551 /* If a mouse click position is given, our variables are based on
1552 the buffer clicked on, not the current buffer. So we may have to
1553 switch the buffer here. */
1555 if (CONSP (position))
1557 Lisp_Object window;
1559 window = POSN_WINDOW (position);
1561 if (WINDOWP (window)
1562 && BUFFERP (XWINDOW (window)->buffer)
1563 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1565 /* Arrange to go back to the original buffer once we're done
1566 processing the key sequence. We don't use
1567 save_excursion_{save,restore} here, in analogy to
1568 `read-key-sequence' to avoid saving point. Maybe this
1569 would not be a problem here, but it is easier to keep
1570 things the same.
1572 record_unwind_current_buffer ();
1573 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1577 if (!NILP (olp))
1579 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
1580 keymaps = Fcons (KVAR (current_kboard, Voverriding_terminal_local_map),
1581 keymaps);
1582 /* The doc said that overriding-terminal-local-map should
1583 override overriding-local-map. The code used them both,
1584 but it seems clearer to use just one. rms, jan 2005. */
1585 else if (!NILP (Voverriding_local_map))
1586 keymaps = Fcons (Voverriding_local_map, keymaps);
1588 if (NILP (XCDR (keymaps)))
1590 Lisp_Object *maps;
1591 int nmaps, i;
1592 ptrdiff_t pt = click_position (position);
1593 /* This usually returns the buffer's local map,
1594 but that can be overridden by a `local-map' property. */
1595 Lisp_Object local_map = get_local_map (pt, current_buffer, Qlocal_map);
1596 /* This returns nil unless there is a `keymap' property. */
1597 Lisp_Object keymap = get_local_map (pt, current_buffer, Qkeymap);
1599 if (CONSP (position))
1601 Lisp_Object string = POSN_STRING (position);
1603 /* For a mouse click, get the local text-property keymap
1604 of the place clicked on, rather than point. */
1606 if (POSN_INBUFFER_P (position))
1608 Lisp_Object pos;
1610 pos = POSN_BUFFER_POSN (position);
1611 if (INTEGERP (pos)
1612 && XINT (pos) >= BEG && XINT (pos) <= Z)
1614 local_map = get_local_map (XINT (pos),
1615 current_buffer, Qlocal_map);
1617 keymap = get_local_map (XINT (pos),
1618 current_buffer, Qkeymap);
1622 /* If on a mode line string with a local keymap,
1623 or for a click on a string, i.e. overlay string or a
1624 string displayed via the `display' property,
1625 consider `local-map' and `keymap' properties of
1626 that string. */
1628 if (CONSP (string) && STRINGP (XCAR (string)))
1630 Lisp_Object pos, map;
1632 pos = XCDR (string);
1633 string = XCAR (string);
1634 if (INTEGERP (pos)
1635 && XINT (pos) >= 0
1636 && XINT (pos) < SCHARS (string))
1638 map = Fget_text_property (pos, Qlocal_map, string);
1639 if (!NILP (map))
1640 local_map = map;
1642 map = Fget_text_property (pos, Qkeymap, string);
1643 if (!NILP (map))
1644 keymap = map;
1650 if (!NILP (local_map))
1651 keymaps = Fcons (local_map, keymaps);
1653 /* Now put all the minor mode keymaps on the list. */
1654 nmaps = current_minor_maps (0, &maps);
1656 for (i = --nmaps; i >= 0; i--)
1657 if (!NILP (maps[i]))
1658 keymaps = Fcons (maps[i], keymaps);
1660 if (!NILP (keymap))
1661 keymaps = Fcons (keymap, keymaps);
1664 unbind_to (count, Qnil);
1666 return keymaps;
1669 /* GC is possible in this function if it autoloads a keymap. */
1671 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1672 doc: /* Return the binding for command KEY in current keymaps.
1673 KEY is a string or vector, a sequence of keystrokes.
1674 The binding is probably a symbol with a function definition.
1676 Normally, `key-binding' ignores bindings for t, which act as default
1677 bindings, used when nothing else in the keymap applies; this makes it
1678 usable as a general function for probing keymaps. However, if the
1679 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1680 recognize the default bindings, just as `read-key-sequence' does.
1682 Like the normal command loop, `key-binding' will remap the command
1683 resulting from looking up KEY by looking up the command in the
1684 current keymaps. However, if the optional third argument NO-REMAP
1685 is non-nil, `key-binding' returns the unmapped command.
1687 If KEY is a key sequence initiated with the mouse, the used keymaps
1688 will depend on the clicked mouse position with regard to the buffer
1689 and possible local keymaps on strings.
1691 If the optional argument POSITION is non-nil, it specifies a mouse
1692 position as returned by `event-start' and `event-end', and the lookup
1693 occurs in the keymaps associated with it instead of KEY. It can also
1694 be a number or marker, in which case the keymap properties at the
1695 specified buffer position instead of point are used.
1697 (Lisp_Object key, Lisp_Object accept_default, Lisp_Object no_remap, Lisp_Object position)
1699 Lisp_Object value;
1701 if (NILP (position) && VECTORP (key))
1703 Lisp_Object event
1704 /* mouse events may have a symbolic prefix indicating the
1705 scrollbar or mode line */
1706 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1708 /* We are not interested in locations without event data */
1710 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1712 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1713 if (EQ (kind, Qmouse_click))
1714 position = EVENT_START (event);
1718 value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)),
1719 key, accept_default);
1721 if (NILP (value) || INTEGERP (value))
1722 return Qnil;
1724 /* If the result of the ordinary keymap lookup is an interactive
1725 command, look for a key binding (ie. remapping) for that command. */
1727 if (NILP (no_remap) && SYMBOLP (value))
1729 Lisp_Object value1;
1730 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1731 value = value1;
1734 return value;
1737 /* GC is possible in this function if it autoloads a keymap. */
1739 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1740 doc: /* Return the binding for command KEYS in current local keymap only.
1741 KEYS is a string or vector, a sequence of keystrokes.
1742 The binding is probably a symbol with a function definition.
1744 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1745 bindings; see the description of `lookup-key' for more details about this. */)
1746 (Lisp_Object keys, Lisp_Object accept_default)
1748 register Lisp_Object map;
1749 map = BVAR (current_buffer, keymap);
1750 if (NILP (map))
1751 return Qnil;
1752 return Flookup_key (map, keys, accept_default);
1755 /* GC is possible in this function if it autoloads a keymap. */
1757 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1758 doc: /* Return the binding for command KEYS in current global keymap only.
1759 KEYS is a string or vector, a sequence of keystrokes.
1760 The binding is probably a symbol with a function definition.
1761 This function's return values are the same as those of `lookup-key'
1762 \(which see).
1764 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1765 bindings; see the description of `lookup-key' for more details about this. */)
1766 (Lisp_Object keys, Lisp_Object accept_default)
1768 return Flookup_key (current_global_map, keys, accept_default);
1771 /* GC is possible in this function if it autoloads a keymap. */
1773 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1774 doc: /* Find the visible minor mode bindings of KEY.
1775 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1776 the symbol which names the minor mode binding KEY, and BINDING is
1777 KEY's definition in that mode. In particular, if KEY has no
1778 minor-mode bindings, return nil. If the first binding is a
1779 non-prefix, all subsequent bindings will be omitted, since they would
1780 be ignored. Similarly, the list doesn't include non-prefix bindings
1781 that come after prefix bindings.
1783 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1784 bindings; see the description of `lookup-key' for more details about this. */)
1785 (Lisp_Object key, Lisp_Object accept_default)
1787 Lisp_Object *modes, *maps;
1788 int nmaps;
1789 Lisp_Object binding;
1790 int i, j;
1791 struct gcpro gcpro1, gcpro2;
1793 nmaps = current_minor_maps (&modes, &maps);
1794 /* Note that all these maps are GCPRO'd
1795 in the places where we found them. */
1797 binding = Qnil;
1798 GCPRO2 (key, binding);
1800 for (i = j = 0; i < nmaps; i++)
1801 if (!NILP (maps[i])
1802 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
1803 && !INTEGERP (binding))
1805 if (KEYMAPP (binding))
1806 maps[j++] = Fcons (modes[i], binding);
1807 else if (j == 0)
1808 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
1811 UNGCPRO;
1812 return Flist (j, maps);
1815 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
1816 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1817 A new sparse keymap is stored as COMMAND's function definition and its value.
1818 If a second optional argument MAPVAR is given, the map is stored as
1819 its value instead of as COMMAND's value; but COMMAND is still defined
1820 as a function.
1821 The third optional argument NAME, if given, supplies a menu name
1822 string for the map. This is required to use the keymap as a menu.
1823 This function returns COMMAND. */)
1824 (Lisp_Object command, Lisp_Object mapvar, Lisp_Object name)
1826 Lisp_Object map;
1827 map = Fmake_sparse_keymap (name);
1828 Ffset (command, map);
1829 if (!NILP (mapvar))
1830 Fset (mapvar, map);
1831 else
1832 Fset (command, map);
1833 return command;
1836 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
1837 doc: /* Select KEYMAP as the global keymap. */)
1838 (Lisp_Object keymap)
1840 keymap = get_keymap (keymap, 1, 1);
1841 current_global_map = keymap;
1843 return Qnil;
1846 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
1847 doc: /* Select KEYMAP as the local keymap.
1848 If KEYMAP is nil, that means no local keymap. */)
1849 (Lisp_Object keymap)
1851 if (!NILP (keymap))
1852 keymap = get_keymap (keymap, 1, 1);
1854 bset_keymap (current_buffer, keymap);
1856 return Qnil;
1859 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
1860 doc: /* Return current buffer's local keymap, or nil if it has none.
1861 Normally the local keymap is set by the major mode with `use-local-map'. */)
1862 (void)
1864 return BVAR (current_buffer, keymap);
1867 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
1868 doc: /* Return the current global keymap. */)
1869 (void)
1871 return current_global_map;
1874 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
1875 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
1876 (void)
1878 Lisp_Object *maps;
1879 int nmaps = current_minor_maps (0, &maps);
1881 return Flist (nmaps, maps);
1884 /* Help functions for describing and documenting keymaps. */
1886 struct accessible_keymaps_data {
1887 Lisp_Object maps, tail, thisseq;
1888 /* Does the current sequence end in the meta-prefix-char? */
1889 bool is_metized;
1892 static void
1893 accessible_keymaps_1 (Lisp_Object key, Lisp_Object cmd, Lisp_Object args, void *data)
1894 /* Use void* data to be compatible with map_keymap_function_t. */
1896 struct accessible_keymaps_data *d = data; /* Cast! */
1897 Lisp_Object maps = d->maps;
1898 Lisp_Object tail = d->tail;
1899 Lisp_Object thisseq = d->thisseq;
1900 bool is_metized = d->is_metized && INTEGERP (key);
1901 Lisp_Object tem;
1903 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
1904 if (NILP (cmd))
1905 return;
1907 /* Look for and break cycles. */
1908 while (!NILP (tem = Frassq (cmd, maps)))
1910 Lisp_Object prefix = XCAR (tem);
1911 ptrdiff_t lim = XINT (Flength (XCAR (tem)));
1912 if (lim <= XINT (Flength (thisseq)))
1913 { /* This keymap was already seen with a smaller prefix. */
1914 ptrdiff_t i = 0;
1915 while (i < lim && EQ (Faref (prefix, make_number (i)),
1916 Faref (thisseq, make_number (i))))
1917 i++;
1918 if (i >= lim)
1919 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1920 return;
1922 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1923 but maybe `cmd' occurs again further down in `maps', so keep
1924 looking. */
1925 maps = XCDR (Fmemq (tem, maps));
1928 /* If the last key in thisseq is meta-prefix-char,
1929 turn it into a meta-ized keystroke. We know
1930 that the event we're about to append is an
1931 ascii keystroke since we're processing a
1932 keymap table. */
1933 if (is_metized)
1935 int meta_bit = meta_modifier;
1936 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
1937 tem = Fcopy_sequence (thisseq);
1939 Faset (tem, last, make_number (XINT (key) | meta_bit));
1941 /* This new sequence is the same length as
1942 thisseq, so stick it in the list right
1943 after this one. */
1944 XSETCDR (tail,
1945 Fcons (Fcons (tem, cmd), XCDR (tail)));
1947 else
1949 tem = append_key (thisseq, key);
1950 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
1954 /* This function cannot GC. */
1956 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
1957 1, 2, 0,
1958 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
1959 Returns a list of elements of the form (KEYS . MAP), where the sequence
1960 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1961 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1962 An optional argument PREFIX, if non-nil, should be a key sequence;
1963 then the value includes only maps for prefixes that start with PREFIX. */)
1964 (Lisp_Object keymap, Lisp_Object prefix)
1966 Lisp_Object maps, tail;
1967 EMACS_INT prefixlen = XFASTINT (Flength (prefix));
1969 /* no need for gcpro because we don't autoload any keymaps. */
1971 if (!NILP (prefix))
1973 /* If a prefix was specified, start with the keymap (if any) for
1974 that prefix, so we don't waste time considering other prefixes. */
1975 Lisp_Object tem;
1976 tem = Flookup_key (keymap, prefix, Qt);
1977 /* Flookup_key may give us nil, or a number,
1978 if the prefix is not defined in this particular map.
1979 It might even give us a list that isn't a keymap. */
1980 tem = get_keymap (tem, 0, 0);
1981 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
1982 want to return it. */
1983 if (!NILP (tem))
1985 /* Convert PREFIX to a vector now, so that later on
1986 we don't have to deal with the possibility of a string. */
1987 if (STRINGP (prefix))
1989 int i, i_byte, c;
1990 Lisp_Object copy;
1992 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
1993 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
1995 int i_before = i;
1997 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
1998 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
1999 c ^= 0200 | meta_modifier;
2000 ASET (copy, i_before, make_number (c));
2002 prefix = copy;
2004 maps = Fcons (Fcons (prefix, tem), Qnil);
2006 else
2007 return Qnil;
2009 else
2010 maps = Fcons (Fcons (zero_vector, get_keymap (keymap, 1, 0)), Qnil);
2012 /* For each map in the list maps,
2013 look at any other maps it points to,
2014 and stick them at the end if they are not already in the list.
2016 This is a breadth-first traversal, where tail is the queue of
2017 nodes, and maps accumulates a list of all nodes visited. */
2019 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2021 struct accessible_keymaps_data data;
2022 register Lisp_Object thismap = Fcdr (XCAR (tail));
2023 Lisp_Object last;
2025 data.thisseq = Fcar (XCAR (tail));
2026 data.maps = maps;
2027 data.tail = tail;
2028 last = make_number (XINT (Flength (data.thisseq)) - 1);
2029 /* Does the current sequence end in the meta-prefix-char? */
2030 data.is_metized = (XINT (last) >= 0
2031 /* Don't metize the last char of PREFIX. */
2032 && XINT (last) >= prefixlen
2033 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2035 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2036 if (CONSP (thismap))
2037 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2039 return maps;
2041 static Lisp_Object Qsingle_key_description, Qkey_description;
2043 /* This function cannot GC. */
2045 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2046 doc: /* Return a pretty description of key-sequence KEYS.
2047 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2048 For example, [?\C-x ?l] is converted into the string \"C-x l\".
2050 The `kbd' macro is an approximate inverse of this. */)
2051 (Lisp_Object keys, Lisp_Object prefix)
2053 ptrdiff_t len = 0;
2054 EMACS_INT i;
2055 ptrdiff_t i_byte;
2056 Lisp_Object *args;
2057 EMACS_INT size = XINT (Flength (keys));
2058 Lisp_Object list;
2059 Lisp_Object sep = build_string (" ");
2060 Lisp_Object key;
2061 Lisp_Object result;
2062 bool add_meta = 0;
2063 USE_SAFE_ALLOCA;
2065 if (!NILP (prefix))
2066 size += XINT (Flength (prefix));
2068 /* This has one extra element at the end that we don't pass to Fconcat. */
2069 if (min (PTRDIFF_MAX, SIZE_MAX) / word_size / 4 < size)
2070 memory_full (SIZE_MAX);
2071 SAFE_ALLOCA_LISP (args, size * 4);
2073 /* In effect, this computes
2074 (mapconcat 'single-key-description keys " ")
2075 but we shouldn't use mapconcat because it can do GC. */
2077 next_list:
2078 if (!NILP (prefix))
2079 list = prefix, prefix = Qnil;
2080 else if (!NILP (keys))
2081 list = keys, keys = Qnil;
2082 else
2084 if (add_meta)
2086 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2087 result = Fconcat (len + 1, args);
2089 else if (len == 0)
2090 result = empty_unibyte_string;
2091 else
2092 result = Fconcat (len - 1, args);
2093 SAFE_FREE ();
2094 return result;
2097 if (STRINGP (list))
2098 size = SCHARS (list);
2099 else if (VECTORP (list))
2100 size = ASIZE (list);
2101 else if (CONSP (list))
2102 size = XINT (Flength (list));
2103 else
2104 wrong_type_argument (Qarrayp, list);
2106 i = i_byte = 0;
2108 while (i < size)
2110 if (STRINGP (list))
2112 int c;
2113 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2114 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2115 c ^= 0200 | meta_modifier;
2116 XSETFASTINT (key, c);
2118 else if (VECTORP (list))
2120 key = AREF (list, i); i++;
2122 else
2124 key = XCAR (list);
2125 list = XCDR (list);
2126 i++;
2129 if (add_meta)
2131 if (!INTEGERP (key)
2132 || EQ (key, meta_prefix_char)
2133 || (XINT (key) & meta_modifier))
2135 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2136 args[len++] = sep;
2137 if (EQ (key, meta_prefix_char))
2138 continue;
2140 else
2141 XSETINT (key, XINT (key) | meta_modifier);
2142 add_meta = 0;
2144 else if (EQ (key, meta_prefix_char))
2146 add_meta = 1;
2147 continue;
2149 args[len++] = Fsingle_key_description (key, Qnil);
2150 args[len++] = sep;
2152 goto next_list;
2156 char *
2157 push_key_description (EMACS_INT ch, char *p)
2159 int c, c2;
2160 bool tab_as_ci;
2162 /* Clear all the meaningless bits above the meta bit. */
2163 c = ch & (meta_modifier | ~ - meta_modifier);
2164 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2165 | meta_modifier | shift_modifier | super_modifier);
2167 if (! CHARACTERP (make_number (c2)))
2169 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2170 p += sprintf (p, "[%d]", c);
2171 return p;
2174 tab_as_ci = (c2 == '\t' && (c & meta_modifier));
2176 if (c & alt_modifier)
2178 *p++ = 'A';
2179 *p++ = '-';
2180 c -= alt_modifier;
2182 if ((c & ctrl_modifier) != 0
2183 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M'))
2184 || tab_as_ci)
2186 *p++ = 'C';
2187 *p++ = '-';
2188 c &= ~ctrl_modifier;
2190 if (c & hyper_modifier)
2192 *p++ = 'H';
2193 *p++ = '-';
2194 c -= hyper_modifier;
2196 if (c & meta_modifier)
2198 *p++ = 'M';
2199 *p++ = '-';
2200 c -= meta_modifier;
2202 if (c & shift_modifier)
2204 *p++ = 'S';
2205 *p++ = '-';
2206 c -= shift_modifier;
2208 if (c & super_modifier)
2210 *p++ = 's';
2211 *p++ = '-';
2212 c -= super_modifier;
2214 if (c < 040)
2216 if (c == 033)
2218 *p++ = 'E';
2219 *p++ = 'S';
2220 *p++ = 'C';
2222 else if (tab_as_ci)
2224 *p++ = 'i';
2226 else if (c == '\t')
2228 *p++ = 'T';
2229 *p++ = 'A';
2230 *p++ = 'B';
2232 else if (c == Ctl ('M'))
2234 *p++ = 'R';
2235 *p++ = 'E';
2236 *p++ = 'T';
2238 else
2240 /* `C-' already added above. */
2241 if (c > 0 && c <= Ctl ('Z'))
2242 *p++ = c + 0140;
2243 else
2244 *p++ = c + 0100;
2247 else if (c == 0177)
2249 *p++ = 'D';
2250 *p++ = 'E';
2251 *p++ = 'L';
2253 else if (c == ' ')
2255 *p++ = 'S';
2256 *p++ = 'P';
2257 *p++ = 'C';
2259 else if (c < 128)
2260 *p++ = c;
2261 else
2263 /* Now we are sure that C is a valid character code. */
2264 p += CHAR_STRING (c, (unsigned char *) p);
2267 return p;
2270 /* This function cannot GC. */
2272 DEFUN ("single-key-description", Fsingle_key_description,
2273 Ssingle_key_description, 1, 2, 0,
2274 doc: /* Return a pretty description of command character KEY.
2275 Control characters turn into C-whatever, etc.
2276 Optional argument NO-ANGLES non-nil means don't put angle brackets
2277 around function keys and event symbols. */)
2278 (Lisp_Object key, Lisp_Object no_angles)
2280 if (CONSP (key) && lucid_event_type_list_p (key))
2281 key = Fevent_convert_list (key);
2283 if (CONSP (key) && INTEGERP (XCAR (key)) && INTEGERP (XCDR (key)))
2284 /* An interval from a map-char-table. */
2285 return concat3 (Fsingle_key_description (XCAR (key), no_angles),
2286 build_string (".."),
2287 Fsingle_key_description (XCDR (key), no_angles));
2289 key = EVENT_HEAD (key);
2291 if (INTEGERP (key)) /* Normal character. */
2293 char tem[KEY_DESCRIPTION_SIZE];
2294 char *p = push_key_description (XINT (key), tem);
2295 *p = 0;
2296 return make_specified_string (tem, -1, p - tem, 1);
2298 else if (SYMBOLP (key)) /* Function key or event-symbol. */
2300 if (NILP (no_angles))
2302 Lisp_Object result;
2303 USE_SAFE_ALLOCA;
2304 char *buffer = SAFE_ALLOCA (sizeof "<>"
2305 + SBYTES (SYMBOL_NAME (key)));
2306 esprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2307 result = build_string (buffer);
2308 SAFE_FREE ();
2309 return result;
2311 else
2312 return Fsymbol_name (key);
2314 else if (STRINGP (key)) /* Buffer names in the menubar. */
2315 return Fcopy_sequence (key);
2316 else
2317 error ("KEY must be an integer, cons, symbol, or string");
2318 return Qnil;
2321 static char *
2322 push_text_char_description (register unsigned int c, register char *p)
2324 if (c >= 0200)
2326 *p++ = 'M';
2327 *p++ = '-';
2328 c -= 0200;
2330 if (c < 040)
2332 *p++ = '^';
2333 *p++ = c + 64; /* 'A' - 1 */
2335 else if (c == 0177)
2337 *p++ = '^';
2338 *p++ = '?';
2340 else
2341 *p++ = c;
2342 return p;
2345 /* This function cannot GC. */
2347 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2348 doc: /* Return a pretty description of file-character CHARACTER.
2349 Control characters turn into "^char", etc. This differs from
2350 `single-key-description' which turns them into "C-char".
2351 Also, this function recognizes the 2**7 bit as the Meta character,
2352 whereas `single-key-description' uses the 2**27 bit for Meta.
2353 See Info node `(elisp)Describing Characters' for examples. */)
2354 (Lisp_Object character)
2356 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2357 char str[6];
2358 int c;
2360 CHECK_CHARACTER (character);
2362 c = XINT (character);
2363 if (!ASCII_CHAR_P (c))
2365 int len = CHAR_STRING (c, (unsigned char *) str);
2367 return make_multibyte_string (str, 1, len);
2370 *push_text_char_description (c & 0377, str) = 0;
2372 return build_string (str);
2375 static int where_is_preferred_modifier;
2377 /* Return 0 if SEQ uses non-preferred modifiers or non-char events.
2378 Else, return 2 if SEQ uses the where_is_preferred_modifier,
2379 and 1 otherwise. */
2380 static int
2381 preferred_sequence_p (Lisp_Object seq)
2383 EMACS_INT i;
2384 EMACS_INT len = XFASTINT (Flength (seq));
2385 int result = 1;
2387 for (i = 0; i < len; i++)
2389 Lisp_Object ii, elt;
2391 XSETFASTINT (ii, i);
2392 elt = Faref (seq, ii);
2394 if (!INTEGERP (elt))
2395 return 0;
2396 else
2398 int modifiers = XINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
2399 if (modifiers == where_is_preferred_modifier)
2400 result = 2;
2401 else if (modifiers)
2402 return 0;
2406 return result;
2410 /* where-is - finding a command in a set of keymaps. */
2412 static void where_is_internal_1 (Lisp_Object key, Lisp_Object binding,
2413 Lisp_Object args, void *data);
2415 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2416 Returns the first non-nil binding found in any of those maps.
2417 If REMAP is true, pass the result of the lookup through command
2418 remapping before returning it. */
2420 static Lisp_Object
2421 shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag,
2422 bool remap)
2424 Lisp_Object tail, value;
2426 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2428 value = Flookup_key (XCAR (tail), key, flag);
2429 if (NATNUMP (value))
2431 value = Flookup_key (XCAR (tail),
2432 Fsubstring (key, make_number (0), value), flag);
2433 if (!NILP (value))
2434 return Qnil;
2436 else if (!NILP (value))
2438 Lisp_Object remapping;
2439 if (remap && SYMBOLP (value)
2440 && (remapping = Fcommand_remapping (value, Qnil, shadow),
2441 !NILP (remapping)))
2442 return remapping;
2443 else
2444 return value;
2447 return Qnil;
2450 static Lisp_Object Vmouse_events;
2452 struct where_is_internal_data {
2453 Lisp_Object definition, this, last;
2454 bool last_is_meta, noindirect;
2455 Lisp_Object sequences;
2458 /* This function can't GC, AFAIK. */
2459 /* Return the list of bindings found. This list is ordered "longest
2460 to shortest". It may include bindings that are actually shadowed
2461 by others, as well as duplicate bindings and remapping bindings.
2462 The list returned is potentially shared with where_is_cache, so
2463 be careful not to modify it via side-effects. */
2465 static Lisp_Object
2466 where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
2467 bool noindirect, bool nomenus)
2469 Lisp_Object maps = Qnil;
2470 Lisp_Object found;
2471 struct where_is_internal_data data;
2473 /* Only important use of caching is for the menubar
2474 (i.e. where-is-internal called with (def nil t nil nil)). */
2475 if (nomenus && !noindirect)
2477 /* Check heuristic-consistency of the cache. */
2478 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2479 where_is_cache = Qnil;
2481 if (NILP (where_is_cache))
2483 /* We need to create the cache. */
2484 Lisp_Object args[2];
2485 where_is_cache = Fmake_hash_table (0, args);
2486 where_is_cache_keymaps = Qt;
2488 else
2489 /* We can reuse the cache. */
2490 return Fgethash (definition, where_is_cache, Qnil);
2492 else
2493 /* Kill the cache so that where_is_internal_1 doesn't think
2494 we're filling it up. */
2495 where_is_cache = Qnil;
2497 found = keymaps;
2498 while (CONSP (found))
2500 maps =
2501 nconc2 (maps,
2502 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2503 found = XCDR (found);
2506 data.sequences = Qnil;
2507 for (; CONSP (maps); maps = XCDR (maps))
2509 /* Key sequence to reach map, and the map that it reaches */
2510 register Lisp_Object this, map, tem;
2512 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2513 [M-CHAR] sequences, check if last character of the sequence
2514 is the meta-prefix char. */
2515 Lisp_Object last;
2516 bool last_is_meta;
2518 this = Fcar (XCAR (maps));
2519 map = Fcdr (XCAR (maps));
2520 last = make_number (XINT (Flength (this)) - 1);
2521 last_is_meta = (XINT (last) >= 0
2522 && EQ (Faref (this, last), meta_prefix_char));
2524 /* if (nomenus && !preferred_sequence_p (this)) */
2525 if (nomenus && XINT (last) >= 0
2526 && SYMBOLP (tem = Faref (this, make_number (0)))
2527 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2528 /* If no menu entries should be returned, skip over the
2529 keymaps bound to `menu-bar' and `tool-bar' and other
2530 non-ascii prefixes like `C-down-mouse-2'. */
2531 continue;
2533 QUIT;
2535 data.definition = definition;
2536 data.noindirect = noindirect;
2537 data.this = this;
2538 data.last = last;
2539 data.last_is_meta = last_is_meta;
2541 if (CONSP (map))
2542 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2545 if (nomenus && !noindirect)
2546 { /* Remember for which keymaps this cache was built.
2547 We do it here (late) because we want to keep where_is_cache_keymaps
2548 set to t while the cache isn't fully filled. */
2549 where_is_cache_keymaps = keymaps;
2550 /* During cache-filling, data.sequences is not filled by
2551 where_is_internal_1. */
2552 return Fgethash (definition, where_is_cache, Qnil);
2554 else
2555 return data.sequences;
2558 /* This function can GC if Flookup_key autoloads any keymaps. */
2560 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2561 doc: /* Return list of keys that invoke DEFINITION.
2562 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2563 If KEYMAP is nil, search all the currently active keymaps, except
2564 for `overriding-local-map' (which is ignored).
2565 If KEYMAP is a list of keymaps, search only those keymaps.
2567 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2568 rather than a list of all possible key sequences.
2569 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2570 no matter what it is.
2571 If FIRSTONLY has another non-nil value, prefer bindings
2572 that use the modifier key specified in `where-is-preferred-modifier'
2573 \(or their meta variants) and entirely reject menu bindings.
2575 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2576 to other keymaps or slots. This makes it possible to search for an
2577 indirect definition itself.
2579 The optional 5th arg NO-REMAP alters how command remapping is handled:
2581 - If another command OTHER-COMMAND is remapped to DEFINITION, normally
2582 search for the bindings of OTHER-COMMAND and include them in the
2583 returned list. But if NO-REMAP is non-nil, include the vector
2584 [remap OTHER-COMMAND] in the returned list instead, without
2585 searching for those other bindings.
2587 - If DEFINITION is remapped to OTHER-COMMAND, normally return the
2588 bindings for OTHER-COMMAND. But if NO-REMAP is non-nil, return the
2589 bindings for DEFINITION instead, ignoring its remapping. */)
2590 (Lisp_Object definition, Lisp_Object keymap, Lisp_Object firstonly, Lisp_Object noindirect, Lisp_Object no_remap)
2592 /* The keymaps in which to search. */
2593 Lisp_Object keymaps;
2594 /* Potentially relevant bindings in "shortest to longest" order. */
2595 Lisp_Object sequences = Qnil;
2596 /* Actually relevant bindings. */
2597 Lisp_Object found = Qnil;
2598 /* 1 means ignore all menu bindings entirely. */
2599 bool nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2600 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
2601 /* List of sequences found via remapping. Keep them in a separate
2602 variable, so as to push them later, since we prefer
2603 non-remapped binding. */
2604 Lisp_Object remapped_sequences = Qnil;
2605 /* Whether or not we're handling remapped sequences. This is needed
2606 because remapping is not done recursively by Fcommand_remapping: you
2607 can't remap a remapped command. */
2608 bool remapped = 0;
2609 Lisp_Object tem = Qnil;
2611 /* Refresh the C version of the modifier preference. */
2612 where_is_preferred_modifier
2613 = parse_solitary_modifier (Vwhere_is_preferred_modifier);
2615 /* Find the relevant keymaps. */
2616 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2617 keymaps = keymap;
2618 else if (!NILP (keymap))
2619 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2620 else
2621 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2623 GCPRO6 (definition, keymaps, found, sequences, remapped_sequences, tem);
2625 tem = Fcommand_remapping (definition, Qnil, keymaps);
2626 /* If `definition' is remapped to tem', then OT1H no key will run
2627 that command (since they will run `tem' instead), so we should
2628 return nil; but OTOH all keys bound to `definition' (or to `tem')
2629 will run the same command.
2630 So for menu-shortcut purposes, we want to find all the keys bound (maybe
2631 via remapping) to `tem'. But for the purpose of finding the keys that
2632 run `definition', then we'd want to just return nil.
2633 We choose to make it work right for menu-shortcuts, since it's the most
2634 common use.
2635 Known bugs: if you remap switch-to-buffer to toto, C-h f switch-to-buffer
2636 will tell you that switch-to-buffer is bound to C-x b even though C-x b
2637 will run toto instead. And if `toto' is itself remapped to forward-char,
2638 then C-h f toto will tell you that it's bound to C-f even though C-f does
2639 not run toto and it won't tell you that C-x b does run toto. */
2640 if (NILP (no_remap) && !NILP (tem))
2641 definition = tem;
2643 if (SYMBOLP (definition)
2644 && !NILP (firstonly)
2645 && !NILP (tem = Fget (definition, QCadvertised_binding)))
2647 /* We have a list of advertised bindings. */
2648 while (CONSP (tem))
2649 if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
2650 RETURN_UNGCPRO (XCAR (tem));
2651 else
2652 tem = XCDR (tem);
2653 if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition))
2654 RETURN_UNGCPRO (tem);
2657 sequences = Freverse (where_is_internal (definition, keymaps,
2658 !NILP (noindirect), nomenus));
2660 while (CONSP (sequences)
2661 /* If we're at the end of the `sequences' list and we haven't
2662 considered remapped sequences yet, copy them over and
2663 process them. */
2664 || (!remapped && (sequences = remapped_sequences,
2665 remapped = 1,
2666 CONSP (sequences))))
2668 Lisp_Object sequence, function;
2670 sequence = XCAR (sequences);
2671 sequences = XCDR (sequences);
2673 /* Verify that this key binding is not shadowed by another
2674 binding for the same key, before we say it exists.
2676 Mechanism: look for local definition of this key and if
2677 it is defined and does not match what we found then
2678 ignore this key.
2680 Either nil or number as value from Flookup_key
2681 means undefined. */
2682 if (NILP (Fequal (shadow_lookup (keymaps, sequence, Qnil, remapped),
2683 definition)))
2684 continue;
2686 /* If the current sequence is a command remapping with
2687 format [remap COMMAND], find the key sequences
2688 which run COMMAND, and use those sequences instead. */
2689 if (NILP (no_remap) && !remapped
2690 && VECTORP (sequence) && ASIZE (sequence) == 2
2691 && EQ (AREF (sequence, 0), Qremap)
2692 && (function = AREF (sequence, 1), SYMBOLP (function)))
2694 Lisp_Object seqs = where_is_internal (function, keymaps,
2695 !NILP (noindirect), nomenus);
2696 remapped_sequences = nconc2 (Freverse (seqs), remapped_sequences);
2697 continue;
2700 /* Don't annoy user with strings from a menu such as the
2701 entries from the "Edit => Paste from Kill Menu".
2702 Change them all to "(any string)", so that there
2703 seems to be only one menu item to report. */
2704 if (! NILP (sequence))
2706 Lisp_Object tem1;
2707 tem1 = Faref (sequence, make_number (ASIZE (sequence) - 1));
2708 if (STRINGP (tem1))
2709 Faset (sequence, make_number (ASIZE (sequence) - 1),
2710 build_string ("(any string)"));
2713 /* It is a true unshadowed match. Record it, unless it's already
2714 been seen (as could happen when inheriting keymaps). */
2715 if (NILP (Fmember (sequence, found)))
2716 found = Fcons (sequence, found);
2718 /* If firstonly is Qnon_ascii, then we can return the first
2719 binding we find. If firstonly is not Qnon_ascii but not
2720 nil, then we should return the first ascii-only binding
2721 we find. */
2722 if (EQ (firstonly, Qnon_ascii))
2723 RETURN_UNGCPRO (sequence);
2724 else if (!NILP (firstonly)
2725 && 2 == preferred_sequence_p (sequence))
2726 RETURN_UNGCPRO (sequence);
2729 UNGCPRO;
2731 found = Fnreverse (found);
2733 /* firstonly may have been t, but we may have gone all the way through
2734 the keymaps without finding an all-ASCII key sequence. So just
2735 return the best we could find. */
2736 if (NILP (firstonly))
2737 return found;
2738 else if (where_is_preferred_modifier == 0)
2739 return Fcar (found);
2740 else
2741 { /* Maybe we did not find a preferred_modifier binding, but we did find
2742 some ASCII binding. */
2743 Lisp_Object bindings = found;
2744 while (CONSP (bindings))
2745 if (preferred_sequence_p (XCAR (bindings)))
2746 return XCAR (bindings);
2747 else
2748 bindings = XCDR (bindings);
2749 return Fcar (found);
2753 /* This function can GC because get_keyelt can. */
2755 static void
2756 where_is_internal_1 (Lisp_Object key, Lisp_Object binding, Lisp_Object args, void *data)
2758 struct where_is_internal_data *d = data; /* Cast! */
2759 Lisp_Object definition = d->definition;
2760 bool noindirect = d->noindirect;
2761 Lisp_Object this = d->this;
2762 Lisp_Object last = d->last;
2763 bool last_is_meta = d->last_is_meta;
2764 Lisp_Object sequence;
2766 /* Search through indirections unless that's not wanted. */
2767 if (!noindirect)
2768 binding = get_keyelt (binding, 0);
2770 /* End this iteration if this element does not match
2771 the target. */
2773 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2774 || EQ (binding, definition)
2775 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2776 /* Doesn't match. */
2777 return;
2779 /* We have found a match. Construct the key sequence where we found it. */
2780 if (INTEGERP (key) && last_is_meta)
2782 sequence = Fcopy_sequence (this);
2783 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2785 else
2787 if (CONSP (key))
2788 key = Fcons (XCAR (key), XCDR (key));
2789 sequence = append_key (this, key);
2792 if (!NILP (where_is_cache))
2794 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2795 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2797 else
2798 d->sequences = Fcons (sequence, d->sequences);
2801 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2803 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2804 doc: /* Insert the list of all defined keys and their definitions.
2805 The list is inserted in the current buffer, while the bindings are
2806 looked up in BUFFER.
2807 The optional argument PREFIX, if non-nil, should be a key sequence;
2808 then we display only bindings that start with that prefix.
2809 The optional argument MENUS, if non-nil, says to mention menu bindings.
2810 \(Ordinarily these are omitted from the output.) */)
2811 (Lisp_Object buffer, Lisp_Object prefix, Lisp_Object menus)
2813 Lisp_Object outbuf, shadow;
2814 bool nomenu = NILP (menus);
2815 Lisp_Object start1;
2816 struct gcpro gcpro1;
2818 const char *alternate_heading
2819 = "\
2820 Keyboard translations:\n\n\
2821 You type Translation\n\
2822 -------- -----------\n";
2824 CHECK_BUFFER (buffer);
2826 shadow = Qnil;
2827 GCPRO1 (shadow);
2829 outbuf = Fcurrent_buffer ();
2831 /* Report on alternates for keys. */
2832 if (STRINGP (KVAR (current_kboard, Vkeyboard_translate_table)) && !NILP (prefix))
2834 int c;
2835 const unsigned char *translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
2836 int translate_len = SCHARS (KVAR (current_kboard, Vkeyboard_translate_table));
2838 for (c = 0; c < translate_len; c++)
2839 if (translate[c] != c)
2841 char buf[KEY_DESCRIPTION_SIZE];
2842 char *bufend;
2844 if (alternate_heading)
2846 insert_string (alternate_heading);
2847 alternate_heading = 0;
2850 bufend = push_key_description (translate[c], buf);
2851 insert (buf, bufend - buf);
2852 Findent_to (make_number (16), make_number (1));
2853 bufend = push_key_description (c, buf);
2854 insert (buf, bufend - buf);
2856 insert ("\n", 1);
2858 /* Insert calls signal_after_change which may GC. */
2859 translate = SDATA (KVAR (current_kboard, Vkeyboard_translate_table));
2862 insert ("\n", 1);
2865 if (!NILP (Vkey_translation_map))
2866 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
2867 "Key translations", nomenu, 1, 0, 0);
2870 /* Print the (major mode) local map. */
2871 start1 = Qnil;
2872 if (!NILP (KVAR (current_kboard, Voverriding_terminal_local_map)))
2873 start1 = KVAR (current_kboard, Voverriding_terminal_local_map);
2874 else if (!NILP (Voverriding_local_map))
2875 start1 = Voverriding_local_map;
2877 if (!NILP (start1))
2879 describe_map_tree (start1, 1, shadow, prefix,
2880 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
2881 shadow = Fcons (start1, shadow);
2883 else
2885 /* Print the minor mode and major mode keymaps. */
2886 int i, nmaps;
2887 Lisp_Object *modes, *maps;
2889 /* Temporarily switch to `buffer', so that we can get that buffer's
2890 minor modes correctly. */
2891 Fset_buffer (buffer);
2893 nmaps = current_minor_maps (&modes, &maps);
2894 Fset_buffer (outbuf);
2896 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
2897 XBUFFER (buffer), Qkeymap);
2898 if (!NILP (start1))
2900 describe_map_tree (start1, 1, shadow, prefix,
2901 "\f\n`keymap' Property Bindings", nomenu,
2902 0, 0, 0);
2903 shadow = Fcons (start1, shadow);
2906 /* Print the minor mode maps. */
2907 for (i = 0; i < nmaps; i++)
2909 /* The title for a minor mode keymap
2910 is constructed at run time.
2911 We let describe_map_tree do the actual insertion
2912 because it takes care of other features when doing so. */
2913 char *title, *p;
2915 if (!SYMBOLP (modes[i]))
2916 emacs_abort ();
2918 p = title = alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
2919 *p++ = '\f';
2920 *p++ = '\n';
2921 *p++ = '`';
2922 memcpy (p, SDATA (SYMBOL_NAME (modes[i])),
2923 SCHARS (SYMBOL_NAME (modes[i])));
2924 p += SCHARS (SYMBOL_NAME (modes[i]));
2925 *p++ = '\'';
2926 memcpy (p, " Minor Mode Bindings", strlen (" Minor Mode Bindings"));
2927 p += strlen (" Minor Mode Bindings");
2928 *p = 0;
2930 describe_map_tree (maps[i], 1, shadow, prefix,
2931 title, nomenu, 0, 0, 0);
2932 shadow = Fcons (maps[i], shadow);
2935 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
2936 XBUFFER (buffer), Qlocal_map);
2937 if (!NILP (start1))
2939 if (EQ (start1, BVAR (XBUFFER (buffer), keymap)))
2940 describe_map_tree (start1, 1, shadow, prefix,
2941 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
2942 else
2943 describe_map_tree (start1, 1, shadow, prefix,
2944 "\f\n`local-map' Property Bindings",
2945 nomenu, 0, 0, 0);
2947 shadow = Fcons (start1, shadow);
2951 describe_map_tree (current_global_map, 1, shadow, prefix,
2952 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
2954 /* Print the function-key-map translations under this prefix. */
2955 if (!NILP (KVAR (current_kboard, Vlocal_function_key_map)))
2956 describe_map_tree (KVAR (current_kboard, Vlocal_function_key_map), 0, Qnil, prefix,
2957 "\f\nFunction key map translations", nomenu, 1, 0, 0);
2959 /* Print the input-decode-map translations under this prefix. */
2960 if (!NILP (KVAR (current_kboard, Vinput_decode_map)))
2961 describe_map_tree (KVAR (current_kboard, Vinput_decode_map), 0, Qnil, prefix,
2962 "\f\nInput decoding map translations", nomenu, 1, 0, 0);
2964 UNGCPRO;
2965 return Qnil;
2968 /* Insert a description of the key bindings in STARTMAP,
2969 followed by those of all maps reachable through STARTMAP.
2970 If PARTIAL, omit certain "uninteresting" commands
2971 (such as `undefined').
2972 If SHADOW is non-nil, it is a list of maps;
2973 don't mention keys which would be shadowed by any of them.
2974 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2975 TITLE, if not 0, is a string to insert at the beginning.
2976 TITLE should not end with a colon or a newline; we supply that.
2977 If NOMENU, then omit menu-bar commands.
2979 If TRANSL, the definitions are actually key translations
2980 so print strings and vectors differently.
2982 If ALWAYS_TITLE, print the title even if there are no maps
2983 to look through.
2985 If MENTION_SHADOW, then when something is shadowed by SHADOW,
2986 don't omit it; instead, mention it but say it is shadowed.
2988 Any inserted text ends in two newlines (used by `help-make-xrefs'). */
2990 void
2991 describe_map_tree (Lisp_Object startmap, bool partial, Lisp_Object shadow,
2992 Lisp_Object prefix, const char *title, bool nomenu,
2993 bool transl, bool always_title, bool mention_shadow)
2995 Lisp_Object maps, orig_maps, seen, sub_shadows;
2996 struct gcpro gcpro1, gcpro2, gcpro3;
2997 bool something = 0;
2998 const char *key_heading
2999 = "\
3000 key binding\n\
3001 --- -------\n";
3003 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3004 seen = Qnil;
3005 sub_shadows = Qnil;
3006 GCPRO3 (maps, seen, sub_shadows);
3008 if (nomenu)
3010 Lisp_Object list;
3012 /* Delete from MAPS each element that is for the menu bar. */
3013 for (list = maps; CONSP (list); list = XCDR (list))
3015 Lisp_Object elt, elt_prefix, tem;
3017 elt = XCAR (list);
3018 elt_prefix = Fcar (elt);
3019 if (ASIZE (elt_prefix) >= 1)
3021 tem = Faref (elt_prefix, make_number (0));
3022 if (EQ (tem, Qmenu_bar))
3023 maps = Fdelq (elt, maps);
3028 if (!NILP (maps) || always_title)
3030 if (title)
3032 insert_string (title);
3033 if (!NILP (prefix))
3035 insert_string (" Starting With ");
3036 insert1 (Fkey_description (prefix, Qnil));
3038 insert_string (":\n");
3040 insert_string (key_heading);
3041 something = 1;
3044 for (; CONSP (maps); maps = XCDR (maps))
3046 register Lisp_Object elt, elt_prefix, tail;
3048 elt = XCAR (maps);
3049 elt_prefix = Fcar (elt);
3051 sub_shadows = Qnil;
3053 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3055 Lisp_Object shmap;
3057 shmap = XCAR (tail);
3059 /* If the sequence by which we reach this keymap is zero-length,
3060 then the shadow map for this keymap is just SHADOW. */
3061 if ((STRINGP (elt_prefix) && SCHARS (elt_prefix) == 0)
3062 || (VECTORP (elt_prefix) && ASIZE (elt_prefix) == 0))
3064 /* If the sequence by which we reach this keymap actually has
3065 some elements, then the sequence's definition in SHADOW is
3066 what we should use. */
3067 else
3069 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3070 if (INTEGERP (shmap))
3071 shmap = Qnil;
3074 /* If shmap is not nil and not a keymap,
3075 it completely shadows this map, so don't
3076 describe this map at all. */
3077 if (!NILP (shmap) && !KEYMAPP (shmap))
3078 goto skip;
3080 if (!NILP (shmap))
3081 sub_shadows = Fcons (shmap, sub_shadows);
3084 /* Maps we have already listed in this loop shadow this map. */
3085 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3087 Lisp_Object tem;
3088 tem = Fequal (Fcar (XCAR (tail)), elt_prefix);
3089 if (!NILP (tem))
3090 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3093 describe_map (Fcdr (elt), elt_prefix,
3094 transl ? describe_translation : describe_command,
3095 partial, sub_shadows, &seen, nomenu, mention_shadow);
3097 skip: ;
3100 if (something)
3101 insert_string ("\n");
3103 UNGCPRO;
3106 static int previous_description_column;
3108 static void
3109 describe_command (Lisp_Object definition, Lisp_Object args)
3111 register Lisp_Object tem1;
3112 ptrdiff_t column = current_column ();
3113 int description_column;
3115 /* If column 16 is no good, go to col 32;
3116 but don't push beyond that--go to next line instead. */
3117 if (column > 30)
3119 insert_char ('\n');
3120 description_column = 32;
3122 else if (column > 14 || (column > 10 && previous_description_column == 32))
3123 description_column = 32;
3124 else
3125 description_column = 16;
3127 Findent_to (make_number (description_column), make_number (1));
3128 previous_description_column = description_column;
3130 if (SYMBOLP (definition))
3132 tem1 = SYMBOL_NAME (definition);
3133 insert1 (tem1);
3134 insert_string ("\n");
3136 else if (STRINGP (definition) || VECTORP (definition))
3137 insert_string ("Keyboard Macro\n");
3138 else if (KEYMAPP (definition))
3139 insert_string ("Prefix Command\n");
3140 else
3141 insert_string ("??\n");
3144 static void
3145 describe_translation (Lisp_Object definition, Lisp_Object args)
3147 register Lisp_Object tem1;
3149 Findent_to (make_number (16), make_number (1));
3151 if (SYMBOLP (definition))
3153 tem1 = SYMBOL_NAME (definition);
3154 insert1 (tem1);
3155 insert_string ("\n");
3157 else if (STRINGP (definition) || VECTORP (definition))
3159 insert1 (Fkey_description (definition, Qnil));
3160 insert_string ("\n");
3162 else if (KEYMAPP (definition))
3163 insert_string ("Prefix Command\n");
3164 else
3165 insert_string ("??\n");
3168 /* describe_map puts all the usable elements of a sparse keymap
3169 into an array of `struct describe_map_elt',
3170 then sorts them by the events. */
3172 struct describe_map_elt
3174 Lisp_Object event;
3175 Lisp_Object definition;
3176 bool shadowed;
3179 /* qsort comparison function for sorting `struct describe_map_elt' by
3180 the event field. */
3182 static int
3183 describe_map_compare (const void *aa, const void *bb)
3185 const struct describe_map_elt *a = aa, *b = bb;
3186 if (INTEGERP (a->event) && INTEGERP (b->event))
3187 return ((XINT (a->event) > XINT (b->event))
3188 - (XINT (a->event) < XINT (b->event)));
3189 if (!INTEGERP (a->event) && INTEGERP (b->event))
3190 return 1;
3191 if (INTEGERP (a->event) && !INTEGERP (b->event))
3192 return -1;
3193 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3194 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3195 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3196 : 0);
3197 return 0;
3200 /* Describe the contents of map MAP, assuming that this map itself is
3201 reached by the sequence of prefix keys PREFIX (a string or vector).
3202 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3204 static void
3205 describe_map (Lisp_Object map, Lisp_Object prefix,
3206 void (*elt_describer) (Lisp_Object, Lisp_Object),
3207 bool partial, Lisp_Object shadow,
3208 Lisp_Object *seen, bool nomenu, bool mention_shadow)
3210 Lisp_Object tail, definition, event;
3211 Lisp_Object tem;
3212 Lisp_Object suppress;
3213 Lisp_Object kludge;
3214 bool first = 1;
3215 struct gcpro gcpro1, gcpro2, gcpro3;
3217 /* These accumulate the values from sparse keymap bindings,
3218 so we can sort them and handle them in order. */
3219 int length_needed = 0;
3220 struct describe_map_elt *vect;
3221 int slots_used = 0;
3222 int i;
3224 suppress = Qnil;
3226 if (partial)
3227 suppress = intern ("suppress-keymap");
3229 /* This vector gets used to present single keys to Flookup_key. Since
3230 that is done once per keymap element, we don't want to cons up a
3231 fresh vector every time. */
3232 kludge = Fmake_vector (make_number (1), Qnil);
3233 definition = Qnil;
3235 GCPRO3 (prefix, definition, kludge);
3237 map = call1 (Qkeymap_canonicalize, map);
3239 for (tail = map; CONSP (tail); tail = XCDR (tail))
3240 length_needed++;
3242 vect = ((struct describe_map_elt *)
3243 alloca (sizeof (struct describe_map_elt) * length_needed));
3245 for (tail = map; CONSP (tail); tail = XCDR (tail))
3247 QUIT;
3249 if (VECTORP (XCAR (tail))
3250 || CHAR_TABLE_P (XCAR (tail)))
3251 describe_vector (XCAR (tail),
3252 prefix, Qnil, elt_describer, partial, shadow, map,
3253 1, mention_shadow);
3254 else if (CONSP (XCAR (tail)))
3256 bool this_shadowed = 0;
3258 event = XCAR (XCAR (tail));
3260 /* Ignore bindings whose "prefix" are not really valid events.
3261 (We get these in the frames and buffers menu.) */
3262 if (!(SYMBOLP (event) || INTEGERP (event)))
3263 continue;
3265 if (nomenu && EQ (event, Qmenu_bar))
3266 continue;
3268 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3270 /* Don't show undefined commands or suppressed commands. */
3271 if (NILP (definition)) continue;
3272 if (SYMBOLP (definition) && partial)
3274 tem = Fget (definition, suppress);
3275 if (!NILP (tem))
3276 continue;
3279 /* Don't show a command that isn't really visible
3280 because a local definition of the same key shadows it. */
3282 ASET (kludge, 0, event);
3283 if (!NILP (shadow))
3285 tem = shadow_lookup (shadow, kludge, Qt, 0);
3286 if (!NILP (tem))
3288 /* If both bindings are keymaps, this key is a prefix key,
3289 so don't say it is shadowed. */
3290 if (KEYMAPP (definition) && KEYMAPP (tem))
3292 /* Avoid generating duplicate entries if the
3293 shadowed binding has the same definition. */
3294 else if (mention_shadow && !EQ (tem, definition))
3295 this_shadowed = 1;
3296 else
3297 continue;
3301 tem = Flookup_key (map, kludge, Qt);
3302 if (!EQ (tem, definition)) continue;
3304 vect[slots_used].event = event;
3305 vect[slots_used].definition = definition;
3306 vect[slots_used].shadowed = this_shadowed;
3307 slots_used++;
3309 else if (EQ (XCAR (tail), Qkeymap))
3311 /* The same keymap might be in the structure twice, if we're
3312 using an inherited keymap. So skip anything we've already
3313 encountered. */
3314 tem = Fassq (tail, *seen);
3315 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3316 break;
3317 *seen = Fcons (Fcons (tail, prefix), *seen);
3321 /* If we found some sparse map events, sort them. */
3323 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3324 describe_map_compare);
3326 /* Now output them in sorted order. */
3328 for (i = 0; i < slots_used; i++)
3330 Lisp_Object start, end;
3332 if (first)
3334 previous_description_column = 0;
3335 insert ("\n", 1);
3336 first = 0;
3339 ASET (kludge, 0, vect[i].event);
3340 start = vect[i].event;
3341 end = start;
3343 definition = vect[i].definition;
3345 /* Find consecutive chars that are identically defined. */
3346 if (INTEGERP (vect[i].event))
3348 while (i + 1 < slots_used
3349 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3350 && !NILP (Fequal (vect[i + 1].definition, definition))
3351 && vect[i].shadowed == vect[i + 1].shadowed)
3352 i++;
3353 end = vect[i].event;
3356 /* Now START .. END is the range to describe next. */
3358 /* Insert the string to describe the event START. */
3359 insert1 (Fkey_description (kludge, prefix));
3361 if (!EQ (start, end))
3363 insert (" .. ", 4);
3365 ASET (kludge, 0, end);
3366 /* Insert the string to describe the character END. */
3367 insert1 (Fkey_description (kludge, prefix));
3370 /* Print a description of the definition of this character.
3371 elt_describer will take care of spacing out far enough
3372 for alignment purposes. */
3373 (*elt_describer) (vect[i].definition, Qnil);
3375 if (vect[i].shadowed)
3377 SET_PT (PT - 1);
3378 insert_string ("\n (that binding is currently shadowed by another mode)");
3379 SET_PT (PT + 1);
3383 UNGCPRO;
3386 static void
3387 describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
3389 Findent_to (make_number (16), make_number (1));
3390 call1 (fun, elt);
3391 Fterpri (Qnil);
3394 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3395 doc: /* Insert a description of contents of VECTOR.
3396 This is text showing the elements of vector matched against indices.
3397 DESCRIBER is the output function used; nil means use `princ'. */)
3398 (Lisp_Object vector, Lisp_Object describer)
3400 ptrdiff_t count = SPECPDL_INDEX ();
3401 if (NILP (describer))
3402 describer = intern ("princ");
3403 specbind (Qstandard_output, Fcurrent_buffer ());
3404 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3405 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3406 Qnil, Qnil, 0, 0);
3408 return unbind_to (count, Qnil);
3411 /* Insert in the current buffer a description of the contents of VECTOR.
3412 We call ELT_DESCRIBER to insert the description of one value found
3413 in VECTOR.
3415 ELT_PREFIX describes what "comes before" the keys or indices defined
3416 by this vector. This is a human-readable string whose size
3417 is not necessarily related to the situation.
3419 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3420 leads to this keymap.
3422 If the vector is a chartable, ELT_PREFIX is the vector
3423 of bytes that lead to the character set or portion of a character
3424 set described by this chartable.
3426 If PARTIAL, it means do not mention suppressed commands
3427 (that assumes the vector is in a keymap).
3429 SHADOW is a list of keymaps that shadow this map.
3430 If it is non-nil, then we look up the key in those maps
3431 and we don't mention it now if it is defined by any of them.
3433 ENTIRE_MAP is the keymap in which this vector appears.
3434 If the definition in effect in the whole map does not match
3435 the one in this vector, we ignore this one.
3437 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3439 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3441 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3443 static void
3444 describe_vector (Lisp_Object vector, Lisp_Object prefix, Lisp_Object args,
3445 void (*elt_describer) (Lisp_Object, Lisp_Object),
3446 bool partial, Lisp_Object shadow, Lisp_Object entire_map,
3447 bool keymap_p, bool mention_shadow)
3449 Lisp_Object definition;
3450 Lisp_Object tem2;
3451 Lisp_Object elt_prefix = Qnil;
3452 int i;
3453 Lisp_Object suppress;
3454 Lisp_Object kludge;
3455 bool first = 1;
3456 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3457 /* Range of elements to be handled. */
3458 int from, to, stop;
3459 Lisp_Object character;
3460 int starting_i;
3462 suppress = Qnil;
3464 definition = Qnil;
3466 if (!keymap_p)
3468 /* Call Fkey_description first, to avoid GC bug for the other string. */
3469 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3471 Lisp_Object tem;
3472 tem = Fkey_description (prefix, Qnil);
3473 elt_prefix = concat2 (tem, build_string (" "));
3475 prefix = Qnil;
3478 /* This vector gets used to present single keys to Flookup_key. Since
3479 that is done once per vector element, we don't want to cons up a
3480 fresh vector every time. */
3481 kludge = Fmake_vector (make_number (1), Qnil);
3482 GCPRO4 (elt_prefix, prefix, definition, kludge);
3484 if (partial)
3485 suppress = intern ("suppress-keymap");
3487 from = 0;
3488 if (CHAR_TABLE_P (vector))
3489 stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1;
3490 else
3491 stop = to = ASIZE (vector);
3493 for (i = from; ; i++)
3495 bool this_shadowed = 0;
3496 int range_beg, range_end;
3497 Lisp_Object val;
3499 QUIT;
3501 if (i == stop)
3503 if (i == to)
3504 break;
3505 stop = to;
3508 starting_i = i;
3510 if (CHAR_TABLE_P (vector))
3512 range_beg = i;
3513 i = stop - 1;
3514 val = char_table_ref_and_range (vector, range_beg, &range_beg, &i);
3516 else
3517 val = AREF (vector, i);
3518 definition = get_keyelt (val, 0);
3520 if (NILP (definition)) continue;
3522 /* Don't mention suppressed commands. */
3523 if (SYMBOLP (definition) && partial)
3525 Lisp_Object tem;
3527 tem = Fget (definition, suppress);
3529 if (!NILP (tem)) continue;
3532 character = make_number (starting_i);
3533 ASET (kludge, 0, character);
3535 /* If this binding is shadowed by some other map, ignore it. */
3536 if (!NILP (shadow))
3538 Lisp_Object tem;
3540 tem = shadow_lookup (shadow, kludge, Qt, 0);
3542 if (!NILP (tem))
3544 if (mention_shadow)
3545 this_shadowed = 1;
3546 else
3547 continue;
3551 /* Ignore this definition if it is shadowed by an earlier
3552 one in the same keymap. */
3553 if (!NILP (entire_map))
3555 Lisp_Object tem;
3557 tem = Flookup_key (entire_map, kludge, Qt);
3559 if (!EQ (tem, definition))
3560 continue;
3563 if (first)
3565 insert ("\n", 1);
3566 first = 0;
3569 /* Output the prefix that applies to every entry in this map. */
3570 if (!NILP (elt_prefix))
3571 insert1 (elt_prefix);
3573 insert1 (Fkey_description (kludge, prefix));
3575 /* Find all consecutive characters or rows that have the same
3576 definition. But, VECTOR is a char-table, we had better put a
3577 boundary between normal characters (-#x3FFF7F) and 8-bit
3578 characters (#x3FFF80-). */
3579 if (CHAR_TABLE_P (vector))
3581 while (i + 1 < stop
3582 && (range_beg = i + 1, range_end = stop - 1,
3583 val = char_table_ref_and_range (vector, range_beg,
3584 &range_beg, &range_end),
3585 tem2 = get_keyelt (val, 0),
3586 !NILP (tem2))
3587 && !NILP (Fequal (tem2, definition)))
3588 i = range_end;
3590 else
3591 while (i + 1 < stop
3592 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3593 !NILP (tem2))
3594 && !NILP (Fequal (tem2, definition)))
3595 i++;
3597 /* If we have a range of more than one character,
3598 print where the range reaches to. */
3600 if (i != starting_i)
3602 insert (" .. ", 4);
3604 ASET (kludge, 0, make_number (i));
3606 if (!NILP (elt_prefix))
3607 insert1 (elt_prefix);
3609 insert1 (Fkey_description (kludge, prefix));
3612 /* Print a description of the definition of this character.
3613 elt_describer will take care of spacing out far enough
3614 for alignment purposes. */
3615 (*elt_describer) (definition, args);
3617 if (this_shadowed)
3619 SET_PT (PT - 1);
3620 insert_string (" (binding currently shadowed)");
3621 SET_PT (PT + 1);
3625 if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
3627 if (!NILP (elt_prefix))
3628 insert1 (elt_prefix);
3629 insert ("default", 7);
3630 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3633 UNGCPRO;
3636 /* Apropos - finding all symbols whose names match a regexp. */
3637 static Lisp_Object apropos_predicate;
3638 static Lisp_Object apropos_accumulate;
3640 static void
3641 apropos_accum (Lisp_Object symbol, Lisp_Object string)
3643 register Lisp_Object tem;
3645 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3646 if (!NILP (tem) && !NILP (apropos_predicate))
3647 tem = call1 (apropos_predicate, symbol);
3648 if (!NILP (tem))
3649 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3652 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3653 doc: /* Show all symbols whose names contain match for REGEXP.
3654 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3655 for each symbol and a symbol is mentioned only if that returns non-nil.
3656 Return list of symbols found. */)
3657 (Lisp_Object regexp, Lisp_Object predicate)
3659 Lisp_Object tem;
3660 CHECK_STRING (regexp);
3661 apropos_predicate = predicate;
3662 apropos_accumulate = Qnil;
3663 map_obarray (Vobarray, apropos_accum, regexp);
3664 tem = Fsort (apropos_accumulate, Qstring_lessp);
3665 apropos_accumulate = Qnil;
3666 apropos_predicate = Qnil;
3667 return tem;
3670 void
3671 syms_of_keymap (void)
3673 DEFSYM (Qkeymap, "keymap");
3674 staticpro (&apropos_predicate);
3675 staticpro (&apropos_accumulate);
3676 apropos_predicate = Qnil;
3677 apropos_accumulate = Qnil;
3679 DEFSYM (Qkeymap_canonicalize, "keymap-canonicalize");
3681 /* Now we are ready to set up this property, so we can
3682 create char tables. */
3683 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3685 /* Initialize the keymaps standardly used.
3686 Each one is the value of a Lisp variable, and is also
3687 pointed to by a C variable */
3689 global_map = Fmake_keymap (Qnil);
3690 Fset (intern_c_string ("global-map"), global_map);
3692 current_global_map = global_map;
3693 staticpro (&global_map);
3694 staticpro (&current_global_map);
3696 meta_map = Fmake_keymap (Qnil);
3697 Fset (intern_c_string ("esc-map"), meta_map);
3698 Ffset (intern_c_string ("ESC-prefix"), meta_map);
3700 control_x_map = Fmake_keymap (Qnil);
3701 Fset (intern_c_string ("ctl-x-map"), control_x_map);
3702 Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
3704 exclude_keys = listn (CONSTYPE_PURE, 5,
3705 pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")),
3706 pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")),
3707 pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")),
3708 pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")),
3709 pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" ")));
3710 staticpro (&exclude_keys);
3712 DEFVAR_LISP ("define-key-rebound-commands", Vdefine_key_rebound_commands,
3713 doc: /* List of commands given new key bindings recently.
3714 This is used for internal purposes during Emacs startup;
3715 don't alter it yourself. */);
3716 Vdefine_key_rebound_commands = Qt;
3718 DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map,
3719 doc: /* Default keymap to use when reading from the minibuffer. */);
3720 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3722 DEFVAR_LISP ("minibuffer-local-ns-map", Vminibuffer_local_ns_map,
3723 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
3724 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3725 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3728 DEFVAR_LISP ("minor-mode-map-alist", Vminor_mode_map_alist,
3729 doc: /* Alist of keymaps to use for minor modes.
3730 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3731 key sequences and look up bindings if VARIABLE's value is non-nil.
3732 If two active keymaps bind the same key, the keymap appearing earlier
3733 in the list takes precedence. */);
3734 Vminor_mode_map_alist = Qnil;
3736 DEFVAR_LISP ("minor-mode-overriding-map-alist", Vminor_mode_overriding_map_alist,
3737 doc: /* Alist of keymaps to use for minor modes, in current major mode.
3738 This variable is an alist just like `minor-mode-map-alist', and it is
3739 used the same way (and before `minor-mode-map-alist'); however,
3740 it is provided for major modes to bind locally. */);
3741 Vminor_mode_overriding_map_alist = Qnil;
3743 DEFVAR_LISP ("emulation-mode-map-alists", Vemulation_mode_map_alists,
3744 doc: /* List of keymap alists to use for emulations modes.
3745 It is intended for modes or packages using multiple minor-mode keymaps.
3746 Each element is a keymap alist just like `minor-mode-map-alist', or a
3747 symbol with a variable binding which is a keymap alist, and it is used
3748 the same way. The "active" keymaps in each alist are used before
3749 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3750 Vemulation_mode_map_alists = Qnil;
3752 DEFVAR_LISP ("where-is-preferred-modifier", Vwhere_is_preferred_modifier,
3753 doc: /* Preferred modifier key to use for `where-is'.
3754 When a single binding is requested, `where-is' will return one that
3755 uses this modifier key if possible. If nil, or if no such binding
3756 exists, bindings using keys without modifiers (or only with meta) will
3757 be preferred. */);
3758 Vwhere_is_preferred_modifier = Qnil;
3759 where_is_preferred_modifier = 0;
3761 staticpro (&Vmouse_events);
3762 Vmouse_events = listn (CONSTYPE_PURE, 9,
3763 intern_c_string ("menu-bar"),
3764 intern_c_string ("tool-bar"),
3765 intern_c_string ("header-line"),
3766 intern_c_string ("mode-line"),
3767 intern_c_string ("mouse-1"),
3768 intern_c_string ("mouse-2"),
3769 intern_c_string ("mouse-3"),
3770 intern_c_string ("mouse-4"),
3771 intern_c_string ("mouse-5"));
3773 DEFSYM (Qsingle_key_description, "single-key-description");
3774 DEFSYM (Qkey_description, "key-description");
3775 DEFSYM (Qkeymapp, "keymapp");
3776 DEFSYM (Qnon_ascii, "non-ascii");
3777 DEFSYM (Qmenu_item, "menu-item");
3778 DEFSYM (Qremap, "remap");
3779 DEFSYM (QCadvertised_binding, ":advertised-binding");
3781 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
3782 staticpro (&command_remapping_vector);
3784 where_is_cache_keymaps = Qt;
3785 where_is_cache = Qnil;
3786 staticpro (&where_is_cache);
3787 staticpro (&where_is_cache_keymaps);
3789 defsubr (&Skeymapp);
3790 defsubr (&Skeymap_parent);
3791 defsubr (&Skeymap_prompt);
3792 defsubr (&Sset_keymap_parent);
3793 defsubr (&Smake_keymap);
3794 defsubr (&Smake_sparse_keymap);
3795 defsubr (&Smap_keymap_internal);
3796 defsubr (&Smap_keymap);
3797 defsubr (&Scopy_keymap);
3798 defsubr (&Scommand_remapping);
3799 defsubr (&Skey_binding);
3800 defsubr (&Slocal_key_binding);
3801 defsubr (&Sglobal_key_binding);
3802 defsubr (&Sminor_mode_key_binding);
3803 defsubr (&Sdefine_key);
3804 defsubr (&Slookup_key);
3805 defsubr (&Sdefine_prefix_command);
3806 defsubr (&Suse_global_map);
3807 defsubr (&Suse_local_map);
3808 defsubr (&Scurrent_local_map);
3809 defsubr (&Scurrent_global_map);
3810 defsubr (&Scurrent_minor_mode_maps);
3811 defsubr (&Scurrent_active_maps);
3812 defsubr (&Saccessible_keymaps);
3813 defsubr (&Skey_description);
3814 defsubr (&Sdescribe_vector);
3815 defsubr (&Ssingle_key_description);
3816 defsubr (&Stext_char_description);
3817 defsubr (&Swhere_is_internal);
3818 defsubr (&Sdescribe_buffer_bindings);
3819 defsubr (&Sapropos_internal);
3822 void
3823 keys_of_keymap (void)
3825 initial_define_key (global_map, 033, "ESC-prefix");
3826 initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");