(ns_get_color): Remove incompatible color formats.
[emacs.git] / src / keymap.c
blob02e93675548df19bdbcdbce347ac91397f47813e
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 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 #if HAVE_ALLOCA_H
25 # include <alloca.h>
26 #endif
27 #include "lisp.h"
28 #include "commands.h"
29 #include "buffer.h"
30 #include "character.h"
31 #include "charset.h"
32 #include "keyboard.h"
33 #include "frame.h"
34 #include "termhooks.h"
35 #include "blockinput.h"
36 #include "puresize.h"
37 #include "intervals.h"
38 #include "keymap.h"
39 #include "window.h"
41 /* The number of elements in keymap vectors. */
42 #define DENSE_TABLE_SIZE (0200)
44 /* Actually allocate storage for these variables */
46 Lisp_Object current_global_map; /* Current global keymap */
48 Lisp_Object global_map; /* default global key bindings */
50 Lisp_Object meta_map; /* The keymap used for globally bound
51 ESC-prefixed default commands */
53 Lisp_Object control_x_map; /* The keymap used for globally bound
54 C-x-prefixed default commands */
56 /* was MinibufLocalMap */
57 Lisp_Object Vminibuffer_local_map;
58 /* The keymap used by the minibuf for local
59 bindings when spaces are allowed in the
60 minibuf */
62 /* was MinibufLocalNSMap */
63 Lisp_Object Vminibuffer_local_ns_map;
64 /* The keymap used by the minibuf for local
65 bindings when spaces are not encouraged
66 in the minibuf */
68 /* keymap used for minibuffers when doing completion */
69 /* was MinibufLocalCompletionMap */
70 Lisp_Object Vminibuffer_local_completion_map;
72 /* keymap used for minibuffers when doing completion in filenames */
73 Lisp_Object Vminibuffer_local_filename_completion_map;
75 /* keymap used for minibuffers when doing completion in filenames
76 with require-match*/
77 Lisp_Object Vminibuffer_local_filename_must_match_map;
79 /* keymap used for minibuffers when doing completion and require a match */
80 /* was MinibufLocalMustMatchMap */
81 Lisp_Object Vminibuffer_local_must_match_map;
83 /* Alist of minor mode variables and keymaps. */
84 Lisp_Object Vminor_mode_map_alist;
86 /* Alist of major-mode-specific overrides for
87 minor mode variables and keymaps. */
88 Lisp_Object Vminor_mode_overriding_map_alist;
90 /* List of emulation mode keymap alists. */
91 Lisp_Object Vemulation_mode_map_alists;
93 /* A list of all commands given new bindings since a certain time
94 when nil was stored here.
95 This is used to speed up recomputation of menu key equivalents
96 when Emacs starts up. t means don't record anything here. */
97 Lisp_Object Vdefine_key_rebound_commands;
99 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
101 /* Alist of elements like (DEL . "\d"). */
102 static Lisp_Object exclude_keys;
104 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
105 static Lisp_Object command_remapping_vector;
107 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
108 in a string key sequence is equivalent to prefixing with this
109 character. */
110 extern Lisp_Object meta_prefix_char;
112 extern Lisp_Object Voverriding_local_map;
114 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
115 static Lisp_Object where_is_cache;
116 /* Which keymaps are reverse-stored in the cache. */
117 static Lisp_Object where_is_cache_keymaps;
119 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
120 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
122 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
123 static void describe_command P_ ((Lisp_Object, Lisp_Object));
124 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
125 static void describe_map P_ ((Lisp_Object, Lisp_Object,
126 void (*) P_ ((Lisp_Object, Lisp_Object)),
127 int, Lisp_Object, Lisp_Object*, int, int));
128 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
129 void (*) (Lisp_Object, Lisp_Object), int,
130 Lisp_Object, Lisp_Object, int *,
131 int, int, int));
132 static void silly_event_symbol_error P_ ((Lisp_Object));
134 /* Keymap object support - constructors and predicates. */
136 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
137 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
138 CHARTABLE is a char-table that holds the bindings for all characters
139 without modifiers. All entries in it are initially nil, meaning
140 "command undefined". ALIST is an assoc-list which holds bindings for
141 function keys, mouse events, and any other things that appear in the
142 input stream. Initially, ALIST is nil.
144 The optional arg STRING supplies a menu name for the keymap
145 in case you use it as a menu with `x-popup-menu'. */)
146 (string)
147 Lisp_Object string;
149 Lisp_Object tail;
150 if (!NILP (string))
151 tail = Fcons (string, Qnil);
152 else
153 tail = Qnil;
154 return Fcons (Qkeymap,
155 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
158 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
159 doc: /* Construct and return a new sparse keymap.
160 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
161 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
162 which binds the function key or mouse event SYMBOL to DEFINITION.
163 Initially the alist is nil.
165 The optional arg STRING supplies a menu name for the keymap
166 in case you use it as a menu with `x-popup-menu'. */)
167 (string)
168 Lisp_Object string;
170 if (!NILP (string))
171 return Fcons (Qkeymap, Fcons (string, Qnil));
172 return Fcons (Qkeymap, Qnil);
175 /* This function is used for installing the standard key bindings
176 at initialization time.
178 For example:
180 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
182 void
183 initial_define_key (keymap, key, defname)
184 Lisp_Object keymap;
185 int key;
186 char *defname;
188 store_in_keymap (keymap, make_number (key), intern (defname));
191 void
192 initial_define_lispy_key (keymap, keyname, defname)
193 Lisp_Object keymap;
194 char *keyname;
195 char *defname;
197 store_in_keymap (keymap, intern (keyname), intern (defname));
200 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
201 doc: /* Return t if OBJECT is a keymap.
203 A keymap is a list (keymap . ALIST),
204 or a symbol whose function definition is itself a keymap.
205 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
206 a vector of densely packed bindings for small character codes
207 is also allowed as an element. */)
208 (object)
209 Lisp_Object object;
211 return (KEYMAPP (object) ? Qt : Qnil);
214 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
215 doc: /* Return the prompt-string of a keymap MAP.
216 If non-nil, the prompt is shown in the echo-area
217 when reading a key-sequence to be looked-up in this keymap. */)
218 (map)
219 Lisp_Object map;
221 map = get_keymap (map, 0, 0);
222 while (CONSP (map))
224 Lisp_Object tem = XCAR (map);
225 if (STRINGP (tem))
226 return tem;
227 map = XCDR (map);
229 return Qnil;
232 /* Check that OBJECT is a keymap (after dereferencing through any
233 symbols). If it is, return it.
235 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
236 is an autoload form, do the autoload and try again.
237 If AUTOLOAD is nonzero, callers must assume GC is possible.
239 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
240 is zero as well), return Qt.
242 ERROR controls how we respond if OBJECT isn't a keymap.
243 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
245 Note that most of the time, we don't want to pursue autoloads.
246 Functions like Faccessible_keymaps which scan entire keymap trees
247 shouldn't load every autoloaded keymap. I'm not sure about this,
248 but it seems to me that only read_key_sequence, Flookup_key, and
249 Fdefine_key should cause keymaps to be autoloaded.
251 This function can GC when AUTOLOAD is non-zero, because it calls
252 do_autoload which can GC. */
254 Lisp_Object
255 get_keymap (object, error, autoload)
256 Lisp_Object object;
257 int error, autoload;
259 Lisp_Object tem;
261 autoload_retry:
262 if (NILP (object))
263 goto end;
264 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
265 return object;
267 tem = indirect_function (object);
268 if (CONSP (tem))
270 if (EQ (XCAR (tem), Qkeymap))
271 return tem;
273 /* Should we do an autoload? Autoload forms for keymaps have
274 Qkeymap as their fifth element. */
275 if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
276 && SYMBOLP (object))
278 Lisp_Object tail;
280 tail = Fnth (make_number (4), tem);
281 if (EQ (tail, Qkeymap))
283 if (autoload)
285 struct gcpro gcpro1, gcpro2;
287 GCPRO2 (tem, object);
288 do_autoload (tem, object);
289 UNGCPRO;
291 goto autoload_retry;
293 else
294 return Qt;
299 end:
300 if (error)
301 wrong_type_argument (Qkeymapp, object);
302 return Qnil;
305 /* Return the parent map of KEYMAP, or nil if it has none.
306 We assume that KEYMAP is a valid keymap. */
308 Lisp_Object
309 keymap_parent (keymap, autoload)
310 Lisp_Object keymap;
311 int autoload;
313 Lisp_Object list;
315 keymap = get_keymap (keymap, 1, autoload);
317 /* Skip past the initial element `keymap'. */
318 list = XCDR (keymap);
319 for (; CONSP (list); list = XCDR (list))
321 /* See if there is another `keymap'. */
322 if (KEYMAPP (list))
323 return list;
326 return get_keymap (list, 0, autoload);
329 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
330 doc: /* Return the parent keymap of KEYMAP.
331 If KEYMAP has no parent, return nil. */)
332 (keymap)
333 Lisp_Object keymap;
335 return keymap_parent (keymap, 1);
338 /* Check whether MAP is one of MAPS parents. */
340 keymap_memberp (map, maps)
341 Lisp_Object map, maps;
343 if (NILP (map)) return 0;
344 while (KEYMAPP (maps) && !EQ (map, maps))
345 maps = keymap_parent (maps, 0);
346 return (EQ (map, maps));
349 /* Set the parent keymap of MAP to PARENT. */
351 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
352 doc: /* Modify KEYMAP to set its parent map to PARENT.
353 Return PARENT. PARENT should be nil or another keymap. */)
354 (keymap, parent)
355 Lisp_Object keymap, parent;
357 Lisp_Object list, prev;
358 struct gcpro gcpro1, gcpro2;
359 int i;
361 /* Force a keymap flush for the next call to where-is.
362 Since this can be called from within where-is, we don't set where_is_cache
363 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
364 be changed during where-is, while where_is_cache_keymaps is only used at
365 the very beginning of where-is and can thus be changed here without any
366 adverse effect.
367 This is a very minor correctness (rather than safety) issue. */
368 where_is_cache_keymaps = Qt;
370 GCPRO2 (keymap, parent);
371 keymap = get_keymap (keymap, 1, 1);
373 if (!NILP (parent))
375 parent = get_keymap (parent, 1, 1);
377 /* Check for cycles. */
378 if (keymap_memberp (keymap, parent))
379 error ("Cyclic keymap inheritance");
382 /* Skip past the initial element `keymap'. */
383 prev = keymap;
384 while (1)
386 list = XCDR (prev);
387 /* If there is a parent keymap here, replace it.
388 If we came to the end, add the parent in PREV. */
389 if (!CONSP (list) || KEYMAPP (list))
391 /* If we already have the right parent, return now
392 so that we avoid the loops below. */
393 if (EQ (XCDR (prev), parent))
394 RETURN_UNGCPRO (parent);
396 CHECK_IMPURE (prev);
397 XSETCDR (prev, parent);
398 break;
400 prev = list;
403 /* Scan through for submaps, and set their parents too. */
405 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
407 /* Stop the scan when we come to the parent. */
408 if (EQ (XCAR (list), Qkeymap))
409 break;
411 /* If this element holds a prefix map, deal with it. */
412 if (CONSP (XCAR (list))
413 && CONSP (XCDR (XCAR (list))))
414 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
415 XCDR (XCAR (list)));
417 if (VECTORP (XCAR (list)))
418 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
419 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
420 fix_submap_inheritance (keymap, make_number (i),
421 XVECTOR (XCAR (list))->contents[i]);
423 if (CHAR_TABLE_P (XCAR (list)))
425 map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
429 RETURN_UNGCPRO (parent);
432 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
433 if EVENT is also a prefix in MAP's parent,
434 make sure that SUBMAP inherits that definition as its own parent. */
436 static void
437 fix_submap_inheritance (map, event, submap)
438 Lisp_Object map, event, submap;
440 Lisp_Object map_parent, parent_entry;
442 /* SUBMAP is a cons that we found as a key binding.
443 Discard the other things found in a menu key binding. */
445 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
447 /* If it isn't a keymap now, there's no work to do. */
448 if (!CONSP (submap))
449 return;
451 map_parent = keymap_parent (map, 0);
452 if (!NILP (map_parent))
453 parent_entry =
454 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
455 else
456 parent_entry = Qnil;
458 /* If MAP's parent has something other than a keymap,
459 our own submap shadows it completely. */
460 if (!CONSP (parent_entry))
461 return;
463 if (! EQ (parent_entry, submap))
465 Lisp_Object submap_parent;
466 submap_parent = submap;
467 while (1)
469 Lisp_Object tem;
471 tem = keymap_parent (submap_parent, 0);
473 if (KEYMAPP (tem))
475 if (keymap_memberp (tem, parent_entry))
476 /* Fset_keymap_parent could create a cycle. */
477 return;
478 submap_parent = tem;
480 else
481 break;
483 Fset_keymap_parent (submap_parent, parent_entry);
487 /* Look up IDX in MAP. IDX may be any sort of event.
488 Note that this does only one level of lookup; IDX must be a single
489 event, not a sequence.
491 If T_OK is non-zero, bindings for Qt are treated as default
492 bindings; any key left unmentioned by other tables and bindings is
493 given the binding of Qt.
495 If T_OK is zero, bindings for Qt are not treated specially.
497 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
499 Lisp_Object
500 access_keymap (map, idx, t_ok, noinherit, autoload)
501 Lisp_Object map;
502 Lisp_Object idx;
503 int t_ok;
504 int noinherit;
505 int autoload;
507 Lisp_Object val;
509 /* Qunbound in VAL means we have found no binding yet. */
510 val = Qunbound;
512 /* If idx is a list (some sort of mouse click, perhaps?),
513 the index we want to use is the car of the list, which
514 ought to be a symbol. */
515 idx = EVENT_HEAD (idx);
517 /* If idx is a symbol, it might have modifiers, which need to
518 be put in the canonical order. */
519 if (SYMBOLP (idx))
520 idx = reorder_modifiers (idx);
521 else if (INTEGERP (idx))
522 /* Clobber the high bits that can be present on a machine
523 with more than 24 bits of integer. */
524 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
526 /* Handle the special meta -> esc mapping. */
527 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
529 /* See if there is a meta-map. If there's none, there is
530 no binding for IDX, unless a default binding exists in MAP. */
531 struct gcpro gcpro1;
532 Lisp_Object meta_map;
533 GCPRO1 (map);
534 /* A strange value in which Meta is set would cause
535 infinite recursion. Protect against that. */
536 if (XINT (meta_prefix_char) & CHAR_META)
537 meta_prefix_char = make_number (27);
538 meta_map = get_keymap (access_keymap (map, meta_prefix_char,
539 t_ok, noinherit, autoload),
540 0, autoload);
541 UNGCPRO;
542 if (CONSP (meta_map))
544 map = meta_map;
545 idx = make_number (XUINT (idx) & ~meta_modifier);
547 else if (t_ok)
548 /* Set IDX to t, so that we only find a default binding. */
549 idx = Qt;
550 else
551 /* We know there is no binding. */
552 return Qnil;
555 /* t_binding is where we put a default binding that applies,
556 to use in case we do not find a binding specifically
557 for this key sequence. */
559 Lisp_Object tail;
560 Lisp_Object t_binding = Qnil;
561 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
563 GCPRO4 (map, tail, idx, t_binding);
565 for (tail = XCDR (map);
566 (CONSP (tail)
567 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
568 tail = XCDR (tail))
570 Lisp_Object binding;
572 binding = XCAR (tail);
573 if (SYMBOLP (binding))
575 /* If NOINHERIT, stop finding prefix definitions
576 after we pass a second occurrence of the `keymap' symbol. */
577 if (noinherit && EQ (binding, Qkeymap))
578 RETURN_UNGCPRO (Qnil);
580 else if (CONSP (binding))
582 Lisp_Object key = XCAR (binding);
584 if (EQ (key, idx))
585 val = XCDR (binding);
586 else if (t_ok && EQ (key, Qt))
588 t_binding = XCDR (binding);
589 t_ok = 0;
592 else if (VECTORP (binding))
594 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
595 val = AREF (binding, XFASTINT (idx));
597 else if (CHAR_TABLE_P (binding))
599 /* Character codes with modifiers
600 are not included in a char-table.
601 All character codes without modifiers are included. */
602 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
604 val = Faref (binding, idx);
605 /* `nil' has a special meaning for char-tables, so
606 we use something else to record an explicitly
607 unbound entry. */
608 if (NILP (val))
609 val = Qunbound;
613 /* If we found a binding, clean it up and return it. */
614 if (!EQ (val, Qunbound))
616 if (EQ (val, Qt))
617 /* A Qt binding is just like an explicit nil binding
618 (i.e. it shadows any parent binding but not bindings in
619 keymaps of lower precedence). */
620 val = Qnil;
621 val = get_keyelt (val, autoload);
622 if (KEYMAPP (val))
623 fix_submap_inheritance (map, idx, val);
624 RETURN_UNGCPRO (val);
626 QUIT;
628 UNGCPRO;
629 return get_keyelt (t_binding, autoload);
633 static void
634 map_keymap_item (fun, args, key, val, data)
635 map_keymap_function_t fun;
636 Lisp_Object args, key, val;
637 void *data;
639 /* We should maybe try to detect bindings shadowed by previous
640 ones and things like that. */
641 if (EQ (val, Qt))
642 val = Qnil;
643 (*fun) (key, val, args, data);
646 static void
647 map_keymap_char_table_item (args, key, val)
648 Lisp_Object args, key, val;
650 if (!NILP (val))
652 map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
653 args = XCDR (args);
654 /* If the key is a range, make a copy since map_char_table modifies
655 it in place. */
656 if (CONSP (key))
657 key = Fcons (XCAR (key), XCDR (key));
658 map_keymap_item (fun, XCDR (args), key, val,
659 XSAVE_VALUE (XCAR (args))->pointer);
663 /* Call FUN for every binding in MAP and stop at (and return) the parent.
664 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA). */
665 Lisp_Object
666 map_keymap_internal (Lisp_Object map,
667 map_keymap_function_t fun,
668 Lisp_Object args,
669 void *data)
671 struct gcpro gcpro1, gcpro2, gcpro3;
672 Lisp_Object tail
673 = (CONSP (map) && EQ (Qkeymap, XCAR (map))) ? XCDR (map) : map;
675 GCPRO3 (map, args, tail);
676 for (; CONSP (tail) && !EQ (Qkeymap, XCAR (tail)); tail = XCDR (tail))
678 Lisp_Object binding = XCAR (tail);
680 if (CONSP (binding))
681 map_keymap_item (fun, args, XCAR (binding), XCDR (binding), data);
682 else if (VECTORP (binding))
684 /* Loop over the char values represented in the vector. */
685 int len = ASIZE (binding);
686 int c;
687 for (c = 0; c < len; c++)
689 Lisp_Object character;
690 XSETFASTINT (character, c);
691 map_keymap_item (fun, args, character, AREF (binding, c), data);
694 else if (CHAR_TABLE_P (binding))
696 map_char_table (map_keymap_char_table_item, Qnil, binding,
697 Fcons (make_save_value (fun, 0),
698 Fcons (make_save_value (data, 0),
699 args)));
702 UNGCPRO;
703 return tail;
706 static void
707 map_keymap_call (key, val, fun, dummy)
708 Lisp_Object key, val, fun;
709 void *dummy;
711 call2 (fun, key, val);
714 /* Same as map_keymap_internal, but doesn't traverses parent keymaps as well.
715 A non-zero AUTOLOAD indicates that autoloaded keymaps should be loaded. */
716 void
717 map_keymap (map, fun, args, data, autoload)
718 map_keymap_function_t fun;
719 Lisp_Object map, args;
720 void *data;
721 int autoload;
723 struct gcpro gcpro1;
724 GCPRO1 (args);
725 map = get_keymap (map, 1, autoload);
726 while (CONSP (map))
728 map = map_keymap_internal (map, fun, args, data);
729 map = get_keymap (map, 0, autoload);
731 UNGCPRO;
734 Lisp_Object Qkeymap_canonicalize;
736 /* Same as map_keymap, but does it right, properly eliminating duplicate
737 bindings due to inheritance. */
738 void
739 map_keymap_canonical (map, fun, args, data)
740 map_keymap_function_t fun;
741 Lisp_Object map, args;
742 void *data;
744 struct gcpro gcpro1;
745 GCPRO1 (args);
746 /* map_keymap_canonical may be used from redisplay (e.g. when building menus)
747 so be careful to ignore errors and to inhibit redisplay. */
748 map = safe_call1 (Qkeymap_canonicalize, map);
749 /* No need to use `map_keymap' here because canonical map has no parent. */
750 map_keymap_internal (map, fun, args, data);
751 UNGCPRO;
754 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
755 doc: /* Call FUNCTION once for each event binding in KEYMAP.
756 FUNCTION is called with two arguments: the event that is bound, and
757 the definition it is bound to. The event may be a character range.
758 If KEYMAP has a parent, this function returns it without processing it. */)
759 (function, keymap)
760 Lisp_Object function, keymap;
762 struct gcpro gcpro1;
763 GCPRO1 (function);
764 keymap = get_keymap (keymap, 1, 1);
765 keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
766 UNGCPRO;
767 return keymap;
770 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
771 doc: /* Call FUNCTION once for each event binding in KEYMAP.
772 FUNCTION is called with two arguments: the event that is bound, and
773 the definition it is bound to. The event may be a character range.
775 If KEYMAP has a parent, the parent's bindings are included as well.
776 This works recursively: if the parent has itself a parent, then the
777 grandparent's bindings are also included and so on.
778 usage: (map-keymap FUNCTION KEYMAP) */)
779 (function, keymap, sort_first)
780 Lisp_Object function, keymap, sort_first;
782 if (! NILP (sort_first))
783 return call2 (intern ("map-keymap-sorted"), function, keymap);
785 map_keymap (keymap, map_keymap_call, function, NULL, 1);
786 return Qnil;
789 /* Given OBJECT which was found in a slot in a keymap,
790 trace indirect definitions to get the actual definition of that slot.
791 An indirect definition is a list of the form
792 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
793 and INDEX is the object to look up in KEYMAP to yield the definition.
795 Also if OBJECT has a menu string as the first element,
796 remove that. Also remove a menu help string as second element.
798 If AUTOLOAD is nonzero, load autoloadable keymaps
799 that are referred to with indirection.
801 This can GC because menu_item_eval_property calls Feval. */
803 Lisp_Object
804 get_keyelt (object, autoload)
805 Lisp_Object object;
806 int autoload;
808 while (1)
810 if (!(CONSP (object)))
811 /* This is really the value. */
812 return object;
814 /* If the keymap contents looks like (keymap ...) or (lambda ...)
815 then use itself. */
816 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
817 return object;
819 /* If the keymap contents looks like (menu-item name . DEFN)
820 or (menu-item name DEFN ...) then use DEFN.
821 This is a new format menu item. */
822 else if (EQ (XCAR (object), Qmenu_item))
824 if (CONSP (XCDR (object)))
826 Lisp_Object tem;
828 object = XCDR (XCDR (object));
829 tem = object;
830 if (CONSP (object))
831 object = XCAR (object);
833 /* If there's a `:filter FILTER', apply FILTER to the
834 menu-item's definition to get the real definition to
835 use. */
836 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
837 if (EQ (XCAR (tem), QCfilter) && autoload)
839 Lisp_Object filter;
840 filter = XCAR (XCDR (tem));
841 filter = list2 (filter, list2 (Qquote, object));
842 object = menu_item_eval_property (filter);
843 break;
846 else
847 /* Invalid keymap. */
848 return object;
851 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
852 Keymap alist elements like (CHAR MENUSTRING . DEFN)
853 will be used by HierarKey menus. */
854 else if (STRINGP (XCAR (object)))
856 object = XCDR (object);
857 /* Also remove a menu help string, if any,
858 following the menu item name. */
859 if (CONSP (object) && STRINGP (XCAR (object)))
860 object = XCDR (object);
861 /* Also remove the sublist that caches key equivalences, if any. */
862 if (CONSP (object) && CONSP (XCAR (object)))
864 Lisp_Object carcar;
865 carcar = XCAR (XCAR (object));
866 if (NILP (carcar) || VECTORP (carcar))
867 object = XCDR (object);
871 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
872 else
874 struct gcpro gcpro1;
875 Lisp_Object map;
876 GCPRO1 (object);
877 map = get_keymap (Fcar_safe (object), 0, autoload);
878 UNGCPRO;
879 return (!CONSP (map) ? object /* Invalid keymap */
880 : access_keymap (map, Fcdr (object), 0, 0, autoload));
885 static Lisp_Object
886 store_in_keymap (keymap, idx, def)
887 Lisp_Object keymap;
888 register Lisp_Object idx;
889 Lisp_Object def;
891 /* Flush any reverse-map cache. */
892 where_is_cache = Qnil;
893 where_is_cache_keymaps = Qt;
895 /* If we are preparing to dump, and DEF is a menu element
896 with a menu item indicator, copy it to ensure it is not pure. */
897 if (CONSP (def) && PURE_P (def)
898 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
899 def = Fcons (XCAR (def), XCDR (def));
901 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
902 error ("attempt to define a key in a non-keymap");
904 /* If idx is a cons, and the car part is a character, idx must be of
905 the form (FROM-CHAR . TO-CHAR). */
906 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
907 CHECK_CHARACTER_CDR (idx);
908 else
909 /* If idx is a list (some sort of mouse click, perhaps?),
910 the index we want to use is the car of the list, which
911 ought to be a symbol. */
912 idx = EVENT_HEAD (idx);
914 /* If idx is a symbol, it might have modifiers, which need to
915 be put in the canonical order. */
916 if (SYMBOLP (idx))
917 idx = reorder_modifiers (idx);
918 else if (INTEGERP (idx))
919 /* Clobber the high bits that can be present on a machine
920 with more than 24 bits of integer. */
921 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
923 /* Scan the keymap for a binding of idx. */
925 Lisp_Object tail;
927 /* The cons after which we should insert new bindings. If the
928 keymap has a table element, we record its position here, so new
929 bindings will go after it; this way, the table will stay
930 towards the front of the alist and character lookups in dense
931 keymaps will remain fast. Otherwise, this just points at the
932 front of the keymap. */
933 Lisp_Object insertion_point;
935 insertion_point = keymap;
936 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
938 Lisp_Object elt;
940 elt = XCAR (tail);
941 if (VECTORP (elt))
943 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
945 CHECK_IMPURE (elt);
946 ASET (elt, XFASTINT (idx), def);
947 return def;
949 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
951 int from = XFASTINT (XCAR (idx));
952 int to = XFASTINT (XCDR (idx));
954 if (to >= ASIZE (elt))
955 to = ASIZE (elt) - 1;
956 for (; from <= to; from++)
957 ASET (elt, from, def);
958 if (to == XFASTINT (XCDR (idx)))
959 /* We have defined all keys in IDX. */
960 return def;
962 insertion_point = tail;
964 else if (CHAR_TABLE_P (elt))
966 /* Character codes with modifiers
967 are not included in a char-table.
968 All character codes without modifiers are included. */
969 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
971 Faset (elt, idx,
972 /* `nil' has a special meaning for char-tables, so
973 we use something else to record an explicitly
974 unbound entry. */
975 NILP (def) ? Qt : def);
976 return def;
978 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
980 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
981 return def;
983 insertion_point = tail;
985 else if (CONSP (elt))
987 if (EQ (idx, XCAR (elt)))
989 CHECK_IMPURE (elt);
990 XSETCDR (elt, def);
991 return def;
993 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
995 int from = XFASTINT (XCAR (idx));
996 int to = XFASTINT (XCDR (idx));
998 if (from <= XFASTINT (XCAR (elt))
999 && to >= XFASTINT (XCAR (elt)))
1001 XSETCDR (elt, def);
1002 if (from == to)
1003 return def;
1007 else if (EQ (elt, Qkeymap))
1008 /* If we find a 'keymap' symbol in the spine of KEYMAP,
1009 then we must have found the start of a second keymap
1010 being used as the tail of KEYMAP, and a binding for IDX
1011 should be inserted before it. */
1012 goto keymap_end;
1014 QUIT;
1017 keymap_end:
1018 /* We have scanned the entire keymap, and not found a binding for
1019 IDX. Let's add one. */
1021 Lisp_Object elt;
1023 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
1025 /* IDX specifies a range of characters, and not all of them
1026 were handled yet, which means this keymap doesn't have a
1027 char-table. So, we insert a char-table now. */
1028 elt = Fmake_char_table (Qkeymap, Qnil);
1029 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
1031 else
1032 elt = Fcons (idx, def);
1033 CHECK_IMPURE (insertion_point);
1034 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
1038 return def;
1041 EXFUN (Fcopy_keymap, 1);
1043 Lisp_Object
1044 copy_keymap_item (elt)
1045 Lisp_Object elt;
1047 Lisp_Object res, tem;
1049 if (!CONSP (elt))
1050 return elt;
1052 res = tem = elt;
1054 /* Is this a new format menu item. */
1055 if (EQ (XCAR (tem), Qmenu_item))
1057 /* Copy cell with menu-item marker. */
1058 res = elt = Fcons (XCAR (tem), XCDR (tem));
1059 tem = XCDR (elt);
1060 if (CONSP (tem))
1062 /* Copy cell with menu-item name. */
1063 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1064 elt = XCDR (elt);
1065 tem = XCDR (elt);
1067 if (CONSP (tem))
1069 /* Copy cell with binding and if the binding is a keymap,
1070 copy that. */
1071 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1072 elt = XCDR (elt);
1073 tem = XCAR (elt);
1074 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1075 XSETCAR (elt, Fcopy_keymap (tem));
1076 tem = XCDR (elt);
1077 if (CONSP (tem) && CONSP (XCAR (tem)))
1078 /* Delete cache for key equivalences. */
1079 XSETCDR (elt, XCDR (tem));
1082 else
1084 /* It may be an old fomat menu item.
1085 Skip the optional menu string. */
1086 if (STRINGP (XCAR (tem)))
1088 /* Copy the cell, since copy-alist didn't go this deep. */
1089 res = elt = Fcons (XCAR (tem), XCDR (tem));
1090 tem = XCDR (elt);
1091 /* Also skip the optional menu help string. */
1092 if (CONSP (tem) && STRINGP (XCAR (tem)))
1094 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1095 elt = XCDR (elt);
1096 tem = XCDR (elt);
1098 /* There may also be a list that caches key equivalences.
1099 Just delete it for the new keymap. */
1100 if (CONSP (tem)
1101 && CONSP (XCAR (tem))
1102 && (NILP (XCAR (XCAR (tem)))
1103 || VECTORP (XCAR (XCAR (tem)))))
1105 XSETCDR (elt, XCDR (tem));
1106 tem = XCDR (tem);
1108 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1109 XSETCDR (elt, Fcopy_keymap (tem));
1111 else if (EQ (XCAR (tem), Qkeymap))
1112 res = Fcopy_keymap (elt);
1114 return res;
1117 static void
1118 copy_keymap_1 (chartable, idx, elt)
1119 Lisp_Object chartable, idx, elt;
1121 Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
1124 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1125 doc: /* Return a copy of the keymap KEYMAP.
1126 The copy starts out with the same definitions of KEYMAP,
1127 but changing either the copy or KEYMAP does not affect the other.
1128 Any key definitions that are subkeymaps are recursively copied.
1129 However, a key definition which is a symbol whose definition is a keymap
1130 is not copied. */)
1131 (keymap)
1132 Lisp_Object keymap;
1134 register Lisp_Object copy, tail;
1135 keymap = get_keymap (keymap, 1, 0);
1136 copy = tail = Fcons (Qkeymap, Qnil);
1137 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1139 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1141 Lisp_Object elt = XCAR (keymap);
1142 if (CHAR_TABLE_P (elt))
1144 elt = Fcopy_sequence (elt);
1145 map_char_table (copy_keymap_1, Qnil, elt, elt);
1147 else if (VECTORP (elt))
1149 int i;
1150 elt = Fcopy_sequence (elt);
1151 for (i = 0; i < ASIZE (elt); i++)
1152 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1154 else if (CONSP (elt))
1155 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1156 XSETCDR (tail, Fcons (elt, Qnil));
1157 tail = XCDR (tail);
1158 keymap = XCDR (keymap);
1160 XSETCDR (tail, keymap);
1161 return copy;
1164 /* Simple Keymap mutators and accessors. */
1166 /* GC is possible in this function if it autoloads a keymap. */
1168 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1169 doc: /* In KEYMAP, define key sequence KEY as DEF.
1170 KEYMAP is a keymap.
1172 KEY is a string or a vector of symbols and characters meaning a
1173 sequence of keystrokes and events. Non-ASCII characters with codes
1174 above 127 (such as ISO Latin-1) can be included if you use a vector.
1175 Using [t] for KEY creates a default definition, which applies to any
1176 event type that has no other definition in this keymap.
1178 DEF is anything that can be a key's definition:
1179 nil (means key is undefined in this keymap),
1180 a command (a Lisp function suitable for interactive calling),
1181 a string (treated as a keyboard macro),
1182 a keymap (to define a prefix key),
1183 a symbol (when the key is looked up, the symbol will stand for its
1184 function definition, which should at that time be one of the above,
1185 or another symbol whose function definition is used, etc.),
1186 a cons (STRING . DEFN), meaning that DEFN is the definition
1187 (DEFN should be a valid definition in its own right),
1188 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1189 or an extended menu item definition.
1190 (See info node `(elisp)Extended Menu Items'.)
1192 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1193 binding is altered. If there is no binding for KEY, the new pair
1194 binding KEY to DEF is added at the front of KEYMAP. */)
1195 (keymap, key, def)
1196 Lisp_Object keymap;
1197 Lisp_Object key;
1198 Lisp_Object def;
1200 register int idx;
1201 register Lisp_Object c;
1202 register Lisp_Object cmd;
1203 int metized = 0;
1204 int meta_bit;
1205 int length;
1206 struct gcpro gcpro1, gcpro2, gcpro3;
1208 GCPRO3 (keymap, key, def);
1209 keymap = get_keymap (keymap, 1, 1);
1211 CHECK_VECTOR_OR_STRING (key);
1213 length = XFASTINT (Flength (key));
1214 if (length == 0)
1215 RETURN_UNGCPRO (Qnil);
1217 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1218 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1220 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1221 ? meta_modifier : 0x80);
1223 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1224 { /* DEF is apparently an XEmacs-style keyboard macro. */
1225 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1226 int i = ASIZE (def);
1227 while (--i >= 0)
1229 Lisp_Object c = AREF (def, i);
1230 if (CONSP (c) && lucid_event_type_list_p (c))
1231 c = Fevent_convert_list (c);
1232 ASET (tmp, i, c);
1234 def = tmp;
1237 idx = 0;
1238 while (1)
1240 c = Faref (key, make_number (idx));
1242 if (CONSP (c))
1244 /* C may be a Lucid style event type list or a cons (FROM .
1245 TO) specifying a range of characters. */
1246 if (lucid_event_type_list_p (c))
1247 c = Fevent_convert_list (c);
1248 else if (CHARACTERP (XCAR (c)))
1249 CHECK_CHARACTER_CDR (c);
1252 if (SYMBOLP (c))
1253 silly_event_symbol_error (c);
1255 if (INTEGERP (c)
1256 && (XINT (c) & meta_bit)
1257 && !metized)
1259 c = meta_prefix_char;
1260 metized = 1;
1262 else
1264 if (INTEGERP (c))
1265 XSETINT (c, XINT (c) & ~meta_bit);
1267 metized = 0;
1268 idx++;
1271 if (!INTEGERP (c) && !SYMBOLP (c)
1272 && (!CONSP (c)
1273 /* If C is a range, it must be a leaf. */
1274 || (INTEGERP (XCAR (c)) && idx != length)))
1275 error ("Key sequence contains invalid event");
1277 if (idx == length)
1278 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1280 cmd = access_keymap (keymap, c, 0, 1, 1);
1282 /* If this key is undefined, make it a prefix. */
1283 if (NILP (cmd))
1284 cmd = define_as_prefix (keymap, c);
1286 keymap = get_keymap (cmd, 0, 1);
1287 if (!CONSP (keymap))
1288 /* We must use Fkey_description rather than just passing key to
1289 error; key might be a vector, not a string. */
1290 error ("Key sequence %s starts with non-prefix key %s",
1291 SDATA (Fkey_description (key, Qnil)),
1292 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1293 make_number (idx)),
1294 Qnil)));
1298 /* This function may GC (it calls Fkey_binding). */
1300 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1301 doc: /* Return the remapping for command COMMAND.
1302 Returns nil if COMMAND is not remapped (or not a symbol).
1304 If the optional argument POSITION is non-nil, it specifies a mouse
1305 position as returned by `event-start' and `event-end', and the
1306 remapping occurs in the keymaps associated with it. It can also be a
1307 number or marker, in which case the keymap properties at the specified
1308 buffer position instead of point are used. The KEYMAPS argument is
1309 ignored if POSITION is non-nil.
1311 If the optional argument KEYMAPS is non-nil, it should be a list of
1312 keymaps to search for command remapping. Otherwise, search for the
1313 remapping in all currently active keymaps. */)
1314 (command, position, keymaps)
1315 Lisp_Object command, position, keymaps;
1317 if (!SYMBOLP (command))
1318 return Qnil;
1320 ASET (command_remapping_vector, 1, command);
1322 if (NILP (keymaps))
1323 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1324 else
1326 Lisp_Object maps, binding;
1328 for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
1330 binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
1331 if (!NILP (binding) && !INTEGERP (binding))
1332 return binding;
1334 return Qnil;
1338 /* Value is number if KEY is too long; nil if valid but has no definition. */
1339 /* GC is possible in this function if it autoloads a keymap. */
1341 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1342 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1343 A value of nil means undefined. See doc of `define-key'
1344 for kinds of definitions.
1346 A number as value means KEY is "too long";
1347 that is, characters or symbols in it except for the last one
1348 fail to be a valid sequence of prefix characters in KEYMAP.
1349 The number is how many characters at the front of KEY
1350 it takes to reach a non-prefix key.
1352 Normally, `lookup-key' ignores bindings for t, which act as default
1353 bindings, used when nothing else in the keymap applies; this makes it
1354 usable as a general function for probing keymaps. However, if the
1355 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1356 recognize the default bindings, just as `read-key-sequence' does. */)
1357 (keymap, key, accept_default)
1358 Lisp_Object keymap;
1359 Lisp_Object key;
1360 Lisp_Object accept_default;
1362 register int idx;
1363 register Lisp_Object cmd;
1364 register Lisp_Object c;
1365 int length;
1366 int t_ok = !NILP (accept_default);
1367 struct gcpro gcpro1, gcpro2;
1369 GCPRO2 (keymap, key);
1370 keymap = get_keymap (keymap, 1, 1);
1372 CHECK_VECTOR_OR_STRING (key);
1374 length = XFASTINT (Flength (key));
1375 if (length == 0)
1376 RETURN_UNGCPRO (keymap);
1378 idx = 0;
1379 while (1)
1381 c = Faref (key, make_number (idx++));
1383 if (CONSP (c) && lucid_event_type_list_p (c))
1384 c = Fevent_convert_list (c);
1386 /* Turn the 8th bit of string chars into a meta modifier. */
1387 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1388 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1390 /* Allow string since binding for `menu-bar-select-buffer'
1391 includes the buffer name in the key sequence. */
1392 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1393 error ("Key sequence contains invalid event");
1395 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1396 if (idx == length)
1397 RETURN_UNGCPRO (cmd);
1399 keymap = get_keymap (cmd, 0, 1);
1400 if (!CONSP (keymap))
1401 RETURN_UNGCPRO (make_number (idx));
1403 QUIT;
1407 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1408 Assume that currently it does not define C at all.
1409 Return the keymap. */
1411 static Lisp_Object
1412 define_as_prefix (keymap, c)
1413 Lisp_Object keymap, c;
1415 Lisp_Object cmd;
1417 cmd = Fmake_sparse_keymap (Qnil);
1418 /* If this key is defined as a prefix in an inherited keymap,
1419 make it a prefix in this map, and make its definition
1420 inherit the other prefix definition. */
1421 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1422 store_in_keymap (keymap, c, cmd);
1424 return cmd;
1427 /* Append a key to the end of a key sequence. We always make a vector. */
1429 Lisp_Object
1430 append_key (key_sequence, key)
1431 Lisp_Object key_sequence, key;
1433 Lisp_Object args[2];
1435 args[0] = key_sequence;
1437 args[1] = Fcons (key, Qnil);
1438 return Fvconcat (2, args);
1441 /* Given a event type C which is a symbol,
1442 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1444 static void
1445 silly_event_symbol_error (c)
1446 Lisp_Object c;
1448 Lisp_Object parsed, base, name, assoc;
1449 int modifiers;
1451 parsed = parse_modifiers (c);
1452 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1453 base = XCAR (parsed);
1454 name = Fsymbol_name (base);
1455 /* This alist includes elements such as ("RET" . "\\r"). */
1456 assoc = Fassoc (name, exclude_keys);
1458 if (! NILP (assoc))
1460 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1461 char *p = new_mods;
1462 Lisp_Object keystring;
1463 if (modifiers & alt_modifier)
1464 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1465 if (modifiers & ctrl_modifier)
1466 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1467 if (modifiers & hyper_modifier)
1468 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1469 if (modifiers & meta_modifier)
1470 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1471 if (modifiers & shift_modifier)
1472 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1473 if (modifiers & super_modifier)
1474 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1475 *p = 0;
1477 c = reorder_modifiers (c);
1478 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1480 error ((modifiers & ~meta_modifier
1481 ? "To bind the key %s, use [?%s], not [%s]"
1482 : "To bind the key %s, use \"%s\", not [%s]"),
1483 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1484 SDATA (SYMBOL_NAME (c)));
1488 /* Global, local, and minor mode keymap stuff. */
1490 /* We can't put these variables inside current_minor_maps, since under
1491 some systems, static gets macro-defined to be the empty string.
1492 Ickypoo. */
1493 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1494 static int cmm_size = 0;
1496 /* Store a pointer to an array of the currently active minor modes in
1497 *modeptr, a pointer to an array of the keymaps of the currently
1498 active minor modes in *mapptr, and return the number of maps
1499 *mapptr contains.
1501 This function always returns a pointer to the same buffer, and may
1502 free or reallocate it, so if you want to keep it for a long time or
1503 hand it out to lisp code, copy it. This procedure will be called
1504 for every key sequence read, so the nice lispy approach (return a
1505 new assoclist, list, what have you) for each invocation would
1506 result in a lot of consing over time.
1508 If we used xrealloc/xmalloc and ran out of memory, they would throw
1509 back to the command loop, which would try to read a key sequence,
1510 which would call this function again, resulting in an infinite
1511 loop. Instead, we'll use realloc/malloc and silently truncate the
1512 list, let the key sequence be read, and hope some other piece of
1513 code signals the error. */
1515 current_minor_maps (modeptr, mapptr)
1516 Lisp_Object **modeptr, **mapptr;
1518 int i = 0;
1519 int list_number = 0;
1520 Lisp_Object alist, assoc, var, val;
1521 Lisp_Object emulation_alists;
1522 Lisp_Object lists[2];
1524 emulation_alists = Vemulation_mode_map_alists;
1525 lists[0] = Vminor_mode_overriding_map_alist;
1526 lists[1] = Vminor_mode_map_alist;
1528 for (list_number = 0; list_number < 2; list_number++)
1530 if (CONSP (emulation_alists))
1532 alist = XCAR (emulation_alists);
1533 emulation_alists = XCDR (emulation_alists);
1534 if (SYMBOLP (alist))
1535 alist = find_symbol_value (alist);
1536 list_number = -1;
1538 else
1539 alist = lists[list_number];
1541 for ( ; CONSP (alist); alist = XCDR (alist))
1542 if ((assoc = XCAR (alist), CONSP (assoc))
1543 && (var = XCAR (assoc), SYMBOLP (var))
1544 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1545 && !NILP (val))
1547 Lisp_Object temp;
1549 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1550 and also an entry in Vminor_mode_map_alist,
1551 ignore the latter. */
1552 if (list_number == 1)
1554 val = assq_no_quit (var, lists[0]);
1555 if (!NILP (val))
1556 continue;
1559 if (i >= cmm_size)
1561 int newsize, allocsize;
1562 Lisp_Object *newmodes, *newmaps;
1564 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1565 allocsize = newsize * sizeof *newmodes;
1567 /* Use malloc here. See the comment above this function.
1568 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1569 BLOCK_INPUT;
1570 newmodes = (Lisp_Object *) malloc (allocsize);
1571 if (newmodes)
1573 if (cmm_modes)
1575 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1576 free (cmm_modes);
1578 cmm_modes = newmodes;
1581 newmaps = (Lisp_Object *) malloc (allocsize);
1582 if (newmaps)
1584 if (cmm_maps)
1586 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1587 free (cmm_maps);
1589 cmm_maps = newmaps;
1591 UNBLOCK_INPUT;
1593 if (newmodes == NULL || newmaps == NULL)
1594 break;
1595 cmm_size = newsize;
1598 /* Get the keymap definition--or nil if it is not defined. */
1599 temp = Findirect_function (XCDR (assoc), Qt);
1600 if (!NILP (temp))
1602 cmm_modes[i] = var;
1603 cmm_maps [i] = temp;
1604 i++;
1609 if (modeptr) *modeptr = cmm_modes;
1610 if (mapptr) *mapptr = cmm_maps;
1611 return i;
1614 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1615 0, 2, 0,
1616 doc: /* Return a list of the currently active keymaps.
1617 OLP if non-nil indicates that we should obey `overriding-local-map' and
1618 `overriding-terminal-local-map'. POSITION can specify a click position
1619 like in the respective argument of `key-binding'. */)
1620 (olp, position)
1621 Lisp_Object olp, position;
1623 int count = SPECPDL_INDEX ();
1625 Lisp_Object keymaps;
1627 /* If a mouse click position is given, our variables are based on
1628 the buffer clicked on, not the current buffer. So we may have to
1629 switch the buffer here. */
1631 if (CONSP (position))
1633 Lisp_Object window;
1635 window = POSN_WINDOW (position);
1637 if (WINDOWP (window)
1638 && BUFFERP (XWINDOW (window)->buffer)
1639 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1641 /* Arrange to go back to the original buffer once we're done
1642 processing the key sequence. We don't use
1643 save_excursion_{save,restore} here, in analogy to
1644 `read-key-sequence' to avoid saving point. Maybe this
1645 would not be a problem here, but it is easier to keep
1646 things the same.
1649 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1651 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1655 keymaps = Fcons (current_global_map, Qnil);
1657 if (!NILP (olp))
1659 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1660 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1661 /* The doc said that overriding-terminal-local-map should
1662 override overriding-local-map. The code used them both,
1663 but it seems clearer to use just one. rms, jan 2005. */
1664 else if (!NILP (Voverriding_local_map))
1665 keymaps = Fcons (Voverriding_local_map, keymaps);
1667 if (NILP (XCDR (keymaps)))
1669 Lisp_Object *maps;
1670 int nmaps, i;
1672 Lisp_Object keymap, local_map;
1673 EMACS_INT pt;
1675 pt = INTEGERP (position) ? XINT (position)
1676 : MARKERP (position) ? marker_position (position)
1677 : PT;
1679 /* Get the buffer local maps, possibly overriden by text or
1680 overlay properties */
1682 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1683 keymap = get_local_map (pt, current_buffer, Qkeymap);
1685 if (CONSP (position))
1687 Lisp_Object string;
1689 /* For a mouse click, get the local text-property keymap
1690 of the place clicked on, rather than point. */
1692 if (POSN_INBUFFER_P (position))
1694 Lisp_Object pos;
1696 pos = POSN_BUFFER_POSN (position);
1697 if (INTEGERP (pos)
1698 && XINT (pos) >= BEG && XINT (pos) <= Z)
1700 local_map = get_local_map (XINT (pos),
1701 current_buffer, Qlocal_map);
1703 keymap = get_local_map (XINT (pos),
1704 current_buffer, Qkeymap);
1708 /* If on a mode line string with a local keymap,
1709 or for a click on a string, i.e. overlay string or a
1710 string displayed via the `display' property,
1711 consider `local-map' and `keymap' properties of
1712 that string. */
1714 if (string = POSN_STRING (position),
1715 (CONSP (string) && STRINGP (XCAR (string))))
1717 Lisp_Object pos, map;
1719 pos = XCDR (string);
1720 string = XCAR (string);
1721 if (INTEGERP (pos)
1722 && XINT (pos) >= 0
1723 && XINT (pos) < SCHARS (string))
1725 map = Fget_text_property (pos, Qlocal_map, string);
1726 if (!NILP (map))
1727 local_map = map;
1729 map = Fget_text_property (pos, Qkeymap, string);
1730 if (!NILP (map))
1731 keymap = map;
1737 if (!NILP (local_map))
1738 keymaps = Fcons (local_map, keymaps);
1740 /* Now put all the minor mode keymaps on the list. */
1741 nmaps = current_minor_maps (0, &maps);
1743 for (i = --nmaps; i >= 0; i--)
1744 if (!NILP (maps[i]))
1745 keymaps = Fcons (maps[i], keymaps);
1747 if (!NILP (keymap))
1748 keymaps = Fcons (keymap, keymaps);
1751 unbind_to (count, Qnil);
1753 return keymaps;
1756 /* GC is possible in this function if it autoloads a keymap. */
1758 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1759 doc: /* Return the binding for command KEY in current keymaps.
1760 KEY is a string or vector, a sequence of keystrokes.
1761 The binding is probably a symbol with a function definition.
1763 Normally, `key-binding' ignores bindings for t, which act as default
1764 bindings, used when nothing else in the keymap applies; this makes it
1765 usable as a general function for probing keymaps. However, if the
1766 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1767 recognize the default bindings, just as `read-key-sequence' does.
1769 Like the normal command loop, `key-binding' will remap the command
1770 resulting from looking up KEY by looking up the command in the
1771 current keymaps. However, if the optional third argument NO-REMAP
1772 is non-nil, `key-binding' returns the unmapped command.
1774 If KEY is a key sequence initiated with the mouse, the used keymaps
1775 will depend on the clicked mouse position with regard to the buffer
1776 and possible local keymaps on strings.
1778 If the optional argument POSITION is non-nil, it specifies a mouse
1779 position as returned by `event-start' and `event-end', and the lookup
1780 occurs in the keymaps associated with it instead of KEY. It can also
1781 be a number or marker, in which case the keymap properties at the
1782 specified buffer position instead of point are used.
1784 (key, accept_default, no_remap, position)
1785 Lisp_Object key, accept_default, no_remap, position;
1787 Lisp_Object *maps, value;
1788 int nmaps, i;
1789 struct gcpro gcpro1, gcpro2;
1790 int count = SPECPDL_INDEX ();
1792 GCPRO2 (key, position);
1794 if (NILP (position) && VECTORP (key))
1796 Lisp_Object event
1797 /* mouse events may have a symbolic prefix indicating the
1798 scrollbar or mode line */
1799 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1801 /* We are not interested in locations without event data */
1803 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1805 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1806 if (EQ (kind, Qmouse_click))
1807 position = EVENT_START (event);
1811 /* Key sequences beginning with mouse clicks
1812 are read using the keymaps of the buffer clicked on, not
1813 the current buffer. So we may have to switch the buffer
1814 here. */
1816 if (CONSP (position))
1818 Lisp_Object window;
1820 window = POSN_WINDOW (position);
1822 if (WINDOWP (window)
1823 && BUFFERP (XWINDOW (window)->buffer)
1824 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1826 /* Arrange to go back to the original buffer once we're done
1827 processing the key sequence. We don't use
1828 save_excursion_{save,restore} here, in analogy to
1829 `read-key-sequence' to avoid saving point. Maybe this
1830 would not be a problem here, but it is easier to keep
1831 things the same.
1834 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1836 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1840 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1842 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1843 key, accept_default);
1844 if (! NILP (value) && !INTEGERP (value))
1845 goto done;
1847 else if (! NILP (Voverriding_local_map))
1849 value = Flookup_key (Voverriding_local_map, key, accept_default);
1850 if (! NILP (value) && !INTEGERP (value))
1851 goto done;
1853 else
1855 Lisp_Object keymap, local_map;
1856 EMACS_INT pt;
1858 pt = INTEGERP (position) ? XINT (position)
1859 : MARKERP (position) ? marker_position (position)
1860 : PT;
1862 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1863 keymap = get_local_map (pt, current_buffer, Qkeymap);
1865 if (CONSP (position))
1867 Lisp_Object string;
1869 /* For a mouse click, get the local text-property keymap
1870 of the place clicked on, rather than point. */
1872 if (POSN_INBUFFER_P (position))
1874 Lisp_Object pos;
1876 pos = POSN_BUFFER_POSN (position);
1877 if (INTEGERP (pos)
1878 && XINT (pos) >= BEG && XINT (pos) <= Z)
1880 local_map = get_local_map (XINT (pos),
1881 current_buffer, Qlocal_map);
1883 keymap = get_local_map (XINT (pos),
1884 current_buffer, Qkeymap);
1888 /* If on a mode line string with a local keymap,
1889 or for a click on a string, i.e. overlay string or a
1890 string displayed via the `display' property,
1891 consider `local-map' and `keymap' properties of
1892 that string. */
1894 if (string = POSN_STRING (position),
1895 (CONSP (string) && STRINGP (XCAR (string))))
1897 Lisp_Object pos, map;
1899 pos = XCDR (string);
1900 string = XCAR (string);
1901 if (INTEGERP (pos)
1902 && XINT (pos) >= 0
1903 && XINT (pos) < SCHARS (string))
1905 map = Fget_text_property (pos, Qlocal_map, string);
1906 if (!NILP (map))
1907 local_map = map;
1909 map = Fget_text_property (pos, Qkeymap, string);
1910 if (!NILP (map))
1911 keymap = map;
1917 if (! NILP (keymap))
1919 value = Flookup_key (keymap, key, accept_default);
1920 if (! NILP (value) && !INTEGERP (value))
1921 goto done;
1924 nmaps = current_minor_maps (0, &maps);
1925 /* Note that all these maps are GCPRO'd
1926 in the places where we found them. */
1928 for (i = 0; i < nmaps; i++)
1929 if (! NILP (maps[i]))
1931 value = Flookup_key (maps[i], key, accept_default);
1932 if (! NILP (value) && !INTEGERP (value))
1933 goto done;
1936 if (! NILP (local_map))
1938 value = Flookup_key (local_map, key, accept_default);
1939 if (! NILP (value) && !INTEGERP (value))
1940 goto done;
1944 value = Flookup_key (current_global_map, key, accept_default);
1946 done:
1947 unbind_to (count, Qnil);
1949 UNGCPRO;
1950 if (NILP (value) || INTEGERP (value))
1951 return Qnil;
1953 /* If the result of the ordinary keymap lookup is an interactive
1954 command, look for a key binding (ie. remapping) for that command. */
1956 if (NILP (no_remap) && SYMBOLP (value))
1958 Lisp_Object value1;
1959 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1960 value = value1;
1963 return value;
1966 /* GC is possible in this function if it autoloads a keymap. */
1968 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1969 doc: /* Return the binding for command KEYS in current local keymap only.
1970 KEYS is a string or vector, a sequence of keystrokes.
1971 The binding is probably a symbol with a function definition.
1973 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1974 bindings; see the description of `lookup-key' for more details about this. */)
1975 (keys, accept_default)
1976 Lisp_Object keys, accept_default;
1978 register Lisp_Object map;
1979 map = current_buffer->keymap;
1980 if (NILP (map))
1981 return Qnil;
1982 return Flookup_key (map, keys, accept_default);
1985 /* GC is possible in this function if it autoloads a keymap. */
1987 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1988 doc: /* Return the binding for command KEYS in current global keymap only.
1989 KEYS is a string or vector, a sequence of keystrokes.
1990 The binding is probably a symbol with a function definition.
1991 This function's return values are the same as those of `lookup-key'
1992 \(which see).
1994 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1995 bindings; see the description of `lookup-key' for more details about this. */)
1996 (keys, accept_default)
1997 Lisp_Object keys, accept_default;
1999 return Flookup_key (current_global_map, keys, accept_default);
2002 /* GC is possible in this function if it autoloads a keymap. */
2004 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
2005 doc: /* Find the visible minor mode bindings of KEY.
2006 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
2007 the symbol which names the minor mode binding KEY, and BINDING is
2008 KEY's definition in that mode. In particular, if KEY has no
2009 minor-mode bindings, return nil. If the first binding is a
2010 non-prefix, all subsequent bindings will be omitted, since they would
2011 be ignored. Similarly, the list doesn't include non-prefix bindings
2012 that come after prefix bindings.
2014 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
2015 bindings; see the description of `lookup-key' for more details about this. */)
2016 (key, accept_default)
2017 Lisp_Object key, accept_default;
2019 Lisp_Object *modes, *maps;
2020 int nmaps;
2021 Lisp_Object binding;
2022 int i, j;
2023 struct gcpro gcpro1, gcpro2;
2025 nmaps = current_minor_maps (&modes, &maps);
2026 /* Note that all these maps are GCPRO'd
2027 in the places where we found them. */
2029 binding = Qnil;
2030 GCPRO2 (key, binding);
2032 for (i = j = 0; i < nmaps; i++)
2033 if (!NILP (maps[i])
2034 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
2035 && !INTEGERP (binding))
2037 if (KEYMAPP (binding))
2038 maps[j++] = Fcons (modes[i], binding);
2039 else if (j == 0)
2040 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
2043 UNGCPRO;
2044 return Flist (j, maps);
2047 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
2048 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
2049 A new sparse keymap is stored as COMMAND's function definition and its value.
2050 If a second optional argument MAPVAR is given, the map is stored as
2051 its value instead of as COMMAND's value; but COMMAND is still defined
2052 as a function.
2053 The third optional argument NAME, if given, supplies a menu name
2054 string for the map. This is required to use the keymap as a menu.
2055 This function returns COMMAND. */)
2056 (command, mapvar, name)
2057 Lisp_Object command, mapvar, name;
2059 Lisp_Object map;
2060 map = Fmake_sparse_keymap (name);
2061 Ffset (command, map);
2062 if (!NILP (mapvar))
2063 Fset (mapvar, map);
2064 else
2065 Fset (command, map);
2066 return command;
2069 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
2070 doc: /* Select KEYMAP as the global keymap. */)
2071 (keymap)
2072 Lisp_Object keymap;
2074 keymap = get_keymap (keymap, 1, 1);
2075 current_global_map = keymap;
2077 return Qnil;
2080 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
2081 doc: /* Select KEYMAP as the local keymap.
2082 If KEYMAP is nil, that means no local keymap. */)
2083 (keymap)
2084 Lisp_Object keymap;
2086 if (!NILP (keymap))
2087 keymap = get_keymap (keymap, 1, 1);
2089 current_buffer->keymap = keymap;
2091 return Qnil;
2094 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
2095 doc: /* Return current buffer's local keymap, or nil if it has none.
2096 Normally the local keymap is set by the major mode with `use-local-map'. */)
2099 return current_buffer->keymap;
2102 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2103 doc: /* Return the current global keymap. */)
2106 return current_global_map;
2109 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2110 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2113 Lisp_Object *maps;
2114 int nmaps = current_minor_maps (0, &maps);
2116 return Flist (nmaps, maps);
2119 /* Help functions for describing and documenting keymaps. */
2121 struct accessible_keymaps_data {
2122 Lisp_Object maps, tail, thisseq;
2123 /* Does the current sequence end in the meta-prefix-char? */
2124 int is_metized;
2127 static void
2128 accessible_keymaps_1 (key, cmd, args, data)
2129 Lisp_Object key, cmd, args;
2130 /* Use void* to be compatible with map_keymap_function_t. */
2131 void *data;
2133 struct accessible_keymaps_data *d = data; /* Cast! */
2134 Lisp_Object maps = d->maps;
2135 Lisp_Object tail = d->tail;
2136 Lisp_Object thisseq = d->thisseq;
2137 int is_metized = d->is_metized && INTEGERP (key);
2138 Lisp_Object tem;
2140 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2141 if (NILP (cmd))
2142 return;
2144 /* Look for and break cycles. */
2145 while (!NILP (tem = Frassq (cmd, maps)))
2147 Lisp_Object prefix = XCAR (tem);
2148 int lim = XINT (Flength (XCAR (tem)));
2149 if (lim <= XINT (Flength (thisseq)))
2150 { /* This keymap was already seen with a smaller prefix. */
2151 int i = 0;
2152 while (i < lim && EQ (Faref (prefix, make_number (i)),
2153 Faref (thisseq, make_number (i))))
2154 i++;
2155 if (i >= lim)
2156 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2157 return;
2159 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2160 but maybe `cmd' occurs again further down in `maps', so keep
2161 looking. */
2162 maps = XCDR (Fmemq (tem, maps));
2165 /* If the last key in thisseq is meta-prefix-char,
2166 turn it into a meta-ized keystroke. We know
2167 that the event we're about to append is an
2168 ascii keystroke since we're processing a
2169 keymap table. */
2170 if (is_metized)
2172 int meta_bit = meta_modifier;
2173 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2174 tem = Fcopy_sequence (thisseq);
2176 Faset (tem, last, make_number (XINT (key) | meta_bit));
2178 /* This new sequence is the same length as
2179 thisseq, so stick it in the list right
2180 after this one. */
2181 XSETCDR (tail,
2182 Fcons (Fcons (tem, cmd), XCDR (tail)));
2184 else
2186 tem = append_key (thisseq, key);
2187 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2191 /* This function cannot GC. */
2193 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2194 1, 2, 0,
2195 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2196 Returns a list of elements of the form (KEYS . MAP), where the sequence
2197 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2198 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2199 An optional argument PREFIX, if non-nil, should be a key sequence;
2200 then the value includes only maps for prefixes that start with PREFIX. */)
2201 (keymap, prefix)
2202 Lisp_Object keymap, prefix;
2204 Lisp_Object maps, tail;
2205 int prefixlen = XINT (Flength (prefix));
2207 /* no need for gcpro because we don't autoload any keymaps. */
2209 if (!NILP (prefix))
2211 /* If a prefix was specified, start with the keymap (if any) for
2212 that prefix, so we don't waste time considering other prefixes. */
2213 Lisp_Object tem;
2214 tem = Flookup_key (keymap, prefix, Qt);
2215 /* Flookup_key may give us nil, or a number,
2216 if the prefix is not defined in this particular map.
2217 It might even give us a list that isn't a keymap. */
2218 tem = get_keymap (tem, 0, 0);
2219 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2220 want to return it. */
2221 if (!NILP (tem))
2223 /* Convert PREFIX to a vector now, so that later on
2224 we don't have to deal with the possibility of a string. */
2225 if (STRINGP (prefix))
2227 int i, i_byte, c;
2228 Lisp_Object copy;
2230 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2231 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2233 int i_before = i;
2235 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2236 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2237 c ^= 0200 | meta_modifier;
2238 ASET (copy, i_before, make_number (c));
2240 prefix = copy;
2242 maps = Fcons (Fcons (prefix, tem), Qnil);
2244 else
2245 return Qnil;
2247 else
2248 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2249 get_keymap (keymap, 1, 0)),
2250 Qnil);
2252 /* For each map in the list maps,
2253 look at any other maps it points to,
2254 and stick them at the end if they are not already in the list.
2256 This is a breadth-first traversal, where tail is the queue of
2257 nodes, and maps accumulates a list of all nodes visited. */
2259 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2261 struct accessible_keymaps_data data;
2262 register Lisp_Object thismap = Fcdr (XCAR (tail));
2263 Lisp_Object last;
2265 data.thisseq = Fcar (XCAR (tail));
2266 data.maps = maps;
2267 data.tail = tail;
2268 last = make_number (XINT (Flength (data.thisseq)) - 1);
2269 /* Does the current sequence end in the meta-prefix-char? */
2270 data.is_metized = (XINT (last) >= 0
2271 /* Don't metize the last char of PREFIX. */
2272 && XINT (last) >= prefixlen
2273 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2275 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2276 if (CONSP (thismap))
2277 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2279 return maps;
2281 Lisp_Object Qsingle_key_description, Qkey_description;
2283 /* This function cannot GC. */
2285 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2286 doc: /* Return a pretty description of key-sequence KEYS.
2287 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2288 Control characters turn into "C-foo" sequences, meta into "M-foo",
2289 spaces are put between sequence elements, etc. */)
2290 (keys, prefix)
2291 Lisp_Object keys, prefix;
2293 int len = 0;
2294 int i, i_byte;
2295 Lisp_Object *args;
2296 int size = XINT (Flength (keys));
2297 Lisp_Object list;
2298 Lisp_Object sep = build_string (" ");
2299 Lisp_Object key;
2300 int add_meta = 0;
2302 if (!NILP (prefix))
2303 size += XINT (Flength (prefix));
2305 /* This has one extra element at the end that we don't pass to Fconcat. */
2306 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2308 /* In effect, this computes
2309 (mapconcat 'single-key-description keys " ")
2310 but we shouldn't use mapconcat because it can do GC. */
2312 next_list:
2313 if (!NILP (prefix))
2314 list = prefix, prefix = Qnil;
2315 else if (!NILP (keys))
2316 list = keys, keys = Qnil;
2317 else
2319 if (add_meta)
2321 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2322 len += 2;
2324 else if (len == 0)
2325 return empty_unibyte_string;
2326 return Fconcat (len - 1, args);
2329 if (STRINGP (list))
2330 size = SCHARS (list);
2331 else if (VECTORP (list))
2332 size = XVECTOR (list)->size;
2333 else if (CONSP (list))
2334 size = XINT (Flength (list));
2335 else
2336 wrong_type_argument (Qarrayp, list);
2338 i = i_byte = 0;
2340 while (i < size)
2342 if (STRINGP (list))
2344 int c;
2345 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2346 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2347 c ^= 0200 | meta_modifier;
2348 XSETFASTINT (key, c);
2350 else if (VECTORP (list))
2352 key = AREF (list, i); i++;
2354 else
2356 key = XCAR (list);
2357 list = XCDR (list);
2358 i++;
2361 if (add_meta)
2363 if (!INTEGERP (key)
2364 || EQ (key, meta_prefix_char)
2365 || (XINT (key) & meta_modifier))
2367 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2368 args[len++] = sep;
2369 if (EQ (key, meta_prefix_char))
2370 continue;
2372 else
2373 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2374 add_meta = 0;
2376 else if (EQ (key, meta_prefix_char))
2378 add_meta = 1;
2379 continue;
2381 args[len++] = Fsingle_key_description (key, Qnil);
2382 args[len++] = sep;
2384 goto next_list;
2388 char *
2389 push_key_description (c, p, force_multibyte)
2390 register unsigned int c;
2391 register char *p;
2392 int force_multibyte;
2394 unsigned c2;
2396 /* Clear all the meaningless bits above the meta bit. */
2397 c &= meta_modifier | ~ - meta_modifier;
2398 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2399 | meta_modifier | shift_modifier | super_modifier);
2401 if (! CHARACTERP (make_number (c2)))
2403 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2404 p += sprintf (p, "[%d]", c);
2405 return p;
2408 if (c & alt_modifier)
2410 *p++ = 'A';
2411 *p++ = '-';
2412 c -= alt_modifier;
2414 if ((c & ctrl_modifier) != 0
2415 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2417 *p++ = 'C';
2418 *p++ = '-';
2419 c &= ~ctrl_modifier;
2421 if (c & hyper_modifier)
2423 *p++ = 'H';
2424 *p++ = '-';
2425 c -= hyper_modifier;
2427 if (c & meta_modifier)
2429 *p++ = 'M';
2430 *p++ = '-';
2431 c -= meta_modifier;
2433 if (c & shift_modifier)
2435 *p++ = 'S';
2436 *p++ = '-';
2437 c -= shift_modifier;
2439 if (c & super_modifier)
2441 *p++ = 's';
2442 *p++ = '-';
2443 c -= super_modifier;
2445 if (c < 040)
2447 if (c == 033)
2449 *p++ = 'E';
2450 *p++ = 'S';
2451 *p++ = 'C';
2453 else if (c == '\t')
2455 *p++ = 'T';
2456 *p++ = 'A';
2457 *p++ = 'B';
2459 else if (c == Ctl ('M'))
2461 *p++ = 'R';
2462 *p++ = 'E';
2463 *p++ = 'T';
2465 else
2467 /* `C-' already added above. */
2468 if (c > 0 && c <= Ctl ('Z'))
2469 *p++ = c + 0140;
2470 else
2471 *p++ = c + 0100;
2474 else if (c == 0177)
2476 *p++ = 'D';
2477 *p++ = 'E';
2478 *p++ = 'L';
2480 else if (c == ' ')
2482 *p++ = 'S';
2483 *p++ = 'P';
2484 *p++ = 'C';
2486 else if (c < 128
2487 || (NILP (current_buffer->enable_multibyte_characters)
2488 && SINGLE_BYTE_CHAR_P (c)
2489 && !force_multibyte))
2491 *p++ = c;
2493 else
2495 /* Now we are sure that C is a valid character code. */
2496 if (NILP (current_buffer->enable_multibyte_characters)
2497 && ! force_multibyte)
2498 *p++ = multibyte_char_to_unibyte (c, Qnil);
2499 else
2500 p += CHAR_STRING (c, (unsigned char *) p);
2503 return p;
2506 /* This function cannot GC. */
2508 DEFUN ("single-key-description", Fsingle_key_description,
2509 Ssingle_key_description, 1, 2, 0,
2510 doc: /* Return a pretty description of command character KEY.
2511 Control characters turn into C-whatever, etc.
2512 Optional argument NO-ANGLES non-nil means don't put angle brackets
2513 around function keys and event symbols. */)
2514 (key, no_angles)
2515 Lisp_Object key, no_angles;
2517 if (CONSP (key) && lucid_event_type_list_p (key))
2518 key = Fevent_convert_list (key);
2520 key = EVENT_HEAD (key);
2522 if (INTEGERP (key)) /* Normal character */
2524 char tem[KEY_DESCRIPTION_SIZE];
2526 *push_key_description (XUINT (key), tem, 1) = 0;
2527 return build_string (tem);
2529 else if (SYMBOLP (key)) /* Function key or event-symbol */
2531 if (NILP (no_angles))
2533 char *buffer
2534 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2535 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2536 return build_string (buffer);
2538 else
2539 return Fsymbol_name (key);
2541 else if (STRINGP (key)) /* Buffer names in the menubar. */
2542 return Fcopy_sequence (key);
2543 else
2544 error ("KEY must be an integer, cons, symbol, or string");
2545 return Qnil;
2548 char *
2549 push_text_char_description (c, p)
2550 register unsigned int c;
2551 register char *p;
2553 if (c >= 0200)
2555 *p++ = 'M';
2556 *p++ = '-';
2557 c -= 0200;
2559 if (c < 040)
2561 *p++ = '^';
2562 *p++ = c + 64; /* 'A' - 1 */
2564 else if (c == 0177)
2566 *p++ = '^';
2567 *p++ = '?';
2569 else
2570 *p++ = c;
2571 return p;
2574 /* This function cannot GC. */
2576 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2577 doc: /* Return a pretty description of file-character CHARACTER.
2578 Control characters turn into "^char", etc. This differs from
2579 `single-key-description' which turns them into "C-char".
2580 Also, this function recognizes the 2**7 bit as the Meta character,
2581 whereas `single-key-description' uses the 2**27 bit for Meta.
2582 See Info node `(elisp)Describing Characters' for examples. */)
2583 (character)
2584 Lisp_Object character;
2586 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2587 unsigned char str[6];
2588 int c;
2590 CHECK_NUMBER (character);
2592 c = XINT (character);
2593 if (!ASCII_CHAR_P (c))
2595 int len = CHAR_STRING (c, str);
2597 return make_multibyte_string (str, 1, len);
2600 *push_text_char_description (c & 0377, str) = 0;
2602 return build_string (str);
2605 static int where_is_preferred_modifier;
2607 /* Return 0 if SEQ uses non-preferred modifiers or non-char events.
2608 Else, return 2 if SEQ uses the where_is_preferred_modifier,
2609 and 1 otherwise. */
2610 static int
2611 preferred_sequence_p (seq)
2612 Lisp_Object seq;
2614 int i;
2615 int len = XINT (Flength (seq));
2616 int result = 1;
2618 for (i = 0; i < len; i++)
2620 Lisp_Object ii, elt;
2622 XSETFASTINT (ii, i);
2623 elt = Faref (seq, ii);
2625 if (!INTEGERP (elt))
2626 return 0;
2627 else
2629 int modifiers = XUINT (elt) & (CHAR_MODIFIER_MASK & ~CHAR_META);
2630 if (modifiers == where_is_preferred_modifier)
2631 result = 2;
2632 else if (modifiers)
2633 return 0;
2637 return result;
2641 /* where-is - finding a command in a set of keymaps. */
2643 static Lisp_Object where_is_internal ();
2644 static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
2645 Lisp_Object args, void *data));
2647 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2648 Returns the first non-nil binding found in any of those maps. */
2650 static Lisp_Object
2651 shadow_lookup (shadow, key, flag)
2652 Lisp_Object shadow, key, flag;
2654 Lisp_Object tail, value;
2656 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2658 value = Flookup_key (XCAR (tail), key, flag);
2659 if (NATNUMP (value))
2661 value = Flookup_key (XCAR (tail),
2662 Fsubstring (key, make_number (0), value), flag);
2663 if (!NILP (value))
2664 return Qnil;
2666 else if (!NILP (value))
2667 return value;
2669 return Qnil;
2672 static Lisp_Object Vmouse_events;
2674 struct where_is_internal_data {
2675 Lisp_Object definition, noindirect, this, last;
2676 int last_is_meta;
2677 Lisp_Object sequences;
2680 /* This function can GC if Flookup_key autoloads any keymaps. */
2682 static Lisp_Object
2683 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2684 Lisp_Object definition, keymaps;
2685 Lisp_Object firstonly, noindirect, no_remap;
2687 Lisp_Object maps = Qnil;
2688 Lisp_Object found, sequences;
2689 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2690 /* 1 means ignore all menu bindings entirely. */
2691 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2693 found = keymaps;
2694 while (CONSP (found))
2696 maps =
2697 nconc2 (maps,
2698 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2699 found = XCDR (found);
2702 GCPRO5 (definition, keymaps, maps, found, sequences);
2703 found = Qnil;
2704 sequences = Qnil;
2706 /* If this command is remapped, then it has no key bindings
2707 of its own. */
2708 if (NILP (no_remap)
2709 && SYMBOLP (definition)
2710 && !NILP (Fcommand_remapping (definition, Qnil, keymaps)))
2711 RETURN_UNGCPRO (Qnil);
2713 for (; CONSP (maps); maps = XCDR (maps))
2715 /* Key sequence to reach map, and the map that it reaches */
2716 register Lisp_Object this, map, tem;
2717 struct where_is_internal_data data;
2719 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2720 [M-CHAR] sequences, check if last character of the sequence
2721 is the meta-prefix char. */
2722 Lisp_Object last;
2723 int last_is_meta;
2725 this = Fcar (XCAR (maps));
2726 map = Fcdr (XCAR (maps));
2727 last = make_number (XINT (Flength (this)) - 1);
2728 last_is_meta = (XINT (last) >= 0
2729 && EQ (Faref (this, last), meta_prefix_char));
2731 /* if (nomenus && !preferred_sequence_p (this)) */
2732 if (nomenus && XINT (last) >= 0
2733 && SYMBOLP (tem = Faref (this, make_number (0)))
2734 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2735 /* If no menu entries should be returned, skip over the
2736 keymaps bound to `menu-bar' and `tool-bar' and other
2737 non-ascii prefixes like `C-down-mouse-2'. */
2738 continue;
2740 QUIT;
2742 data.definition = definition;
2743 data.noindirect = noindirect;
2744 data.this = this;
2745 data.last = last;
2746 data.last_is_meta = last_is_meta;
2747 data.sequences = Qnil;
2749 if (CONSP (map))
2750 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2752 sequences = data.sequences;
2754 while (CONSP (sequences))
2756 Lisp_Object sequence, remapped, function;
2758 sequence = XCAR (sequences);
2759 sequences = XCDR (sequences);
2761 /* If the current sequence is a command remapping with
2762 format [remap COMMAND], find the key sequences
2763 which run COMMAND, and use those sequences instead. */
2764 remapped = Qnil;
2765 if (NILP (no_remap)
2766 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2767 && EQ (AREF (sequence, 0), Qremap)
2768 && (function = AREF (sequence, 1), SYMBOLP (function)))
2770 Lisp_Object remapped1;
2772 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2773 if (CONSP (remapped1))
2775 /* Verify that this key binding actually maps to the
2776 remapped command (see below). */
2777 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2778 continue;
2779 sequence = XCAR (remapped1);
2780 remapped = XCDR (remapped1);
2781 goto record_sequence;
2785 /* Verify that this key binding is not shadowed by another
2786 binding for the same key, before we say it exists.
2788 Mechanism: look for local definition of this key and if
2789 it is defined and does not match what we found then
2790 ignore this key.
2792 Either nil or number as value from Flookup_key
2793 means undefined. */
2794 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2795 continue;
2797 record_sequence:
2798 /* Don't annoy user with strings from a menu such as
2799 Select Paste. Change them all to "(any string)",
2800 so that there seems to be only one menu item
2801 to report. */
2802 if (! NILP (sequence))
2804 Lisp_Object tem;
2805 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2806 if (STRINGP (tem))
2807 Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2808 build_string ("(any string)"));
2811 /* It is a true unshadowed match. Record it, unless it's already
2812 been seen (as could happen when inheriting keymaps). */
2813 if (NILP (Fmember (sequence, found)))
2814 found = Fcons (sequence, found);
2816 /* If firstonly is Qnon_ascii, then we can return the first
2817 binding we find. If firstonly is not Qnon_ascii but not
2818 nil, then we should return the first ascii-only binding
2819 we find. */
2820 if (EQ (firstonly, Qnon_ascii))
2821 RETURN_UNGCPRO (sequence);
2822 else if (!NILP (firstonly) && 2 == preferred_sequence_p (sequence))
2823 RETURN_UNGCPRO (sequence);
2825 if (CONSP (remapped))
2827 sequence = XCAR (remapped);
2828 remapped = XCDR (remapped);
2829 goto record_sequence;
2834 UNGCPRO;
2836 found = Fnreverse (found);
2838 /* firstonly may have been t, but we may have gone all the way through
2839 the keymaps without finding an all-ASCII key sequence. So just
2840 return the best we could find. */
2841 if (NILP (firstonly))
2842 return found;
2843 else if (where_is_preferred_modifier == 0)
2844 return Fcar (found);
2845 else
2846 { /* Maybe we did not find a preferred_modifier binding, but we did find
2847 some ASCII binding. */
2848 Lisp_Object bindings = found;
2849 while (CONSP (bindings))
2850 if (preferred_sequence_p (XCAR (bindings)))
2851 return XCAR (bindings);
2852 else
2853 bindings = XCDR (bindings);
2854 return Fcar (found);
2858 static Lisp_Object Vwhere_is_preferred_modifier;
2860 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2861 doc: /* Return list of keys that invoke DEFINITION.
2862 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2863 If KEYMAP is nil, search all the currently active keymaps.
2864 If KEYMAP is a list of keymaps, search only those keymaps.
2866 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2867 rather than a list of all possible key sequences.
2868 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2869 no matter what it is.
2870 If FIRSTONLY has another non-nil value, prefer bindings
2871 that use the modifier key specified in `where-is-preferred-modifier'
2872 \(or their meta variants) and entirely reject menu bindings.
2874 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2875 to other keymaps or slots. This makes it possible to search for an
2876 indirect definition itself.
2878 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2879 that invoke a command which is remapped to DEFINITION, but include the
2880 remapped command in the returned list. */)
2881 (definition, keymap, firstonly, noindirect, no_remap)
2882 Lisp_Object definition, keymap;
2883 Lisp_Object firstonly, noindirect, no_remap;
2885 Lisp_Object sequences, keymaps;
2886 /* 1 means ignore all menu bindings entirely. */
2887 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2888 Lisp_Object result;
2890 /* Refresh the C version of the modifier preference. */
2891 where_is_preferred_modifier
2892 = parse_solitary_modifier (Vwhere_is_preferred_modifier);
2894 /* Find the relevant keymaps. */
2895 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2896 keymaps = keymap;
2897 else if (!NILP (keymap))
2898 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2899 else
2900 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2902 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2903 We don't really need to check `keymap'. */
2904 if (nomenus && NILP (noindirect) && NILP (keymap))
2906 Lisp_Object *defns;
2907 int i, n;
2908 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2910 /* Check heuristic-consistency of the cache. */
2911 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2912 where_is_cache = Qnil;
2914 if (NILP (where_is_cache))
2916 /* We need to create the cache. */
2917 Lisp_Object args[2];
2918 where_is_cache = Fmake_hash_table (0, args);
2919 where_is_cache_keymaps = Qt;
2921 /* Fill in the cache. */
2922 GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2923 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2924 UNGCPRO;
2926 where_is_cache_keymaps = keymaps;
2929 /* We want to process definitions from the last to the first.
2930 Instead of consing, copy definitions to a vector and step
2931 over that vector. */
2932 sequences = Fgethash (definition, where_is_cache, Qnil);
2933 n = XINT (Flength (sequences));
2934 defns = (Lisp_Object *) alloca (n * sizeof *defns);
2935 for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2936 defns[i++] = XCAR (sequences);
2938 /* Verify that the key bindings are not shadowed. Note that
2939 the following can GC. */
2940 GCPRO2 (definition, keymaps);
2941 result = Qnil;
2943 int best_pref = -1;
2944 int j = -1;
2945 for (i = n - 1; i >= 0; --i)
2947 int pref = preferred_sequence_p (defns[i]);
2948 if (pref > best_pref
2949 && EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2951 j = i;
2952 best_pref = pref;
2953 if (best_pref == 2)
2954 break;
2957 result = j >= 0 ? defns[j] : Qnil;
2959 UNGCPRO;
2961 else
2963 /* Kill the cache so that where_is_internal_1 doesn't think
2964 we're filling it up. */
2965 where_is_cache = Qnil;
2966 result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2969 return result;
2972 /* This function can GC because get_keyelt can. */
2974 static void
2975 where_is_internal_1 (key, binding, args, data)
2976 Lisp_Object key, binding, args;
2977 void *data;
2979 struct where_is_internal_data *d = data; /* Cast! */
2980 Lisp_Object definition = d->definition;
2981 Lisp_Object noindirect = d->noindirect;
2982 Lisp_Object this = d->this;
2983 Lisp_Object last = d->last;
2984 int last_is_meta = d->last_is_meta;
2985 Lisp_Object sequence;
2987 /* Search through indirections unless that's not wanted. */
2988 if (NILP (noindirect))
2989 binding = get_keyelt (binding, 0);
2991 /* End this iteration if this element does not match
2992 the target. */
2994 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2995 || EQ (binding, definition)
2996 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2997 /* Doesn't match. */
2998 return;
3000 /* We have found a match. Construct the key sequence where we found it. */
3001 if (INTEGERP (key) && last_is_meta)
3003 sequence = Fcopy_sequence (this);
3004 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
3006 else
3008 if (CONSP (key))
3009 key = Fcons (XCAR (key), XCDR (key));
3010 sequence = append_key (this, key);
3013 if (!NILP (where_is_cache))
3015 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
3016 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
3018 else
3019 d->sequences = Fcons (sequence, d->sequences);
3022 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
3024 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
3025 doc: /* Insert the list of all defined keys and their definitions.
3026 The list is inserted in the current buffer, while the bindings are
3027 looked up in BUFFER.
3028 The optional argument PREFIX, if non-nil, should be a key sequence;
3029 then we display only bindings that start with that prefix.
3030 The optional argument MENUS, if non-nil, says to mention menu bindings.
3031 \(Ordinarily these are omitted from the output.) */)
3032 (buffer, prefix, menus)
3033 Lisp_Object buffer, prefix, menus;
3035 Lisp_Object outbuf, shadow;
3036 int nomenu = NILP (menus);
3037 register Lisp_Object start1;
3038 struct gcpro gcpro1;
3040 char *alternate_heading
3041 = "\
3042 Keyboard translations:\n\n\
3043 You type Translation\n\
3044 -------- -----------\n";
3046 CHECK_BUFFER (buffer);
3048 shadow = Qnil;
3049 GCPRO1 (shadow);
3051 outbuf = Fcurrent_buffer ();
3053 /* Report on alternates for keys. */
3054 if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix))
3056 int c;
3057 const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table);
3058 int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table);
3060 for (c = 0; c < translate_len; c++)
3061 if (translate[c] != c)
3063 char buf[KEY_DESCRIPTION_SIZE];
3064 char *bufend;
3066 if (alternate_heading)
3068 insert_string (alternate_heading);
3069 alternate_heading = 0;
3072 bufend = push_key_description (translate[c], buf, 1);
3073 insert (buf, bufend - buf);
3074 Findent_to (make_number (16), make_number (1));
3075 bufend = push_key_description (c, buf, 1);
3076 insert (buf, bufend - buf);
3078 insert ("\n", 1);
3080 /* Insert calls signal_after_change which may GC. */
3081 translate = SDATA (current_kboard->Vkeyboard_translate_table);
3084 insert ("\n", 1);
3087 if (!NILP (Vkey_translation_map))
3088 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3089 "Key translations", nomenu, 1, 0, 0);
3092 /* Print the (major mode) local map. */
3093 start1 = Qnil;
3094 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3095 start1 = current_kboard->Voverriding_terminal_local_map;
3096 else if (!NILP (Voverriding_local_map))
3097 start1 = Voverriding_local_map;
3099 if (!NILP (start1))
3101 describe_map_tree (start1, 1, shadow, prefix,
3102 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3103 shadow = Fcons (start1, shadow);
3105 else
3107 /* Print the minor mode and major mode keymaps. */
3108 int i, nmaps;
3109 Lisp_Object *modes, *maps;
3111 /* Temporarily switch to `buffer', so that we can get that buffer's
3112 minor modes correctly. */
3113 Fset_buffer (buffer);
3115 nmaps = current_minor_maps (&modes, &maps);
3116 Fset_buffer (outbuf);
3118 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3119 XBUFFER (buffer), Qkeymap);
3120 if (!NILP (start1))
3122 describe_map_tree (start1, 1, shadow, prefix,
3123 "\f\n`keymap' Property Bindings", nomenu,
3124 0, 0, 0);
3125 shadow = Fcons (start1, shadow);
3128 /* Print the minor mode maps. */
3129 for (i = 0; i < nmaps; i++)
3131 /* The title for a minor mode keymap
3132 is constructed at run time.
3133 We let describe_map_tree do the actual insertion
3134 because it takes care of other features when doing so. */
3135 char *title, *p;
3137 if (!SYMBOLP (modes[i]))
3138 abort ();
3140 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3141 *p++ = '\f';
3142 *p++ = '\n';
3143 *p++ = '`';
3144 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3145 SCHARS (SYMBOL_NAME (modes[i])));
3146 p += SCHARS (SYMBOL_NAME (modes[i]));
3147 *p++ = '\'';
3148 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3149 p += sizeof (" Minor Mode Bindings") - 1;
3150 *p = 0;
3152 describe_map_tree (maps[i], 1, shadow, prefix,
3153 title, nomenu, 0, 0, 0);
3154 shadow = Fcons (maps[i], shadow);
3157 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3158 XBUFFER (buffer), Qlocal_map);
3159 if (!NILP (start1))
3161 if (EQ (start1, XBUFFER (buffer)->keymap))
3162 describe_map_tree (start1, 1, shadow, prefix,
3163 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3164 else
3165 describe_map_tree (start1, 1, shadow, prefix,
3166 "\f\n`local-map' Property Bindings",
3167 nomenu, 0, 0, 0);
3169 shadow = Fcons (start1, shadow);
3173 describe_map_tree (current_global_map, 1, shadow, prefix,
3174 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3176 /* Print the function-key-map translations under this prefix. */
3177 if (!NILP (current_kboard->Vlocal_function_key_map))
3178 describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix,
3179 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3181 /* Print the input-decode-map translations under this prefix. */
3182 if (!NILP (current_kboard->Vinput_decode_map))
3183 describe_map_tree (current_kboard->Vinput_decode_map, 0, Qnil, prefix,
3184 "\f\nInput decoding map translations", nomenu, 1, 0, 0);
3186 UNGCPRO;
3187 return Qnil;
3190 /* Insert a description of the key bindings in STARTMAP,
3191 followed by those of all maps reachable through STARTMAP.
3192 If PARTIAL is nonzero, omit certain "uninteresting" commands
3193 (such as `undefined').
3194 If SHADOW is non-nil, it is a list of maps;
3195 don't mention keys which would be shadowed by any of them.
3196 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3197 TITLE, if not 0, is a string to insert at the beginning.
3198 TITLE should not end with a colon or a newline; we supply that.
3199 If NOMENU is not 0, then omit menu-bar commands.
3201 If TRANSL is nonzero, the definitions are actually key translations
3202 so print strings and vectors differently.
3204 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3205 to look through.
3207 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3208 don't omit it; instead, mention it but say it is shadowed. */
3210 void
3211 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3212 always_title, mention_shadow)
3213 Lisp_Object startmap, shadow, prefix;
3214 int partial;
3215 char *title;
3216 int nomenu;
3217 int transl;
3218 int always_title;
3219 int mention_shadow;
3221 Lisp_Object maps, orig_maps, seen, sub_shadows;
3222 struct gcpro gcpro1, gcpro2, gcpro3;
3223 int something = 0;
3224 char *key_heading
3225 = "\
3226 key binding\n\
3227 --- -------\n";
3229 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3230 seen = Qnil;
3231 sub_shadows = Qnil;
3232 GCPRO3 (maps, seen, sub_shadows);
3234 if (nomenu)
3236 Lisp_Object list;
3238 /* Delete from MAPS each element that is for the menu bar. */
3239 for (list = maps; CONSP (list); list = XCDR (list))
3241 Lisp_Object elt, prefix, tem;
3243 elt = XCAR (list);
3244 prefix = Fcar (elt);
3245 if (XVECTOR (prefix)->size >= 1)
3247 tem = Faref (prefix, make_number (0));
3248 if (EQ (tem, Qmenu_bar))
3249 maps = Fdelq (elt, maps);
3254 if (!NILP (maps) || always_title)
3256 if (title)
3258 insert_string (title);
3259 if (!NILP (prefix))
3261 insert_string (" Starting With ");
3262 insert1 (Fkey_description (prefix, Qnil));
3264 insert_string (":\n");
3266 insert_string (key_heading);
3267 something = 1;
3270 for (; CONSP (maps); maps = XCDR (maps))
3272 register Lisp_Object elt, prefix, tail;
3274 elt = XCAR (maps);
3275 prefix = Fcar (elt);
3277 sub_shadows = Qnil;
3279 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3281 Lisp_Object shmap;
3283 shmap = XCAR (tail);
3285 /* If the sequence by which we reach this keymap is zero-length,
3286 then the shadow map for this keymap is just SHADOW. */
3287 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3288 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3290 /* If the sequence by which we reach this keymap actually has
3291 some elements, then the sequence's definition in SHADOW is
3292 what we should use. */
3293 else
3295 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3296 if (INTEGERP (shmap))
3297 shmap = Qnil;
3300 /* If shmap is not nil and not a keymap,
3301 it completely shadows this map, so don't
3302 describe this map at all. */
3303 if (!NILP (shmap) && !KEYMAPP (shmap))
3304 goto skip;
3306 if (!NILP (shmap))
3307 sub_shadows = Fcons (shmap, sub_shadows);
3310 /* Maps we have already listed in this loop shadow this map. */
3311 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3313 Lisp_Object tem;
3314 tem = Fequal (Fcar (XCAR (tail)), prefix);
3315 if (!NILP (tem))
3316 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3319 describe_map (Fcdr (elt), prefix,
3320 transl ? describe_translation : describe_command,
3321 partial, sub_shadows, &seen, nomenu, mention_shadow);
3323 skip: ;
3326 if (something)
3327 insert_string ("\n");
3329 UNGCPRO;
3332 static int previous_description_column;
3334 static void
3335 describe_command (definition, args)
3336 Lisp_Object definition, args;
3338 register Lisp_Object tem1;
3339 int column = (int) current_column (); /* iftc */
3340 int description_column;
3342 /* If column 16 is no good, go to col 32;
3343 but don't push beyond that--go to next line instead. */
3344 if (column > 30)
3346 insert_char ('\n');
3347 description_column = 32;
3349 else if (column > 14 || (column > 10 && previous_description_column == 32))
3350 description_column = 32;
3351 else
3352 description_column = 16;
3354 Findent_to (make_number (description_column), make_number (1));
3355 previous_description_column = description_column;
3357 if (SYMBOLP (definition))
3359 tem1 = SYMBOL_NAME (definition);
3360 insert1 (tem1);
3361 insert_string ("\n");
3363 else if (STRINGP (definition) || VECTORP (definition))
3364 insert_string ("Keyboard Macro\n");
3365 else if (KEYMAPP (definition))
3366 insert_string ("Prefix Command\n");
3367 else
3368 insert_string ("??\n");
3371 static void
3372 describe_translation (definition, args)
3373 Lisp_Object definition, args;
3375 register Lisp_Object tem1;
3377 Findent_to (make_number (16), make_number (1));
3379 if (SYMBOLP (definition))
3381 tem1 = SYMBOL_NAME (definition);
3382 insert1 (tem1);
3383 insert_string ("\n");
3385 else if (STRINGP (definition) || VECTORP (definition))
3387 insert1 (Fkey_description (definition, Qnil));
3388 insert_string ("\n");
3390 else if (KEYMAPP (definition))
3391 insert_string ("Prefix Command\n");
3392 else
3393 insert_string ("??\n");
3396 /* describe_map puts all the usable elements of a sparse keymap
3397 into an array of `struct describe_map_elt',
3398 then sorts them by the events. */
3400 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3402 /* qsort comparison function for sorting `struct describe_map_elt' by
3403 the event field. */
3405 static int
3406 describe_map_compare (aa, bb)
3407 const void *aa, *bb;
3409 const struct describe_map_elt *a = aa, *b = bb;
3410 if (INTEGERP (a->event) && INTEGERP (b->event))
3411 return ((XINT (a->event) > XINT (b->event))
3412 - (XINT (a->event) < XINT (b->event)));
3413 if (!INTEGERP (a->event) && INTEGERP (b->event))
3414 return 1;
3415 if (INTEGERP (a->event) && !INTEGERP (b->event))
3416 return -1;
3417 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3418 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3419 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3420 : 0);
3421 return 0;
3424 /* Describe the contents of map MAP, assuming that this map itself is
3425 reached by the sequence of prefix keys PREFIX (a string or vector).
3426 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3428 static void
3429 describe_map (map, prefix, elt_describer, partial, shadow,
3430 seen, nomenu, mention_shadow)
3431 register Lisp_Object map;
3432 Lisp_Object prefix;
3433 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3434 int partial;
3435 Lisp_Object shadow;
3436 Lisp_Object *seen;
3437 int nomenu;
3438 int mention_shadow;
3440 Lisp_Object tail, definition, event;
3441 Lisp_Object tem;
3442 Lisp_Object suppress;
3443 Lisp_Object kludge;
3444 int first = 1;
3445 struct gcpro gcpro1, gcpro2, gcpro3;
3447 /* These accumulate the values from sparse keymap bindings,
3448 so we can sort them and handle them in order. */
3449 int length_needed = 0;
3450 struct describe_map_elt *vect;
3451 int slots_used = 0;
3452 int i;
3454 suppress = Qnil;
3456 if (partial)
3457 suppress = intern ("suppress-keymap");
3459 /* This vector gets used to present single keys to Flookup_key. Since
3460 that is done once per keymap element, we don't want to cons up a
3461 fresh vector every time. */
3462 kludge = Fmake_vector (make_number (1), Qnil);
3463 definition = Qnil;
3465 GCPRO3 (prefix, definition, kludge);
3467 map = call1 (Qkeymap_canonicalize, map);
3469 for (tail = map; CONSP (tail); tail = XCDR (tail))
3470 length_needed++;
3472 vect = ((struct describe_map_elt *)
3473 alloca (sizeof (struct describe_map_elt) * length_needed));
3475 for (tail = map; CONSP (tail); tail = XCDR (tail))
3477 QUIT;
3479 if (VECTORP (XCAR (tail))
3480 || CHAR_TABLE_P (XCAR (tail)))
3481 describe_vector (XCAR (tail),
3482 prefix, Qnil, elt_describer, partial, shadow, map,
3483 (int *)0, 0, 1, mention_shadow);
3484 else if (CONSP (XCAR (tail)))
3486 int this_shadowed = 0;
3488 event = XCAR (XCAR (tail));
3490 /* Ignore bindings whose "prefix" are not really valid events.
3491 (We get these in the frames and buffers menu.) */
3492 if (!(SYMBOLP (event) || INTEGERP (event)))
3493 continue;
3495 if (nomenu && EQ (event, Qmenu_bar))
3496 continue;
3498 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3500 /* Don't show undefined commands or suppressed commands. */
3501 if (NILP (definition)) continue;
3502 if (SYMBOLP (definition) && partial)
3504 tem = Fget (definition, suppress);
3505 if (!NILP (tem))
3506 continue;
3509 /* Don't show a command that isn't really visible
3510 because a local definition of the same key shadows it. */
3512 ASET (kludge, 0, event);
3513 if (!NILP (shadow))
3515 tem = shadow_lookup (shadow, kludge, Qt);
3516 if (!NILP (tem))
3518 /* If both bindings are keymaps, this key is a prefix key,
3519 so don't say it is shadowed. */
3520 if (KEYMAPP (definition) && KEYMAPP (tem))
3522 /* Avoid generating duplicate entries if the
3523 shadowed binding has the same definition. */
3524 else if (mention_shadow && !EQ (tem, definition))
3525 this_shadowed = 1;
3526 else
3527 continue;
3531 tem = Flookup_key (map, kludge, Qt);
3532 if (!EQ (tem, definition)) continue;
3534 vect[slots_used].event = event;
3535 vect[slots_used].definition = definition;
3536 vect[slots_used].shadowed = this_shadowed;
3537 slots_used++;
3539 else if (EQ (XCAR (tail), Qkeymap))
3541 /* The same keymap might be in the structure twice, if we're
3542 using an inherited keymap. So skip anything we've already
3543 encountered. */
3544 tem = Fassq (tail, *seen);
3545 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3546 break;
3547 *seen = Fcons (Fcons (tail, prefix), *seen);
3551 /* If we found some sparse map events, sort them. */
3553 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3554 describe_map_compare);
3556 /* Now output them in sorted order. */
3558 for (i = 0; i < slots_used; i++)
3560 Lisp_Object start, end;
3562 if (first)
3564 previous_description_column = 0;
3565 insert ("\n", 1);
3566 first = 0;
3569 ASET (kludge, 0, vect[i].event);
3570 start = vect[i].event;
3571 end = start;
3573 definition = vect[i].definition;
3575 /* Find consecutive chars that are identically defined. */
3576 if (INTEGERP (vect[i].event))
3578 while (i + 1 < slots_used
3579 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3580 && !NILP (Fequal (vect[i + 1].definition, definition))
3581 && vect[i].shadowed == vect[i + 1].shadowed)
3582 i++;
3583 end = vect[i].event;
3586 /* Now START .. END is the range to describe next. */
3588 /* Insert the string to describe the event START. */
3589 insert1 (Fkey_description (kludge, prefix));
3591 if (!EQ (start, end))
3593 insert (" .. ", 4);
3595 ASET (kludge, 0, end);
3596 /* Insert the string to describe the character END. */
3597 insert1 (Fkey_description (kludge, prefix));
3600 /* Print a description of the definition of this character.
3601 elt_describer will take care of spacing out far enough
3602 for alignment purposes. */
3603 (*elt_describer) (vect[i].definition, Qnil);
3605 if (vect[i].shadowed)
3607 SET_PT (PT - 1);
3608 insert_string ("\n (that binding is currently shadowed by another mode)");
3609 SET_PT (PT + 1);
3613 UNGCPRO;
3616 static void
3617 describe_vector_princ (elt, fun)
3618 Lisp_Object elt, fun;
3620 Findent_to (make_number (16), make_number (1));
3621 call1 (fun, elt);
3622 Fterpri (Qnil);
3625 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3626 doc: /* Insert a description of contents of VECTOR.
3627 This is text showing the elements of vector matched against indices.
3628 DESCRIBER is the output function used; nil means use `princ'. */)
3629 (vector, describer)
3630 Lisp_Object vector, describer;
3632 int count = SPECPDL_INDEX ();
3633 if (NILP (describer))
3634 describer = intern ("princ");
3635 specbind (Qstandard_output, Fcurrent_buffer ());
3636 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3637 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3638 Qnil, Qnil, (int *)0, 0, 0, 0);
3640 return unbind_to (count, Qnil);
3643 /* Insert in the current buffer a description of the contents of VECTOR.
3644 We call ELT_DESCRIBER to insert the description of one value found
3645 in VECTOR.
3647 ELT_PREFIX describes what "comes before" the keys or indices defined
3648 by this vector. This is a human-readable string whose size
3649 is not necessarily related to the situation.
3651 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3652 leads to this keymap.
3654 If the vector is a chartable, ELT_PREFIX is the vector
3655 of bytes that lead to the character set or portion of a character
3656 set described by this chartable.
3658 If PARTIAL is nonzero, it means do not mention suppressed commands
3659 (that assumes the vector is in a keymap).
3661 SHADOW is a list of keymaps that shadow this map.
3662 If it is non-nil, then we look up the key in those maps
3663 and we don't mention it now if it is defined by any of them.
3665 ENTIRE_MAP is the keymap in which this vector appears.
3666 If the definition in effect in the whole map does not match
3667 the one in this vector, we ignore this one.
3669 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3671 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3672 the near future.
3674 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3676 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3678 static void
3679 describe_vector (vector, prefix, args, elt_describer,
3680 partial, shadow, entire_map,
3681 indices, char_table_depth, keymap_p,
3682 mention_shadow)
3683 register Lisp_Object vector;
3684 Lisp_Object prefix, args;
3685 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3686 int partial;
3687 Lisp_Object shadow;
3688 Lisp_Object entire_map;
3689 int *indices;
3690 int char_table_depth;
3691 int keymap_p;
3692 int mention_shadow;
3694 Lisp_Object definition;
3695 Lisp_Object tem2;
3696 Lisp_Object elt_prefix = Qnil;
3697 int i;
3698 Lisp_Object suppress;
3699 Lisp_Object kludge;
3700 int first = 1;
3701 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3702 /* Range of elements to be handled. */
3703 int from, to, stop;
3704 Lisp_Object character;
3705 int starting_i;
3707 suppress = Qnil;
3709 definition = Qnil;
3711 if (!keymap_p)
3713 /* Call Fkey_description first, to avoid GC bug for the other string. */
3714 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3716 Lisp_Object tem;
3717 tem = Fkey_description (prefix, Qnil);
3718 elt_prefix = concat2 (tem, build_string (" "));
3720 prefix = Qnil;
3723 /* This vector gets used to present single keys to Flookup_key. Since
3724 that is done once per vector element, we don't want to cons up a
3725 fresh vector every time. */
3726 kludge = Fmake_vector (make_number (1), Qnil);
3727 GCPRO4 (elt_prefix, prefix, definition, kludge);
3729 if (partial)
3730 suppress = intern ("suppress-keymap");
3732 from = 0;
3733 if (CHAR_TABLE_P (vector))
3734 stop = MAX_5_BYTE_CHAR + 1, to = MAX_CHAR + 1;
3735 else
3736 stop = to = XVECTOR (vector)->size;
3738 for (i = from; ; i++)
3740 int this_shadowed = 0;
3741 int range_beg, range_end;
3742 Lisp_Object val;
3744 QUIT;
3746 if (i == stop)
3748 if (i == to)
3749 break;
3750 stop = to;
3753 starting_i = i;
3755 if (CHAR_TABLE_P (vector))
3757 range_beg = i;
3758 i = stop - 1;
3759 val = char_table_ref_and_range (vector, range_beg, &range_beg, &i);
3761 else
3762 val = AREF (vector, i);
3763 definition = get_keyelt (val, 0);
3765 if (NILP (definition)) continue;
3767 /* Don't mention suppressed commands. */
3768 if (SYMBOLP (definition) && partial)
3770 Lisp_Object tem;
3772 tem = Fget (definition, suppress);
3774 if (!NILP (tem)) continue;
3777 character = make_number (starting_i);
3778 ASET (kludge, 0, character);
3780 /* If this binding is shadowed by some other map, ignore it. */
3781 if (!NILP (shadow))
3783 Lisp_Object tem;
3785 tem = shadow_lookup (shadow, kludge, Qt);
3787 if (!NILP (tem))
3789 if (mention_shadow)
3790 this_shadowed = 1;
3791 else
3792 continue;
3796 /* Ignore this definition if it is shadowed by an earlier
3797 one in the same keymap. */
3798 if (!NILP (entire_map))
3800 Lisp_Object tem;
3802 tem = Flookup_key (entire_map, kludge, Qt);
3804 if (!EQ (tem, definition))
3805 continue;
3808 if (first)
3810 insert ("\n", 1);
3811 first = 0;
3814 /* Output the prefix that applies to every entry in this map. */
3815 if (!NILP (elt_prefix))
3816 insert1 (elt_prefix);
3818 insert1 (Fkey_description (kludge, prefix));
3820 /* Find all consecutive characters or rows that have the same
3821 definition. But, VECTOR is a char-table, we had better put a
3822 boundary between normal characters (-#x3FFF7F) and 8-bit
3823 characters (#x3FFF80-). */
3824 if (CHAR_TABLE_P (vector))
3826 while (i + 1 < stop
3827 && (range_beg = i + 1, range_end = stop - 1,
3828 val = char_table_ref_and_range (vector, range_beg,
3829 &range_beg, &range_end),
3830 tem2 = get_keyelt (val, 0),
3831 !NILP (tem2))
3832 && !NILP (Fequal (tem2, definition)))
3833 i = range_end;
3835 else
3836 while (i + 1 < stop
3837 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3838 !NILP (tem2))
3839 && !NILP (Fequal (tem2, definition)))
3840 i++;
3842 /* If we have a range of more than one character,
3843 print where the range reaches to. */
3845 if (i != starting_i)
3847 insert (" .. ", 4);
3849 ASET (kludge, 0, make_number (i));
3851 if (!NILP (elt_prefix))
3852 insert1 (elt_prefix);
3854 insert1 (Fkey_description (kludge, prefix));
3857 /* Print a description of the definition of this character.
3858 elt_describer will take care of spacing out far enough
3859 for alignment purposes. */
3860 (*elt_describer) (definition, args);
3862 if (this_shadowed)
3864 SET_PT (PT - 1);
3865 insert_string (" (binding currently shadowed)");
3866 SET_PT (PT + 1);
3870 if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
3872 if (!NILP (elt_prefix))
3873 insert1 (elt_prefix);
3874 insert ("default", 7);
3875 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3878 UNGCPRO;
3881 /* Apropos - finding all symbols whose names match a regexp. */
3882 static Lisp_Object apropos_predicate;
3883 static Lisp_Object apropos_accumulate;
3885 static void
3886 apropos_accum (symbol, string)
3887 Lisp_Object symbol, string;
3889 register Lisp_Object tem;
3891 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3892 if (!NILP (tem) && !NILP (apropos_predicate))
3893 tem = call1 (apropos_predicate, symbol);
3894 if (!NILP (tem))
3895 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3898 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3899 doc: /* Show all symbols whose names contain match for REGEXP.
3900 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3901 for each symbol and a symbol is mentioned only if that returns non-nil.
3902 Return list of symbols found. */)
3903 (regexp, predicate)
3904 Lisp_Object regexp, predicate;
3906 Lisp_Object tem;
3907 CHECK_STRING (regexp);
3908 apropos_predicate = predicate;
3909 apropos_accumulate = Qnil;
3910 map_obarray (Vobarray, apropos_accum, regexp);
3911 tem = Fsort (apropos_accumulate, Qstring_lessp);
3912 apropos_accumulate = Qnil;
3913 apropos_predicate = Qnil;
3914 return tem;
3917 void
3918 syms_of_keymap ()
3920 Qkeymap = intern ("keymap");
3921 staticpro (&Qkeymap);
3922 staticpro (&apropos_predicate);
3923 staticpro (&apropos_accumulate);
3924 apropos_predicate = Qnil;
3925 apropos_accumulate = Qnil;
3927 Qkeymap_canonicalize = intern ("keymap-canonicalize");
3928 staticpro (&Qkeymap_canonicalize);
3930 /* Now we are ready to set up this property, so we can
3931 create char tables. */
3932 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3934 /* Initialize the keymaps standardly used.
3935 Each one is the value of a Lisp variable, and is also
3936 pointed to by a C variable */
3938 global_map = Fmake_keymap (Qnil);
3939 Fset (intern ("global-map"), global_map);
3941 current_global_map = global_map;
3942 staticpro (&global_map);
3943 staticpro (&current_global_map);
3945 meta_map = Fmake_keymap (Qnil);
3946 Fset (intern ("esc-map"), meta_map);
3947 Ffset (intern ("ESC-prefix"), meta_map);
3949 control_x_map = Fmake_keymap (Qnil);
3950 Fset (intern ("ctl-x-map"), control_x_map);
3951 Ffset (intern ("Control-X-prefix"), control_x_map);
3953 exclude_keys
3954 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3955 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3956 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3957 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3958 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3959 Qnil)))));
3960 staticpro (&exclude_keys);
3962 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3963 doc: /* List of commands given new key bindings recently.
3964 This is used for internal purposes during Emacs startup;
3965 don't alter it yourself. */);
3966 Vdefine_key_rebound_commands = Qt;
3968 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3969 doc: /* Default keymap to use when reading from the minibuffer. */);
3970 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3972 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3973 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
3974 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3975 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3977 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3978 doc: /* Local keymap for minibuffer input with completion. */);
3979 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3980 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
3982 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
3983 &Vminibuffer_local_filename_completion_map,
3984 doc: /* Local keymap for minibuffer input with completion for filenames. */);
3985 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
3986 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
3987 Vminibuffer_local_completion_map);
3990 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
3991 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
3992 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3993 Fset_keymap_parent (Vminibuffer_local_must_match_map,
3994 Vminibuffer_local_completion_map);
3996 DEFVAR_LISP ("minibuffer-local-filename-must-match-map",
3997 &Vminibuffer_local_filename_must_match_map,
3998 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
3999 Vminibuffer_local_filename_must_match_map = Fmake_sparse_keymap (Qnil);
4000 Fset_keymap_parent (Vminibuffer_local_filename_must_match_map,
4001 Vminibuffer_local_must_match_map);
4003 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
4004 doc: /* Alist of keymaps to use for minor modes.
4005 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
4006 key sequences and look up bindings if VARIABLE's value is non-nil.
4007 If two active keymaps bind the same key, the keymap appearing earlier
4008 in the list takes precedence. */);
4009 Vminor_mode_map_alist = Qnil;
4011 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
4012 doc: /* Alist of keymaps to use for minor modes, in current major mode.
4013 This variable is an alist just like `minor-mode-map-alist', and it is
4014 used the same way (and before `minor-mode-map-alist'); however,
4015 it is provided for major modes to bind locally. */);
4016 Vminor_mode_overriding_map_alist = Qnil;
4018 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
4019 doc: /* List of keymap alists to use for emulations modes.
4020 It is intended for modes or packages using multiple minor-mode keymaps.
4021 Each element is a keymap alist just like `minor-mode-map-alist', or a
4022 symbol with a variable binding which is a keymap alist, and it is used
4023 the same way. The "active" keymaps in each alist are used before
4024 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
4025 Vemulation_mode_map_alists = Qnil;
4027 DEFVAR_LISP ("where-is-preferred-modifier", &Vwhere_is_preferred_modifier,
4028 doc: /* Preferred modifier to use for `where-is'.
4029 When a single binding is requested, `where-is' will return one that
4030 uses this modifier if possible. If nil, or if no such binding exists,
4031 bindings using keys without modifiers (or only with meta) will be
4032 preferred. */);
4033 Vwhere_is_preferred_modifier = Qnil;
4034 where_is_preferred_modifier = 0;
4036 staticpro (&Vmouse_events);
4037 Vmouse_events = Fcons (intern ("menu-bar"),
4038 Fcons (intern ("tool-bar"),
4039 Fcons (intern ("header-line"),
4040 Fcons (intern ("mode-line"),
4041 Fcons (intern ("mouse-1"),
4042 Fcons (intern ("mouse-2"),
4043 Fcons (intern ("mouse-3"),
4044 Fcons (intern ("mouse-4"),
4045 Fcons (intern ("mouse-5"),
4046 Qnil)))))))));
4049 Qsingle_key_description = intern ("single-key-description");
4050 staticpro (&Qsingle_key_description);
4052 Qkey_description = intern ("key-description");
4053 staticpro (&Qkey_description);
4055 Qkeymapp = intern ("keymapp");
4056 staticpro (&Qkeymapp);
4058 Qnon_ascii = intern ("non-ascii");
4059 staticpro (&Qnon_ascii);
4061 Qmenu_item = intern ("menu-item");
4062 staticpro (&Qmenu_item);
4064 Qremap = intern ("remap");
4065 staticpro (&Qremap);
4067 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
4068 staticpro (&command_remapping_vector);
4070 where_is_cache_keymaps = Qt;
4071 where_is_cache = Qnil;
4072 staticpro (&where_is_cache);
4073 staticpro (&where_is_cache_keymaps);
4075 defsubr (&Skeymapp);
4076 defsubr (&Skeymap_parent);
4077 defsubr (&Skeymap_prompt);
4078 defsubr (&Sset_keymap_parent);
4079 defsubr (&Smake_keymap);
4080 defsubr (&Smake_sparse_keymap);
4081 defsubr (&Smap_keymap_internal);
4082 defsubr (&Smap_keymap);
4083 defsubr (&Scopy_keymap);
4084 defsubr (&Scommand_remapping);
4085 defsubr (&Skey_binding);
4086 defsubr (&Slocal_key_binding);
4087 defsubr (&Sglobal_key_binding);
4088 defsubr (&Sminor_mode_key_binding);
4089 defsubr (&Sdefine_key);
4090 defsubr (&Slookup_key);
4091 defsubr (&Sdefine_prefix_command);
4092 defsubr (&Suse_global_map);
4093 defsubr (&Suse_local_map);
4094 defsubr (&Scurrent_local_map);
4095 defsubr (&Scurrent_global_map);
4096 defsubr (&Scurrent_minor_mode_maps);
4097 defsubr (&Scurrent_active_maps);
4098 defsubr (&Saccessible_keymaps);
4099 defsubr (&Skey_description);
4100 defsubr (&Sdescribe_vector);
4101 defsubr (&Ssingle_key_description);
4102 defsubr (&Stext_char_description);
4103 defsubr (&Swhere_is_internal);
4104 defsubr (&Sdescribe_buffer_bindings);
4105 defsubr (&Sapropos_internal);
4108 void
4109 keys_of_keymap ()
4111 initial_define_key (global_map, 033, "ESC-prefix");
4112 initial_define_key (global_map, Ctl ('X'), "Control-X-prefix");
4115 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4116 (do not change this comment) */