* frames.texi (Pop-Up Menus): Document where menu title comes from (Bug#7684).
[emacs.git] / src / keymap.c
blob00726cdea9d7bd310a8d61f0906a01600f1affc5
1 /* Manipulation of keymaps
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
6 This file is part of GNU Emacs.
8 GNU Emacs is free software: you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation, either version 3 of the License, or
11 (at your option) any later version.
13 GNU Emacs is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
22 #include <config.h>
23 #include <stdio.h>
24 #include <setjmp.h>
25 #if HAVE_ALLOCA_H
26 # include <alloca.h>
27 #endif
28 #include "lisp.h"
29 #include "commands.h"
30 #include "buffer.h"
31 #include "character.h"
32 #include "charset.h"
33 #include "keyboard.h"
34 #include "frame.h"
35 #include "termhooks.h"
36 #include "blockinput.h"
37 #include "puresize.h"
38 #include "intervals.h"
39 #include "keymap.h"
40 #include "window.h"
42 /* The number of elements in keymap vectors. */
43 #define DENSE_TABLE_SIZE (0200)
45 /* Actually allocate storage for these variables */
47 Lisp_Object current_global_map; /* Current global keymap */
49 Lisp_Object global_map; /* default global key bindings */
51 Lisp_Object meta_map; /* The keymap used for globally bound
52 ESC-prefixed default commands */
54 Lisp_Object control_x_map; /* The keymap used for globally bound
55 C-x-prefixed default commands */
57 /* was MinibufLocalMap */
58 Lisp_Object Vminibuffer_local_map;
59 /* The keymap used by the minibuf for local
60 bindings when spaces are allowed in the
61 minibuf */
63 /* was MinibufLocalNSMap */
64 Lisp_Object Vminibuffer_local_ns_map;
65 /* The keymap used by the minibuf for local
66 bindings when spaces are not encouraged
67 in the minibuf */
69 /* keymap used for minibuffers when doing completion */
70 /* was MinibufLocalCompletionMap */
71 Lisp_Object Vminibuffer_local_completion_map;
73 /* keymap used for minibuffers when doing completion in filenames */
74 Lisp_Object Vminibuffer_local_filename_completion_map;
76 /* keymap used for minibuffers when doing completion in filenames
77 with require-match*/
78 Lisp_Object Vminibuffer_local_filename_must_match_map;
80 /* keymap used for minibuffers when doing completion and require a match */
81 /* was MinibufLocalMustMatchMap */
82 Lisp_Object Vminibuffer_local_must_match_map;
84 /* Alist of minor mode variables and keymaps. */
85 Lisp_Object Vminor_mode_map_alist;
87 /* Alist of major-mode-specific overrides for
88 minor mode variables and keymaps. */
89 Lisp_Object Vminor_mode_overriding_map_alist;
91 /* List of emulation mode keymap alists. */
92 Lisp_Object Vemulation_mode_map_alists;
94 /* A list of all commands given new bindings since a certain time
95 when nil was stored here.
96 This is used to speed up recomputation of menu key equivalents
97 when Emacs starts up. t means don't record anything here. */
98 Lisp_Object Vdefine_key_rebound_commands;
100 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
101 Lisp_Object QCadvertised_binding;
103 /* Alist of elements like (DEL . "\d"). */
104 static Lisp_Object exclude_keys;
106 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
107 static Lisp_Object command_remapping_vector;
109 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
110 in a string key sequence is equivalent to prefixing with this
111 character. */
112 extern Lisp_Object meta_prefix_char;
114 extern Lisp_Object Voverriding_local_map;
116 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
117 static Lisp_Object where_is_cache;
118 /* Which keymaps are reverse-stored in the cache. */
119 static Lisp_Object where_is_cache_keymaps;
121 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
122 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
124 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
125 static void describe_command P_ ((Lisp_Object, Lisp_Object));
126 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
127 static void describe_map P_ ((Lisp_Object, Lisp_Object,
128 void (*) P_ ((Lisp_Object, Lisp_Object)),
129 int, Lisp_Object, Lisp_Object*, int, int));
130 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
131 void (*) (Lisp_Object, Lisp_Object), int,
132 Lisp_Object, Lisp_Object, int *,
133 int, int, int));
134 static void silly_event_symbol_error P_ ((Lisp_Object));
136 /* Keymap object support - constructors and predicates. */
138 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
139 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
140 CHARTABLE is a char-table that holds the bindings for all characters
141 without modifiers. All entries in it are initially nil, meaning
142 "command undefined". ALIST is an assoc-list which holds bindings for
143 function keys, mouse events, and any other things that appear in the
144 input stream. Initially, ALIST is nil.
146 The optional arg STRING supplies a menu name for the keymap
147 in case you use it as a menu with `x-popup-menu'. */)
148 (string)
149 Lisp_Object string;
151 Lisp_Object tail;
152 if (!NILP (string))
153 tail = Fcons (string, Qnil);
154 else
155 tail = Qnil;
156 return Fcons (Qkeymap,
157 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
160 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
161 doc: /* Construct and return a new sparse keymap.
162 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
163 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
164 which binds the function key or mouse event SYMBOL to DEFINITION.
165 Initially the alist is nil.
167 The optional arg STRING supplies a menu name for the keymap
168 in case you use it as a menu with `x-popup-menu'. */)
169 (string)
170 Lisp_Object string;
172 if (!NILP (string))
174 if (!NILP (Vpurify_flag))
175 string = Fpurecopy (string);
176 return Fcons (Qkeymap, Fcons (string, Qnil));
178 return Fcons (Qkeymap, Qnil);
181 /* This function is used for installing the standard key bindings
182 at initialization time.
184 For example:
186 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
188 void
189 initial_define_key (keymap, key, defname)
190 Lisp_Object keymap;
191 int key;
192 char *defname;
194 store_in_keymap (keymap, make_number (key), intern_c_string (defname));
197 void
198 initial_define_lispy_key (keymap, keyname, defname)
199 Lisp_Object keymap;
200 char *keyname;
201 char *defname;
203 store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
206 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
207 doc: /* Return t if OBJECT is a keymap.
209 A keymap is a list (keymap . ALIST),
210 or a symbol whose function definition is itself a keymap.
211 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
212 a vector of densely packed bindings for small character codes
213 is also allowed as an element. */)
214 (object)
215 Lisp_Object object;
217 return (KEYMAPP (object) ? Qt : Qnil);
220 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
221 doc: /* Return the prompt-string of a keymap MAP.
222 If non-nil, the prompt is shown in the echo-area
223 when reading a key-sequence to be looked-up in this keymap. */)
224 (map)
225 Lisp_Object map;
227 map = get_keymap (map, 0, 0);
228 while (CONSP (map))
230 Lisp_Object tem = XCAR (map);
231 if (STRINGP (tem))
232 return tem;
233 map = XCDR (map);
235 return Qnil;
238 /* Check that OBJECT is a keymap (after dereferencing through any
239 symbols). If it is, return it.
241 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
242 is an autoload form, do the autoload and try again.
243 If AUTOLOAD is nonzero, callers must assume GC is possible.
245 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
246 is zero as well), return Qt.
248 ERROR controls how we respond if OBJECT isn't a keymap.
249 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
251 Note that most of the time, we don't want to pursue autoloads.
252 Functions like Faccessible_keymaps which scan entire keymap trees
253 shouldn't load every autoloaded keymap. I'm not sure about this,
254 but it seems to me that only read_key_sequence, Flookup_key, and
255 Fdefine_key should cause keymaps to be autoloaded.
257 This function can GC when AUTOLOAD is non-zero, because it calls
258 do_autoload which can GC. */
260 Lisp_Object
261 get_keymap (object, error, autoload)
262 Lisp_Object object;
263 int error, autoload;
265 Lisp_Object tem;
267 autoload_retry:
268 if (NILP (object))
269 goto end;
270 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
271 return object;
273 tem = indirect_function (object);
274 if (CONSP (tem))
276 if (EQ (XCAR (tem), Qkeymap))
277 return tem;
279 /* Should we do an autoload? Autoload forms for keymaps have
280 Qkeymap as their fifth element. */
281 if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
282 && SYMBOLP (object))
284 Lisp_Object tail;
286 tail = Fnth (make_number (4), tem);
287 if (EQ (tail, Qkeymap))
289 if (autoload)
291 struct gcpro gcpro1, gcpro2;
293 GCPRO2 (tem, object);
294 do_autoload (tem, object);
295 UNGCPRO;
297 goto autoload_retry;
299 else
300 return object;
305 end:
306 if (error)
307 wrong_type_argument (Qkeymapp, object);
308 return Qnil;
311 /* Return the parent map of KEYMAP, or nil if it has none.
312 We assume that KEYMAP is a valid keymap. */
314 Lisp_Object
315 keymap_parent (keymap, autoload)
316 Lisp_Object keymap;
317 int autoload;
319 Lisp_Object list;
321 keymap = get_keymap (keymap, 1, autoload);
323 /* Skip past the initial element `keymap'. */
324 list = XCDR (keymap);
325 for (; CONSP (list); list = XCDR (list))
327 /* See if there is another `keymap'. */
328 if (KEYMAPP (list))
329 return list;
332 return get_keymap (list, 0, autoload);
335 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
336 doc: /* Return the parent keymap of KEYMAP.
337 If KEYMAP has no parent, return nil. */)
338 (keymap)
339 Lisp_Object keymap;
341 return keymap_parent (keymap, 1);
344 /* Check whether MAP is one of MAPS parents. */
346 keymap_memberp (map, maps)
347 Lisp_Object map, maps;
349 if (NILP (map)) return 0;
350 while (KEYMAPP (maps) && !EQ (map, maps))
351 maps = keymap_parent (maps, 0);
352 return (EQ (map, maps));
355 /* Set the parent keymap of MAP to PARENT. */
357 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
358 doc: /* Modify KEYMAP to set its parent map to PARENT.
359 Return PARENT. PARENT should be nil or another keymap. */)
360 (keymap, parent)
361 Lisp_Object keymap, parent;
363 Lisp_Object list, prev;
364 struct gcpro gcpro1, gcpro2;
365 int i;
367 /* Force a keymap flush for the next call to where-is.
368 Since this can be called from within where-is, we don't set where_is_cache
369 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
370 be changed during where-is, while where_is_cache_keymaps is only used at
371 the very beginning of where-is and can thus be changed here without any
372 adverse effect.
373 This is a very minor correctness (rather than safety) issue. */
374 where_is_cache_keymaps = Qt;
376 GCPRO2 (keymap, parent);
377 keymap = get_keymap (keymap, 1, 1);
379 if (!NILP (parent))
381 parent = get_keymap (parent, 1, 1);
383 /* Check for cycles. */
384 if (keymap_memberp (keymap, parent))
385 error ("Cyclic keymap inheritance");
388 /* Skip past the initial element `keymap'. */
389 prev = keymap;
390 while (1)
392 list = XCDR (prev);
393 /* If there is a parent keymap here, replace it.
394 If we came to the end, add the parent in PREV. */
395 if (!CONSP (list) || KEYMAPP (list))
397 /* If we already have the right parent, return now
398 so that we avoid the loops below. */
399 if (EQ (XCDR (prev), parent))
400 RETURN_UNGCPRO (parent);
402 CHECK_IMPURE (prev);
403 XSETCDR (prev, parent);
404 break;
406 prev = list;
409 /* Scan through for submaps, and set their parents too. */
411 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
413 /* Stop the scan when we come to the parent. */
414 if (EQ (XCAR (list), Qkeymap))
415 break;
417 /* If this element holds a prefix map, deal with it. */
418 if (CONSP (XCAR (list))
419 && CONSP (XCDR (XCAR (list))))
420 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
421 XCDR (XCAR (list)));
423 if (VECTORP (XCAR (list)))
424 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
425 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
426 fix_submap_inheritance (keymap, make_number (i),
427 XVECTOR (XCAR (list))->contents[i]);
429 if (CHAR_TABLE_P (XCAR (list)))
431 map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
435 RETURN_UNGCPRO (parent);
438 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
439 if EVENT is also a prefix in MAP's parent,
440 make sure that SUBMAP inherits that definition as its own parent. */
442 static void
443 fix_submap_inheritance (map, event, submap)
444 Lisp_Object map, event, submap;
446 Lisp_Object map_parent, parent_entry;
448 /* SUBMAP is a cons that we found as a key binding.
449 Discard the other things found in a menu key binding. */
451 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
453 /* If it isn't a keymap now, there's no work to do. */
454 if (!CONSP (submap))
455 return;
457 map_parent = keymap_parent (map, 0);
458 if (!NILP (map_parent))
459 parent_entry =
460 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
461 else
462 parent_entry = Qnil;
464 /* If MAP's parent has something other than a keymap,
465 our own submap shadows it completely. */
466 if (!CONSP (parent_entry))
467 return;
469 if (! EQ (parent_entry, submap))
471 Lisp_Object submap_parent;
472 submap_parent = submap;
473 while (1)
475 Lisp_Object tem;
477 tem = keymap_parent (submap_parent, 0);
479 if (KEYMAPP (tem))
481 if (keymap_memberp (tem, parent_entry))
482 /* Fset_keymap_parent could create a cycle. */
483 return;
484 submap_parent = tem;
486 else
487 break;
489 Fset_keymap_parent (submap_parent, parent_entry);
493 /* Look up IDX in MAP. IDX may be any sort of event.
494 Note that this does only one level of lookup; IDX must be a single
495 event, not a sequence.
497 If T_OK is non-zero, bindings for Qt are treated as default
498 bindings; any key left unmentioned by other tables and bindings is
499 given the binding of Qt.
501 If T_OK is zero, bindings for Qt are not treated specially.
503 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
505 Lisp_Object
506 access_keymap (map, idx, t_ok, noinherit, autoload)
507 Lisp_Object map;
508 Lisp_Object idx;
509 int t_ok;
510 int noinherit;
511 int autoload;
513 Lisp_Object val;
515 /* Qunbound in VAL means we have found no binding yet. */
516 val = Qunbound;
518 /* If idx is a list (some sort of mouse click, perhaps?),
519 the index we want to use is the car of the list, which
520 ought to be a symbol. */
521 idx = EVENT_HEAD (idx);
523 /* If idx is a symbol, it might have modifiers, which need to
524 be put in the canonical order. */
525 if (SYMBOLP (idx))
526 idx = reorder_modifiers (idx);
527 else if (INTEGERP (idx))
528 /* Clobber the high bits that can be present on a machine
529 with more than 24 bits of integer. */
530 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
532 /* Handle the special meta -> esc mapping. */
533 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
535 /* See if there is a meta-map. If there's none, there is
536 no binding for IDX, unless a default binding exists in MAP. */
537 struct gcpro gcpro1;
538 Lisp_Object meta_map;
539 GCPRO1 (map);
540 /* A strange value in which Meta is set would cause
541 infinite recursion. Protect against that. */
542 if (XINT (meta_prefix_char) & CHAR_META)
543 meta_prefix_char = make_number (27);
544 meta_map = get_keymap (access_keymap (map, meta_prefix_char,
545 t_ok, noinherit, autoload),
546 0, autoload);
547 UNGCPRO;
548 if (CONSP (meta_map))
550 map = meta_map;
551 idx = make_number (XUINT (idx) & ~meta_modifier);
553 else if (t_ok)
554 /* Set IDX to t, so that we only find a default binding. */
555 idx = Qt;
556 else
557 /* We know there is no binding. */
558 return Qnil;
561 /* t_binding is where we put a default binding that applies,
562 to use in case we do not find a binding specifically
563 for this key sequence. */
565 Lisp_Object tail;
566 Lisp_Object t_binding = Qnil;
567 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
569 GCPRO4 (map, tail, idx, t_binding);
571 for (tail = XCDR (map);
572 (CONSP (tail)
573 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
574 tail = XCDR (tail))
576 Lisp_Object binding;
578 binding = XCAR (tail);
579 if (SYMBOLP (binding))
581 /* If NOINHERIT, stop finding prefix definitions
582 after we pass a second occurrence of the `keymap' symbol. */
583 if (noinherit && EQ (binding, Qkeymap))
584 RETURN_UNGCPRO (Qnil);
586 else if (CONSP (binding))
588 Lisp_Object key = XCAR (binding);
590 if (EQ (key, idx))
591 val = XCDR (binding);
592 else if (t_ok && EQ (key, Qt))
594 t_binding = XCDR (binding);
595 t_ok = 0;
598 else if (VECTORP (binding))
600 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
601 val = AREF (binding, XFASTINT (idx));
603 else if (CHAR_TABLE_P (binding))
605 /* Character codes with modifiers
606 are not included in a char-table.
607 All character codes without modifiers are included. */
608 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
610 val = Faref (binding, idx);
611 /* `nil' has a special meaning for char-tables, so
612 we use something else to record an explicitly
613 unbound entry. */
614 if (NILP (val))
615 val = Qunbound;
619 /* If we found a binding, clean it up and return it. */
620 if (!EQ (val, Qunbound))
622 if (EQ (val, Qt))
623 /* A Qt binding is just like an explicit nil binding
624 (i.e. it shadows any parent binding but not bindings in
625 keymaps of lower precedence). */
626 val = Qnil;
627 val = get_keyelt (val, autoload);
628 if (KEYMAPP (val))
629 fix_submap_inheritance (map, idx, val);
630 RETURN_UNGCPRO (val);
632 QUIT;
634 UNGCPRO;
635 return get_keyelt (t_binding, autoload);
639 static void
640 map_keymap_item (fun, args, key, val, data)
641 map_keymap_function_t fun;
642 Lisp_Object args, key, val;
643 void *data;
645 /* We should maybe try to detect bindings shadowed by previous
646 ones and things like that. */
647 if (EQ (val, Qt))
648 val = Qnil;
649 (*fun) (key, val, args, data);
652 static void
653 map_keymap_char_table_item (args, key, val)
654 Lisp_Object args, key, val;
656 if (!NILP (val))
658 map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
659 args = XCDR (args);
660 /* If the key is a range, make a copy since map_char_table modifies
661 it in place. */
662 if (CONSP (key))
663 key = Fcons (XCAR (key), XCDR (key));
664 map_keymap_item (fun, XCDR (args), key, val,
665 XSAVE_VALUE (XCAR (args))->pointer);
669 /* Call FUN for every binding in MAP and stop at (and return) the parent.
670 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA). */
671 Lisp_Object
672 map_keymap_internal (Lisp_Object map,
673 map_keymap_function_t fun,
674 Lisp_Object args,
675 void *data)
677 struct gcpro gcpro1, gcpro2, gcpro3;
678 Lisp_Object tail
679 = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
681 GCPRO3 (map, args, tail);
682 for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
684 Lisp_Object binding = XCAR (tail);
686 if (CONSP (binding))
687 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
688 else if (VECTORP (binding))
690 /* Loop over the char values represented in the vector. */
691 int len = ASIZE (binding);
692 int c;
693 for (c = 0; c < len; c++)
695 Lisp_Object character;
696 XSETFASTINT (character, c);
697 map_keymap_item (fun, args, character, AREF (binding, c), data);
700 else if (CHAR_TABLE_P (binding))
702 map_char_table (map_keymap_char_table_item, Qnil, binding,
703 Fcons (make_save_value (fun, 0),
704 Fcons (make_save_value (data, 0),
705 args)));
708 UNGCPRO;
709 return tail;
712 static void
713 map_keymap_call (key, val, fun, dummy)
714 Lisp_Object key, val, fun;
715 void *dummy;
717 call2 (fun, key, val);
720 /* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
721 A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
722 void
723 map_keymap (map, fun, args, data, autoload)
724 map_keymap_function_t fun;
725 Lisp_Object map, args;
726 void *data;
727 int autoload;
729 struct gcpro gcpro1;
730 GCPRO1 (args);
731 map = get_keymap (map, 1, autoload);
732 while (CONSP (map))
734 map = map_keymap_internal (map, fun, args, data);
735 map = get_keymap (map, 0, autoload);
737 UNGCPRO;
740 Lisp_Object Qkeymap_canonicalize;
742 /* Same as map_keymap, but does it right, properly eliminating duplicate
743 bindings due to inheritance. */
744 void
745 map_keymap_canonical (map, fun, args, data)
746 map_keymap_function_t fun;
747 Lisp_Object map, args;
748 void *data;
750 struct gcpro gcpro1;
751 GCPRO1 (args);
752 /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
753 so be careful to ignore errors and to inhibit redisplay. */
754 map = safe_call1 (Qkeymap_canonicalize, map);
755 /* No need to use `map_keymap' here because canonical map has no parent. */
756 map_keymap_internal (map, fun, args, data);
757 UNGCPRO;
760 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
761 doc: /* Call FUNCTION once for each event binding in KEYMAP.
762 FUNCTION is called with two arguments: the event that is bound, and
763 the definition it is bound to. The event may be a character range.
764 If KEYMAP has a parent, this function returns it without processing it. */)
765 (function, keymap)
766 Lisp_Object function, keymap;
768 struct gcpro gcpro1;
769 GCPRO1 (function);
770 keymap = get_keymap (keymap, 1, 1);
771 keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
772 UNGCPRO;
773 return keymap;
776 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
777 doc: /* Call FUNCTION once for each event binding in KEYMAP.
778 FUNCTION is called with two arguments: the event that is bound, and
779 the definition it is bound to. The event may be a character range.
781 If KEYMAP has a parent, the parent's bindings are included as well.
782 This works recursively: if the parent has itself a parent, then the
783 grandparent's bindings are also included and so on.
784 usage: (map-keymap FUNCTION KEYMAP) */)
785 (function, keymap, sort_first)
786 Lisp_Object function, keymap, sort_first;
788 if (! NILP (sort_first))
789 return call2 (intern ("map-keymap-sorted"), function, keymap);
791 map_keymap (keymap, map_keymap_call, function, NULL, 1);
792 return Qnil;
795 /* Given OBJECT which was found in a slot in a keymap,
796 trace indirect definitions to get the actual definition of that slot.
797 An indirect definition is a list of the form
798 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
799 and INDEX is the object to look up in KEYMAP to yield the definition.
801 Also if OBJECT has a menu string as the first element,
802 remove that. Also remove a menu help string as second element.
804 If AUTOLOAD is nonzero, load autoloadable keymaps
805 that are referred to with indirection.
807 This can GC because menu_item_eval_property calls Feval. */
809 Lisp_Object
810 get_keyelt (object, autoload)
811 Lisp_Object object;
812 int autoload;
814 while (1)
816 if (!(CONSP (object)))
817 /* This is really the value. */
818 return object;
820 /* If the keymap contents looks like (keymap ...) or (lambda ...)
821 then use itself. */
822 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
823 return object;
825 /* If the keymap contents looks like (menu-item name . DEFN)
826 or (menu-item name DEFN ...) then use DEFN.
827 This is a new format menu item. */
828 else if (EQ (XCAR (object), Qmenu_item))
830 if (CONSP (XCDR (object)))
832 Lisp_Object tem;
834 object = XCDR (XCDR (object));
835 tem = object;
836 if (CONSP (object))
837 object = XCAR (object);
839 /* If there's a `:filter FILTER', apply FILTER to the
840 menu-item's definition to get the real definition to
841 use. */
842 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
843 if (EQ (XCAR (tem), QCfilter) && autoload)
845 Lisp_Object filter;
846 filter = XCAR (XCDR (tem));
847 filter = list2 (filter, list2 (Qquote, object));
848 object = menu_item_eval_property (filter);
849 break;
852 else
853 /* Invalid keymap. */
854 return object;
857 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
858 Keymap alist elements like (CHAR MENUSTRING . DEFN)
859 will be used by HierarKey menus. */
860 else if (STRINGP (XCAR (object)))
862 object = XCDR (object);
863 /* Also remove a menu help string, if any,
864 following the menu item name. */
865 if (CONSP (object) && STRINGP (XCAR (object)))
866 object = XCDR (object);
867 /* Also remove the sublist that caches key equivalences, if any. */
868 if (CONSP (object) && CONSP (XCAR (object)))
870 Lisp_Object carcar;
871 carcar = XCAR (XCAR (object));
872 if (NILP (carcar) || VECTORP (carcar))
873 object = XCDR (object);
877 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
878 else
880 struct gcpro gcpro1;
881 Lisp_Object map;
882 GCPRO1 (object);
883 map = get_keymap (Fcar_safe (object), 0, autoload);
884 UNGCPRO;
885 return (!CONSP (map) ? object /* Invalid keymap */
886 : access_keymap (map, Fcdr (object), 0, 0, autoload));
891 static Lisp_Object
892 store_in_keymap (keymap, idx, def)
893 Lisp_Object keymap;
894 register Lisp_Object idx;
895 Lisp_Object def;
897 /* Flush any reverse-map cache. */
898 where_is_cache = Qnil;
899 where_is_cache_keymaps = Qt;
901 /* If we are preparing to dump, and DEF is a menu element
902 with a menu item indicator, copy it to ensure it is not pure. */
903 if (CONSP (def) && PURE_P (def)
904 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
905 def = Fcons (XCAR (def), XCDR (def));
907 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
908 error ("attempt to define a key in a non-keymap");
910 /* If idx is a cons, and the car part is a character, idx must be of
911 the form (FROM-CHAR . TO-CHAR). */
912 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
913 CHECK_CHARACTER_CDR (idx);
914 else
915 /* If idx is a list (some sort of mouse click, perhaps?),
916 the index we want to use is the car of the list, which
917 ought to be a symbol. */
918 idx = EVENT_HEAD (idx);
920 /* If idx is a symbol, it might have modifiers, which need to
921 be put in the canonical order. */
922 if (SYMBOLP (idx))
923 idx = reorder_modifiers (idx);
924 else if (INTEGERP (idx))
925 /* Clobber the high bits that can be present on a machine
926 with more than 24 bits of integer. */
927 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
929 /* Scan the keymap for a binding of idx. */
931 Lisp_Object tail;
933 /* The cons after which we should insert new bindings. If the
934 keymap has a table element, we record its position here, so new
935 bindings will go after it; this way, the table will stay
936 towards the front of the alist and character lookups in dense
937 keymaps will remain fast. Otherwise, this just points at the
938 front of the keymap. */
939 Lisp_Object insertion_point;
941 insertion_point = keymap;
942 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
944 Lisp_Object elt;
946 elt = XCAR (tail);
947 if (VECTORP (elt))
949 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
951 CHECK_IMPURE (elt);
952 ASET (elt, XFASTINT (idx), def);
953 return def;
955 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
957 int from = XFASTINT (XCAR (idx));
958 int to = XFASTINT (XCDR (idx));
960 if (to >= ASIZE (elt))
961 to = ASIZE (elt) - 1;
962 for (; from <= to; from++)
963 ASET (elt, from, def);
964 if (to == XFASTINT (XCDR (idx)))
965 /* We have defined all keys in IDX. */
966 return def;
968 insertion_point = tail;
970 else if (CHAR_TABLE_P (elt))
972 /* Character codes with modifiers
973 are not included in a char-table.
974 All character codes without modifiers are included. */
975 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
977 Faset (elt, idx,
978 /* `nil' has a special meaning for char-tables, so
979 we use something else to record an explicitly
980 unbound entry. */
981 NILP (def) ? Qt : def);
982 return def;
984 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
986 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
987 return def;
989 insertion_point = tail;
991 else if (CONSP (elt))
993 if (EQ (idx, XCAR (elt)))
995 CHECK_IMPURE (elt);
996 XSETCDR (elt, def);
997 return def;
999 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
1001 int from = XFASTINT (XCAR (idx));
1002 int to = XFASTINT (XCDR (idx));
1004 if (from <= XFASTINT (XCAR (elt))
1005 && to >= XFASTINT (XCAR (elt)))
1007 XSETCDR (elt, def);
1008 if (from == to)
1009 return def;
1013 else if (EQ (elt, Qkeymap))
1014 /* If we find a 'keymap' symbol in the spine of KEYMAP,
1015 then we must have found the start of a second keymap
1016 being used as the tail of KEYMAP, and a binding for IDX
1017 should be inserted before it. */
1018 goto keymap_end;
1020 QUIT;
1023 keymap_end:
1024 /* We have scanned the entire keymap, and not found a binding for
1025 IDX. Let's add one. */
1027 Lisp_Object elt;
1029 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
1031 /* IDX specifies a range of characters, and not all of them
1032 were handled yet, which means this keymap doesn't have a
1033 char-table. So, we insert a char-table now. */
1034 elt = Fmake_char_table (Qkeymap, Qnil);
1035 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
1037 else
1038 elt = Fcons (idx, def);
1039 CHECK_IMPURE (insertion_point);
1040 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
1044 return def;
1047 EXFUN (Fcopy_keymap, 1);
1049 Lisp_Object
1050 copy_keymap_item (elt)
1051 Lisp_Object elt;
1053 Lisp_Object res, tem;
1055 if (!CONSP (elt))
1056 return elt;
1058 res = tem = elt;
1060 /* Is this a new format menu item. */
1061 if (EQ (XCAR (tem), Qmenu_item))
1063 /* Copy cell with menu-item marker. */
1064 res = elt = Fcons (XCAR (tem), XCDR (tem));
1065 tem = XCDR (elt);
1066 if (CONSP (tem))
1068 /* Copy cell with menu-item name. */
1069 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1070 elt = XCDR (elt);
1071 tem = XCDR (elt);
1073 if (CONSP (tem))
1075 /* Copy cell with binding and if the binding is a keymap,
1076 copy that. */
1077 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1078 elt = XCDR (elt);
1079 tem = XCAR (elt);
1080 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1081 XSETCAR (elt, Fcopy_keymap (tem));
1082 tem = XCDR (elt);
1083 if (CONSP (tem) && CONSP (XCAR (tem)))
1084 /* Delete cache for key equivalences. */
1085 XSETCDR (elt, XCDR (tem));
1088 else
1090 /* It may be an old fomat menu item.
1091 Skip the optional menu string. */
1092 if (STRINGP (XCAR (tem)))
1094 /* Copy the cell, since copy-alist didn't go this deep. */
1095 res = elt = Fcons (XCAR (tem), XCDR (tem));
1096 tem = XCDR (elt);
1097 /* Also skip the optional menu help string. */
1098 if (CONSP (tem) && STRINGP (XCAR (tem)))
1100 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1101 elt = XCDR (elt);
1102 tem = XCDR (elt);
1104 /* There may also be a list that caches key equivalences.
1105 Just delete it for the new keymap. */
1106 if (CONSP (tem)
1107 && CONSP (XCAR (tem))
1108 && (NILP (XCAR (XCAR (tem)))
1109 || VECTORP (XCAR (XCAR (tem)))))
1111 XSETCDR (elt, XCDR (tem));
1112 tem = XCDR (tem);
1114 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1115 XSETCDR (elt, Fcopy_keymap (tem));
1117 else if (EQ (XCAR (tem), Qkeymap))
1118 res = Fcopy_keymap (elt);
1120 return res;
1123 static void
1124 copy_keymap_1 (chartable, idx, elt)
1125 Lisp_Object chartable, idx, elt;
1127 Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
1130 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1131 doc: /* Return a copy of the keymap KEYMAP.
1132 The copy starts out with the same definitions of KEYMAP,
1133 but changing either the copy or KEYMAP does not affect the other.
1134 Any key definitions that are subkeymaps are recursively copied.
1135 However, a key definition which is a symbol whose definition is a keymap
1136 is not copied. */)
1137 (keymap)
1138 Lisp_Object keymap;
1140 register Lisp_Object copy, tail;
1141 keymap = get_keymap (keymap, 1, 0);
1142 copy = tail = Fcons (Qkeymap, Qnil);
1143 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1145 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1147 Lisp_Object elt = XCAR (keymap);
1148 if (CHAR_TABLE_P (elt))
1150 elt = Fcopy_sequence (elt);
1151 map_char_table (copy_keymap_1, Qnil, elt, elt);
1153 else if (VECTORP (elt))
1155 int i;
1156 elt = Fcopy_sequence (elt);
1157 for (i = 0; i < ASIZE (elt); i++)
1158 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1160 else if (CONSP (elt))
1161 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1162 XSETCDR (tail, Fcons (elt, Qnil));
1163 tail = XCDR (tail);
1164 keymap = XCDR (keymap);
1166 XSETCDR (tail, keymap);
1167 return copy;
1170 /* Simple Keymap mutators and accessors. */
1172 /* GC is possible in this function if it autoloads a keymap. */
1174 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1175 doc: /* In KEYMAP, define key sequence KEY as DEF.
1176 KEYMAP is a keymap.
1178 KEY is a string or a vector of symbols and characters, representing a
1179 sequence of keystrokes and events. Non-ASCII characters with codes
1180 above 127 (such as ISO Latin-1) can be represented by vectors.
1181 Two types of vector have special meanings:
1182 [remap COMMAND] remaps any key binding for COMMAND in KEYMAP.
1183 [t] creates a default definition, which applies to any event with no
1184 other definition in KEYMAP.
1186 DEF is anything that can be a key's definition:
1187 nil (means key is undefined in this keymap),
1188 a command (a Lisp function suitable for interactive calling),
1189 a string (treated as a keyboard macro),
1190 a keymap (to define a prefix key),
1191 a symbol (when the key is looked up, the symbol will stand for its
1192 function definition, which should at that time be one of the above,
1193 or another symbol whose function definition is used, etc.),
1194 a cons (STRING . DEFN), meaning that DEFN is the definition
1195 (DEFN should be a valid definition in its own right),
1196 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1197 or an extended menu item definition.
1198 (See info node `(elisp)Extended Menu Items'.)
1200 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1201 binding is altered. If there is no binding for KEY, the new pair
1202 binding KEY to DEF is added at the front of KEYMAP. */)
1203 (keymap, key, def)
1204 Lisp_Object keymap;
1205 Lisp_Object key;
1206 Lisp_Object def;
1208 register int idx;
1209 register Lisp_Object c;
1210 register Lisp_Object cmd;
1211 int metized = 0;
1212 int meta_bit;
1213 int length;
1214 struct gcpro gcpro1, gcpro2, gcpro3;
1216 GCPRO3 (keymap, key, def);
1217 keymap = get_keymap (keymap, 1, 1);
1219 CHECK_VECTOR_OR_STRING (key);
1221 length = XFASTINT (Flength (key));
1222 if (length == 0)
1223 RETURN_UNGCPRO (Qnil);
1225 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1226 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1228 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1229 ? meta_modifier : 0x80);
1231 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1232 { /* DEF is apparently an XEmacs-style keyboard macro. */
1233 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1234 int i = ASIZE (def);
1235 while (--i >= 0)
1237 Lisp_Object c = AREF (def, i);
1238 if (CONSP (c) && lucid_event_type_list_p (c))
1239 c = Fevent_convert_list (c);
1240 ASET (tmp, i, c);
1242 def = tmp;
1245 idx = 0;
1246 while (1)
1248 c = Faref (key, make_number (idx));
1250 if (CONSP (c))
1252 /* C may be a Lucid style event type list or a cons (FROM .
1253 TO) specifying a range of characters. */
1254 if (lucid_event_type_list_p (c))
1255 c = Fevent_convert_list (c);
1256 else if (CHARACTERP (XCAR (c)))
1257 CHECK_CHARACTER_CDR (c);
1260 if (SYMBOLP (c))
1261 silly_event_symbol_error (c);
1263 if (INTEGERP (c)
1264 && (XINT (c) & meta_bit)
1265 && !metized)
1267 c = meta_prefix_char;
1268 metized = 1;
1270 else
1272 if (INTEGERP (c))
1273 XSETINT (c, XINT (c) & ~meta_bit);
1275 metized = 0;
1276 idx++;
1279 if (!INTEGERP (c) && !SYMBOLP (c)
1280 && (!CONSP (c)
1281 /* If C is a range, it must be a leaf. */
1282 || (INTEGERP (XCAR (c)) && idx != length)))
1283 error ("Key sequence contains invalid event");
1285 if (idx == length)
1286 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1288 cmd = access_keymap (keymap, c, 0, 1, 1);
1290 /* If this key is undefined, make it a prefix. */
1291 if (NILP (cmd))
1292 cmd = define_as_prefix (keymap, c);
1294 keymap = get_keymap (cmd, 0, 1);
1295 if (!CONSP (keymap))
1296 /* We must use Fkey_description rather than just passing key to
1297 error; key might be a vector, not a string. */
1298 error ("Key sequence %s starts with non-prefix key %s",
1299 SDATA (Fkey_description (key, Qnil)),
1300 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1301 make_number (idx)),
1302 Qnil)));
1306 /* This function may GC (it calls Fkey_binding). */
1308 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1309 doc: /* Return the remapping for command COMMAND.
1310 Returns nil if COMMAND is not remapped (or not a symbol).
1312 If the optional argument POSITION is non-nil, it specifies a mouse
1313 position as returned by `event-start' and `event-end', and the
1314 remapping occurs in the keymaps associated with it. It can also be a
1315 number or marker, in which case the keymap properties at the specified
1316 buffer position instead of point are used. The KEYMAPS argument is
1317 ignored if POSITION is non-nil.
1319 If the optional argument KEYMAPS is non-nil, it should be a list of
1320 keymaps to search for command remapping. Otherwise, search for the
1321 remapping in all currently active keymaps. */)
1322 (command, position, keymaps)
1323 Lisp_Object command, position, keymaps;
1325 if (!SYMBOLP (command))
1326 return Qnil;
1328 ASET (command_remapping_vector, 1, command);
1330 if (NILP (keymaps))
1331 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1332 else
1334 Lisp_Object maps, binding;
1336 for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
1338 binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
1339 if (!NILP (binding) && !INTEGERP (binding))
1340 return binding;
1342 return Qnil;
1346 /* Value is number if KEY is too long; nil if valid but has no definition. */
1347 /* GC is possible in this function if it autoloads a keymap. */
1349 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1350 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1351 A value of nil means undefined. See doc of `define-key'
1352 for kinds of definitions.
1354 A number as value means KEY is "too long";
1355 that is, characters or symbols in it except for the last one
1356 fail to be a valid sequence of prefix characters in KEYMAP.
1357 The number is how many characters at the front of KEY
1358 it takes to reach a non-prefix key.
1360 Normally, `lookup-key' ignores bindings for t, which act as default
1361 bindings, used when nothing else in the keymap applies; this makes it
1362 usable as a general function for probing keymaps. However, if the
1363 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1364 recognize the default bindings, just as `read-key-sequence' does. */)
1365 (keymap, key, accept_default)
1366 Lisp_Object keymap;
1367 Lisp_Object key;
1368 Lisp_Object accept_default;
1370 register int idx;
1371 register Lisp_Object cmd;
1372 register Lisp_Object c;
1373 int length;
1374 int t_ok = !NILP (accept_default);
1375 struct gcpro gcpro1, gcpro2;
1377 GCPRO2 (keymap, key);
1378 keymap = get_keymap (keymap, 1, 1);
1380 CHECK_VECTOR_OR_STRING (key);
1382 length = XFASTINT (Flength (key));
1383 if (length == 0)
1384 RETURN_UNGCPRO (keymap);
1386 idx = 0;
1387 while (1)
1389 c = Faref (key, make_number (idx++));
1391 if (CONSP (c) && lucid_event_type_list_p (c))
1392 c = Fevent_convert_list (c);
1394 /* Turn the 8th bit of string chars into a meta modifier. */
1395 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1396 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1398 /* Allow string since binding for `menu-bar-select-buffer'
1399 includes the buffer name in the key sequence. */
1400 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1401 error ("Key sequence contains invalid event");
1403 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1404 if (idx == length)
1405 RETURN_UNGCPRO (cmd);
1407 keymap = get_keymap (cmd, 0, 1);
1408 if (!CONSP (keymap))
1409 RETURN_UNGCPRO (make_number (idx));
1411 QUIT;
1415 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1416 Assume that currently it does not define C at all.
1417 Return the keymap. */
1419 static Lisp_Object
1420 define_as_prefix (keymap, c)
1421 Lisp_Object keymap, c;
1423 Lisp_Object cmd;
1425 cmd = Fmake_sparse_keymap (Qnil);
1426 /* If this key is defined as a prefix in an inherited keymap,
1427 make it a prefix in this map, and make its definition
1428 inherit the other prefix definition. */
1429 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1430 store_in_keymap (keymap, c, cmd);
1432 return cmd;
1435 /* Append a key to the end of a key sequence. We always make a vector. */
1437 Lisp_Object
1438 append_key (key_sequence, key)
1439 Lisp_Object key_sequence, key;
1441 Lisp_Object args[2];
1443 args[0] = key_sequence;
1445 args[1] = Fcons (key, Qnil);
1446 return Fvconcat (2, args);
1449 /* Given a event type C which is a symbol,
1450 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1452 static void
1453 silly_event_symbol_error (c)
1454 Lisp_Object c;
1456 Lisp_Object parsed, base, name, assoc;
1457 int modifiers;
1459 parsed = parse_modifiers (c);
1460 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1461 base = XCAR (parsed);
1462 name = Fsymbol_name (base);
1463 /* This alist includes elements such as ("RET" . "\\r"). */
1464 assoc = Fassoc (name, exclude_keys);
1466 if (! NILP (assoc))
1468 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1469 char *p = new_mods;
1470 Lisp_Object keystring;
1471 if (modifiers & alt_modifier)
1472 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1473 if (modifiers & ctrl_modifier)
1474 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1475 if (modifiers & hyper_modifier)
1476 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1477 if (modifiers & meta_modifier)
1478 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1479 if (modifiers & shift_modifier)
1480 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1481 if (modifiers & super_modifier)
1482 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1483 *p = 0;
1485 c = reorder_modifiers (c);
1486 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1488 error ((modifiers & ~meta_modifier
1489 ? "To bind the key %s, use [?%s], not [%s]"
1490 : "To bind the key %s, use \"%s\", not [%s]"),
1491 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1492 SDATA (SYMBOL_NAME (c)));
1496 /* Global, local, and minor mode keymap stuff. */
1498 /* We can't put these variables inside current_minor_maps, since under
1499 some systems, static gets macro-defined to be the empty string.
1500 Ickypoo. */
1501 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1502 static int cmm_size = 0;
1504 /* Store a pointer to an array of the currently active minor modes in
1505 *modeptr, a pointer to an array of the keymaps of the currently
1506 active minor modes in *mapptr, and return the number of maps
1507 *mapptr contains.
1509 This function always returns a pointer to the same buffer, and may
1510 free or reallocate it, so if you want to keep it for a long time or
1511 hand it out to lisp code, copy it. This procedure will be called
1512 for every key sequence read, so the nice lispy approach (return a
1513 new assoclist, list, what have you) for each invocation would
1514 result in a lot of consing over time.
1516 If we used xrealloc/xmalloc and ran out of memory, they would throw
1517 back to the command loop, which would try to read a key sequence,
1518 which would call this function again, resulting in an infinite
1519 loop. Instead, we'll use realloc/malloc and silently truncate the
1520 list, let the key sequence be read, and hope some other piece of
1521 code signals the error. */
1523 current_minor_maps (modeptr, mapptr)
1524 Lisp_Object **modeptr, **mapptr;
1526 int i = 0;
1527 int list_number = 0;
1528 Lisp_Object alist, assoc, var, val;
1529 Lisp_Object emulation_alists;
1530 Lisp_Object lists[2];
1532 emulation_alists = Vemulation_mode_map_alists;
1533 lists[0] = Vminor_mode_overriding_map_alist;
1534 lists[1] = Vminor_mode_map_alist;
1536 for (list_number = 0; list_number < 2; list_number++)
1538 if (CONSP (emulation_alists))
1540 alist = XCAR (emulation_alists);
1541 emulation_alists = XCDR (emulation_alists);
1542 if (SYMBOLP (alist))
1543 alist = find_symbol_value (alist);
1544 list_number = -1;
1546 else
1547 alist = lists[list_number];
1549 for ( ; CONSP (alist); alist = XCDR (alist))
1550 if ((assoc = XCAR (alist), CONSP (assoc))
1551 && (var = XCAR (assoc), SYMBOLP (var))
1552 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1553 && !NILP (val))
1555 Lisp_Object temp;
1557 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1558 and also an entry in Vminor_mode_map_alist,
1559 ignore the latter. */
1560 if (list_number == 1)
1562 val = assq_no_quit (var, lists[0]);
1563 if (!NILP (val))
1564 continue;
1567 if (i >= cmm_size)
1569 int newsize, allocsize;
1570 Lisp_Object *newmodes, *newmaps;
1572 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1573 allocsize = newsize * sizeof *newmodes;
1575 /* Use malloc here. See the comment above this function.
1576 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1577 BLOCK_INPUT;
1578 newmodes = (Lisp_Object *) malloc (allocsize);
1579 if (newmodes)
1581 if (cmm_modes)
1583 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1584 free (cmm_modes);
1586 cmm_modes = newmodes;
1589 newmaps = (Lisp_Object *) malloc (allocsize);
1590 if (newmaps)
1592 if (cmm_maps)
1594 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1595 free (cmm_maps);
1597 cmm_maps = newmaps;
1599 UNBLOCK_INPUT;
1601 if (newmodes == NULL || newmaps == NULL)
1602 break;
1603 cmm_size = newsize;
1606 /* Get the keymap definition--or nil if it is not defined. */
1607 temp = Findirect_function (XCDR (assoc), Qt);
1608 if (!NILP (temp))
1610 cmm_modes[i] = var;
1611 cmm_maps [i] = temp;
1612 i++;
1617 if (modeptr) *modeptr = cmm_modes;
1618 if (mapptr) *mapptr = cmm_maps;
1619 return i;
1622 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1623 0, 2, 0,
1624 doc: /* Return a list of the currently active keymaps.
1625 OLP if non-nil indicates that we should obey `overriding-local-map' and
1626 `overriding-terminal-local-map'. POSITION can specify a click position
1627 like in the respective argument of `key-binding'. */)
1628 (olp, position)
1629 Lisp_Object olp, position;
1631 int count = SPECPDL_INDEX ();
1633 Lisp_Object keymaps;
1635 /* If a mouse click position is given, our variables are based on
1636 the buffer clicked on, not the current buffer. So we may have to
1637 switch the buffer here. */
1639 if (CONSP (position))
1641 Lisp_Object window;
1643 window = POSN_WINDOW (position);
1645 if (WINDOWP (window)
1646 && BUFFERP (XWINDOW (window)->buffer)
1647 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1649 /* Arrange to go back to the original buffer once we're done
1650 processing the key sequence. We don't use
1651 save_excursion_{save,restore} here, in analogy to
1652 `read-key-sequence' to avoid saving point. Maybe this
1653 would not be a problem here, but it is easier to keep
1654 things the same.
1657 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1659 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1663 keymaps = Fcons (current_global_map, Qnil);
1665 if (!NILP (olp))
1667 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1668 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1669 /* The doc said that overriding-terminal-local-map should
1670 override overriding-local-map. The code used them both,
1671 but it seems clearer to use just one. rms, jan 2005. */
1672 else if (!NILP (Voverriding_local_map))
1673 keymaps = Fcons (Voverriding_local_map, keymaps);
1675 if (NILP (XCDR (keymaps)))
1677 Lisp_Object *maps;
1678 int nmaps, i;
1680 Lisp_Object keymap, local_map;
1681 EMACS_INT pt;
1683 pt = INTEGERP (position) ? XINT (position)
1684 : MARKERP (position) ? marker_position (position)
1685 : PT;
1687 /* Get the buffer local maps, possibly overriden by text or
1688 overlay properties */
1690 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1691 keymap = get_local_map (pt, current_buffer, Qkeymap);
1693 if (CONSP (position))
1695 Lisp_Object string;
1697 /* For a mouse click, get the local text-property keymap
1698 of the place clicked on, rather than point. */
1700 if (POSN_INBUFFER_P (position))
1702 Lisp_Object pos;
1704 pos = POSN_BUFFER_POSN (position);
1705 if (INTEGERP (pos)
1706 && XINT (pos) >= BEG && XINT (pos) <= Z)
1708 local_map = get_local_map (XINT (pos),
1709 current_buffer, Qlocal_map);
1711 keymap = get_local_map (XINT (pos),
1712 current_buffer, Qkeymap);
1716 /* If on a mode line string with a local keymap,
1717 or for a click on a string, i.e. overlay string or a
1718 string displayed via the `display' property,
1719 consider `local-map' and `keymap' properties of
1720 that string. */
1722 if (string = POSN_STRING (position),
1723 (CONSP (string) && STRINGP (XCAR (string))))
1725 Lisp_Object pos, map;
1727 pos = XCDR (string);
1728 string = XCAR (string);
1729 if (INTEGERP (pos)
1730 && XINT (pos) >= 0
1731 && XINT (pos) < SCHARS (string))
1733 map = Fget_text_property (pos, Qlocal_map, string);
1734 if (!NILP (map))
1735 local_map = map;
1737 map = Fget_text_property (pos, Qkeymap, string);
1738 if (!NILP (map))
1739 keymap = map;
1745 if (!NILP (local_map))
1746 keymaps = Fcons (local_map, keymaps);
1748 /* Now put all the minor mode keymaps on the list. */
1749 nmaps = current_minor_maps (0, &maps);
1751 for (i = --nmaps; i >= 0; i--)
1752 if (!NILP (maps[i]))
1753 keymaps = Fcons (maps[i], keymaps);
1755 if (!NILP (keymap))
1756 keymaps = Fcons (keymap, keymaps);
1759 unbind_to (count, Qnil);
1761 return keymaps;
1764 /* GC is possible in this function if it autoloads a keymap. */
1766 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1767 doc: /* Return the binding for command KEY in current keymaps.
1768 KEY is a string or vector, a sequence of keystrokes.
1769 The binding is probably a symbol with a function definition.
1771 Normally, `key-binding' ignores bindings for t, which act as default
1772 bindings, used when nothing else in the keymap applies; this makes it
1773 usable as a general function for probing keymaps. However, if the
1774 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1775 recognize the default bindings, just as `read-key-sequence' does.
1777 Like the normal command loop, `key-binding' will remap the command
1778 resulting from looking up KEY by looking up the command in the
1779 current keymaps. However, if the optional third argument NO-REMAP
1780 is non-nil, `key-binding' returns the unmapped command.
1782 If KEY is a key sequence initiated with the mouse, the used keymaps
1783 will depend on the clicked mouse position with regard to the buffer
1784 and possible local keymaps on strings.
1786 If the optional argument POSITION is non-nil, it specifies a mouse
1787 position as returned by `event-start' and `event-end', and the lookup
1788 occurs in the keymaps associated with it instead of KEY. It can also
1789 be a number or marker, in which case the keymap properties at the
1790 specified buffer position instead of point are used.
1792 (key, accept_default, no_remap, position)
1793 Lisp_Object key, accept_default, no_remap, position;
1795 Lisp_Object *maps, value;
1796 int nmaps, i;
1797 struct gcpro gcpro1, gcpro2;
1798 int count = SPECPDL_INDEX ();
1800 GCPRO2 (key, position);
1802 if (NILP (position) && VECTORP (key))
1804 Lisp_Object event
1805 /* mouse events may have a symbolic prefix indicating the
1806 scrollbar or mode line */
1807 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1809 /* We are not interested in locations without event data */
1811 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1813 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1814 if (EQ (kind, Qmouse_click))
1815 position = EVENT_START (event);
1819 /* Key sequences beginning with mouse clicks
1820 are read using the keymaps of the buffer clicked on, not
1821 the current buffer. So we may have to switch the buffer
1822 here. */
1824 if (CONSP (position))
1826 Lisp_Object window;
1828 window = POSN_WINDOW (position);
1830 if (WINDOWP (window)
1831 && BUFFERP (XWINDOW (window)->buffer)
1832 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1834 /* Arrange to go back to the original buffer once we're done
1835 processing the key sequence. We don't use
1836 save_excursion_{save,restore} here, in analogy to
1837 `read-key-sequence' to avoid saving point. Maybe this
1838 would not be a problem here, but it is easier to keep
1839 things the same.
1842 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1844 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1848 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1850 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1851 key, accept_default);
1852 if (! NILP (value) && !INTEGERP (value))
1853 goto done;
1855 else if (! NILP (Voverriding_local_map))
1857 value = Flookup_key (Voverriding_local_map, key, accept_default);
1858 if (! NILP (value) && !INTEGERP (value))
1859 goto done;
1861 else
1863 Lisp_Object keymap, local_map;
1864 EMACS_INT pt;
1866 pt = INTEGERP (position) ? XINT (position)
1867 : MARKERP (position) ? marker_position (position)
1868 : PT;
1870 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1871 keymap = get_local_map (pt, current_buffer, Qkeymap);
1873 if (CONSP (position))
1875 Lisp_Object string;
1877 /* For a mouse click, get the local text-property keymap
1878 of the place clicked on, rather than point. */
1880 if (POSN_INBUFFER_P (position))
1882 Lisp_Object pos;
1884 pos = POSN_BUFFER_POSN (position);
1885 if (INTEGERP (pos)
1886 && XINT (pos) >= BEG && XINT (pos) <= Z)
1888 local_map = get_local_map (XINT (pos),
1889 current_buffer, Qlocal_map);
1891 keymap = get_local_map (XINT (pos),
1892 current_buffer, Qkeymap);
1896 /* If on a mode line string with a local keymap,
1897 or for a click on a string, i.e. overlay string or a
1898 string displayed via the `display' property,
1899 consider `local-map' and `keymap' properties of
1900 that string. */
1902 if (string = POSN_STRING (position),
1903 (CONSP (string) && STRINGP (XCAR (string))))
1905 Lisp_Object pos, map;
1907 pos = XCDR (string);
1908 string = XCAR (string);
1909 if (INTEGERP (pos)
1910 && XINT (pos) >= 0
1911 && XINT (pos) < SCHARS (string))
1913 map = Fget_text_property (pos, Qlocal_map, string);
1914 if (!NILP (map))
1915 local_map = map;
1917 map = Fget_text_property (pos, Qkeymap, string);
1918 if (!NILP (map))
1919 keymap = map;
1925 if (! NILP (keymap))
1927 value = Flookup_key (keymap, key, accept_default);
1928 if (! NILP (value) && !INTEGERP (value))
1929 goto done;
1932 nmaps = current_minor_maps (0, &maps);
1933 /* Note that all these maps are GCPRO'd
1934 in the places where we found them. */
1936 for (i = 0; i < nmaps; i++)
1937 if (! NILP (maps[i]))
1939 value = Flookup_key (maps[i], key, accept_default);
1940 if (! NILP (value) && !INTEGERP (value))
1941 goto done;
1944 if (! NILP (local_map))
1946 value = Flookup_key (local_map, key, accept_default);
1947 if (! NILP (value) && !INTEGERP (value))
1948 goto done;
1952 value = Flookup_key (current_global_map, key, accept_default);
1954 done:
1955 unbind_to (count, Qnil);
1957 UNGCPRO;
1958 if (NILP (value) || INTEGERP (value))
1959 return Qnil;
1961 /* If the result of the ordinary keymap lookup is an interactive
1962 command, look for a key binding (ie. remapping) for that command. */
1964 if (NILP (no_remap) && SYMBOLP (value))
1966 Lisp_Object value1;
1967 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1968 value = value1;
1971 return value;
1974 /* GC is possible in this function if it autoloads a keymap. */
1976 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1977 doc: /* Return the binding for command KEYS in current local keymap only.
1978 KEYS is a string or vector, a sequence of keystrokes.
1979 The binding is probably a symbol with a function definition.
1981 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1982 bindings; see the description of `lookup-key' for more details about this. */)
1983 (keys, accept_default)
1984 Lisp_Object keys, accept_default;
1986 register Lisp_Object map;
1987 map = current_buffer->keymap;
1988 if (NILP (map))
1989 return Qnil;
1990 return Flookup_key (map, keys, accept_default);
1993 /* GC is possible in this function if it autoloads a keymap. */
1995 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1996 doc: /* Return the binding for command KEYS in current global keymap only.
1997 KEYS is a string or vector, a sequence of keystrokes.
1998 The binding is probably a symbol with a function definition.
1999 This function's return values are the same as those of `lookup-key'
2000 \(which see).
2002 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
2003 bindings; see the description of `lookup-key' for more details about this. */)
2004 (keys, accept_default)
2005 Lisp_Object keys, accept_default;
2007 return Flookup_key (current_global_map, keys, accept_default);
2010 /* GC is possible in this function if it autoloads a keymap. */
2012 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
2013 doc: /* Find the visible minor mode bindings of KEY.
2014 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
2015 the symbol which names the minor mode binding KEY, and BINDING is
2016 KEY's definition in that mode. In particular, if KEY has no
2017 minor-mode bindings, return nil. If the first binding is a
2018 non-prefix, all subsequent bindings will be omitted, since they would
2019 be ignored. Similarly, the list doesn't include non-prefix bindings
2020 that come after prefix bindings.
2022 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
2023 bindings; see the description of `lookup-key' for more details about this. */)
2024 (key, accept_default)
2025 Lisp_Object key, accept_default;
2027 Lisp_Object *modes, *maps;
2028 int nmaps;
2029 Lisp_Object binding;
2030 int i, j;
2031 struct gcpro gcpro1, gcpro2;
2033 nmaps = current_minor_maps (&modes, &maps);
2034 /* Note that all these maps are GCPRO'd
2035 in the places where we found them. */
2037 binding = Qnil;
2038 GCPRO2 (key, binding);
2040 for (i = j = 0; i < nmaps; i++)
2041 if (!NILP (maps[i])
2042 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
2043 && !INTEGERP (binding))
2045 if (KEYMAPP (binding))
2046 maps[j++] = Fcons (modes[i], binding);
2047 else if (j == 0)
2048 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
2051 UNGCPRO;
2052 return Flist (j, maps);
2055 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
2056 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
2057 A new sparse keymap is stored as COMMAND's function definition and its value.
2058 If a second optional argument MAPVAR is given, the map is stored as
2059 its value instead of as COMMAND's value; but COMMAND is still defined
2060 as a function.
2061 The third optional argument NAME, if given, supplies a menu name
2062 string for the map. This is required to use the keymap as a menu.
2063 This function returns COMMAND. */)
2064 (command, mapvar, name)
2065 Lisp_Object command, mapvar, name;
2067 Lisp_Object map;
2068 map = Fmake_sparse_keymap (name);
2069 Ffset (command, map);
2070 if (!NILP (mapvar))
2071 Fset (mapvar, map);
2072 else
2073 Fset (command, map);
2074 return command;
2077 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
2078 doc: /* Select KEYMAP as the global keymap. */)
2079 (keymap)
2080 Lisp_Object keymap;
2082 keymap = get_keymap (keymap, 1, 1);
2083 current_global_map = keymap;
2085 return Qnil;
2088 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
2089 doc: /* Select KEYMAP as the local keymap.
2090 If KEYMAP is nil, that means no local keymap. */)
2091 (keymap)
2092 Lisp_Object keymap;
2094 if (!NILP (keymap))
2095 keymap = get_keymap (keymap, 1, 1);
2097 current_buffer->keymap = keymap;
2099 return Qnil;
2102 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
2103 doc: /* Return current buffer's local keymap, or nil if it has none.
2104 Normally the local keymap is set by the major mode with `use-local-map'. */)
2107 return current_buffer->keymap;
2110 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2111 doc: /* Return the current global keymap. */)
2114 return current_global_map;
2117 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2118 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2121 Lisp_Object *maps;
2122 int nmaps = current_minor_maps (0, &maps);
2124 return Flist (nmaps, maps);
2127 /* Help functions for describing and documenting keymaps. */
2129 struct accessible_keymaps_data {
2130 Lisp_Object maps, tail, thisseq;
2131 /* Does the current sequence end in the meta-prefix-char? */
2132 int is_metized;
2135 static void
2136 accessible_keymaps_1 (key, cmd, args, data)
2137 Lisp_Object key, cmd, args;
2138 /* Use void* to be compatible with map_keymap_function_t. */
2139 void *data;
2141 struct accessible_keymaps_data *d = data; /* Cast! */
2142 Lisp_Object maps = d->maps;
2143 Lisp_Object tail = d->tail;
2144 Lisp_Object thisseq = d->thisseq;
2145 int is_metized = d->is_metized && INTEGERP (key);
2146 Lisp_Object tem;
2148 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2149 if (NILP (cmd))
2150 return;
2152 /* Look for and break cycles. */
2153 while (!NILP (tem = Frassq (cmd, maps)))
2155 Lisp_Object prefix = XCAR (tem);
2156 int lim = XINT (Flength (XCAR (tem)));
2157 if (lim <= XINT (Flength (thisseq)))
2158 { /* This keymap was already seen with a smaller prefix. */
2159 int i = 0;
2160 while (i < lim && EQ (Faref (prefix, make_number (i)),
2161 Faref (thisseq, make_number (i))))
2162 i++;
2163 if (i >= lim)
2164 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2165 return;
2167 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2168 but maybe `cmd' occurs again further down in `maps', so keep
2169 looking. */
2170 maps = XCDR (Fmemq (tem, maps));
2173 /* If the last key in thisseq is meta-prefix-char,
2174 turn it into a meta-ized keystroke. We know
2175 that the event we're about to append is an
2176 ascii keystroke since we're processing a
2177 keymap table. */
2178 if (is_metized)
2180 int meta_bit = meta_modifier;
2181 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2182 tem = Fcopy_sequence (thisseq);
2184 Faset (tem, last, make_number (XINT (key) | meta_bit));
2186 /* This new sequence is the same length as
2187 thisseq, so stick it in the list right
2188 after this one. */
2189 XSETCDR (tail,
2190 Fcons (Fcons (tem, cmd), XCDR (tail)));
2192 else
2194 tem = append_key (thisseq, key);
2195 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2199 /* This function cannot GC. */
2201 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2202 1, 2, 0,
2203 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2204 Returns a list of elements of the form (KEYS . MAP), where the sequence
2205 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2206 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2207 An optional argument PREFIX, if non-nil, should be a key sequence;
2208 then the value includes only maps for prefixes that start with PREFIX. */)
2209 (keymap, prefix)
2210 Lisp_Object keymap, prefix;
2212 Lisp_Object maps, tail;
2213 int prefixlen = XINT (Flength (prefix));
2215 /* no need for gcpro because we don't autoload any keymaps. */
2217 if (!NILP (prefix))
2219 /* If a prefix was specified, start with the keymap (if any) for
2220 that prefix, so we don't waste time considering other prefixes. */
2221 Lisp_Object tem;
2222 tem = Flookup_key (keymap, prefix, Qt);
2223 /* Flookup_key may give us nil, or a number,
2224 if the prefix is not defined in this particular map.
2225 It might even give us a list that isn't a keymap. */
2226 tem = get_keymap (tem, 0, 0);
2227 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2228 want to return it. */
2229 if (!NILP (tem))
2231 /* Convert PREFIX to a vector now, so that later on
2232 we don't have to deal with the possibility of a string. */
2233 if (STRINGP (prefix))
2235 int i, i_byte, c;
2236 Lisp_Object copy;
2238 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2239 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2241 int i_before = i;
2243 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2244 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2245 c ^= 0200 | meta_modifier;
2246 ASET (copy, i_before, make_number (c));
2248 prefix = copy;
2250 maps = Fcons (Fcons (prefix, tem), Qnil);
2252 else
2253 return Qnil;
2255 else
2256 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2257 get_keymap (keymap, 1, 0)),
2258 Qnil);
2260 /* For each map in the list maps,
2261 look at any other maps it points to,
2262 and stick them at the end if they are not already in the list.
2264 This is a breadth-first traversal, where tail is the queue of
2265 nodes, and maps accumulates a list of all nodes visited. */
2267 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2269 struct accessible_keymaps_data data;
2270 register Lisp_Object thismap = Fcdr (XCAR (tail));
2271 Lisp_Object last;
2273 data.thisseq = Fcar (XCAR (tail));
2274 data.maps = maps;
2275 data.tail = tail;
2276 last = make_number (XINT (Flength (data.thisseq)) - 1);
2277 /* Does the current sequence end in the meta-prefix-char? */
2278 data.is_metized = (XINT (last) >= 0
2279 /* Don't metize the last char of PREFIX. */
2280 && XINT (last) >= prefixlen
2281 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2283 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2284 if (CONSP (thismap))
2285 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2287 return maps;
2289 Lisp_Object Qsingle_key_description, Qkey_description;
2291 /* This function cannot GC. */
2293 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2294 doc: /* Return a pretty description of key-sequence KEYS.
2295 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2296 Control characters turn into "C-foo" sequences, meta into "M-foo",
2297 spaces are put between sequence elements, etc. */)
2298 (keys, prefix)
2299 Lisp_Object keys, prefix;
2301 int len = 0;
2302 int i, i_byte;
2303 Lisp_Object *args;
2304 int size = XINT (Flength (keys));
2305 Lisp_Object list;
2306 Lisp_Object sep = build_string (" ");
2307 Lisp_Object key;
2308 int add_meta = 0;
2310 if (!NILP (prefix))
2311 size += XINT (Flength (prefix));
2313 /* This has one extra element at the end that we don't pass to Fconcat. */
2314 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2316 /* In effect, this computes
2317 (mapconcat 'single-key-description keys " ")
2318 but we shouldn't use mapconcat because it can do GC. */
2320 next_list:
2321 if (!NILP (prefix))
2322 list = prefix, prefix = Qnil;
2323 else if (!NILP (keys))
2324 list = keys, keys = Qnil;
2325 else
2327 if (add_meta)
2329 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2330 len += 2;
2332 else if (len == 0)
2333 return empty_unibyte_string;
2334 return Fconcat (len - 1, args);
2337 if (STRINGP (list))
2338 size = SCHARS (list);
2339 else if (VECTORP (list))
2340 size = XVECTOR (list)->size;
2341 else if (CONSP (list))
2342 size = XINT (Flength (list));
2343 else
2344 wrong_type_argument (Qarrayp, list);
2346 i = i_byte = 0;
2348 while (i < size)
2350 if (STRINGP (list))
2352 int c;
2353 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2354 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2355 c ^= 0200 | meta_modifier;
2356 XSETFASTINT (key, c);
2358 else if (VECTORP (list))
2360 key = AREF (list, i); i++;
2362 else
2364 key = XCAR (list);
2365 list = XCDR (list);
2366 i++;
2369 if (add_meta)
2371 if (!INTEGERP (key)
2372 || EQ (key, meta_prefix_char)
2373 || (XINT (key) & meta_modifier))
2375 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2376 args[len++] = sep;
2377 if (EQ (key, meta_prefix_char))
2378 continue;
2380 else
2381 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2382 add_meta = 0;
2384 else if (EQ (key, meta_prefix_char))
2386 add_meta = 1;
2387 continue;
2389 args[len++] = Fsingle_key_description (key, Qnil);
2390 args[len++] = sep;
2392 goto next_list;
2396 char *
2397 push_key_description (c, p, force_multibyte)
2398 register unsigned int c;
2399 register char *p;
2400 int force_multibyte;
2402 unsigned c2;
2404 /* Clear all the meaningless bits above the meta bit. */
2405 c &= meta_modifier | ~ - meta_modifier;
2406 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2407 | meta_modifier | shift_modifier | super_modifier);
2409 if (! CHARACTERP (make_number (c2)))
2411 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2412 p += sprintf (p, "[%d]", c);
2413 return p;
2416 if (c & alt_modifier)
2418 *p++ = 'A';
2419 *p++ = '-';
2420 c -= alt_modifier;
2422 if ((c & ctrl_modifier) != 0
2423 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2425 *p++ = 'C';
2426 *p++ = '-';
2427 c &= ~ctrl_modifier;
2429 if (c & hyper_modifier)
2431 *p++ = 'H';
2432 *p++ = '-';
2433 c -= hyper_modifier;
2435 if (c & meta_modifier)
2437 *p++ = 'M';
2438 *p++ = '-';
2439 c -= meta_modifier;
2441 if (c & shift_modifier)
2443 *p++ = 'S';
2444 *p++ = '-';
2445 c -= shift_modifier;
2447 if (c & super_modifier)
2449 *p++ = 's';
2450 *p++ = '-';
2451 c -= super_modifier;
2453 if (c < 040)
2455 if (c == 033)
2457 *p++ = 'E';
2458 *p++ = 'S';
2459 *p++ = 'C';
2461 else if (c == '\t')
2463 *p++ = 'T';
2464 *p++ = 'A';
2465 *p++ = 'B';
2467 else if (c == Ctl ('M'))
2469 *p++ = 'R';
2470 *p++ = 'E';
2471 *p++ = 'T';
2473 else
2475 /* `C-' already added above. */
2476 if (c > 0 && c <= Ctl ('Z'))
2477 *p++ = c + 0140;
2478 else
2479 *p++ = c + 0100;
2482 else if (c == 0177)
2484 *p++ = 'D';
2485 *p++ = 'E';
2486 *p++ = 'L';
2488 else if (c == ' ')
2490 *p++ = 'S';
2491 *p++ = 'P';
2492 *p++ = 'C';
2494 else if (c < 128
2495 || (NILP (current_buffer->enable_multibyte_characters)
2496 && SINGLE_BYTE_CHAR_P (c)
2497 && !force_multibyte))
2499 *p++ = c;
2501 else
2503 /* Now we are sure that C is a valid character code. */
2504 if (NILP (current_buffer->enable_multibyte_characters)
2505 && ! force_multibyte)
2506 *p++ = multibyte_char_to_unibyte (c, Qnil);
2507 else
2508 p += CHAR_STRING (c, (unsigned char *) p);
2511 return p;
2514 /* This function cannot GC. */
2516 DEFUN ("single-key-description", Fsingle_key_description,
2517 Ssingle_key_description, 1, 2, 0,
2518 doc: /* Return a pretty description of command character KEY.
2519 Control characters turn into C-whatever, etc.
2520 Optional argument NO-ANGLES non-nil means don't put angle brackets
2521 around function keys and event symbols. */)
2522 (key, no_angles)
2523 Lisp_Object key, no_angles;
2525 if (CONSP (key) && lucid_event_type_list_p (key))
2526 key = Fevent_convert_list (key);
2528 key = EVENT_HEAD (key);
2530 if (INTEGERP (key)) /* Normal character */
2532 char tem[KEY_DESCRIPTION_SIZE];
2534 *push_key_description (XUINT (key), tem, 1) = 0;
2535 return build_string (tem);
2537 else if (SYMBOLP (key)) /* Function key or event-symbol */
2539 if (NILP (no_angles))
2541 char *buffer
2542 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2543 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2544 return build_string (buffer);
2546 else
2547 return Fsymbol_name (key);
2549 else if (STRINGP (key)) /* Buffer names in the menubar. */
2550 return Fcopy_sequence (key);
2551 else
2552 error ("KEY must be an integer, cons, symbol, or string");
2553 return Qnil;
2556 char *
2557 push_text_char_description (c, p)
2558 register unsigned int c;
2559 register char *p;
2561 if (c >= 0200)
2563 *p++ = 'M';
2564 *p++ = '-';
2565 c -= 0200;
2567 if (c < 040)
2569 *p++ = '^';
2570 *p++ = c + 64; /* 'A' - 1 */
2572 else if (c == 0177)
2574 *p++ = '^';
2575 *p++ = '?';
2577 else
2578 *p++ = c;
2579 return p;
2582 /* This function cannot GC. */
2584 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2585 doc: /* Return a pretty description of file-character CHARACTER.
2586 Control characters turn into "^char", etc. This differs from
2587 `single-key-description' which turns them into "C-char".
2588 Also, this function recognizes the 2**7 bit as the Meta character,
2589 whereas `single-key-description' uses the 2**27 bit for Meta.
2590 See Info node `(elisp)Describing Characters' for examples. */)
2591 (character)
2592 Lisp_Object character;
2594 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2595 unsigned char str[6];
2596 int c;
2598 CHECK_NUMBER (character);
2600 c = XINT (character);
2601 if (!ASCII_CHAR_P (c))
2603 int len = CHAR_STRING (c, str);
2605 return make_multibyte_string (str, 1, len);
2608 *push_text_char_description (c & 0377, str) = 0;
2610 return build_string (str);
2613 static int where_is_preferred_modifier;
2615 /* Return 0 if SEQ uses non-preferred modifiers or non-char events.
2616 Else, return 2 if SEQ uses the where_is_preferred_modifier,
2617 and 1 otherwise. */
2618 static int
2619 preferred_sequence_p (seq)
2620 Lisp_Object seq;
2622 int i;
2623 int len = XINT (Flength (seq));
2624 int result = 1;
2626 for (i = 0; i < len; i++)
2628 Lisp_Object ii, elt;
2630 XSETFASTINT (ii, i);
2631 elt = Faref (seq, ii);
2633 if (!INTEGERP (elt))
2634 return 0;
2635 else
2637 int modifiers = XUINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
2638 if (modifiers == where_is_preferred_modifier)
2639 result = 2;
2640 else if (modifiers)
2641 return 0;
2645 return result;
2649 /* where-is - finding a command in a set of keymaps. */
2651 static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
2652 Lisp_Object args, void *data));
2654 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2655 Returns the first non-nil binding found in any of those maps.
2656 If REMAP is true, pass the result of the lookup through command
2657 remapping before returning it. */
2659 static Lisp_Object
2660 shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag,
2661 int remap)
2663 Lisp_Object tail, value;
2665 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2667 value = Flookup_key (XCAR (tail), key, flag);
2668 if (NATNUMP (value))
2670 value = Flookup_key (XCAR (tail),
2671 Fsubstring (key, make_number (0), value), flag);
2672 if (!NILP (value))
2673 return Qnil;
2675 else if (!NILP (value))
2677 Lisp_Object remapping;
2678 if (remap && SYMBOLP (value)
2679 && (remapping = Fcommand_remapping (value, Qnil, shadow),
2680 !NILP (remapping)))
2681 return remapping;
2682 else
2683 return value;
2686 return Qnil;
2689 static Lisp_Object Vmouse_events;
2691 struct where_is_internal_data {
2692 Lisp_Object definition, this, last;
2693 int last_is_meta, noindirect;
2694 Lisp_Object sequences;
2697 /* This function can't GC, AFAIK. */
2698 /* Return the list of bindings found. This list is ordered "longest
2699 to shortest". It may include bindings that are actually shadowed
2700 by others, as well as duplicate bindings and remapping bindings.
2701 The list returned is potentially shared with where_is_cache, so
2702 be careful not to modify it via side-effects. */
2704 static Lisp_Object
2705 where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
2706 int noindirect, int nomenus)
2708 Lisp_Object maps = Qnil;
2709 Lisp_Object found;
2710 struct where_is_internal_data data;
2712 /* Only important use of caching is for the menubar
2713 (i.e. where-is-internal called with (def nil t nil nil)). */
2714 if (nomenus && !noindirect)
2716 /* Check heuristic-consistency of the cache. */
2717 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2718 where_is_cache = Qnil;
2720 if (NILP (where_is_cache))
2722 /* We need to create the cache. */
2723 Lisp_Object args[2];
2724 where_is_cache = Fmake_hash_table (0, args);
2725 where_is_cache_keymaps = Qt;
2727 else
2728 /* We can reuse the cache. */
2729 return Fgethash (definition, where_is_cache, Qnil);
2731 else
2732 /* Kill the cache so that where_is_internal_1 doesn't think
2733 we're filling it up. */
2734 where_is_cache = Qnil;
2736 found = keymaps;
2737 while (CONSP (found))
2739 maps =
2740 nconc2 (maps,
2741 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2742 found = XCDR (found);
2745 data.sequences = Qnil;
2746 for (; CONSP (maps); maps = XCDR (maps))
2748 /* Key sequence to reach map, and the map that it reaches */
2749 register Lisp_Object this, map, tem;
2751 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2752 [M-CHAR] sequences, check if last character of the sequence
2753 is the meta-prefix char. */
2754 Lisp_Object last;
2755 int last_is_meta;
2757 this = Fcar (XCAR (maps));
2758 map = Fcdr (XCAR (maps));
2759 last = make_number (XINT (Flength (this)) - 1);
2760 last_is_meta = (XINT (last) >= 0
2761 && EQ (Faref (this, last), meta_prefix_char));
2763 /* if (nomenus && !preferred_sequence_p (this)) */
2764 if (nomenus && XINT (last) >= 0
2765 && SYMBOLP (tem = Faref (this, make_number (0)))
2766 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2767 /* If no menu entries should be returned, skip over the
2768 keymaps bound to `menu-bar' and `tool-bar' and other
2769 non-ascii prefixes like `C-down-mouse-2'. */
2770 continue;
2772 QUIT;
2774 data.definition = definition;
2775 data.noindirect = noindirect;
2776 data.this = this;
2777 data.last = last;
2778 data.last_is_meta = last_is_meta;
2780 if (CONSP (map))
2781 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2784 if (nomenus && !noindirect)
2785 { /* Remember for which keymaps this cache was built.
2786 We do it here (late) because we want to keep where_is_cache_keymaps
2787 set to t while the cache isn't fully filled. */
2788 where_is_cache_keymaps = keymaps;
2789 /* During cache-filling, data.sequences is not filled by
2790 where_is_internal_1. */
2791 return Fgethash (definition, where_is_cache, Qnil);
2793 else
2794 return data.sequences;
2797 static Lisp_Object Vwhere_is_preferred_modifier;
2799 /* This function can GC if Flookup_key autoloads any keymaps. */
2801 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2802 doc: /* Return list of keys that invoke DEFINITION.
2803 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2804 If KEYMAP is nil, search all the currently active keymaps.
2805 If KEYMAP is a list of keymaps, search only those keymaps.
2807 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2808 rather than a list of all possible key sequences.
2809 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2810 no matter what it is.
2811 If FIRSTONLY has another non-nil value, prefer bindings
2812 that use the modifier key specified in `where-is-preferred-modifier'
2813 \(or their meta variants) and entirely reject menu bindings.
2815 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2816 to other keymaps or slots. This makes it possible to search for an
2817 indirect definition itself.
2819 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2820 that invoke a command which is remapped to DEFINITION, but include the
2821 remapped command in the returned list. */)
2822 (definition, keymap, firstonly, noindirect, no_remap)
2823 Lisp_Object definition, keymap;
2824 Lisp_Object firstonly, noindirect, no_remap;
2826 /* The keymaps in which to search. */
2827 Lisp_Object keymaps;
2828 /* Potentially relevant bindings in "shortest to longest" order. */
2829 Lisp_Object sequences = Qnil;
2830 /* Actually relevant bindings. */
2831 Lisp_Object found = Qnil;
2832 /* 1 means ignore all menu bindings entirely. */
2833 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2834 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
2835 /* List of sequences found via remapping. Keep them in a separate
2836 variable, so as to push them later, since we prefer
2837 non-remapped binding. */
2838 Lisp_Object remapped_sequences = Qnil;
2839 /* Whether or not we're handling remapped sequences. This is needed
2840 because remapping is not done recursively by Fcommand_remapping: you
2841 can't remap a remapped command. */
2842 int remapped = 0;
2843 Lisp_Object tem = Qnil;
2845 /* Refresh the C version of the modifier preference. */
2846 where_is_preferred_modifier
2847 = parse_solitary_modifier (Vwhere_is_preferred_modifier);
2849 /* Find the relevant keymaps. */
2850 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2851 keymaps = keymap;
2852 else if (!NILP (keymap))
2853 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2854 else
2855 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2857 GCPRO6 (definition, keymaps, found, sequences, remapped_sequences, tem);
2859 tem = Fcommand_remapping (definition, Qnil, keymaps);
2860 /* If `definition' is remapped to tem', then OT1H no key will run
2861 that command (since they will run `tem' instead), so we should
2862 return nil; but OTOH all keys bound to `definition' (or to `tem')
2863 will run the same command.
2864 So for menu-shortcut purposes, we want to find all the keys bound (maybe
2865 via remapping) to `tem'. But for the purpose of finding the keys that
2866 run `definition', then we'd want to just return nil.
2867 We choose to make it work right for menu-shortcuts, since it's the most
2868 common use.
2869 Known bugs: if you remap switch-to-buffer to toto, C-h f switch-to-buffer
2870 will tell you that switch-to-buffer is bound to C-x b even though C-x b
2871 will run toto instead. And if `toto' is itself remapped to forward-char,
2872 then C-h f toto will tell you that it's bound to C-f even though C-f does
2873 not run toto and it won't tell you that C-x b does run toto. */
2874 if (NILP (no_remap) && !NILP (tem))
2875 definition = tem;
2877 if (SYMBOLP (definition)
2878 && !NILP (firstonly)
2879 && !NILP (tem = Fget (definition, QCadvertised_binding)))
2881 /* We have a list of advertized bindings. */
2882 while (CONSP (tem))
2883 if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
2884 return XCAR (tem);
2885 else
2886 tem = XCDR (tem);
2887 if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition))
2888 return tem;
2891 sequences = Freverse (where_is_internal (definition, keymaps,
2892 !NILP (noindirect), nomenus));
2894 while (CONSP (sequences)
2895 /* If we're at the end of the `sequences' list and we haven't
2896 considered remapped sequences yet, copy them over and
2897 process them. */
2898 || (!remapped && (sequences = remapped_sequences,
2899 remapped = 1),
2900 CONSP (sequences)))
2902 Lisp_Object sequence, function;
2904 sequence = XCAR (sequences);
2905 sequences = XCDR (sequences);
2907 /* Verify that this key binding is not shadowed by another
2908 binding for the same key, before we say it exists.
2910 Mechanism: look for local definition of this key and if
2911 it is defined and does not match what we found then
2912 ignore this key.
2914 Either nil or number as value from Flookup_key
2915 means undefined. */
2916 if (NILP (Fequal (shadow_lookup (keymaps, sequence, Qnil, remapped),
2917 definition)))
2918 continue;
2920 /* If the current sequence is a command remapping with
2921 format [remap COMMAND], find the key sequences
2922 which run COMMAND, and use those sequences instead. */
2923 if (NILP (no_remap) && !remapped
2924 && VECTORP (sequence) && ASIZE (sequence) == 2
2925 && EQ (AREF (sequence, 0), Qremap)
2926 && (function = AREF (sequence, 1), SYMBOLP (function)))
2928 Lisp_Object seqs = where_is_internal (function, keymaps,
2929 !NILP (noindirect), nomenus);
2930 remapped_sequences = nconc2 (Freverse (seqs), remapped_sequences);
2931 continue;
2934 /* Don't annoy user with strings from a menu such as the
2935 entries from the "Edit => Paste from Kill Menu".
2936 Change them all to "(any string)", so that there
2937 seems to be only one menu item to report. */
2938 if (! NILP (sequence))
2940 Lisp_Object tem;
2941 tem = Faref (sequence, make_number (ASIZE (sequence) - 1));
2942 if (STRINGP (tem))
2943 Faset (sequence, make_number (ASIZE (sequence) - 1),
2944 build_string ("(any string)"));
2947 /* It is a true unshadowed match. Record it, unless it's already
2948 been seen (as could happen when inheriting keymaps). */
2949 if (NILP (Fmember (sequence, found)))
2950 found = Fcons (sequence, found);
2952 /* If firstonly is Qnon_ascii, then we can return the first
2953 binding we find. If firstonly is not Qnon_ascii but not
2954 nil, then we should return the first ascii-only binding
2955 we find. */
2956 if (EQ (firstonly, Qnon_ascii))
2957 RETURN_UNGCPRO (sequence);
2958 else if (!NILP (firstonly)
2959 && 2 == preferred_sequence_p (sequence))
2960 RETURN_UNGCPRO (sequence);
2963 UNGCPRO;
2965 found = Fnreverse (found);
2967 /* firstonly may have been t, but we may have gone all the way through
2968 the keymaps without finding an all-ASCII key sequence. So just
2969 return the best we could find. */
2970 if (NILP (firstonly))
2971 return found;
2972 else if (where_is_preferred_modifier == 0)
2973 return Fcar (found);
2974 else
2975 { /* Maybe we did not find a preferred_modifier binding, but we did find
2976 some ASCII binding. */
2977 Lisp_Object bindings = found;
2978 while (CONSP (bindings))
2979 if (preferred_sequence_p (XCAR (bindings)))
2980 return XCAR (bindings);
2981 else
2982 bindings = XCDR (bindings);
2983 return Fcar (found);
2987 /* This function can GC because get_keyelt can. */
2989 static void
2990 where_is_internal_1 (key, binding, args, data)
2991 Lisp_Object key, binding, args;
2992 void *data;
2994 struct where_is_internal_data *d = data; /* Cast! */
2995 Lisp_Object definition = d->definition;
2996 int noindirect = d->noindirect;
2997 Lisp_Object this = d->this;
2998 Lisp_Object last = d->last;
2999 int last_is_meta = d->last_is_meta;
3000 Lisp_Object sequence;
3002 /* Search through indirections unless that's not wanted. */
3003 if (!noindirect)
3004 binding = get_keyelt (binding, 0);
3006 /* End this iteration if this element does not match
3007 the target. */
3009 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
3010 || EQ (binding, definition)
3011 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
3012 /* Doesn't match. */
3013 return;
3015 /* We have found a match. Construct the key sequence where we found it. */
3016 if (INTEGERP (key) && last_is_meta)
3018 sequence = Fcopy_sequence (this);
3019 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
3021 else
3023 if (CONSP (key))
3024 key = Fcons (XCAR (key), XCDR (key));
3025 sequence = append_key (this, key);
3028 if (!NILP (where_is_cache))
3030 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
3031 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
3033 else
3034 d->sequences = Fcons (sequence, d->sequences);
3037 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
3039 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
3040 doc: /* Insert the list of all defined keys and their definitions.
3041 The list is inserted in the current buffer, while the bindings are
3042 looked up in BUFFER.
3043 The optional argument PREFIX, if non-nil, should be a key sequence;
3044 then we display only bindings that start with that prefix.
3045 The optional argument MENUS, if non-nil, says to mention menu bindings.
3046 \(Ordinarily these are omitted from the output.) */)
3047 (buffer, prefix, menus)
3048 Lisp_Object buffer, prefix, menus;
3050 Lisp_Object outbuf, shadow;
3051 int nomenu = NILP (menus);
3052 register Lisp_Object start1;
3053 struct gcpro gcpro1;
3055 char *alternate_heading
3056 = "\
3057 Keyboard translations:\n\n\
3058 You type Translation\n\
3059 -------- -----------\n";
3061 CHECK_BUFFER (buffer);
3063 shadow = Qnil;
3064 GCPRO1 (shadow);
3066 outbuf = Fcurrent_buffer ();
3068 /* Report on alternates for keys. */
3069 if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix))
3071 int c;
3072 const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table);
3073 int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table);
3075 for (c = 0; c < translate_len; c++)
3076 if (translate[c] != c)
3078 char buf[KEY_DESCRIPTION_SIZE];
3079 char *bufend;
3081 if (alternate_heading)
3083 insert_string (alternate_heading);
3084 alternate_heading = 0;
3087 bufend = push_key_description (translate[c], buf, 1);
3088 insert (buf, bufend - buf);
3089 Findent_to (make_number (16), make_number (1));
3090 bufend = push_key_description (c, buf, 1);
3091 insert (buf, bufend - buf);
3093 insert ("\n", 1);
3095 /* Insert calls signal_after_change which may GC. */
3096 translate = SDATA (current_kboard->Vkeyboard_translate_table);
3099 insert ("\n", 1);
3102 if (!NILP (Vkey_translation_map))
3103 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3104 "Key translations", nomenu, 1, 0, 0);
3107 /* Print the (major mode) local map. */
3108 start1 = Qnil;
3109 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3110 start1 = current_kboard->Voverriding_terminal_local_map;
3111 else if (!NILP (Voverriding_local_map))
3112 start1 = Voverriding_local_map;
3114 if (!NILP (start1))
3116 describe_map_tree (start1, 1, shadow, prefix,
3117 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3118 shadow = Fcons (start1, shadow);
3120 else
3122 /* Print the minor mode and major mode keymaps. */
3123 int i, nmaps;
3124 Lisp_Object *modes, *maps;
3126 /* Temporarily switch to `buffer', so that we can get that buffer's
3127 minor modes correctly. */
3128 Fset_buffer (buffer);
3130 nmaps = current_minor_maps (&modes, &maps);
3131 Fset_buffer (outbuf);
3133 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3134 XBUFFER (buffer), Qkeymap);
3135 if (!NILP (start1))
3137 describe_map_tree (start1, 1, shadow, prefix,
3138 "\f\n`keymap' Property Bindings", nomenu,
3139 0, 0, 0);
3140 shadow = Fcons (start1, shadow);
3143 /* Print the minor mode maps. */
3144 for (i = 0; i < nmaps; i++)
3146 /* The title for a minor mode keymap
3147 is constructed at run time.
3148 We let describe_map_tree do the actual insertion
3149 because it takes care of other features when doing so. */
3150 char *title, *p;
3152 if (!SYMBOLP (modes[i]))
3153 abort ();
3155 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3156 *p++ = '\f';
3157 *p++ = '\n';
3158 *p++ = '`';
3159 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3160 SCHARS (SYMBOL_NAME (modes[i])));
3161 p += SCHARS (SYMBOL_NAME (modes[i]));
3162 *p++ = '\'';
3163 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3164 p += sizeof (" Minor Mode Bindings") - 1;
3165 *p = 0;
3167 describe_map_tree (maps[i], 1, shadow, prefix,
3168 title, nomenu, 0, 0, 0);
3169 shadow = Fcons (maps[i], shadow);
3172 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3173 XBUFFER (buffer), Qlocal_map);
3174 if (!NILP (start1))
3176 if (EQ (start1, XBUFFER (buffer)->keymap))
3177 describe_map_tree (start1, 1, shadow, prefix,
3178 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3179 else
3180 describe_map_tree (start1, 1, shadow, prefix,
3181 "\f\n`local-map' Property Bindings",
3182 nomenu, 0, 0, 0);
3184 shadow = Fcons (start1, shadow);
3188 describe_map_tree (current_global_map, 1, shadow, prefix,
3189 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3191 /* Print the function-key-map translations under this prefix. */
3192 if (!NILP (current_kboard->Vlocal_function_key_map))
3193 describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix,
3194 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3196 /* Print the input-decode-map translations under this prefix. */
3197 if (!NILP (current_kboard->Vinput_decode_map))
3198 describe_map_tree (current_kboard->Vinput_decode_map, 0, Qnil, prefix,
3199 "\f\nInput decoding map translations", nomenu, 1, 0, 0);
3201 UNGCPRO;
3202 return Qnil;
3205 /* Insert a description of the key bindings in STARTMAP,
3206 followed by those of all maps reachable through STARTMAP.
3207 If PARTIAL is nonzero, omit certain "uninteresting" commands
3208 (such as `undefined').
3209 If SHADOW is non-nil, it is a list of maps;
3210 don't mention keys which would be shadowed by any of them.
3211 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3212 TITLE, if not 0, is a string to insert at the beginning.
3213 TITLE should not end with a colon or a newline; we supply that.
3214 If NOMENU is not 0, then omit menu-bar commands.
3216 If TRANSL is nonzero, the definitions are actually key translations
3217 so print strings and vectors differently.
3219 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3220 to look through.
3222 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3223 don't omit it; instead, mention it but say it is shadowed. */
3225 void
3226 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3227 always_title, mention_shadow)
3228 Lisp_Object startmap, shadow, prefix;
3229 int partial;
3230 char *title;
3231 int nomenu;
3232 int transl;
3233 int always_title;
3234 int mention_shadow;
3236 Lisp_Object maps, orig_maps, seen, sub_shadows;
3237 struct gcpro gcpro1, gcpro2, gcpro3;
3238 int something = 0;
3239 char *key_heading
3240 = "\
3241 key binding\n\
3242 --- -------\n";
3244 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3245 seen = Qnil;
3246 sub_shadows = Qnil;
3247 GCPRO3 (maps, seen, sub_shadows);
3249 if (nomenu)
3251 Lisp_Object list;
3253 /* Delete from MAPS each element that is for the menu bar. */
3254 for (list = maps; CONSP (list); list = XCDR (list))
3256 Lisp_Object elt, prefix, tem;
3258 elt = XCAR (list);
3259 prefix = Fcar (elt);
3260 if (XVECTOR (prefix)->size >= 1)
3262 tem = Faref (prefix, make_number (0));
3263 if (EQ (tem, Qmenu_bar))
3264 maps = Fdelq (elt, maps);
3269 if (!NILP (maps) || always_title)
3271 if (title)
3273 insert_string (title);
3274 if (!NILP (prefix))
3276 insert_string (" Starting With ");
3277 insert1 (Fkey_description (prefix, Qnil));
3279 insert_string (":\n");
3281 insert_string (key_heading);
3282 something = 1;
3285 for (; CONSP (maps); maps = XCDR (maps))
3287 register Lisp_Object elt, prefix, tail;
3289 elt = XCAR (maps);
3290 prefix = Fcar (elt);
3292 sub_shadows = Qnil;
3294 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3296 Lisp_Object shmap;
3298 shmap = XCAR (tail);
3300 /* If the sequence by which we reach this keymap is zero-length,
3301 then the shadow map for this keymap is just SHADOW. */
3302 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3303 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3305 /* If the sequence by which we reach this keymap actually has
3306 some elements, then the sequence's definition in SHADOW is
3307 what we should use. */
3308 else
3310 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3311 if (INTEGERP (shmap))
3312 shmap = Qnil;
3315 /* If shmap is not nil and not a keymap,
3316 it completely shadows this map, so don't
3317 describe this map at all. */
3318 if (!NILP (shmap) && !KEYMAPP (shmap))
3319 goto skip;
3321 if (!NILP (shmap))
3322 sub_shadows = Fcons (shmap, sub_shadows);
3325 /* Maps we have already listed in this loop shadow this map. */
3326 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3328 Lisp_Object tem;
3329 tem = Fequal (Fcar (XCAR (tail)), prefix);
3330 if (!NILP (tem))
3331 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3334 describe_map (Fcdr (elt), prefix,
3335 transl ? describe_translation : describe_command,
3336 partial, sub_shadows, &seen, nomenu, mention_shadow);
3338 skip: ;
3341 if (something)
3342 insert_string ("\n");
3344 UNGCPRO;
3347 static int previous_description_column;
3349 static void
3350 describe_command (definition, args)
3351 Lisp_Object definition, args;
3353 register Lisp_Object tem1;
3354 int column = (int) current_column (); /* iftc */
3355 int description_column;
3357 /* If column 16 is no good, go to col 32;
3358 but don't push beyond that--go to next line instead. */
3359 if (column > 30)
3361 insert_char ('\n');
3362 description_column = 32;
3364 else if (column > 14 || (column > 10 && previous_description_column == 32))
3365 description_column = 32;
3366 else
3367 description_column = 16;
3369 Findent_to (make_number (description_column), make_number (1));
3370 previous_description_column = description_column;
3372 if (SYMBOLP (definition))
3374 tem1 = SYMBOL_NAME (definition);
3375 insert1 (tem1);
3376 insert_string ("\n");
3378 else if (STRINGP (definition) || VECTORP (definition))
3379 insert_string ("Keyboard Macro\n");
3380 else if (KEYMAPP (definition))
3381 insert_string ("Prefix Command\n");
3382 else
3383 insert_string ("??\n");
3386 static void
3387 describe_translation (definition, args)
3388 Lisp_Object definition, args;
3390 register Lisp_Object tem1;
3392 Findent_to (make_number (16), make_number (1));
3394 if (SYMBOLP (definition))
3396 tem1 = SYMBOL_NAME (definition);
3397 insert1 (tem1);
3398 insert_string ("\n");
3400 else if (STRINGP (definition) || VECTORP (definition))
3402 insert1 (Fkey_description (definition, Qnil));
3403 insert_string ("\n");
3405 else if (KEYMAPP (definition))
3406 insert_string ("Prefix Command\n");
3407 else
3408 insert_string ("??\n");
3411 /* describe_map puts all the usable elements of a sparse keymap
3412 into an array of `struct describe_map_elt',
3413 then sorts them by the events. */
3415 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3417 /* qsort comparison function for sorting `struct describe_map_elt' by
3418 the event field. */
3420 static int
3421 describe_map_compare (aa, bb)
3422 const void *aa, *bb;
3424 const struct describe_map_elt *a = aa, *b = bb;
3425 if (INTEGERP (a->event) && INTEGERP (b->event))
3426 return ((XINT (a->event) > XINT (b->event))
3427 - (XINT (a->event) < XINT (b->event)));
3428 if (!INTEGERP (a->event) && INTEGERP (b->event))
3429 return 1;
3430 if (INTEGERP (a->event) && !INTEGERP (b->event))
3431 return -1;
3432 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3433 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3434 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3435 : 0);
3436 return 0;
3439 /* Describe the contents of map MAP, assuming that this map itself is
3440 reached by the sequence of prefix keys PREFIX (a string or vector).
3441 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3443 static void
3444 describe_map (map, prefix, elt_describer, partial, shadow,
3445 seen, nomenu, mention_shadow)
3446 register Lisp_Object map;
3447 Lisp_Object prefix;
3448 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3449 int partial;
3450 Lisp_Object shadow;
3451 Lisp_Object *seen;
3452 int nomenu;
3453 int mention_shadow;
3455 Lisp_Object tail, definition, event;
3456 Lisp_Object tem;
3457 Lisp_Object suppress;
3458 Lisp_Object kludge;
3459 int first = 1;
3460 struct gcpro gcpro1, gcpro2, gcpro3;
3462 /* These accumulate the values from sparse keymap bindings,
3463 so we can sort them and handle them in order. */
3464 int length_needed = 0;
3465 struct describe_map_elt *vect;
3466 int slots_used = 0;
3467 int i;
3469 suppress = Qnil;
3471 if (partial)
3472 suppress = intern ("suppress-keymap");
3474 /* This vector gets used to present single keys to Flookup_key. Since
3475 that is done once per keymap element, we don't want to cons up a
3476 fresh vector every time. */
3477 kludge = Fmake_vector (make_number (1), Qnil);
3478 definition = Qnil;
3480 GCPRO3 (prefix, definition, kludge);
3482 map = call1 (Qkeymap_canonicalize, map);
3484 for (tail = map; CONSP (tail); tail = XCDR (tail))
3485 length_needed++;
3487 vect = ((struct describe_map_elt *)
3488 alloca (sizeof (struct describe_map_elt) * length_needed));
3490 for (tail = map; CONSP (tail); tail = XCDR (tail))
3492 QUIT;
3494 if (VECTORP (XCAR (tail))
3495 || CHAR_TABLE_P (XCAR (tail)))
3496 describe_vector (XCAR (tail),
3497 prefix, Qnil, elt_describer, partial, shadow, map,
3498 (int *)0, 0, 1, mention_shadow);
3499 else if (CONSP (XCAR (tail)))
3501 int this_shadowed = 0;
3503 event = XCAR (XCAR (tail));
3505 /* Ignore bindings whose "prefix" are not really valid events.
3506 (We get these in the frames and buffers menu.) */
3507 if (!(SYMBOLP (event) || INTEGERP (event)))
3508 continue;
3510 if (nomenu && EQ (event, Qmenu_bar))
3511 continue;
3513 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3515 /* Don't show undefined commands or suppressed commands. */
3516 if (NILP (definition)) continue;
3517 if (SYMBOLP (definition) && partial)
3519 tem = Fget (definition, suppress);
3520 if (!NILP (tem))
3521 continue;
3524 /* Don't show a command that isn't really visible
3525 because a local definition of the same key shadows it. */
3527 ASET (kludge, 0, event);
3528 if (!NILP (shadow))
3530 tem = shadow_lookup (shadow, kludge, Qt, 0);
3531 if (!NILP (tem))
3533 /* If both bindings are keymaps, this key is a prefix key,
3534 so don't say it is shadowed. */
3535 if (KEYMAPP (definition) && KEYMAPP (tem))
3537 /* Avoid generating duplicate entries if the
3538 shadowed binding has the same definition. */
3539 else if (mention_shadow && !EQ (tem, definition))
3540 this_shadowed = 1;
3541 else
3542 continue;
3546 tem = Flookup_key (map, kludge, Qt);
3547 if (!EQ (tem, definition)) continue;
3549 vect[slots_used].event = event;
3550 vect[slots_used].definition = definition;
3551 vect[slots_used].shadowed = this_shadowed;
3552 slots_used++;
3554 else if (EQ (XCAR (tail), Qkeymap))
3556 /* The same keymap might be in the structure twice, if we're
3557 using an inherited keymap. So skip anything we've already
3558 encountered. */
3559 tem = Fassq (tail, *seen);
3560 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3561 break;
3562 *seen = Fcons (Fcons (tail, prefix), *seen);
3566 /* If we found some sparse map events, sort them. */
3568 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3569 describe_map_compare);
3571 /* Now output them in sorted order. */
3573 for (i = 0; i < slots_used; i++)
3575 Lisp_Object start, end;
3577 if (first)
3579 previous_description_column = 0;
3580 insert ("\n", 1);
3581 first = 0;
3584 ASET (kludge, 0, vect[i].event);
3585 start = vect[i].event;
3586 end = start;
3588 definition = vect[i].definition;
3590 /* Find consecutive chars that are identically defined. */
3591 if (INTEGERP (vect[i].event))
3593 while (i + 1 < slots_used
3594 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3595 && !NILP (Fequal (vect[i + 1].definition, definition))
3596 && vect[i].shadowed == vect[i + 1].shadowed)
3597 i++;
3598 end = vect[i].event;
3601 /* Now START .. END is the range to describe next. */
3603 /* Insert the string to describe the event START. */
3604 insert1 (Fkey_description (kludge, prefix));
3606 if (!EQ (start, end))
3608 insert (" .. ", 4);
3610 ASET (kludge, 0, end);
3611 /* Insert the string to describe the character END. */
3612 insert1 (Fkey_description (kludge, prefix));
3615 /* Print a description of the definition of this character.
3616 elt_describer will take care of spacing out far enough
3617 for alignment purposes. */
3618 (*elt_describer) (vect[i].definition, Qnil);
3620 if (vect[i].shadowed)
3622 SET_PT (PT - 1);
3623 insert_string ("\n (that binding is currently shadowed by another mode)");
3624 SET_PT (PT + 1);
3628 UNGCPRO;
3631 static void
3632 describe_vector_princ (elt, fun)
3633 Lisp_Object elt, fun;
3635 Findent_to (make_number (16), make_number (1));
3636 call1 (fun, elt);
3637 Fterpri (Qnil);
3640 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3641 doc: /* Insert a description of contents of VECTOR.
3642 This is text showing the elements of vector matched against indices.
3643 DESCRIBER is the output function used; nil means use `princ'. */)
3644 (vector, describer)
3645 Lisp_Object vector, describer;
3647 int count = SPECPDL_INDEX ();
3648 if (NILP (describer))
3649 describer = intern ("princ");
3650 specbind (Qstandard_output, Fcurrent_buffer ());
3651 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3652 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3653 Qnil, Qnil, (int *)0, 0, 0, 0);
3655 return unbind_to (count, Qnil);
3658 /* Insert in the current buffer a description of the contents of VECTOR.
3659 We call ELT_DESCRIBER to insert the description of one value found
3660 in VECTOR.
3662 ELT_PREFIX describes what "comes before" the keys or indices defined
3663 by this vector. This is a human-readable string whose size
3664 is not necessarily related to the situation.
3666 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3667 leads to this keymap.
3669 If the vector is a chartable, ELT_PREFIX is the vector
3670 of bytes that lead to the character set or portion of a character
3671 set described by this chartable.
3673 If PARTIAL is nonzero, it means do not mention suppressed commands
3674 (that assumes the vector is in a keymap).
3676 SHADOW is a list of keymaps that shadow this map.
3677 If it is non-nil, then we look up the key in those maps
3678 and we don't mention it now if it is defined by any of them.
3680 ENTIRE_MAP is the keymap in which this vector appears.
3681 If the definition in effect in the whole map does not match
3682 the one in this vector, we ignore this one.
3684 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3686 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3687 the near future.
3689 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3691 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3693 static void
3694 describe_vector (vector, prefix, args, elt_describer,
3695 partial, shadow, entire_map,
3696 indices, char_table_depth, keymap_p,
3697 mention_shadow)
3698 register Lisp_Object vector;
3699 Lisp_Object prefix, args;
3700 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3701 int partial;
3702 Lisp_Object shadow;
3703 Lisp_Object entire_map;
3704 int *indices;
3705 int char_table_depth;
3706 int keymap_p;
3707 int mention_shadow;
3709 Lisp_Object definition;
3710 Lisp_Object tem2;
3711 Lisp_Object elt_prefix = Qnil;
3712 int i;
3713 Lisp_Object suppress;
3714 Lisp_Object kludge;
3715 int first = 1;
3716 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3717 /* Range of elements to be handled. */
3718 int from, to, stop;
3719 Lisp_Object character;
3720 int starting_i;
3722 suppress = Qnil;
3724 definition = Qnil;
3726 if (!keymap_p)
3728 /* Call Fkey_description first, to avoid GC bug for the other string. */
3729 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3731 Lisp_Object tem;
3732 tem = Fkey_description (prefix, Qnil);
3733 elt_prefix = concat2 (tem, build_string (" "));
3735 prefix = Qnil;
3738 /* This vector gets used to present single keys to Flookup_key. Since
3739 that is done once per vector element, we don't want to cons up a
3740 fresh vector every time. */
3741 kludge = Fmake_vector (make_number (1), Qnil);
3742 GCPRO4 (elt_prefix, prefix, definition, kludge);
3744 if (partial)
3745 suppress = intern ("suppress-keymap");
3747 from = 0;
3748 if (CHAR_TABLE_P (vector))
3749 stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1;
3750 else
3751 stop = to = XVECTOR (vector)->size;
3753 for (i = from; ; i++)
3755 int this_shadowed = 0;
3756 int range_beg, range_end;
3757 Lisp_Object val;
3759 QUIT;
3761 if (i == stop)
3763 if (i == to)
3764 break;
3765 stop = to;
3768 starting_i = i;
3770 if (CHAR_TABLE_P (vector))
3772 range_beg = i;
3773 i = stop - 1;
3774 val = char_table_ref_and_range (vector, range_beg, &range_beg, &i);
3776 else
3777 val = AREF (vector, i);
3778 definition = get_keyelt (val, 0);
3780 if (NILP (definition)) continue;
3782 /* Don't mention suppressed commands. */
3783 if (SYMBOLP (definition) && partial)
3785 Lisp_Object tem;
3787 tem = Fget (definition, suppress);
3789 if (!NILP (tem)) continue;
3792 character = make_number (starting_i);
3793 ASET (kludge, 0, character);
3795 /* If this binding is shadowed by some other map, ignore it. */
3796 if (!NILP (shadow))
3798 Lisp_Object tem;
3800 tem = shadow_lookup (shadow, kludge, Qt, 0);
3802 if (!NILP (tem))
3804 if (mention_shadow)
3805 this_shadowed = 1;
3806 else
3807 continue;
3811 /* Ignore this definition if it is shadowed by an earlier
3812 one in the same keymap. */
3813 if (!NILP (entire_map))
3815 Lisp_Object tem;
3817 tem = Flookup_key (entire_map, kludge, Qt);
3819 if (!EQ (tem, definition))
3820 continue;
3823 if (first)
3825 insert ("\n", 1);
3826 first = 0;
3829 /* Output the prefix that applies to every entry in this map. */
3830 if (!NILP (elt_prefix))
3831 insert1 (elt_prefix);
3833 insert1 (Fkey_description (kludge, prefix));
3835 /* Find all consecutive characters or rows that have the same
3836 definition. But, VECTOR is a char-table, we had better put a
3837 boundary between normal characters (-#x3FFF7F) and 8-bit
3838 characters (#x3FFF80-). */
3839 if (CHAR_TABLE_P (vector))
3841 while (i + 1 < stop
3842 && (range_beg = i + 1, range_end = stop - 1,
3843 val = char_table_ref_and_range (vector, range_beg,
3844 &range_beg, &range_end),
3845 tem2 = get_keyelt (val, 0),
3846 !NILP (tem2))
3847 && !NILP (Fequal (tem2, definition)))
3848 i = range_end;
3850 else
3851 while (i + 1 < stop
3852 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3853 !NILP (tem2))
3854 && !NILP (Fequal (tem2, definition)))
3855 i++;
3857 /* If we have a range of more than one character,
3858 print where the range reaches to. */
3860 if (i != starting_i)
3862 insert (" .. ", 4);
3864 ASET (kludge, 0, make_number (i));
3866 if (!NILP (elt_prefix))
3867 insert1 (elt_prefix);
3869 insert1 (Fkey_description (kludge, prefix));
3872 /* Print a description of the definition of this character.
3873 elt_describer will take care of spacing out far enough
3874 for alignment purposes. */
3875 (*elt_describer) (definition, args);
3877 if (this_shadowed)
3879 SET_PT (PT - 1);
3880 insert_string (" (binding currently shadowed)");
3881 SET_PT (PT + 1);
3885 if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
3887 if (!NILP (elt_prefix))
3888 insert1 (elt_prefix);
3889 insert ("default", 7);
3890 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3893 UNGCPRO;
3896 /* Apropos - finding all symbols whose names match a regexp. */
3897 static Lisp_Object apropos_predicate;
3898 static Lisp_Object apropos_accumulate;
3900 static void
3901 apropos_accum (symbol, string)
3902 Lisp_Object symbol, string;
3904 register Lisp_Object tem;
3906 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3907 if (!NILP (tem) && !NILP (apropos_predicate))
3908 tem = call1 (apropos_predicate, symbol);
3909 if (!NILP (tem))
3910 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3913 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3914 doc: /* Show all symbols whose names contain match for REGEXP.
3915 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3916 for each symbol and a symbol is mentioned only if that returns non-nil.
3917 Return list of symbols found. */)
3918 (regexp, predicate)
3919 Lisp_Object regexp, predicate;
3921 Lisp_Object tem;
3922 CHECK_STRING (regexp);
3923 apropos_predicate = predicate;
3924 apropos_accumulate = Qnil;
3925 map_obarray (Vobarray, apropos_accum, regexp);
3926 tem = Fsort (apropos_accumulate, Qstring_lessp);
3927 apropos_accumulate = Qnil;
3928 apropos_predicate = Qnil;
3929 return tem;
3932 void
3933 syms_of_keymap ()
3935 Qkeymap = intern_c_string ("keymap");
3936 staticpro (&Qkeymap);
3937 staticpro (&apropos_predicate);
3938 staticpro (&apropos_accumulate);
3939 apropos_predicate = Qnil;
3940 apropos_accumulate = Qnil;
3942 Qkeymap_canonicalize = intern_c_string ("keymap-canonicalize");
3943 staticpro (&Qkeymap_canonicalize);
3945 /* Now we are ready to set up this property, so we can
3946 create char tables. */
3947 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3949 /* Initialize the keymaps standardly used.
3950 Each one is the value of a Lisp variable, and is also
3951 pointed to by a C variable */
3953 global_map = Fmake_keymap (Qnil);
3954 Fset (intern_c_string ("global-map"), global_map);
3956 current_global_map = global_map;
3957 staticpro (&global_map);
3958 staticpro (&current_global_map);
3960 meta_map = Fmake_keymap (Qnil);
3961 Fset (intern_c_string ("esc-map"), meta_map);
3962 Ffset (intern_c_string ("ESC-prefix"), meta_map);
3964 control_x_map = Fmake_keymap (Qnil);
3965 Fset (intern_c_string ("ctl-x-map"), control_x_map);
3966 Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
3968 exclude_keys
3969 = pure_cons (pure_cons (make_pure_c_string ("DEL"), make_pure_c_string ("\\d")),
3970 pure_cons (pure_cons (make_pure_c_string ("TAB"), make_pure_c_string ("\\t")),
3971 pure_cons (pure_cons (make_pure_c_string ("RET"), make_pure_c_string ("\\r")),
3972 pure_cons (pure_cons (make_pure_c_string ("ESC"), make_pure_c_string ("\\e")),
3973 pure_cons (pure_cons (make_pure_c_string ("SPC"), make_pure_c_string (" ")),
3974 Qnil)))));
3975 staticpro (&exclude_keys);
3977 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3978 doc: /* List of commands given new key bindings recently.
3979 This is used for internal purposes during Emacs startup;
3980 don't alter it yourself. */);
3981 Vdefine_key_rebound_commands = Qt;
3983 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3984 doc: /* Default keymap to use when reading from the minibuffer. */);
3985 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3987 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3988 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
3989 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3990 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3992 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3993 doc: /* Local keymap for minibuffer input with completion. */);
3994 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3995 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
3997 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
3998 &Vminibuffer_local_filename_completion_map,
3999 doc: /* Local keymap for minibuffer input with completion for filenames. */);
4000 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
4001 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
4002 Vminibuffer_local_completion_map);
4005 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
4006 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
4007 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
4008 Fset_keymap_parent (Vminibuffer_local_must_match_map,
4009 Vminibuffer_local_completion_map);
4011 DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
4012 &Vminibuffer_local_filename_must_match_map,
4013 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
4014 Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
4015 Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
4016 Vminibuffer_local_must_match_map);
4018 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4019 doc: /* Alist of keymaps to use for minor modes.
4020 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4021 key sequences and look up bindings if VARIABLE's value is non-nil.
4022 If two active keymaps bind the same key, the keymap appearing earlier
4023 in the list takes precedence. */);
4024 Vminor_mode_map_alist = Qnil;
4026 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4027 doc: /* Alist of keymaps to use for minor modes, in current major mode.
4028 This variable is an alist just like `minor-mode-map-alist', and it is
4029 used the same way (and before `minor-mode-map-alist'); however,
4030 it is provided for major modes to bind locally. */);
4031 Vminor_mode_overriding_map_alist = Qnil;
4033 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4034 doc: /* List of keymap alists to use for emulations modes.
4035 It is intended for modes or packages using multiple minor-mode keymaps.
4036 Each element is a keymap alist just like `minor-mode-map-alist', or a
4037 symbol with a variable binding which is a keymap alist, and it is used
4038 the same way. The "active" keymaps in each alist are used before
4039 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
4040 Vemulation_mode_map_alists = Qnil;
4042 DEFVAR_LISP ("where-is-preferred-modifier", &Vwhere_is_preferred_modifier,
4043 doc: /* Preferred modifier to use for `where-is'.
4044 When a single binding is requested, `where-is' will return one that
4045 uses this modifier if possible. If nil, or if no such binding exists,
4046 bindings using keys without modifiers (or only with meta) will be
4047 preferred. */);
4048 Vwhere_is_preferred_modifier = Qnil;
4049 where_is_preferred_modifier = 0;
4051 staticpro (&Vmouse_events);
4052 Vmouse_events = pure_cons (intern_c_string ("menu-bar"),
4053 pure_cons (intern_c_string ("tool-bar"),
4054 pure_cons (intern_c_string ("header-line"),
4055 pure_cons (intern_c_string ("mode-line"),
4056 pure_cons (intern_c_string ("mouse-1"),
4057 pure_cons (intern_c_string ("mouse-2"),
4058 pure_cons (intern_c_string ("mouse-3"),
4059 pure_cons (intern_c_string ("mouse-4"),
4060 pure_cons (intern_c_string ("mouse-5"),
4061 Qnil)))))))));
4064 Qsingle_key_description = intern_c_string ("single-key-description");
4065 staticpro (&Qsingle_key_description);
4067 Qkey_description = intern_c_string ("key-description");
4068 staticpro (&Qkey_description);
4070 Qkeymapp = intern_c_string ("keymapp");
4071 staticpro (&Qkeymapp);
4073 Qnon_ascii = intern_c_string ("non-ascii");
4074 staticpro (&Qnon_ascii);
4076 Qmenu_item = intern_c_string ("menu-item");
4077 staticpro (&Qmenu_item);
4079 Qremap = intern_c_string ("remap");
4080 staticpro (&Qremap);
4082 QCadvertised_binding = intern_c_string (":advertised-binding");
4083 staticpro (&QCadvertised_binding);
4085 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4086 staticpro (&command_remapping_vector);
4088 where_is_cache_keymaps = Qt;
4089 where_is_cache = Qnil;
4090 staticpro (&where_is_cache);
4091 staticpro (&where_is_cache_keymaps);
4093 defsubr (&Skeymapp);
4094 defsubr (&Skeymap_parent);
4095 defsubr (&Skeymap_prompt);
4096 defsubr (&Sset_keymap_parent);
4097 defsubr (&Smake_keymap);
4098 defsubr (&Smake_sparse_keymap);
4099 defsubr (&Smap_keymap_internal);
4100 defsubr (&Smap_keymap);
4101 defsubr (&Scopy_keymap);
4102 defsubr (&Scommand_remapping);
4103 defsubr (&Skey_binding);
4104 defsubr (&Slocal_key_binding);
4105 defsubr (&Sglobal_key_binding);
4106 defsubr (&Sminor_mode_key_binding);
4107 defsubr (&Sdefine_key);
4108 defsubr (&Slookup_key);
4109 defsubr (&Sdefine_prefix_command);
4110 defsubr (&Suse_global_map);
4111 defsubr (&Suse_local_map);
4112 defsubr (&Scurrent_local_map);
4113 defsubr (&Scurrent_global_map);
4114 defsubr (&Scurrent_minor_mode_maps);
4115 defsubr (&Scurrent_active_maps);
4116 defsubr (&Saccessible_keymaps);
4117 defsubr (&Skey_description);
4118 defsubr (&Sdescribe_vector);
4119 defsubr (&Ssingle_key_description);
4120 defsubr (&Stext_char_description);
4121 defsubr (&Swhere_is_internal);
4122 defsubr (&Sdescribe_buffer_bindings);
4123 defsubr (&Sapropos_internal);
4126 void
4127 keys_of_keymap ()
4129 initial_define_key (global_map, 033, "ESC-prefix");
4130 initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
4133 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4134 (do not change this comment) */