* lisp/simple.el (kill-new): Fix logic of kill-do-not-save-duplicates.
[emacs.git] / src / keymap.c
blobc3a9d9e5cc001a29b13f7eaf5a8c65569ac95741
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 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 #include "lisp.h"
26 #include "commands.h"
27 #include "buffer.h"
28 #include "character.h"
29 #include "charset.h"
30 #include "keyboard.h"
31 #include "frame.h"
32 #include "termhooks.h"
33 #include "blockinput.h"
34 #include "puresize.h"
35 #include "intervals.h"
36 #include "keymap.h"
37 #include "window.h"
39 /* The number of elements in keymap vectors. */
40 #define DENSE_TABLE_SIZE (0200)
42 /* Actually allocate storage for these variables */
44 Lisp_Object current_global_map; /* Current global keymap */
46 Lisp_Object global_map; /* default global key bindings */
48 Lisp_Object meta_map; /* The keymap used for globally bound
49 ESC-prefixed default commands */
51 Lisp_Object control_x_map; /* The keymap used for globally bound
52 C-x-prefixed default commands */
54 /* was MinibufLocalMap */
55 Lisp_Object Vminibuffer_local_map;
56 /* The keymap used by the minibuf for local
57 bindings when spaces are allowed in the
58 minibuf */
60 /* was MinibufLocalNSMap */
61 Lisp_Object Vminibuffer_local_ns_map;
62 /* The keymap used by the minibuf for local
63 bindings when spaces are not encouraged
64 in the minibuf */
66 /* keymap used for minibuffers when doing completion */
67 /* was MinibufLocalCompletionMap */
68 Lisp_Object Vminibuffer_local_completion_map;
70 /* keymap used for minibuffers when doing completion in filenames */
71 Lisp_Object Vminibuffer_local_filename_completion_map;
73 /* keymap used for minibuffers when doing completion in filenames
74 with require-match*/
75 Lisp_Object Vminibuffer_local_filename_must_match_map;
77 /* keymap used for minibuffers when doing completion and require a match */
78 /* was MinibufLocalMustMatchMap */
79 Lisp_Object Vminibuffer_local_must_match_map;
81 /* Alist of minor mode variables and keymaps. */
82 Lisp_Object Vminor_mode_map_alist;
84 /* Alist of major-mode-specific overrides for
85 minor mode variables and keymaps. */
86 Lisp_Object Vminor_mode_overriding_map_alist;
88 /* List of emulation mode keymap alists. */
89 Lisp_Object Vemulation_mode_map_alists;
91 /* A list of all commands given new bindings since a certain time
92 when nil was stored here.
93 This is used to speed up recomputation of menu key equivalents
94 when Emacs starts up. t means don't record anything here. */
95 Lisp_Object Vdefine_key_rebound_commands;
97 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
98 Lisp_Object QCadvertised_binding;
100 /* Alist of elements like (DEL . "\d"). */
101 static Lisp_Object exclude_keys;
103 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
104 static Lisp_Object command_remapping_vector;
106 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
107 in a string key sequence is equivalent to prefixing with this
108 character. */
109 extern Lisp_Object meta_prefix_char;
111 extern Lisp_Object Voverriding_local_map;
113 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
114 static Lisp_Object where_is_cache;
115 /* Which keymaps are reverse-stored in the cache. */
116 static Lisp_Object where_is_cache_keymaps;
118 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
119 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
121 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
122 static void describe_command P_ ((Lisp_Object, Lisp_Object));
123 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
124 static void describe_map P_ ((Lisp_Object, Lisp_Object,
125 void (*) P_ ((Lisp_Object, Lisp_Object)),
126 int, Lisp_Object, Lisp_Object*, int, int));
127 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
128 void (*) (Lisp_Object, Lisp_Object), int,
129 Lisp_Object, Lisp_Object, int *,
130 int, int, int));
131 static void silly_event_symbol_error P_ ((Lisp_Object));
133 /* Keymap object support - constructors and predicates. */
135 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
136 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
137 CHARTABLE is a char-table that holds the bindings for all characters
138 without modifiers. All entries in it are initially nil, meaning
139 "command undefined". ALIST is an assoc-list which holds bindings for
140 function keys, mouse events, and any other things that appear in the
141 input stream. Initially, ALIST is nil.
143 The optional arg STRING supplies a menu name for the keymap
144 in case you use it as a menu with `x-popup-menu'. */)
145 (string)
146 Lisp_Object string;
148 Lisp_Object tail;
149 if (!NILP (string))
150 tail = Fcons (string, Qnil);
151 else
152 tail = Qnil;
153 return Fcons (Qkeymap,
154 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
157 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
158 doc: /* Construct and return a new sparse keymap.
159 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
160 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
161 which binds the function key or mouse event SYMBOL to DEFINITION.
162 Initially the alist is nil.
164 The optional arg STRING supplies a menu name for the keymap
165 in case you use it as a menu with `x-popup-menu'. */)
166 (string)
167 Lisp_Object string;
169 if (!NILP (string))
171 if (!NILP (Vpurify_flag))
172 string = Fpurecopy (string);
173 return Fcons (Qkeymap, Fcons (string, Qnil));
175 return Fcons (Qkeymap, Qnil);
178 /* This function is used for installing the standard key bindings
179 at initialization time.
181 For example:
183 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
185 void
186 initial_define_key (keymap, key, defname)
187 Lisp_Object keymap;
188 int key;
189 char *defname;
191 store_in_keymap (keymap, make_number (key), intern_c_string (defname));
194 void
195 initial_define_lispy_key (keymap, keyname, defname)
196 Lisp_Object keymap;
197 char *keyname;
198 char *defname;
200 store_in_keymap (keymap, intern_c_string (keyname), intern_c_string (defname));
203 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
204 doc: /* Return t if OBJECT is a keymap.
206 A keymap is a list (keymap . ALIST),
207 or a symbol whose function definition is itself a keymap.
208 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
209 a vector of densely packed bindings for small character codes
210 is also allowed as an element. */)
211 (object)
212 Lisp_Object object;
214 return (KEYMAPP (object) ? Qt : Qnil);
217 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
218 doc: /* Return the prompt-string of a keymap MAP.
219 If non-nil, the prompt is shown in the echo-area
220 when reading a key-sequence to be looked-up in this keymap. */)
221 (map)
222 Lisp_Object map;
224 map = get_keymap (map, 0, 0);
225 while (CONSP (map))
227 Lisp_Object tem = XCAR (map);
228 if (STRINGP (tem))
229 return tem;
230 map = XCDR (map);
232 return Qnil;
235 /* Check that OBJECT is a keymap (after dereferencing through any
236 symbols). If it is, return it.
238 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
239 is an autoload form, do the autoload and try again.
240 If AUTOLOAD is nonzero, callers must assume GC is possible.
242 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
243 is zero as well), return Qt.
245 ERROR controls how we respond if OBJECT isn't a keymap.
246 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
248 Note that most of the time, we don't want to pursue autoloads.
249 Functions like Faccessible_keymaps which scan entire keymap trees
250 shouldn't load every autoloaded keymap. I'm not sure about this,
251 but it seems to me that only read_key_sequence, Flookup_key, and
252 Fdefine_key should cause keymaps to be autoloaded.
254 This function can GC when AUTOLOAD is non-zero, because it calls
255 do_autoload which can GC. */
257 Lisp_Object
258 get_keymap (object, error, autoload)
259 Lisp_Object object;
260 int error, autoload;
262 Lisp_Object tem;
264 autoload_retry:
265 if (NILP (object))
266 goto end;
267 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
268 return object;
270 tem = indirect_function (object);
271 if (CONSP (tem))
273 if (EQ (XCAR (tem), Qkeymap))
274 return tem;
276 /* Should we do an autoload? Autoload forms for keymaps have
277 Qkeymap as their fifth element. */
278 if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
279 && SYMBOLP (object))
281 Lisp_Object tail;
283 tail = Fnth (make_number (4), tem);
284 if (EQ (tail, Qkeymap))
286 if (autoload)
288 struct gcpro gcpro1, gcpro2;
290 GCPRO2 (tem, object);
291 do_autoload (tem, object);
292 UNGCPRO;
294 goto autoload_retry;
296 else
297 return object;
302 end:
303 if (error)
304 wrong_type_argument (Qkeymapp, object);
305 return Qnil;
308 /* Return the parent map of KEYMAP, or nil if it has none.
309 We assume that KEYMAP is a valid keymap. */
311 Lisp_Object
312 keymap_parent (keymap, autoload)
313 Lisp_Object keymap;
314 int autoload;
316 Lisp_Object list;
318 keymap = get_keymap (keymap, 1, autoload);
320 /* Skip past the initial element `keymap'. */
321 list = XCDR (keymap);
322 for (; CONSP (list); list = XCDR (list))
324 /* See if there is another `keymap'. */
325 if (KEYMAPP (list))
326 return list;
329 return get_keymap (list, 0, autoload);
332 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
333 doc: /* Return the parent keymap of KEYMAP.
334 If KEYMAP has no parent, return nil. */)
335 (keymap)
336 Lisp_Object keymap;
338 return keymap_parent (keymap, 1);
341 /* Check whether MAP is one of MAPS parents. */
343 keymap_memberp (map, maps)
344 Lisp_Object map, maps;
346 if (NILP (map)) return 0;
347 while (KEYMAPP (maps) && !EQ (map, maps))
348 maps = keymap_parent (maps, 0);
349 return (EQ (map, maps));
352 /* Set the parent keymap of MAP to PARENT. */
354 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
355 doc: /* Modify KEYMAP to set its parent map to PARENT.
356 Return PARENT. PARENT should be nil or another keymap. */)
357 (keymap, parent)
358 Lisp_Object keymap, parent;
360 Lisp_Object list, prev;
361 struct gcpro gcpro1, gcpro2;
362 int i;
364 /* Force a keymap flush for the next call to where-is.
365 Since this can be called from within where-is, we don't set where_is_cache
366 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
367 be changed during where-is, while where_is_cache_keymaps is only used at
368 the very beginning of where-is and can thus be changed here without any
369 adverse effect.
370 This is a very minor correctness (rather than safety) issue. */
371 where_is_cache_keymaps = Qt;
373 GCPRO2 (keymap, parent);
374 keymap = get_keymap (keymap, 1, 1);
376 if (!NILP (parent))
378 parent = get_keymap (parent, 1, 1);
380 /* Check for cycles. */
381 if (keymap_memberp (keymap, parent))
382 error ("Cyclic keymap inheritance");
385 /* Skip past the initial element `keymap'. */
386 prev = keymap;
387 while (1)
389 list = XCDR (prev);
390 /* If there is a parent keymap here, replace it.
391 If we came to the end, add the parent in PREV. */
392 if (!CONSP (list) || KEYMAPP (list))
394 /* If we already have the right parent, return now
395 so that we avoid the loops below. */
396 if (EQ (XCDR (prev), parent))
397 RETURN_UNGCPRO (parent);
399 CHECK_IMPURE (prev);
400 XSETCDR (prev, parent);
401 break;
403 prev = list;
406 /* Scan through for submaps, and set their parents too. */
408 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
410 /* Stop the scan when we come to the parent. */
411 if (EQ (XCAR (list), Qkeymap))
412 break;
414 /* If this element holds a prefix map, deal with it. */
415 if (CONSP (XCAR (list))
416 && CONSP (XCDR (XCAR (list))))
417 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
418 XCDR (XCAR (list)));
420 if (VECTORP (XCAR (list)))
421 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
422 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
423 fix_submap_inheritance (keymap, make_number (i),
424 XVECTOR (XCAR (list))->contents[i]);
426 if (CHAR_TABLE_P (XCAR (list)))
428 map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
432 RETURN_UNGCPRO (parent);
435 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
436 if EVENT is also a prefix in MAP's parent,
437 make sure that SUBMAP inherits that definition as its own parent. */
439 static void
440 fix_submap_inheritance (map, event, submap)
441 Lisp_Object map, event, submap;
443 Lisp_Object map_parent, parent_entry;
445 /* SUBMAP is a cons that we found as a key binding.
446 Discard the other things found in a menu key binding. */
448 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
450 /* If it isn't a keymap now, there's no work to do. */
451 if (!CONSP (submap))
452 return;
454 map_parent = keymap_parent (map, 0);
455 if (!NILP (map_parent))
456 parent_entry =
457 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
458 else
459 parent_entry = Qnil;
461 /* If MAP's parent has something other than a keymap,
462 our own submap shadows it completely. */
463 if (!CONSP (parent_entry))
464 return;
466 if (! EQ (parent_entry, submap))
468 Lisp_Object submap_parent;
469 submap_parent = submap;
470 while (1)
472 Lisp_Object tem;
474 tem = keymap_parent (submap_parent, 0);
476 if (KEYMAPP (tem))
478 if (keymap_memberp (tem, parent_entry))
479 /* Fset_keymap_parent could create a cycle. */
480 return;
481 submap_parent = tem;
483 else
484 break;
486 Fset_keymap_parent (submap_parent, parent_entry);
490 /* Look up IDX in MAP. IDX may be any sort of event.
491 Note that this does only one level of lookup; IDX must be a single
492 event, not a sequence.
494 If T_OK is non-zero, bindings for Qt are treated as default
495 bindings; any key left unmentioned by other tables and bindings is
496 given the binding of Qt.
498 If T_OK is zero, bindings for Qt are not treated specially.
500 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
502 Lisp_Object
503 access_keymap (map, idx, t_ok, noinherit, autoload)
504 Lisp_Object map;
505 Lisp_Object idx;
506 int t_ok;
507 int noinherit;
508 int autoload;
510 Lisp_Object val;
512 /* Qunbound in VAL means we have found no binding yet. */
513 val = Qunbound;
515 /* If idx is a list (some sort of mouse click, perhaps?),
516 the index we want to use is the car of the list, which
517 ought to be a symbol. */
518 idx = EVENT_HEAD (idx);
520 /* If idx is a symbol, it might have modifiers, which need to
521 be put in the canonical order. */
522 if (SYMBOLP (idx))
523 idx = reorder_modifiers (idx);
524 else if (INTEGERP (idx))
525 /* Clobber the high bits that can be present on a machine
526 with more than 24 bits of integer. */
527 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
529 /* Handle the special meta -> esc mapping. */
530 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
532 /* See if there is a meta-map. If there's none, there is
533 no binding for IDX, unless a default binding exists in MAP. */
534 struct gcpro gcpro1;
535 Lisp_Object meta_map;
536 GCPRO1 (map);
537 /* A strange value in which Meta is set would cause
538 infinite recursion. Protect against that. */
539 if (XINT (meta_prefix_char) & CHAR_META)
540 meta_prefix_char = make_number (27);
541 meta_map = get_keymap (access_keymap (map, meta_prefix_char,
542 t_ok, noinherit, autoload),
543 0, autoload);
544 UNGCPRO;
545 if (CONSP (meta_map))
547 map = meta_map;
548 idx = make_number (XUINT (idx) & ~meta_modifier);
550 else if (t_ok)
551 /* Set IDX to t, so that we only find a default binding. */
552 idx = Qt;
553 else
554 /* We know there is no binding. */
555 return Qnil;
558 /* t_binding is where we put a default binding that applies,
559 to use in case we do not find a binding specifically
560 for this key sequence. */
562 Lisp_Object tail;
563 Lisp_Object t_binding = Qnil;
564 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
566 GCPRO4 (map, tail, idx, t_binding);
568 for (tail = XCDR (map);
569 (CONSP (tail)
570 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
571 tail = XCDR (tail))
573 Lisp_Object binding;
575 binding = XCAR (tail);
576 if (SYMBOLP (binding))
578 /* If NOINHERIT, stop finding prefix definitions
579 after we pass a second occurrence of the `keymap' symbol. */
580 if (noinherit && EQ (binding, Qkeymap))
581 RETURN_UNGCPRO (Qnil);
583 else if (CONSP (binding))
585 Lisp_Object key = XCAR (binding);
587 if (EQ (key, idx))
588 val = XCDR (binding);
589 else if (t_ok && EQ (key, Qt))
591 t_binding = XCDR (binding);
592 t_ok = 0;
595 else if (VECTORP (binding))
597 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
598 val = AREF (binding, XFASTINT (idx));
600 else if (CHAR_TABLE_P (binding))
602 /* Character codes with modifiers
603 are not included in a char-table.
604 All character codes without modifiers are included. */
605 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
607 val = Faref (binding, idx);
608 /* `nil' has a special meaning for char-tables, so
609 we use something else to record an explicitly
610 unbound entry. */
611 if (NILP (val))
612 val = Qunbound;
616 /* If we found a binding, clean it up and return it. */
617 if (!EQ (val, Qunbound))
619 if (EQ (val, Qt))
620 /* A Qt binding is just like an explicit nil binding
621 (i.e. it shadows any parent binding but not bindings in
622 keymaps of lower precedence). */
623 val = Qnil;
624 val = get_keyelt (val, autoload);
625 if (KEYMAPP (val))
626 fix_submap_inheritance (map, idx, val);
627 RETURN_UNGCPRO (val);
629 QUIT;
631 UNGCPRO;
632 return get_keyelt (t_binding, autoload);
636 static void
637 map_keymap_item (fun, args, key, val, data)
638 map_keymap_function_t fun;
639 Lisp_Object args, key, val;
640 void *data;
642 /* We should maybe try to detect bindings shadowed by previous
643 ones and things like that. */
644 if (EQ (val, Qt))
645 val = Qnil;
646 (*fun) (key, val, args, data);
649 static void
650 map_keymap_char_table_item (args, key, val)
651 Lisp_Object args, key, val;
653 if (!NILP (val))
655 map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
656 args = XCDR (args);
657 /* If the key is a range, make a copy since map_char_table modifies
658 it in place. */
659 if (CONSP (key))
660 key = Fcons (XCAR (key), XCDR (key));
661 map_keymap_item (fun, XCDR (args), key, val,
662 XSAVE_VALUE (XCAR (args))->pointer);
666 /* Call FUN for every binding in MAP and stop at (and return) the parent.
667 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA). */
668 Lisp_Object
669 map_keymap_internal (Lisp_Object map,
670 map_keymap_function_t fun,
671 Lisp_Object args,
672 void *data)
674 struct gcpro gcpro1, gcpro2, gcpro3;
675 Lisp_Object tail
676 = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
678 GCPRO3 (map, args, tail);
679 for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
681 Lisp_Object binding = XCAR (tail);
683 if (CONSP (binding))
684 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
685 else if (VECTORP (binding))
687 /* Loop over the char values represented in the vector. */
688 int len = ASIZE (binding);
689 int c;
690 for (c = 0; c < len; c++)
692 Lisp_Object character;
693 XSETFASTINT (character, c);
694 map_keymap_item (fun, args, character, AREF (binding, c), data);
697 else if (CHAR_TABLE_P (binding))
699 map_char_table (map_keymap_char_table_item, Qnil, binding,
700 Fcons (make_save_value (fun, 0),
701 Fcons (make_save_value (data, 0),
702 args)));
705 UNGCPRO;
706 return tail;
709 static void
710 map_keymap_call (key, val, fun, dummy)
711 Lisp_Object key, val, fun;
712 void *dummy;
714 call2 (fun, key, val);
717 /* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
718 A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
719 void
720 map_keymap (map, fun, args, data, autoload)
721 map_keymap_function_t fun;
722 Lisp_Object map, args;
723 void *data;
724 int autoload;
726 struct gcpro gcpro1;
727 GCPRO1 (args);
728 map = get_keymap (map, 1, autoload);
729 while (CONSP (map))
731 map = map_keymap_internal (map, fun, args, data);
732 map = get_keymap (map, 0, autoload);
734 UNGCPRO;
737 Lisp_Object Qkeymap_canonicalize;
739 /* Same as map_keymap, but does it right, properly eliminating duplicate
740 bindings due to inheritance. */
741 void
742 map_keymap_canonical (map, fun, args, data)
743 map_keymap_function_t fun;
744 Lisp_Object map, args;
745 void *data;
747 struct gcpro gcpro1;
748 GCPRO1 (args);
749 /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
750 so be careful to ignore errors and to inhibit redisplay. */
751 map = safe_call1 (Qkeymap_canonicalize, map);
752 /* No need to use `map_keymap' here because canonical map has no parent. */
753 map_keymap_internal (map, fun, args, data);
754 UNGCPRO;
757 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
758 doc: /* Call FUNCTION once for each event binding in KEYMAP.
759 FUNCTION is called with two arguments: the event that is bound, and
760 the definition it is bound to. The event may be a character range.
761 If KEYMAP has a parent, this function returns it without processing it. */)
762 (function, keymap)
763 Lisp_Object function, keymap;
765 struct gcpro gcpro1;
766 GCPRO1 (function);
767 keymap = get_keymap (keymap, 1, 1);
768 keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
769 UNGCPRO;
770 return keymap;
773 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
774 doc: /* Call FUNCTION once for each event binding in KEYMAP.
775 FUNCTION is called with two arguments: the event that is bound, and
776 the definition it is bound to. The event may be a character range.
778 If KEYMAP has a parent, the parent's bindings are included as well.
779 This works recursively: if the parent has itself a parent, then the
780 grandparent's bindings are also included and so on.
781 usage: (map-keymap FUNCTION KEYMAP) */)
782 (function, keymap, sort_first)
783 Lisp_Object function, keymap, sort_first;
785 if (! NILP (sort_first))
786 return call2 (intern ("map-keymap-sorted"), function, keymap);
788 map_keymap (keymap, map_keymap_call, function, NULL, 1);
789 return Qnil;
792 /* Given OBJECT which was found in a slot in a keymap,
793 trace indirect definitions to get the actual definition of that slot.
794 An indirect definition is a list of the form
795 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
796 and INDEX is the object to look up in KEYMAP to yield the definition.
798 Also if OBJECT has a menu string as the first element,
799 remove that. Also remove a menu help string as second element.
801 If AUTOLOAD is nonzero, load autoloadable keymaps
802 that are referred to with indirection.
804 This can GC because menu_item_eval_property calls Feval. */
806 Lisp_Object
807 get_keyelt (object, autoload)
808 Lisp_Object object;
809 int autoload;
811 while (1)
813 if (!(CONSP (object)))
814 /* This is really the value. */
815 return object;
817 /* If the keymap contents looks like (keymap ...) or (lambda ...)
818 then use itself. */
819 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
820 return object;
822 /* If the keymap contents looks like (menu-item name . DEFN)
823 or (menu-item name DEFN ...) then use DEFN.
824 This is a new format menu item. */
825 else if (EQ (XCAR (object), Qmenu_item))
827 if (CONSP (XCDR (object)))
829 Lisp_Object tem;
831 object = XCDR (XCDR (object));
832 tem = object;
833 if (CONSP (object))
834 object = XCAR (object);
836 /* If there's a `:filter FILTER', apply FILTER to the
837 menu-item's definition to get the real definition to
838 use. */
839 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
840 if (EQ (XCAR (tem), QCfilter) && autoload)
842 Lisp_Object filter;
843 filter = XCAR (XCDR (tem));
844 filter = list2 (filter, list2 (Qquote, object));
845 object = menu_item_eval_property (filter);
846 break;
849 else
850 /* Invalid keymap. */
851 return object;
854 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
855 Keymap alist elements like (CHAR MENUSTRING . DEFN)
856 will be used by HierarKey menus. */
857 else if (STRINGP (XCAR (object)))
859 object = XCDR (object);
860 /* Also remove a menu help string, if any,
861 following the menu item name. */
862 if (CONSP (object) && STRINGP (XCAR (object)))
863 object = XCDR (object);
864 /* Also remove the sublist that caches key equivalences, if any. */
865 if (CONSP (object) && CONSP (XCAR (object)))
867 Lisp_Object carcar;
868 carcar = XCAR (XCAR (object));
869 if (NILP (carcar) || VECTORP (carcar))
870 object = XCDR (object);
874 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
875 else
877 struct gcpro gcpro1;
878 Lisp_Object map;
879 GCPRO1 (object);
880 map = get_keymap (Fcar_safe (object), 0, autoload);
881 UNGCPRO;
882 return (!CONSP (map) ? object /* Invalid keymap */
883 : access_keymap (map, Fcdr (object), 0, 0, autoload));
888 static Lisp_Object
889 store_in_keymap (keymap, idx, def)
890 Lisp_Object keymap;
891 register Lisp_Object idx;
892 Lisp_Object def;
894 /* Flush any reverse-map cache. */
895 where_is_cache = Qnil;
896 where_is_cache_keymaps = Qt;
898 /* If we are preparing to dump, and DEF is a menu element
899 with a menu item indicator, copy it to ensure it is not pure. */
900 if (CONSP (def) && PURE_P (def)
901 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
902 def = Fcons (XCAR (def), XCDR (def));
904 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
905 error ("attempt to define a key in a non-keymap");
907 /* If idx is a cons, and the car part is a character, idx must be of
908 the form (FROM-CHAR . TO-CHAR). */
909 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
910 CHECK_CHARACTER_CDR (idx);
911 else
912 /* If idx is a list (some sort of mouse click, perhaps?),
913 the index we want to use is the car of the list, which
914 ought to be a symbol. */
915 idx = EVENT_HEAD (idx);
917 /* If idx is a symbol, it might have modifiers, which need to
918 be put in the canonical order. */
919 if (SYMBOLP (idx))
920 idx = reorder_modifiers (idx);
921 else if (INTEGERP (idx))
922 /* Clobber the high bits that can be present on a machine
923 with more than 24 bits of integer. */
924 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
926 /* Scan the keymap for a binding of idx. */
928 Lisp_Object tail;
930 /* The cons after which we should insert new bindings. If the
931 keymap has a table element, we record its position here, so new
932 bindings will go after it; this way, the table will stay
933 towards the front of the alist and character lookups in dense
934 keymaps will remain fast. Otherwise, this just points at the
935 front of the keymap. */
936 Lisp_Object insertion_point;
938 insertion_point = keymap;
939 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
941 Lisp_Object elt;
943 elt = XCAR (tail);
944 if (VECTORP (elt))
946 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
948 CHECK_IMPURE (elt);
949 ASET (elt, XFASTINT (idx), def);
950 return def;
952 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
954 int from = XFASTINT (XCAR (idx));
955 int to = XFASTINT (XCDR (idx));
957 if (to >= ASIZE (elt))
958 to = ASIZE (elt) - 1;
959 for (; from <= to; from++)
960 ASET (elt, from, def);
961 if (to == XFASTINT (XCDR (idx)))
962 /* We have defined all keys in IDX. */
963 return def;
965 insertion_point = tail;
967 else if (CHAR_TABLE_P (elt))
969 /* Character codes with modifiers
970 are not included in a char-table.
971 All character codes without modifiers are included. */
972 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
974 Faset (elt, idx,
975 /* `nil' has a special meaning for char-tables, so
976 we use something else to record an explicitly
977 unbound entry. */
978 NILP (def) ? Qt : def);
979 return def;
981 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
983 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
984 return def;
986 insertion_point = tail;
988 else if (CONSP (elt))
990 if (EQ (idx, XCAR (elt)))
992 CHECK_IMPURE (elt);
993 XSETCDR (elt, def);
994 return def;
996 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
998 int from = XFASTINT (XCAR (idx));
999 int to = XFASTINT (XCDR (idx));
1001 if (from <= XFASTINT (XCAR (elt))
1002 && to >= XFASTINT (XCAR (elt)))
1004 XSETCDR (elt, def);
1005 if (from == to)
1006 return def;
1010 else if (EQ (elt, Qkeymap))
1011 /* If we find a 'keymap' symbol in the spine of KEYMAP,
1012 then we must have found the start of a second keymap
1013 being used as the tail of KEYMAP, and a binding for IDX
1014 should be inserted before it. */
1015 goto keymap_end;
1017 QUIT;
1020 keymap_end:
1021 /* We have scanned the entire keymap, and not found a binding for
1022 IDX. Let's add one. */
1024 Lisp_Object elt;
1026 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
1028 /* IDX specifies a range of characters, and not all of them
1029 were handled yet, which means this keymap doesn't have a
1030 char-table. So, we insert a char-table now. */
1031 elt = Fmake_char_table (Qkeymap, Qnil);
1032 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
1034 else
1035 elt = Fcons (idx, def);
1036 CHECK_IMPURE (insertion_point);
1037 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
1041 return def;
1044 EXFUN (Fcopy_keymap, 1);
1046 Lisp_Object
1047 copy_keymap_item (elt)
1048 Lisp_Object elt;
1050 Lisp_Object res, tem;
1052 if (!CONSP (elt))
1053 return elt;
1055 res = tem = elt;
1057 /* Is this a new format menu item. */
1058 if (EQ (XCAR (tem), Qmenu_item))
1060 /* Copy cell with menu-item marker. */
1061 res = elt = Fcons (XCAR (tem), XCDR (tem));
1062 tem = XCDR (elt);
1063 if (CONSP (tem))
1065 /* Copy cell with menu-item name. */
1066 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1067 elt = XCDR (elt);
1068 tem = XCDR (elt);
1070 if (CONSP (tem))
1072 /* Copy cell with binding and if the binding is a keymap,
1073 copy that. */
1074 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1075 elt = XCDR (elt);
1076 tem = XCAR (elt);
1077 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1078 XSETCAR (elt, Fcopy_keymap (tem));
1079 tem = XCDR (elt);
1080 if (CONSP (tem) && CONSP (XCAR (tem)))
1081 /* Delete cache for key equivalences. */
1082 XSETCDR (elt, XCDR (tem));
1085 else
1087 /* It may be an old fomat menu item.
1088 Skip the optional menu string. */
1089 if (STRINGP (XCAR (tem)))
1091 /* Copy the cell, since copy-alist didn't go this deep. */
1092 res = elt = Fcons (XCAR (tem), XCDR (tem));
1093 tem = XCDR (elt);
1094 /* Also skip the optional menu help string. */
1095 if (CONSP (tem) && STRINGP (XCAR (tem)))
1097 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1098 elt = XCDR (elt);
1099 tem = XCDR (elt);
1101 /* There may also be a list that caches key equivalences.
1102 Just delete it for the new keymap. */
1103 if (CONSP (tem)
1104 && CONSP (XCAR (tem))
1105 && (NILP (XCAR (XCAR (tem)))
1106 || VECTORP (XCAR (XCAR (tem)))))
1108 XSETCDR (elt, XCDR (tem));
1109 tem = XCDR (tem);
1111 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1112 XSETCDR (elt, Fcopy_keymap (tem));
1114 else if (EQ (XCAR (tem), Qkeymap))
1115 res = Fcopy_keymap (elt);
1117 return res;
1120 static void
1121 copy_keymap_1 (chartable, idx, elt)
1122 Lisp_Object chartable, idx, elt;
1124 Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
1127 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1128 doc: /* Return a copy of the keymap KEYMAP.
1129 The copy starts out with the same definitions of KEYMAP,
1130 but changing either the copy or KEYMAP does not affect the other.
1131 Any key definitions that are subkeymaps are recursively copied.
1132 However, a key definition which is a symbol whose definition is a keymap
1133 is not copied. */)
1134 (keymap)
1135 Lisp_Object keymap;
1137 register Lisp_Object copy, tail;
1138 keymap = get_keymap (keymap, 1, 0);
1139 copy = tail = Fcons (Qkeymap, Qnil);
1140 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1142 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1144 Lisp_Object elt = XCAR (keymap);
1145 if (CHAR_TABLE_P (elt))
1147 elt = Fcopy_sequence (elt);
1148 map_char_table (copy_keymap_1, Qnil, elt, elt);
1150 else if (VECTORP (elt))
1152 int i;
1153 elt = Fcopy_sequence (elt);
1154 for (i = 0; i < ASIZE (elt); i++)
1155 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1157 else if (CONSP (elt))
1158 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1159 XSETCDR (tail, Fcons (elt, Qnil));
1160 tail = XCDR (tail);
1161 keymap = XCDR (keymap);
1163 XSETCDR (tail, keymap);
1164 return copy;
1167 /* Simple Keymap mutators and accessors. */
1169 /* GC is possible in this function if it autoloads a keymap. */
1171 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1172 doc: /* In KEYMAP, define key sequence KEY as DEF.
1173 KEYMAP is a keymap.
1175 KEY is a string or a vector of symbols and characters meaning a
1176 sequence of keystrokes and events. Non-ASCII characters with codes
1177 above 127 (such as ISO Latin-1) can be included if you use a vector.
1178 Using [t] for KEY creates a default definition, which applies to any
1179 event type that has no other definition in this keymap.
1181 DEF is anything that can be a key's definition:
1182 nil (means key is undefined in this keymap),
1183 a command (a Lisp function suitable for interactive calling),
1184 a string (treated as a keyboard macro),
1185 a keymap (to define a prefix key),
1186 a symbol (when the key is looked up, the symbol will stand for its
1187 function definition, which should at that time be one of the above,
1188 or another symbol whose function definition is used, etc.),
1189 a cons (STRING . DEFN), meaning that DEFN is the definition
1190 (DEFN should be a valid definition in its own right),
1191 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1192 or an extended menu item definition.
1193 (See info node `(elisp)Extended Menu Items'.)
1195 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1196 binding is altered. If there is no binding for KEY, the new pair
1197 binding KEY to DEF is added at the front of KEYMAP. */)
1198 (keymap, key, def)
1199 Lisp_Object keymap;
1200 Lisp_Object key;
1201 Lisp_Object def;
1203 register int idx;
1204 register Lisp_Object c;
1205 register Lisp_Object cmd;
1206 int metized = 0;
1207 int meta_bit;
1208 int length;
1209 struct gcpro gcpro1, gcpro2, gcpro3;
1211 GCPRO3 (keymap, key, def);
1212 keymap = get_keymap (keymap, 1, 1);
1214 CHECK_VECTOR_OR_STRING (key);
1216 length = XFASTINT (Flength (key));
1217 if (length == 0)
1218 RETURN_UNGCPRO (Qnil);
1220 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1221 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1223 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1224 ? meta_modifier : 0x80);
1226 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1227 { /* DEF is apparently an XEmacs-style keyboard macro. */
1228 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1229 int i = ASIZE (def);
1230 while (--i >= 0)
1232 Lisp_Object c = AREF (def, i);
1233 if (CONSP (c) && lucid_event_type_list_p (c))
1234 c = Fevent_convert_list (c);
1235 ASET (tmp, i, c);
1237 def = tmp;
1240 idx = 0;
1241 while (1)
1243 c = Faref (key, make_number (idx));
1245 if (CONSP (c))
1247 /* C may be a Lucid style event type list or a cons (FROM .
1248 TO) specifying a range of characters. */
1249 if (lucid_event_type_list_p (c))
1250 c = Fevent_convert_list (c);
1251 else if (CHARACTERP (XCAR (c)))
1252 CHECK_CHARACTER_CDR (c);
1255 if (SYMBOLP (c))
1256 silly_event_symbol_error (c);
1258 if (INTEGERP (c)
1259 && (XINT (c) & meta_bit)
1260 && !metized)
1262 c = meta_prefix_char;
1263 metized = 1;
1265 else
1267 if (INTEGERP (c))
1268 XSETINT (c, XINT (c) & ~meta_bit);
1270 metized = 0;
1271 idx++;
1274 if (!INTEGERP (c) && !SYMBOLP (c)
1275 && (!CONSP (c)
1276 /* If C is a range, it must be a leaf. */
1277 || (INTEGERP (XCAR (c)) && idx != length)))
1278 error ("Key sequence contains invalid event");
1280 if (idx == length)
1281 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1283 cmd = access_keymap (keymap, c, 0, 1, 1);
1285 /* If this key is undefined, make it a prefix. */
1286 if (NILP (cmd))
1287 cmd = define_as_prefix (keymap, c);
1289 keymap = get_keymap (cmd, 0, 1);
1290 if (!CONSP (keymap))
1291 /* We must use Fkey_description rather than just passing key to
1292 error; key might be a vector, not a string. */
1293 error ("Key sequence %s starts with non-prefix key %s",
1294 SDATA (Fkey_description (key, Qnil)),
1295 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1296 make_number (idx)),
1297 Qnil)));
1301 /* This function may GC (it calls Fkey_binding). */
1303 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1304 doc: /* Return the remapping for command COMMAND.
1305 Returns nil if COMMAND is not remapped (or not a symbol).
1307 If the optional argument POSITION is non-nil, it specifies a mouse
1308 position as returned by `event-start' and `event-end', and the
1309 remapping occurs in the keymaps associated with it. It can also be a
1310 number or marker, in which case the keymap properties at the specified
1311 buffer position instead of point are used. The KEYMAPS argument is
1312 ignored if POSITION is non-nil.
1314 If the optional argument KEYMAPS is non-nil, it should be a list of
1315 keymaps to search for command remapping. Otherwise, search for the
1316 remapping in all currently active keymaps. */)
1317 (command, position, keymaps)
1318 Lisp_Object command, position, keymaps;
1320 if (!SYMBOLP (command))
1321 return Qnil;
1323 ASET (command_remapping_vector, 1, command);
1325 if (NILP (keymaps))
1326 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1327 else
1329 Lisp_Object maps, binding;
1331 for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
1333 binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
1334 if (!NILP (binding) && !INTEGERP (binding))
1335 return binding;
1337 return Qnil;
1341 /* Value is number if KEY is too long; nil if valid but has no definition. */
1342 /* GC is possible in this function if it autoloads a keymap. */
1344 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1345 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1346 A value of nil means undefined. See doc of `define-key'
1347 for kinds of definitions.
1349 A number as value means KEY is "too long";
1350 that is, characters or symbols in it except for the last one
1351 fail to be a valid sequence of prefix characters in KEYMAP.
1352 The number is how many characters at the front of KEY
1353 it takes to reach a non-prefix key.
1355 Normally, `lookup-key' ignores bindings for t, which act as default
1356 bindings, used when nothing else in the keymap applies; this makes it
1357 usable as a general function for probing keymaps. However, if the
1358 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1359 recognize the default bindings, just as `read-key-sequence' does. */)
1360 (keymap, key, accept_default)
1361 Lisp_Object keymap;
1362 Lisp_Object key;
1363 Lisp_Object accept_default;
1365 register int idx;
1366 register Lisp_Object cmd;
1367 register Lisp_Object c;
1368 int length;
1369 int t_ok = !NILP (accept_default);
1370 struct gcpro gcpro1, gcpro2;
1372 GCPRO2 (keymap, key);
1373 keymap = get_keymap (keymap, 1, 1);
1375 CHECK_VECTOR_OR_STRING (key);
1377 length = XFASTINT (Flength (key));
1378 if (length == 0)
1379 RETURN_UNGCPRO (keymap);
1381 idx = 0;
1382 while (1)
1384 c = Faref (key, make_number (idx++));
1386 if (CONSP (c) && lucid_event_type_list_p (c))
1387 c = Fevent_convert_list (c);
1389 /* Turn the 8th bit of string chars into a meta modifier. */
1390 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1391 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1393 /* Allow string since binding for `menu-bar-select-buffer'
1394 includes the buffer name in the key sequence. */
1395 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1396 error ("Key sequence contains invalid event");
1398 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1399 if (idx == length)
1400 RETURN_UNGCPRO (cmd);
1402 keymap = get_keymap (cmd, 0, 1);
1403 if (!CONSP (keymap))
1404 RETURN_UNGCPRO (make_number (idx));
1406 QUIT;
1410 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1411 Assume that currently it does not define C at all.
1412 Return the keymap. */
1414 static Lisp_Object
1415 define_as_prefix (keymap, c)
1416 Lisp_Object keymap, c;
1418 Lisp_Object cmd;
1420 cmd = Fmake_sparse_keymap (Qnil);
1421 /* If this key is defined as a prefix in an inherited keymap,
1422 make it a prefix in this map, and make its definition
1423 inherit the other prefix definition. */
1424 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1425 store_in_keymap (keymap, c, cmd);
1427 return cmd;
1430 /* Append a key to the end of a key sequence. We always make a vector. */
1432 Lisp_Object
1433 append_key (key_sequence, key)
1434 Lisp_Object key_sequence, key;
1436 Lisp_Object args[2];
1438 args[0] = key_sequence;
1440 args[1] = Fcons (key, Qnil);
1441 return Fvconcat (2, args);
1444 /* Given a event type C which is a symbol,
1445 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1447 static void
1448 silly_event_symbol_error (c)
1449 Lisp_Object c;
1451 Lisp_Object parsed, base, name, assoc;
1452 int modifiers;
1454 parsed = parse_modifiers (c);
1455 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1456 base = XCAR (parsed);
1457 name = Fsymbol_name (base);
1458 /* This alist includes elements such as ("RET" . "\\r"). */
1459 assoc = Fassoc (name, exclude_keys);
1461 if (! NILP (assoc))
1463 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1464 char *p = new_mods;
1465 Lisp_Object keystring;
1466 if (modifiers & alt_modifier)
1467 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1468 if (modifiers & ctrl_modifier)
1469 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1470 if (modifiers & hyper_modifier)
1471 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1472 if (modifiers & meta_modifier)
1473 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1474 if (modifiers & shift_modifier)
1475 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1476 if (modifiers & super_modifier)
1477 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1478 *p = 0;
1480 c = reorder_modifiers (c);
1481 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1483 error ((modifiers & ~meta_modifier
1484 ? "To bind the key %s, use [?%s], not [%s]"
1485 : "To bind the key %s, use \"%s\", not [%s]"),
1486 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1487 SDATA (SYMBOL_NAME (c)));
1491 /* Global, local, and minor mode keymap stuff. */
1493 /* We can't put these variables inside current_minor_maps, since under
1494 some systems, static gets macro-defined to be the empty string.
1495 Ickypoo. */
1496 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1497 static int cmm_size = 0;
1499 /* Store a pointer to an array of the currently active minor modes in
1500 *modeptr, a pointer to an array of the keymaps of the currently
1501 active minor modes in *mapptr, and return the number of maps
1502 *mapptr contains.
1504 This function always returns a pointer to the same buffer, and may
1505 free or reallocate it, so if you want to keep it for a long time or
1506 hand it out to lisp code, copy it. This procedure will be called
1507 for every key sequence read, so the nice lispy approach (return a
1508 new assoclist, list, what have you) for each invocation would
1509 result in a lot of consing over time.
1511 If we used xrealloc/xmalloc and ran out of memory, they would throw
1512 back to the command loop, which would try to read a key sequence,
1513 which would call this function again, resulting in an infinite
1514 loop. Instead, we'll use realloc/malloc and silently truncate the
1515 list, let the key sequence be read, and hope some other piece of
1516 code signals the error. */
1518 current_minor_maps (modeptr, mapptr)
1519 Lisp_Object **modeptr, **mapptr;
1521 int i = 0;
1522 int list_number = 0;
1523 Lisp_Object alist, assoc, var, val;
1524 Lisp_Object emulation_alists;
1525 Lisp_Object lists[2];
1527 emulation_alists = Vemulation_mode_map_alists;
1528 lists[0] = Vminor_mode_overriding_map_alist;
1529 lists[1] = Vminor_mode_map_alist;
1531 for (list_number = 0; list_number < 2; list_number++)
1533 if (CONSP (emulation_alists))
1535 alist = XCAR (emulation_alists);
1536 emulation_alists = XCDR (emulation_alists);
1537 if (SYMBOLP (alist))
1538 alist = find_symbol_value (alist);
1539 list_number = -1;
1541 else
1542 alist = lists[list_number];
1544 for ( ; CONSP (alist); alist = XCDR (alist))
1545 if ((assoc = XCAR (alist), CONSP (assoc))
1546 && (var = XCAR (assoc), SYMBOLP (var))
1547 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1548 && !NILP (val))
1550 Lisp_Object temp;
1552 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1553 and also an entry in Vminor_mode_map_alist,
1554 ignore the latter. */
1555 if (list_number == 1)
1557 val = assq_no_quit (var, lists[0]);
1558 if (!NILP (val))
1559 continue;
1562 if (i >= cmm_size)
1564 int newsize, allocsize;
1565 Lisp_Object *newmodes, *newmaps;
1567 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1568 allocsize = newsize * sizeof *newmodes;
1570 /* Use malloc here. See the comment above this function.
1571 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1572 BLOCK_INPUT;
1573 newmodes = (Lisp_Object *) malloc (allocsize);
1574 if (newmodes)
1576 if (cmm_modes)
1578 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1579 free (cmm_modes);
1581 cmm_modes = newmodes;
1584 newmaps = (Lisp_Object *) malloc (allocsize);
1585 if (newmaps)
1587 if (cmm_maps)
1589 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1590 free (cmm_maps);
1592 cmm_maps = newmaps;
1594 UNBLOCK_INPUT;
1596 if (newmodes == NULL || newmaps == NULL)
1597 break;
1598 cmm_size = newsize;
1601 /* Get the keymap definition--or nil if it is not defined. */
1602 temp = Findirect_function (XCDR (assoc), Qt);
1603 if (!NILP (temp))
1605 cmm_modes[i] = var;
1606 cmm_maps [i] = temp;
1607 i++;
1612 if (modeptr) *modeptr = cmm_modes;
1613 if (mapptr) *mapptr = cmm_maps;
1614 return i;
1617 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1618 0, 2, 0,
1619 doc: /* Return a list of the currently active keymaps.
1620 OLP if non-nil indicates that we should obey `overriding-local-map' and
1621 `overriding-terminal-local-map'. POSITION can specify a click position
1622 like in the respective argument of `key-binding'. */)
1623 (olp, position)
1624 Lisp_Object olp, position;
1626 int count = SPECPDL_INDEX ();
1628 Lisp_Object keymaps;
1630 /* If a mouse click position is given, our variables are based on
1631 the buffer clicked on, not the current buffer. So we may have to
1632 switch the buffer here. */
1634 if (CONSP (position))
1636 Lisp_Object window;
1638 window = POSN_WINDOW (position);
1640 if (WINDOWP (window)
1641 && BUFFERP (XWINDOW (window)->buffer)
1642 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1644 /* Arrange to go back to the original buffer once we're done
1645 processing the key sequence. We don't use
1646 save_excursion_{save,restore} here, in analogy to
1647 `read-key-sequence' to avoid saving point. Maybe this
1648 would not be a problem here, but it is easier to keep
1649 things the same.
1652 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1654 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1658 keymaps = Fcons (current_global_map, Qnil);
1660 if (!NILP (olp))
1662 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1663 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1664 /* The doc said that overriding-terminal-local-map should
1665 override overriding-local-map. The code used them both,
1666 but it seems clearer to use just one. rms, jan 2005. */
1667 else if (!NILP (Voverriding_local_map))
1668 keymaps = Fcons (Voverriding_local_map, keymaps);
1670 if (NILP (XCDR (keymaps)))
1672 Lisp_Object *maps;
1673 int nmaps, i;
1675 Lisp_Object keymap, local_map;
1676 EMACS_INT pt;
1678 pt = INTEGERP (position) ? XINT (position)
1679 : MARKERP (position) ? marker_position (position)
1680 : PT;
1682 /* Get the buffer local maps, possibly overriden by text or
1683 overlay properties */
1685 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1686 keymap = get_local_map (pt, current_buffer, Qkeymap);
1688 if (CONSP (position))
1690 Lisp_Object string;
1692 /* For a mouse click, get the local text-property keymap
1693 of the place clicked on, rather than point. */
1695 if (POSN_INBUFFER_P (position))
1697 Lisp_Object pos;
1699 pos = POSN_BUFFER_POSN (position);
1700 if (INTEGERP (pos)
1701 && XINT (pos) >= BEG && XINT (pos) <= Z)
1703 local_map = get_local_map (XINT (pos),
1704 current_buffer, Qlocal_map);
1706 keymap = get_local_map (XINT (pos),
1707 current_buffer, Qkeymap);
1711 /* If on a mode line string with a local keymap,
1712 or for a click on a string, i.e. overlay string or a
1713 string displayed via the `display' property,
1714 consider `local-map' and `keymap' properties of
1715 that string. */
1717 if (string = POSN_STRING (position),
1718 (CONSP (string) && STRINGP (XCAR (string))))
1720 Lisp_Object pos, map;
1722 pos = XCDR (string);
1723 string = XCAR (string);
1724 if (INTEGERP (pos)
1725 && XINT (pos) >= 0
1726 && XINT (pos) < SCHARS (string))
1728 map = Fget_text_property (pos, Qlocal_map, string);
1729 if (!NILP (map))
1730 local_map = map;
1732 map = Fget_text_property (pos, Qkeymap, string);
1733 if (!NILP (map))
1734 keymap = map;
1740 if (!NILP (local_map))
1741 keymaps = Fcons (local_map, keymaps);
1743 /* Now put all the minor mode keymaps on the list. */
1744 nmaps = current_minor_maps (0, &maps);
1746 for (i = --nmaps; i >= 0; i--)
1747 if (!NILP (maps[i]))
1748 keymaps = Fcons (maps[i], keymaps);
1750 if (!NILP (keymap))
1751 keymaps = Fcons (keymap, keymaps);
1754 unbind_to (count, Qnil);
1756 return keymaps;
1759 /* GC is possible in this function if it autoloads a keymap. */
1761 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1762 doc: /* Return the binding for command KEY in current keymaps.
1763 KEY is a string or vector, a sequence of keystrokes.
1764 The binding is probably a symbol with a function definition.
1766 Normally, `key-binding' ignores bindings for t, which act as default
1767 bindings, used when nothing else in the keymap applies; this makes it
1768 usable as a general function for probing keymaps. However, if the
1769 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1770 recognize the default bindings, just as `read-key-sequence' does.
1772 Like the normal command loop, `key-binding' will remap the command
1773 resulting from looking up KEY by looking up the command in the
1774 current keymaps. However, if the optional third argument NO-REMAP
1775 is non-nil, `key-binding' returns the unmapped command.
1777 If KEY is a key sequence initiated with the mouse, the used keymaps
1778 will depend on the clicked mouse position with regard to the buffer
1779 and possible local keymaps on strings.
1781 If the optional argument POSITION is non-nil, it specifies a mouse
1782 position as returned by `event-start' and `event-end', and the lookup
1783 occurs in the keymaps associated with it instead of KEY. It can also
1784 be a number or marker, in which case the keymap properties at the
1785 specified buffer position instead of point are used.
1787 (key, accept_default, no_remap, position)
1788 Lisp_Object key, accept_default, no_remap, position;
1790 Lisp_Object *maps, value;
1791 int nmaps, i;
1792 struct gcpro gcpro1, gcpro2;
1793 int count = SPECPDL_INDEX ();
1795 GCPRO2 (key, position);
1797 if (NILP (position) && VECTORP (key))
1799 Lisp_Object event
1800 /* mouse events may have a symbolic prefix indicating the
1801 scrollbar or mode line */
1802 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1804 /* We are not interested in locations without event data */
1806 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1808 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1809 if (EQ (kind, Qmouse_click))
1810 position = EVENT_START (event);
1814 /* Key sequences beginning with mouse clicks
1815 are read using the keymaps of the buffer clicked on, not
1816 the current buffer. So we may have to switch the buffer
1817 here. */
1819 if (CONSP (position))
1821 Lisp_Object window;
1823 window = POSN_WINDOW (position);
1825 if (WINDOWP (window)
1826 && BUFFERP (XWINDOW (window)->buffer)
1827 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1829 /* Arrange to go back to the original buffer once we're done
1830 processing the key sequence. We don't use
1831 save_excursion_{save,restore} here, in analogy to
1832 `read-key-sequence' to avoid saving point. Maybe this
1833 would not be a problem here, but it is easier to keep
1834 things the same.
1837 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1839 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1843 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1845 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1846 key, accept_default);
1847 if (! NILP (value) && !INTEGERP (value))
1848 goto done;
1850 else if (! NILP (Voverriding_local_map))
1852 value = Flookup_key (Voverriding_local_map, key, accept_default);
1853 if (! NILP (value) && !INTEGERP (value))
1854 goto done;
1856 else
1858 Lisp_Object keymap, local_map;
1859 EMACS_INT pt;
1861 pt = INTEGERP (position) ? XINT (position)
1862 : MARKERP (position) ? marker_position (position)
1863 : PT;
1865 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1866 keymap = get_local_map (pt, current_buffer, Qkeymap);
1868 if (CONSP (position))
1870 Lisp_Object string;
1872 /* For a mouse click, get the local text-property keymap
1873 of the place clicked on, rather than point. */
1875 if (POSN_INBUFFER_P (position))
1877 Lisp_Object pos;
1879 pos = POSN_BUFFER_POSN (position);
1880 if (INTEGERP (pos)
1881 && XINT (pos) >= BEG && XINT (pos) <= Z)
1883 local_map = get_local_map (XINT (pos),
1884 current_buffer, Qlocal_map);
1886 keymap = get_local_map (XINT (pos),
1887 current_buffer, Qkeymap);
1891 /* If on a mode line string with a local keymap,
1892 or for a click on a string, i.e. overlay string or a
1893 string displayed via the `display' property,
1894 consider `local-map' and `keymap' properties of
1895 that string. */
1897 if (string = POSN_STRING (position),
1898 (CONSP (string) && STRINGP (XCAR (string))))
1900 Lisp_Object pos, map;
1902 pos = XCDR (string);
1903 string = XCAR (string);
1904 if (INTEGERP (pos)
1905 && XINT (pos) >= 0
1906 && XINT (pos) < SCHARS (string))
1908 map = Fget_text_property (pos, Qlocal_map, string);
1909 if (!NILP (map))
1910 local_map = map;
1912 map = Fget_text_property (pos, Qkeymap, string);
1913 if (!NILP (map))
1914 keymap = map;
1920 if (! NILP (keymap))
1922 value = Flookup_key (keymap, key, accept_default);
1923 if (! NILP (value) && !INTEGERP (value))
1924 goto done;
1927 nmaps = current_minor_maps (0, &maps);
1928 /* Note that all these maps are GCPRO'd
1929 in the places where we found them. */
1931 for (i = 0; i < nmaps; i++)
1932 if (! NILP (maps[i]))
1934 value = Flookup_key (maps[i], key, accept_default);
1935 if (! NILP (value) && !INTEGERP (value))
1936 goto done;
1939 if (! NILP (local_map))
1941 value = Flookup_key (local_map, key, accept_default);
1942 if (! NILP (value) && !INTEGERP (value))
1943 goto done;
1947 value = Flookup_key (current_global_map, key, accept_default);
1949 done:
1950 unbind_to (count, Qnil);
1952 UNGCPRO;
1953 if (NILP (value) || INTEGERP (value))
1954 return Qnil;
1956 /* If the result of the ordinary keymap lookup is an interactive
1957 command, look for a key binding (ie. remapping) for that command. */
1959 if (NILP (no_remap) && SYMBOLP (value))
1961 Lisp_Object value1;
1962 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1963 value = value1;
1966 return value;
1969 /* GC is possible in this function if it autoloads a keymap. */
1971 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1972 doc: /* Return the binding for command KEYS in current local keymap only.
1973 KEYS is a string or vector, a sequence of keystrokes.
1974 The binding is probably a symbol with a function definition.
1976 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1977 bindings; see the description of `lookup-key' for more details about this. */)
1978 (keys, accept_default)
1979 Lisp_Object keys, accept_default;
1981 register Lisp_Object map;
1982 map = current_buffer->keymap;
1983 if (NILP (map))
1984 return Qnil;
1985 return Flookup_key (map, keys, accept_default);
1988 /* GC is possible in this function if it autoloads a keymap. */
1990 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1991 doc: /* Return the binding for command KEYS in current global keymap only.
1992 KEYS is a string or vector, a sequence of keystrokes.
1993 The binding is probably a symbol with a function definition.
1994 This function's return values are the same as those of `lookup-key'
1995 \(which see).
1997 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1998 bindings; see the description of `lookup-key' for more details about this. */)
1999 (keys, accept_default)
2000 Lisp_Object keys, accept_default;
2002 return Flookup_key (current_global_map, keys, accept_default);
2005 /* GC is possible in this function if it autoloads a keymap. */
2007 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
2008 doc: /* Find the visible minor mode bindings of KEY.
2009 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
2010 the symbol which names the minor mode binding KEY, and BINDING is
2011 KEY's definition in that mode. In particular, if KEY has no
2012 minor-mode bindings, return nil. If the first binding is a
2013 non-prefix, all subsequent bindings will be omitted, since they would
2014 be ignored. Similarly, the list doesn't include non-prefix bindings
2015 that come after prefix bindings.
2017 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
2018 bindings; see the description of `lookup-key' for more details about this. */)
2019 (key, accept_default)
2020 Lisp_Object key, accept_default;
2022 Lisp_Object *modes, *maps;
2023 int nmaps;
2024 Lisp_Object binding;
2025 int i, j;
2026 struct gcpro gcpro1, gcpro2;
2028 nmaps = current_minor_maps (&modes, &maps);
2029 /* Note that all these maps are GCPRO'd
2030 in the places where we found them. */
2032 binding = Qnil;
2033 GCPRO2 (key, binding);
2035 for (i = j = 0; i < nmaps; i++)
2036 if (!NILP (maps[i])
2037 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
2038 && !INTEGERP (binding))
2040 if (KEYMAPP (binding))
2041 maps[j++] = Fcons (modes[i], binding);
2042 else if (j == 0)
2043 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
2046 UNGCPRO;
2047 return Flist (j, maps);
2050 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
2051 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
2052 A new sparse keymap is stored as COMMAND's function definition and its value.
2053 If a second optional argument MAPVAR is given, the map is stored as
2054 its value instead of as COMMAND's value; but COMMAND is still defined
2055 as a function.
2056 The third optional argument NAME, if given, supplies a menu name
2057 string for the map. This is required to use the keymap as a menu.
2058 This function returns COMMAND. */)
2059 (command, mapvar, name)
2060 Lisp_Object command, mapvar, name;
2062 Lisp_Object map;
2063 map = Fmake_sparse_keymap (name);
2064 Ffset (command, map);
2065 if (!NILP (mapvar))
2066 Fset (mapvar, map);
2067 else
2068 Fset (command, map);
2069 return command;
2072 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
2073 doc: /* Select KEYMAP as the global keymap. */)
2074 (keymap)
2075 Lisp_Object keymap;
2077 keymap = get_keymap (keymap, 1, 1);
2078 current_global_map = keymap;
2080 return Qnil;
2083 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
2084 doc: /* Select KEYMAP as the local keymap.
2085 If KEYMAP is nil, that means no local keymap. */)
2086 (keymap)
2087 Lisp_Object keymap;
2089 if (!NILP (keymap))
2090 keymap = get_keymap (keymap, 1, 1);
2092 current_buffer->keymap = keymap;
2094 return Qnil;
2097 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
2098 doc: /* Return current buffer's local keymap, or nil if it has none.
2099 Normally the local keymap is set by the major mode with `use-local-map'. */)
2102 return current_buffer->keymap;
2105 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2106 doc: /* Return the current global keymap. */)
2109 return current_global_map;
2112 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2113 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2116 Lisp_Object *maps;
2117 int nmaps = current_minor_maps (0, &maps);
2119 return Flist (nmaps, maps);
2122 /* Help functions for describing and documenting keymaps. */
2124 struct accessible_keymaps_data {
2125 Lisp_Object maps, tail, thisseq;
2126 /* Does the current sequence end in the meta-prefix-char? */
2127 int is_metized;
2130 static void
2131 accessible_keymaps_1 (key, cmd, args, data)
2132 Lisp_Object key, cmd, args;
2133 /* Use void* to be compatible with map_keymap_function_t. */
2134 void *data;
2136 struct accessible_keymaps_data *d = data; /* Cast! */
2137 Lisp_Object maps = d->maps;
2138 Lisp_Object tail = d->tail;
2139 Lisp_Object thisseq = d->thisseq;
2140 int is_metized = d->is_metized && INTEGERP (key);
2141 Lisp_Object tem;
2143 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2144 if (NILP (cmd))
2145 return;
2147 /* Look for and break cycles. */
2148 while (!NILP (tem = Frassq (cmd, maps)))
2150 Lisp_Object prefix = XCAR (tem);
2151 int lim = XINT (Flength (XCAR (tem)));
2152 if (lim <= XINT (Flength (thisseq)))
2153 { /* This keymap was already seen with a smaller prefix. */
2154 int i = 0;
2155 while (i < lim && EQ (Faref (prefix, make_number (i)),
2156 Faref (thisseq, make_number (i))))
2157 i++;
2158 if (i >= lim)
2159 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2160 return;
2162 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2163 but maybe `cmd' occurs again further down in `maps', so keep
2164 looking. */
2165 maps = XCDR (Fmemq (tem, maps));
2168 /* If the last key in thisseq is meta-prefix-char,
2169 turn it into a meta-ized keystroke. We know
2170 that the event we're about to append is an
2171 ascii keystroke since we're processing a
2172 keymap table. */
2173 if (is_metized)
2175 int meta_bit = meta_modifier;
2176 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2177 tem = Fcopy_sequence (thisseq);
2179 Faset (tem, last, make_number (XINT (key) | meta_bit));
2181 /* This new sequence is the same length as
2182 thisseq, so stick it in the list right
2183 after this one. */
2184 XSETCDR (tail,
2185 Fcons (Fcons (tem, cmd), XCDR (tail)));
2187 else
2189 tem = append_key (thisseq, key);
2190 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2194 /* This function cannot GC. */
2196 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2197 1, 2, 0,
2198 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2199 Returns a list of elements of the form (KEYS . MAP), where the sequence
2200 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2201 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2202 An optional argument PREFIX, if non-nil, should be a key sequence;
2203 then the value includes only maps for prefixes that start with PREFIX. */)
2204 (keymap, prefix)
2205 Lisp_Object keymap, prefix;
2207 Lisp_Object maps, tail;
2208 int prefixlen = XINT (Flength (prefix));
2210 /* no need for gcpro because we don't autoload any keymaps. */
2212 if (!NILP (prefix))
2214 /* If a prefix was specified, start with the keymap (if any) for
2215 that prefix, so we don't waste time considering other prefixes. */
2216 Lisp_Object tem;
2217 tem = Flookup_key (keymap, prefix, Qt);
2218 /* Flookup_key may give us nil, or a number,
2219 if the prefix is not defined in this particular map.
2220 It might even give us a list that isn't a keymap. */
2221 tem = get_keymap (tem, 0, 0);
2222 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2223 want to return it. */
2224 if (!NILP (tem))
2226 /* Convert PREFIX to a vector now, so that later on
2227 we don't have to deal with the possibility of a string. */
2228 if (STRINGP (prefix))
2230 int i, i_byte, c;
2231 Lisp_Object copy;
2233 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2234 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2236 int i_before = i;
2238 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2239 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2240 c ^= 0200 | meta_modifier;
2241 ASET (copy, i_before, make_number (c));
2243 prefix = copy;
2245 maps = Fcons (Fcons (prefix, tem), Qnil);
2247 else
2248 return Qnil;
2250 else
2251 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2252 get_keymap (keymap, 1, 0)),
2253 Qnil);
2255 /* For each map in the list maps,
2256 look at any other maps it points to,
2257 and stick them at the end if they are not already in the list.
2259 This is a breadth-first traversal, where tail is the queue of
2260 nodes, and maps accumulates a list of all nodes visited. */
2262 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2264 struct accessible_keymaps_data data;
2265 register Lisp_Object thismap = Fcdr (XCAR (tail));
2266 Lisp_Object last;
2268 data.thisseq = Fcar (XCAR (tail));
2269 data.maps = maps;
2270 data.tail = tail;
2271 last = make_number (XINT (Flength (data.thisseq)) - 1);
2272 /* Does the current sequence end in the meta-prefix-char? */
2273 data.is_metized = (XINT (last) >= 0
2274 /* Don't metize the last char of PREFIX. */
2275 && XINT (last) >= prefixlen
2276 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2278 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2279 if (CONSP (thismap))
2280 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2282 return maps;
2284 Lisp_Object Qsingle_key_description, Qkey_description;
2286 /* This function cannot GC. */
2288 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2289 doc: /* Return a pretty description of key-sequence KEYS.
2290 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2291 Control characters turn into "C-foo" sequences, meta into "M-foo",
2292 spaces are put between sequence elements, etc. */)
2293 (keys, prefix)
2294 Lisp_Object keys, prefix;
2296 int len = 0;
2297 int i, i_byte;
2298 Lisp_Object *args;
2299 int size = XINT (Flength (keys));
2300 Lisp_Object list;
2301 Lisp_Object sep = build_string (" ");
2302 Lisp_Object key;
2303 int add_meta = 0;
2305 if (!NILP (prefix))
2306 size += XINT (Flength (prefix));
2308 /* This has one extra element at the end that we don't pass to Fconcat. */
2309 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2311 /* In effect, this computes
2312 (mapconcat 'single-key-description keys " ")
2313 but we shouldn't use mapconcat because it can do GC. */
2315 next_list:
2316 if (!NILP (prefix))
2317 list = prefix, prefix = Qnil;
2318 else if (!NILP (keys))
2319 list = keys, keys = Qnil;
2320 else
2322 if (add_meta)
2324 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2325 len += 2;
2327 else if (len == 0)
2328 return empty_unibyte_string;
2329 return Fconcat (len - 1, args);
2332 if (STRINGP (list))
2333 size = SCHARS (list);
2334 else if (VECTORP (list))
2335 size = XVECTOR (list)->size;
2336 else if (CONSP (list))
2337 size = XINT (Flength (list));
2338 else
2339 wrong_type_argument (Qarrayp, list);
2341 i = i_byte = 0;
2343 while (i < size)
2345 if (STRINGP (list))
2347 int c;
2348 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2349 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2350 c ^= 0200 | meta_modifier;
2351 XSETFASTINT (key, c);
2353 else if (VECTORP (list))
2355 key = AREF (list, i); i++;
2357 else
2359 key = XCAR (list);
2360 list = XCDR (list);
2361 i++;
2364 if (add_meta)
2366 if (!INTEGERP (key)
2367 || EQ (key, meta_prefix_char)
2368 || (XINT (key) & meta_modifier))
2370 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2371 args[len++] = sep;
2372 if (EQ (key, meta_prefix_char))
2373 continue;
2375 else
2376 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2377 add_meta = 0;
2379 else if (EQ (key, meta_prefix_char))
2381 add_meta = 1;
2382 continue;
2384 args[len++] = Fsingle_key_description (key, Qnil);
2385 args[len++] = sep;
2387 goto next_list;
2391 char *
2392 push_key_description (c, p, force_multibyte)
2393 register unsigned int c;
2394 register char *p;
2395 int force_multibyte;
2397 unsigned c2;
2399 /* Clear all the meaningless bits above the meta bit. */
2400 c &= meta_modifier | ~ - meta_modifier;
2401 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2402 | meta_modifier | shift_modifier | super_modifier);
2404 if (! CHARACTERP (make_number (c2)))
2406 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2407 p += sprintf (p, "[%d]", c);
2408 return p;
2411 if (c & alt_modifier)
2413 *p++ = 'A';
2414 *p++ = '-';
2415 c -= alt_modifier;
2417 if ((c & ctrl_modifier) != 0
2418 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2420 *p++ = 'C';
2421 *p++ = '-';
2422 c &= ~ctrl_modifier;
2424 if (c & hyper_modifier)
2426 *p++ = 'H';
2427 *p++ = '-';
2428 c -= hyper_modifier;
2430 if (c & meta_modifier)
2432 *p++ = 'M';
2433 *p++ = '-';
2434 c -= meta_modifier;
2436 if (c & shift_modifier)
2438 *p++ = 'S';
2439 *p++ = '-';
2440 c -= shift_modifier;
2442 if (c & super_modifier)
2444 *p++ = 's';
2445 *p++ = '-';
2446 c -= super_modifier;
2448 if (c < 040)
2450 if (c == 033)
2452 *p++ = 'E';
2453 *p++ = 'S';
2454 *p++ = 'C';
2456 else if (c == '\t')
2458 *p++ = 'T';
2459 *p++ = 'A';
2460 *p++ = 'B';
2462 else if (c == Ctl ('M'))
2464 *p++ = 'R';
2465 *p++ = 'E';
2466 *p++ = 'T';
2468 else
2470 /* `C-' already added above. */
2471 if (c > 0 && c <= Ctl ('Z'))
2472 *p++ = c + 0140;
2473 else
2474 *p++ = c + 0100;
2477 else if (c == 0177)
2479 *p++ = 'D';
2480 *p++ = 'E';
2481 *p++ = 'L';
2483 else if (c == ' ')
2485 *p++ = 'S';
2486 *p++ = 'P';
2487 *p++ = 'C';
2489 else if (c < 128
2490 || (NILP (current_buffer->enable_multibyte_characters)
2491 && SINGLE_BYTE_CHAR_P (c)
2492 && !force_multibyte))
2494 *p++ = c;
2496 else
2498 /* Now we are sure that C is a valid character code. */
2499 if (NILP (current_buffer->enable_multibyte_characters)
2500 && ! force_multibyte)
2501 *p++ = multibyte_char_to_unibyte (c, Qnil);
2502 else
2503 p += CHAR_STRING (c, (unsigned char *) p);
2506 return p;
2509 /* This function cannot GC. */
2511 DEFUN ("single-key-description", Fsingle_key_description,
2512 Ssingle_key_description, 1, 2, 0,
2513 doc: /* Return a pretty description of command character KEY.
2514 Control characters turn into C-whatever, etc.
2515 Optional argument NO-ANGLES non-nil means don't put angle brackets
2516 around function keys and event symbols. */)
2517 (key, no_angles)
2518 Lisp_Object key, no_angles;
2520 if (CONSP (key) && lucid_event_type_list_p (key))
2521 key = Fevent_convert_list (key);
2523 key = EVENT_HEAD (key);
2525 if (INTEGERP (key)) /* Normal character */
2527 char tem[KEY_DESCRIPTION_SIZE];
2529 *push_key_description (XUINT (key), tem, 1) = 0;
2530 return build_string (tem);
2532 else if (SYMBOLP (key)) /* Function key or event-symbol */
2534 if (NILP (no_angles))
2536 char *buffer
2537 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2538 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2539 return build_string (buffer);
2541 else
2542 return Fsymbol_name (key);
2544 else if (STRINGP (key)) /* Buffer names in the menubar. */
2545 return Fcopy_sequence (key);
2546 else
2547 error ("KEY must be an integer, cons, symbol, or string");
2548 return Qnil;
2551 char *
2552 push_text_char_description (c, p)
2553 register unsigned int c;
2554 register char *p;
2556 if (c >= 0200)
2558 *p++ = 'M';
2559 *p++ = '-';
2560 c -= 0200;
2562 if (c < 040)
2564 *p++ = '^';
2565 *p++ = c + 64; /* 'A' - 1 */
2567 else if (c == 0177)
2569 *p++ = '^';
2570 *p++ = '?';
2572 else
2573 *p++ = c;
2574 return p;
2577 /* This function cannot GC. */
2579 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2580 doc: /* Return a pretty description of file-character CHARACTER.
2581 Control characters turn into "^char", etc. This differs from
2582 `single-key-description' which turns them into "C-char".
2583 Also, this function recognizes the 2**7 bit as the Meta character,
2584 whereas `single-key-description' uses the 2**27 bit for Meta.
2585 See Info node `(elisp)Describing Characters' for examples. */)
2586 (character)
2587 Lisp_Object character;
2589 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2590 unsigned char str[6];
2591 int c;
2593 CHECK_NUMBER (character);
2595 c = XINT (character);
2596 if (!ASCII_CHAR_P (c))
2598 int len = CHAR_STRING (c, str);
2600 return make_multibyte_string (str, 1, len);
2603 *push_text_char_description (c & 0377, str) = 0;
2605 return build_string (str);
2608 static int where_is_preferred_modifier;
2610 /* Return 0 if SEQ uses non-preferred modifiers or non-char events.
2611 Else, return 2 if SEQ uses the where_is_preferred_modifier,
2612 and 1 otherwise. */
2613 static int
2614 preferred_sequence_p (seq)
2615 Lisp_Object seq;
2617 int i;
2618 int len = XINT (Flength (seq));
2619 int result = 1;
2621 for (i = 0; i < len; i++)
2623 Lisp_Object ii, elt;
2625 XSETFASTINT (ii, i);
2626 elt = Faref (seq, ii);
2628 if (!INTEGERP (elt))
2629 return 0;
2630 else
2632 int modifiers = XUINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
2633 if (modifiers == where_is_preferred_modifier)
2634 result = 2;
2635 else if (modifiers)
2636 return 0;
2640 return result;
2644 /* where-is - finding a command in a set of keymaps. */
2646 static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
2647 Lisp_Object args, void *data));
2649 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2650 Returns the first non-nil binding found in any of those maps.
2651 If REMAP is true, pass the result of the lookup through command
2652 remapping before returning it. */
2654 static Lisp_Object
2655 shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag,
2656 int remap)
2658 Lisp_Object tail, value;
2660 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2662 value = Flookup_key (XCAR (tail), key, flag);
2663 if (NATNUMP (value))
2665 value = Flookup_key (XCAR (tail),
2666 Fsubstring (key, make_number (0), value), flag);
2667 if (!NILP (value))
2668 return Qnil;
2670 else if (!NILP (value))
2672 Lisp_Object remapping;
2673 if (remap && SYMBOLP (value)
2674 && (remapping = Fcommand_remapping (value, Qnil, shadow),
2675 !NILP (remapping)))
2676 return remapping;
2677 else
2678 return value;
2681 return Qnil;
2684 static Lisp_Object Vmouse_events;
2686 struct where_is_internal_data {
2687 Lisp_Object definition, this, last;
2688 int last_is_meta, noindirect;
2689 Lisp_Object sequences;
2692 /* This function can't GC, AFAIK. */
2693 /* Return the list of bindings found. This list is ordered "longest
2694 to shortest". It may include bindings that are actually shadowed
2695 by others, as well as duplicate bindings and remapping bindings.
2696 The list returned is potentially shared with where_is_cache, so
2697 be careful not to modify it via side-effects. */
2699 static Lisp_Object
2700 where_is_internal (Lisp_Object definition, Lisp_Object keymaps,
2701 int noindirect, int nomenus)
2703 Lisp_Object maps = Qnil;
2704 Lisp_Object found;
2705 struct where_is_internal_data data;
2707 /* Only important use of caching is for the menubar
2708 (i.e. where-is-internal called with (def nil t nil nil)). */
2709 if (nomenus && !noindirect)
2711 /* Check heuristic-consistency of the cache. */
2712 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2713 where_is_cache = Qnil;
2715 if (NILP (where_is_cache))
2717 /* We need to create the cache. */
2718 Lisp_Object args[2];
2719 where_is_cache = Fmake_hash_table (0, args);
2720 where_is_cache_keymaps = Qt;
2722 else
2723 /* We can reuse the cache. */
2724 return Fgethash (definition, where_is_cache, Qnil);
2726 else
2727 /* Kill the cache so that where_is_internal_1 doesn't think
2728 we're filling it up. */
2729 where_is_cache = Qnil;
2731 found = keymaps;
2732 while (CONSP (found))
2734 maps =
2735 nconc2 (maps,
2736 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2737 found = XCDR (found);
2740 data.sequences = Qnil;
2741 for (; CONSP (maps); maps = XCDR (maps))
2743 /* Key sequence to reach map, and the map that it reaches */
2744 register Lisp_Object this, map, tem;
2746 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2747 [M-CHAR] sequences, check if last character of the sequence
2748 is the meta-prefix char. */
2749 Lisp_Object last;
2750 int last_is_meta;
2752 this = Fcar (XCAR (maps));
2753 map = Fcdr (XCAR (maps));
2754 last = make_number (XINT (Flength (this)) - 1);
2755 last_is_meta = (XINT (last) >= 0
2756 && EQ (Faref (this, last), meta_prefix_char));
2758 /* if (nomenus && !preferred_sequence_p (this)) */
2759 if (nomenus && XINT (last) >= 0
2760 && SYMBOLP (tem = Faref (this, make_number (0)))
2761 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2762 /* If no menu entries should be returned, skip over the
2763 keymaps bound to `menu-bar' and `tool-bar' and other
2764 non-ascii prefixes like `C-down-mouse-2'. */
2765 continue;
2767 QUIT;
2769 data.definition = definition;
2770 data.noindirect = noindirect;
2771 data.this = this;
2772 data.last = last;
2773 data.last_is_meta = last_is_meta;
2775 if (CONSP (map))
2776 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2779 if (nomenus && !noindirect)
2780 { /* Remember for which keymaps this cache was built.
2781 We do it here (late) because we want to keep where_is_cache_keymaps
2782 set to t while the cache isn't fully filled. */
2783 where_is_cache_keymaps = keymaps;
2784 /* During cache-filling, data.sequences is not filled by
2785 where_is_internal_1. */
2786 return Fgethash (definition, where_is_cache, Qnil);
2788 else
2789 return data.sequences;
2792 static Lisp_Object Vwhere_is_preferred_modifier;
2794 /* This function can GC if Flookup_key autoloads any keymaps. */
2796 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2797 doc: /* Return list of keys that invoke DEFINITION.
2798 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2799 If KEYMAP is nil, search all the currently active keymaps.
2800 If KEYMAP is a list of keymaps, search only those keymaps.
2802 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2803 rather than a list of all possible key sequences.
2804 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2805 no matter what it is.
2806 If FIRSTONLY has another non-nil value, prefer bindings
2807 that use the modifier key specified in `where-is-preferred-modifier'
2808 \(or their meta variants) and entirely reject menu bindings.
2810 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2811 to other keymaps or slots. This makes it possible to search for an
2812 indirect definition itself.
2814 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2815 that invoke a command which is remapped to DEFINITION, but include the
2816 remapped command in the returned list. */)
2817 (definition, keymap, firstonly, noindirect, no_remap)
2818 Lisp_Object definition, keymap;
2819 Lisp_Object firstonly, noindirect, no_remap;
2821 /* The keymaps in which to search. */
2822 Lisp_Object keymaps;
2823 /* Potentially relevant bindings in "shortest to longest" order. */
2824 Lisp_Object sequences = Qnil;
2825 /* Actually relevant bindings. */
2826 Lisp_Object found = Qnil;
2827 /* 1 means ignore all menu bindings entirely. */
2828 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2829 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
2830 /* List of sequences found via remapping. Keep them in a separate
2831 variable, so as to push them later, since we prefer
2832 non-remapped binding. */
2833 Lisp_Object remapped_sequences = Qnil;
2834 /* Whether or not we're handling remapped sequences. This is needed
2835 because remapping is not done recursively by Fcommand_remapping: you
2836 can't remap a remapped command. */
2837 int remapped = 0;
2838 Lisp_Object tem = Qnil;
2840 /* Refresh the C version of the modifier preference. */
2841 where_is_preferred_modifier
2842 = parse_solitary_modifier (Vwhere_is_preferred_modifier);
2844 /* Find the relevant keymaps. */
2845 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2846 keymaps = keymap;
2847 else if (!NILP (keymap))
2848 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2849 else
2850 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2852 GCPRO6 (definition, keymaps, found, sequences, remapped_sequences, tem);
2854 tem = Fcommand_remapping (definition, Qnil, keymaps);
2855 /* If `definition' is remapped to tem', then OT1H no key will run
2856 that command (since they will run `tem' instead), so we should
2857 return nil; but OTOH all keys bound to `definition' (or to `tem')
2858 will run the same command.
2859 So for menu-shortcut purposes, we want to find all the keys bound (maybe
2860 via remapping) to `tem'. But for the purpose of finding the keys that
2861 run `definition', then we'd want to just return nil.
2862 We choose to make it work right for menu-shortcuts, since it's the most
2863 common use.
2864 Known bugs: if you remap switch-to-buffer to toto, C-h f switch-to-buffer
2865 will tell you that switch-to-buffer is bound to C-x b even though C-x b
2866 will run toto instead. And if `toto' is itself remapped to forward-char,
2867 then C-h f toto will tell you that it's bound to C-f even though C-f does
2868 not run toto and it won't tell you that C-x b does run toto. */
2869 if (NILP (no_remap) && !NILP (tem))
2870 definition = tem;
2872 if (SYMBOLP (definition)
2873 && !NILP (firstonly)
2874 && !NILP (tem = Fget (definition, QCadvertised_binding)))
2876 /* We have a list of advertized bindings. */
2877 while (CONSP (tem))
2878 if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
2879 return XCAR (tem);
2880 else
2881 tem = XCDR (tem);
2882 if (EQ (shadow_lookup (keymaps, tem, Qnil, 0), definition))
2883 return tem;
2886 sequences = Freverse (where_is_internal (definition, keymaps,
2887 !NILP (noindirect), nomenus));
2889 while (CONSP (sequences)
2890 /* If we're at the end of the `sequences' list and we haven't
2891 considered remapped sequences yet, copy them over and
2892 process them. */
2893 || (!remapped && (sequences = remapped_sequences,
2894 remapped = 1),
2895 CONSP (sequences)))
2897 Lisp_Object sequence, function;
2899 sequence = XCAR (sequences);
2900 sequences = XCDR (sequences);
2902 /* Verify that this key binding is not shadowed by another
2903 binding for the same key, before we say it exists.
2905 Mechanism: look for local definition of this key and if
2906 it is defined and does not match what we found then
2907 ignore this key.
2909 Either nil or number as value from Flookup_key
2910 means undefined. */
2911 if (NILP (Fequal (shadow_lookup (keymaps, sequence, Qnil, remapped),
2912 definition)))
2913 continue;
2915 /* If the current sequence is a command remapping with
2916 format [remap COMMAND], find the key sequences
2917 which run COMMAND, and use those sequences instead. */
2918 if (NILP (no_remap) && !remapped
2919 && VECTORP (sequence) && ASIZE (sequence) == 2
2920 && EQ (AREF (sequence, 0), Qremap)
2921 && (function = AREF (sequence, 1), SYMBOLP (function)))
2923 Lisp_Object seqs = where_is_internal (function, keymaps,
2924 !NILP (noindirect), nomenus);
2925 remapped_sequences = nconc2 (Freverse (seqs), remapped_sequences);
2926 continue;
2929 /* Don't annoy user with strings from a menu such as the
2930 entries from the "Edit => Paste from Kill Menu".
2931 Change them all to "(any string)", so that there
2932 seems to be only one menu item to report. */
2933 if (! NILP (sequence))
2935 Lisp_Object tem;
2936 tem = Faref (sequence, make_number (ASIZE (sequence) - 1));
2937 if (STRINGP (tem))
2938 Faset (sequence, make_number (ASIZE (sequence) - 1),
2939 build_string ("(any string)"));
2942 /* It is a true unshadowed match. Record it, unless it's already
2943 been seen (as could happen when inheriting keymaps). */
2944 if (NILP (Fmember (sequence, found)))
2945 found = Fcons (sequence, found);
2947 /* If firstonly is Qnon_ascii, then we can return the first
2948 binding we find. If firstonly is not Qnon_ascii but not
2949 nil, then we should return the first ascii-only binding
2950 we find. */
2951 if (EQ (firstonly, Qnon_ascii))
2952 RETURN_UNGCPRO (sequence);
2953 else if (!NILP (firstonly)
2954 && 2 == preferred_sequence_p (sequence))
2955 RETURN_UNGCPRO (sequence);
2958 UNGCPRO;
2960 found = Fnreverse (found);
2962 /* firstonly may have been t, but we may have gone all the way through
2963 the keymaps without finding an all-ASCII key sequence. So just
2964 return the best we could find. */
2965 if (NILP (firstonly))
2966 return found;
2967 else if (where_is_preferred_modifier == 0)
2968 return Fcar (found);
2969 else
2970 { /* Maybe we did not find a preferred_modifier binding, but we did find
2971 some ASCII binding. */
2972 Lisp_Object bindings = found;
2973 while (CONSP (bindings))
2974 if (preferred_sequence_p (XCAR (bindings)))
2975 return XCAR (bindings);
2976 else
2977 bindings = XCDR (bindings);
2978 return Fcar (found);
2982 /* This function can GC because get_keyelt can. */
2984 static void
2985 where_is_internal_1 (key, binding, args, data)
2986 Lisp_Object key, binding, args;
2987 void *data;
2989 struct where_is_internal_data *d = data; /* Cast! */
2990 Lisp_Object definition = d->definition;
2991 int noindirect = d->noindirect;
2992 Lisp_Object this = d->this;
2993 Lisp_Object last = d->last;
2994 int last_is_meta = d->last_is_meta;
2995 Lisp_Object sequence;
2997 /* Search through indirections unless that's not wanted. */
2998 if (!noindirect)
2999 binding = get_keyelt (binding, 0);
3001 /* End this iteration if this element does not match
3002 the target. */
3004 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
3005 || EQ (binding, definition)
3006 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
3007 /* Doesn't match. */
3008 return;
3010 /* We have found a match. Construct the key sequence where we found it. */
3011 if (INTEGERP (key) && last_is_meta)
3013 sequence = Fcopy_sequence (this);
3014 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
3016 else
3018 if (CONSP (key))
3019 key = Fcons (XCAR (key), XCDR (key));
3020 sequence = append_key (this, key);
3023 if (!NILP (where_is_cache))
3025 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
3026 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
3028 else
3029 d->sequences = Fcons (sequence, d->sequences);
3032 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
3034 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
3035 doc: /* Insert the list of all defined keys and their definitions.
3036 The list is inserted in the current buffer, while the bindings are
3037 looked up in BUFFER.
3038 The optional argument PREFIX, if non-nil, should be a key sequence;
3039 then we display only bindings that start with that prefix.
3040 The optional argument MENUS, if non-nil, says to mention menu bindings.
3041 \(Ordinarily these are omitted from the output.) */)
3042 (buffer, prefix, menus)
3043 Lisp_Object buffer, prefix, menus;
3045 Lisp_Object outbuf, shadow;
3046 int nomenu = NILP (menus);
3047 register Lisp_Object start1;
3048 struct gcpro gcpro1;
3050 char *alternate_heading
3051 = "\
3052 Keyboard translations:\n\n\
3053 You type Translation\n\
3054 -------- -----------\n";
3056 CHECK_BUFFER (buffer);
3058 shadow = Qnil;
3059 GCPRO1 (shadow);
3061 outbuf = Fcurrent_buffer ();
3063 /* Report on alternates for keys. */
3064 if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix))
3066 int c;
3067 const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table);
3068 int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table);
3070 for (c = 0; c < translate_len; c++)
3071 if (translate[c] != c)
3073 char buf[KEY_DESCRIPTION_SIZE];
3074 char *bufend;
3076 if (alternate_heading)
3078 insert_string (alternate_heading);
3079 alternate_heading = 0;
3082 bufend = push_key_description (translate[c], buf, 1);
3083 insert (buf, bufend - buf);
3084 Findent_to (make_number (16), make_number (1));
3085 bufend = push_key_description (c, buf, 1);
3086 insert (buf, bufend - buf);
3088 insert ("\n", 1);
3090 /* Insert calls signal_after_change which may GC. */
3091 translate = SDATA (current_kboard->Vkeyboard_translate_table);
3094 insert ("\n", 1);
3097 if (!NILP (Vkey_translation_map))
3098 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3099 "Key translations", nomenu, 1, 0, 0);
3102 /* Print the (major mode) local map. */
3103 start1 = Qnil;
3104 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3105 start1 = current_kboard->Voverriding_terminal_local_map;
3106 else if (!NILP (Voverriding_local_map))
3107 start1 = Voverriding_local_map;
3109 if (!NILP (start1))
3111 describe_map_tree (start1, 1, shadow, prefix,
3112 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3113 shadow = Fcons (start1, shadow);
3115 else
3117 /* Print the minor mode and major mode keymaps. */
3118 int i, nmaps;
3119 Lisp_Object *modes, *maps;
3121 /* Temporarily switch to `buffer', so that we can get that buffer's
3122 minor modes correctly. */
3123 Fset_buffer (buffer);
3125 nmaps = current_minor_maps (&modes, &maps);
3126 Fset_buffer (outbuf);
3128 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3129 XBUFFER (buffer), Qkeymap);
3130 if (!NILP (start1))
3132 describe_map_tree (start1, 1, shadow, prefix,
3133 "\f\n`keymap' Property Bindings", nomenu,
3134 0, 0, 0);
3135 shadow = Fcons (start1, shadow);
3138 /* Print the minor mode maps. */
3139 for (i = 0; i < nmaps; i++)
3141 /* The title for a minor mode keymap
3142 is constructed at run time.
3143 We let describe_map_tree do the actual insertion
3144 because it takes care of other features when doing so. */
3145 char *title, *p;
3147 if (!SYMBOLP (modes[i]))
3148 abort ();
3150 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3151 *p++ = '\f';
3152 *p++ = '\n';
3153 *p++ = '`';
3154 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3155 SCHARS (SYMBOL_NAME (modes[i])));
3156 p += SCHARS (SYMBOL_NAME (modes[i]));
3157 *p++ = '\'';
3158 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3159 p += sizeof (" Minor Mode Bindings") - 1;
3160 *p = 0;
3162 describe_map_tree (maps[i], 1, shadow, prefix,
3163 title, nomenu, 0, 0, 0);
3164 shadow = Fcons (maps[i], shadow);
3167 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3168 XBUFFER (buffer), Qlocal_map);
3169 if (!NILP (start1))
3171 if (EQ (start1, XBUFFER (buffer)->keymap))
3172 describe_map_tree (start1, 1, shadow, prefix,
3173 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3174 else
3175 describe_map_tree (start1, 1, shadow, prefix,
3176 "\f\n`local-map' Property Bindings",
3177 nomenu, 0, 0, 0);
3179 shadow = Fcons (start1, shadow);
3183 describe_map_tree (current_global_map, 1, shadow, prefix,
3184 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3186 /* Print the function-key-map translations under this prefix. */
3187 if (!NILP (current_kboard->Vlocal_function_key_map))
3188 describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix,
3189 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3191 /* Print the input-decode-map translations under this prefix. */
3192 if (!NILP (current_kboard->Vinput_decode_map))
3193 describe_map_tree (current_kboard->Vinput_decode_map, 0, Qnil, prefix,
3194 "\f\nInput decoding map translations", nomenu, 1, 0, 0);
3196 UNGCPRO;
3197 return Qnil;
3200 /* Insert a description of the key bindings in STARTMAP,
3201 followed by those of all maps reachable through STARTMAP.
3202 If PARTIAL is nonzero, omit certain "uninteresting" commands
3203 (such as `undefined').
3204 If SHADOW is non-nil, it is a list of maps;
3205 don't mention keys which would be shadowed by any of them.
3206 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3207 TITLE, if not 0, is a string to insert at the beginning.
3208 TITLE should not end with a colon or a newline; we supply that.
3209 If NOMENU is not 0, then omit menu-bar commands.
3211 If TRANSL is nonzero, the definitions are actually key translations
3212 so print strings and vectors differently.
3214 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3215 to look through.
3217 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3218 don't omit it; instead, mention it but say it is shadowed. */
3220 void
3221 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3222 always_title, mention_shadow)
3223 Lisp_Object startmap, shadow, prefix;
3224 int partial;
3225 char *title;
3226 int nomenu;
3227 int transl;
3228 int always_title;
3229 int mention_shadow;
3231 Lisp_Object maps, orig_maps, seen, sub_shadows;
3232 struct gcpro gcpro1, gcpro2, gcpro3;
3233 int something = 0;
3234 char *key_heading
3235 = "\
3236 key binding\n\
3237 --- -------\n";
3239 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3240 seen = Qnil;
3241 sub_shadows = Qnil;
3242 GCPRO3 (maps, seen, sub_shadows);
3244 if (nomenu)
3246 Lisp_Object list;
3248 /* Delete from MAPS each element that is for the menu bar. */
3249 for (list = maps; CONSP (list); list = XCDR (list))
3251 Lisp_Object elt, prefix, tem;
3253 elt = XCAR (list);
3254 prefix = Fcar (elt);
3255 if (XVECTOR (prefix)->size >= 1)
3257 tem = Faref (prefix, make_number (0));
3258 if (EQ (tem, Qmenu_bar))
3259 maps = Fdelq (elt, maps);
3264 if (!NILP (maps) || always_title)
3266 if (title)
3268 insert_string (title);
3269 if (!NILP (prefix))
3271 insert_string (" Starting With ");
3272 insert1 (Fkey_description (prefix, Qnil));
3274 insert_string (":\n");
3276 insert_string (key_heading);
3277 something = 1;
3280 for (; CONSP (maps); maps = XCDR (maps))
3282 register Lisp_Object elt, prefix, tail;
3284 elt = XCAR (maps);
3285 prefix = Fcar (elt);
3287 sub_shadows = Qnil;
3289 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3291 Lisp_Object shmap;
3293 shmap = XCAR (tail);
3295 /* If the sequence by which we reach this keymap is zero-length,
3296 then the shadow map for this keymap is just SHADOW. */
3297 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3298 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3300 /* If the sequence by which we reach this keymap actually has
3301 some elements, then the sequence's definition in SHADOW is
3302 what we should use. */
3303 else
3305 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3306 if (INTEGERP (shmap))
3307 shmap = Qnil;
3310 /* If shmap is not nil and not a keymap,
3311 it completely shadows this map, so don't
3312 describe this map at all. */
3313 if (!NILP (shmap) && !KEYMAPP (shmap))
3314 goto skip;
3316 if (!NILP (shmap))
3317 sub_shadows = Fcons (shmap, sub_shadows);
3320 /* Maps we have already listed in this loop shadow this map. */
3321 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3323 Lisp_Object tem;
3324 tem = Fequal (Fcar (XCAR (tail)), prefix);
3325 if (!NILP (tem))
3326 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3329 describe_map (Fcdr (elt), prefix,
3330 transl ? describe_translation : describe_command,
3331 partial, sub_shadows, &seen, nomenu, mention_shadow);
3333 skip: ;
3336 if (something)
3337 insert_string ("\n");
3339 UNGCPRO;
3342 static int previous_description_column;
3344 static void
3345 describe_command (definition, args)
3346 Lisp_Object definition, args;
3348 register Lisp_Object tem1;
3349 int column = (int) current_column (); /* iftc */
3350 int description_column;
3352 /* If column 16 is no good, go to col 32;
3353 but don't push beyond that--go to next line instead. */
3354 if (column > 30)
3356 insert_char ('\n');
3357 description_column = 32;
3359 else if (column > 14 || (column > 10 && previous_description_column == 32))
3360 description_column = 32;
3361 else
3362 description_column = 16;
3364 Findent_to (make_number (description_column), make_number (1));
3365 previous_description_column = description_column;
3367 if (SYMBOLP (definition))
3369 tem1 = SYMBOL_NAME (definition);
3370 insert1 (tem1);
3371 insert_string ("\n");
3373 else if (STRINGP (definition) || VECTORP (definition))
3374 insert_string ("Keyboard Macro\n");
3375 else if (KEYMAPP (definition))
3376 insert_string ("Prefix Command\n");
3377 else
3378 insert_string ("??\n");
3381 static void
3382 describe_translation (definition, args)
3383 Lisp_Object definition, args;
3385 register Lisp_Object tem1;
3387 Findent_to (make_number (16), make_number (1));
3389 if (SYMBOLP (definition))
3391 tem1 = SYMBOL_NAME (definition);
3392 insert1 (tem1);
3393 insert_string ("\n");
3395 else if (STRINGP (definition) || VECTORP (definition))
3397 insert1 (Fkey_description (definition, Qnil));
3398 insert_string ("\n");
3400 else if (KEYMAPP (definition))
3401 insert_string ("Prefix Command\n");
3402 else
3403 insert_string ("??\n");
3406 /* describe_map puts all the usable elements of a sparse keymap
3407 into an array of `struct describe_map_elt',
3408 then sorts them by the events. */
3410 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3412 /* qsort comparison function for sorting `struct describe_map_elt' by
3413 the event field. */
3415 static int
3416 describe_map_compare (aa, bb)
3417 const void *aa, *bb;
3419 const struct describe_map_elt *a = aa, *b = bb;
3420 if (INTEGERP (a->event) && INTEGERP (b->event))
3421 return ((XINT (a->event) > XINT (b->event))
3422 - (XINT (a->event) < XINT (b->event)));
3423 if (!INTEGERP (a->event) && INTEGERP (b->event))
3424 return 1;
3425 if (INTEGERP (a->event) && !INTEGERP (b->event))
3426 return -1;
3427 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3428 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3429 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3430 : 0);
3431 return 0;
3434 /* Describe the contents of map MAP, assuming that this map itself is
3435 reached by the sequence of prefix keys PREFIX (a string or vector).
3436 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3438 static void
3439 describe_map (map, prefix, elt_describer, partial, shadow,
3440 seen, nomenu, mention_shadow)
3441 register Lisp_Object map;
3442 Lisp_Object prefix;
3443 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3444 int partial;
3445 Lisp_Object shadow;
3446 Lisp_Object *seen;
3447 int nomenu;
3448 int mention_shadow;
3450 Lisp_Object tail, definition, event;
3451 Lisp_Object tem;
3452 Lisp_Object suppress;
3453 Lisp_Object kludge;
3454 int first = 1;
3455 struct gcpro gcpro1, gcpro2, gcpro3;
3457 /* These accumulate the values from sparse keymap bindings,
3458 so we can sort them and handle them in order. */
3459 int length_needed = 0;
3460 struct describe_map_elt *vect;
3461 int slots_used = 0;
3462 int i;
3464 suppress = Qnil;
3466 if (partial)
3467 suppress = intern ("suppress-keymap");
3469 /* This vector gets used to present single keys to Flookup_key. Since
3470 that is done once per keymap element, we don't want to cons up a
3471 fresh vector every time. */
3472 kludge = Fmake_vector (make_number (1), Qnil);
3473 definition = Qnil;
3475 GCPRO3 (prefix, definition, kludge);
3477 map = call1 (Qkeymap_canonicalize, map);
3479 for (tail = map; CONSP (tail); tail = XCDR (tail))
3480 length_needed++;
3482 vect = ((struct describe_map_elt *)
3483 alloca (sizeof (struct describe_map_elt) * length_needed));
3485 for (tail = map; CONSP (tail); tail = XCDR (tail))
3487 QUIT;
3489 if (VECTORP (XCAR (tail))
3490 || CHAR_TABLE_P (XCAR (tail)))
3491 describe_vector (XCAR (tail),
3492 prefix, Qnil, elt_describer, partial, shadow, map,
3493 (int *)0, 0, 1, mention_shadow);
3494 else if (CONSP (XCAR (tail)))
3496 int this_shadowed = 0;
3498 event = XCAR (XCAR (tail));
3500 /* Ignore bindings whose "prefix" are not really valid events.
3501 (We get these in the frames and buffers menu.) */
3502 if (!(SYMBOLP (event) || INTEGERP (event)))
3503 continue;
3505 if (nomenu && EQ (event, Qmenu_bar))
3506 continue;
3508 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3510 /* Don't show undefined commands or suppressed commands. */
3511 if (NILP (definition)) continue;
3512 if (SYMBOLP (definition) && partial)
3514 tem = Fget (definition, suppress);
3515 if (!NILP (tem))
3516 continue;
3519 /* Don't show a command that isn't really visible
3520 because a local definition of the same key shadows it. */
3522 ASET (kludge, 0, event);
3523 if (!NILP (shadow))
3525 tem = shadow_lookup (shadow, kludge, Qt, 0);
3526 if (!NILP (tem))
3528 /* If both bindings are keymaps, this key is a prefix key,
3529 so don't say it is shadowed. */
3530 if (KEYMAPP (definition) && KEYMAPP (tem))
3532 /* Avoid generating duplicate entries if the
3533 shadowed binding has the same definition. */
3534 else if (mention_shadow && !EQ (tem, definition))
3535 this_shadowed = 1;
3536 else
3537 continue;
3541 tem = Flookup_key (map, kludge, Qt);
3542 if (!EQ (tem, definition)) continue;
3544 vect[slots_used].event = event;
3545 vect[slots_used].definition = definition;
3546 vect[slots_used].shadowed = this_shadowed;
3547 slots_used++;
3549 else if (EQ (XCAR (tail), Qkeymap))
3551 /* The same keymap might be in the structure twice, if we're
3552 using an inherited keymap. So skip anything we've already
3553 encountered. */
3554 tem = Fassq (tail, *seen);
3555 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3556 break;
3557 *seen = Fcons (Fcons (tail, prefix), *seen);
3561 /* If we found some sparse map events, sort them. */
3563 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3564 describe_map_compare);
3566 /* Now output them in sorted order. */
3568 for (i = 0; i < slots_used; i++)
3570 Lisp_Object start, end;
3572 if (first)
3574 previous_description_column = 0;
3575 insert ("\n", 1);
3576 first = 0;
3579 ASET (kludge, 0, vect[i].event);
3580 start = vect[i].event;
3581 end = start;
3583 definition = vect[i].definition;
3585 /* Find consecutive chars that are identically defined. */
3586 if (INTEGERP (vect[i].event))
3588 while (i + 1 < slots_used
3589 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3590 && !NILP (Fequal (vect[i + 1].definition, definition))
3591 && vect[i].shadowed == vect[i + 1].shadowed)
3592 i++;
3593 end = vect[i].event;
3596 /* Now START .. END is the range to describe next. */
3598 /* Insert the string to describe the event START. */
3599 insert1 (Fkey_description (kludge, prefix));
3601 if (!EQ (start, end))
3603 insert (" .. ", 4);
3605 ASET (kludge, 0, end);
3606 /* Insert the string to describe the character END. */
3607 insert1 (Fkey_description (kludge, prefix));
3610 /* Print a description of the definition of this character.
3611 elt_describer will take care of spacing out far enough
3612 for alignment purposes. */
3613 (*elt_describer) (vect[i].definition, Qnil);
3615 if (vect[i].shadowed)
3617 SET_PT (PT - 1);
3618 insert_string ("\n (that binding is currently shadowed by another mode)");
3619 SET_PT (PT + 1);
3623 UNGCPRO;
3626 static void
3627 describe_vector_princ (elt, fun)
3628 Lisp_Object elt, fun;
3630 Findent_to (make_number (16), make_number (1));
3631 call1 (fun, elt);
3632 Fterpri (Qnil);
3635 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3636 doc: /* Insert a description of contents of VECTOR.
3637 This is text showing the elements of vector matched against indices.
3638 DESCRIBER is the output function used; nil means use `princ'. */)
3639 (vector, describer)
3640 Lisp_Object vector, describer;
3642 int count = SPECPDL_INDEX ();
3643 if (NILP (describer))
3644 describer = intern ("princ");
3645 specbind (Qstandard_output, Fcurrent_buffer ());
3646 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3647 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3648 Qnil, Qnil, (int *)0, 0, 0, 0);
3650 return unbind_to (count, Qnil);
3653 /* Insert in the current buffer a description of the contents of VECTOR.
3654 We call ELT_DESCRIBER to insert the description of one value found
3655 in VECTOR.
3657 ELT_PREFIX describes what "comes before" the keys or indices defined
3658 by this vector. This is a human-readable string whose size
3659 is not necessarily related to the situation.
3661 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3662 leads to this keymap.
3664 If the vector is a chartable, ELT_PREFIX is the vector
3665 of bytes that lead to the character set or portion of a character
3666 set described by this chartable.
3668 If PARTIAL is nonzero, it means do not mention suppressed commands
3669 (that assumes the vector is in a keymap).
3671 SHADOW is a list of keymaps that shadow this map.
3672 If it is non-nil, then we look up the key in those maps
3673 and we don't mention it now if it is defined by any of them.
3675 ENTIRE_MAP is the keymap in which this vector appears.
3676 If the definition in effect in the whole map does not match
3677 the one in this vector, we ignore this one.
3679 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3681 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3682 the near future.
3684 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3686 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3688 static void
3689 describe_vector (vector, prefix, args, elt_describer,
3690 partial, shadow, entire_map,
3691 indices, char_table_depth, keymap_p,
3692 mention_shadow)
3693 register Lisp_Object vector;
3694 Lisp_Object prefix, args;
3695 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3696 int partial;
3697 Lisp_Object shadow;
3698 Lisp_Object entire_map;
3699 int *indices;
3700 int char_table_depth;
3701 int keymap_p;
3702 int mention_shadow;
3704 Lisp_Object definition;
3705 Lisp_Object tem2;
3706 Lisp_Object elt_prefix = Qnil;
3707 int i;
3708 Lisp_Object suppress;
3709 Lisp_Object kludge;
3710 int first = 1;
3711 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3712 /* Range of elements to be handled. */
3713 int from, to, stop;
3714 Lisp_Object character;
3715 int starting_i;
3717 suppress = Qnil;
3719 definition = Qnil;
3721 if (!keymap_p)
3723 /* Call Fkey_description first, to avoid GC bug for the other string. */
3724 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3726 Lisp_Object tem;
3727 tem = Fkey_description (prefix, Qnil);
3728 elt_prefix = concat2 (tem, build_string (" "));
3730 prefix = Qnil;
3733 /* This vector gets used to present single keys to Flookup_key. Since
3734 that is done once per vector element, we don't want to cons up a
3735 fresh vector every time. */
3736 kludge = Fmake_vector (make_number (1), Qnil);
3737 GCPRO4 (elt_prefix, prefix, definition, kludge);
3739 if (partial)
3740 suppress = intern ("suppress-keymap");
3742 from = 0;
3743 if (CHAR_TABLE_P (vector))
3744 stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1;
3745 else
3746 stop = to = XVECTOR (vector)->size;
3748 for (i = from; ; i++)
3750 int this_shadowed = 0;
3751 int range_beg, range_end;
3752 Lisp_Object val;
3754 QUIT;
3756 if (i == stop)
3758 if (i == to)
3759 break;
3760 stop = to;
3763 starting_i = i;
3765 if (CHAR_TABLE_P (vector))
3767 range_beg = i;
3768 i = stop - 1;
3769 val = char_table_ref_and_range (vector, range_beg, &range_beg, &i);
3771 else
3772 val = AREF (vector, i);
3773 definition = get_keyelt (val, 0);
3775 if (NILP (definition)) continue;
3777 /* Don't mention suppressed commands. */
3778 if (SYMBOLP (definition) && partial)
3780 Lisp_Object tem;
3782 tem = Fget (definition, suppress);
3784 if (!NILP (tem)) continue;
3787 character = make_number (starting_i);
3788 ASET (kludge, 0, character);
3790 /* If this binding is shadowed by some other map, ignore it. */
3791 if (!NILP (shadow))
3793 Lisp_Object tem;
3795 tem = shadow_lookup (shadow, kludge, Qt, 0);
3797 if (!NILP (tem))
3799 if (mention_shadow)
3800 this_shadowed = 1;
3801 else
3802 continue;
3806 /* Ignore this definition if it is shadowed by an earlier
3807 one in the same keymap. */
3808 if (!NILP (entire_map))
3810 Lisp_Object tem;
3812 tem = Flookup_key (entire_map, kludge, Qt);
3814 if (!EQ (tem, definition))
3815 continue;
3818 if (first)
3820 insert ("\n", 1);
3821 first = 0;
3824 /* Output the prefix that applies to every entry in this map. */
3825 if (!NILP (elt_prefix))
3826 insert1 (elt_prefix);
3828 insert1 (Fkey_description (kludge, prefix));
3830 /* Find all consecutive characters or rows that have the same
3831 definition. But, VECTOR is a char-table, we had better put a
3832 boundary between normal characters (-#x3FFF7F) and 8-bit
3833 characters (#x3FFF80-). */
3834 if (CHAR_TABLE_P (vector))
3836 while (i + 1 < stop
3837 && (range_beg = i + 1, range_end = stop - 1,
3838 val = char_table_ref_and_range (vector, range_beg,
3839 &range_beg, &range_end),
3840 tem2 = get_keyelt (val, 0),
3841 !NILP (tem2))
3842 && !NILP (Fequal (tem2, definition)))
3843 i = range_end;
3845 else
3846 while (i + 1 < stop
3847 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3848 !NILP (tem2))
3849 && !NILP (Fequal (tem2, definition)))
3850 i++;
3852 /* If we have a range of more than one character,
3853 print where the range reaches to. */
3855 if (i != starting_i)
3857 insert (" .. ", 4);
3859 ASET (kludge, 0, make_number (i));
3861 if (!NILP (elt_prefix))
3862 insert1 (elt_prefix);
3864 insert1 (Fkey_description (kludge, prefix));
3867 /* Print a description of the definition of this character.
3868 elt_describer will take care of spacing out far enough
3869 for alignment purposes. */
3870 (*elt_describer) (definition, args);
3872 if (this_shadowed)
3874 SET_PT (PT - 1);
3875 insert_string (" (binding currently shadowed)");
3876 SET_PT (PT + 1);
3880 if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
3882 if (!NILP (elt_prefix))
3883 insert1 (elt_prefix);
3884 insert ("default", 7);
3885 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3888 UNGCPRO;
3891 /* Apropos - finding all symbols whose names match a regexp. */
3892 static Lisp_Object apropos_predicate;
3893 static Lisp_Object apropos_accumulate;
3895 static void
3896 apropos_accum (symbol, string)
3897 Lisp_Object symbol, string;
3899 register Lisp_Object tem;
3901 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3902 if (!NILP (tem) && !NILP (apropos_predicate))
3903 tem = call1 (apropos_predicate, symbol);
3904 if (!NILP (tem))
3905 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3908 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3909 doc: /* Show all symbols whose names contain match for REGEXP.
3910 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3911 for each symbol and a symbol is mentioned only if that returns non-nil.
3912 Return list of symbols found. */)
3913 (regexp, predicate)
3914 Lisp_Object regexp, predicate;
3916 Lisp_Object tem;
3917 CHECK_STRING (regexp);
3918 apropos_predicate = predicate;
3919 apropos_accumulate = Qnil;
3920 map_obarray (Vobarray, apropos_accum, regexp);
3921 tem = Fsort (apropos_accumulate, Qstring_lessp);
3922 apropos_accumulate = Qnil;
3923 apropos_predicate = Qnil;
3924 return tem;
3927 void
3928 syms_of_keymap ()
3930 Qkeymap = intern_c_string ("keymap");
3931 staticpro (&Qkeymap);
3932 staticpro (&apropos_predicate);
3933 staticpro (&apropos_accumulate);
3934 apropos_predicate = Qnil;
3935 apropos_accumulate = Qnil;
3937 Qkeymap_canonicalize = intern_c_string ("keymap-canonicalize");
3938 staticpro (&Qkeymap_canonicalize);
3940 /* Now we are ready to set up this property, so we can
3941 create char tables. */
3942 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3944 /* Initialize the keymaps standardly used.
3945 Each one is the value of a Lisp variable, and is also
3946 pointed to by a C variable */
3948 global_map = Fmake_keymap (Qnil);
3949 Fset (intern_c_string ("global-map"), global_map);
3951 current_global_map = global_map;
3952 staticpro (&global_map);
3953 staticpro (&current_global_map);
3955 meta_map = Fmake_keymap (Qnil);
3956 Fset (intern_c_string ("esc-map"), meta_map);
3957 Ffset (intern_c_string ("ESC-prefix"), meta_map);
3959 control_x_map = Fmake_keymap (Qnil);
3960 Fset (intern_c_string ("ctl-x-map"), control_x_map);
3961 Ffset (intern_c_string ("Control-X-prefix"), control_x_map);
3963 exclude_keys
3964 = pure_cons (pure_cons (make_pure_c_string ("DEL"), make_pure_c_string ("\\d")),
3965 pure_cons (pure_cons (make_pure_c_string ("TAB"), make_pure_c_string ("\\t")),
3966 pure_cons (pure_cons (make_pure_c_string ("RET"), make_pure_c_string ("\\r")),
3967 pure_cons (pure_cons (make_pure_c_string ("ESC"), make_pure_c_string ("\\e")),
3968 pure_cons (pure_cons (make_pure_c_string ("SPC"), make_pure_c_string (" ")),
3969 Qnil)))));
3970 staticpro (&exclude_keys);
3972 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3973 doc: /* List of commands given new key bindings recently.
3974 This is used for internal purposes during Emacs startup;
3975 don't alter it yourself. */);
3976 Vdefine_key_rebound_commands = Qt;
3978 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3979 doc: /* Default keymap to use when reading from the minibuffer. */);
3980 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3982 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3983 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
3984 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3985 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3987 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3988 doc: /* Local keymap for minibuffer input with completion. */);
3989 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3990 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
3992 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
3993 &Vminibuffer_local_filename_completion_map,
3994 doc: /* Local keymap for minibuffer input with completion for filenames. */);
3995 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
3996 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
3997 Vminibuffer_local_completion_map);
4000 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
4001 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
4002 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
4003 Fset_keymap_parent (Vminibuffer_local_must_match_map,
4004 Vminibuffer_local_completion_map);
4006 DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
4007 &Vminibuffer_local_filename_must_match_map,
4008 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
4009 Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
4010 Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
4011 Vminibuffer_local_must_match_map);
4013 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4014 doc: /* Alist of keymaps to use for minor modes.
4015 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4016 key sequences and look up bindings if VARIABLE's value is non-nil.
4017 If two active keymaps bind the same key, the keymap appearing earlier
4018 in the list takes precedence. */);
4019 Vminor_mode_map_alist = Qnil;
4021 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4022 doc: /* Alist of keymaps to use for minor modes, in current major mode.
4023 This variable is an alist just like `minor-mode-map-alist', and it is
4024 used the same way (and before `minor-mode-map-alist'); however,
4025 it is provided for major modes to bind locally. */);
4026 Vminor_mode_overriding_map_alist = Qnil;
4028 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4029 doc: /* List of keymap alists to use for emulations modes.
4030 It is intended for modes or packages using multiple minor-mode keymaps.
4031 Each element is a keymap alist just like `minor-mode-map-alist', or a
4032 symbol with a variable binding which is a keymap alist, and it is used
4033 the same way. The "active" keymaps in each alist are used before
4034 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
4035 Vemulation_mode_map_alists = Qnil;
4037 DEFVAR_LISP ("where-is-preferred-modifier", &Vwhere_is_preferred_modifier,
4038 doc: /* Preferred modifier to use for `where-is'.
4039 When a single binding is requested, `where-is' will return one that
4040 uses this modifier if possible. If nil, or if no such binding exists,
4041 bindings using keys without modifiers (or only with meta) will be
4042 preferred. */);
4043 Vwhere_is_preferred_modifier = Qnil;
4044 where_is_preferred_modifier = 0;
4046 staticpro (&Vmouse_events);
4047 Vmouse_events = pure_cons (intern_c_string ("menu-bar"),
4048 pure_cons (intern_c_string ("tool-bar"),
4049 pure_cons (intern_c_string ("header-line"),
4050 pure_cons (intern_c_string ("mode-line"),
4051 pure_cons (intern_c_string ("mouse-1"),
4052 pure_cons (intern_c_string ("mouse-2"),
4053 pure_cons (intern_c_string ("mouse-3"),
4054 pure_cons (intern_c_string ("mouse-4"),
4055 pure_cons (intern_c_string ("mouse-5"),
4056 Qnil)))))))));
4059 Qsingle_key_description = intern_c_string ("single-key-description");
4060 staticpro (&Qsingle_key_description);
4062 Qkey_description = intern_c_string ("key-description");
4063 staticpro (&Qkey_description);
4065 Qkeymapp = intern_c_string ("keymapp");
4066 staticpro (&Qkeymapp);
4068 Qnon_ascii = intern_c_string ("non-ascii");
4069 staticpro (&Qnon_ascii);
4071 Qmenu_item = intern_c_string ("menu-item");
4072 staticpro (&Qmenu_item);
4074 Qremap = intern_c_string ("remap");
4075 staticpro (&Qremap);
4077 QCadvertised_binding = intern_c_string (":advertised-binding");
4078 staticpro (&QCadvertised_binding);
4080 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4081 staticpro (&command_remapping_vector);
4083 where_is_cache_keymaps = Qt;
4084 where_is_cache = Qnil;
4085 staticpro (&where_is_cache);
4086 staticpro (&where_is_cache_keymaps);
4088 defsubr (&Skeymapp);
4089 defsubr (&Skeymap_parent);
4090 defsubr (&Skeymap_prompt);
4091 defsubr (&Sset_keymap_parent);
4092 defsubr (&Smake_keymap);
4093 defsubr (&Smake_sparse_keymap);
4094 defsubr (&Smap_keymap_internal);
4095 defsubr (&Smap_keymap);
4096 defsubr (&Scopy_keymap);
4097 defsubr (&Scommand_remapping);
4098 defsubr (&Skey_binding);
4099 defsubr (&Slocal_key_binding);
4100 defsubr (&Sglobal_key_binding);
4101 defsubr (&Sminor_mode_key_binding);
4102 defsubr (&Sdefine_key);
4103 defsubr (&Slookup_key);
4104 defsubr (&Sdefine_prefix_command);
4105 defsubr (&Suse_global_map);
4106 defsubr (&Suse_local_map);
4107 defsubr (&Scurrent_local_map);
4108 defsubr (&Scurrent_global_map);
4109 defsubr (&Scurrent_minor_mode_maps);
4110 defsubr (&Scurrent_active_maps);
4111 defsubr (&Saccessible_keymaps);
4112 defsubr (&Skey_description);
4113 defsubr (&Sdescribe_vector);
4114 defsubr (&Ssingle_key_description);
4115 defsubr (&Stext_char_description);
4116 defsubr (&Swhere_is_internal);
4117 defsubr (&Sdescribe_buffer_bindings);
4118 defsubr (&Sapropos_internal);
4121 void
4122 keys_of_keymap ()
4124 initial_define_key (global_map, 033, "ESC-prefix");
4125 initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
4128 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4129 (do not change this comment) */