1 /* Manipulation of keymaps
2 Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995,
3 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 2005 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 2, or (at your option)
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. */
29 #include "character.h"
32 #include "termhooks.h"
33 #include "blockinput.h"
35 #include "intervals.h"
38 /* The number of elements in keymap vectors. */
39 #define DENSE_TABLE_SIZE (0200)
41 /* Actually allocate storage for these variables */
43 Lisp_Object current_global_map
; /* Current global keymap */
45 Lisp_Object global_map
; /* default global key bindings */
47 Lisp_Object meta_map
; /* The keymap used for globally bound
48 ESC-prefixed default commands */
50 Lisp_Object control_x_map
; /* The keymap used for globally bound
51 C-x-prefixed default commands */
53 /* was MinibufLocalMap */
54 Lisp_Object Vminibuffer_local_map
;
55 /* The keymap used by the minibuf for local
56 bindings when spaces are allowed in the
59 /* was MinibufLocalNSMap */
60 Lisp_Object Vminibuffer_local_ns_map
;
61 /* The keymap used by the minibuf for local
62 bindings when spaces are not encouraged
65 /* keymap used for minibuffers when doing completion */
66 /* was MinibufLocalCompletionMap */
67 Lisp_Object Vminibuffer_local_completion_map
;
69 /* keymap used for minibuffers when doing completion and require a match */
70 /* was MinibufLocalMustMatchMap */
71 Lisp_Object Vminibuffer_local_must_match_map
;
73 /* Alist of minor mode variables and keymaps. */
74 Lisp_Object Vminor_mode_map_alist
;
76 /* Alist of major-mode-specific overrides for
77 minor mode variables and keymaps. */
78 Lisp_Object Vminor_mode_overriding_map_alist
;
80 /* List of emulation mode keymap alists. */
81 Lisp_Object Vemulation_mode_map_alists
;
83 /* Keymap mapping ASCII function key sequences onto their preferred forms.
84 Initialized by the terminal-specific lisp files. See DEFVAR for more
86 Lisp_Object Vfunction_key_map
;
88 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
89 Lisp_Object Vkey_translation_map
;
91 /* A list of all commands given new bindings since a certain time
92 when nil was stored here.
93 This is used to speed up recomputation of menu key equivalents
94 when Emacs starts up. t means don't record anything here. */
95 Lisp_Object Vdefine_key_rebound_commands
;
97 Lisp_Object Qkeymapp
, Qkeymap
, Qnon_ascii
, Qmenu_item
, Qremap
;
99 /* Alist of elements like (DEL . "\d"). */
100 static Lisp_Object exclude_keys
;
102 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
103 static Lisp_Object command_remapping_vector
;
105 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
106 in a string key sequence is equivalent to prefixing with this
108 extern Lisp_Object meta_prefix_char
;
110 extern Lisp_Object Voverriding_local_map
;
112 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
113 static Lisp_Object where_is_cache
;
114 /* Which keymaps are reverse-stored in the cache. */
115 static Lisp_Object where_is_cache_keymaps
;
117 static Lisp_Object store_in_keymap
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
118 static void fix_submap_inheritance
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
120 static Lisp_Object define_as_prefix
P_ ((Lisp_Object
, Lisp_Object
));
121 static void describe_command
P_ ((Lisp_Object
, Lisp_Object
));
122 static void describe_translation
P_ ((Lisp_Object
, Lisp_Object
));
123 static void describe_map
P_ ((Lisp_Object
, Lisp_Object
,
124 void (*) P_ ((Lisp_Object
, Lisp_Object
)),
125 int, Lisp_Object
, Lisp_Object
*, int, int));
126 static void describe_vector
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
127 void (*) (Lisp_Object
, Lisp_Object
), int,
128 Lisp_Object
, Lisp_Object
, int *,
130 static void silly_event_symbol_error
P_ ((Lisp_Object
));
132 /* Keymap object support - constructors and predicates. */
134 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
135 doc
: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
136 CHARTABLE is a char-table that holds the bindings for all characters
137 without modifiers. All entries in it are initially nil, meaning
138 "command undefined". ALIST is an assoc-list which holds bindings for
139 function keys, mouse events, and any other things that appear in the
140 input stream. Initially, ALIST is nil.
142 The optional arg STRING supplies a menu name for the keymap
143 in case you use it as a menu with `x-popup-menu'. */)
149 tail
= Fcons (string
, Qnil
);
152 return Fcons (Qkeymap
,
153 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
156 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
157 doc
: /* Construct and return a new sparse keymap.
158 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
159 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
160 which binds the function key or mouse event SYMBOL to DEFINITION.
161 Initially the alist is nil.
163 The optional arg STRING supplies a menu name for the keymap
164 in case you use it as a menu with `x-popup-menu'. */)
169 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
170 return Fcons (Qkeymap
, Qnil
);
173 /* This function is used for installing the standard key bindings
174 at initialization time.
178 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
181 initial_define_key (keymap
, key
, defname
)
186 store_in_keymap (keymap
, make_number (key
), intern (defname
));
190 initial_define_lispy_key (keymap
, keyname
, defname
)
195 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
198 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
199 doc
: /* Return t if OBJECT is a keymap.
201 A keymap is a list (keymap . ALIST),
202 or a symbol whose function definition is itself a keymap.
203 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
204 a vector of densely packed bindings for small character codes
205 is also allowed as an element. */)
209 return (KEYMAPP (object
) ? Qt
: Qnil
);
212 DEFUN ("keymap-prompt", Fkeymap_prompt
, Skeymap_prompt
, 1, 1, 0,
213 doc
: /* Return the prompt-string of a keymap MAP.
214 If non-nil, the prompt is shown in the echo-area
215 when reading a key-sequence to be looked-up in this keymap. */)
219 map
= get_keymap (map
, 0, 0);
222 Lisp_Object tem
= XCAR (map
);
230 /* Check that OBJECT is a keymap (after dereferencing through any
231 symbols). If it is, return it.
233 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
234 is an autoload form, do the autoload and try again.
235 If AUTOLOAD is nonzero, callers must assume GC is possible.
237 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
238 is zero as well), return Qt.
240 ERROR controls how we respond if OBJECT isn't a keymap.
241 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
243 Note that most of the time, we don't want to pursue autoloads.
244 Functions like Faccessible_keymaps which scan entire keymap trees
245 shouldn't load every autoloaded keymap. I'm not sure about this,
246 but it seems to me that only read_key_sequence, Flookup_key, and
247 Fdefine_key should cause keymaps to be autoloaded.
249 This function can GC when AUTOLOAD is non-zero, because it calls
250 do_autoload which can GC. */
253 get_keymap (object
, error
, autoload
)
262 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
265 tem
= indirect_function (object
);
268 if (EQ (XCAR (tem
), Qkeymap
))
271 /* Should we do an autoload? Autoload forms for keymaps have
272 Qkeymap as their fifth element. */
273 if ((autoload
|| !error
) && EQ (XCAR (tem
), Qautoload
)
278 tail
= Fnth (make_number (4), tem
);
279 if (EQ (tail
, Qkeymap
))
283 struct gcpro gcpro1
, gcpro2
;
285 GCPRO2 (tem
, object
);
286 do_autoload (tem
, object
);
299 wrong_type_argument (Qkeymapp
, object
);
303 /* Return the parent map of KEYMAP, or nil if it has none.
304 We assume that KEYMAP is a valid keymap. */
307 keymap_parent (keymap
, autoload
)
313 keymap
= get_keymap (keymap
, 1, autoload
);
315 /* Skip past the initial element `keymap'. */
316 list
= XCDR (keymap
);
317 for (; CONSP (list
); list
= XCDR (list
))
319 /* See if there is another `keymap'. */
324 return get_keymap (list
, 0, autoload
);
327 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
328 doc
: /* Return the parent keymap of KEYMAP. */)
332 return keymap_parent (keymap
, 1);
335 /* Check whether MAP is one of MAPS parents. */
337 keymap_memberp (map
, maps
)
338 Lisp_Object map
, maps
;
340 if (NILP (map
)) return 0;
341 while (KEYMAPP (maps
) && !EQ (map
, maps
))
342 maps
= keymap_parent (maps
, 0);
343 return (EQ (map
, maps
));
346 /* Set the parent keymap of MAP to PARENT. */
348 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
349 doc
: /* Modify KEYMAP to set its parent map to PARENT.
350 Return PARENT. PARENT should be nil or another keymap. */)
352 Lisp_Object keymap
, parent
;
354 Lisp_Object list
, prev
;
355 struct gcpro gcpro1
, gcpro2
;
358 /* Force a keymap flush for the next call to where-is.
359 Since this can be called from within where-is, we don't set where_is_cache
360 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
361 be changed during where-is, while where_is_cache_keymaps is only used at
362 the very beginning of where-is and can thus be changed here without any
364 This is a very minor correctness (rather than safety) issue. */
365 where_is_cache_keymaps
= Qt
;
367 GCPRO2 (keymap
, parent
);
368 keymap
= get_keymap (keymap
, 1, 1);
372 parent
= get_keymap (parent
, 1, 1);
374 /* Check for cycles. */
375 if (keymap_memberp (keymap
, parent
))
376 error ("Cyclic keymap inheritance");
379 /* Skip past the initial element `keymap'. */
384 /* If there is a parent keymap here, replace it.
385 If we came to the end, add the parent in PREV. */
386 if (!CONSP (list
) || KEYMAPP (list
))
388 /* If we already have the right parent, return now
389 so that we avoid the loops below. */
390 if (EQ (XCDR (prev
), parent
))
391 RETURN_UNGCPRO (parent
);
393 XSETCDR (prev
, parent
);
399 /* Scan through for submaps, and set their parents too. */
401 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
403 /* Stop the scan when we come to the parent. */
404 if (EQ (XCAR (list
), Qkeymap
))
407 /* If this element holds a prefix map, deal with it. */
408 if (CONSP (XCAR (list
))
409 && CONSP (XCDR (XCAR (list
))))
410 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
413 if (VECTORP (XCAR (list
)))
414 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
415 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
416 fix_submap_inheritance (keymap
, make_number (i
),
417 XVECTOR (XCAR (list
))->contents
[i
]);
419 if (CHAR_TABLE_P (XCAR (list
)))
421 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
), keymap
);
425 RETURN_UNGCPRO (parent
);
428 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
429 if EVENT is also a prefix in MAP's parent,
430 make sure that SUBMAP inherits that definition as its own parent. */
433 fix_submap_inheritance (map
, event
, submap
)
434 Lisp_Object map
, event
, submap
;
436 Lisp_Object map_parent
, parent_entry
;
438 /* SUBMAP is a cons that we found as a key binding.
439 Discard the other things found in a menu key binding. */
441 submap
= get_keymap (get_keyelt (submap
, 0), 0, 0);
443 /* If it isn't a keymap now, there's no work to do. */
447 map_parent
= keymap_parent (map
, 0);
448 if (!NILP (map_parent
))
450 get_keymap (access_keymap (map_parent
, event
, 0, 0, 0), 0, 0);
454 /* If MAP's parent has something other than a keymap,
455 our own submap shadows it completely. */
456 if (!CONSP (parent_entry
))
459 if (! EQ (parent_entry
, submap
))
461 Lisp_Object submap_parent
;
462 submap_parent
= submap
;
467 tem
= keymap_parent (submap_parent
, 0);
471 if (keymap_memberp (tem
, parent_entry
))
472 /* Fset_keymap_parent could create a cycle. */
479 Fset_keymap_parent (submap_parent
, parent_entry
);
483 /* Look up IDX in MAP. IDX may be any sort of event.
484 Note that this does only one level of lookup; IDX must be a single
485 event, not a sequence.
487 If T_OK is non-zero, bindings for Qt are treated as default
488 bindings; any key left unmentioned by other tables and bindings is
489 given the binding of Qt.
491 If T_OK is zero, bindings for Qt are not treated specially.
493 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
496 access_keymap (map
, idx
, t_ok
, noinherit
, autoload
)
505 /* Qunbound in VAL means we have found no binding yet. */
508 /* If idx is a list (some sort of mouse click, perhaps?),
509 the index we want to use is the car of the list, which
510 ought to be a symbol. */
511 idx
= EVENT_HEAD (idx
);
513 /* If idx is a symbol, it might have modifiers, which need to
514 be put in the canonical order. */
516 idx
= reorder_modifiers (idx
);
517 else if (INTEGERP (idx
))
518 /* Clobber the high bits that can be present on a machine
519 with more than 24 bits of integer. */
520 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
522 /* Handle the special meta -> esc mapping. */
523 if (INTEGERP (idx
) && XUINT (idx
) & meta_modifier
)
525 /* See if there is a meta-map. If there's none, there is
526 no binding for IDX, unless a default binding exists in MAP. */
528 Lisp_Object meta_map
;
530 /* A strange value in which Meta is set would cause
531 infinite recursion. Protect against that. */
532 if (XINT (meta_prefix_char
) & CHAR_META
)
533 meta_prefix_char
= make_number (27);
534 meta_map
= get_keymap (access_keymap (map
, meta_prefix_char
,
535 t_ok
, noinherit
, autoload
),
538 if (CONSP (meta_map
))
541 idx
= make_number (XUINT (idx
) & ~meta_modifier
);
544 /* Set IDX to t, so that we only find a default binding. */
547 /* We know there is no binding. */
551 /* t_binding is where we put a default binding that applies,
552 to use in case we do not find a binding specifically
553 for this key sequence. */
556 Lisp_Object t_binding
= Qnil
;
557 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
559 GCPRO4 (map
, tail
, idx
, t_binding
);
561 /* If `t_ok' is 2, both `t' is accepted. */
564 for (tail
= XCDR (map
);
566 || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
)));
571 binding
= XCAR (tail
);
572 if (SYMBOLP (binding
))
574 /* If NOINHERIT, stop finding prefix definitions
575 after we pass a second occurrence of the `keymap' symbol. */
576 if (noinherit
&& EQ (binding
, Qkeymap
))
577 RETURN_UNGCPRO (Qnil
);
579 else if (CONSP (binding
))
581 Lisp_Object key
= XCAR (binding
);
584 val
= XCDR (binding
);
585 else if (t_ok
> 1 && EQ (key
, Qt
))
587 t_binding
= XCDR (binding
);
591 else if (VECTORP (binding
))
593 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (binding
))
594 val
= AREF (binding
, XFASTINT (idx
));
596 else if (CHAR_TABLE_P (binding
))
598 /* Character codes with modifiers
599 are not included in a char-table.
600 All character codes without modifiers are included. */
601 if (NATNUMP (idx
) && (XFASTINT (idx
) & CHAR_MODIFIER_MASK
) == 0)
603 val
= Faref (binding
, idx
);
604 /* `nil' has a special meaning for char-tables, so
605 we use something else to record an explicitly
612 /* If we found a binding, clean it up and return it. */
613 if (!EQ (val
, Qunbound
))
616 /* A Qt binding is just like an explicit nil binding
617 (i.e. it shadows any parent binding but not bindings in
618 keymaps of lower precedence). */
620 val
= get_keyelt (val
, autoload
);
622 fix_submap_inheritance (map
, idx
, val
);
623 RETURN_UNGCPRO (val
);
628 return get_keyelt (t_binding
, autoload
);
633 map_keymap_item (fun
, args
, key
, val
, data
)
634 map_keymap_function_t fun
;
635 Lisp_Object args
, key
, val
;
638 /* We should maybe try to detect bindings shadowed by previous
639 ones and things like that. */
642 (*fun
) (key
, val
, args
, data
);
646 map_keymap_char_table_item (args
, key
, val
)
647 Lisp_Object args
, key
, val
;
651 map_keymap_function_t fun
= XSAVE_VALUE (XCAR (args
))->pointer
;
653 map_keymap_item (fun
, XCDR (args
), key
, val
,
654 XSAVE_VALUE (XCAR (args
))->pointer
);
658 /* Call FUN for every binding in MAP.
659 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
660 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
662 map_keymap (map
, fun
, args
, data
, autoload
)
663 map_keymap_function_t fun
;
664 Lisp_Object map
, args
;
668 struct gcpro gcpro1
, gcpro2
, gcpro3
;
671 GCPRO3 (map
, args
, tail
);
672 map
= get_keymap (map
, 1, autoload
);
673 for (tail
= (CONSP (map
) && EQ (Qkeymap
, XCAR (map
))) ? XCDR (map
) : map
;
674 CONSP (tail
) || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
));
677 Lisp_Object binding
= XCAR (tail
);
680 map_keymap_item (fun
, args
, XCAR (binding
), XCDR (binding
), data
);
681 else if (VECTORP (binding
))
683 /* Loop over the char values represented in the vector. */
684 int len
= ASIZE (binding
);
686 for (c
= 0; c
< len
; c
++)
688 Lisp_Object character
;
689 XSETFASTINT (character
, c
);
690 map_keymap_item (fun
, args
, character
, AREF (binding
, c
), data
);
693 else if (CHAR_TABLE_P (binding
))
695 map_char_table (map_keymap_char_table_item
, Qnil
, binding
,
696 Fcons (make_save_value (fun
, 0),
697 Fcons (make_save_value (data
, 0),
705 map_keymap_call (key
, val
, fun
, dummy
)
706 Lisp_Object key
, val
, fun
;
709 call2 (fun
, key
, val
);
712 DEFUN ("map-keymap", Fmap_keymap
, Smap_keymap
, 2, 3, 0,
713 doc
: /* Call FUNCTION for every binding in KEYMAP.
714 FUNCTION is called with two arguments: the event and its binding.
715 If KEYMAP has a parent, the parent's bindings are included as well.
716 This works recursively: if the parent has itself a parent, then the
717 grandparent's bindings are also included and so on.
718 usage: (map-keymap FUNCTION KEYMAP) */)
719 (function
, keymap
, sort_first
)
720 Lisp_Object function
, keymap
, sort_first
;
722 if (INTEGERP (function
))
723 /* We have to stop integers early since map_keymap gives them special
725 Fsignal (Qinvalid_function
, Fcons (function
, Qnil
));
726 if (! NILP (sort_first
))
727 return call3 (intern ("map-keymap-internal"), function
, keymap
, Qt
);
729 map_keymap (keymap
, map_keymap_call
, function
, NULL
, 1);
733 /* Given OBJECT which was found in a slot in a keymap,
734 trace indirect definitions to get the actual definition of that slot.
735 An indirect definition is a list of the form
736 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
737 and INDEX is the object to look up in KEYMAP to yield the definition.
739 Also if OBJECT has a menu string as the first element,
740 remove that. Also remove a menu help string as second element.
742 If AUTOLOAD is nonzero, load autoloadable keymaps
743 that are referred to with indirection.
745 This can GC because menu_item_eval_property calls Feval. */
748 get_keyelt (object
, autoload
)
754 if (!(CONSP (object
)))
755 /* This is really the value. */
758 /* If the keymap contents looks like (keymap ...) or (lambda ...)
760 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
763 /* If the keymap contents looks like (menu-item name . DEFN)
764 or (menu-item name DEFN ...) then use DEFN.
765 This is a new format menu item. */
766 else if (EQ (XCAR (object
), Qmenu_item
))
768 if (CONSP (XCDR (object
)))
772 object
= XCDR (XCDR (object
));
775 object
= XCAR (object
);
777 /* If there's a `:filter FILTER', apply FILTER to the
778 menu-item's definition to get the real definition to
780 for (; CONSP (tem
) && CONSP (XCDR (tem
)); tem
= XCDR (tem
))
781 if (EQ (XCAR (tem
), QCfilter
) && autoload
)
784 filter
= XCAR (XCDR (tem
));
785 filter
= list2 (filter
, list2 (Qquote
, object
));
786 object
= menu_item_eval_property (filter
);
791 /* Invalid keymap. */
795 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
796 Keymap alist elements like (CHAR MENUSTRING . DEFN)
797 will be used by HierarKey menus. */
798 else if (STRINGP (XCAR (object
)))
800 object
= XCDR (object
);
801 /* Also remove a menu help string, if any,
802 following the menu item name. */
803 if (CONSP (object
) && STRINGP (XCAR (object
)))
804 object
= XCDR (object
);
805 /* Also remove the sublist that caches key equivalences, if any. */
806 if (CONSP (object
) && CONSP (XCAR (object
)))
809 carcar
= XCAR (XCAR (object
));
810 if (NILP (carcar
) || VECTORP (carcar
))
811 object
= XCDR (object
);
815 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
821 map
= get_keymap (Fcar_safe (object
), 0, autoload
);
823 return (!CONSP (map
) ? object
/* Invalid keymap */
824 : access_keymap (map
, Fcdr (object
), 0, 0, autoload
));
830 store_in_keymap (keymap
, idx
, def
)
832 register Lisp_Object idx
;
833 register Lisp_Object def
;
835 /* Flush any reverse-map cache. */
836 where_is_cache
= Qnil
;
837 where_is_cache_keymaps
= Qt
;
839 /* If we are preparing to dump, and DEF is a menu element
840 with a menu item indicator, copy it to ensure it is not pure. */
841 if (CONSP (def
) && PURE_P (def
)
842 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
843 def
= Fcons (XCAR (def
), XCDR (def
));
845 if (!CONSP (keymap
) || !EQ (XCAR (keymap
), Qkeymap
))
846 error ("attempt to define a key in a non-keymap");
848 /* If idx is a cons, and the car part is a character, idx must be of
849 the form (FROM-CHAR . TO-CHAR). */
850 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
851 CHECK_CHARACTER_CDR (idx
);
853 /* If idx is a list (some sort of mouse click, perhaps?),
854 the index we want to use is the car of the list, which
855 ought to be a symbol. */
856 idx
= EVENT_HEAD (idx
);
858 /* If idx is a symbol, it might have modifiers, which need to
859 be put in the canonical order. */
861 idx
= reorder_modifiers (idx
);
862 else if (INTEGERP (idx
))
863 /* Clobber the high bits that can be present on a machine
864 with more than 24 bits of integer. */
865 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
867 /* Scan the keymap for a binding of idx. */
871 /* The cons after which we should insert new bindings. If the
872 keymap has a table element, we record its position here, so new
873 bindings will go after it; this way, the table will stay
874 towards the front of the alist and character lookups in dense
875 keymaps will remain fast. Otherwise, this just points at the
876 front of the keymap. */
877 Lisp_Object insertion_point
;
879 insertion_point
= keymap
;
880 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
887 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (elt
))
889 ASET (elt
, XFASTINT (idx
), def
);
892 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
894 int from
= XFASTINT (XCAR (idx
));
895 int to
= XFASTINT (XCDR (idx
));
897 if (to
>= ASIZE (elt
))
898 to
= ASIZE (elt
) - 1;
899 for (; from
<= to
; from
++)
900 ASET (elt
, from
, def
);
901 if (to
== XFASTINT (XCDR (idx
)))
902 /* We have defined all keys in IDX. */
905 insertion_point
= tail
;
907 else if (CHAR_TABLE_P (elt
))
909 /* Character codes with modifiers
910 are not included in a char-table.
911 All character codes without modifiers are included. */
912 if (NATNUMP (idx
) && !(XFASTINT (idx
) & CHAR_MODIFIER_MASK
))
915 /* `nil' has a special meaning for char-tables, so
916 we use something else to record an explicitly
918 NILP (def
) ? Qt
: def
);
921 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
923 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
926 insertion_point
= tail
;
928 else if (CONSP (elt
))
930 if (EQ (idx
, XCAR (elt
)))
935 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
937 int from
= XFASTINT (XCAR (idx
));
938 int to
= XFASTINT (XCDR (idx
));
940 if (from
<= XFASTINT (XCAR (elt
))
941 && to
>= XFASTINT (XCAR (elt
)))
949 else if (EQ (elt
, Qkeymap
))
950 /* If we find a 'keymap' symbol in the spine of KEYMAP,
951 then we must have found the start of a second keymap
952 being used as the tail of KEYMAP, and a binding for IDX
953 should be inserted before it. */
960 /* We have scanned the entire keymap, and not found a binding for
961 IDX. Let's add one. */
965 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
967 /* IDX specifies a range of characters, and not all of them
968 were handled yet, which means this keymap doesn't have a
969 char-table. So, we insert a char-table now. */
970 elt
= Fmake_char_table (Qkeymap
, Qnil
);
971 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
974 elt
= Fcons (idx
, def
);
975 XSETCDR (insertion_point
, Fcons (elt
, XCDR (insertion_point
)));
982 EXFUN (Fcopy_keymap
, 1);
985 copy_keymap_item (elt
)
988 Lisp_Object res
, tem
;
995 /* Is this a new format menu item. */
996 if (EQ (XCAR (tem
), Qmenu_item
))
998 /* Copy cell with menu-item marker. */
999 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
1003 /* Copy cell with menu-item name. */
1004 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1010 /* Copy cell with binding and if the binding is a keymap,
1012 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1015 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1016 XSETCAR (elt
, Fcopy_keymap (tem
));
1018 if (CONSP (tem
) && CONSP (XCAR (tem
)))
1019 /* Delete cache for key equivalences. */
1020 XSETCDR (elt
, XCDR (tem
));
1025 /* It may be an old fomat menu item.
1026 Skip the optional menu string. */
1027 if (STRINGP (XCAR (tem
)))
1029 /* Copy the cell, since copy-alist didn't go this deep. */
1030 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
1032 /* Also skip the optional menu help string. */
1033 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1035 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1039 /* There may also be a list that caches key equivalences.
1040 Just delete it for the new keymap. */
1042 && CONSP (XCAR (tem
))
1043 && (NILP (XCAR (XCAR (tem
)))
1044 || VECTORP (XCAR (XCAR (tem
)))))
1046 XSETCDR (elt
, XCDR (tem
));
1049 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1050 XSETCDR (elt
, Fcopy_keymap (tem
));
1052 else if (EQ (XCAR (tem
), Qkeymap
))
1053 res
= Fcopy_keymap (elt
);
1059 copy_keymap_1 (chartable
, idx
, elt
)
1060 Lisp_Object chartable
, idx
, elt
;
1062 Fset_char_table_range (chartable
, idx
, copy_keymap_item (elt
));
1065 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
1066 doc
: /* Return a copy of the keymap KEYMAP.
1067 The copy starts out with the same definitions of KEYMAP,
1068 but changing either the copy or KEYMAP does not affect the other.
1069 Any key definitions that are subkeymaps are recursively copied.
1070 However, a key definition which is a symbol whose definition is a keymap
1075 register Lisp_Object copy
, tail
;
1076 keymap
= get_keymap (keymap
, 1, 0);
1077 copy
= tail
= Fcons (Qkeymap
, Qnil
);
1078 keymap
= XCDR (keymap
); /* Skip the `keymap' symbol. */
1080 while (CONSP (keymap
) && !EQ (XCAR (keymap
), Qkeymap
))
1082 Lisp_Object elt
= XCAR (keymap
);
1083 if (CHAR_TABLE_P (elt
))
1085 elt
= Fcopy_sequence (elt
);
1086 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
);
1088 else if (VECTORP (elt
))
1091 elt
= Fcopy_sequence (elt
);
1092 for (i
= 0; i
< ASIZE (elt
); i
++)
1093 ASET (elt
, i
, copy_keymap_item (AREF (elt
, i
)));
1095 else if (CONSP (elt
))
1096 elt
= Fcons (XCAR (elt
), copy_keymap_item (XCDR (elt
)));
1097 XSETCDR (tail
, Fcons (elt
, Qnil
));
1099 keymap
= XCDR (keymap
);
1101 XSETCDR (tail
, keymap
);
1105 /* Simple Keymap mutators and accessors. */
1107 /* GC is possible in this function if it autoloads a keymap. */
1109 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
1110 doc
: /* In KEYMAP, define key sequence KEY as DEF.
1113 KEY is a string or a vector of symbols and characters meaning a
1114 sequence of keystrokes and events. Non-ASCII characters with codes
1115 above 127 (such as ISO Latin-1) can be included if you use a vector.
1116 Using [t] for KEY creates a default definition, which applies to any
1117 event type that has no other definition in this keymap.
1119 DEF is anything that can be a key's definition:
1120 nil (means key is undefined in this keymap),
1121 a command (a Lisp function suitable for interactive calling),
1122 a string (treated as a keyboard macro),
1123 a keymap (to define a prefix key),
1124 a symbol (when the key is looked up, the symbol will stand for its
1125 function definition, which should at that time be one of the above,
1126 or another symbol whose function definition is used, etc.),
1127 a cons (STRING . DEFN), meaning that DEFN is the definition
1128 (DEFN should be a valid definition in its own right),
1129 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP.
1131 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1132 binding is altered. If there is no binding for KEY, the new pair
1133 binding KEY to DEF is added at the front of KEYMAP. */)
1140 register Lisp_Object c
;
1141 register Lisp_Object cmd
;
1145 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1147 GCPRO3 (keymap
, key
, def
);
1148 keymap
= get_keymap (keymap
, 1, 1);
1150 if (!VECTORP (key
) && !STRINGP (key
))
1151 key
= wrong_type_argument (Qarrayp
, key
);
1153 length
= XFASTINT (Flength (key
));
1155 RETURN_UNGCPRO (Qnil
);
1157 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
1158 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
1160 meta_bit
= VECTORP (key
) ? meta_modifier
: 0x80;
1165 c
= Faref (key
, make_number (idx
));
1169 /* C may be a Lucid style event type list or a cons (FROM .
1170 TO) specifying a range of characters. */
1171 if (lucid_event_type_list_p (c
))
1172 c
= Fevent_convert_list (c
);
1173 else if (CHARACTERP (XCAR (c
)))
1174 CHECK_CHARACTER_CDR (c
);
1178 silly_event_symbol_error (c
);
1181 && (XINT (c
) & meta_bit
)
1184 c
= meta_prefix_char
;
1190 XSETINT (c
, XINT (c
) & ~meta_bit
);
1196 if (!INTEGERP (c
) && !SYMBOLP (c
)
1198 /* If C is a range, it must be a leaf. */
1199 || (INTEGERP (XCAR (c
)) && idx
!= length
)))
1200 error ("Key sequence contains invalid event");
1203 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
1205 cmd
= access_keymap (keymap
, c
, 0, 1, 1);
1207 /* If this key is undefined, make it a prefix. */
1209 cmd
= define_as_prefix (keymap
, c
);
1211 keymap
= get_keymap (cmd
, 0, 1);
1212 if (!CONSP (keymap
))
1213 /* We must use Fkey_description rather than just passing key to
1214 error; key might be a vector, not a string. */
1215 error ("Key sequence %s uses invalid prefix characters",
1216 SDATA (Fkey_description (key
, Qnil
)));
1220 /* This function may GC (it calls Fkey_binding). */
1222 DEFUN ("command-remapping", Fcommand_remapping
, Scommand_remapping
, 1, 1, 0,
1223 doc
: /* Return the remapping for command COMMAND in current keymaps.
1224 Returns nil if COMMAND is not remapped (or not a symbol). */)
1226 Lisp_Object command
;
1228 if (!SYMBOLP (command
))
1231 ASET (command_remapping_vector
, 1, command
);
1232 return Fkey_binding (command_remapping_vector
, Qnil
, Qt
);
1235 /* Value is number if KEY is too long; nil if valid but has no definition. */
1236 /* GC is possible in this function if it autoloads a keymap. */
1238 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
1239 doc
: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1240 nil means undefined. See doc of `define-key' for kinds of definitions.
1242 A number as value means KEY is "too long";
1243 that is, characters or symbols in it except for the last one
1244 fail to be a valid sequence of prefix characters in KEYMAP.
1245 The number is how many characters at the front of KEY
1246 it takes to reach a non-prefix command.
1248 Normally, `lookup-key' ignores bindings for t, which act as default
1249 bindings, used when nothing else in the keymap applies; this makes it
1250 usable as a general function for probing keymaps. However, if the
1251 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1252 recognize the default bindings, just as `read-key-sequence' does. */)
1253 (keymap
, key
, accept_default
)
1256 Lisp_Object accept_default
;
1259 register Lisp_Object cmd
;
1260 register Lisp_Object c
;
1262 int t_ok
= !NILP (accept_default
);
1263 struct gcpro gcpro1
, gcpro2
;
1265 GCPRO2 (keymap
, key
);
1266 keymap
= get_keymap (keymap
, 1, 1);
1268 if (!VECTORP (key
) && !STRINGP (key
))
1269 key
= wrong_type_argument (Qarrayp
, key
);
1271 length
= XFASTINT (Flength (key
));
1273 RETURN_UNGCPRO (keymap
);
1278 c
= Faref (key
, make_number (idx
++));
1280 if (CONSP (c
) && lucid_event_type_list_p (c
))
1281 c
= Fevent_convert_list (c
);
1283 /* Turn the 8th bit of string chars into a meta modifier. */
1284 if (INTEGERP (c
) && XINT (c
) & 0x80 && STRINGP (key
))
1285 XSETINT (c
, (XINT (c
) | meta_modifier
) & ~0x80);
1287 /* Allow string since binding for `menu-bar-select-buffer'
1288 includes the buffer name in the key sequence. */
1289 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
) && !STRINGP (c
))
1290 error ("Key sequence contains invalid event");
1292 cmd
= access_keymap (keymap
, c
, t_ok
, 0, 1);
1294 RETURN_UNGCPRO (cmd
);
1296 keymap
= get_keymap (cmd
, 0, 1);
1297 if (!CONSP (keymap
))
1298 RETURN_UNGCPRO (make_number (idx
));
1304 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1305 Assume that currently it does not define C at all.
1306 Return the keymap. */
1309 define_as_prefix (keymap
, c
)
1310 Lisp_Object keymap
, c
;
1314 cmd
= Fmake_sparse_keymap (Qnil
);
1315 /* If this key is defined as a prefix in an inherited keymap,
1316 make it a prefix in this map, and make its definition
1317 inherit the other prefix definition. */
1318 cmd
= nconc2 (cmd
, access_keymap (keymap
, c
, 0, 0, 0));
1319 store_in_keymap (keymap
, c
, cmd
);
1324 /* Append a key to the end of a key sequence. We always make a vector. */
1327 append_key (key_sequence
, key
)
1328 Lisp_Object key_sequence
, key
;
1330 Lisp_Object args
[2];
1332 args
[0] = key_sequence
;
1334 args
[1] = Fcons (key
, Qnil
);
1335 return Fvconcat (2, args
);
1338 /* Given a event type C which is a symbol,
1339 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1342 silly_event_symbol_error (c
)
1345 Lisp_Object parsed
, base
, name
, assoc
;
1348 parsed
= parse_modifiers (c
);
1349 modifiers
= (int) XUINT (XCAR (XCDR (parsed
)));
1350 base
= XCAR (parsed
);
1351 name
= Fsymbol_name (base
);
1352 /* This alist includes elements such as ("RET" . "\\r"). */
1353 assoc
= Fassoc (name
, exclude_keys
);
1357 char new_mods
[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1359 Lisp_Object keystring
;
1360 if (modifiers
& alt_modifier
)
1361 { *p
++ = '\\'; *p
++ = 'A'; *p
++ = '-'; }
1362 if (modifiers
& ctrl_modifier
)
1363 { *p
++ = '\\'; *p
++ = 'C'; *p
++ = '-'; }
1364 if (modifiers
& hyper_modifier
)
1365 { *p
++ = '\\'; *p
++ = 'H'; *p
++ = '-'; }
1366 if (modifiers
& meta_modifier
)
1367 { *p
++ = '\\'; *p
++ = 'M'; *p
++ = '-'; }
1368 if (modifiers
& shift_modifier
)
1369 { *p
++ = '\\'; *p
++ = 'S'; *p
++ = '-'; }
1370 if (modifiers
& super_modifier
)
1371 { *p
++ = '\\'; *p
++ = 's'; *p
++ = '-'; }
1374 c
= reorder_modifiers (c
);
1375 keystring
= concat2 (build_string (new_mods
), XCDR (assoc
));
1377 error ((modifiers
& ~meta_modifier
1378 ? "To bind the key %s, use [?%s], not [%s]"
1379 : "To bind the key %s, use \"%s\", not [%s]"),
1380 SDATA (SYMBOL_NAME (c
)), SDATA (keystring
),
1381 SDATA (SYMBOL_NAME (c
)));
1385 /* Global, local, and minor mode keymap stuff. */
1387 /* We can't put these variables inside current_minor_maps, since under
1388 some systems, static gets macro-defined to be the empty string.
1390 static Lisp_Object
*cmm_modes
= NULL
, *cmm_maps
= NULL
;
1391 static int cmm_size
= 0;
1393 /* Error handler used in current_minor_maps. */
1395 current_minor_maps_error ()
1400 /* Store a pointer to an array of the keymaps of the currently active
1401 minor modes in *buf, and return the number of maps it contains.
1403 This function always returns a pointer to the same buffer, and may
1404 free or reallocate it, so if you want to keep it for a long time or
1405 hand it out to lisp code, copy it. This procedure will be called
1406 for every key sequence read, so the nice lispy approach (return a
1407 new assoclist, list, what have you) for each invocation would
1408 result in a lot of consing over time.
1410 If we used xrealloc/xmalloc and ran out of memory, they would throw
1411 back to the command loop, which would try to read a key sequence,
1412 which would call this function again, resulting in an infinite
1413 loop. Instead, we'll use realloc/malloc and silently truncate the
1414 list, let the key sequence be read, and hope some other piece of
1415 code signals the error. */
1417 current_minor_maps (modeptr
, mapptr
)
1418 Lisp_Object
**modeptr
, **mapptr
;
1421 int list_number
= 0;
1422 Lisp_Object alist
, assoc
, var
, val
;
1423 Lisp_Object emulation_alists
;
1424 Lisp_Object lists
[2];
1426 emulation_alists
= Vemulation_mode_map_alists
;
1427 lists
[0] = Vminor_mode_overriding_map_alist
;
1428 lists
[1] = Vminor_mode_map_alist
;
1430 for (list_number
= 0; list_number
< 2; list_number
++)
1432 if (CONSP (emulation_alists
))
1434 alist
= XCAR (emulation_alists
);
1435 emulation_alists
= XCDR (emulation_alists
);
1436 if (SYMBOLP (alist
))
1437 alist
= find_symbol_value (alist
);
1441 alist
= lists
[list_number
];
1443 for ( ; CONSP (alist
); alist
= XCDR (alist
))
1444 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1445 && (var
= XCAR (assoc
), SYMBOLP (var
))
1446 && (val
= find_symbol_value (var
), !EQ (val
, Qunbound
))
1451 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1452 and also an entry in Vminor_mode_map_alist,
1453 ignore the latter. */
1454 if (list_number
== 1)
1456 val
= assq_no_quit (var
, lists
[0]);
1463 int newsize
, allocsize
;
1464 Lisp_Object
*newmodes
, *newmaps
;
1466 newsize
= cmm_size
== 0 ? 30 : cmm_size
* 2;
1467 allocsize
= newsize
* sizeof *newmodes
;
1469 /* Use malloc here. See the comment above this function.
1470 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1472 newmodes
= (Lisp_Object
*) malloc (allocsize
);
1477 bcopy (cmm_modes
, newmodes
, cmm_size
* sizeof cmm_modes
[0]);
1480 cmm_modes
= newmodes
;
1483 newmaps
= (Lisp_Object
*) malloc (allocsize
);
1488 bcopy (cmm_maps
, newmaps
, cmm_size
* sizeof cmm_maps
[0]);
1495 if (newmodes
== NULL
|| newmaps
== NULL
)
1500 /* Get the keymap definition--or nil if it is not defined. */
1501 temp
= internal_condition_case_1 (Findirect_function
,
1503 Qerror
, current_minor_maps_error
);
1507 cmm_maps
[i
] = temp
;
1513 if (modeptr
) *modeptr
= cmm_modes
;
1514 if (mapptr
) *mapptr
= cmm_maps
;
1518 DEFUN ("current-active-maps", Fcurrent_active_maps
, Scurrent_active_maps
,
1520 doc
: /* Return a list of the currently active keymaps.
1521 OLP if non-nil indicates that we should obey `overriding-local-map' and
1522 `overriding-terminal-local-map'. */)
1526 Lisp_Object keymaps
= Fcons (current_global_map
, Qnil
);
1530 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1531 keymaps
= Fcons (current_kboard
->Voverriding_terminal_local_map
, keymaps
);
1532 /* The doc said that overriding-terminal-local-map should
1533 override overriding-local-map. The code used them both,
1534 but it seems clearer to use just one. rms, jan 2005. */
1535 else if (!NILP (Voverriding_local_map
))
1536 keymaps
= Fcons (Voverriding_local_map
, keymaps
);
1538 if (NILP (XCDR (keymaps
)))
1544 /* This usually returns the buffer's local map,
1545 but that can be overridden by a `local-map' property. */
1546 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1548 keymaps
= Fcons (local
, keymaps
);
1550 /* Now put all the minor mode keymaps on the list. */
1551 nmaps
= current_minor_maps (0, &maps
);
1553 for (i
= --nmaps
; i
>= 0; i
--)
1554 if (!NILP (maps
[i
]))
1555 keymaps
= Fcons (maps
[i
], keymaps
);
1557 /* This returns nil unless there is a `keymap' property. */
1558 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1560 keymaps
= Fcons (local
, keymaps
);
1566 /* GC is possible in this function if it autoloads a keymap. */
1568 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 3, 0,
1569 doc
: /* Return the binding for command KEY in current keymaps.
1570 KEY is a string or vector, a sequence of keystrokes.
1571 The binding is probably a symbol with a function definition.
1573 Normally, `key-binding' ignores bindings for t, which act as default
1574 bindings, used when nothing else in the keymap applies; this makes it
1575 usable as a general function for probing keymaps. However, if the
1576 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1577 recognize the default bindings, just as `read-key-sequence' does.
1579 Like the normal command loop, `key-binding' will remap the command
1580 resulting from looking up KEY by looking up the command in the
1581 current keymaps. However, if the optional third argument NO-REMAP
1582 is non-nil, `key-binding' returns the unmapped command. */)
1583 (key
, accept_default
, no_remap
)
1584 Lisp_Object key
, accept_default
, no_remap
;
1586 Lisp_Object
*maps
, value
;
1588 struct gcpro gcpro1
;
1592 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1594 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1595 key
, accept_default
);
1596 if (! NILP (value
) && !INTEGERP (value
))
1599 else if (!NILP (Voverriding_local_map
))
1601 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1602 if (! NILP (value
) && !INTEGERP (value
))
1609 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1612 value
= Flookup_key (local
, key
, accept_default
);
1613 if (! NILP (value
) && !INTEGERP (value
))
1617 nmaps
= current_minor_maps (0, &maps
);
1618 /* Note that all these maps are GCPRO'd
1619 in the places where we found them. */
1621 for (i
= 0; i
< nmaps
; i
++)
1622 if (! NILP (maps
[i
]))
1624 value
= Flookup_key (maps
[i
], key
, accept_default
);
1625 if (! NILP (value
) && !INTEGERP (value
))
1629 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1632 value
= Flookup_key (local
, key
, accept_default
);
1633 if (! NILP (value
) && !INTEGERP (value
))
1638 value
= Flookup_key (current_global_map
, key
, accept_default
);
1642 if (NILP (value
) || INTEGERP (value
))
1645 /* If the result of the ordinary keymap lookup is an interactive
1646 command, look for a key binding (ie. remapping) for that command. */
1648 if (NILP (no_remap
) && SYMBOLP (value
))
1651 if (value1
= Fcommand_remapping (value
), !NILP (value1
))
1658 /* GC is possible in this function if it autoloads a keymap. */
1660 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1661 doc
: /* Return the binding for command KEYS in current local keymap only.
1662 KEYS is a string or vector, a sequence of keystrokes.
1663 The binding is probably a symbol with a function definition.
1665 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1666 bindings; see the description of `lookup-key' for more details about this. */)
1667 (keys
, accept_default
)
1668 Lisp_Object keys
, accept_default
;
1670 register Lisp_Object map
;
1671 map
= current_buffer
->keymap
;
1674 return Flookup_key (map
, keys
, accept_default
);
1677 /* GC is possible in this function if it autoloads a keymap. */
1679 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1680 doc
: /* Return the binding for command KEYS in current global keymap only.
1681 KEYS is a string or vector, a sequence of keystrokes.
1682 The binding is probably a symbol with a function definition.
1683 This function's return values are the same as those of `lookup-key'
1686 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1687 bindings; see the description of `lookup-key' for more details about this. */)
1688 (keys
, accept_default
)
1689 Lisp_Object keys
, accept_default
;
1691 return Flookup_key (current_global_map
, keys
, accept_default
);
1694 /* GC is possible in this function if it autoloads a keymap. */
1696 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1697 doc
: /* Find the visible minor mode bindings of KEY.
1698 Return an alist of pairs (MODENAME . BINDING), where MODENAME is
1699 the symbol which names the minor mode binding KEY, and BINDING is
1700 KEY's definition in that mode. In particular, if KEY has no
1701 minor-mode bindings, return nil. If the first binding is a
1702 non-prefix, all subsequent bindings will be omitted, since they would
1703 be ignored. Similarly, the list doesn't include non-prefix bindings
1704 that come after prefix bindings.
1706 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1707 bindings; see the description of `lookup-key' for more details about this. */)
1708 (key
, accept_default
)
1709 Lisp_Object key
, accept_default
;
1711 Lisp_Object
*modes
, *maps
;
1713 Lisp_Object binding
;
1715 struct gcpro gcpro1
, gcpro2
;
1717 nmaps
= current_minor_maps (&modes
, &maps
);
1718 /* Note that all these maps are GCPRO'd
1719 in the places where we found them. */
1722 GCPRO2 (key
, binding
);
1724 for (i
= j
= 0; i
< nmaps
; i
++)
1726 && !NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1727 && !INTEGERP (binding
))
1729 if (KEYMAPP (binding
))
1730 maps
[j
++] = Fcons (modes
[i
], binding
);
1732 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1736 return Flist (j
, maps
);
1739 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1740 doc
: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1741 A new sparse keymap is stored as COMMAND's function definition and its value.
1742 If a second optional argument MAPVAR is given, the map is stored as
1743 its value instead of as COMMAND's value; but COMMAND is still defined
1745 The third optional argument NAME, if given, supplies a menu name
1746 string for the map. This is required to use the keymap as a menu.
1747 This function returns COMMAND. */)
1748 (command
, mapvar
, name
)
1749 Lisp_Object command
, mapvar
, name
;
1752 map
= Fmake_sparse_keymap (name
);
1753 Ffset (command
, map
);
1757 Fset (command
, map
);
1761 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1762 doc
: /* Select KEYMAP as the global keymap. */)
1766 keymap
= get_keymap (keymap
, 1, 1);
1767 current_global_map
= keymap
;
1772 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1773 doc
: /* Select KEYMAP as the local keymap.
1774 If KEYMAP is nil, that means no local keymap. */)
1779 keymap
= get_keymap (keymap
, 1, 1);
1781 current_buffer
->keymap
= keymap
;
1786 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1787 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1790 return current_buffer
->keymap
;
1793 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1794 doc
: /* Return the current global keymap. */)
1797 return current_global_map
;
1800 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1801 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1805 int nmaps
= current_minor_maps (0, &maps
);
1807 return Flist (nmaps
, maps
);
1810 /* Help functions for describing and documenting keymaps. */
1814 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1815 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1816 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1820 cmd
= get_keymap (get_keyelt (cmd
, 0), 0, 0);
1824 /* Look for and break cycles. */
1825 while (!NILP (tem
= Frassq (cmd
, maps
)))
1827 Lisp_Object prefix
= XCAR (tem
);
1828 int lim
= XINT (Flength (XCAR (tem
)));
1829 if (lim
<= XINT (Flength (thisseq
)))
1830 { /* This keymap was already seen with a smaller prefix. */
1832 while (i
< lim
&& EQ (Faref (prefix
, make_number (i
)),
1833 Faref (thisseq
, make_number (i
))))
1836 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1839 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1840 but maybe `cmd' occurs again further down in `maps', so keep
1842 maps
= XCDR (Fmemq (tem
, maps
));
1845 /* If the last key in thisseq is meta-prefix-char,
1846 turn it into a meta-ized keystroke. We know
1847 that the event we're about to append is an
1848 ascii keystroke since we're processing a
1852 int meta_bit
= meta_modifier
;
1853 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1854 tem
= Fcopy_sequence (thisseq
);
1856 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1858 /* This new sequence is the same length as
1859 thisseq, so stick it in the list right
1862 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1866 tem
= append_key (thisseq
, key
);
1867 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1872 accessible_keymaps_char_table (args
, index
, cmd
)
1873 Lisp_Object args
, index
, cmd
;
1875 accessible_keymaps_1 (index
, cmd
,
1879 XINT (XCDR (XCAR (args
))));
1882 /* This function cannot GC. */
1884 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1886 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1887 Returns a list of elements of the form (KEYS . MAP), where the sequence
1888 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1889 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1890 An optional argument PREFIX, if non-nil, should be a key sequence;
1891 then the value includes only maps for prefixes that start with PREFIX. */)
1893 Lisp_Object keymap
, prefix
;
1895 Lisp_Object maps
, tail
;
1898 /* no need for gcpro because we don't autoload any keymaps. */
1901 prefixlen
= XINT (Flength (prefix
));
1905 /* If a prefix was specified, start with the keymap (if any) for
1906 that prefix, so we don't waste time considering other prefixes. */
1908 tem
= Flookup_key (keymap
, prefix
, Qt
);
1909 /* Flookup_key may give us nil, or a number,
1910 if the prefix is not defined in this particular map.
1911 It might even give us a list that isn't a keymap. */
1912 tem
= get_keymap (tem
, 0, 0);
1915 /* Convert PREFIX to a vector now, so that later on
1916 we don't have to deal with the possibility of a string. */
1917 if (STRINGP (prefix
))
1922 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1923 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1927 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1928 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1929 c
^= 0200 | meta_modifier
;
1930 ASET (copy
, i_before
, make_number (c
));
1934 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1940 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1941 get_keymap (keymap
, 1, 0)),
1944 /* For each map in the list maps,
1945 look at any other maps it points to,
1946 and stick them at the end if they are not already in the list.
1948 This is a breadth-first traversal, where tail is the queue of
1949 nodes, and maps accumulates a list of all nodes visited. */
1951 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1953 register Lisp_Object thisseq
, thismap
;
1955 /* Does the current sequence end in the meta-prefix-char? */
1958 thisseq
= Fcar (Fcar (tail
));
1959 thismap
= Fcdr (Fcar (tail
));
1960 last
= make_number (XINT (Flength (thisseq
)) - 1);
1961 is_metized
= (XINT (last
) >= 0
1962 /* Don't metize the last char of PREFIX. */
1963 && XINT (last
) >= prefixlen
1964 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1966 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1970 elt
= XCAR (thismap
);
1974 if (CHAR_TABLE_P (elt
))
1976 map_char_table (accessible_keymaps_char_table
, Qnil
,
1977 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1978 Fcons (tail
, thisseq
)));
1980 else if (VECTORP (elt
))
1984 /* Vector keymap. Scan all the elements. */
1985 for (i
= 0; i
< ASIZE (elt
); i
++)
1986 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1987 maps
, tail
, thisseq
, is_metized
);
1990 else if (CONSP (elt
))
1991 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1992 maps
, tail
, thisseq
,
1993 is_metized
&& INTEGERP (XCAR (elt
)));
2001 Lisp_Object Qsingle_key_description
, Qkey_description
;
2003 /* This function cannot GC. */
2005 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 2, 0,
2006 doc
: /* Return a pretty description of key-sequence KEYS.
2007 Optional arg PREFIX is the sequence of keys leading up to KEYS.
2008 Control characters turn into "C-foo" sequences, meta into "M-foo",
2009 spaces are put between sequence elements, etc. */)
2011 Lisp_Object keys
, prefix
;
2016 int size
= XINT (Flength (keys
));
2018 Lisp_Object sep
= build_string (" ");
2023 size
+= XINT (Flength (prefix
));
2025 /* This has one extra element at the end that we don't pass to Fconcat. */
2026 args
= (Lisp_Object
*) alloca (size
* 4 * sizeof (Lisp_Object
));
2028 /* In effect, this computes
2029 (mapconcat 'single-key-description keys " ")
2030 but we shouldn't use mapconcat because it can do GC. */
2034 list
= prefix
, prefix
= Qnil
;
2035 else if (!NILP (keys
))
2036 list
= keys
, keys
= Qnil
;
2041 args
[len
] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2045 return empty_string
;
2046 return Fconcat (len
- 1, args
);
2050 size
= SCHARS (list
);
2051 else if (VECTORP (list
))
2052 size
= XVECTOR (list
)->size
;
2053 else if (CONSP (list
))
2054 size
= XINT (Flength (list
));
2056 wrong_type_argument (Qarrayp
, list
);
2065 FETCH_STRING_CHAR_ADVANCE (c
, list
, i
, i_byte
);
2066 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
2067 c
^= 0200 | meta_modifier
;
2068 XSETFASTINT (key
, c
);
2070 else if (VECTORP (list
))
2072 key
= AREF (list
, i
++);
2084 || EQ (key
, meta_prefix_char
)
2085 || (XINT (key
) & meta_modifier
))
2087 args
[len
++] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2089 if (EQ (key
, meta_prefix_char
))
2093 XSETINT (key
, (XINT (key
) | meta_modifier
) & ~0x80);
2096 else if (EQ (key
, meta_prefix_char
))
2101 args
[len
++] = Fsingle_key_description (key
, Qnil
);
2109 push_key_description (c
, p
, force_multibyte
)
2110 register unsigned int c
;
2112 int force_multibyte
;
2116 /* Clear all the meaningless bits above the meta bit. */
2117 c
&= meta_modifier
| ~ - meta_modifier
;
2118 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
2119 | meta_modifier
| shift_modifier
| super_modifier
);
2121 if (c
& alt_modifier
)
2127 if ((c
& ctrl_modifier
) != 0
2128 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
2132 c
&= ~ctrl_modifier
;
2134 if (c
& hyper_modifier
)
2138 c
-= hyper_modifier
;
2140 if (c
& meta_modifier
)
2146 if (c
& shift_modifier
)
2150 c
-= shift_modifier
;
2152 if (c
& super_modifier
)
2156 c
-= super_modifier
;
2172 else if (c
== Ctl ('M'))
2180 /* `C-' already added above. */
2181 if (c
> 0 && c
<= Ctl ('Z'))
2200 || (NILP (current_buffer
->enable_multibyte_characters
)
2201 && SINGLE_BYTE_CHAR_P (c
)
2202 && !force_multibyte
))
2206 else if (CHARACTERP (make_number (c
)))
2208 if (NILP (current_buffer
->enable_multibyte_characters
)
2209 && ! force_multibyte
)
2210 *p
++ = multibyte_char_to_unibyte (c
, Qnil
);
2212 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2218 /* The biggest character code uses 22 bits. */
2219 for (bit_offset
= 21; bit_offset
>= 0; bit_offset
-= 3)
2221 if (c
>= (1 << bit_offset
))
2222 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2229 /* This function cannot GC. */
2231 DEFUN ("single-key-description", Fsingle_key_description
,
2232 Ssingle_key_description
, 1, 2, 0,
2233 doc
: /* Return a pretty description of command character KEY.
2234 Control characters turn into C-whatever, etc.
2235 Optional argument NO-ANGLES non-nil means don't put angle brackets
2236 around function keys and event symbols. */)
2238 Lisp_Object key
, no_angles
;
2240 if (CONSP (key
) && lucid_event_type_list_p (key
))
2241 key
= Fevent_convert_list (key
);
2243 key
= EVENT_HEAD (key
);
2245 if (INTEGERP (key
)) /* Normal character */
2247 char tem
[KEY_DESCRIPTION_SIZE
];
2249 *push_key_description (XUINT (key
), tem
, 1) = 0;
2250 return build_string (tem
);
2252 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2254 if (NILP (no_angles
))
2257 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2258 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2259 return build_string (buffer
);
2262 return Fsymbol_name (key
);
2264 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2265 return Fcopy_sequence (key
);
2267 error ("KEY must be an integer, cons, symbol, or string");
2272 push_text_char_description (c
, p
)
2273 register unsigned int c
;
2285 *p
++ = c
+ 64; /* 'A' - 1 */
2297 /* This function cannot GC. */
2299 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2300 doc
: /* Return a pretty description of file-character CHARACTER.
2301 Control characters turn into "^char", etc. This differs from
2302 `single-key-description' which turns them into "C-char".
2303 Also, this function recognizes the 2**7 bit as the Meta character,
2304 whereas `single-key-description' uses the 2**27 bit for Meta.
2305 See Info node `(elisp)Describing Characters' for examples. */)
2307 Lisp_Object character
;
2309 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2310 unsigned char str
[6];
2313 CHECK_NUMBER (character
);
2315 c
= XINT (character
);
2316 if (!ASCII_CHAR_P (c
))
2318 int len
= CHAR_STRING (c
, str
);
2320 return make_multibyte_string (str
, 1, len
);
2323 *push_text_char_description (c
& 0377, str
) = 0;
2325 return build_string (str
);
2328 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2331 ascii_sequence_p (seq
)
2335 int len
= XINT (Flength (seq
));
2337 for (i
= 0; i
< len
; i
++)
2339 Lisp_Object ii
, elt
;
2341 XSETFASTINT (ii
, i
);
2342 elt
= Faref (seq
, ii
);
2345 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2353 /* where-is - finding a command in a set of keymaps. */
2355 static Lisp_Object
where_is_internal ();
2356 static Lisp_Object
where_is_internal_1 ();
2357 static void where_is_internal_2 ();
2359 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2360 Returns the first non-nil binding found in any of those maps. */
2363 shadow_lookup (shadow
, key
, flag
)
2364 Lisp_Object shadow
, key
, flag
;
2366 Lisp_Object tail
, value
;
2368 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2370 value
= Flookup_key (XCAR (tail
), key
, flag
);
2371 if (!NILP (value
) && !NATNUMP (value
))
2377 static Lisp_Object Vmouse_events
;
2379 /* This function can GC if Flookup_key autoloads any keymaps. */
2382 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2383 Lisp_Object definition
, keymaps
;
2384 Lisp_Object firstonly
, noindirect
, no_remap
;
2386 Lisp_Object maps
= Qnil
;
2387 Lisp_Object found
, sequences
;
2388 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2389 /* 1 means ignore all menu bindings entirely. */
2390 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2392 /* If this command is remapped, then it has no key bindings
2394 if (NILP (no_remap
) && SYMBOLP (definition
))
2397 if (tem
= Fcommand_remapping (definition
), !NILP (tem
))
2402 while (CONSP (found
))
2406 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2407 found
= XCDR (found
);
2410 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2414 for (; !NILP (maps
); maps
= Fcdr (maps
))
2416 /* Key sequence to reach map, and the map that it reaches */
2417 register Lisp_Object
this, map
, tem
;
2419 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2420 [M-CHAR] sequences, check if last character of the sequence
2421 is the meta-prefix char. */
2425 this = Fcar (Fcar (maps
));
2426 map
= Fcdr (Fcar (maps
));
2427 last
= make_number (XINT (Flength (this)) - 1);
2428 last_is_meta
= (XINT (last
) >= 0
2429 && EQ (Faref (this, last
), meta_prefix_char
));
2431 /* if (nomenus && !ascii_sequence_p (this)) */
2432 if (nomenus
&& XINT (last
) >= 0
2433 && SYMBOLP (tem
= Faref (this, make_number (0)))
2434 && !NILP (Fmemq (XCAR (parse_modifiers (tem
)), Vmouse_events
)))
2435 /* If no menu entries should be returned, skip over the
2436 keymaps bound to `menu-bar' and `tool-bar' and other
2437 non-ascii prefixes like `C-down-mouse-2'. */
2444 /* Because the code we want to run on each binding is rather
2445 large, we don't want to have two separate loop bodies for
2446 sparse keymap bindings and tables; we want to iterate one
2447 loop body over both keymap and vector bindings.
2449 For this reason, if Fcar (map) is a vector, we don't
2450 advance map to the next element until i indicates that we
2451 have finished off the vector. */
2452 Lisp_Object elt
, key
, binding
;
2460 /* Set key and binding to the current key and binding, and
2461 advance map and i to the next binding. */
2464 Lisp_Object sequence
;
2466 /* In a vector, look at each element. */
2467 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2469 binding
= AREF (elt
, i
);
2470 XSETFASTINT (key
, i
);
2471 sequence
= where_is_internal_1 (binding
, key
, definition
,
2473 last
, nomenus
, last_is_meta
);
2474 if (!NILP (sequence
))
2475 sequences
= Fcons (sequence
, sequences
);
2478 else if (CHAR_TABLE_P (elt
))
2482 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2483 Qnil
), /* Result accumulator. */
2484 Fcons (Fcons (this, last
),
2485 Fcons (make_number (nomenus
),
2486 make_number (last_is_meta
))));
2487 map_char_table (where_is_internal_2
, Qnil
, elt
, args
);
2488 sequences
= XCDR (XCAR (args
));
2490 else if (CONSP (elt
))
2492 Lisp_Object sequence
;
2495 binding
= XCDR (elt
);
2497 sequence
= where_is_internal_1 (binding
, key
, definition
,
2499 last
, nomenus
, last_is_meta
);
2500 if (!NILP (sequence
))
2501 sequences
= Fcons (sequence
, sequences
);
2505 while (!NILP (sequences
))
2507 Lisp_Object sequence
, remapped
, function
;
2509 sequence
= XCAR (sequences
);
2510 sequences
= XCDR (sequences
);
2512 /* If the current sequence is a command remapping with
2513 format [remap COMMAND], find the key sequences
2514 which run COMMAND, and use those sequences instead. */
2517 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2518 && EQ (AREF (sequence
, 0), Qremap
)
2519 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2521 Lisp_Object remapped1
;
2523 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2524 if (CONSP (remapped1
))
2526 /* Verify that this key binding actually maps to the
2527 remapped command (see below). */
2528 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2530 sequence
= XCAR (remapped1
);
2531 remapped
= XCDR (remapped1
);
2532 goto record_sequence
;
2536 /* Verify that this key binding is not shadowed by another
2537 binding for the same key, before we say it exists.
2539 Mechanism: look for local definition of this key and if
2540 it is defined and does not match what we found then
2543 Either nil or number as value from Flookup_key
2545 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2549 /* Don't annoy user with strings from a menu such as
2550 Select Paste. Change them all to "(any string)",
2551 so that there seems to be only one menu item
2553 if (! NILP (sequence
))
2556 tem
= Faref (sequence
, make_number (XVECTOR (sequence
)->size
- 1));
2558 Faset (sequence
, make_number (XVECTOR (sequence
)->size
- 1),
2559 build_string ("(any string)"));
2562 /* It is a true unshadowed match. Record it, unless it's already
2563 been seen (as could happen when inheriting keymaps). */
2564 if (NILP (Fmember (sequence
, found
)))
2565 found
= Fcons (sequence
, found
);
2567 /* If firstonly is Qnon_ascii, then we can return the first
2568 binding we find. If firstonly is not Qnon_ascii but not
2569 nil, then we should return the first ascii-only binding
2571 if (EQ (firstonly
, Qnon_ascii
))
2572 RETURN_UNGCPRO (sequence
);
2573 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2574 RETURN_UNGCPRO (sequence
);
2576 if (CONSP (remapped
))
2578 sequence
= XCAR (remapped
);
2579 remapped
= XCDR (remapped
);
2580 goto record_sequence
;
2588 found
= Fnreverse (found
);
2590 /* firstonly may have been t, but we may have gone all the way through
2591 the keymaps without finding an all-ASCII key sequence. So just
2592 return the best we could find. */
2593 if (!NILP (firstonly
))
2594 return Fcar (found
);
2599 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2600 doc
: /* Return list of keys that invoke DEFINITION.
2601 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2602 If KEYMAP is nil, search all the currently active keymaps.
2603 If KEYMAP is a list of keymaps, search only those keymaps.
2605 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2606 rather than a list of all possible key sequences.
2607 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2608 no matter what it is.
2609 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2610 \(or their meta variants) and entirely reject menu bindings.
2612 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2613 to other keymaps or slots. This makes it possible to search for an
2614 indirect definition itself.
2616 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2617 that invoke a command which is remapped to DEFINITION, but include the
2618 remapped command in the returned list. */)
2619 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2620 Lisp_Object definition
, keymap
;
2621 Lisp_Object firstonly
, noindirect
, no_remap
;
2623 Lisp_Object sequences
, keymaps
;
2624 /* 1 means ignore all menu bindings entirely. */
2625 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2628 /* Find the relevant keymaps. */
2629 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2631 else if (!NILP (keymap
))
2632 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2634 keymaps
= Fcurrent_active_maps (Qnil
);
2636 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2637 We don't really need to check `keymap'. */
2638 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2642 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2644 /* Check heuristic-consistency of the cache. */
2645 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2646 where_is_cache
= Qnil
;
2648 if (NILP (where_is_cache
))
2650 /* We need to create the cache. */
2651 Lisp_Object args
[2];
2652 where_is_cache
= Fmake_hash_table (0, args
);
2653 where_is_cache_keymaps
= Qt
;
2655 /* Fill in the cache. */
2656 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2657 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2660 where_is_cache_keymaps
= keymaps
;
2663 /* We want to process definitions from the last to the first.
2664 Instead of consing, copy definitions to a vector and step
2665 over that vector. */
2666 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2667 n
= XINT (Flength (sequences
));
2668 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2669 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2670 defns
[i
++] = XCAR (sequences
);
2672 /* Verify that the key bindings are not shadowed. Note that
2673 the following can GC. */
2674 GCPRO2 (definition
, keymaps
);
2677 for (i
= n
- 1; i
>= 0; --i
)
2678 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2680 if (ascii_sequence_p (defns
[i
]))
2686 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2691 /* Kill the cache so that where_is_internal_1 doesn't think
2692 we're filling it up. */
2693 where_is_cache
= Qnil
;
2694 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2700 /* This is the function that Fwhere_is_internal calls using map_char_table.
2702 (((DEFINITION . NOINDIRECT) . RESULT)
2704 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2705 Since map_char_table doesn't really use the return value from this function,
2706 we the result append to RESULT, the slot in ARGS.
2708 KEY may be a cons (FROM . TO) where both FROM and TO are integers
2709 (i.e. character events).
2711 This function can GC because it calls where_is_internal_1 which can
2715 where_is_internal_2 (args
, key
, binding
)
2716 Lisp_Object args
, key
, binding
;
2718 Lisp_Object definition
, noindirect
, this, last
;
2719 Lisp_Object result
, sequence
;
2720 int nomenus
, last_is_meta
;
2721 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2723 GCPRO3 (args
, key
, binding
);
2724 definition
= XCAR (XCAR (XCAR (args
)));
2725 noindirect
= XCDR (XCAR (XCAR (args
)));
2726 this = XCAR (XCAR (XCDR (args
)));
2727 last
= XCDR (XCAR (XCDR (args
)));
2728 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2729 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2732 if (CONSP (key
) && INTEGERP (XCAR (key
)) && INTEGERP (XCDR (key
)))
2734 /* Try all ASCII characters. Try also non-ASCII characters but
2735 only the first and last one because trying all of them is
2736 extremely memory and time consuming.
2738 Fixme: Perhaps it should be allowed to store a cons directly
2739 in RESULT. -- handa@m17n.org */
2740 int from
= XINT (XCAR (key
)), to
= XINT (XCDR (key
));
2743 for (; from
<= to
; to
--)
2745 k
= make_number (to
);
2746 sequence
= where_is_internal_1 (binding
, k
, definition
, noindirect
,
2747 this, last
, nomenus
, last_is_meta
);
2748 if (!NILP (sequence
))
2749 result
= Fcons (sequence
, result
);
2756 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2757 this, last
, nomenus
, last_is_meta
);
2758 if (!NILP (sequence
))
2759 result
= Fcons (sequence
, Qnil
);
2762 if (! NILP (result
))
2763 nconc2 (XCAR (args
), result
);
2769 /* This function can GC because get_keyelt can. */
2772 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2773 nomenus
, last_is_meta
)
2774 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2775 int nomenus
, last_is_meta
;
2777 Lisp_Object sequence
;
2779 /* Search through indirections unless that's not wanted. */
2780 if (NILP (noindirect
))
2781 binding
= get_keyelt (binding
, 0);
2783 /* End this iteration if this element does not match
2786 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2787 || EQ (binding
, definition
)
2788 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2789 /* Doesn't match. */
2792 /* We have found a match. Construct the key sequence where we found it. */
2793 if (INTEGERP (key
) && last_is_meta
)
2795 sequence
= Fcopy_sequence (this);
2796 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2799 sequence
= append_key (this, key
);
2801 if (!NILP (where_is_cache
))
2803 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2804 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2811 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2813 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2814 doc
: /* Insert the list of all defined keys and their definitions.
2815 The list is inserted in the current buffer, while the bindings are
2816 looked up in BUFFER.
2817 The optional argument PREFIX, if non-nil, should be a key sequence;
2818 then we display only bindings that start with that prefix.
2819 The optional argument MENUS, if non-nil, says to mention menu bindings.
2820 \(Ordinarily these are omitted from the output.) */)
2821 (buffer
, prefix
, menus
)
2822 Lisp_Object buffer
, prefix
, menus
;
2824 Lisp_Object outbuf
, shadow
;
2825 int nomenu
= NILP (menus
);
2826 register Lisp_Object start1
;
2827 struct gcpro gcpro1
;
2829 char *alternate_heading
2831 Keyboard translations:\n\n\
2832 You type Translation\n\
2833 -------- -----------\n";
2838 outbuf
= Fcurrent_buffer ();
2840 /* Report on alternates for keys. */
2841 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2844 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2845 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2847 for (c
= 0; c
< translate_len
; c
++)
2848 if (translate
[c
] != c
)
2850 char buf
[KEY_DESCRIPTION_SIZE
];
2853 if (alternate_heading
)
2855 insert_string (alternate_heading
);
2856 alternate_heading
= 0;
2859 bufend
= push_key_description (translate
[c
], buf
, 1);
2860 insert (buf
, bufend
- buf
);
2861 Findent_to (make_number (16), make_number (1));
2862 bufend
= push_key_description (c
, buf
, 1);
2863 insert (buf
, bufend
- buf
);
2867 /* Insert calls signal_after_change which may GC. */
2868 translate
= SDATA (Vkeyboard_translate_table
);
2874 if (!NILP (Vkey_translation_map
))
2875 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2876 "Key translations", nomenu
, 1, 0, 0);
2879 /* Print the (major mode) local map. */
2881 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2882 start1
= current_kboard
->Voverriding_terminal_local_map
;
2883 else if (!NILP (Voverriding_local_map
))
2884 start1
= Voverriding_local_map
;
2888 describe_map_tree (start1
, 1, shadow
, prefix
,
2889 "\f\nOverriding Bindings", nomenu
, 0, 0, 0);
2890 shadow
= Fcons (start1
, shadow
);
2894 /* Print the minor mode and major mode keymaps. */
2896 Lisp_Object
*modes
, *maps
;
2898 /* Temporarily switch to `buffer', so that we can get that buffer's
2899 minor modes correctly. */
2900 Fset_buffer (buffer
);
2902 nmaps
= current_minor_maps (&modes
, &maps
);
2903 Fset_buffer (outbuf
);
2905 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2906 XBUFFER (buffer
), Qkeymap
);
2909 describe_map_tree (start1
, 1, shadow
, prefix
,
2910 "\f\n`keymap' Property Bindings", nomenu
,
2912 shadow
= Fcons (start1
, shadow
);
2915 /* Print the minor mode maps. */
2916 for (i
= 0; i
< nmaps
; i
++)
2918 /* The title for a minor mode keymap
2919 is constructed at run time.
2920 We let describe_map_tree do the actual insertion
2921 because it takes care of other features when doing so. */
2924 if (!SYMBOLP (modes
[i
]))
2927 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2931 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2932 SCHARS (SYMBOL_NAME (modes
[i
])));
2933 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2935 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2936 p
+= sizeof (" Minor Mode Bindings") - 1;
2939 describe_map_tree (maps
[i
], 1, shadow
, prefix
,
2940 title
, nomenu
, 0, 0, 0);
2941 shadow
= Fcons (maps
[i
], shadow
);
2944 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2945 XBUFFER (buffer
), Qlocal_map
);
2948 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2949 describe_map_tree (start1
, 1, shadow
, prefix
,
2950 "\f\nMajor Mode Bindings", nomenu
, 0, 0, 0);
2952 describe_map_tree (start1
, 1, shadow
, prefix
,
2953 "\f\n`local-map' Property Bindings",
2956 shadow
= Fcons (start1
, shadow
);
2960 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2961 "\f\nGlobal Bindings", nomenu
, 0, 1, 0);
2963 /* Print the function-key-map translations under this prefix. */
2964 if (!NILP (Vfunction_key_map
))
2965 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2966 "\f\nFunction key map translations", nomenu
, 1, 0, 0);
2972 /* Insert a description of the key bindings in STARTMAP,
2973 followed by those of all maps reachable through STARTMAP.
2974 If PARTIAL is nonzero, omit certain "uninteresting" commands
2975 (such as `undefined').
2976 If SHADOW is non-nil, it is a list of maps;
2977 don't mention keys which would be shadowed by any of them.
2978 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2979 TITLE, if not 0, is a string to insert at the beginning.
2980 TITLE should not end with a colon or a newline; we supply that.
2981 If NOMENU is not 0, then omit menu-bar commands.
2983 If TRANSL is nonzero, the definitions are actually key translations
2984 so print strings and vectors differently.
2986 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2989 If MENTION_SHADOW is nonzero, then when something is shadowed by SHADOW,
2990 don't omit it; instead, mention it but say it is shadowed. */
2993 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2994 always_title
, mention_shadow
)
2995 Lisp_Object startmap
, shadow
, prefix
;
3003 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
3004 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3011 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
3014 GCPRO3 (maps
, seen
, sub_shadows
);
3020 /* Delete from MAPS each element that is for the menu bar. */
3021 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
3023 Lisp_Object elt
, prefix
, tem
;
3026 prefix
= Fcar (elt
);
3027 if (XVECTOR (prefix
)->size
>= 1)
3029 tem
= Faref (prefix
, make_number (0));
3030 if (EQ (tem
, Qmenu_bar
))
3031 maps
= Fdelq (elt
, maps
);
3036 if (!NILP (maps
) || always_title
)
3040 insert_string (title
);
3043 insert_string (" Starting With ");
3044 insert1 (Fkey_description (prefix
, Qnil
));
3046 insert_string (":\n");
3048 insert_string (key_heading
);
3052 for (; !NILP (maps
); maps
= Fcdr (maps
))
3054 register Lisp_Object elt
, prefix
, tail
;
3057 prefix
= Fcar (elt
);
3061 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
3065 shmap
= XCAR (tail
);
3067 /* If the sequence by which we reach this keymap is zero-length,
3068 then the shadow map for this keymap is just SHADOW. */
3069 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
3070 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
3072 /* If the sequence by which we reach this keymap actually has
3073 some elements, then the sequence's definition in SHADOW is
3074 what we should use. */
3077 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
3078 if (INTEGERP (shmap
))
3082 /* If shmap is not nil and not a keymap,
3083 it completely shadows this map, so don't
3084 describe this map at all. */
3085 if (!NILP (shmap
) && !KEYMAPP (shmap
))
3089 sub_shadows
= Fcons (shmap
, sub_shadows
);
3092 /* Maps we have already listed in this loop shadow this map. */
3093 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
3096 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
3098 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
3101 describe_map (Fcdr (elt
), prefix
,
3102 transl
? describe_translation
: describe_command
,
3103 partial
, sub_shadows
, &seen
, nomenu
, mention_shadow
);
3109 insert_string ("\n");
3114 static int previous_description_column
;
3117 describe_command (definition
, args
)
3118 Lisp_Object definition
, args
;
3120 register Lisp_Object tem1
;
3121 int column
= (int) current_column (); /* iftc */
3122 int description_column
;
3124 /* If column 16 is no good, go to col 32;
3125 but don't push beyond that--go to next line instead. */
3129 description_column
= 32;
3131 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
3132 description_column
= 32;
3134 description_column
= 16;
3136 Findent_to (make_number (description_column
), make_number (1));
3137 previous_description_column
= description_column
;
3139 if (SYMBOLP (definition
))
3141 tem1
= SYMBOL_NAME (definition
);
3143 insert_string ("\n");
3145 else if (STRINGP (definition
) || VECTORP (definition
))
3146 insert_string ("Keyboard Macro\n");
3147 else if (KEYMAPP (definition
))
3148 insert_string ("Prefix Command\n");
3150 insert_string ("??\n");
3154 describe_translation (definition
, args
)
3155 Lisp_Object definition
, args
;
3157 register Lisp_Object tem1
;
3159 Findent_to (make_number (16), make_number (1));
3161 if (SYMBOLP (definition
))
3163 tem1
= SYMBOL_NAME (definition
);
3165 insert_string ("\n");
3167 else if (STRINGP (definition
) || VECTORP (definition
))
3169 insert1 (Fkey_description (definition
, Qnil
));
3170 insert_string ("\n");
3172 else if (KEYMAPP (definition
))
3173 insert_string ("Prefix Command\n");
3175 insert_string ("??\n");
3178 /* Describe the contents of map MAP, assuming that this map itself is
3179 reached by the sequence of prefix keys PREFIX (a string or vector).
3180 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3183 describe_map (map
, prefix
, elt_describer
, partial
, shadow
,
3184 seen
, nomenu
, mention_shadow
)
3185 register Lisp_Object map
;
3187 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3194 Lisp_Object tail
, definition
, event
;
3196 Lisp_Object suppress
;
3199 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3204 suppress
= intern ("suppress-keymap");
3206 /* This vector gets used to present single keys to Flookup_key. Since
3207 that is done once per keymap element, we don't want to cons up a
3208 fresh vector every time. */
3209 kludge
= Fmake_vector (make_number (1), Qnil
);
3212 GCPRO3 (prefix
, definition
, kludge
);
3214 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3218 if (VECTORP (XCAR (tail
))
3219 || CHAR_TABLE_P (XCAR (tail
)))
3220 describe_vector (XCAR (tail
),
3221 prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3222 (int *)0, 0, 1, mention_shadow
);
3223 else if (CONSP (XCAR (tail
)))
3225 int this_shadowed
= 0;
3226 event
= XCAR (XCAR (tail
));
3228 /* Ignore bindings whose "prefix" are not really valid events.
3229 (We get these in the frames and buffers menu.) */
3230 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3233 if (nomenu
&& EQ (event
, Qmenu_bar
))
3236 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3238 /* Don't show undefined commands or suppressed commands. */
3239 if (NILP (definition
)) continue;
3240 if (SYMBOLP (definition
) && partial
)
3242 tem
= Fget (definition
, suppress
);
3247 /* Don't show a command that isn't really visible
3248 because a local definition of the same key shadows it. */
3250 ASET (kludge
, 0, event
);
3253 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3263 tem
= Flookup_key (map
, kludge
, Qt
);
3264 if (!EQ (tem
, definition
)) continue;
3268 previous_description_column
= 0;
3273 /* THIS gets the string to describe the character EVENT. */
3274 insert1 (Fkey_description (kludge
, prefix
));
3276 /* Print a description of the definition of this character.
3277 elt_describer will take care of spacing out far enough
3278 for alignment purposes. */
3279 (*elt_describer
) (definition
, Qnil
);
3284 insert_string (" (binding currently shadowed)");
3288 else if (EQ (XCAR (tail
), Qkeymap
))
3290 /* The same keymap might be in the structure twice, if we're
3291 using an inherited keymap. So skip anything we've already
3293 tem
= Fassq (tail
, *seen
);
3294 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), prefix
)))
3296 *seen
= Fcons (Fcons (tail
, prefix
), *seen
);
3304 describe_vector_princ (elt
, fun
)
3305 Lisp_Object elt
, fun
;
3307 Findent_to (make_number (16), make_number (1));
3312 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3313 doc
: /* Insert a description of contents of VECTOR.
3314 This is text showing the elements of vector matched against indices.
3315 DESCRIBER is the output function used; nil means use `princ'. */)
3317 Lisp_Object vector
, describer
;
3319 int count
= SPECPDL_INDEX ();
3320 if (NILP (describer
))
3321 describer
= intern ("princ");
3322 specbind (Qstandard_output
, Fcurrent_buffer ());
3323 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3324 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3325 Qnil
, Qnil
, (int *)0, 0, 0, 0);
3327 return unbind_to (count
, Qnil
);
3330 /* Insert in the current buffer a description of the contents of VECTOR.
3331 We call ELT_DESCRIBER to insert the description of one value found
3334 ELT_PREFIX describes what "comes before" the keys or indices defined
3335 by this vector. This is a human-readable string whose size
3336 is not necessarily related to the situation.
3338 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3339 leads to this keymap.
3341 If the vector is a chartable, ELT_PREFIX is the vector
3342 of bytes that lead to the character set or portion of a character
3343 set described by this chartable.
3345 If PARTIAL is nonzero, it means do not mention suppressed commands
3346 (that assumes the vector is in a keymap).
3348 SHADOW is a list of keymaps that shadow this map.
3349 If it is non-nil, then we look up the key in those maps
3350 and we don't mention it now if it is defined by any of them.
3352 ENTIRE_MAP is the keymap in which this vector appears.
3353 If the definition in effect in the whole map does not match
3354 the one in this vector, we ignore this one.
3356 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3358 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3361 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3363 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3366 describe_vector (vector
, prefix
, args
, elt_describer
,
3367 partial
, shadow
, entire_map
,
3368 indices
, char_table_depth
, keymap_p
,
3370 register Lisp_Object vector
;
3371 Lisp_Object prefix
, args
;
3372 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3375 Lisp_Object entire_map
;
3377 int char_table_depth
;
3381 Lisp_Object definition
;
3383 Lisp_Object elt_prefix
= Qnil
;
3385 Lisp_Object suppress
;
3388 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3389 /* Range of elements to be handled. */
3391 Lisp_Object character
;
3400 /* Call Fkey_description first, to avoid GC bug for the other string. */
3401 if (!NILP (prefix
) && XFASTINT (Flength (prefix
)) > 0)
3404 tem
= Fkey_description (prefix
, Qnil
);
3405 elt_prefix
= concat2 (tem
, build_string (" "));
3410 /* This vector gets used to present single keys to Flookup_key. Since
3411 that is done once per vector element, we don't want to cons up a
3412 fresh vector every time. */
3413 kludge
= Fmake_vector (make_number (1), Qnil
);
3414 GCPRO4 (elt_prefix
, prefix
, definition
, kludge
);
3417 suppress
= intern ("suppress-keymap");
3420 to
= CHAR_TABLE_P (vector
) ? MAX_CHAR
+ 1 : XVECTOR (vector
)->size
;
3422 for (i
= from
; i
< to
; i
++)
3424 int this_shadowed
= 0;
3425 int range_beg
, range_end
;
3432 if (CHAR_TABLE_P (vector
))
3433 val
= char_table_ref_and_range (vector
, i
, &range_beg
, &i
);
3435 val
= AREF (vector
, i
);
3436 definition
= get_keyelt (val
, 0);
3438 if (NILP (definition
)) continue;
3440 /* Don't mention suppressed commands. */
3441 if (SYMBOLP (definition
) && partial
)
3445 tem
= Fget (definition
, suppress
);
3447 if (!NILP (tem
)) continue;
3450 character
= make_number (starting_i
);
3451 ASET (kludge
, 0, character
);
3453 /* If this binding is shadowed by some other map, ignore it. */
3458 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3469 /* Ignore this definition if it is shadowed by an earlier
3470 one in the same keymap. */
3471 if (!NILP (entire_map
))
3475 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3477 if (!EQ (tem
, definition
))
3487 /* Output the prefix that applies to every entry in this map. */
3488 if (!NILP (elt_prefix
))
3489 insert1 (elt_prefix
);
3491 insert1 (Fkey_description (kludge
, prefix
));
3493 /* Find all consecutive characters or rows that have the same
3494 definition. But, for elements of a top level char table, if
3495 they are for charsets, we had better describe one by one even
3496 if they have the same definition. */
3497 if (CHAR_TABLE_P (vector
))
3499 && (val
= char_table_ref_and_range (vector
, i
+ 1,
3500 &range_beg
, &range_end
),
3501 tem2
= get_keyelt (val
, 0),
3503 && !NILP (Fequal (tem2
, definition
)))
3507 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3509 && !NILP (Fequal (tem2
, definition
)))
3512 /* If we have a range of more than one character,
3513 print where the range reaches to. */
3515 if (i
!= starting_i
)
3519 ASET (kludge
, 0, make_number (i
));
3521 if (!NILP (elt_prefix
))
3522 insert1 (elt_prefix
);
3524 insert1 (Fkey_description (kludge
, prefix
));
3527 /* Print a description of the definition of this character.
3528 elt_describer will take care of spacing out far enough
3529 for alignment purposes. */
3530 (*elt_describer
) (definition
, args
);
3535 insert_string (" (binding currently shadowed)");
3540 if (CHAR_TABLE_P (vector
) && ! NILP (XCHAR_TABLE (vector
)->defalt
))
3542 if (!NILP (elt_prefix
))
3543 insert1 (elt_prefix
);
3544 insert ("default", 7);
3545 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3551 /* Apropos - finding all symbols whose names match a regexp. */
3552 static Lisp_Object apropos_predicate
;
3553 static Lisp_Object apropos_accumulate
;
3556 apropos_accum (symbol
, string
)
3557 Lisp_Object symbol
, string
;
3559 register Lisp_Object tem
;
3561 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3562 if (!NILP (tem
) && !NILP (apropos_predicate
))
3563 tem
= call1 (apropos_predicate
, symbol
);
3565 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3568 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3569 doc
: /* Show all symbols whose names contain match for REGEXP.
3570 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3571 for each symbol and a symbol is mentioned only if that returns non-nil.
3572 Return list of symbols found. */)
3574 Lisp_Object regexp
, predicate
;
3577 CHECK_STRING (regexp
);
3578 apropos_predicate
= predicate
;
3579 apropos_accumulate
= Qnil
;
3580 map_obarray (Vobarray
, apropos_accum
, regexp
);
3581 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3582 apropos_accumulate
= Qnil
;
3583 apropos_predicate
= Qnil
;
3590 Qkeymap
= intern ("keymap");
3591 staticpro (&Qkeymap
);
3592 staticpro (&apropos_predicate
);
3593 staticpro (&apropos_accumulate
);
3594 apropos_predicate
= Qnil
;
3595 apropos_accumulate
= Qnil
;
3597 /* Now we are ready to set up this property, so we can
3598 create char tables. */
3599 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3601 /* Initialize the keymaps standardly used.
3602 Each one is the value of a Lisp variable, and is also
3603 pointed to by a C variable */
3605 global_map
= Fmake_keymap (Qnil
);
3606 Fset (intern ("global-map"), global_map
);
3608 current_global_map
= global_map
;
3609 staticpro (&global_map
);
3610 staticpro (¤t_global_map
);
3612 meta_map
= Fmake_keymap (Qnil
);
3613 Fset (intern ("esc-map"), meta_map
);
3614 Ffset (intern ("ESC-prefix"), meta_map
);
3616 control_x_map
= Fmake_keymap (Qnil
);
3617 Fset (intern ("ctl-x-map"), control_x_map
);
3618 Ffset (intern ("Control-X-prefix"), control_x_map
);
3621 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3622 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3623 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3624 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3625 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3627 staticpro (&exclude_keys
);
3629 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3630 doc
: /* List of commands given new key bindings recently.
3631 This is used for internal purposes during Emacs startup;
3632 don't alter it yourself. */);
3633 Vdefine_key_rebound_commands
= Qt
;
3635 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3636 doc
: /* Default keymap to use when reading from the minibuffer. */);
3637 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3639 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3640 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3641 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3642 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3644 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3645 doc
: /* Local keymap for minibuffer input with completion. */);
3646 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3647 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3649 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3650 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3651 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3652 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3653 Vminibuffer_local_completion_map
);
3655 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3656 doc
: /* Alist of keymaps to use for minor modes.
3657 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3658 key sequences and look up bindings iff VARIABLE's value is non-nil.
3659 If two active keymaps bind the same key, the keymap appearing earlier
3660 in the list takes precedence. */);
3661 Vminor_mode_map_alist
= Qnil
;
3663 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3664 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3665 This variable is an alist just like `minor-mode-map-alist', and it is
3666 used the same way (and before `minor-mode-map-alist'); however,
3667 it is provided for major modes to bind locally. */);
3668 Vminor_mode_overriding_map_alist
= Qnil
;
3670 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3671 doc
: /* List of keymap alists to use for emulations modes.
3672 It is intended for modes or packages using multiple minor-mode keymaps.
3673 Each element is a keymap alist just like `minor-mode-map-alist', or a
3674 symbol with a variable binding which is a keymap alist, and it is used
3675 the same way. The "active" keymaps in each alist are used before
3676 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3677 Vemulation_mode_map_alists
= Qnil
;
3680 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3681 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3682 This allows Emacs to recognize function keys sent from ASCII
3683 terminals at any point in a key sequence.
3685 The `read-key-sequence' function replaces any subsequence bound by
3686 `function-key-map' with its binding. More precisely, when the active
3687 keymaps have no binding for the current key sequence but
3688 `function-key-map' binds a suffix of the sequence to a vector or string,
3689 `read-key-sequence' replaces the matching suffix with its binding, and
3690 continues with the new sequence.
3692 The events that come from bindings in `function-key-map' are not
3693 themselves looked up in `function-key-map'.
3695 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3696 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3697 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3698 key, typing `ESC O P x' would return [f1 x]. */);
3699 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3701 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3702 doc
: /* Keymap of key translations that can override keymaps.
3703 This keymap works like `function-key-map', but comes after that,
3704 and its non-prefix bindings override ordinary bindings. */);
3705 Vkey_translation_map
= Qnil
;
3707 staticpro (&Vmouse_events
);
3708 Vmouse_events
= Fcons (intern ("menu-bar"),
3709 Fcons (intern ("tool-bar"),
3710 Fcons (intern ("header-line"),
3711 Fcons (intern ("mode-line"),
3712 Fcons (intern ("mouse-1"),
3713 Fcons (intern ("mouse-2"),
3714 Fcons (intern ("mouse-3"),
3715 Fcons (intern ("mouse-4"),
3716 Fcons (intern ("mouse-5"),
3720 Qsingle_key_description
= intern ("single-key-description");
3721 staticpro (&Qsingle_key_description
);
3723 Qkey_description
= intern ("key-description");
3724 staticpro (&Qkey_description
);
3726 Qkeymapp
= intern ("keymapp");
3727 staticpro (&Qkeymapp
);
3729 Qnon_ascii
= intern ("non-ascii");
3730 staticpro (&Qnon_ascii
);
3732 Qmenu_item
= intern ("menu-item");
3733 staticpro (&Qmenu_item
);
3735 Qremap
= intern ("remap");
3736 staticpro (&Qremap
);
3738 command_remapping_vector
= Fmake_vector (make_number (2), Qremap
);
3739 staticpro (&command_remapping_vector
);
3741 where_is_cache_keymaps
= Qt
;
3742 where_is_cache
= Qnil
;
3743 staticpro (&where_is_cache
);
3744 staticpro (&where_is_cache_keymaps
);
3746 defsubr (&Skeymapp
);
3747 defsubr (&Skeymap_parent
);
3748 defsubr (&Skeymap_prompt
);
3749 defsubr (&Sset_keymap_parent
);
3750 defsubr (&Smake_keymap
);
3751 defsubr (&Smake_sparse_keymap
);
3752 defsubr (&Smap_keymap
);
3753 defsubr (&Scopy_keymap
);
3754 defsubr (&Scommand_remapping
);
3755 defsubr (&Skey_binding
);
3756 defsubr (&Slocal_key_binding
);
3757 defsubr (&Sglobal_key_binding
);
3758 defsubr (&Sminor_mode_key_binding
);
3759 defsubr (&Sdefine_key
);
3760 defsubr (&Slookup_key
);
3761 defsubr (&Sdefine_prefix_command
);
3762 defsubr (&Suse_global_map
);
3763 defsubr (&Suse_local_map
);
3764 defsubr (&Scurrent_local_map
);
3765 defsubr (&Scurrent_global_map
);
3766 defsubr (&Scurrent_minor_mode_maps
);
3767 defsubr (&Scurrent_active_maps
);
3768 defsubr (&Saccessible_keymaps
);
3769 defsubr (&Skey_description
);
3770 defsubr (&Sdescribe_vector
);
3771 defsubr (&Ssingle_key_description
);
3772 defsubr (&Stext_char_description
);
3773 defsubr (&Swhere_is_internal
);
3774 defsubr (&Sdescribe_buffer_bindings
);
3775 defsubr (&Sapropos_internal
);
3781 initial_define_key (global_map
, 033, "ESC-prefix");
3782 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");
3785 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
3786 (do not change this comment) */