1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 01, 2004
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
28 #include "character.h"
31 #include "termhooks.h"
32 #include "blockinput.h"
34 #include "intervals.h"
37 /* The number of elements in keymap vectors. */
38 #define DENSE_TABLE_SIZE (0200)
40 /* Actually allocate storage for these variables */
42 Lisp_Object current_global_map
; /* Current global keymap */
44 Lisp_Object global_map
; /* default global key bindings */
46 Lisp_Object meta_map
; /* The keymap used for globally bound
47 ESC-prefixed default commands */
49 Lisp_Object control_x_map
; /* The keymap used for globally bound
50 C-x-prefixed default commands */
52 /* was MinibufLocalMap */
53 Lisp_Object Vminibuffer_local_map
;
54 /* The keymap used by the minibuf for local
55 bindings when spaces are allowed in the
58 /* was MinibufLocalNSMap */
59 Lisp_Object Vminibuffer_local_ns_map
;
60 /* The keymap used by the minibuf for local
61 bindings when spaces are not encouraged
64 /* keymap used for minibuffers when doing completion */
65 /* was MinibufLocalCompletionMap */
66 Lisp_Object Vminibuffer_local_completion_map
;
68 /* keymap used for minibuffers when doing completion and require a match */
69 /* was MinibufLocalMustMatchMap */
70 Lisp_Object Vminibuffer_local_must_match_map
;
72 /* Alist of minor mode variables and keymaps. */
73 Lisp_Object Vminor_mode_map_alist
;
75 /* Alist of major-mode-specific overrides for
76 minor mode variables and keymaps. */
77 Lisp_Object Vminor_mode_overriding_map_alist
;
79 /* List of emulation mode keymap alists. */
80 Lisp_Object Vemulation_mode_map_alists
;
82 /* Keymap mapping ASCII function key sequences onto their preferred forms.
83 Initialized by the terminal-specific lisp files. See DEFVAR for more
85 Lisp_Object Vfunction_key_map
;
87 /* Keymap mapping ASCII function key sequences onto their preferred forms. */
88 Lisp_Object Vkey_translation_map
;
90 /* A list of all commands given new bindings since a certain time
91 when nil was stored here.
92 This is used to speed up recomputation of menu key equivalents
93 when Emacs starts up. t means don't record anything here. */
94 Lisp_Object Vdefine_key_rebound_commands
;
96 Lisp_Object Qkeymapp
, Qkeymap
, Qnon_ascii
, Qmenu_item
, Qremap
;
98 /* Alist of elements like (DEL . "\d"). */
99 static Lisp_Object exclude_keys
;
101 /* Pre-allocated 2-element vector for Fcommand_remapping to use. */
102 static Lisp_Object command_remapping_vector
;
104 /* A char with the CHAR_META bit set in a vector or the 0200 bit set
105 in a string key sequence is equivalent to prefixing with this
107 extern Lisp_Object meta_prefix_char
;
109 extern Lisp_Object Voverriding_local_map
;
111 /* Hash table used to cache a reverse-map to speed up calls to where-is. */
112 static Lisp_Object where_is_cache
;
113 /* Which keymaps are reverse-stored in the cache. */
114 static Lisp_Object where_is_cache_keymaps
;
116 static Lisp_Object store_in_keymap
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
117 static void fix_submap_inheritance
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
));
119 static Lisp_Object define_as_prefix
P_ ((Lisp_Object
, Lisp_Object
));
120 static void describe_command
P_ ((Lisp_Object
, Lisp_Object
));
121 static void describe_translation
P_ ((Lisp_Object
, Lisp_Object
));
122 static void describe_map
P_ ((Lisp_Object
, Lisp_Object
,
123 void (*) P_ ((Lisp_Object
, Lisp_Object
)),
124 int, Lisp_Object
, Lisp_Object
*, int));
125 static void describe_vector
P_ ((Lisp_Object
, Lisp_Object
, Lisp_Object
,
126 void (*) (Lisp_Object
, Lisp_Object
), int,
127 Lisp_Object
, Lisp_Object
, int *, int, int));
128 static void silly_event_symbol_error
P_ ((Lisp_Object
));
130 /* Keymap object support - constructors and predicates. */
132 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
133 doc
: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
134 CHARTABLE is a char-table that holds the bindings for all characters
135 without modifiers. All entries in it are initially nil, meaning
136 "command undefined". ALIST is an assoc-list which holds bindings for
137 function keys, mouse events, and any other things that appear in the
138 input stream. Initially, ALIST is nil.
140 The optional arg STRING supplies a menu name for the keymap
141 in case you use it as a menu with `x-popup-menu'. */)
147 tail
= Fcons (string
, Qnil
);
150 return Fcons (Qkeymap
,
151 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
154 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
155 doc
: /* Construct and return a new sparse keymap.
156 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
157 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
158 which binds the function key or mouse event SYMBOL to DEFINITION.
159 Initially the alist is nil.
161 The optional arg STRING supplies a menu name for the keymap
162 in case you use it as a menu with `x-popup-menu'. */)
167 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
168 return Fcons (Qkeymap
, Qnil
);
171 /* This function is used for installing the standard key bindings
172 at initialization time.
176 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
179 initial_define_key (keymap
, key
, defname
)
184 store_in_keymap (keymap
, make_number (key
), intern (defname
));
188 initial_define_lispy_key (keymap
, keyname
, defname
)
193 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
196 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
197 doc
: /* Return t if OBJECT is a keymap.
199 A keymap is a list (keymap . ALIST),
200 or a symbol whose function definition is itself a keymap.
201 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
202 a vector of densely packed bindings for small character codes
203 is also allowed as an element. */)
207 return (KEYMAPP (object
) ? Qt
: Qnil
);
210 DEFUN ("keymap-prompt", Fkeymap_prompt
, Skeymap_prompt
, 1, 1, 0,
211 doc
: /* Return the prompt-string of a keymap MAP.
212 If non-nil, the prompt is shown in the echo-area
213 when reading a key-sequence to be looked-up in this keymap. */)
219 register Lisp_Object tem
;
228 /* Check that OBJECT is a keymap (after dereferencing through any
229 symbols). If it is, return it.
231 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
232 is an autoload form, do the autoload and try again.
233 If AUTOLOAD is nonzero, callers must assume GC is possible.
235 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
236 is zero as well), return Qt.
238 ERROR controls how we respond if OBJECT isn't a keymap.
239 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
241 Note that most of the time, we don't want to pursue autoloads.
242 Functions like Faccessible_keymaps which scan entire keymap trees
243 shouldn't load every autoloaded keymap. I'm not sure about this,
244 but it seems to me that only read_key_sequence, Flookup_key, and
245 Fdefine_key should cause keymaps to be autoloaded.
247 This function can GC when AUTOLOAD is non-zero, because it calls
248 do_autoload which can GC. */
251 get_keymap (object
, error
, autoload
)
260 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
263 tem
= indirect_function (object
);
266 if (EQ (XCAR (tem
), Qkeymap
))
269 /* Should we do an autoload? Autoload forms for keymaps have
270 Qkeymap as their fifth element. */
271 if ((autoload
|| !error
) && EQ (XCAR (tem
), Qautoload
))
275 tail
= Fnth (make_number (4), tem
);
276 if (EQ (tail
, Qkeymap
))
280 struct gcpro gcpro1
, gcpro2
;
282 GCPRO2 (tem
, object
);
283 do_autoload (tem
, object
);
296 wrong_type_argument (Qkeymapp
, object
);
300 /* Return the parent map of KEYMAP, or nil if it has none.
301 We assume that KEYMAP is a valid keymap. */
304 keymap_parent (keymap
, autoload
)
310 keymap
= get_keymap (keymap
, 1, autoload
);
312 /* Skip past the initial element `keymap'. */
313 list
= XCDR (keymap
);
314 for (; CONSP (list
); list
= XCDR (list
))
316 /* See if there is another `keymap'. */
321 return get_keymap (list
, 0, autoload
);
324 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
325 doc
: /* Return the parent keymap of KEYMAP. */)
329 return keymap_parent (keymap
, 1);
332 /* Check whether MAP is one of MAPS parents. */
334 keymap_memberp (map
, maps
)
335 Lisp_Object map
, maps
;
337 if (NILP (map
)) return 0;
338 while (KEYMAPP (maps
) && !EQ (map
, maps
))
339 maps
= keymap_parent (maps
, 0);
340 return (EQ (map
, maps
));
343 /* Set the parent keymap of MAP to PARENT. */
345 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
346 doc
: /* Modify KEYMAP to set its parent map to PARENT.
347 Return PARENT. PARENT should be nil or another keymap. */)
349 Lisp_Object keymap
, parent
;
351 Lisp_Object list
, prev
;
352 struct gcpro gcpro1
, gcpro2
;
355 /* Force a keymap flush for the next call to where-is.
356 Since this can be called from within where-is, we don't set where_is_cache
357 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
358 be changed during where-is, while where_is_cache_keymaps is only used at
359 the very beginning of where-is and can thus be changed here without any
361 This is a very minor correctness (rather than safety) issue. */
362 where_is_cache_keymaps
= Qt
;
364 GCPRO2 (keymap
, parent
);
365 keymap
= get_keymap (keymap
, 1, 1);
369 parent
= get_keymap (parent
, 1, 1);
371 /* Check for cycles. */
372 if (keymap_memberp (keymap
, parent
))
373 error ("Cyclic keymap inheritance");
376 /* Skip past the initial element `keymap'. */
381 /* If there is a parent keymap here, replace it.
382 If we came to the end, add the parent in PREV. */
383 if (!CONSP (list
) || KEYMAPP (list
))
385 /* If we already have the right parent, return now
386 so that we avoid the loops below. */
387 if (EQ (XCDR (prev
), parent
))
388 RETURN_UNGCPRO (parent
);
390 XSETCDR (prev
, parent
);
396 /* Scan through for submaps, and set their parents too. */
398 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
400 /* Stop the scan when we come to the parent. */
401 if (EQ (XCAR (list
), Qkeymap
))
404 /* If this element holds a prefix map, deal with it. */
405 if (CONSP (XCAR (list
))
406 && CONSP (XCDR (XCAR (list
))))
407 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
410 if (VECTORP (XCAR (list
)))
411 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
412 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
413 fix_submap_inheritance (keymap
, make_number (i
),
414 XVECTOR (XCAR (list
))->contents
[i
]);
416 if (CHAR_TABLE_P (XCAR (list
)))
418 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
), keymap
);
422 RETURN_UNGCPRO (parent
);
425 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
426 if EVENT is also a prefix in MAP's parent,
427 make sure that SUBMAP inherits that definition as its own parent. */
430 fix_submap_inheritance (map
, event
, submap
)
431 Lisp_Object map
, event
, submap
;
433 Lisp_Object map_parent
, parent_entry
;
435 /* SUBMAP is a cons that we found as a key binding.
436 Discard the other things found in a menu key binding. */
438 submap
= get_keymap (get_keyelt (submap
, 0), 0, 0);
440 /* If it isn't a keymap now, there's no work to do. */
444 map_parent
= keymap_parent (map
, 0);
445 if (!NILP (map_parent
))
447 get_keymap (access_keymap (map_parent
, event
, 0, 0, 0), 0, 0);
451 /* If MAP's parent has something other than a keymap,
452 our own submap shadows it completely. */
453 if (!CONSP (parent_entry
))
456 if (! EQ (parent_entry
, submap
))
458 Lisp_Object submap_parent
;
459 submap_parent
= submap
;
464 tem
= keymap_parent (submap_parent
, 0);
468 if (keymap_memberp (tem
, parent_entry
))
469 /* Fset_keymap_parent could create a cycle. */
476 Fset_keymap_parent (submap_parent
, parent_entry
);
480 /* Look up IDX in MAP. IDX may be any sort of event.
481 Note that this does only one level of lookup; IDX must be a single
482 event, not a sequence.
484 If T_OK is non-zero, bindings for Qt are treated as default
485 bindings; any key left unmentioned by other tables and bindings is
486 given the binding of Qt.
488 If T_OK is zero, bindings for Qt are not treated specially.
490 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
493 access_keymap (map
, idx
, t_ok
, noinherit
, autoload
)
502 /* Qunbound in VAL means we have found no binding yet. */
505 /* If idx is a list (some sort of mouse click, perhaps?),
506 the index we want to use is the car of the list, which
507 ought to be a symbol. */
508 idx
= EVENT_HEAD (idx
);
510 /* If idx is a symbol, it might have modifiers, which need to
511 be put in the canonical order. */
513 idx
= reorder_modifiers (idx
);
514 else if (INTEGERP (idx
))
515 /* Clobber the high bits that can be present on a machine
516 with more than 24 bits of integer. */
517 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
519 /* Handle the special meta -> esc mapping. */
520 if (INTEGERP (idx
) && XUINT (idx
) & meta_modifier
)
522 /* See if there is a meta-map. If there's none, there is
523 no binding for IDX, unless a default binding exists in MAP. */
525 Lisp_Object meta_map
;
527 meta_map
= get_keymap (access_keymap (map
, meta_prefix_char
,
528 t_ok
, noinherit
, autoload
),
531 if (CONSP (meta_map
))
534 idx
= make_number (XUINT (idx
) & ~meta_modifier
);
537 /* Set IDX to t, so that we only find a default binding. */
540 /* We know there is no binding. */
544 /* t_binding is where we put a default binding that applies,
545 to use in case we do not find a binding specifically
546 for this key sequence. */
549 Lisp_Object t_binding
= Qnil
;
550 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
552 GCPRO4 (map
, tail
, idx
, t_binding
);
554 /* If `t_ok' is 2, both `t' is accepted. */
557 for (tail
= XCDR (map
);
559 || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
)));
564 binding
= XCAR (tail
);
565 if (SYMBOLP (binding
))
567 /* If NOINHERIT, stop finding prefix definitions
568 after we pass a second occurrence of the `keymap' symbol. */
569 if (noinherit
&& EQ (binding
, Qkeymap
))
570 RETURN_UNGCPRO (Qnil
);
572 else if (CONSP (binding
))
574 Lisp_Object key
= XCAR (binding
);
577 val
= XCDR (binding
);
578 else if (t_ok
> 1 && EQ (key
, Qt
))
580 t_binding
= XCDR (binding
);
584 else if (VECTORP (binding
))
586 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (binding
))
587 val
= AREF (binding
, XFASTINT (idx
));
589 else if (CHAR_TABLE_P (binding
))
591 /* Character codes with modifiers
592 are not included in a char-table.
593 All character codes without modifiers are included. */
594 if (NATNUMP (idx
) && (XFASTINT (idx
) & CHAR_MODIFIER_MASK
) == 0)
596 val
= Faref (binding
, idx
);
597 /* `nil' has a special meaning for char-tables, so
598 we use something else to record an explicitly
605 /* If we found a binding, clean it up and return it. */
606 if (!EQ (val
, Qunbound
))
609 /* A Qt binding is just like an explicit nil binding
610 (i.e. it shadows any parent binding but not bindings in
611 keymaps of lower precedence). */
613 val
= get_keyelt (val
, autoload
);
615 fix_submap_inheritance (map
, idx
, val
);
616 RETURN_UNGCPRO (val
);
621 return get_keyelt (t_binding
, autoload
);
626 map_keymap_item (fun
, args
, key
, val
, data
)
627 map_keymap_function_t fun
;
628 Lisp_Object args
, key
, val
;
631 /* We should maybe try to detect bindings shadowed by previous
632 ones and things like that. */
635 (*fun
) (key
, val
, args
, data
);
639 map_keymap_char_table_item (args
, key
, val
)
640 Lisp_Object args
, key
, val
;
644 map_keymap_function_t fun
= XSAVE_VALUE (XCAR (args
))->pointer
;
646 map_keymap_item (fun
, XCDR (args
), key
, val
,
647 XSAVE_VALUE (XCAR (args
))->pointer
);
651 /* Call FUN for every binding in MAP.
652 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
653 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
655 map_keymap (map
, fun
, args
, data
, autoload
)
656 map_keymap_function_t fun
;
657 Lisp_Object map
, args
;
661 struct gcpro gcpro1
, gcpro2
, gcpro3
;
664 GCPRO3 (map
, args
, tail
);
665 map
= get_keymap (map
, 1, autoload
);
666 for (tail
= (CONSP (map
) && EQ (Qkeymap
, XCAR (map
))) ? XCDR (map
) : map
;
667 CONSP (tail
) || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
));
670 Lisp_Object binding
= XCAR (tail
);
673 map_keymap_item (fun
, args
, XCAR (binding
), XCDR (binding
), data
);
674 else if (VECTORP (binding
))
676 /* Loop over the char values represented in the vector. */
677 int len
= ASIZE (binding
);
679 for (c
= 0; c
< len
; c
++)
681 Lisp_Object character
;
682 XSETFASTINT (character
, c
);
683 map_keymap_item (fun
, args
, character
, AREF (binding
, c
), data
);
686 else if (CHAR_TABLE_P (binding
))
688 map_char_table (map_keymap_char_table_item
, Qnil
, binding
,
689 Fcons (make_save_value (fun
, 0),
690 Fcons (make_save_value (data
, 0),
698 map_keymap_call (key
, val
, fun
, dummy
)
699 Lisp_Object key
, val
, fun
;
702 call2 (fun
, key
, val
);
705 DEFUN ("map-keymap", Fmap_keymap
, Smap_keymap
, 2, 2, 0,
706 doc
: /* Call FUNCTION for every binding in KEYMAP.
707 FUNCTION is called with two arguments: the event and its binding.
708 If KEYMAP has a parent, the parent's bindings are included as well.
709 This works recursively: if the parent has itself a parent, then the
710 grandparent's bindings are also included and so on. */)
712 Lisp_Object function
, keymap
;
714 if (INTEGERP (function
))
715 /* We have to stop integers early since map_keymap gives them special
717 Fsignal (Qinvalid_function
, Fcons (function
, Qnil
));
718 map_keymap (keymap
, map_keymap_call
, function
, NULL
, 1);
722 /* Given OBJECT which was found in a slot in a keymap,
723 trace indirect definitions to get the actual definition of that slot.
724 An indirect definition is a list of the form
725 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
726 and INDEX is the object to look up in KEYMAP to yield the definition.
728 Also if OBJECT has a menu string as the first element,
729 remove that. Also remove a menu help string as second element.
731 If AUTOLOAD is nonzero, load autoloadable keymaps
732 that are referred to with indirection. */
735 get_keyelt (object
, autoload
)
741 if (!(CONSP (object
)))
742 /* This is really the value. */
745 /* If the keymap contents looks like (keymap ...) or (lambda ...)
747 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
750 /* If the keymap contents looks like (menu-item name . DEFN)
751 or (menu-item name DEFN ...) then use DEFN.
752 This is a new format menu item. */
753 else if (EQ (XCAR (object
), Qmenu_item
))
755 if (CONSP (XCDR (object
)))
759 object
= XCDR (XCDR (object
));
762 object
= XCAR (object
);
764 /* If there's a `:filter FILTER', apply FILTER to the
765 menu-item's definition to get the real definition to
767 for (; CONSP (tem
) && CONSP (XCDR (tem
)); tem
= XCDR (tem
))
768 if (EQ (XCAR (tem
), QCfilter
) && autoload
)
771 filter
= XCAR (XCDR (tem
));
772 filter
= list2 (filter
, list2 (Qquote
, object
));
773 object
= menu_item_eval_property (filter
);
778 /* Invalid keymap. */
782 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
783 Keymap alist elements like (CHAR MENUSTRING . DEFN)
784 will be used by HierarKey menus. */
785 else if (STRINGP (XCAR (object
)))
787 object
= XCDR (object
);
788 /* Also remove a menu help string, if any,
789 following the menu item name. */
790 if (CONSP (object
) && STRINGP (XCAR (object
)))
791 object
= XCDR (object
);
792 /* Also remove the sublist that caches key equivalences, if any. */
793 if (CONSP (object
) && CONSP (XCAR (object
)))
796 carcar
= XCAR (XCAR (object
));
797 if (NILP (carcar
) || VECTORP (carcar
))
798 object
= XCDR (object
);
802 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
808 map
= get_keymap (Fcar_safe (object
), 0, autoload
);
810 return (!CONSP (map
) ? object
/* Invalid keymap */
811 : access_keymap (map
, Fcdr (object
), 0, 0, autoload
));
817 store_in_keymap (keymap
, idx
, def
)
819 register Lisp_Object idx
;
820 register Lisp_Object def
;
822 /* Flush any reverse-map cache. */
823 where_is_cache
= Qnil
;
824 where_is_cache_keymaps
= Qt
;
826 /* If we are preparing to dump, and DEF is a menu element
827 with a menu item indicator, copy it to ensure it is not pure. */
828 if (CONSP (def
) && PURE_P (def
)
829 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
830 def
= Fcons (XCAR (def
), XCDR (def
));
832 if (!CONSP (keymap
) || !EQ (XCAR (keymap
), Qkeymap
))
833 error ("attempt to define a key in a non-keymap");
835 /* If idx is a cons, and the car part is a character, idx must be of
836 the form (FROM-CHAR . TO-CHAR). */
837 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
838 CHECK_CHARACTER_CDR (idx
);
840 /* If idx is a list (some sort of mouse click, perhaps?),
841 the index we want to use is the car of the list, which
842 ought to be a symbol. */
843 idx
= EVENT_HEAD (idx
);
845 /* If idx is a symbol, it might have modifiers, which need to
846 be put in the canonical order. */
848 idx
= reorder_modifiers (idx
);
849 else if (INTEGERP (idx
))
850 /* Clobber the high bits that can be present on a machine
851 with more than 24 bits of integer. */
852 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
854 /* Scan the keymap for a binding of idx. */
858 /* The cons after which we should insert new bindings. If the
859 keymap has a table element, we record its position here, so new
860 bindings will go after it; this way, the table will stay
861 towards the front of the alist and character lookups in dense
862 keymaps will remain fast. Otherwise, this just points at the
863 front of the keymap. */
864 Lisp_Object insertion_point
;
866 insertion_point
= keymap
;
867 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
874 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (elt
))
876 ASET (elt
, XFASTINT (idx
), def
);
879 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
881 int from
= XFASTINT (XCAR (idx
));
882 int to
= XFASTINT (XCDR (idx
));
884 if (to
>= ASIZE (elt
))
885 to
= ASIZE (elt
) - 1;
886 for (; from
<= to
; from
++)
887 ASET (elt
, from
, def
);
888 if (to
== XFASTINT (XCDR (idx
)))
889 /* We have defined all keys in IDX. */
892 insertion_point
= tail
;
894 else if (CHAR_TABLE_P (elt
))
896 /* Character codes with modifiers
897 are not included in a char-table.
898 All character codes without modifiers are included. */
899 if (NATNUMP (idx
) && !(XFASTINT (idx
) & CHAR_MODIFIER_MASK
))
902 /* `nil' has a special meaning for char-tables, so
903 we use something else to record an explicitly
905 NILP (def
) ? Qt
: def
);
908 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
910 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
913 insertion_point
= tail
;
915 else if (CONSP (elt
))
917 if (EQ (idx
, XCAR (elt
)))
922 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
924 int from
= XFASTINT (XCAR (idx
));
925 int to
= XFASTINT (XCDR (idx
));
927 if (from
<= XFASTINT (XCAR (elt
))
928 && to
>= XFASTINT (XCAR (elt
)))
936 else if (EQ (elt
, Qkeymap
))
937 /* If we find a 'keymap' symbol in the spine of KEYMAP,
938 then we must have found the start of a second keymap
939 being used as the tail of KEYMAP, and a binding for IDX
940 should be inserted before it. */
947 /* We have scanned the entire keymap, and not found a binding for
948 IDX. Let's add one. */
952 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
954 /* IDX specifies a range of characters, and not all of them
955 were handled yet, which means this keymap doesn't have a
956 char-table. So, we insert a char-table now. */
957 elt
= Fmake_char_table (Qkeymap
, Qnil
);
958 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
961 elt
= Fcons (idx
, def
);
962 XSETCDR (insertion_point
, Fcons (elt
, XCDR (insertion_point
)));
969 EXFUN (Fcopy_keymap
, 1);
972 copy_keymap_item (elt
)
975 Lisp_Object res
, tem
;
982 /* Is this a new format menu item. */
983 if (EQ (XCAR (tem
), Qmenu_item
))
985 /* Copy cell with menu-item marker. */
986 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
990 /* Copy cell with menu-item name. */
991 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
997 /* Copy cell with binding and if the binding is a keymap,
999 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1002 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1003 XSETCAR (elt
, Fcopy_keymap (tem
));
1005 if (CONSP (tem
) && CONSP (XCAR (tem
)))
1006 /* Delete cache for key equivalences. */
1007 XSETCDR (elt
, XCDR (tem
));
1012 /* It may be an old fomat menu item.
1013 Skip the optional menu string. */
1014 if (STRINGP (XCAR (tem
)))
1016 /* Copy the cell, since copy-alist didn't go this deep. */
1017 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
1019 /* Also skip the optional menu help string. */
1020 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1022 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1026 /* There may also be a list that caches key equivalences.
1027 Just delete it for the new keymap. */
1029 && CONSP (XCAR (tem
))
1030 && (NILP (XCAR (XCAR (tem
)))
1031 || VECTORP (XCAR (XCAR (tem
)))))
1033 XSETCDR (elt
, XCDR (tem
));
1036 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1037 XSETCDR (elt
, Fcopy_keymap (tem
));
1039 else if (EQ (XCAR (tem
), Qkeymap
))
1040 res
= Fcopy_keymap (elt
);
1046 copy_keymap_1 (chartable
, idx
, elt
)
1047 Lisp_Object chartable
, idx
, elt
;
1049 Fset_char_table_range (chartable
, idx
, copy_keymap_item (elt
));
1052 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
1053 doc
: /* Return a copy of the keymap KEYMAP.
1054 The copy starts out with the same definitions of KEYMAP,
1055 but changing either the copy or KEYMAP does not affect the other.
1056 Any key definitions that are subkeymaps are recursively copied.
1057 However, a key definition which is a symbol whose definition is a keymap
1062 register Lisp_Object copy
, tail
;
1063 keymap
= get_keymap (keymap
, 1, 0);
1064 copy
= tail
= Fcons (Qkeymap
, Qnil
);
1065 keymap
= XCDR (keymap
); /* Skip the `keymap' symbol. */
1067 while (CONSP (keymap
) && !EQ (XCAR (keymap
), Qkeymap
))
1069 Lisp_Object elt
= XCAR (keymap
);
1070 if (CHAR_TABLE_P (elt
))
1072 elt
= Fcopy_sequence (elt
);
1073 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
);
1075 else if (VECTORP (elt
))
1078 elt
= Fcopy_sequence (elt
);
1079 for (i
= 0; i
< ASIZE (elt
); i
++)
1080 ASET (elt
, i
, copy_keymap_item (AREF (elt
, i
)));
1082 else if (CONSP (elt
))
1083 elt
= Fcons (XCAR (elt
), copy_keymap_item (XCDR (elt
)));
1084 XSETCDR (tail
, Fcons (elt
, Qnil
));
1086 keymap
= XCDR (keymap
);
1088 XSETCDR (tail
, keymap
);
1092 /* Simple Keymap mutators and accessors. */
1094 /* GC is possible in this function if it autoloads a keymap. */
1096 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
1097 doc
: /* In KEYMAP, define key sequence KEY as DEF.
1100 KEY is a string or a vector of symbols and characters meaning a
1101 sequence of keystrokes and events. Non-ASCII characters with codes
1102 above 127 (such as ISO Latin-1) can be included if you use a vector.
1103 Using [t] for KEY creates a default definition, which applies to any
1104 event type that has no other definition in this keymap.
1106 DEF is anything that can be a key's definition:
1107 nil (means key is undefined in this keymap),
1108 a command (a Lisp function suitable for interactive calling),
1109 a string (treated as a keyboard macro),
1110 a keymap (to define a prefix key),
1111 a symbol (when the key is looked up, the symbol will stand for its
1112 function definition, which should at that time be one of the above,
1113 or another symbol whose function definition is used, etc.),
1114 a cons (STRING . DEFN), meaning that DEFN is the definition
1115 (DEFN should be a valid definition in its own right),
1116 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP.
1118 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1119 binding is altered. If there is no binding for KEY, the new pair
1120 binding KEY to DEF is added at the front of KEYMAP. */)
1127 register Lisp_Object c
;
1128 register Lisp_Object cmd
;
1132 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1134 GCPRO3 (keymap
, key
, def
);
1135 keymap
= get_keymap (keymap
, 1, 1);
1137 if (!VECTORP (key
) && !STRINGP (key
))
1138 key
= wrong_type_argument (Qarrayp
, key
);
1140 length
= XFASTINT (Flength (key
));
1142 RETURN_UNGCPRO (Qnil
);
1144 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
1145 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
1147 meta_bit
= VECTORP (key
) ? meta_modifier
: 0x80;
1152 c
= Faref (key
, make_number (idx
));
1156 /* C may be a Lucid style event type list or a cons (FROM .
1157 TO) specifying a range of characters. */
1158 if (lucid_event_type_list_p (c
))
1159 c
= Fevent_convert_list (c
);
1160 else if (CHARACTERP (XCAR (c
)))
1161 CHECK_CHARACTER_CDR (c
);
1165 silly_event_symbol_error (c
);
1168 && (XINT (c
) & meta_bit
)
1171 c
= meta_prefix_char
;
1177 XSETINT (c
, XINT (c
) & ~meta_bit
);
1183 if (!INTEGERP (c
) && !SYMBOLP (c
)
1185 /* If C is a range, it must be a leaf. */
1186 || (INTEGERP (XCAR (c
)) && idx
!= length
)))
1187 error ("Key sequence contains invalid event");
1190 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
1192 cmd
= access_keymap (keymap
, c
, 0, 1, 1);
1194 /* If this key is undefined, make it a prefix. */
1196 cmd
= define_as_prefix (keymap
, c
);
1198 keymap
= get_keymap (cmd
, 0, 1);
1199 if (!CONSP (keymap
))
1200 /* We must use Fkey_description rather than just passing key to
1201 error; key might be a vector, not a string. */
1202 error ("Key sequence %s uses invalid prefix characters",
1203 SDATA (Fkey_description (key
, Qnil
)));
1207 /* This function may GC (it calls Fkey_binding). */
1209 DEFUN ("command-remapping", Fcommand_remapping
, Scommand_remapping
, 1, 1, 0,
1210 doc
: /* Return the remapping for command COMMAND in current keymaps.
1211 Returns nil if COMMAND is not remapped (or not a symbol). */)
1213 Lisp_Object command
;
1215 if (!SYMBOLP (command
))
1218 ASET (command_remapping_vector
, 1, command
);
1219 return Fkey_binding (command_remapping_vector
, Qnil
, Qt
);
1222 /* Value is number if KEY is too long; nil if valid but has no definition. */
1223 /* GC is possible in this function if it autoloads a keymap. */
1225 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
1226 doc
: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1227 nil means undefined. See doc of `define-key' for kinds of definitions.
1229 A number as value means KEY is "too long";
1230 that is, characters or symbols in it except for the last one
1231 fail to be a valid sequence of prefix characters in KEYMAP.
1232 The number is how many characters at the front of KEY
1233 it takes to reach a non-prefix command.
1235 Normally, `lookup-key' ignores bindings for t, which act as default
1236 bindings, used when nothing else in the keymap applies; this makes it
1237 usable as a general function for probing keymaps. However, if the
1238 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1239 recognize the default bindings, just as `read-key-sequence' does. */)
1240 (keymap
, key
, accept_default
)
1243 Lisp_Object accept_default
;
1246 register Lisp_Object cmd
;
1247 register Lisp_Object c
;
1249 int t_ok
= !NILP (accept_default
);
1250 struct gcpro gcpro1
, gcpro2
;
1252 GCPRO2 (keymap
, key
);
1253 keymap
= get_keymap (keymap
, 1, 1);
1255 if (!VECTORP (key
) && !STRINGP (key
))
1256 key
= wrong_type_argument (Qarrayp
, key
);
1258 length
= XFASTINT (Flength (key
));
1260 RETURN_UNGCPRO (keymap
);
1265 c
= Faref (key
, make_number (idx
++));
1267 if (CONSP (c
) && lucid_event_type_list_p (c
))
1268 c
= Fevent_convert_list (c
);
1270 /* Turn the 8th bit of string chars into a meta modifier. */
1271 if (XINT (c
) & 0x80 && STRINGP (key
))
1272 XSETINT (c
, (XINT (c
) | meta_modifier
) & ~0x80);
1274 /* Allow string since binding for `menu-bar-select-buffer'
1275 includes the buffer name in the key sequence. */
1276 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
) && !STRINGP (c
))
1277 error ("Key sequence contains invalid event");
1279 cmd
= access_keymap (keymap
, c
, t_ok
, 0, 1);
1281 RETURN_UNGCPRO (cmd
);
1283 keymap
= get_keymap (cmd
, 0, 1);
1284 if (!CONSP (keymap
))
1285 RETURN_UNGCPRO (make_number (idx
));
1291 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1292 Assume that currently it does not define C at all.
1293 Return the keymap. */
1296 define_as_prefix (keymap
, c
)
1297 Lisp_Object keymap
, c
;
1301 cmd
= Fmake_sparse_keymap (Qnil
);
1302 /* If this key is defined as a prefix in an inherited keymap,
1303 make it a prefix in this map, and make its definition
1304 inherit the other prefix definition. */
1305 cmd
= nconc2 (cmd
, access_keymap (keymap
, c
, 0, 0, 0));
1306 store_in_keymap (keymap
, c
, cmd
);
1311 /* Append a key to the end of a key sequence. We always make a vector. */
1314 append_key (key_sequence
, key
)
1315 Lisp_Object key_sequence
, key
;
1317 Lisp_Object args
[2];
1319 args
[0] = key_sequence
;
1321 args
[1] = Fcons (key
, Qnil
);
1322 return Fvconcat (2, args
);
1325 /* Given a event type C which is a symbol,
1326 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1329 silly_event_symbol_error (c
)
1332 Lisp_Object parsed
, base
, name
, assoc
;
1335 parsed
= parse_modifiers (c
);
1336 modifiers
= (int) XUINT (XCAR (XCDR (parsed
)));
1337 base
= XCAR (parsed
);
1338 name
= Fsymbol_name (base
);
1339 /* This alist includes elements such as ("RET" . "\\r"). */
1340 assoc
= Fassoc (name
, exclude_keys
);
1344 char new_mods
[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1346 Lisp_Object keystring
;
1347 if (modifiers
& alt_modifier
)
1348 { *p
++ = '\\'; *p
++ = 'A'; *p
++ = '-'; }
1349 if (modifiers
& ctrl_modifier
)
1350 { *p
++ = '\\'; *p
++ = 'C'; *p
++ = '-'; }
1351 if (modifiers
& hyper_modifier
)
1352 { *p
++ = '\\'; *p
++ = 'H'; *p
++ = '-'; }
1353 if (modifiers
& meta_modifier
)
1354 { *p
++ = '\\'; *p
++ = 'M'; *p
++ = '-'; }
1355 if (modifiers
& shift_modifier
)
1356 { *p
++ = '\\'; *p
++ = 'S'; *p
++ = '-'; }
1357 if (modifiers
& super_modifier
)
1358 { *p
++ = '\\'; *p
++ = 's'; *p
++ = '-'; }
1361 c
= reorder_modifiers (c
);
1362 keystring
= concat2 (build_string (new_mods
), XCDR (assoc
));
1364 error ((modifiers
& ~meta_modifier
1365 ? "To bind the key %s, use [?%s], not [%s]"
1366 : "To bind the key %s, use \"%s\", not [%s]"),
1367 SDATA (SYMBOL_NAME (c
)), SDATA (keystring
),
1368 SDATA (SYMBOL_NAME (c
)));
1372 /* Global, local, and minor mode keymap stuff. */
1374 /* We can't put these variables inside current_minor_maps, since under
1375 some systems, static gets macro-defined to be the empty string.
1377 static Lisp_Object
*cmm_modes
= NULL
, *cmm_maps
= NULL
;
1378 static int cmm_size
= 0;
1380 /* Error handler used in current_minor_maps. */
1382 current_minor_maps_error ()
1387 /* Store a pointer to an array of the keymaps of the currently active
1388 minor modes in *buf, and return the number of maps it contains.
1390 This function always returns a pointer to the same buffer, and may
1391 free or reallocate it, so if you want to keep it for a long time or
1392 hand it out to lisp code, copy it. This procedure will be called
1393 for every key sequence read, so the nice lispy approach (return a
1394 new assoclist, list, what have you) for each invocation would
1395 result in a lot of consing over time.
1397 If we used xrealloc/xmalloc and ran out of memory, they would throw
1398 back to the command loop, which would try to read a key sequence,
1399 which would call this function again, resulting in an infinite
1400 loop. Instead, we'll use realloc/malloc and silently truncate the
1401 list, let the key sequence be read, and hope some other piece of
1402 code signals the error. */
1404 current_minor_maps (modeptr
, mapptr
)
1405 Lisp_Object
**modeptr
, **mapptr
;
1408 int list_number
= 0;
1409 Lisp_Object alist
, assoc
, var
, val
;
1410 Lisp_Object emulation_alists
;
1411 Lisp_Object lists
[2];
1413 emulation_alists
= Vemulation_mode_map_alists
;
1414 lists
[0] = Vminor_mode_overriding_map_alist
;
1415 lists
[1] = Vminor_mode_map_alist
;
1417 for (list_number
= 0; list_number
< 2; list_number
++)
1419 if (CONSP (emulation_alists
))
1421 alist
= XCAR (emulation_alists
);
1422 emulation_alists
= XCDR (emulation_alists
);
1423 if (SYMBOLP (alist
))
1424 alist
= find_symbol_value (alist
);
1428 alist
= lists
[list_number
];
1430 for ( ; CONSP (alist
); alist
= XCDR (alist
))
1431 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1432 && (var
= XCAR (assoc
), SYMBOLP (var
))
1433 && (val
= find_symbol_value (var
), !EQ (val
, Qunbound
))
1438 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1439 and also an entry in Vminor_mode_map_alist,
1440 ignore the latter. */
1441 if (list_number
== 1)
1443 val
= assq_no_quit (var
, lists
[0]);
1450 int newsize
, allocsize
;
1451 Lisp_Object
*newmodes
, *newmaps
;
1453 newsize
= cmm_size
== 0 ? 30 : cmm_size
* 2;
1454 allocsize
= newsize
* sizeof *newmodes
;
1456 /* Use malloc here. See the comment above this function.
1457 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1459 newmodes
= (Lisp_Object
*) malloc (allocsize
);
1464 bcopy (cmm_modes
, newmodes
, cmm_size
* sizeof cmm_modes
[0]);
1467 cmm_modes
= newmodes
;
1470 newmaps
= (Lisp_Object
*) malloc (allocsize
);
1475 bcopy (cmm_maps
, newmaps
, cmm_size
* sizeof cmm_maps
[0]);
1482 if (newmodes
== NULL
|| newmaps
== NULL
)
1487 /* Get the keymap definition--or nil if it is not defined. */
1488 temp
= internal_condition_case_1 (Findirect_function
,
1490 Qerror
, current_minor_maps_error
);
1494 cmm_maps
[i
] = temp
;
1500 if (modeptr
) *modeptr
= cmm_modes
;
1501 if (mapptr
) *mapptr
= cmm_maps
;
1505 DEFUN ("current-active-maps", Fcurrent_active_maps
, Scurrent_active_maps
,
1507 doc
: /* Return a list of the currently active keymaps.
1508 OLP if non-nil indicates that we should obey `overriding-local-map' and
1509 `overriding-terminal-local-map'. */)
1513 Lisp_Object keymaps
= Fcons (current_global_map
, Qnil
);
1517 if (!NILP (Voverriding_local_map
))
1518 keymaps
= Fcons (Voverriding_local_map
, keymaps
);
1519 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1520 keymaps
= Fcons (current_kboard
->Voverriding_terminal_local_map
, keymaps
);
1522 if (NILP (XCDR (keymaps
)))
1528 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1530 keymaps
= Fcons (local
, keymaps
);
1532 nmaps
= current_minor_maps (0, &maps
);
1534 for (i
= --nmaps
; i
>= 0; i
--)
1535 if (!NILP (maps
[i
]))
1536 keymaps
= Fcons (maps
[i
], keymaps
);
1538 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1540 keymaps
= Fcons (local
, keymaps
);
1546 /* GC is possible in this function if it autoloads a keymap. */
1548 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 3, 0,
1549 doc
: /* Return the binding for command KEY in current keymaps.
1550 KEY is a string or vector, a sequence of keystrokes.
1551 The binding is probably a symbol with a function definition.
1553 Normally, `key-binding' ignores bindings for t, which act as default
1554 bindings, used when nothing else in the keymap applies; this makes it
1555 usable as a general function for probing keymaps. However, if the
1556 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1557 recognize the default bindings, just as `read-key-sequence' does.
1559 Like the normal command loop, `key-binding' will remap the command
1560 resulting from looking up KEY by looking up the command in the
1561 current keymaps. However, if the optional third argument NO-REMAP
1562 is non-nil, `key-binding' returns the unmapped command. */)
1563 (key
, accept_default
, no_remap
)
1564 Lisp_Object key
, accept_default
, no_remap
;
1566 Lisp_Object
*maps
, value
;
1568 struct gcpro gcpro1
;
1572 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1574 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1575 key
, accept_default
);
1576 if (! NILP (value
) && !INTEGERP (value
))
1579 else if (!NILP (Voverriding_local_map
))
1581 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1582 if (! NILP (value
) && !INTEGERP (value
))
1589 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1592 value
= Flookup_key (local
, key
, accept_default
);
1593 if (! NILP (value
) && !INTEGERP (value
))
1597 nmaps
= current_minor_maps (0, &maps
);
1598 /* Note that all these maps are GCPRO'd
1599 in the places where we found them. */
1601 for (i
= 0; i
< nmaps
; i
++)
1602 if (! NILP (maps
[i
]))
1604 value
= Flookup_key (maps
[i
], key
, accept_default
);
1605 if (! NILP (value
) && !INTEGERP (value
))
1609 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1612 value
= Flookup_key (local
, key
, accept_default
);
1613 if (! NILP (value
) && !INTEGERP (value
))
1618 value
= Flookup_key (current_global_map
, key
, accept_default
);
1622 if (NILP (value
) || INTEGERP (value
))
1625 /* If the result of the ordinary keymap lookup is an interactive
1626 command, look for a key binding (ie. remapping) for that command. */
1628 if (NILP (no_remap
) && SYMBOLP (value
))
1631 if (value1
= Fcommand_remapping (value
), !NILP (value1
))
1638 /* GC is possible in this function if it autoloads a keymap. */
1640 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1641 doc
: /* Return the binding for command KEYS in current local keymap only.
1642 KEYS is a string or vector, a sequence of keystrokes.
1643 The binding is probably a symbol with a function definition.
1645 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1646 bindings; see the description of `lookup-key' for more details about this. */)
1647 (keys
, accept_default
)
1648 Lisp_Object keys
, accept_default
;
1650 register Lisp_Object map
;
1651 map
= current_buffer
->keymap
;
1654 return Flookup_key (map
, keys
, accept_default
);
1657 /* GC is possible in this function if it autoloads a keymap. */
1659 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1660 doc
: /* Return the binding for command KEYS in current global keymap only.
1661 KEYS is a string or vector, a sequence of keystrokes.
1662 The binding is probably a symbol with a function definition.
1663 This function's return values are the same as those of `lookup-key'
1666 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1667 bindings; see the description of `lookup-key' for more details about this. */)
1668 (keys
, accept_default
)
1669 Lisp_Object keys
, accept_default
;
1671 return Flookup_key (current_global_map
, keys
, accept_default
);
1674 /* GC is possible in this function if it autoloads a keymap. */
1676 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1677 doc
: /* Find the visible minor mode bindings of KEY.
1678 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
1679 the symbol which names the minor mode binding KEY, and BINDING is
1680 KEY's definition in that mode. In particular, if KEY has no
1681 minor-mode bindings, return nil. If the first binding is a
1682 non-prefix, all subsequent bindings will be omitted, since they would
1683 be ignored. Similarly, the list doesn't include non-prefix bindings
1684 that come after prefix bindings.
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 (key
, accept_default
)
1689 Lisp_Object key
, accept_default
;
1691 Lisp_Object
*modes
, *maps
;
1693 Lisp_Object binding
;
1695 struct gcpro gcpro1
, gcpro2
;
1697 nmaps
= current_minor_maps (&modes
, &maps
);
1698 /* Note that all these maps are GCPRO'd
1699 in the places where we found them. */
1702 GCPRO2 (key
, binding
);
1704 for (i
= j
= 0; i
< nmaps
; i
++)
1706 && !NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1707 && !INTEGERP (binding
))
1709 if (KEYMAPP (binding
))
1710 maps
[j
++] = Fcons (modes
[i
], binding
);
1712 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1716 return Flist (j
, maps
);
1719 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1720 doc
: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1721 A new sparse keymap is stored as COMMAND's function definition and its value.
1722 If a second optional argument MAPVAR is given, the map is stored as
1723 its value instead of as COMMAND's value; but COMMAND is still defined
1725 The third optional argument NAME, if given, supplies a menu name
1726 string for the map. This is required to use the keymap as a menu.
1727 This function returns COMMAND. */)
1728 (command
, mapvar
, name
)
1729 Lisp_Object command
, mapvar
, name
;
1732 map
= Fmake_sparse_keymap (name
);
1733 Ffset (command
, map
);
1737 Fset (command
, map
);
1741 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1742 doc
: /* Select KEYMAP as the global keymap. */)
1746 keymap
= get_keymap (keymap
, 1, 1);
1747 current_global_map
= keymap
;
1752 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1753 doc
: /* Select KEYMAP as the local keymap.
1754 If KEYMAP is nil, that means no local keymap. */)
1759 keymap
= get_keymap (keymap
, 1, 1);
1761 current_buffer
->keymap
= keymap
;
1766 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1767 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1770 return current_buffer
->keymap
;
1773 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1774 doc
: /* Return the current global keymap. */)
1777 return current_global_map
;
1780 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1781 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1785 int nmaps
= current_minor_maps (0, &maps
);
1787 return Flist (nmaps
, maps
);
1790 /* Help functions for describing and documenting keymaps. */
1794 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1795 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1796 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1800 cmd
= get_keymap (get_keyelt (cmd
, 0), 0, 0);
1804 /* Look for and break cycles. */
1805 while (!NILP (tem
= Frassq (cmd
, maps
)))
1807 Lisp_Object prefix
= XCAR (tem
);
1808 int lim
= XINT (Flength (XCAR (tem
)));
1809 if (lim
<= XINT (Flength (thisseq
)))
1810 { /* This keymap was already seen with a smaller prefix. */
1812 while (i
< lim
&& EQ (Faref (prefix
, make_number (i
)),
1813 Faref (thisseq
, make_number (i
))))
1816 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1819 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1820 but maybe `cmd' occurs again further down in `maps', so keep
1822 maps
= XCDR (Fmemq (tem
, maps
));
1825 /* If the last key in thisseq is meta-prefix-char,
1826 turn it into a meta-ized keystroke. We know
1827 that the event we're about to append is an
1828 ascii keystroke since we're processing a
1832 int meta_bit
= meta_modifier
;
1833 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1834 tem
= Fcopy_sequence (thisseq
);
1836 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1838 /* This new sequence is the same length as
1839 thisseq, so stick it in the list right
1842 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1846 tem
= append_key (thisseq
, key
);
1847 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1852 accessible_keymaps_char_table (args
, index
, cmd
)
1853 Lisp_Object args
, index
, cmd
;
1855 accessible_keymaps_1 (index
, cmd
,
1859 XINT (XCDR (XCAR (args
))));
1862 /* This function cannot GC. */
1864 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1866 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1867 Returns a list of elements of the form (KEYS . MAP), where the sequence
1868 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1869 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1870 An optional argument PREFIX, if non-nil, should be a key sequence;
1871 then the value includes only maps for prefixes that start with PREFIX. */)
1873 Lisp_Object keymap
, prefix
;
1875 Lisp_Object maps
, tail
;
1878 /* no need for gcpro because we don't autoload any keymaps. */
1881 prefixlen
= XINT (Flength (prefix
));
1885 /* If a prefix was specified, start with the keymap (if any) for
1886 that prefix, so we don't waste time considering other prefixes. */
1888 tem
= Flookup_key (keymap
, prefix
, Qt
);
1889 /* Flookup_key may give us nil, or a number,
1890 if the prefix is not defined in this particular map.
1891 It might even give us a list that isn't a keymap. */
1892 tem
= get_keymap (tem
, 0, 0);
1895 /* Convert PREFIX to a vector now, so that later on
1896 we don't have to deal with the possibility of a string. */
1897 if (STRINGP (prefix
))
1902 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1903 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1907 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1908 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1909 c
^= 0200 | meta_modifier
;
1910 ASET (copy
, i_before
, make_number (c
));
1914 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1920 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1921 get_keymap (keymap
, 1, 0)),
1924 /* For each map in the list maps,
1925 look at any other maps it points to,
1926 and stick them at the end if they are not already in the list.
1928 This is a breadth-first traversal, where tail is the queue of
1929 nodes, and maps accumulates a list of all nodes visited. */
1931 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1933 register Lisp_Object thisseq
, thismap
;
1935 /* Does the current sequence end in the meta-prefix-char? */
1938 thisseq
= Fcar (Fcar (tail
));
1939 thismap
= Fcdr (Fcar (tail
));
1940 last
= make_number (XINT (Flength (thisseq
)) - 1);
1941 is_metized
= (XINT (last
) >= 0
1942 /* Don't metize the last char of PREFIX. */
1943 && XINT (last
) >= prefixlen
1944 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1946 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1950 elt
= XCAR (thismap
);
1954 if (CHAR_TABLE_P (elt
))
1956 map_char_table (accessible_keymaps_char_table
, Qnil
,
1957 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1958 Fcons (tail
, thisseq
)));
1960 else if (VECTORP (elt
))
1964 /* Vector keymap. Scan all the elements. */
1965 for (i
= 0; i
< ASIZE (elt
); i
++)
1966 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1967 maps
, tail
, thisseq
, is_metized
);
1970 else if (CONSP (elt
))
1971 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1972 maps
, tail
, thisseq
,
1973 is_metized
&& INTEGERP (XCAR (elt
)));
1981 Lisp_Object Qsingle_key_description
, Qkey_description
;
1983 /* This function cannot GC. */
1985 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 2, 0,
1986 doc
: /* Return a pretty description of key-sequence KEYS.
1987 Optional arg PREFIX is the sequence of keys leading up to KEYS.
1988 Control characters turn into "C-foo" sequences, meta into "M-foo",
1989 spaces are put between sequence elements, etc. */)
1991 Lisp_Object keys
, prefix
;
1996 int size
= XINT (Flength (keys
));
1998 Lisp_Object sep
= build_string (" ");
2003 size
+= XINT (Flength (prefix
));
2005 /* This has one extra element at the end that we don't pass to Fconcat. */
2006 args
= (Lisp_Object
*) alloca (size
* 4 * sizeof (Lisp_Object
));
2008 /* In effect, this computes
2009 (mapconcat 'single-key-description keys " ")
2010 but we shouldn't use mapconcat because it can do GC. */
2014 list
= prefix
, prefix
= Qnil
;
2015 else if (!NILP (keys
))
2016 list
= keys
, keys
= Qnil
;
2021 args
[len
] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2025 return empty_string
;
2026 return Fconcat (len
- 1, args
);
2030 size
= SCHARS (list
);
2031 else if (VECTORP (list
))
2032 size
= XVECTOR (list
)->size
;
2033 else if (CONSP (list
))
2034 size
= XINT (Flength (list
));
2036 wrong_type_argument (Qarrayp
, list
);
2045 FETCH_STRING_CHAR_ADVANCE (c
, list
, i
, i_byte
);
2046 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
2047 c
^= 0200 | meta_modifier
;
2048 XSETFASTINT (key
, c
);
2050 else if (VECTORP (list
))
2052 key
= AREF (list
, i
++);
2064 || EQ (key
, meta_prefix_char
)
2065 || (XINT (key
) & meta_modifier
))
2067 args
[len
++] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2069 if (EQ (key
, meta_prefix_char
))
2073 XSETINT (key
, (XINT (key
) | meta_modifier
) & ~0x80);
2076 else if (EQ (key
, meta_prefix_char
))
2081 args
[len
++] = Fsingle_key_description (key
, Qnil
);
2089 push_key_description (c
, p
, force_multibyte
)
2090 register unsigned int c
;
2092 int force_multibyte
;
2096 /* Clear all the meaningless bits above the meta bit. */
2097 c
&= meta_modifier
| ~ - meta_modifier
;
2098 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
2099 | meta_modifier
| shift_modifier
| super_modifier
);
2101 if (c
& alt_modifier
)
2107 if ((c
& ctrl_modifier
) != 0
2108 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
2112 c
&= ~ctrl_modifier
;
2114 if (c
& hyper_modifier
)
2118 c
-= hyper_modifier
;
2120 if (c
& meta_modifier
)
2126 if (c
& shift_modifier
)
2130 c
-= shift_modifier
;
2132 if (c
& super_modifier
)
2136 c
-= super_modifier
;
2152 else if (c
== Ctl ('M'))
2160 /* `C-' already added above. */
2161 if (c
> 0 && c
<= Ctl ('Z'))
2180 || (NILP (current_buffer
->enable_multibyte_characters
)
2181 && SINGLE_BYTE_CHAR_P (c
)
2182 && !force_multibyte
))
2186 else if (CHARACTERP (make_number (c
)))
2188 if (NILP (current_buffer
->enable_multibyte_characters
)
2189 && ! force_multibyte
)
2190 *p
++ = multibyte_char_to_unibyte (c
, Qnil
);
2192 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2198 /* The biggest character code uses 22 bits. */
2199 for (bit_offset
= 21; bit_offset
>= 0; bit_offset
-= 3)
2201 if (c
>= (1 << bit_offset
))
2202 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2209 /* This function cannot GC. */
2211 DEFUN ("single-key-description", Fsingle_key_description
,
2212 Ssingle_key_description
, 1, 2, 0,
2213 doc
: /* Return a pretty description of command character KEY.
2214 Control characters turn into C-whatever, etc.
2215 Optional argument NO-ANGLES non-nil means don't put angle brackets
2216 around function keys and event symbols. */)
2218 Lisp_Object key
, no_angles
;
2220 if (CONSP (key
) && lucid_event_type_list_p (key
))
2221 key
= Fevent_convert_list (key
);
2223 key
= EVENT_HEAD (key
);
2225 if (INTEGERP (key
)) /* Normal character */
2227 char tem
[KEY_DESCRIPTION_SIZE
];
2229 *push_key_description (XUINT (key
), tem
, 1) = 0;
2230 return build_string (tem
);
2232 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2234 if (NILP (no_angles
))
2237 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2238 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2239 return build_string (buffer
);
2242 return Fsymbol_name (key
);
2244 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2245 return Fcopy_sequence (key
);
2247 error ("KEY must be an integer, cons, symbol, or string");
2252 push_text_char_description (c
, p
)
2253 register unsigned int c
;
2265 *p
++ = c
+ 64; /* 'A' - 1 */
2277 /* This function cannot GC. */
2279 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2280 doc
: /* Return a pretty description of file-character CHARACTER.
2281 Control characters turn into "^char", etc. This differs from
2282 `single-key-description' which turns them into "C-char".
2283 Also, this function recognizes the 2**7 bit as the Meta character,
2284 whereas `single-key-description' uses the 2**27 bit for Meta.
2285 See Info node `(elisp)Describing Characters' for examples. */)
2287 Lisp_Object character
;
2289 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2290 unsigned char str
[6];
2293 CHECK_NUMBER (character
);
2295 c
= XINT (character
);
2296 if (!ASCII_CHAR_P (c
))
2298 int len
= CHAR_STRING (c
, str
);
2300 return make_multibyte_string (str
, 1, len
);
2303 *push_text_char_description (c
& 0377, str
) = 0;
2305 return build_string (str
);
2308 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2311 ascii_sequence_p (seq
)
2315 int len
= XINT (Flength (seq
));
2317 for (i
= 0; i
< len
; i
++)
2319 Lisp_Object ii
, elt
;
2321 XSETFASTINT (ii
, i
);
2322 elt
= Faref (seq
, ii
);
2325 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2333 /* where-is - finding a command in a set of keymaps. */
2335 static Lisp_Object
where_is_internal ();
2336 static Lisp_Object
where_is_internal_1 ();
2337 static void where_is_internal_2 ();
2339 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2340 Returns the first non-nil binding found in any of those maps. */
2343 shadow_lookup (shadow
, key
, flag
)
2344 Lisp_Object shadow
, key
, flag
;
2346 Lisp_Object tail
, value
;
2348 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2350 value
= Flookup_key (XCAR (tail
), key
, flag
);
2351 if (!NILP (value
) && !NATNUMP (value
))
2357 static Lisp_Object Vmouse_events
;
2359 /* This function can GC if Flookup_key autoloads any keymaps. */
2362 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2363 Lisp_Object definition
, keymaps
;
2364 Lisp_Object firstonly
, noindirect
, no_remap
;
2366 Lisp_Object maps
= Qnil
;
2367 Lisp_Object found
, sequences
;
2368 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2369 /* 1 means ignore all menu bindings entirely. */
2370 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2372 /* If this command is remapped, then it has no key bindings
2374 if (NILP (no_remap
) && SYMBOLP (definition
))
2377 if (tem
= Fcommand_remapping (definition
), !NILP (tem
))
2382 while (CONSP (found
))
2386 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2387 found
= XCDR (found
);
2390 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2394 for (; !NILP (maps
); maps
= Fcdr (maps
))
2396 /* Key sequence to reach map, and the map that it reaches */
2397 register Lisp_Object
this, map
, tem
;
2399 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2400 [M-CHAR] sequences, check if last character of the sequence
2401 is the meta-prefix char. */
2405 this = Fcar (Fcar (maps
));
2406 map
= Fcdr (Fcar (maps
));
2407 last
= make_number (XINT (Flength (this)) - 1);
2408 last_is_meta
= (XINT (last
) >= 0
2409 && EQ (Faref (this, last
), meta_prefix_char
));
2411 /* if (nomenus && !ascii_sequence_p (this)) */
2412 if (nomenus
&& XINT (last
) >= 0
2413 && SYMBOLP (tem
= Faref (this, make_number (0)))
2414 && !NILP (Fmemq (XCAR (parse_modifiers (tem
)), Vmouse_events
)))
2415 /* If no menu entries should be returned, skip over the
2416 keymaps bound to `menu-bar' and `tool-bar' and other
2417 non-ascii prefixes like `C-down-mouse-2'. */
2424 /* Because the code we want to run on each binding is rather
2425 large, we don't want to have two separate loop bodies for
2426 sparse keymap bindings and tables; we want to iterate one
2427 loop body over both keymap and vector bindings.
2429 For this reason, if Fcar (map) is a vector, we don't
2430 advance map to the next element until i indicates that we
2431 have finished off the vector. */
2432 Lisp_Object elt
, key
, binding
;
2440 /* Set key and binding to the current key and binding, and
2441 advance map and i to the next binding. */
2444 Lisp_Object sequence
;
2446 /* In a vector, look at each element. */
2447 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2449 binding
= AREF (elt
, i
);
2450 XSETFASTINT (key
, i
);
2451 sequence
= where_is_internal_1 (binding
, key
, definition
,
2453 last
, nomenus
, last_is_meta
);
2454 if (!NILP (sequence
))
2455 sequences
= Fcons (sequence
, sequences
);
2458 else if (CHAR_TABLE_P (elt
))
2462 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2463 Qnil
), /* Result accumulator. */
2464 Fcons (Fcons (this, last
),
2465 Fcons (make_number (nomenus
),
2466 make_number (last_is_meta
))));
2467 map_char_table (where_is_internal_2
, Qnil
, elt
, args
);
2468 sequences
= XCDR (XCAR (args
));
2470 else if (CONSP (elt
))
2472 Lisp_Object sequence
;
2475 binding
= XCDR (elt
);
2477 sequence
= where_is_internal_1 (binding
, key
, definition
,
2479 last
, nomenus
, last_is_meta
);
2480 if (!NILP (sequence
))
2481 sequences
= Fcons (sequence
, sequences
);
2485 while (!NILP (sequences
))
2487 Lisp_Object sequence
, remapped
, function
;
2489 sequence
= XCAR (sequences
);
2490 sequences
= XCDR (sequences
);
2492 /* If the current sequence is a command remapping with
2493 format [remap COMMAND], find the key sequences
2494 which run COMMAND, and use those sequences instead. */
2497 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2498 && EQ (AREF (sequence
, 0), Qremap
)
2499 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2501 Lisp_Object remapped1
;
2503 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2504 if (CONSP (remapped1
))
2506 /* Verify that this key binding actually maps to the
2507 remapped command (see below). */
2508 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2510 sequence
= XCAR (remapped1
);
2511 remapped
= XCDR (remapped1
);
2512 goto record_sequence
;
2516 /* Verify that this key binding is not shadowed by another
2517 binding for the same key, before we say it exists.
2519 Mechanism: look for local definition of this key and if
2520 it is defined and does not match what we found then
2523 Either nil or number as value from Flookup_key
2525 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2529 /* It is a true unshadowed match. Record it, unless it's already
2530 been seen (as could happen when inheriting keymaps). */
2531 if (NILP (Fmember (sequence
, found
)))
2532 found
= Fcons (sequence
, found
);
2534 /* If firstonly is Qnon_ascii, then we can return the first
2535 binding we find. If firstonly is not Qnon_ascii but not
2536 nil, then we should return the first ascii-only binding
2538 if (EQ (firstonly
, Qnon_ascii
))
2539 RETURN_UNGCPRO (sequence
);
2540 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2541 RETURN_UNGCPRO (sequence
);
2543 if (CONSP (remapped
))
2545 sequence
= XCAR (remapped
);
2546 remapped
= XCDR (remapped
);
2547 goto record_sequence
;
2555 found
= Fnreverse (found
);
2557 /* firstonly may have been t, but we may have gone all the way through
2558 the keymaps without finding an all-ASCII key sequence. So just
2559 return the best we could find. */
2560 if (!NILP (firstonly
))
2561 return Fcar (found
);
2566 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2567 doc
: /* Return list of keys that invoke DEFINITION.
2568 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2569 If KEYMAP is nil, search all the currently active keymaps.
2570 If KEYMAP is a list of keymaps, search only those keymaps.
2572 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2573 rather than a list of all possible key sequences.
2574 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2575 no matter what it is.
2576 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2577 \(or their meta variants) and entirely reject menu bindings.
2579 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2580 to other keymaps or slots. This makes it possible to search for an
2581 indirect definition itself.
2583 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2584 that invoke a command which is remapped to DEFINITION, but include the
2585 remapped command in the returned list. */)
2586 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2587 Lisp_Object definition
, keymap
;
2588 Lisp_Object firstonly
, noindirect
, no_remap
;
2590 Lisp_Object sequences
, keymaps
;
2591 /* 1 means ignore all menu bindings entirely. */
2592 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2595 /* Find the relevant keymaps. */
2596 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2598 else if (!NILP (keymap
))
2599 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2601 keymaps
= Fcurrent_active_maps (Qnil
);
2603 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2604 We don't really need to check `keymap'. */
2605 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2609 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2611 /* Check heuristic-consistency of the cache. */
2612 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2613 where_is_cache
= Qnil
;
2615 if (NILP (where_is_cache
))
2617 /* We need to create the cache. */
2618 Lisp_Object args
[2];
2619 where_is_cache
= Fmake_hash_table (0, args
);
2620 where_is_cache_keymaps
= Qt
;
2622 /* Fill in the cache. */
2623 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2624 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2627 where_is_cache_keymaps
= keymaps
;
2630 /* We want to process definitions from the last to the first.
2631 Instead of consing, copy definitions to a vector and step
2632 over that vector. */
2633 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2634 n
= XINT (Flength (sequences
));
2635 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2636 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2637 defns
[i
++] = XCAR (sequences
);
2639 /* Verify that the key bindings are not shadowed. Note that
2640 the following can GC. */
2641 GCPRO2 (definition
, keymaps
);
2644 for (i
= n
- 1; i
>= 0; --i
)
2645 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2647 if (ascii_sequence_p (defns
[i
]))
2653 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2658 /* Kill the cache so that where_is_internal_1 doesn't think
2659 we're filling it up. */
2660 where_is_cache
= Qnil
;
2661 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2667 /* This is the function that Fwhere_is_internal calls using map_char_table.
2669 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2671 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2672 Since map_char_table doesn't really use the return value from this function,
2673 we the result append to RESULT, the slot in ARGS.
2675 This function can GC because it calls where_is_internal_1 which can
2679 where_is_internal_2 (args
, key
, binding
)
2680 Lisp_Object args
, key
, binding
;
2682 Lisp_Object definition
, noindirect
, this, last
;
2683 Lisp_Object result
, sequence
;
2684 int nomenus
, last_is_meta
;
2685 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2687 GCPRO3 (args
, key
, binding
);
2688 result
= XCDR (XCAR (args
));
2689 definition
= XCAR (XCAR (XCAR (args
)));
2690 noindirect
= XCDR (XCAR (XCAR (args
)));
2691 this = XCAR (XCAR (XCDR (args
)));
2692 last
= XCDR (XCAR (XCDR (args
)));
2693 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2694 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2696 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2697 this, last
, nomenus
, last_is_meta
);
2699 if (!NILP (sequence
))
2700 XSETCDR (XCAR (args
), Fcons (sequence
, result
));
2706 /* This function cannot GC. */
2709 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2710 nomenus
, last_is_meta
)
2711 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2712 int nomenus
, last_is_meta
;
2714 Lisp_Object sequence
;
2716 /* Search through indirections unless that's not wanted. */
2717 if (NILP (noindirect
))
2718 binding
= get_keyelt (binding
, 0);
2720 /* End this iteration if this element does not match
2723 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2724 || EQ (binding
, definition
)
2725 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2726 /* Doesn't match. */
2729 /* We have found a match. Construct the key sequence where we found it. */
2730 if (INTEGERP (key
) && last_is_meta
)
2732 sequence
= Fcopy_sequence (this);
2733 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2736 sequence
= append_key (this, key
);
2738 if (!NILP (where_is_cache
))
2740 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2741 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2748 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2750 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2751 doc
: /* Insert the list of all defined keys and their definitions.
2752 The list is inserted in the current buffer, while the bindings are
2753 looked up in BUFFER.
2754 The optional argument PREFIX, if non-nil, should be a key sequence;
2755 then we display only bindings that start with that prefix.
2756 The optional argument MENUS, if non-nil, says to mention menu bindings.
2757 \(Ordinarily these are omitted from the output.) */)
2758 (buffer
, prefix
, menus
)
2759 Lisp_Object buffer
, prefix
, menus
;
2761 Lisp_Object outbuf
, shadow
;
2762 int nomenu
= NILP (menus
);
2763 register Lisp_Object start1
;
2764 struct gcpro gcpro1
;
2766 char *alternate_heading
2768 Keyboard translations:\n\n\
2769 You type Translation\n\
2770 -------- -----------\n";
2775 outbuf
= Fcurrent_buffer ();
2777 /* Report on alternates for keys. */
2778 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2781 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2782 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2784 for (c
= 0; c
< translate_len
; c
++)
2785 if (translate
[c
] != c
)
2787 char buf
[KEY_DESCRIPTION_SIZE
];
2790 if (alternate_heading
)
2792 insert_string (alternate_heading
);
2793 alternate_heading
= 0;
2796 bufend
= push_key_description (translate
[c
], buf
, 1);
2797 insert (buf
, bufend
- buf
);
2798 Findent_to (make_number (16), make_number (1));
2799 bufend
= push_key_description (c
, buf
, 1);
2800 insert (buf
, bufend
- buf
);
2808 if (!NILP (Vkey_translation_map
))
2809 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2810 "Key translations", nomenu
, 1, 0);
2813 /* Print the (major mode) local map. */
2815 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2816 start1
= current_kboard
->Voverriding_terminal_local_map
;
2817 else if (!NILP (Voverriding_local_map
))
2818 start1
= Voverriding_local_map
;
2822 describe_map_tree (start1
, 1, shadow
, prefix
,
2823 "\f\nOverriding Bindings", nomenu
, 0, 0);
2824 shadow
= Fcons (start1
, shadow
);
2828 /* Print the minor mode and major mode keymaps. */
2830 Lisp_Object
*modes
, *maps
;
2832 /* Temporarily switch to `buffer', so that we can get that buffer's
2833 minor modes correctly. */
2834 Fset_buffer (buffer
);
2836 nmaps
= current_minor_maps (&modes
, &maps
);
2837 Fset_buffer (outbuf
);
2839 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2840 XBUFFER (buffer
), Qkeymap
);
2843 describe_map_tree (start1
, 1, shadow
, prefix
,
2844 "\f\n`keymap' Property Bindings", nomenu
, 0, 0);
2845 shadow
= Fcons (start1
, shadow
);
2848 /* Print the minor mode maps. */
2849 for (i
= 0; i
< nmaps
; i
++)
2851 /* The title for a minor mode keymap
2852 is constructed at run time.
2853 We let describe_map_tree do the actual insertion
2854 because it takes care of other features when doing so. */
2857 if (!SYMBOLP (modes
[i
]))
2860 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2864 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2865 SCHARS (SYMBOL_NAME (modes
[i
])));
2866 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2868 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2869 p
+= sizeof (" Minor Mode Bindings") - 1;
2872 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2873 shadow
= Fcons (maps
[i
], shadow
);
2876 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2877 XBUFFER (buffer
), Qlocal_map
);
2880 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2881 describe_map_tree (start1
, 1, shadow
, prefix
,
2882 "\f\nMajor Mode Bindings", nomenu
, 0, 0);
2884 describe_map_tree (start1
, 1, shadow
, prefix
,
2885 "\f\n`local-map' Property Bindings",
2888 shadow
= Fcons (start1
, shadow
);
2892 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2893 "\f\nGlobal Bindings", nomenu
, 0, 1);
2895 /* Print the function-key-map translations under this prefix. */
2896 if (!NILP (Vfunction_key_map
))
2897 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2898 "\f\nFunction key map translations", nomenu
, 1, 0);
2904 /* Insert a description of the key bindings in STARTMAP,
2905 followed by those of all maps reachable through STARTMAP.
2906 If PARTIAL is nonzero, omit certain "uninteresting" commands
2907 (such as `undefined').
2908 If SHADOW is non-nil, it is a list of maps;
2909 don't mention keys which would be shadowed by any of them.
2910 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2911 TITLE, if not 0, is a string to insert at the beginning.
2912 TITLE should not end with a colon or a newline; we supply that.
2913 If NOMENU is not 0, then omit menu-bar commands.
2915 If TRANSL is nonzero, the definitions are actually key translations
2916 so print strings and vectors differently.
2918 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2922 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2924 Lisp_Object startmap
, shadow
, prefix
;
2931 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2932 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2939 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2942 GCPRO3 (maps
, seen
, sub_shadows
);
2948 /* Delete from MAPS each element that is for the menu bar. */
2949 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2951 Lisp_Object elt
, prefix
, tem
;
2954 prefix
= Fcar (elt
);
2955 if (XVECTOR (prefix
)->size
>= 1)
2957 tem
= Faref (prefix
, make_number (0));
2958 if (EQ (tem
, Qmenu_bar
))
2959 maps
= Fdelq (elt
, maps
);
2964 if (!NILP (maps
) || always_title
)
2968 insert_string (title
);
2971 insert_string (" Starting With ");
2972 insert1 (Fkey_description (prefix
, Qnil
));
2974 insert_string (":\n");
2976 insert_string (key_heading
);
2980 for (; !NILP (maps
); maps
= Fcdr (maps
))
2982 register Lisp_Object elt
, prefix
, tail
;
2985 prefix
= Fcar (elt
);
2989 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2993 shmap
= XCAR (tail
);
2995 /* If the sequence by which we reach this keymap is zero-length,
2996 then the shadow map for this keymap is just SHADOW. */
2997 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
2998 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
3000 /* If the sequence by which we reach this keymap actually has
3001 some elements, then the sequence's definition in SHADOW is
3002 what we should use. */
3005 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
3006 if (INTEGERP (shmap
))
3010 /* If shmap is not nil and not a keymap,
3011 it completely shadows this map, so don't
3012 describe this map at all. */
3013 if (!NILP (shmap
) && !KEYMAPP (shmap
))
3017 sub_shadows
= Fcons (shmap
, sub_shadows
);
3020 /* Maps we have already listed in this loop shadow this map. */
3021 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
3024 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
3026 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
3029 describe_map (Fcdr (elt
), prefix
,
3030 transl
? describe_translation
: describe_command
,
3031 partial
, sub_shadows
, &seen
, nomenu
);
3037 insert_string ("\n");
3042 static int previous_description_column
;
3045 describe_command (definition
, args
)
3046 Lisp_Object definition
, args
;
3048 register Lisp_Object tem1
;
3049 int column
= (int) current_column (); /* iftc */
3050 int description_column
;
3052 /* If column 16 is no good, go to col 32;
3053 but don't push beyond that--go to next line instead. */
3057 description_column
= 32;
3059 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
3060 description_column
= 32;
3062 description_column
= 16;
3064 Findent_to (make_number (description_column
), make_number (1));
3065 previous_description_column
= description_column
;
3067 if (SYMBOLP (definition
))
3069 tem1
= SYMBOL_NAME (definition
);
3071 insert_string ("\n");
3073 else if (STRINGP (definition
) || VECTORP (definition
))
3074 insert_string ("Keyboard Macro\n");
3075 else if (KEYMAPP (definition
))
3076 insert_string ("Prefix Command\n");
3078 insert_string ("??\n");
3082 describe_translation (definition
, args
)
3083 Lisp_Object definition
, args
;
3085 register Lisp_Object tem1
;
3087 Findent_to (make_number (16), make_number (1));
3089 if (SYMBOLP (definition
))
3091 tem1
= SYMBOL_NAME (definition
);
3093 insert_string ("\n");
3095 else if (STRINGP (definition
) || VECTORP (definition
))
3097 insert1 (Fkey_description (definition
, Qnil
));
3098 insert_string ("\n");
3100 else if (KEYMAPP (definition
))
3101 insert_string ("Prefix Command\n");
3103 insert_string ("??\n");
3106 /* Describe the contents of map MAP, assuming that this map itself is
3107 reached by the sequence of prefix keys PREFIX (a string or vector).
3108 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3111 describe_map (map
, prefix
, elt_describer
, partial
, shadow
, seen
, nomenu
)
3112 register Lisp_Object map
;
3114 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3120 Lisp_Object tail
, definition
, event
;
3122 Lisp_Object suppress
;
3125 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3130 suppress
= intern ("suppress-keymap");
3132 /* This vector gets used to present single keys to Flookup_key. Since
3133 that is done once per keymap element, we don't want to cons up a
3134 fresh vector every time. */
3135 kludge
= Fmake_vector (make_number (1), Qnil
);
3138 GCPRO3 (prefix
, definition
, kludge
);
3140 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3144 if (VECTORP (XCAR (tail
))
3145 || CHAR_TABLE_P (XCAR (tail
)))
3146 describe_vector (XCAR (tail
),
3147 prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3149 else if (CONSP (XCAR (tail
)))
3151 event
= XCAR (XCAR (tail
));
3153 /* Ignore bindings whose "prefix" are not really valid events.
3154 (We get these in the frames and buffers menu.) */
3155 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3158 if (nomenu
&& EQ (event
, Qmenu_bar
))
3161 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3163 /* Don't show undefined commands or suppressed commands. */
3164 if (NILP (definition
)) continue;
3165 if (SYMBOLP (definition
) && partial
)
3167 tem
= Fget (definition
, suppress
);
3172 /* Don't show a command that isn't really visible
3173 because a local definition of the same key shadows it. */
3175 ASET (kludge
, 0, event
);
3178 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3179 if (!NILP (tem
)) continue;
3182 tem
= Flookup_key (map
, kludge
, Qt
);
3183 if (!EQ (tem
, definition
)) continue;
3187 previous_description_column
= 0;
3192 /* THIS gets the string to describe the character EVENT. */
3193 insert1 (Fkey_description (kludge
, prefix
));
3195 /* Print a description of the definition of this character.
3196 elt_describer will take care of spacing out far enough
3197 for alignment purposes. */
3198 (*elt_describer
) (definition
, Qnil
);
3200 else if (EQ (XCAR (tail
), Qkeymap
))
3202 /* The same keymap might be in the structure twice, if we're
3203 using an inherited keymap. So skip anything we've already
3205 tem
= Fassq (tail
, *seen
);
3206 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), prefix
)))
3208 *seen
= Fcons (Fcons (tail
, prefix
), *seen
);
3216 describe_vector_princ (elt
, fun
)
3217 Lisp_Object elt
, fun
;
3219 Findent_to (make_number (16), make_number (1));
3224 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3225 doc
: /* Insert a description of contents of VECTOR.
3226 This is text showing the elements of vector matched against indices.
3227 DESCRIBER is the output function used; nil means use `princ'. */)
3229 Lisp_Object vector
, describer
;
3231 int count
= SPECPDL_INDEX ();
3232 if (NILP (describer
))
3233 describer
= intern ("princ");
3234 specbind (Qstandard_output
, Fcurrent_buffer ());
3235 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3236 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3237 Qnil
, Qnil
, (int *)0, 0, 0);
3239 return unbind_to (count
, Qnil
);
3242 /* Insert in the current buffer a description of the contents of VECTOR.
3243 We call ELT_DESCRIBER to insert the description of one value found
3246 ELT_PREFIX describes what "comes before" the keys or indices defined
3247 by this vector. This is a human-readable string whose size
3248 is not necessarily related to the situation.
3250 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3251 leads to this keymap.
3253 If the vector is a chartable, ELT_PREFIX is the vector
3254 of bytes that lead to the character set or portion of a character
3255 set described by this chartable.
3257 If PARTIAL is nonzero, it means do not mention suppressed commands
3258 (that assumes the vector is in a keymap).
3260 SHADOW is a list of keymaps that shadow this map.
3261 If it is non-nil, then we look up the key in those maps
3262 and we don't mention it now if it is defined by any of them.
3264 ENTIRE_MAP is the keymap in which this vector appears.
3265 If the definition in effect in the whole map does not match
3266 the one in this vector, we ignore this one.
3268 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3270 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3273 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3275 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3278 describe_vector (vector
, prefix
, args
, elt_describer
,
3279 partial
, shadow
, entire_map
,
3280 indices
, char_table_depth
, keymap_p
)
3281 register Lisp_Object vector
;
3282 Lisp_Object prefix
, args
;
3283 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3286 Lisp_Object entire_map
;
3288 int char_table_depth
;
3291 Lisp_Object definition
;
3293 Lisp_Object elt_prefix
= Qnil
;
3295 Lisp_Object suppress
;
3298 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3299 /* Range of elements to be handled. */
3301 Lisp_Object character
;
3310 /* Call Fkey_description first, to avoid GC bug for the other string. */
3311 if (!NILP (prefix
) && XFASTINT (Flength (prefix
)) > 0)
3314 tem
= Fkey_description (prefix
, Qnil
);
3315 elt_prefix
= concat2 (tem
, build_string (" "));
3320 /* This vector gets used to present single keys to Flookup_key. Since
3321 that is done once per vector element, we don't want to cons up a
3322 fresh vector every time. */
3323 kludge
= Fmake_vector (make_number (1), Qnil
);
3324 GCPRO4 (elt_prefix
, prefix
, definition
, kludge
);
3327 suppress
= intern ("suppress-keymap");
3330 to
= CHAR_TABLE_P (vector
) ? MAX_CHAR
+ 1 : XVECTOR (vector
)->size
;
3332 for (i
= from
; i
< to
; i
++)
3334 int range_beg
, range_end
;
3341 if (CHAR_TABLE_P (vector
))
3342 val
= char_table_ref_and_range (vector
, i
, &range_beg
, &i
);
3344 val
= AREF (vector
, i
);
3345 definition
= get_keyelt (val
, 0);
3347 if (NILP (definition
)) continue;
3349 /* Don't mention suppressed commands. */
3350 if (SYMBOLP (definition
) && partial
)
3354 tem
= Fget (definition
, suppress
);
3356 if (!NILP (tem
)) continue;
3359 character
= make_number (starting_i
);
3360 ASET (kludge
, 0, character
);
3362 /* If this binding is shadowed by some other map, ignore it. */
3367 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3369 if (!NILP (tem
)) continue;
3372 /* Ignore this definition if it is shadowed by an earlier
3373 one in the same keymap. */
3374 if (!NILP (entire_map
))
3378 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3380 if (!EQ (tem
, definition
))
3390 /* Output the prefix that applies to every entry in this map. */
3391 if (!NILP (elt_prefix
))
3392 insert1 (elt_prefix
);
3394 insert1 (Fkey_description (kludge
, prefix
));
3396 /* Find all consecutive characters or rows that have the same
3397 definition. But, for elements of a top level char table, if
3398 they are for charsets, we had better describe one by one even
3399 if they have the same definition. */
3400 if (CHAR_TABLE_P (vector
))
3402 && (val
= char_table_ref_and_range (vector
, i
+ 1,
3403 &range_beg
, &range_end
),
3404 tem2
= get_keyelt (val
, 0),
3406 && !NILP (Fequal (tem2
, definition
)))
3410 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3412 && !NILP (Fequal (tem2
, definition
)))
3415 /* If we have a range of more than one character,
3416 print where the range reaches to. */
3418 if (i
!= starting_i
)
3422 ASET (kludge
, 0, make_number (i
));
3424 if (!NILP (elt_prefix
))
3425 insert1 (elt_prefix
);
3427 insert1 (Fkey_description (kludge
, prefix
));
3430 /* Print a description of the definition of this character.
3431 elt_describer will take care of spacing out far enough
3432 for alignment purposes. */
3433 (*elt_describer
) (definition
, args
);
3436 if (CHAR_TABLE_P (vector
) && ! NILP (XCHAR_TABLE (vector
)->defalt
))
3438 if (!NILP (elt_prefix
))
3439 insert1 (elt_prefix
);
3440 insert ("default", 7);
3441 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3447 /* Apropos - finding all symbols whose names match a regexp. */
3448 static Lisp_Object apropos_predicate
;
3449 static Lisp_Object apropos_accumulate
;
3452 apropos_accum (symbol
, string
)
3453 Lisp_Object symbol
, string
;
3455 register Lisp_Object tem
;
3457 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3458 if (!NILP (tem
) && !NILP (apropos_predicate
))
3459 tem
= call1 (apropos_predicate
, symbol
);
3461 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3464 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3465 doc
: /* Show all symbols whose names contain match for REGEXP.
3466 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3467 for each symbol and a symbol is mentioned only if that returns non-nil.
3468 Return list of symbols found. */)
3470 Lisp_Object regexp
, predicate
;
3473 CHECK_STRING (regexp
);
3474 apropos_predicate
= predicate
;
3475 apropos_accumulate
= Qnil
;
3476 map_obarray (Vobarray
, apropos_accum
, regexp
);
3477 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3478 apropos_accumulate
= Qnil
;
3479 apropos_predicate
= Qnil
;
3486 Qkeymap
= intern ("keymap");
3487 staticpro (&Qkeymap
);
3488 staticpro (&apropos_predicate
);
3489 staticpro (&apropos_accumulate
);
3490 apropos_predicate
= Qnil
;
3491 apropos_accumulate
= Qnil
;
3493 /* Now we are ready to set up this property, so we can
3494 create char tables. */
3495 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3497 /* Initialize the keymaps standardly used.
3498 Each one is the value of a Lisp variable, and is also
3499 pointed to by a C variable */
3501 global_map
= Fmake_keymap (Qnil
);
3502 Fset (intern ("global-map"), global_map
);
3504 current_global_map
= global_map
;
3505 staticpro (&global_map
);
3506 staticpro (¤t_global_map
);
3508 meta_map
= Fmake_keymap (Qnil
);
3509 Fset (intern ("esc-map"), meta_map
);
3510 Ffset (intern ("ESC-prefix"), meta_map
);
3512 control_x_map
= Fmake_keymap (Qnil
);
3513 Fset (intern ("ctl-x-map"), control_x_map
);
3514 Ffset (intern ("Control-X-prefix"), control_x_map
);
3517 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3518 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3519 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3520 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3521 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3523 staticpro (&exclude_keys
);
3525 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3526 doc
: /* List of commands given new key bindings recently.
3527 This is used for internal purposes during Emacs startup;
3528 don't alter it yourself. */);
3529 Vdefine_key_rebound_commands
= Qt
;
3531 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3532 doc
: /* Default keymap to use when reading from the minibuffer. */);
3533 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3535 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3536 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3537 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3538 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3540 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3541 doc
: /* Local keymap for minibuffer input with completion. */);
3542 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3543 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3545 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3546 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3547 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3548 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3549 Vminibuffer_local_completion_map
);
3551 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3552 doc
: /* Alist of keymaps to use for minor modes.
3553 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3554 key sequences and look up bindings iff VARIABLE's value is non-nil.
3555 If two active keymaps bind the same key, the keymap appearing earlier
3556 in the list takes precedence. */);
3557 Vminor_mode_map_alist
= Qnil
;
3559 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3560 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3561 This variable is an alist just like `minor-mode-map-alist', and it is
3562 used the same way (and before `minor-mode-map-alist'); however,
3563 it is provided for major modes to bind locally. */);
3564 Vminor_mode_overriding_map_alist
= Qnil
;
3566 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3567 doc
: /* List of keymap alists to use for emulations modes.
3568 It is intended for modes or packages using multiple minor-mode keymaps.
3569 Each element is a keymap alist just like `minor-mode-map-alist', or a
3570 symbol with a variable binding which is a keymap alist, and it is used
3571 the same way. The "active" keymaps in each alist are used before
3572 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3573 Vemulation_mode_map_alists
= Qnil
;
3576 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3577 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3578 This allows Emacs to recognize function keys sent from ASCII
3579 terminals at any point in a key sequence.
3581 The `read-key-sequence' function replaces any subsequence bound by
3582 `function-key-map' with its binding. More precisely, when the active
3583 keymaps have no binding for the current key sequence but
3584 `function-key-map' binds a suffix of the sequence to a vector or string,
3585 `read-key-sequence' replaces the matching suffix with its binding, and
3586 continues with the new sequence.
3588 The events that come from bindings in `function-key-map' are not
3589 themselves looked up in `function-key-map'.
3591 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3592 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3593 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3594 key, typing `ESC O P x' would return [f1 x]. */);
3595 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3597 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3598 doc
: /* Keymap of key translations that can override keymaps.
3599 This keymap works like `function-key-map', but comes after that,
3600 and its non-prefix bindings override ordinary bindings. */);
3601 Vkey_translation_map
= Qnil
;
3603 staticpro (&Vmouse_events
);
3604 Vmouse_events
= Fcons (intern ("menu-bar"),
3605 Fcons (intern ("tool-bar"),
3606 Fcons (intern ("header-line"),
3607 Fcons (intern ("mode-line"),
3608 Fcons (intern ("mouse-1"),
3609 Fcons (intern ("mouse-2"),
3610 Fcons (intern ("mouse-3"),
3611 Fcons (intern ("mouse-4"),
3612 Fcons (intern ("mouse-5"),
3616 Qsingle_key_description
= intern ("single-key-description");
3617 staticpro (&Qsingle_key_description
);
3619 Qkey_description
= intern ("key-description");
3620 staticpro (&Qkey_description
);
3622 Qkeymapp
= intern ("keymapp");
3623 staticpro (&Qkeymapp
);
3625 Qnon_ascii
= intern ("non-ascii");
3626 staticpro (&Qnon_ascii
);
3628 Qmenu_item
= intern ("menu-item");
3629 staticpro (&Qmenu_item
);
3631 Qremap
= intern ("remap");
3632 staticpro (&Qremap
);
3634 command_remapping_vector
= Fmake_vector (make_number (2), Qremap
);
3635 staticpro (&command_remapping_vector
);
3637 where_is_cache_keymaps
= Qt
;
3638 where_is_cache
= Qnil
;
3639 staticpro (&where_is_cache
);
3640 staticpro (&where_is_cache_keymaps
);
3642 defsubr (&Skeymapp
);
3643 defsubr (&Skeymap_parent
);
3644 defsubr (&Skeymap_prompt
);
3645 defsubr (&Sset_keymap_parent
);
3646 defsubr (&Smake_keymap
);
3647 defsubr (&Smake_sparse_keymap
);
3648 defsubr (&Smap_keymap
);
3649 defsubr (&Scopy_keymap
);
3650 defsubr (&Scommand_remapping
);
3651 defsubr (&Skey_binding
);
3652 defsubr (&Slocal_key_binding
);
3653 defsubr (&Sglobal_key_binding
);
3654 defsubr (&Sminor_mode_key_binding
);
3655 defsubr (&Sdefine_key
);
3656 defsubr (&Slookup_key
);
3657 defsubr (&Sdefine_prefix_command
);
3658 defsubr (&Suse_global_map
);
3659 defsubr (&Suse_local_map
);
3660 defsubr (&Scurrent_local_map
);
3661 defsubr (&Scurrent_global_map
);
3662 defsubr (&Scurrent_minor_mode_maps
);
3663 defsubr (&Scurrent_active_maps
);
3664 defsubr (&Saccessible_keymaps
);
3665 defsubr (&Skey_description
);
3666 defsubr (&Sdescribe_vector
);
3667 defsubr (&Ssingle_key_description
);
3668 defsubr (&Stext_char_description
);
3669 defsubr (&Swhere_is_internal
);
3670 defsubr (&Sdescribe_buffer_bindings
);
3671 defsubr (&Sapropos_internal
);
3677 initial_define_key (global_map
, 033, "ESC-prefix");
3678 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");
3681 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
3682 (do not change this comment) */