(cal-tex-cursor-month-landscape)
[emacs.git] / src / keymap.c
blob9ed1e92c84b99982564a63c5beb2aa1dab0c69ab
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 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, or (at your option)
11 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; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 Boston, MA 02110-1301, USA. */
24 #include <config.h>
25 #include <stdio.h>
26 #if HAVE_ALLOCA_H
27 # include <alloca.h>
28 #endif
29 #include "lisp.h"
30 #include "commands.h"
31 #include "buffer.h"
32 #include "character.h"
33 #include "charset.h"
34 #include "keyboard.h"
35 #include "frame.h"
36 #include "termhooks.h"
37 #include "blockinput.h"
38 #include "puresize.h"
39 #include "intervals.h"
40 #include "keymap.h"
41 #include "window.h"
43 /* The number of elements in keymap vectors. */
44 #define DENSE_TABLE_SIZE (0200)
46 /* Actually allocate storage for these variables */
48 Lisp_Object current_global_map; /* Current global keymap */
50 Lisp_Object global_map; /* default global key bindings */
52 Lisp_Object meta_map; /* The keymap used for globally bound
53 ESC-prefixed default commands */
55 Lisp_Object control_x_map; /* The keymap used for globally bound
56 C-x-prefixed default commands */
58 /* was MinibufLocalMap */
59 Lisp_Object Vminibuffer_local_map;
60 /* The keymap used by the minibuf for local
61 bindings when spaces are allowed in the
62 minibuf */
64 /* was MinibufLocalNSMap */
65 Lisp_Object Vminibuffer_local_ns_map;
66 /* The keymap used by the minibuf for local
67 bindings when spaces are not encouraged
68 in the minibuf */
70 /* keymap used for minibuffers when doing completion */
71 /* was MinibufLocalCompletionMap */
72 Lisp_Object Vminibuffer_local_completion_map;
74 /* keymap used for minibuffers when doing completion in filenames */
75 Lisp_Object Vminibuffer_local_filename_completion_map;
77 /* keymap used for minibuffers when doing completion in filenames
78 with require-match*/
79 Lisp_Object Vminibuffer_local_must_match_filename_map;
81 /* keymap used for minibuffers when doing completion and require a match */
82 /* was MinibufLocalMustMatchMap */
83 Lisp_Object Vminibuffer_local_must_match_map;
85 /* Alist of minor mode variables and keymaps. */
86 Lisp_Object Vminor_mode_map_alist;
88 /* Alist of major-mode-specific overrides for
89 minor mode variables and keymaps. */
90 Lisp_Object Vminor_mode_overriding_map_alist;
92 /* List of emulation mode keymap alists. */
93 Lisp_Object Vemulation_mode_map_alists;
95 /* A list of all commands given new bindings since a certain time
96 when nil was stored here.
97 This is used to speed up recomputation of menu key equivalents
98 when Emacs starts up. t means don't record anything here. */
99 Lisp_Object Vdefine_key_rebound_commands;
101 Lisp_Object Qkeymapp, Qkeymap, Qnon_ascii, Qmenu_item, Qremap;
103 /* Alist of elements like (DEL . "\d"). */
104 static Lisp_Object exclude_keys;
106 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
107 static Lisp_Object command_remapping_vector;
109 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
110 in a string key sequence is equivalent to prefixing with this
111 character. */
112 extern Lisp_Object meta_prefix_char;
114 extern Lisp_Object Voverriding_local_map;
116 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
117 static Lisp_Object where_is_cache;
118 /* Which keymaps are reverse-stored in the cache. */
119 static Lisp_Object where_is_cache_keymaps;
121 static Lisp_Object store_in_keymap P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
122 static void fix_submap_inheritance P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
124 static Lisp_Object define_as_prefix P_ ((Lisp_Object, Lisp_Object));
125 static void describe_command P_ ((Lisp_Object, Lisp_Object));
126 static void describe_translation P_ ((Lisp_Object, Lisp_Object));
127 static void describe_map P_ ((Lisp_Object, Lisp_Object,
128 void (*) P_ ((Lisp_Object, Lisp_Object)),
129 int, Lisp_Object, Lisp_Object*, int, int));
130 static void describe_vector P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
131 void (*) (Lisp_Object, Lisp_Object), int,
132 Lisp_Object, Lisp_Object, int *,
133 int, int, int));
134 static void silly_event_symbol_error P_ ((Lisp_Object));
136 /* Keymap object support - constructors and predicates. */
138 DEFUN ("make-keymap", Fmake_keymap, Smake_keymap, 0, 1, 0,
139 doc: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
140 CHARTABLE is a char-table that holds the bindings for all characters
141 without modifiers. All entries in it are initially nil, meaning
142 "command undefined". ALIST is an assoc-list which holds bindings for
143 function keys, mouse events, and any other things that appear in the
144 input stream. Initially, ALIST is nil.
146 The optional arg STRING supplies a menu name for the keymap
147 in case you use it as a menu with `x-popup-menu'. */)
148 (string)
149 Lisp_Object string;
151 Lisp_Object tail;
152 if (!NILP (string))
153 tail = Fcons (string, Qnil);
154 else
155 tail = Qnil;
156 return Fcons (Qkeymap,
157 Fcons (Fmake_char_table (Qkeymap, Qnil), tail));
160 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap, Smake_sparse_keymap, 0, 1, 0,
161 doc: /* Construct and return a new sparse keymap.
162 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
163 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
164 which binds the function key or mouse event SYMBOL to DEFINITION.
165 Initially the alist is nil.
167 The optional arg STRING supplies a menu name for the keymap
168 in case you use it as a menu with `x-popup-menu'. */)
169 (string)
170 Lisp_Object string;
172 if (!NILP (string))
173 return Fcons (Qkeymap, Fcons (string, Qnil));
174 return Fcons (Qkeymap, Qnil);
177 /* This function is used for installing the standard key bindings
178 at initialization time.
180 For example:
182 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
184 void
185 initial_define_key (keymap, key, defname)
186 Lisp_Object keymap;
187 int key;
188 char *defname;
190 store_in_keymap (keymap, make_number (key), intern (defname));
193 void
194 initial_define_lispy_key (keymap, keyname, defname)
195 Lisp_Object keymap;
196 char *keyname;
197 char *defname;
199 store_in_keymap (keymap, intern (keyname), intern (defname));
202 DEFUN ("keymapp", Fkeymapp, Skeymapp, 1, 1, 0,
203 doc: /* Return t if OBJECT is a keymap.
205 A keymap is a list (keymap . ALIST),
206 or a symbol whose function definition is itself a keymap.
207 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
208 a vector of densely packed bindings for small character codes
209 is also allowed as an element. */)
210 (object)
211 Lisp_Object object;
213 return (KEYMAPP (object) ? Qt : Qnil);
216 DEFUN ("keymap-prompt", Fkeymap_prompt, Skeymap_prompt, 1, 1, 0,
217 doc: /* Return the prompt-string of a keymap MAP.
218 If non-nil, the prompt is shown in the echo-area
219 when reading a key-sequence to be looked-up in this keymap. */)
220 (map)
221 Lisp_Object map;
223 map = get_keymap (map, 0, 0);
224 while (CONSP (map))
226 Lisp_Object tem = XCAR (map);
227 if (STRINGP (tem))
228 return tem;
229 map = XCDR (map);
231 return Qnil;
234 /* Check that OBJECT is a keymap (after dereferencing through any
235 symbols). If it is, return it.
237 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
238 is an autoload form, do the autoload and try again.
239 If AUTOLOAD is nonzero, callers must assume GC is possible.
241 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
242 is zero as well), return Qt.
244 ERROR controls how we respond if OBJECT isn't a keymap.
245 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
247 Note that most of the time, we don't want to pursue autoloads.
248 Functions like Faccessible_keymaps which scan entire keymap trees
249 shouldn't load every autoloaded keymap. I'm not sure about this,
250 but it seems to me that only read_key_sequence, Flookup_key, and
251 Fdefine_key should cause keymaps to be autoloaded.
253 This function can GC when AUTOLOAD is non-zero, because it calls
254 do_autoload which can GC. */
256 Lisp_Object
257 get_keymap (object, error, autoload)
258 Lisp_Object object;
259 int error, autoload;
261 Lisp_Object tem;
263 autoload_retry:
264 if (NILP (object))
265 goto end;
266 if (CONSP (object) && EQ (XCAR (object), Qkeymap))
267 return object;
269 tem = indirect_function (object);
270 if (CONSP (tem))
272 if (EQ (XCAR (tem), Qkeymap))
273 return tem;
275 /* Should we do an autoload? Autoload forms for keymaps have
276 Qkeymap as their fifth element. */
277 if ((autoload || !error) && EQ (XCAR (tem), Qautoload)
278 && SYMBOLP (object))
280 Lisp_Object tail;
282 tail = Fnth (make_number (4), tem);
283 if (EQ (tail, Qkeymap))
285 if (autoload)
287 struct gcpro gcpro1, gcpro2;
289 GCPRO2 (tem, object);
290 do_autoload (tem, object);
291 UNGCPRO;
293 goto autoload_retry;
295 else
296 return Qt;
301 end:
302 if (error)
303 wrong_type_argument (Qkeymapp, object);
304 return Qnil;
307 /* Return the parent map of KEYMAP, or nil if it has none.
308 We assume that KEYMAP is a valid keymap. */
310 Lisp_Object
311 keymap_parent (keymap, autoload)
312 Lisp_Object keymap;
313 int autoload;
315 Lisp_Object list;
317 keymap = get_keymap (keymap, 1, autoload);
319 /* Skip past the initial element `keymap'. */
320 list = XCDR (keymap);
321 for (; CONSP (list); list = XCDR (list))
323 /* See if there is another `keymap'. */
324 if (KEYMAPP (list))
325 return list;
328 return get_keymap (list, 0, autoload);
331 DEFUN ("keymap-parent", Fkeymap_parent, Skeymap_parent, 1, 1, 0,
332 doc: /* Return the parent keymap of KEYMAP. */)
333 (keymap)
334 Lisp_Object keymap;
336 return keymap_parent (keymap, 1);
339 /* Check whether MAP is one of MAPS parents. */
341 keymap_memberp (map, maps)
342 Lisp_Object map, maps;
344 if (NILP (map)) return 0;
345 while (KEYMAPP (maps) && !EQ (map, maps))
346 maps = keymap_parent (maps, 0);
347 return (EQ (map, maps));
350 /* Set the parent keymap of MAP to PARENT. */
352 DEFUN ("set-keymap-parent", Fset_keymap_parent, Sset_keymap_parent, 2, 2, 0,
353 doc: /* Modify KEYMAP to set its parent map to PARENT.
354 Return PARENT. PARENT should be nil or another keymap. */)
355 (keymap, parent)
356 Lisp_Object keymap, parent;
358 Lisp_Object list, prev;
359 struct gcpro gcpro1, gcpro2;
360 int i;
362 /* Force a keymap flush for the next call to where-is.
363 Since this can be called from within where-is, we don't set where_is_cache
364 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
365 be changed during where-is, while where_is_cache_keymaps is only used at
366 the very beginning of where-is and can thus be changed here without any
367 adverse effect.
368 This is a very minor correctness (rather than safety) issue. */
369 where_is_cache_keymaps = Qt;
371 GCPRO2 (keymap, parent);
372 keymap = get_keymap (keymap, 1, 1);
374 if (!NILP (parent))
376 parent = get_keymap (parent, 1, 1);
378 /* Check for cycles. */
379 if (keymap_memberp (keymap, parent))
380 error ("Cyclic keymap inheritance");
383 /* Skip past the initial element `keymap'. */
384 prev = keymap;
385 while (1)
387 list = XCDR (prev);
388 /* If there is a parent keymap here, replace it.
389 If we came to the end, add the parent in PREV. */
390 if (!CONSP (list) || KEYMAPP (list))
392 /* If we already have the right parent, return now
393 so that we avoid the loops below. */
394 if (EQ (XCDR (prev), parent))
395 RETURN_UNGCPRO (parent);
397 CHECK_IMPURE (prev);
398 XSETCDR (prev, parent);
399 break;
401 prev = list;
404 /* Scan through for submaps, and set their parents too. */
406 for (list = XCDR (keymap); CONSP (list); list = XCDR (list))
408 /* Stop the scan when we come to the parent. */
409 if (EQ (XCAR (list), Qkeymap))
410 break;
412 /* If this element holds a prefix map, deal with it. */
413 if (CONSP (XCAR (list))
414 && CONSP (XCDR (XCAR (list))))
415 fix_submap_inheritance (keymap, XCAR (XCAR (list)),
416 XCDR (XCAR (list)));
418 if (VECTORP (XCAR (list)))
419 for (i = 0; i < XVECTOR (XCAR (list))->size; i++)
420 if (CONSP (XVECTOR (XCAR (list))->contents[i]))
421 fix_submap_inheritance (keymap, make_number (i),
422 XVECTOR (XCAR (list))->contents[i]);
424 if (CHAR_TABLE_P (XCAR (list)))
426 map_char_table (fix_submap_inheritance, Qnil, XCAR (list), keymap);
430 RETURN_UNGCPRO (parent);
433 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
434 if EVENT is also a prefix in MAP's parent,
435 make sure that SUBMAP inherits that definition as its own parent. */
437 static void
438 fix_submap_inheritance (map, event, submap)
439 Lisp_Object map, event, submap;
441 Lisp_Object map_parent, parent_entry;
443 /* SUBMAP is a cons that we found as a key binding.
444 Discard the other things found in a menu key binding. */
446 submap = get_keymap (get_keyelt (submap, 0), 0, 0);
448 /* If it isn't a keymap now, there's no work to do. */
449 if (!CONSP (submap))
450 return;
452 map_parent = keymap_parent (map, 0);
453 if (!NILP (map_parent))
454 parent_entry =
455 get_keymap (access_keymap (map_parent, event, 0, 0, 0), 0, 0);
456 else
457 parent_entry = Qnil;
459 /* If MAP's parent has something other than a keymap,
460 our own submap shadows it completely. */
461 if (!CONSP (parent_entry))
462 return;
464 if (! EQ (parent_entry, submap))
466 Lisp_Object submap_parent;
467 submap_parent = submap;
468 while (1)
470 Lisp_Object tem;
472 tem = keymap_parent (submap_parent, 0);
474 if (KEYMAPP (tem))
476 if (keymap_memberp (tem, parent_entry))
477 /* Fset_keymap_parent could create a cycle. */
478 return;
479 submap_parent = tem;
481 else
482 break;
484 Fset_keymap_parent (submap_parent, parent_entry);
488 /* Look up IDX in MAP. IDX may be any sort of event.
489 Note that this does only one level of lookup; IDX must be a single
490 event, not a sequence.
492 If T_OK is non-zero, bindings for Qt are treated as default
493 bindings; any key left unmentioned by other tables and bindings is
494 given the binding of Qt.
496 If T_OK is zero, bindings for Qt are not treated specially.
498 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
500 Lisp_Object
501 access_keymap (map, idx, t_ok, noinherit, autoload)
502 Lisp_Object map;
503 Lisp_Object idx;
504 int t_ok;
505 int noinherit;
506 int autoload;
508 Lisp_Object val;
510 /* Qunbound in VAL means we have found no binding yet. */
511 val = Qunbound;
513 /* If idx is a list (some sort of mouse click, perhaps?),
514 the index we want to use is the car of the list, which
515 ought to be a symbol. */
516 idx = EVENT_HEAD (idx);
518 /* If idx is a symbol, it might have modifiers, which need to
519 be put in the canonical order. */
520 if (SYMBOLP (idx))
521 idx = reorder_modifiers (idx);
522 else if (INTEGERP (idx))
523 /* Clobber the high bits that can be present on a machine
524 with more than 24 bits of integer. */
525 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
527 /* Handle the special meta -> esc mapping. */
528 if (INTEGERP (idx) && XUINT (idx) & meta_modifier)
530 /* See if there is a meta-map. If there's none, there is
531 no binding for IDX, unless a default binding exists in MAP. */
532 struct gcpro gcpro1;
533 Lisp_Object meta_map;
534 GCPRO1 (map);
535 /* A strange value in which Meta is set would cause
536 infinite recursion. Protect against that. */
537 if (XINT (meta_prefix_char) & CHAR_META)
538 meta_prefix_char = make_number (27);
539 meta_map = get_keymap (access_keymap (map, meta_prefix_char,
540 t_ok, noinherit, autoload),
541 0, autoload);
542 UNGCPRO;
543 if (CONSP (meta_map))
545 map = meta_map;
546 idx = make_number (XUINT (idx) & ~meta_modifier);
548 else if (t_ok)
549 /* Set IDX to t, so that we only find a default binding. */
550 idx = Qt;
551 else
552 /* We know there is no binding. */
553 return Qnil;
556 /* t_binding is where we put a default binding that applies,
557 to use in case we do not find a binding specifically
558 for this key sequence. */
560 Lisp_Object tail;
561 Lisp_Object t_binding = Qnil;
562 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
564 GCPRO4 (map, tail, idx, t_binding);
566 /* If `t_ok' is 2, both `t' is accepted. */
567 t_ok = t_ok ? 2 : 0;
569 for (tail = XCDR (map);
570 (CONSP (tail)
571 || (tail = get_keymap (tail, 0, autoload), CONSP (tail)));
572 tail = XCDR (tail))
574 Lisp_Object binding;
576 binding = XCAR (tail);
577 if (SYMBOLP (binding))
579 /* If NOINHERIT, stop finding prefix definitions
580 after we pass a second occurrence of the `keymap' symbol. */
581 if (noinherit && EQ (binding, Qkeymap))
582 RETURN_UNGCPRO (Qnil);
584 else if (CONSP (binding))
586 Lisp_Object key = XCAR (binding);
588 if (EQ (key, idx))
589 val = XCDR (binding);
590 else if (t_ok > 1 && EQ (key, Qt))
592 t_binding = XCDR (binding);
593 t_ok = 1;
596 else if (VECTORP (binding))
598 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (binding))
599 val = AREF (binding, XFASTINT (idx));
601 else if (CHAR_TABLE_P (binding))
603 /* Character codes with modifiers
604 are not included in a char-table.
605 All character codes without modifiers are included. */
606 if (NATNUMP (idx) && (XFASTINT (idx) & CHAR_MODIFIER_MASK) == 0)
608 val = Faref (binding, idx);
609 /* `nil' has a special meaning for char-tables, so
610 we use something else to record an explicitly
611 unbound entry. */
612 if (NILP (val))
613 val = Qunbound;
617 /* If we found a binding, clean it up and return it. */
618 if (!EQ (val, Qunbound))
620 if (EQ (val, Qt))
621 /* A Qt binding is just like an explicit nil binding
622 (i.e. it shadows any parent binding but not bindings in
623 keymaps of lower precedence). */
624 val = Qnil;
625 val = get_keyelt (val, autoload);
626 if (KEYMAPP (val))
627 fix_submap_inheritance (map, idx, val);
628 RETURN_UNGCPRO (val);
630 QUIT;
632 UNGCPRO;
633 return get_keyelt (t_binding, autoload);
637 static void
638 map_keymap_item (fun, args, key, val, data)
639 map_keymap_function_t fun;
640 Lisp_Object args, key, val;
641 void *data;
643 /* We should maybe try to detect bindings shadowed by previous
644 ones and things like that. */
645 if (EQ (val, Qt))
646 val = Qnil;
647 (*fun) (key, val, args, data);
650 static void
651 map_keymap_char_table_item (args, key, val)
652 Lisp_Object args, key, val;
654 if (!NILP (val))
656 map_keymap_function_t fun = XSAVE_VALUE (XCAR (args))->pointer;
657 args = XCDR (args);
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 DEFUN ("map-keymap-internal", Fmap_keymap_internal, Smap_keymap_internal, 2, 2, 0,
735 doc: /* Call FUNCTION once for each event binding in KEYMAP.
736 FUNCTION is called with two arguments: the event that is bound, and
737 the definition it is bound to. The event may be a character range.
738 If KEYMAP has a parent, this function returns it without processing it. */)
739 (function, keymap)
740 Lisp_Object function, keymap;
742 struct gcpro gcpro1;
743 GCPRO1 (function);
744 keymap = get_keymap (keymap, 1, 1);
745 keymap = map_keymap_internal (keymap, map_keymap_call, function, NULL);
746 UNGCPRO;
747 return keymap;
750 DEFUN ("map-keymap", Fmap_keymap, Smap_keymap, 2, 3, 0,
751 doc: /* Call FUNCTION once for each event binding in KEYMAP.
752 FUNCTION is called with two arguments: the event that is bound, and
753 the definition it is bound to. The event may be a character range.
755 If KEYMAP has a parent, the parent's bindings are included as well.
756 This works recursively: if the parent has itself a parent, then the
757 grandparent's bindings are also included and so on.
758 usage: (map-keymap FUNCTION KEYMAP) */)
759 (function, keymap, sort_first)
760 Lisp_Object function, keymap, sort_first;
762 if (! NILP (sort_first))
763 return call2 (intern ("map-keymap-sorted"), function, keymap);
765 map_keymap (keymap, map_keymap_call, function, NULL, 1);
766 return Qnil;
769 /* Given OBJECT which was found in a slot in a keymap,
770 trace indirect definitions to get the actual definition of that slot.
771 An indirect definition is a list of the form
772 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
773 and INDEX is the object to look up in KEYMAP to yield the definition.
775 Also if OBJECT has a menu string as the first element,
776 remove that. Also remove a menu help string as second element.
778 If AUTOLOAD is nonzero, load autoloadable keymaps
779 that are referred to with indirection.
781 This can GC because menu_item_eval_property calls Feval. */
783 Lisp_Object
784 get_keyelt (object, autoload)
785 Lisp_Object object;
786 int autoload;
788 while (1)
790 if (!(CONSP (object)))
791 /* This is really the value. */
792 return object;
794 /* If the keymap contents looks like (keymap ...) or (lambda ...)
795 then use itself. */
796 else if (EQ (XCAR (object), Qkeymap) || EQ (XCAR (object), Qlambda))
797 return object;
799 /* If the keymap contents looks like (menu-item name . DEFN)
800 or (menu-item name DEFN ...) then use DEFN.
801 This is a new format menu item. */
802 else if (EQ (XCAR (object), Qmenu_item))
804 if (CONSP (XCDR (object)))
806 Lisp_Object tem;
808 object = XCDR (XCDR (object));
809 tem = object;
810 if (CONSP (object))
811 object = XCAR (object);
813 /* If there's a `:filter FILTER', apply FILTER to the
814 menu-item's definition to get the real definition to
815 use. */
816 for (; CONSP (tem) && CONSP (XCDR (tem)); tem = XCDR (tem))
817 if (EQ (XCAR (tem), QCfilter) && autoload)
819 Lisp_Object filter;
820 filter = XCAR (XCDR (tem));
821 filter = list2 (filter, list2 (Qquote, object));
822 object = menu_item_eval_property (filter);
823 break;
826 else
827 /* Invalid keymap. */
828 return object;
831 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
832 Keymap alist elements like (CHAR MENUSTRING . DEFN)
833 will be used by HierarKey menus. */
834 else if (STRINGP (XCAR (object)))
836 object = XCDR (object);
837 /* Also remove a menu help string, if any,
838 following the menu item name. */
839 if (CONSP (object) && STRINGP (XCAR (object)))
840 object = XCDR (object);
841 /* Also remove the sublist that caches key equivalences, if any. */
842 if (CONSP (object) && CONSP (XCAR (object)))
844 Lisp_Object carcar;
845 carcar = XCAR (XCAR (object));
846 if (NILP (carcar) || VECTORP (carcar))
847 object = XCDR (object);
851 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
852 else
854 struct gcpro gcpro1;
855 Lisp_Object map;
856 GCPRO1 (object);
857 map = get_keymap (Fcar_safe (object), 0, autoload);
858 UNGCPRO;
859 return (!CONSP (map) ? object /* Invalid keymap */
860 : access_keymap (map, Fcdr (object), 0, 0, autoload));
865 static Lisp_Object
866 store_in_keymap (keymap, idx, def)
867 Lisp_Object keymap;
868 register Lisp_Object idx;
869 Lisp_Object def;
871 /* Flush any reverse-map cache. */
872 where_is_cache = Qnil;
873 where_is_cache_keymaps = Qt;
875 /* If we are preparing to dump, and DEF is a menu element
876 with a menu item indicator, copy it to ensure it is not pure. */
877 if (CONSP (def) && PURE_P (def)
878 && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def))))
879 def = Fcons (XCAR (def), XCDR (def));
881 if (!CONSP (keymap) || !EQ (XCAR (keymap), Qkeymap))
882 error ("attempt to define a key in a non-keymap");
884 /* If idx is a cons, and the car part is a character, idx must be of
885 the form (FROM-CHAR . TO-CHAR). */
886 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
887 CHECK_CHARACTER_CDR (idx);
888 else
889 /* If idx is a list (some sort of mouse click, perhaps?),
890 the index we want to use is the car of the list, which
891 ought to be a symbol. */
892 idx = EVENT_HEAD (idx);
894 /* If idx is a symbol, it might have modifiers, which need to
895 be put in the canonical order. */
896 if (SYMBOLP (idx))
897 idx = reorder_modifiers (idx);
898 else if (INTEGERP (idx))
899 /* Clobber the high bits that can be present on a machine
900 with more than 24 bits of integer. */
901 XSETFASTINT (idx, XINT (idx) & (CHAR_META | (CHAR_META - 1)));
903 /* Scan the keymap for a binding of idx. */
905 Lisp_Object tail;
907 /* The cons after which we should insert new bindings. If the
908 keymap has a table element, we record its position here, so new
909 bindings will go after it; this way, the table will stay
910 towards the front of the alist and character lookups in dense
911 keymaps will remain fast. Otherwise, this just points at the
912 front of the keymap. */
913 Lisp_Object insertion_point;
915 insertion_point = keymap;
916 for (tail = XCDR (keymap); CONSP (tail); tail = XCDR (tail))
918 Lisp_Object elt;
920 elt = XCAR (tail);
921 if (VECTORP (elt))
923 if (NATNUMP (idx) && XFASTINT (idx) < ASIZE (elt))
925 CHECK_IMPURE (elt);
926 ASET (elt, XFASTINT (idx), def);
927 return def;
929 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
931 int from = XFASTINT (XCAR (idx));
932 int to = XFASTINT (XCDR (idx));
934 if (to >= ASIZE (elt))
935 to = ASIZE (elt) - 1;
936 for (; from <= to; from++)
937 ASET (elt, from, def);
938 if (to == XFASTINT (XCDR (idx)))
939 /* We have defined all keys in IDX. */
940 return def;
942 insertion_point = tail;
944 else if (CHAR_TABLE_P (elt))
946 /* Character codes with modifiers
947 are not included in a char-table.
948 All character codes without modifiers are included. */
949 if (NATNUMP (idx) && !(XFASTINT (idx) & CHAR_MODIFIER_MASK))
951 Faset (elt, idx,
952 /* `nil' has a special meaning for char-tables, so
953 we use something else to record an explicitly
954 unbound entry. */
955 NILP (def) ? Qt : def);
956 return def;
958 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
960 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
961 return def;
963 insertion_point = tail;
965 else if (CONSP (elt))
967 if (EQ (idx, XCAR (elt)))
969 CHECK_IMPURE (elt);
970 XSETCDR (elt, def);
971 return def;
973 else if (CONSP (idx) && CHARACTERP (XCAR (idx)))
975 int from = XFASTINT (XCAR (idx));
976 int to = XFASTINT (XCDR (idx));
978 if (from <= XFASTINT (XCAR (elt))
979 && to >= XFASTINT (XCAR (elt)))
981 XSETCDR (elt, def);
982 if (from == to)
983 return def;
987 else if (EQ (elt, Qkeymap))
988 /* If we find a 'keymap' symbol in the spine of KEYMAP,
989 then we must have found the start of a second keymap
990 being used as the tail of KEYMAP, and a binding for IDX
991 should be inserted before it. */
992 goto keymap_end;
994 QUIT;
997 keymap_end:
998 /* We have scanned the entire keymap, and not found a binding for
999 IDX. Let's add one. */
1001 Lisp_Object elt;
1003 if (CONSP (idx) && CHARACTERP (XCAR (idx)))
1005 /* IDX specifies a range of characters, and not all of them
1006 were handled yet, which means this keymap doesn't have a
1007 char-table. So, we insert a char-table now. */
1008 elt = Fmake_char_table (Qkeymap, Qnil);
1009 Fset_char_table_range (elt, idx, NILP (def) ? Qt : def);
1011 else
1012 elt = Fcons (idx, def);
1013 CHECK_IMPURE (insertion_point);
1014 XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point)));
1018 return def;
1021 EXFUN (Fcopy_keymap, 1);
1023 Lisp_Object
1024 copy_keymap_item (elt)
1025 Lisp_Object elt;
1027 Lisp_Object res, tem;
1029 if (!CONSP (elt))
1030 return elt;
1032 res = tem = elt;
1034 /* Is this a new format menu item. */
1035 if (EQ (XCAR (tem), Qmenu_item))
1037 /* Copy cell with menu-item marker. */
1038 res = elt = Fcons (XCAR (tem), XCDR (tem));
1039 tem = XCDR (elt);
1040 if (CONSP (tem))
1042 /* Copy cell with menu-item name. */
1043 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1044 elt = XCDR (elt);
1045 tem = XCDR (elt);
1047 if (CONSP (tem))
1049 /* Copy cell with binding and if the binding is a keymap,
1050 copy that. */
1051 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1052 elt = XCDR (elt);
1053 tem = XCAR (elt);
1054 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1055 XSETCAR (elt, Fcopy_keymap (tem));
1056 tem = XCDR (elt);
1057 if (CONSP (tem) && CONSP (XCAR (tem)))
1058 /* Delete cache for key equivalences. */
1059 XSETCDR (elt, XCDR (tem));
1062 else
1064 /* It may be an old fomat menu item.
1065 Skip the optional menu string. */
1066 if (STRINGP (XCAR (tem)))
1068 /* Copy the cell, since copy-alist didn't go this deep. */
1069 res = elt = Fcons (XCAR (tem), XCDR (tem));
1070 tem = XCDR (elt);
1071 /* Also skip the optional menu help string. */
1072 if (CONSP (tem) && STRINGP (XCAR (tem)))
1074 XSETCDR (elt, Fcons (XCAR (tem), XCDR (tem)));
1075 elt = XCDR (elt);
1076 tem = XCDR (elt);
1078 /* There may also be a list that caches key equivalences.
1079 Just delete it for the new keymap. */
1080 if (CONSP (tem)
1081 && CONSP (XCAR (tem))
1082 && (NILP (XCAR (XCAR (tem)))
1083 || VECTORP (XCAR (XCAR (tem)))))
1085 XSETCDR (elt, XCDR (tem));
1086 tem = XCDR (tem);
1088 if (CONSP (tem) && EQ (XCAR (tem), Qkeymap))
1089 XSETCDR (elt, Fcopy_keymap (tem));
1091 else if (EQ (XCAR (tem), Qkeymap))
1092 res = Fcopy_keymap (elt);
1094 return res;
1097 static void
1098 copy_keymap_1 (chartable, idx, elt)
1099 Lisp_Object chartable, idx, elt;
1101 Fset_char_table_range (chartable, idx, copy_keymap_item (elt));
1104 DEFUN ("copy-keymap", Fcopy_keymap, Scopy_keymap, 1, 1, 0,
1105 doc: /* Return a copy of the keymap KEYMAP.
1106 The copy starts out with the same definitions of KEYMAP,
1107 but changing either the copy or KEYMAP does not affect the other.
1108 Any key definitions that are subkeymaps are recursively copied.
1109 However, a key definition which is a symbol whose definition is a keymap
1110 is not copied. */)
1111 (keymap)
1112 Lisp_Object keymap;
1114 register Lisp_Object copy, tail;
1115 keymap = get_keymap (keymap, 1, 0);
1116 copy = tail = Fcons (Qkeymap, Qnil);
1117 keymap = XCDR (keymap); /* Skip the `keymap' symbol. */
1119 while (CONSP (keymap) && !EQ (XCAR (keymap), Qkeymap))
1121 Lisp_Object elt = XCAR (keymap);
1122 if (CHAR_TABLE_P (elt))
1124 elt = Fcopy_sequence (elt);
1125 map_char_table (copy_keymap_1, Qnil, elt, elt);
1127 else if (VECTORP (elt))
1129 int i;
1130 elt = Fcopy_sequence (elt);
1131 for (i = 0; i < ASIZE (elt); i++)
1132 ASET (elt, i, copy_keymap_item (AREF (elt, i)));
1134 else if (CONSP (elt))
1135 elt = Fcons (XCAR (elt), copy_keymap_item (XCDR (elt)));
1136 XSETCDR (tail, Fcons (elt, Qnil));
1137 tail = XCDR (tail);
1138 keymap = XCDR (keymap);
1140 XSETCDR (tail, keymap);
1141 return copy;
1144 /* Simple Keymap mutators and accessors. */
1146 /* GC is possible in this function if it autoloads a keymap. */
1148 DEFUN ("define-key", Fdefine_key, Sdefine_key, 3, 3, 0,
1149 doc: /* In KEYMAP, define key sequence KEY as DEF.
1150 KEYMAP is a keymap.
1152 KEY is a string or a vector of symbols and characters meaning a
1153 sequence of keystrokes and events. Non-ASCII characters with codes
1154 above 127 (such as ISO Latin-1) can be included if you use a vector.
1155 Using [t] for KEY creates a default definition, which applies to any
1156 event type that has no other definition in this keymap.
1158 DEF is anything that can be a key's definition:
1159 nil (means key is undefined in this keymap),
1160 a command (a Lisp function suitable for interactive calling),
1161 a string (treated as a keyboard macro),
1162 a keymap (to define a prefix key),
1163 a symbol (when the key is looked up, the symbol will stand for its
1164 function definition, which should at that time be one of the above,
1165 or another symbol whose function definition is used, etc.),
1166 a cons (STRING . DEFN), meaning that DEFN is the definition
1167 (DEFN should be a valid definition in its own right),
1168 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP,
1169 or an extended menu item definition.
1170 (See info node `(elisp)Extended Menu Items'.)
1172 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1173 binding is altered. If there is no binding for KEY, the new pair
1174 binding KEY to DEF is added at the front of KEYMAP. */)
1175 (keymap, key, def)
1176 Lisp_Object keymap;
1177 Lisp_Object key;
1178 Lisp_Object def;
1180 register int idx;
1181 register Lisp_Object c;
1182 register Lisp_Object cmd;
1183 int metized = 0;
1184 int meta_bit;
1185 int length;
1186 struct gcpro gcpro1, gcpro2, gcpro3;
1188 GCPRO3 (keymap, key, def);
1189 keymap = get_keymap (keymap, 1, 1);
1191 CHECK_VECTOR_OR_STRING (key);
1193 length = XFASTINT (Flength (key));
1194 if (length == 0)
1195 RETURN_UNGCPRO (Qnil);
1197 if (SYMBOLP (def) && !EQ (Vdefine_key_rebound_commands, Qt))
1198 Vdefine_key_rebound_commands = Fcons (def, Vdefine_key_rebound_commands);
1200 meta_bit = (VECTORP (key) || (STRINGP (key) && STRING_MULTIBYTE (key))
1201 ? meta_modifier : 0x80);
1203 if (VECTORP (def) && ASIZE (def) > 0 && CONSP (AREF (def, 0)))
1204 { /* DEF is apparently an XEmacs-style keyboard macro. */
1205 Lisp_Object tmp = Fmake_vector (make_number (ASIZE (def)), Qnil);
1206 int i = ASIZE (def);
1207 while (--i >= 0)
1209 Lisp_Object c = AREF (def, i);
1210 if (CONSP (c) && lucid_event_type_list_p (c))
1211 c = Fevent_convert_list (c);
1212 ASET (tmp, i, c);
1214 def = tmp;
1217 idx = 0;
1218 while (1)
1220 c = Faref (key, make_number (idx));
1222 if (CONSP (c))
1224 /* C may be a Lucid style event type list or a cons (FROM .
1225 TO) specifying a range of characters. */
1226 if (lucid_event_type_list_p (c))
1227 c = Fevent_convert_list (c);
1228 else if (CHARACTERP (XCAR (c)))
1229 CHECK_CHARACTER_CDR (c);
1232 if (SYMBOLP (c))
1233 silly_event_symbol_error (c);
1235 if (INTEGERP (c)
1236 && (XINT (c) & meta_bit)
1237 && !metized)
1239 c = meta_prefix_char;
1240 metized = 1;
1242 else
1244 if (INTEGERP (c))
1245 XSETINT (c, XINT (c) & ~meta_bit);
1247 metized = 0;
1248 idx++;
1251 if (!INTEGERP (c) && !SYMBOLP (c)
1252 && (!CONSP (c)
1253 /* If C is a range, it must be a leaf. */
1254 || (INTEGERP (XCAR (c)) && idx != length)))
1255 error ("Key sequence contains invalid event");
1257 if (idx == length)
1258 RETURN_UNGCPRO (store_in_keymap (keymap, c, def));
1260 cmd = access_keymap (keymap, c, 0, 1, 1);
1262 /* If this key is undefined, make it a prefix. */
1263 if (NILP (cmd))
1264 cmd = define_as_prefix (keymap, c);
1266 keymap = get_keymap (cmd, 0, 1);
1267 if (!CONSP (keymap))
1268 /* We must use Fkey_description rather than just passing key to
1269 error; key might be a vector, not a string. */
1270 error ("Key sequence %s starts with non-prefix key %s",
1271 SDATA (Fkey_description (key, Qnil)),
1272 SDATA (Fkey_description (Fsubstring (key, make_number (0),
1273 make_number (idx)),
1274 Qnil)));
1278 /* This function may GC (it calls Fkey_binding). */
1280 DEFUN ("command-remapping", Fcommand_remapping, Scommand_remapping, 1, 3, 0,
1281 doc: /* Return the remapping for command COMMAND.
1282 Returns nil if COMMAND is not remapped (or not a symbol).
1284 If the optional argument POSITION is non-nil, it specifies a mouse
1285 position as returned by `event-start' and `event-end', and the
1286 remapping occurs in the keymaps associated with it. It can also be a
1287 number or marker, in which case the keymap properties at the specified
1288 buffer position instead of point are used. The KEYMAPS argument is
1289 ignored if POSITION is non-nil.
1291 If the optional argument KEYMAPS is non-nil, it should be a list of
1292 keymaps to search for command remapping. Otherwise, search for the
1293 remapping in all currently active keymaps. */)
1294 (command, position, keymaps)
1295 Lisp_Object command, position, keymaps;
1297 if (!SYMBOLP (command))
1298 return Qnil;
1300 ASET (command_remapping_vector, 1, command);
1302 if (NILP (keymaps))
1303 return Fkey_binding (command_remapping_vector, Qnil, Qt, position);
1304 else
1306 Lisp_Object maps, binding;
1308 for (maps = keymaps; CONSP (maps); maps = XCDR (maps))
1310 binding = Flookup_key (XCAR (maps), command_remapping_vector, Qnil);
1311 if (!NILP (binding) && !INTEGERP (binding))
1312 return binding;
1314 return Qnil;
1318 /* Value is number if KEY is too long; nil if valid but has no definition. */
1319 /* GC is possible in this function if it autoloads a keymap. */
1321 DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
1322 doc: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1323 A value of nil means undefined. See doc of `define-key'
1324 for kinds of definitions.
1326 A number as value means KEY is "too long";
1327 that is, characters or symbols in it except for the last one
1328 fail to be a valid sequence of prefix characters in KEYMAP.
1329 The number is how many characters at the front of KEY
1330 it takes to reach a non-prefix key.
1332 Normally, `lookup-key' ignores bindings for t, which act as default
1333 bindings, used when nothing else in the keymap applies; this makes it
1334 usable as a general function for probing keymaps. However, if the
1335 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1336 recognize the default bindings, just as `read-key-sequence' does. */)
1337 (keymap, key, accept_default)
1338 Lisp_Object keymap;
1339 Lisp_Object key;
1340 Lisp_Object accept_default;
1342 register int idx;
1343 register Lisp_Object cmd;
1344 register Lisp_Object c;
1345 int length;
1346 int t_ok = !NILP (accept_default);
1347 struct gcpro gcpro1, gcpro2;
1349 GCPRO2 (keymap, key);
1350 keymap = get_keymap (keymap, 1, 1);
1352 CHECK_VECTOR_OR_STRING (key);
1354 length = XFASTINT (Flength (key));
1355 if (length == 0)
1356 RETURN_UNGCPRO (keymap);
1358 idx = 0;
1359 while (1)
1361 c = Faref (key, make_number (idx++));
1363 if (CONSP (c) && lucid_event_type_list_p (c))
1364 c = Fevent_convert_list (c);
1366 /* Turn the 8th bit of string chars into a meta modifier. */
1367 if (STRINGP (key) && XINT (c) & 0x80 && !STRING_MULTIBYTE (key))
1368 XSETINT (c, (XINT (c) | meta_modifier) & ~0x80);
1370 /* Allow string since binding for `menu-bar-select-buffer'
1371 includes the buffer name in the key sequence. */
1372 if (!INTEGERP (c) && !SYMBOLP (c) && !CONSP (c) && !STRINGP (c))
1373 error ("Key sequence contains invalid event");
1375 cmd = access_keymap (keymap, c, t_ok, 0, 1);
1376 if (idx == length)
1377 RETURN_UNGCPRO (cmd);
1379 keymap = get_keymap (cmd, 0, 1);
1380 if (!CONSP (keymap))
1381 RETURN_UNGCPRO (make_number (idx));
1383 QUIT;
1387 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1388 Assume that currently it does not define C at all.
1389 Return the keymap. */
1391 static Lisp_Object
1392 define_as_prefix (keymap, c)
1393 Lisp_Object keymap, c;
1395 Lisp_Object cmd;
1397 cmd = Fmake_sparse_keymap (Qnil);
1398 /* If this key is defined as a prefix in an inherited keymap,
1399 make it a prefix in this map, and make its definition
1400 inherit the other prefix definition. */
1401 cmd = nconc2 (cmd, access_keymap (keymap, c, 0, 0, 0));
1402 store_in_keymap (keymap, c, cmd);
1404 return cmd;
1407 /* Append a key to the end of a key sequence. We always make a vector. */
1409 Lisp_Object
1410 append_key (key_sequence, key)
1411 Lisp_Object key_sequence, key;
1413 Lisp_Object args[2];
1415 args[0] = key_sequence;
1417 args[1] = Fcons (key, Qnil);
1418 return Fvconcat (2, args);
1421 /* Given a event type C which is a symbol,
1422 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1424 static void
1425 silly_event_symbol_error (c)
1426 Lisp_Object c;
1428 Lisp_Object parsed, base, name, assoc;
1429 int modifiers;
1431 parsed = parse_modifiers (c);
1432 modifiers = (int) XUINT (XCAR (XCDR (parsed)));
1433 base = XCAR (parsed);
1434 name = Fsymbol_name (base);
1435 /* This alist includes elements such as ("RET" . "\\r"). */
1436 assoc = Fassoc (name, exclude_keys);
1438 if (! NILP (assoc))
1440 char new_mods[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1441 char *p = new_mods;
1442 Lisp_Object keystring;
1443 if (modifiers & alt_modifier)
1444 { *p++ = '\\'; *p++ = 'A'; *p++ = '-'; }
1445 if (modifiers & ctrl_modifier)
1446 { *p++ = '\\'; *p++ = 'C'; *p++ = '-'; }
1447 if (modifiers & hyper_modifier)
1448 { *p++ = '\\'; *p++ = 'H'; *p++ = '-'; }
1449 if (modifiers & meta_modifier)
1450 { *p++ = '\\'; *p++ = 'M'; *p++ = '-'; }
1451 if (modifiers & shift_modifier)
1452 { *p++ = '\\'; *p++ = 'S'; *p++ = '-'; }
1453 if (modifiers & super_modifier)
1454 { *p++ = '\\'; *p++ = 's'; *p++ = '-'; }
1455 *p = 0;
1457 c = reorder_modifiers (c);
1458 keystring = concat2 (build_string (new_mods), XCDR (assoc));
1460 error ((modifiers & ~meta_modifier
1461 ? "To bind the key %s, use [?%s], not [%s]"
1462 : "To bind the key %s, use \"%s\", not [%s]"),
1463 SDATA (SYMBOL_NAME (c)), SDATA (keystring),
1464 SDATA (SYMBOL_NAME (c)));
1468 /* Global, local, and minor mode keymap stuff. */
1470 /* We can't put these variables inside current_minor_maps, since under
1471 some systems, static gets macro-defined to be the empty string.
1472 Ickypoo. */
1473 static Lisp_Object *cmm_modes = NULL, *cmm_maps = NULL;
1474 static int cmm_size = 0;
1476 /* Store a pointer to an array of the currently active minor modes in
1477 *modeptr, a pointer to an array of the keymaps of the currently
1478 active minor modes in *mapptr, and return the number of maps
1479 *mapptr contains.
1481 This function always returns a pointer to the same buffer, and may
1482 free or reallocate it, so if you want to keep it for a long time or
1483 hand it out to lisp code, copy it. This procedure will be called
1484 for every key sequence read, so the nice lispy approach (return a
1485 new assoclist, list, what have you) for each invocation would
1486 result in a lot of consing over time.
1488 If we used xrealloc/xmalloc and ran out of memory, they would throw
1489 back to the command loop, which would try to read a key sequence,
1490 which would call this function again, resulting in an infinite
1491 loop. Instead, we'll use realloc/malloc and silently truncate the
1492 list, let the key sequence be read, and hope some other piece of
1493 code signals the error. */
1495 current_minor_maps (modeptr, mapptr)
1496 Lisp_Object **modeptr, **mapptr;
1498 int i = 0;
1499 int list_number = 0;
1500 Lisp_Object alist, assoc, var, val;
1501 Lisp_Object emulation_alists;
1502 Lisp_Object lists[2];
1504 emulation_alists = Vemulation_mode_map_alists;
1505 lists[0] = Vminor_mode_overriding_map_alist;
1506 lists[1] = Vminor_mode_map_alist;
1508 for (list_number = 0; list_number < 2; list_number++)
1510 if (CONSP (emulation_alists))
1512 alist = XCAR (emulation_alists);
1513 emulation_alists = XCDR (emulation_alists);
1514 if (SYMBOLP (alist))
1515 alist = find_symbol_value (alist);
1516 list_number = -1;
1518 else
1519 alist = lists[list_number];
1521 for ( ; CONSP (alist); alist = XCDR (alist))
1522 if ((assoc = XCAR (alist), CONSP (assoc))
1523 && (var = XCAR (assoc), SYMBOLP (var))
1524 && (val = find_symbol_value (var), !EQ (val, Qunbound))
1525 && !NILP (val))
1527 Lisp_Object temp;
1529 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1530 and also an entry in Vminor_mode_map_alist,
1531 ignore the latter. */
1532 if (list_number == 1)
1534 val = assq_no_quit (var, lists[0]);
1535 if (!NILP (val))
1536 continue;
1539 if (i >= cmm_size)
1541 int newsize, allocsize;
1542 Lisp_Object *newmodes, *newmaps;
1544 newsize = cmm_size == 0 ? 30 : cmm_size * 2;
1545 allocsize = newsize * sizeof *newmodes;
1547 /* Use malloc here. See the comment above this function.
1548 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1549 BLOCK_INPUT;
1550 newmodes = (Lisp_Object *) malloc (allocsize);
1551 if (newmodes)
1553 if (cmm_modes)
1555 bcopy (cmm_modes, newmodes, cmm_size * sizeof cmm_modes[0]);
1556 free (cmm_modes);
1558 cmm_modes = newmodes;
1561 newmaps = (Lisp_Object *) malloc (allocsize);
1562 if (newmaps)
1564 if (cmm_maps)
1566 bcopy (cmm_maps, newmaps, cmm_size * sizeof cmm_maps[0]);
1567 free (cmm_maps);
1569 cmm_maps = newmaps;
1571 UNBLOCK_INPUT;
1573 if (newmodes == NULL || newmaps == NULL)
1574 break;
1575 cmm_size = newsize;
1578 /* Get the keymap definition--or nil if it is not defined. */
1579 temp = Findirect_function (XCDR (assoc), Qt);
1580 if (!NILP (temp))
1582 cmm_modes[i] = var;
1583 cmm_maps [i] = temp;
1584 i++;
1589 if (modeptr) *modeptr = cmm_modes;
1590 if (mapptr) *mapptr = cmm_maps;
1591 return i;
1594 DEFUN ("current-active-maps", Fcurrent_active_maps, Scurrent_active_maps,
1595 0, 2, 0,
1596 doc: /* Return a list of the currently active keymaps.
1597 OLP if non-nil indicates that we should obey `overriding-local-map' and
1598 `overriding-terminal-local-map'. POSITION can specify a click position
1599 like in the respective argument of `key-binding'. */)
1600 (olp, position)
1601 Lisp_Object olp, position;
1603 int count = SPECPDL_INDEX ();
1605 Lisp_Object keymaps;
1607 /* If a mouse click position is given, our variables are based on
1608 the buffer clicked on, not the current buffer. So we may have to
1609 switch the buffer here. */
1611 if (CONSP (position))
1613 Lisp_Object window;
1615 window = POSN_WINDOW (position);
1617 if (WINDOWP (window)
1618 && BUFFERP (XWINDOW (window)->buffer)
1619 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1621 /* Arrange to go back to the original buffer once we're done
1622 processing the key sequence. We don't use
1623 save_excursion_{save,restore} here, in analogy to
1624 `read-key-sequence' to avoid saving point. Maybe this
1625 would not be a problem here, but it is easier to keep
1626 things the same.
1629 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1631 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1635 keymaps = Fcons (current_global_map, Qnil);
1637 if (!NILP (olp))
1639 if (!NILP (current_kboard->Voverriding_terminal_local_map))
1640 keymaps = Fcons (current_kboard->Voverriding_terminal_local_map, keymaps);
1641 /* The doc said that overriding-terminal-local-map should
1642 override overriding-local-map. The code used them both,
1643 but it seems clearer to use just one. rms, jan 2005. */
1644 else if (!NILP (Voverriding_local_map))
1645 keymaps = Fcons (Voverriding_local_map, keymaps);
1647 if (NILP (XCDR (keymaps)))
1649 Lisp_Object *maps;
1650 int nmaps, i;
1652 Lisp_Object keymap, local_map;
1653 EMACS_INT pt;
1655 pt = INTEGERP (position) ? XINT (position)
1656 : MARKERP (position) ? marker_position (position)
1657 : PT;
1659 /* Get the buffer local maps, possibly overriden by text or
1660 overlay properties */
1662 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1663 keymap = get_local_map (pt, current_buffer, Qkeymap);
1665 if (CONSP (position))
1667 Lisp_Object string;
1669 /* For a mouse click, get the local text-property keymap
1670 of the place clicked on, rather than point. */
1672 if (POSN_INBUFFER_P (position))
1674 Lisp_Object pos;
1676 pos = POSN_BUFFER_POSN (position);
1677 if (INTEGERP (pos)
1678 && XINT (pos) >= BEG && XINT (pos) <= Z)
1680 local_map = get_local_map (XINT (pos),
1681 current_buffer, Qlocal_map);
1683 keymap = get_local_map (XINT (pos),
1684 current_buffer, Qkeymap);
1688 /* If on a mode line string with a local keymap,
1689 or for a click on a string, i.e. overlay string or a
1690 string displayed via the `display' property,
1691 consider `local-map' and `keymap' properties of
1692 that string. */
1694 if (string = POSN_STRING (position),
1695 (CONSP (string) && STRINGP (XCAR (string))))
1697 Lisp_Object pos, map;
1699 pos = XCDR (string);
1700 string = XCAR (string);
1701 if (INTEGERP (pos)
1702 && XINT (pos) >= 0
1703 && XINT (pos) < SCHARS (string))
1705 map = Fget_text_property (pos, Qlocal_map, string);
1706 if (!NILP (map))
1707 local_map = map;
1709 map = Fget_text_property (pos, Qkeymap, string);
1710 if (!NILP (map))
1711 keymap = map;
1717 if (!NILP (local_map))
1718 keymaps = Fcons (local_map, keymaps);
1720 /* Now put all the minor mode keymaps on the list. */
1721 nmaps = current_minor_maps (0, &maps);
1723 for (i = --nmaps; i >= 0; i--)
1724 if (!NILP (maps[i]))
1725 keymaps = Fcons (maps[i], keymaps);
1727 if (!NILP (keymap))
1728 keymaps = Fcons (keymap, keymaps);
1731 unbind_to (count, Qnil);
1733 return keymaps;
1736 /* GC is possible in this function if it autoloads a keymap. */
1738 DEFUN ("key-binding", Fkey_binding, Skey_binding, 1, 4, 0,
1739 doc: /* Return the binding for command KEY in current keymaps.
1740 KEY is a string or vector, a sequence of keystrokes.
1741 The binding is probably a symbol with a function definition.
1743 Normally, `key-binding' ignores bindings for t, which act as default
1744 bindings, used when nothing else in the keymap applies; this makes it
1745 usable as a general function for probing keymaps. However, if the
1746 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1747 recognize the default bindings, just as `read-key-sequence' does.
1749 Like the normal command loop, `key-binding' will remap the command
1750 resulting from looking up KEY by looking up the command in the
1751 current keymaps. However, if the optional third argument NO-REMAP
1752 is non-nil, `key-binding' returns the unmapped command.
1754 If KEY is a key sequence initiated with the mouse, the used keymaps
1755 will depend on the clicked mouse position with regard to the buffer
1756 and possible local keymaps on strings.
1758 If the optional argument POSITION is non-nil, it specifies a mouse
1759 position as returned by `event-start' and `event-end', and the lookup
1760 occurs in the keymaps associated with it instead of KEY. It can also
1761 be a number or marker, in which case the keymap properties at the
1762 specified buffer position instead of point are used.
1764 (key, accept_default, no_remap, position)
1765 Lisp_Object key, accept_default, no_remap, position;
1767 Lisp_Object *maps, value;
1768 int nmaps, i;
1769 struct gcpro gcpro1, gcpro2;
1770 int count = SPECPDL_INDEX ();
1772 GCPRO2 (key, position);
1774 if (NILP (position) && VECTORP (key))
1776 Lisp_Object event
1777 /* mouse events may have a symbolic prefix indicating the
1778 scrollbar or mode line */
1779 = AREF (key, SYMBOLP (AREF (key, 0)) && ASIZE (key) > 1 ? 1 : 0);
1781 /* We are not interested in locations without event data */
1783 if (EVENT_HAS_PARAMETERS (event) && CONSP (XCDR (event)))
1785 Lisp_Object kind = EVENT_HEAD_KIND (EVENT_HEAD (event));
1786 if (EQ (kind, Qmouse_click))
1787 position = EVENT_START (event);
1791 /* Key sequences beginning with mouse clicks
1792 are read using the keymaps of the buffer clicked on, not
1793 the current buffer. So we may have to switch the buffer
1794 here. */
1796 if (CONSP (position))
1798 Lisp_Object window;
1800 window = POSN_WINDOW (position);
1802 if (WINDOWP (window)
1803 && BUFFERP (XWINDOW (window)->buffer)
1804 && XBUFFER (XWINDOW (window)->buffer) != current_buffer)
1806 /* Arrange to go back to the original buffer once we're done
1807 processing the key sequence. We don't use
1808 save_excursion_{save,restore} here, in analogy to
1809 `read-key-sequence' to avoid saving point. Maybe this
1810 would not be a problem here, but it is easier to keep
1811 things the same.
1814 record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
1816 set_buffer_internal (XBUFFER (XWINDOW (window)->buffer));
1820 if (! NILP (current_kboard->Voverriding_terminal_local_map))
1822 value = Flookup_key (current_kboard->Voverriding_terminal_local_map,
1823 key, accept_default);
1824 if (! NILP (value) && !INTEGERP (value))
1825 goto done;
1827 else if (! NILP (Voverriding_local_map))
1829 value = Flookup_key (Voverriding_local_map, key, accept_default);
1830 if (! NILP (value) && !INTEGERP (value))
1831 goto done;
1833 else
1835 Lisp_Object keymap, local_map;
1836 EMACS_INT pt;
1838 pt = INTEGERP (position) ? XINT (position)
1839 : MARKERP (position) ? marker_position (position)
1840 : PT;
1842 local_map = get_local_map (pt, current_buffer, Qlocal_map);
1843 keymap = get_local_map (pt, current_buffer, Qkeymap);
1845 if (CONSP (position))
1847 Lisp_Object string;
1849 /* For a mouse click, get the local text-property keymap
1850 of the place clicked on, rather than point. */
1852 if (POSN_INBUFFER_P (position))
1854 Lisp_Object pos;
1856 pos = POSN_BUFFER_POSN (position);
1857 if (INTEGERP (pos)
1858 && XINT (pos) >= BEG && XINT (pos) <= Z)
1860 local_map = get_local_map (XINT (pos),
1861 current_buffer, Qlocal_map);
1863 keymap = get_local_map (XINT (pos),
1864 current_buffer, Qkeymap);
1868 /* If on a mode line string with a local keymap,
1869 or for a click on a string, i.e. overlay string or a
1870 string displayed via the `display' property,
1871 consider `local-map' and `keymap' properties of
1872 that string. */
1874 if (string = POSN_STRING (position),
1875 (CONSP (string) && STRINGP (XCAR (string))))
1877 Lisp_Object pos, map;
1879 pos = XCDR (string);
1880 string = XCAR (string);
1881 if (INTEGERP (pos)
1882 && XINT (pos) >= 0
1883 && XINT (pos) < SCHARS (string))
1885 map = Fget_text_property (pos, Qlocal_map, string);
1886 if (!NILP (map))
1887 local_map = map;
1889 map = Fget_text_property (pos, Qkeymap, string);
1890 if (!NILP (map))
1891 keymap = map;
1897 if (! NILP (keymap))
1899 value = Flookup_key (keymap, key, accept_default);
1900 if (! NILP (value) && !INTEGERP (value))
1901 goto done;
1904 nmaps = current_minor_maps (0, &maps);
1905 /* Note that all these maps are GCPRO'd
1906 in the places where we found them. */
1908 for (i = 0; i < nmaps; i++)
1909 if (! NILP (maps[i]))
1911 value = Flookup_key (maps[i], key, accept_default);
1912 if (! NILP (value) && !INTEGERP (value))
1913 goto done;
1916 if (! NILP (local_map))
1918 value = Flookup_key (local_map, key, accept_default);
1919 if (! NILP (value) && !INTEGERP (value))
1920 goto done;
1924 value = Flookup_key (current_global_map, key, accept_default);
1926 done:
1927 unbind_to (count, Qnil);
1929 UNGCPRO;
1930 if (NILP (value) || INTEGERP (value))
1931 return Qnil;
1933 /* If the result of the ordinary keymap lookup is an interactive
1934 command, look for a key binding (ie. remapping) for that command. */
1936 if (NILP (no_remap) && SYMBOLP (value))
1938 Lisp_Object value1;
1939 if (value1 = Fcommand_remapping (value, position, Qnil), !NILP (value1))
1940 value = value1;
1943 return value;
1946 /* GC is possible in this function if it autoloads a keymap. */
1948 DEFUN ("local-key-binding", Flocal_key_binding, Slocal_key_binding, 1, 2, 0,
1949 doc: /* Return the binding for command KEYS in current local keymap only.
1950 KEYS is a string or vector, a sequence of keystrokes.
1951 The binding is probably a symbol with a function definition.
1953 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1954 bindings; see the description of `lookup-key' for more details about this. */)
1955 (keys, accept_default)
1956 Lisp_Object keys, accept_default;
1958 register Lisp_Object map;
1959 map = current_buffer->keymap;
1960 if (NILP (map))
1961 return Qnil;
1962 return Flookup_key (map, keys, accept_default);
1965 /* GC is possible in this function if it autoloads a keymap. */
1967 DEFUN ("global-key-binding", Fglobal_key_binding, Sglobal_key_binding, 1, 2, 0,
1968 doc: /* Return the binding for command KEYS in current global keymap only.
1969 KEYS is a string or vector, a sequence of keystrokes.
1970 The binding is probably a symbol with a function definition.
1971 This function's return values are the same as those of `lookup-key'
1972 \(which see).
1974 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1975 bindings; see the description of `lookup-key' for more details about this. */)
1976 (keys, accept_default)
1977 Lisp_Object keys, accept_default;
1979 return Flookup_key (current_global_map, keys, accept_default);
1982 /* GC is possible in this function if it autoloads a keymap. */
1984 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding, Sminor_mode_key_binding, 1, 2, 0,
1985 doc: /* Find the visible minor mode bindings of KEY.
1986 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1987 the symbol which names the minor mode binding KEY, and BINDING is
1988 KEY's definition in that mode. In particular, if KEY has no
1989 minor-mode bindings, return nil. If the first binding is a
1990 non-prefix, all subsequent bindings will be omitted, since they would
1991 be ignored. Similarly, the list doesn't include non-prefix bindings
1992 that come after prefix bindings.
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 (key, accept_default)
1997 Lisp_Object key, accept_default;
1999 Lisp_Object *modes, *maps;
2000 int nmaps;
2001 Lisp_Object binding;
2002 int i, j;
2003 struct gcpro gcpro1, gcpro2;
2005 nmaps = current_minor_maps (&modes, &maps);
2006 /* Note that all these maps are GCPRO'd
2007 in the places where we found them. */
2009 binding = Qnil;
2010 GCPRO2 (key, binding);
2012 for (i = j = 0; i < nmaps; i++)
2013 if (!NILP (maps[i])
2014 && !NILP (binding = Flookup_key (maps[i], key, accept_default))
2015 && !INTEGERP (binding))
2017 if (KEYMAPP (binding))
2018 maps[j++] = Fcons (modes[i], binding);
2019 else if (j == 0)
2020 RETURN_UNGCPRO (Fcons (Fcons (modes[i], binding), Qnil));
2023 UNGCPRO;
2024 return Flist (j, maps);
2027 DEFUN ("define-prefix-command", Fdefine_prefix_command, Sdefine_prefix_command, 1, 3, 0,
2028 doc: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
2029 A new sparse keymap is stored as COMMAND's function definition and its value.
2030 If a second optional argument MAPVAR is given, the map is stored as
2031 its value instead of as COMMAND's value; but COMMAND is still defined
2032 as a function.
2033 The third optional argument NAME, if given, supplies a menu name
2034 string for the map. This is required to use the keymap as a menu.
2035 This function returns COMMAND. */)
2036 (command, mapvar, name)
2037 Lisp_Object command, mapvar, name;
2039 Lisp_Object map;
2040 map = Fmake_sparse_keymap (name);
2041 Ffset (command, map);
2042 if (!NILP (mapvar))
2043 Fset (mapvar, map);
2044 else
2045 Fset (command, map);
2046 return command;
2049 DEFUN ("use-global-map", Fuse_global_map, Suse_global_map, 1, 1, 0,
2050 doc: /* Select KEYMAP as the global keymap. */)
2051 (keymap)
2052 Lisp_Object keymap;
2054 keymap = get_keymap (keymap, 1, 1);
2055 current_global_map = keymap;
2057 return Qnil;
2060 DEFUN ("use-local-map", Fuse_local_map, Suse_local_map, 1, 1, 0,
2061 doc: /* Select KEYMAP as the local keymap.
2062 If KEYMAP is nil, that means no local keymap. */)
2063 (keymap)
2064 Lisp_Object keymap;
2066 if (!NILP (keymap))
2067 keymap = get_keymap (keymap, 1, 1);
2069 current_buffer->keymap = keymap;
2071 return Qnil;
2074 DEFUN ("current-local-map", Fcurrent_local_map, Scurrent_local_map, 0, 0, 0,
2075 doc: /* Return current buffer's local keymap, or nil if it has none.
2076 Normally the local keymap is set by the major mode with `use-local-map'. */)
2079 return current_buffer->keymap;
2082 DEFUN ("current-global-map", Fcurrent_global_map, Scurrent_global_map, 0, 0, 0,
2083 doc: /* Return the current global keymap. */)
2086 return current_global_map;
2089 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps, Scurrent_minor_mode_maps, 0, 0, 0,
2090 doc: /* Return a list of keymaps for the minor modes of the current buffer. */)
2093 Lisp_Object *maps;
2094 int nmaps = current_minor_maps (0, &maps);
2096 return Flist (nmaps, maps);
2099 /* Help functions for describing and documenting keymaps. */
2101 struct accessible_keymaps_data {
2102 Lisp_Object maps, tail, thisseq;
2103 /* Does the current sequence end in the meta-prefix-char? */
2104 int is_metized;
2107 static void
2108 accessible_keymaps_1 (key, cmd, args, data)
2109 Lisp_Object key, cmd, args;
2110 /* Use void* to be compatible with map_keymap_function_t. */
2111 void *data;
2113 struct accessible_keymaps_data *d = data; /* Cast! */
2114 Lisp_Object maps = d->maps;
2115 Lisp_Object tail = d->tail;
2116 Lisp_Object thisseq = d->thisseq;
2117 int is_metized = d->is_metized && INTEGERP (key);
2118 Lisp_Object tem;
2120 cmd = get_keymap (get_keyelt (cmd, 0), 0, 0);
2121 if (NILP (cmd))
2122 return;
2124 /* Look for and break cycles. */
2125 while (!NILP (tem = Frassq (cmd, maps)))
2127 Lisp_Object prefix = XCAR (tem);
2128 int lim = XINT (Flength (XCAR (tem)));
2129 if (lim <= XINT (Flength (thisseq)))
2130 { /* This keymap was already seen with a smaller prefix. */
2131 int i = 0;
2132 while (i < lim && EQ (Faref (prefix, make_number (i)),
2133 Faref (thisseq, make_number (i))))
2134 i++;
2135 if (i >= lim)
2136 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
2137 return;
2139 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
2140 but maybe `cmd' occurs again further down in `maps', so keep
2141 looking. */
2142 maps = XCDR (Fmemq (tem, maps));
2145 /* If the last key in thisseq is meta-prefix-char,
2146 turn it into a meta-ized keystroke. We know
2147 that the event we're about to append is an
2148 ascii keystroke since we're processing a
2149 keymap table. */
2150 if (is_metized)
2152 int meta_bit = meta_modifier;
2153 Lisp_Object last = make_number (XINT (Flength (thisseq)) - 1);
2154 tem = Fcopy_sequence (thisseq);
2156 Faset (tem, last, make_number (XINT (key) | meta_bit));
2158 /* This new sequence is the same length as
2159 thisseq, so stick it in the list right
2160 after this one. */
2161 XSETCDR (tail,
2162 Fcons (Fcons (tem, cmd), XCDR (tail)));
2164 else
2166 tem = append_key (thisseq, key);
2167 nconc2 (tail, Fcons (Fcons (tem, cmd), Qnil));
2171 /* This function cannot GC. */
2173 DEFUN ("accessible-keymaps", Faccessible_keymaps, Saccessible_keymaps,
2174 1, 2, 0,
2175 doc: /* Find all keymaps accessible via prefix characters from KEYMAP.
2176 Returns a list of elements of the form (KEYS . MAP), where the sequence
2177 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
2178 so that the KEYS increase in length. The first element is ([] . KEYMAP).
2179 An optional argument PREFIX, if non-nil, should be a key sequence;
2180 then the value includes only maps for prefixes that start with PREFIX. */)
2181 (keymap, prefix)
2182 Lisp_Object keymap, prefix;
2184 Lisp_Object maps, tail;
2185 int prefixlen = XINT (Flength (prefix));
2187 /* no need for gcpro because we don't autoload any keymaps. */
2189 if (!NILP (prefix))
2191 /* If a prefix was specified, start with the keymap (if any) for
2192 that prefix, so we don't waste time considering other prefixes. */
2193 Lisp_Object tem;
2194 tem = Flookup_key (keymap, prefix, Qt);
2195 /* Flookup_key may give us nil, or a number,
2196 if the prefix is not defined in this particular map.
2197 It might even give us a list that isn't a keymap. */
2198 tem = get_keymap (tem, 0, 0);
2199 /* If the keymap is autoloaded `tem' is not a cons-cell, but we still
2200 want to return it. */
2201 if (!NILP (tem))
2203 /* Convert PREFIX to a vector now, so that later on
2204 we don't have to deal with the possibility of a string. */
2205 if (STRINGP (prefix))
2207 int i, i_byte, c;
2208 Lisp_Object copy;
2210 copy = Fmake_vector (make_number (SCHARS (prefix)), Qnil);
2211 for (i = 0, i_byte = 0; i < SCHARS (prefix);)
2213 int i_before = i;
2215 FETCH_STRING_CHAR_ADVANCE (c, prefix, i, i_byte);
2216 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2217 c ^= 0200 | meta_modifier;
2218 ASET (copy, i_before, make_number (c));
2220 prefix = copy;
2222 maps = Fcons (Fcons (prefix, tem), Qnil);
2224 else
2225 return Qnil;
2227 else
2228 maps = Fcons (Fcons (Fmake_vector (make_number (0), Qnil),
2229 get_keymap (keymap, 1, 0)),
2230 Qnil);
2232 /* For each map in the list maps,
2233 look at any other maps it points to,
2234 and stick them at the end if they are not already in the list.
2236 This is a breadth-first traversal, where tail is the queue of
2237 nodes, and maps accumulates a list of all nodes visited. */
2239 for (tail = maps; CONSP (tail); tail = XCDR (tail))
2241 struct accessible_keymaps_data data;
2242 register Lisp_Object thismap = Fcdr (XCAR (tail));
2243 Lisp_Object last;
2245 data.thisseq = Fcar (XCAR (tail));
2246 data.maps = maps;
2247 data.tail = tail;
2248 last = make_number (XINT (Flength (data.thisseq)) - 1);
2249 /* Does the current sequence end in the meta-prefix-char? */
2250 data.is_metized = (XINT (last) >= 0
2251 /* Don't metize the last char of PREFIX. */
2252 && XINT (last) >= prefixlen
2253 && EQ (Faref (data.thisseq, last), meta_prefix_char));
2255 /* Since we can't run lisp code, we can't scan autoloaded maps. */
2256 if (CONSP (thismap))
2257 map_keymap (thismap, accessible_keymaps_1, Qnil, &data, 0);
2259 return maps;
2261 Lisp_Object Qsingle_key_description, Qkey_description;
2263 /* This function cannot GC. */
2265 DEFUN ("key-description", Fkey_description, Skey_description, 1, 2, 0,
2266 doc: /* Return a pretty description of key-sequence KEYS.
2267 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2268 Control characters turn into "C-foo" sequences, meta into "M-foo",
2269 spaces are put between sequence elements, etc. */)
2270 (keys, prefix)
2271 Lisp_Object keys, prefix;
2273 int len = 0;
2274 int i, i_byte;
2275 Lisp_Object *args;
2276 int size = XINT (Flength (keys));
2277 Lisp_Object list;
2278 Lisp_Object sep = build_string (" ");
2279 Lisp_Object key;
2280 int add_meta = 0;
2282 if (!NILP (prefix))
2283 size += XINT (Flength (prefix));
2285 /* This has one extra element at the end that we don't pass to Fconcat. */
2286 args = (Lisp_Object *) alloca (size * 4 * sizeof (Lisp_Object));
2288 /* In effect, this computes
2289 (mapconcat 'single-key-description keys " ")
2290 but we shouldn't use mapconcat because it can do GC. */
2292 next_list:
2293 if (!NILP (prefix))
2294 list = prefix, prefix = Qnil;
2295 else if (!NILP (keys))
2296 list = keys, keys = Qnil;
2297 else
2299 if (add_meta)
2301 args[len] = Fsingle_key_description (meta_prefix_char, Qnil);
2302 len += 2;
2304 else if (len == 0)
2305 return empty_unibyte_string;
2306 return Fconcat (len - 1, args);
2309 if (STRINGP (list))
2310 size = SCHARS (list);
2311 else if (VECTORP (list))
2312 size = XVECTOR (list)->size;
2313 else if (CONSP (list))
2314 size = XINT (Flength (list));
2315 else
2316 wrong_type_argument (Qarrayp, list);
2318 i = i_byte = 0;
2320 while (i < size)
2322 if (STRINGP (list))
2324 int c;
2325 FETCH_STRING_CHAR_ADVANCE (c, list, i, i_byte);
2326 if (SINGLE_BYTE_CHAR_P (c) && (c & 0200))
2327 c ^= 0200 | meta_modifier;
2328 XSETFASTINT (key, c);
2330 else if (VECTORP (list))
2332 key = AREF (list, i); i++;
2334 else
2336 key = XCAR (list);
2337 list = XCDR (list);
2338 i++;
2341 if (add_meta)
2343 if (!INTEGERP (key)
2344 || EQ (key, meta_prefix_char)
2345 || (XINT (key) & meta_modifier))
2347 args[len++] = Fsingle_key_description (meta_prefix_char, Qnil);
2348 args[len++] = sep;
2349 if (EQ (key, meta_prefix_char))
2350 continue;
2352 else
2353 XSETINT (key, (XINT (key) | meta_modifier) & ~0x80);
2354 add_meta = 0;
2356 else if (EQ (key, meta_prefix_char))
2358 add_meta = 1;
2359 continue;
2361 args[len++] = Fsingle_key_description (key, Qnil);
2362 args[len++] = sep;
2364 goto next_list;
2368 char *
2369 push_key_description (c, p, force_multibyte)
2370 register unsigned int c;
2371 register char *p;
2372 int force_multibyte;
2374 unsigned c2;
2376 /* Clear all the meaningless bits above the meta bit. */
2377 c &= meta_modifier | ~ - meta_modifier;
2378 c2 = c & ~(alt_modifier | ctrl_modifier | hyper_modifier
2379 | meta_modifier | shift_modifier | super_modifier);
2381 if (! CHARACTERP (make_number (c2)))
2383 /* KEY_DESCRIPTION_SIZE is large enough for this. */
2384 p += sprintf (p, "[%d]", c);
2385 return p;
2388 if (c & alt_modifier)
2390 *p++ = 'A';
2391 *p++ = '-';
2392 c -= alt_modifier;
2394 if ((c & ctrl_modifier) != 0
2395 || (c2 < ' ' && c2 != 27 && c2 != '\t' && c2 != Ctl ('M')))
2397 *p++ = 'C';
2398 *p++ = '-';
2399 c &= ~ctrl_modifier;
2401 if (c & hyper_modifier)
2403 *p++ = 'H';
2404 *p++ = '-';
2405 c -= hyper_modifier;
2407 if (c & meta_modifier)
2409 *p++ = 'M';
2410 *p++ = '-';
2411 c -= meta_modifier;
2413 if (c & shift_modifier)
2415 *p++ = 'S';
2416 *p++ = '-';
2417 c -= shift_modifier;
2419 if (c & super_modifier)
2421 *p++ = 's';
2422 *p++ = '-';
2423 c -= super_modifier;
2425 if (c < 040)
2427 if (c == 033)
2429 *p++ = 'E';
2430 *p++ = 'S';
2431 *p++ = 'C';
2433 else if (c == '\t')
2435 *p++ = 'T';
2436 *p++ = 'A';
2437 *p++ = 'B';
2439 else if (c == Ctl ('M'))
2441 *p++ = 'R';
2442 *p++ = 'E';
2443 *p++ = 'T';
2445 else
2447 /* `C-' already added above. */
2448 if (c > 0 && c <= Ctl ('Z'))
2449 *p++ = c + 0140;
2450 else
2451 *p++ = c + 0100;
2454 else if (c == 0177)
2456 *p++ = 'D';
2457 *p++ = 'E';
2458 *p++ = 'L';
2460 else if (c == ' ')
2462 *p++ = 'S';
2463 *p++ = 'P';
2464 *p++ = 'C';
2466 else if (c < 128
2467 || (NILP (current_buffer->enable_multibyte_characters)
2468 && SINGLE_BYTE_CHAR_P (c)
2469 && !force_multibyte))
2471 *p++ = c;
2473 else
2475 /* Now we are sure that C is a valid character code. */
2476 if (NILP (current_buffer->enable_multibyte_characters)
2477 && ! force_multibyte)
2478 *p++ = multibyte_char_to_unibyte (c, Qnil);
2479 else
2480 p += CHAR_STRING (c, (unsigned char *) p);
2483 return p;
2486 /* This function cannot GC. */
2488 DEFUN ("single-key-description", Fsingle_key_description,
2489 Ssingle_key_description, 1, 2, 0,
2490 doc: /* Return a pretty description of command character KEY.
2491 Control characters turn into C-whatever, etc.
2492 Optional argument NO-ANGLES non-nil means don't put angle brackets
2493 around function keys and event symbols. */)
2494 (key, no_angles)
2495 Lisp_Object key, no_angles;
2497 if (CONSP (key) && lucid_event_type_list_p (key))
2498 key = Fevent_convert_list (key);
2500 key = EVENT_HEAD (key);
2502 if (INTEGERP (key)) /* Normal character */
2504 char tem[KEY_DESCRIPTION_SIZE];
2506 *push_key_description (XUINT (key), tem, 1) = 0;
2507 return build_string (tem);
2509 else if (SYMBOLP (key)) /* Function key or event-symbol */
2511 if (NILP (no_angles))
2513 char *buffer
2514 = (char *) alloca (SBYTES (SYMBOL_NAME (key)) + 5);
2515 sprintf (buffer, "<%s>", SDATA (SYMBOL_NAME (key)));
2516 return build_string (buffer);
2518 else
2519 return Fsymbol_name (key);
2521 else if (STRINGP (key)) /* Buffer names in the menubar. */
2522 return Fcopy_sequence (key);
2523 else
2524 error ("KEY must be an integer, cons, symbol, or string");
2525 return Qnil;
2528 char *
2529 push_text_char_description (c, p)
2530 register unsigned int c;
2531 register char *p;
2533 if (c >= 0200)
2535 *p++ = 'M';
2536 *p++ = '-';
2537 c -= 0200;
2539 if (c < 040)
2541 *p++ = '^';
2542 *p++ = c + 64; /* 'A' - 1 */
2544 else if (c == 0177)
2546 *p++ = '^';
2547 *p++ = '?';
2549 else
2550 *p++ = c;
2551 return p;
2554 /* This function cannot GC. */
2556 DEFUN ("text-char-description", Ftext_char_description, Stext_char_description, 1, 1, 0,
2557 doc: /* Return a pretty description of file-character CHARACTER.
2558 Control characters turn into "^char", etc. This differs from
2559 `single-key-description' which turns them into "C-char".
2560 Also, this function recognizes the 2**7 bit as the Meta character,
2561 whereas `single-key-description' uses the 2**27 bit for Meta.
2562 See Info node `(elisp)Describing Characters' for examples. */)
2563 (character)
2564 Lisp_Object character;
2566 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2567 unsigned char str[6];
2568 int c;
2570 CHECK_NUMBER (character);
2572 c = XINT (character);
2573 if (!ASCII_CHAR_P (c))
2575 int len = CHAR_STRING (c, str);
2577 return make_multibyte_string (str, 1, len);
2580 *push_text_char_description (c & 0377, str) = 0;
2582 return build_string (str);
2585 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2586 a meta bit. */
2587 static int
2588 ascii_sequence_p (seq)
2589 Lisp_Object seq;
2591 int i;
2592 int len = XINT (Flength (seq));
2594 for (i = 0; i < len; i++)
2596 Lisp_Object ii, elt;
2598 XSETFASTINT (ii, i);
2599 elt = Faref (seq, ii);
2601 if (!INTEGERP (elt)
2602 || (XUINT (elt) & ~CHAR_META) >= 0x80)
2603 return 0;
2606 return 1;
2610 /* where-is - finding a command in a set of keymaps. */
2612 static Lisp_Object where_is_internal ();
2613 static void where_is_internal_1 P_ ((Lisp_Object key, Lisp_Object binding,
2614 Lisp_Object args, void *data));
2616 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2617 Returns the first non-nil binding found in any of those maps. */
2619 static Lisp_Object
2620 shadow_lookup (shadow, key, flag)
2621 Lisp_Object shadow, key, flag;
2623 Lisp_Object tail, value;
2625 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
2627 value = Flookup_key (XCAR (tail), key, flag);
2628 if (NATNUMP (value))
2630 value = Flookup_key (XCAR (tail),
2631 Fsubstring (key, make_number (0), value), flag);
2632 if (!NILP (value))
2633 return Qnil;
2635 else if (!NILP (value))
2636 return value;
2638 return Qnil;
2641 static Lisp_Object Vmouse_events;
2643 struct where_is_internal_data {
2644 Lisp_Object definition, noindirect, this, last;
2645 int last_is_meta;
2646 Lisp_Object sequences;
2649 /* This function can GC if Flookup_key autoloads any keymaps. */
2651 static Lisp_Object
2652 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap)
2653 Lisp_Object definition, keymaps;
2654 Lisp_Object firstonly, noindirect, no_remap;
2656 Lisp_Object maps = Qnil;
2657 Lisp_Object found, sequences;
2658 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2659 /* 1 means ignore all menu bindings entirely. */
2660 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2662 found = keymaps;
2663 while (CONSP (found))
2665 maps =
2666 nconc2 (maps,
2667 Faccessible_keymaps (get_keymap (XCAR (found), 1, 0), Qnil));
2668 found = XCDR (found);
2671 GCPRO5 (definition, keymaps, maps, found, sequences);
2672 found = Qnil;
2673 sequences = Qnil;
2675 /* If this command is remapped, then it has no key bindings
2676 of its own. */
2677 if (NILP (no_remap)
2678 && SYMBOLP (definition)
2679 && !NILP (Fcommand_remapping (definition, Qnil, keymaps)))
2680 RETURN_UNGCPRO (Qnil);
2682 for (; CONSP (maps); maps = XCDR (maps))
2684 /* Key sequence to reach map, and the map that it reaches */
2685 register Lisp_Object this, map, tem;
2686 struct where_is_internal_data data;
2688 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2689 [M-CHAR] sequences, check if last character of the sequence
2690 is the meta-prefix char. */
2691 Lisp_Object last;
2692 int last_is_meta;
2694 this = Fcar (XCAR (maps));
2695 map = Fcdr (XCAR (maps));
2696 last = make_number (XINT (Flength (this)) - 1);
2697 last_is_meta = (XINT (last) >= 0
2698 && EQ (Faref (this, last), meta_prefix_char));
2700 /* if (nomenus && !ascii_sequence_p (this)) */
2701 if (nomenus && XINT (last) >= 0
2702 && SYMBOLP (tem = Faref (this, make_number (0)))
2703 && !NILP (Fmemq (XCAR (parse_modifiers (tem)), Vmouse_events)))
2704 /* If no menu entries should be returned, skip over the
2705 keymaps bound to `menu-bar' and `tool-bar' and other
2706 non-ascii prefixes like `C-down-mouse-2'. */
2707 continue;
2709 QUIT;
2711 data.definition = definition;
2712 data.noindirect = noindirect;
2713 data.this = this;
2714 data.last = last;
2715 data.last_is_meta = last_is_meta;
2716 data.sequences = Qnil;
2718 if (CONSP (map))
2719 map_keymap (map, where_is_internal_1, Qnil, &data, 0);
2721 sequences = data.sequences;
2723 while (CONSP (sequences))
2725 Lisp_Object sequence, remapped, function;
2727 sequence = XCAR (sequences);
2728 sequences = XCDR (sequences);
2730 /* If the current sequence is a command remapping with
2731 format [remap COMMAND], find the key sequences
2732 which run COMMAND, and use those sequences instead. */
2733 remapped = Qnil;
2734 if (NILP (no_remap)
2735 && VECTORP (sequence) && XVECTOR (sequence)->size == 2
2736 && EQ (AREF (sequence, 0), Qremap)
2737 && (function = AREF (sequence, 1), SYMBOLP (function)))
2739 Lisp_Object remapped1;
2741 remapped1 = where_is_internal (function, keymaps, firstonly, noindirect, Qt);
2742 if (CONSP (remapped1))
2744 /* Verify that this key binding actually maps to the
2745 remapped command (see below). */
2746 if (!EQ (shadow_lookup (keymaps, XCAR (remapped1), Qnil), function))
2747 continue;
2748 sequence = XCAR (remapped1);
2749 remapped = XCDR (remapped1);
2750 goto record_sequence;
2754 /* Verify that this key binding is not shadowed by another
2755 binding for the same key, before we say it exists.
2757 Mechanism: look for local definition of this key and if
2758 it is defined and does not match what we found then
2759 ignore this key.
2761 Either nil or number as value from Flookup_key
2762 means undefined. */
2763 if (!EQ (shadow_lookup (keymaps, sequence, Qnil), definition))
2764 continue;
2766 record_sequence:
2767 /* Don't annoy user with strings from a menu such as
2768 Select Paste. Change them all to "(any string)",
2769 so that there seems to be only one menu item
2770 to report. */
2771 if (! NILP (sequence))
2773 Lisp_Object tem;
2774 tem = Faref (sequence, make_number (XVECTOR (sequence)->size - 1));
2775 if (STRINGP (tem))
2776 Faset (sequence, make_number (XVECTOR (sequence)->size - 1),
2777 build_string ("(any string)"));
2780 /* It is a true unshadowed match. Record it, unless it's already
2781 been seen (as could happen when inheriting keymaps). */
2782 if (NILP (Fmember (sequence, found)))
2783 found = Fcons (sequence, found);
2785 /* If firstonly is Qnon_ascii, then we can return the first
2786 binding we find. If firstonly is not Qnon_ascii but not
2787 nil, then we should return the first ascii-only binding
2788 we find. */
2789 if (EQ (firstonly, Qnon_ascii))
2790 RETURN_UNGCPRO (sequence);
2791 else if (!NILP (firstonly) && ascii_sequence_p (sequence))
2792 RETURN_UNGCPRO (sequence);
2794 if (CONSP (remapped))
2796 sequence = XCAR (remapped);
2797 remapped = XCDR (remapped);
2798 goto record_sequence;
2803 UNGCPRO;
2805 found = Fnreverse (found);
2807 /* firstonly may have been t, but we may have gone all the way through
2808 the keymaps without finding an all-ASCII key sequence. So just
2809 return the best we could find. */
2810 if (!NILP (firstonly))
2811 return Fcar (found);
2813 return found;
2816 DEFUN ("where-is-internal", Fwhere_is_internal, Swhere_is_internal, 1, 5, 0,
2817 doc: /* Return list of keys that invoke DEFINITION.
2818 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2819 If KEYMAP is nil, search all the currently active keymaps.
2820 If KEYMAP is a list of keymaps, search only those keymaps.
2822 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2823 rather than a list of all possible key sequences.
2824 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2825 no matter what it is.
2826 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2827 \(or their meta variants) and entirely reject menu bindings.
2829 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2830 to other keymaps or slots. This makes it possible to search for an
2831 indirect definition itself.
2833 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2834 that invoke a command which is remapped to DEFINITION, but include the
2835 remapped command in the returned list. */)
2836 (definition, keymap, firstonly, noindirect, no_remap)
2837 Lisp_Object definition, keymap;
2838 Lisp_Object firstonly, noindirect, no_remap;
2840 Lisp_Object sequences, keymaps;
2841 /* 1 means ignore all menu bindings entirely. */
2842 int nomenus = !NILP (firstonly) && !EQ (firstonly, Qnon_ascii);
2843 Lisp_Object result;
2845 /* Find the relevant keymaps. */
2846 if (CONSP (keymap) && KEYMAPP (XCAR (keymap)))
2847 keymaps = keymap;
2848 else if (!NILP (keymap))
2849 keymaps = Fcons (keymap, Fcons (current_global_map, Qnil));
2850 else
2851 keymaps = Fcurrent_active_maps (Qnil, Qnil);
2853 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2854 We don't really need to check `keymap'. */
2855 if (nomenus && NILP (noindirect) && NILP (keymap))
2857 Lisp_Object *defns;
2858 int i, j, n;
2859 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
2861 /* Check heuristic-consistency of the cache. */
2862 if (NILP (Fequal (keymaps, where_is_cache_keymaps)))
2863 where_is_cache = Qnil;
2865 if (NILP (where_is_cache))
2867 /* We need to create the cache. */
2868 Lisp_Object args[2];
2869 where_is_cache = Fmake_hash_table (0, args);
2870 where_is_cache_keymaps = Qt;
2872 /* Fill in the cache. */
2873 GCPRO5 (definition, keymaps, firstonly, noindirect, no_remap);
2874 where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2875 UNGCPRO;
2877 where_is_cache_keymaps = keymaps;
2880 /* We want to process definitions from the last to the first.
2881 Instead of consing, copy definitions to a vector and step
2882 over that vector. */
2883 sequences = Fgethash (definition, where_is_cache, Qnil);
2884 n = XINT (Flength (sequences));
2885 defns = (Lisp_Object *) alloca (n * sizeof *defns);
2886 for (i = 0; CONSP (sequences); sequences = XCDR (sequences))
2887 defns[i++] = XCAR (sequences);
2889 /* Verify that the key bindings are not shadowed. Note that
2890 the following can GC. */
2891 GCPRO2 (definition, keymaps);
2892 result = Qnil;
2893 j = -1;
2894 for (i = n - 1; i >= 0; --i)
2895 if (EQ (shadow_lookup (keymaps, defns[i], Qnil), definition))
2897 if (ascii_sequence_p (defns[i]))
2898 break;
2899 else if (j < 0)
2900 j = i;
2903 result = i >= 0 ? defns[i] : (j >= 0 ? defns[j] : Qnil);
2904 UNGCPRO;
2906 else
2908 /* Kill the cache so that where_is_internal_1 doesn't think
2909 we're filling it up. */
2910 where_is_cache = Qnil;
2911 result = where_is_internal (definition, keymaps, firstonly, noindirect, no_remap);
2914 return result;
2917 /* This function can GC because get_keyelt can. */
2919 static void
2920 where_is_internal_1 (key, binding, args, data)
2921 Lisp_Object key, binding, args;
2922 void *data;
2924 struct where_is_internal_data *d = data; /* Cast! */
2925 Lisp_Object definition = d->definition;
2926 Lisp_Object noindirect = d->noindirect;
2927 Lisp_Object this = d->this;
2928 Lisp_Object last = d->last;
2929 int last_is_meta = d->last_is_meta;
2930 Lisp_Object sequence;
2932 /* Search through indirections unless that's not wanted. */
2933 if (NILP (noindirect))
2934 binding = get_keyelt (binding, 0);
2936 /* End this iteration if this element does not match
2937 the target. */
2939 if (!(!NILP (where_is_cache) /* everything "matches" during cache-fill. */
2940 || EQ (binding, definition)
2941 || (CONSP (definition) && !NILP (Fequal (binding, definition)))))
2942 /* Doesn't match. */
2943 return;
2945 /* We have found a match. Construct the key sequence where we found it. */
2946 if (INTEGERP (key) && last_is_meta)
2948 sequence = Fcopy_sequence (this);
2949 Faset (sequence, last, make_number (XINT (key) | meta_modifier));
2951 else
2953 if (CONSP (key))
2954 key = Fcons (XCAR (key), XCDR (key));
2955 sequence = append_key (this, key);
2958 if (!NILP (where_is_cache))
2960 Lisp_Object sequences = Fgethash (binding, where_is_cache, Qnil);
2961 Fputhash (binding, Fcons (sequence, sequences), where_is_cache);
2963 else
2964 d->sequences = Fcons (sequence, d->sequences);
2967 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2969 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings, Sdescribe_buffer_bindings, 1, 3, 0,
2970 doc: /* Insert the list of all defined keys and their definitions.
2971 The list is inserted in the current buffer, while the bindings are
2972 looked up in BUFFER.
2973 The optional argument PREFIX, if non-nil, should be a key sequence;
2974 then we display only bindings that start with that prefix.
2975 The optional argument MENUS, if non-nil, says to mention menu bindings.
2976 \(Ordinarily these are omitted from the output.) */)
2977 (buffer, prefix, menus)
2978 Lisp_Object buffer, prefix, menus;
2980 Lisp_Object outbuf, shadow;
2981 int nomenu = NILP (menus);
2982 register Lisp_Object start1;
2983 struct gcpro gcpro1;
2985 char *alternate_heading
2986 = "\
2987 Keyboard translations:\n\n\
2988 You type Translation\n\
2989 -------- -----------\n";
2991 CHECK_BUFFER (buffer);
2993 shadow = Qnil;
2994 GCPRO1 (shadow);
2996 outbuf = Fcurrent_buffer ();
2998 /* Report on alternates for keys. */
2999 if (STRINGP (current_kboard->Vkeyboard_translate_table) && !NILP (prefix))
3001 int c;
3002 const unsigned char *translate = SDATA (current_kboard->Vkeyboard_translate_table);
3003 int translate_len = SCHARS (current_kboard->Vkeyboard_translate_table);
3005 for (c = 0; c < translate_len; c++)
3006 if (translate[c] != c)
3008 char buf[KEY_DESCRIPTION_SIZE];
3009 char *bufend;
3011 if (alternate_heading)
3013 insert_string (alternate_heading);
3014 alternate_heading = 0;
3017 bufend = push_key_description (translate[c], buf, 1);
3018 insert (buf, bufend - buf);
3019 Findent_to (make_number (16), make_number (1));
3020 bufend = push_key_description (c, buf, 1);
3021 insert (buf, bufend - buf);
3023 insert ("\n", 1);
3025 /* Insert calls signal_after_change which may GC. */
3026 translate = SDATA (current_kboard->Vkeyboard_translate_table);
3029 insert ("\n", 1);
3032 if (!NILP (Vkey_translation_map))
3033 describe_map_tree (Vkey_translation_map, 0, Qnil, prefix,
3034 "Key translations", nomenu, 1, 0, 0);
3037 /* Print the (major mode) local map. */
3038 start1 = Qnil;
3039 if (!NILP (current_kboard->Voverriding_terminal_local_map))
3040 start1 = current_kboard->Voverriding_terminal_local_map;
3041 else if (!NILP (Voverriding_local_map))
3042 start1 = Voverriding_local_map;
3044 if (!NILP (start1))
3046 describe_map_tree (start1, 1, shadow, prefix,
3047 "\f\nOverriding Bindings", nomenu, 0, 0, 0);
3048 shadow = Fcons (start1, shadow);
3050 else
3052 /* Print the minor mode and major mode keymaps. */
3053 int i, nmaps;
3054 Lisp_Object *modes, *maps;
3056 /* Temporarily switch to `buffer', so that we can get that buffer's
3057 minor modes correctly. */
3058 Fset_buffer (buffer);
3060 nmaps = current_minor_maps (&modes, &maps);
3061 Fset_buffer (outbuf);
3063 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3064 XBUFFER (buffer), Qkeymap);
3065 if (!NILP (start1))
3067 describe_map_tree (start1, 1, shadow, prefix,
3068 "\f\n`keymap' Property Bindings", nomenu,
3069 0, 0, 0);
3070 shadow = Fcons (start1, shadow);
3073 /* Print the minor mode maps. */
3074 for (i = 0; i < nmaps; i++)
3076 /* The title for a minor mode keymap
3077 is constructed at run time.
3078 We let describe_map_tree do the actual insertion
3079 because it takes care of other features when doing so. */
3080 char *title, *p;
3082 if (!SYMBOLP (modes[i]))
3083 abort();
3085 p = title = (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes[i])));
3086 *p++ = '\f';
3087 *p++ = '\n';
3088 *p++ = '`';
3089 bcopy (SDATA (SYMBOL_NAME (modes[i])), p,
3090 SCHARS (SYMBOL_NAME (modes[i])));
3091 p += SCHARS (SYMBOL_NAME (modes[i]));
3092 *p++ = '\'';
3093 bcopy (" Minor Mode Bindings", p, sizeof (" Minor Mode Bindings") - 1);
3094 p += sizeof (" Minor Mode Bindings") - 1;
3095 *p = 0;
3097 describe_map_tree (maps[i], 1, shadow, prefix,
3098 title, nomenu, 0, 0, 0);
3099 shadow = Fcons (maps[i], shadow);
3102 start1 = get_local_map (BUF_PT (XBUFFER (buffer)),
3103 XBUFFER (buffer), Qlocal_map);
3104 if (!NILP (start1))
3106 if (EQ (start1, XBUFFER (buffer)->keymap))
3107 describe_map_tree (start1, 1, shadow, prefix,
3108 "\f\nMajor Mode Bindings", nomenu, 0, 0, 0);
3109 else
3110 describe_map_tree (start1, 1, shadow, prefix,
3111 "\f\n`local-map' Property Bindings",
3112 nomenu, 0, 0, 0);
3114 shadow = Fcons (start1, shadow);
3118 describe_map_tree (current_global_map, 1, shadow, prefix,
3119 "\f\nGlobal Bindings", nomenu, 0, 1, 0);
3121 /* Print the function-key-map translations under this prefix. */
3122 if (!NILP (current_kboard->Vlocal_function_key_map))
3123 describe_map_tree (current_kboard->Vlocal_function_key_map, 0, Qnil, prefix,
3124 "\f\nFunction key map translations", nomenu, 1, 0, 0);
3126 /* Print the input-decode-map translations under this prefix. */
3127 if (!NILP (current_kboard->Vinput_decode_map))
3128 describe_map_tree (current_kboard->Vinput_decode_map, 0, Qnil, prefix,
3129 "\f\nInput decoding map translations", nomenu, 1, 0, 0);
3131 UNGCPRO;
3132 return Qnil;
3135 /* Insert a description of the key bindings in STARTMAP,
3136 followed by those of all maps reachable through STARTMAP.
3137 If PARTIAL is nonzero, omit certain "uninteresting" commands
3138 (such as `undefined').
3139 If SHADOW is non-nil, it is a list of maps;
3140 don't mention keys which would be shadowed by any of them.
3141 PREFIX, if non-nil, says mention only keys that start with PREFIX.
3142 TITLE, if not 0, is a string to insert at the beginning.
3143 TITLE should not end with a colon or a newline; we supply that.
3144 If NOMENU is not 0, then omit menu-bar commands.
3146 If TRANSL is nonzero, the definitions are actually key translations
3147 so print strings and vectors differently.
3149 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
3150 to look through.
3152 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
3153 don't omit it; instead, mention it but say it is shadowed. */
3155 void
3156 describe_map_tree (startmap, partial, shadow, prefix, title, nomenu, transl,
3157 always_title, mention_shadow)
3158 Lisp_Object startmap, shadow, prefix;
3159 int partial;
3160 char *title;
3161 int nomenu;
3162 int transl;
3163 int always_title;
3164 int mention_shadow;
3166 Lisp_Object maps, orig_maps, seen, sub_shadows;
3167 struct gcpro gcpro1, gcpro2, gcpro3;
3168 int something = 0;
3169 char *key_heading
3170 = "\
3171 key binding\n\
3172 --- -------\n";
3174 orig_maps = maps = Faccessible_keymaps (startmap, prefix);
3175 seen = Qnil;
3176 sub_shadows = Qnil;
3177 GCPRO3 (maps, seen, sub_shadows);
3179 if (nomenu)
3181 Lisp_Object list;
3183 /* Delete from MAPS each element that is for the menu bar. */
3184 for (list = maps; CONSP (list); list = XCDR (list))
3186 Lisp_Object elt, prefix, tem;
3188 elt = XCAR (list);
3189 prefix = Fcar (elt);
3190 if (XVECTOR (prefix)->size >= 1)
3192 tem = Faref (prefix, make_number (0));
3193 if (EQ (tem, Qmenu_bar))
3194 maps = Fdelq (elt, maps);
3199 if (!NILP (maps) || always_title)
3201 if (title)
3203 insert_string (title);
3204 if (!NILP (prefix))
3206 insert_string (" Starting With ");
3207 insert1 (Fkey_description (prefix, Qnil));
3209 insert_string (":\n");
3211 insert_string (key_heading);
3212 something = 1;
3215 for (; CONSP (maps); maps = XCDR (maps))
3217 register Lisp_Object elt, prefix, tail;
3219 elt = XCAR (maps);
3220 prefix = Fcar (elt);
3222 sub_shadows = Qnil;
3224 for (tail = shadow; CONSP (tail); tail = XCDR (tail))
3226 Lisp_Object shmap;
3228 shmap = XCAR (tail);
3230 /* If the sequence by which we reach this keymap is zero-length,
3231 then the shadow map for this keymap is just SHADOW. */
3232 if ((STRINGP (prefix) && SCHARS (prefix) == 0)
3233 || (VECTORP (prefix) && XVECTOR (prefix)->size == 0))
3235 /* If the sequence by which we reach this keymap actually has
3236 some elements, then the sequence's definition in SHADOW is
3237 what we should use. */
3238 else
3240 shmap = Flookup_key (shmap, Fcar (elt), Qt);
3241 if (INTEGERP (shmap))
3242 shmap = Qnil;
3245 /* If shmap is not nil and not a keymap,
3246 it completely shadows this map, so don't
3247 describe this map at all. */
3248 if (!NILP (shmap) && !KEYMAPP (shmap))
3249 goto skip;
3251 if (!NILP (shmap))
3252 sub_shadows = Fcons (shmap, sub_shadows);
3255 /* Maps we have already listed in this loop shadow this map. */
3256 for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
3258 Lisp_Object tem;
3259 tem = Fequal (Fcar (XCAR (tail)), prefix);
3260 if (!NILP (tem))
3261 sub_shadows = Fcons (XCDR (XCAR (tail)), sub_shadows);
3264 describe_map (Fcdr (elt), prefix,
3265 transl ? describe_translation : describe_command,
3266 partial, sub_shadows, &seen, nomenu, mention_shadow);
3268 skip: ;
3271 if (something)
3272 insert_string ("\n");
3274 UNGCPRO;
3277 static int previous_description_column;
3279 static void
3280 describe_command (definition, args)
3281 Lisp_Object definition, args;
3283 register Lisp_Object tem1;
3284 int column = (int) current_column (); /* iftc */
3285 int description_column;
3287 /* If column 16 is no good, go to col 32;
3288 but don't push beyond that--go to next line instead. */
3289 if (column > 30)
3291 insert_char ('\n');
3292 description_column = 32;
3294 else if (column > 14 || (column > 10 && previous_description_column == 32))
3295 description_column = 32;
3296 else
3297 description_column = 16;
3299 Findent_to (make_number (description_column), make_number (1));
3300 previous_description_column = description_column;
3302 if (SYMBOLP (definition))
3304 tem1 = SYMBOL_NAME (definition);
3305 insert1 (tem1);
3306 insert_string ("\n");
3308 else if (STRINGP (definition) || VECTORP (definition))
3309 insert_string ("Keyboard Macro\n");
3310 else if (KEYMAPP (definition))
3311 insert_string ("Prefix Command\n");
3312 else
3313 insert_string ("??\n");
3316 static void
3317 describe_translation (definition, args)
3318 Lisp_Object definition, args;
3320 register Lisp_Object tem1;
3322 Findent_to (make_number (16), make_number (1));
3324 if (SYMBOLP (definition))
3326 tem1 = SYMBOL_NAME (definition);
3327 insert1 (tem1);
3328 insert_string ("\n");
3330 else if (STRINGP (definition) || VECTORP (definition))
3332 insert1 (Fkey_description (definition, Qnil));
3333 insert_string ("\n");
3335 else if (KEYMAPP (definition))
3336 insert_string ("Prefix Command\n");
3337 else
3338 insert_string ("??\n");
3341 /* describe_map puts all the usable elements of a sparse keymap
3342 into an array of `struct describe_map_elt',
3343 then sorts them by the events. */
3345 struct describe_map_elt { Lisp_Object event; Lisp_Object definition; int shadowed; };
3347 /* qsort comparison function for sorting `struct describe_map_elt' by
3348 the event field. */
3350 static int
3351 describe_map_compare (aa, bb)
3352 const void *aa, *bb;
3354 const struct describe_map_elt *a = aa, *b = bb;
3355 if (INTEGERP (a->event) && INTEGERP (b->event))
3356 return ((XINT (a->event) > XINT (b->event))
3357 - (XINT (a->event) < XINT (b->event)));
3358 if (!INTEGERP (a->event) && INTEGERP (b->event))
3359 return 1;
3360 if (INTEGERP (a->event) && !INTEGERP (b->event))
3361 return -1;
3362 if (SYMBOLP (a->event) && SYMBOLP (b->event))
3363 return (!NILP (Fstring_lessp (a->event, b->event)) ? -1
3364 : !NILP (Fstring_lessp (b->event, a->event)) ? 1
3365 : 0);
3366 return 0;
3369 /* Describe the contents of map MAP, assuming that this map itself is
3370 reached by the sequence of prefix keys PREFIX (a string or vector).
3371 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3373 static void
3374 describe_map (map, prefix, elt_describer, partial, shadow,
3375 seen, nomenu, mention_shadow)
3376 register Lisp_Object map;
3377 Lisp_Object prefix;
3378 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3379 int partial;
3380 Lisp_Object shadow;
3381 Lisp_Object *seen;
3382 int nomenu;
3383 int mention_shadow;
3385 Lisp_Object tail, definition, event;
3386 Lisp_Object tem;
3387 Lisp_Object suppress;
3388 Lisp_Object kludge;
3389 int first = 1;
3390 struct gcpro gcpro1, gcpro2, gcpro3;
3392 /* These accumulate the values from sparse keymap bindings,
3393 so we can sort them and handle them in order. */
3394 int length_needed = 0;
3395 struct describe_map_elt *vect;
3396 int slots_used = 0;
3397 int i;
3399 suppress = Qnil;
3401 if (partial)
3402 suppress = intern ("suppress-keymap");
3404 /* This vector gets used to present single keys to Flookup_key. Since
3405 that is done once per keymap element, we don't want to cons up a
3406 fresh vector every time. */
3407 kludge = Fmake_vector (make_number (1), Qnil);
3408 definition = Qnil;
3410 for (tail = map; CONSP (tail); tail = XCDR (tail))
3411 length_needed++;
3413 vect = ((struct describe_map_elt *)
3414 alloca (sizeof (struct describe_map_elt) * length_needed));
3416 GCPRO3 (prefix, definition, kludge);
3418 for (tail = map; CONSP (tail); tail = XCDR (tail))
3420 QUIT;
3422 if (VECTORP (XCAR (tail))
3423 || CHAR_TABLE_P (XCAR (tail)))
3424 describe_vector (XCAR (tail),
3425 prefix, Qnil, elt_describer, partial, shadow, map,
3426 (int *)0, 0, 1, mention_shadow);
3427 else if (CONSP (XCAR (tail)))
3429 int this_shadowed = 0;
3431 event = XCAR (XCAR (tail));
3433 /* Ignore bindings whose "prefix" are not really valid events.
3434 (We get these in the frames and buffers menu.) */
3435 if (!(SYMBOLP (event) || INTEGERP (event)))
3436 continue;
3438 if (nomenu && EQ (event, Qmenu_bar))
3439 continue;
3441 definition = get_keyelt (XCDR (XCAR (tail)), 0);
3443 /* Don't show undefined commands or suppressed commands. */
3444 if (NILP (definition)) continue;
3445 if (SYMBOLP (definition) && partial)
3447 tem = Fget (definition, suppress);
3448 if (!NILP (tem))
3449 continue;
3452 /* Don't show a command that isn't really visible
3453 because a local definition of the same key shadows it. */
3455 ASET (kludge, 0, event);
3456 if (!NILP (shadow))
3458 tem = shadow_lookup (shadow, kludge, Qt);
3459 if (!NILP (tem))
3461 /* If both bindings are keymaps, this key is a prefix key,
3462 so don't say it is shadowed. */
3463 if (KEYMAPP (definition) && KEYMAPP (tem))
3465 /* Avoid generating duplicate entries if the
3466 shadowed binding has the same definition. */
3467 else if (mention_shadow && !EQ (tem, definition))
3468 this_shadowed = 1;
3469 else
3470 continue;
3474 tem = Flookup_key (map, kludge, Qt);
3475 if (!EQ (tem, definition)) continue;
3477 vect[slots_used].event = event;
3478 vect[slots_used].definition = definition;
3479 vect[slots_used].shadowed = this_shadowed;
3480 slots_used++;
3482 else if (EQ (XCAR (tail), Qkeymap))
3484 /* The same keymap might be in the structure twice, if we're
3485 using an inherited keymap. So skip anything we've already
3486 encountered. */
3487 tem = Fassq (tail, *seen);
3488 if (CONSP (tem) && !NILP (Fequal (XCAR (tem), prefix)))
3489 break;
3490 *seen = Fcons (Fcons (tail, prefix), *seen);
3494 /* If we found some sparse map events, sort them. */
3496 qsort (vect, slots_used, sizeof (struct describe_map_elt),
3497 describe_map_compare);
3499 /* Now output them in sorted order. */
3501 for (i = 0; i < slots_used; i++)
3503 Lisp_Object start, end;
3505 if (first)
3507 previous_description_column = 0;
3508 insert ("\n", 1);
3509 first = 0;
3512 ASET (kludge, 0, vect[i].event);
3513 start = vect[i].event;
3514 end = start;
3516 definition = vect[i].definition;
3518 /* Find consecutive chars that are identically defined. */
3519 if (INTEGERP (vect[i].event))
3521 while (i + 1 < slots_used
3522 && EQ (vect[i+1].event, make_number (XINT (vect[i].event) + 1))
3523 && !NILP (Fequal (vect[i + 1].definition, definition))
3524 && vect[i].shadowed == vect[i + 1].shadowed)
3525 i++;
3526 end = vect[i].event;
3529 /* Now START .. END is the range to describe next. */
3531 /* Insert the string to describe the event START. */
3532 insert1 (Fkey_description (kludge, prefix));
3534 if (!EQ (start, end))
3536 insert (" .. ", 4);
3538 ASET (kludge, 0, end);
3539 /* Insert the string to describe the character END. */
3540 insert1 (Fkey_description (kludge, prefix));
3543 /* Print a description of the definition of this character.
3544 elt_describer will take care of spacing out far enough
3545 for alignment purposes. */
3546 (*elt_describer) (vect[i].definition, Qnil);
3548 if (vect[i].shadowed)
3550 SET_PT (PT - 1);
3551 insert_string ("\n (that binding is currently shadowed by another mode)");
3552 SET_PT (PT + 1);
3556 UNGCPRO;
3559 static void
3560 describe_vector_princ (elt, fun)
3561 Lisp_Object elt, fun;
3563 Findent_to (make_number (16), make_number (1));
3564 call1 (fun, elt);
3565 Fterpri (Qnil);
3568 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
3569 doc: /* Insert a description of contents of VECTOR.
3570 This is text showing the elements of vector matched against indices.
3571 DESCRIBER is the output function used; nil means use `princ'. */)
3572 (vector, describer)
3573 Lisp_Object vector, describer;
3575 int count = SPECPDL_INDEX ();
3576 if (NILP (describer))
3577 describer = intern ("princ");
3578 specbind (Qstandard_output, Fcurrent_buffer ());
3579 CHECK_VECTOR_OR_CHAR_TABLE (vector);
3580 describe_vector (vector, Qnil, describer, describe_vector_princ, 0,
3581 Qnil, Qnil, (int *)0, 0, 0, 0);
3583 return unbind_to (count, Qnil);
3586 /* Insert in the current buffer a description of the contents of VECTOR.
3587 We call ELT_DESCRIBER to insert the description of one value found
3588 in VECTOR.
3590 ELT_PREFIX describes what "comes before" the keys or indices defined
3591 by this vector. This is a human-readable string whose size
3592 is not necessarily related to the situation.
3594 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3595 leads to this keymap.
3597 If the vector is a chartable, ELT_PREFIX is the vector
3598 of bytes that lead to the character set or portion of a character
3599 set described by this chartable.
3601 If PARTIAL is nonzero, it means do not mention suppressed commands
3602 (that assumes the vector is in a keymap).
3604 SHADOW is a list of keymaps that shadow this map.
3605 If it is non-nil, then we look up the key in those maps
3606 and we don't mention it now if it is defined by any of them.
3608 ENTIRE_MAP is the keymap in which this vector appears.
3609 If the definition in effect in the whole map does not match
3610 the one in this vector, we ignore this one.
3612 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3614 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3615 the near future.
3617 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3619 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3621 static void
3622 describe_vector (vector, prefix, args, elt_describer,
3623 partial, shadow, entire_map,
3624 indices, char_table_depth, keymap_p,
3625 mention_shadow)
3626 register Lisp_Object vector;
3627 Lisp_Object prefix, args;
3628 void (*elt_describer) P_ ((Lisp_Object, Lisp_Object));
3629 int partial;
3630 Lisp_Object shadow;
3631 Lisp_Object entire_map;
3632 int *indices;
3633 int char_table_depth;
3634 int keymap_p;
3635 int mention_shadow;
3637 Lisp_Object definition;
3638 Lisp_Object tem2;
3639 Lisp_Object elt_prefix = Qnil;
3640 int i;
3641 Lisp_Object suppress;
3642 Lisp_Object kludge;
3643 int first = 1;
3644 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
3645 /* Range of elements to be handled. */
3646 int from, to;
3647 Lisp_Object character;
3648 int starting_i;
3650 suppress = Qnil;
3652 definition = Qnil;
3654 if (!keymap_p)
3656 /* Call Fkey_description first, to avoid GC bug for the other string. */
3657 if (!NILP (prefix) && XFASTINT (Flength (prefix)) > 0)
3659 Lisp_Object tem;
3660 tem = Fkey_description (prefix, Qnil);
3661 elt_prefix = concat2 (tem, build_string (" "));
3663 prefix = Qnil;
3666 /* This vector gets used to present single keys to Flookup_key. Since
3667 that is done once per vector element, we don't want to cons up a
3668 fresh vector every time. */
3669 kludge = Fmake_vector (make_number (1), Qnil);
3670 GCPRO4 (elt_prefix, prefix, definition, kludge);
3672 if (partial)
3673 suppress = intern ("suppress-keymap");
3675 from = 0;
3676 to = CHAR_TABLE_P (vector) ? MAX_CHAR + 1 : XVECTOR (vector)->size;
3678 for (i = from; i < to; i++)
3680 int this_shadowed = 0;
3681 int range_beg, range_end;
3682 Lisp_Object val;
3684 QUIT;
3686 starting_i = i;
3688 if (CHAR_TABLE_P (vector))
3689 val = char_table_ref_and_range (vector, i, &range_beg, &i);
3690 else
3691 val = AREF (vector, i);
3692 definition = get_keyelt (val, 0);
3694 if (NILP (definition)) continue;
3696 /* Don't mention suppressed commands. */
3697 if (SYMBOLP (definition) && partial)
3699 Lisp_Object tem;
3701 tem = Fget (definition, suppress);
3703 if (!NILP (tem)) continue;
3706 character = make_number (starting_i);
3707 ASET (kludge, 0, character);
3709 /* If this binding is shadowed by some other map, ignore it. */
3710 if (!NILP (shadow))
3712 Lisp_Object tem;
3714 tem = shadow_lookup (shadow, kludge, Qt);
3716 if (!NILP (tem))
3718 if (mention_shadow)
3719 this_shadowed = 1;
3720 else
3721 continue;
3725 /* Ignore this definition if it is shadowed by an earlier
3726 one in the same keymap. */
3727 if (!NILP (entire_map))
3729 Lisp_Object tem;
3731 tem = Flookup_key (entire_map, kludge, Qt);
3733 if (!EQ (tem, definition))
3734 continue;
3737 if (first)
3739 insert ("\n", 1);
3740 first = 0;
3743 /* Output the prefix that applies to every entry in this map. */
3744 if (!NILP (elt_prefix))
3745 insert1 (elt_prefix);
3747 insert1 (Fkey_description (kludge, prefix));
3749 /* Find all consecutive characters or rows that have the same
3750 definition. But, for elements of a top level char table, if
3751 they are for charsets, we had better describe one by one even
3752 if they have the same definition. */
3753 if (CHAR_TABLE_P (vector))
3754 while (i + 1 < to
3755 && (val = char_table_ref_and_range (vector, i + 1,
3756 &range_beg, &range_end),
3757 tem2 = get_keyelt (val, 0),
3758 !NILP (tem2))
3759 && !NILP (Fequal (tem2, definition)))
3760 i = range_end;
3761 else
3762 while (i + 1 < to
3763 && (tem2 = get_keyelt (AREF (vector, i + 1), 0),
3764 !NILP (tem2))
3765 && !NILP (Fequal (tem2, definition)))
3766 i++;
3768 /* If we have a range of more than one character,
3769 print where the range reaches to. */
3771 if (i != starting_i)
3773 insert (" .. ", 4);
3775 ASET (kludge, 0, make_number (i));
3777 if (!NILP (elt_prefix))
3778 insert1 (elt_prefix);
3780 insert1 (Fkey_description (kludge, prefix));
3783 /* Print a description of the definition of this character.
3784 elt_describer will take care of spacing out far enough
3785 for alignment purposes. */
3786 (*elt_describer) (definition, args);
3788 if (this_shadowed)
3790 SET_PT (PT - 1);
3791 insert_string (" (binding currently shadowed)");
3792 SET_PT (PT + 1);
3796 if (CHAR_TABLE_P (vector) && ! NILP (XCHAR_TABLE (vector)->defalt))
3798 if (!NILP (elt_prefix))
3799 insert1 (elt_prefix);
3800 insert ("default", 7);
3801 (*elt_describer) (XCHAR_TABLE (vector)->defalt, args);
3804 UNGCPRO;
3807 /* Apropos - finding all symbols whose names match a regexp. */
3808 static Lisp_Object apropos_predicate;
3809 static Lisp_Object apropos_accumulate;
3811 static void
3812 apropos_accum (symbol, string)
3813 Lisp_Object symbol, string;
3815 register Lisp_Object tem;
3817 tem = Fstring_match (string, Fsymbol_name (symbol), Qnil);
3818 if (!NILP (tem) && !NILP (apropos_predicate))
3819 tem = call1 (apropos_predicate, symbol);
3820 if (!NILP (tem))
3821 apropos_accumulate = Fcons (symbol, apropos_accumulate);
3824 DEFUN ("apropos-internal", Fapropos_internal, Sapropos_internal, 1, 2, 0,
3825 doc: /* Show all symbols whose names contain match for REGEXP.
3826 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3827 for each symbol and a symbol is mentioned only if that returns non-nil.
3828 Return list of symbols found. */)
3829 (regexp, predicate)
3830 Lisp_Object regexp, predicate;
3832 Lisp_Object tem;
3833 CHECK_STRING (regexp);
3834 apropos_predicate = predicate;
3835 apropos_accumulate = Qnil;
3836 map_obarray (Vobarray, apropos_accum, regexp);
3837 tem = Fsort (apropos_accumulate, Qstring_lessp);
3838 apropos_accumulate = Qnil;
3839 apropos_predicate = Qnil;
3840 return tem;
3843 void
3844 syms_of_keymap ()
3846 Qkeymap = intern ("keymap");
3847 staticpro (&Qkeymap);
3848 staticpro (&apropos_predicate);
3849 staticpro (&apropos_accumulate);
3850 apropos_predicate = Qnil;
3851 apropos_accumulate = Qnil;
3853 /* Now we are ready to set up this property, so we can
3854 create char tables. */
3855 Fput (Qkeymap, Qchar_table_extra_slots, make_number (0));
3857 /* Initialize the keymaps standardly used.
3858 Each one is the value of a Lisp variable, and is also
3859 pointed to by a C variable */
3861 global_map = Fmake_keymap (Qnil);
3862 Fset (intern ("global-map"), global_map);
3864 current_global_map = global_map;
3865 staticpro (&global_map);
3866 staticpro (&current_global_map);
3868 meta_map = Fmake_keymap (Qnil);
3869 Fset (intern ("esc-map"), meta_map);
3870 Ffset (intern ("ESC-prefix"), meta_map);
3872 control_x_map = Fmake_keymap (Qnil);
3873 Fset (intern ("ctl-x-map"), control_x_map);
3874 Ffset (intern ("Control-X-prefix"), control_x_map);
3876 exclude_keys
3877 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3878 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3879 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3880 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3881 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3882 Qnil)))));
3883 staticpro (&exclude_keys);
3885 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands,
3886 doc: /* List of commands given new key bindings recently.
3887 This is used for internal purposes during Emacs startup;
3888 don't alter it yourself. */);
3889 Vdefine_key_rebound_commands = Qt;
3891 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map,
3892 doc: /* Default keymap to use when reading from the minibuffer. */);
3893 Vminibuffer_local_map = Fmake_sparse_keymap (Qnil);
3895 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map,
3896 doc: /* Local keymap for the minibuffer when spaces are not allowed. */);
3897 Vminibuffer_local_ns_map = Fmake_sparse_keymap (Qnil);
3898 Fset_keymap_parent (Vminibuffer_local_ns_map, Vminibuffer_local_map);
3900 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map,
3901 doc: /* Local keymap for minibuffer input with completion. */);
3902 Vminibuffer_local_completion_map = Fmake_sparse_keymap (Qnil);
3903 Fset_keymap_parent (Vminibuffer_local_completion_map, Vminibuffer_local_map);
3905 DEFVAR_LISP ("minibuffer-local-filename-completion-map",
3906 &Vminibuffer_local_filename_completion_map,
3907 doc: /* Local keymap for minibuffer input with completion for filenames. */);
3908 Vminibuffer_local_filename_completion_map = Fmake_sparse_keymap (Qnil);
3909 Fset_keymap_parent (Vminibuffer_local_filename_completion_map,
3910 Vminibuffer_local_completion_map);
3913 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map,
3914 doc: /* Local keymap for minibuffer input with completion, for exact match. */);
3915 Vminibuffer_local_must_match_map = Fmake_sparse_keymap (Qnil);
3916 Fset_keymap_parent (Vminibuffer_local_must_match_map,
3917 Vminibuffer_local_completion_map);
3919 DEFVAR_LISP ("minibuffer-local-must-match-filename-map",
3920 &Vminibuffer_local_must_match_filename_map,
3921 doc: /* Local keymap for minibuffer input with completion for filenames with exact match. */);
3922 Vminibuffer_local_must_match_filename_map = Fmake_sparse_keymap (Qnil);
3923 Fset_keymap_parent (Vminibuffer_local_must_match_filename_map,
3924 Vminibuffer_local_must_match_map);
3926 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist,
3927 doc: /* Alist of keymaps to use for minor modes.
3928 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3929 key sequences and look up bindings if VARIABLE's value is non-nil.
3930 If two active keymaps bind the same key, the keymap appearing earlier
3931 in the list takes precedence. */);
3932 Vminor_mode_map_alist = Qnil;
3934 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist,
3935 doc: /* Alist of keymaps to use for minor modes, in current major mode.
3936 This variable is an alist just like `minor-mode-map-alist', and it is
3937 used the same way (and before `minor-mode-map-alist'); however,
3938 it is provided for major modes to bind locally. */);
3939 Vminor_mode_overriding_map_alist = Qnil;
3941 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists,
3942 doc: /* List of keymap alists to use for emulations modes.
3943 It is intended for modes or packages using multiple minor-mode keymaps.
3944 Each element is a keymap alist just like `minor-mode-map-alist', or a
3945 symbol with a variable binding which is a keymap alist, and it is used
3946 the same way. The "active" keymaps in each alist are used before
3947 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3948 Vemulation_mode_map_alists = Qnil;
3950 staticpro (&Vmouse_events);
3951 Vmouse_events = Fcons (intern ("menu-bar"),
3952 Fcons (intern ("tool-bar"),
3953 Fcons (intern ("header-line"),
3954 Fcons (intern ("mode-line"),
3955 Fcons (intern ("mouse-1"),
3956 Fcons (intern ("mouse-2"),
3957 Fcons (intern ("mouse-3"),
3958 Fcons (intern ("mouse-4"),
3959 Fcons (intern ("mouse-5"),
3960 Qnil)))))))));
3963 Qsingle_key_description = intern ("single-key-description");
3964 staticpro (&Qsingle_key_description);
3966 Qkey_description = intern ("key-description");
3967 staticpro (&Qkey_description);
3969 Qkeymapp = intern ("keymapp");
3970 staticpro (&Qkeymapp);
3972 Qnon_ascii = intern ("non-ascii");
3973 staticpro (&Qnon_ascii);
3975 Qmenu_item = intern ("menu-item");
3976 staticpro (&Qmenu_item);
3978 Qremap = intern ("remap");
3979 staticpro (&Qremap);
3981 command_remapping_vector = Fmake_vector (make_number (2), Qremap);
3982 staticpro (&command_remapping_vector);
3984 where_is_cache_keymaps = Qt;
3985 where_is_cache = Qnil;
3986 staticpro (&where_is_cache);
3987 staticpro (&where_is_cache_keymaps);
3989 defsubr (&Skeymapp);
3990 defsubr (&Skeymap_parent);
3991 defsubr (&Skeymap_prompt);
3992 defsubr (&Sset_keymap_parent);
3993 defsubr (&Smake_keymap);
3994 defsubr (&Smake_sparse_keymap);
3995 defsubr (&Smap_keymap_internal);
3996 defsubr (&Smap_keymap);
3997 defsubr (&Scopy_keymap);
3998 defsubr (&Scommand_remapping);
3999 defsubr (&Skey_binding);
4000 defsubr (&Slocal_key_binding);
4001 defsubr (&Sglobal_key_binding);
4002 defsubr (&Sminor_mode_key_binding);
4003 defsubr (&Sdefine_key);
4004 defsubr (&Slookup_key);
4005 defsubr (&Sdefine_prefix_command);
4006 defsubr (&Suse_global_map);
4007 defsubr (&Suse_local_map);
4008 defsubr (&Scurrent_local_map);
4009 defsubr (&Scurrent_global_map);
4010 defsubr (&Scurrent_minor_mode_maps);
4011 defsubr (&Scurrent_active_maps);
4012 defsubr (&Saccessible_keymaps);
4013 defsubr (&Skey_description);
4014 defsubr (&Sdescribe_vector);
4015 defsubr (&Ssingle_key_description);
4016 defsubr (&Stext_char_description);
4017 defsubr (&Swhere_is_internal);
4018 defsubr (&Sdescribe_buffer_bindings);
4019 defsubr (&Sapropos_internal);
4022 void
4023 keys_of_keymap ()
4025 initial_define_key (global_map, 033, "ESC-prefix");
4026 initial_define_key (global_map, Ctl('X'), "Control-X-prefix");
4029 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
4030 (do not change this comment) */