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. */)
217 map
= get_keymap (map
, 0, 0);
220 Lisp_Object tem
= XCAR (map
);
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
)
276 tail
= Fnth (make_number (4), tem
);
277 if (EQ (tail
, Qkeymap
))
281 struct gcpro gcpro1
, gcpro2
;
283 GCPRO2 (tem
, object
);
284 do_autoload (tem
, object
);
297 wrong_type_argument (Qkeymapp
, object
);
301 /* Return the parent map of KEYMAP, or nil if it has none.
302 We assume that KEYMAP is a valid keymap. */
305 keymap_parent (keymap
, autoload
)
311 keymap
= get_keymap (keymap
, 1, autoload
);
313 /* Skip past the initial element `keymap'. */
314 list
= XCDR (keymap
);
315 for (; CONSP (list
); list
= XCDR (list
))
317 /* See if there is another `keymap'. */
322 return get_keymap (list
, 0, autoload
);
325 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
326 doc
: /* Return the parent keymap of KEYMAP. */)
330 return keymap_parent (keymap
, 1);
333 /* Check whether MAP is one of MAPS parents. */
335 keymap_memberp (map
, maps
)
336 Lisp_Object map
, maps
;
338 if (NILP (map
)) return 0;
339 while (KEYMAPP (maps
) && !EQ (map
, maps
))
340 maps
= keymap_parent (maps
, 0);
341 return (EQ (map
, maps
));
344 /* Set the parent keymap of MAP to PARENT. */
346 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
347 doc
: /* Modify KEYMAP to set its parent map to PARENT.
348 Return PARENT. PARENT should be nil or another keymap. */)
350 Lisp_Object keymap
, parent
;
352 Lisp_Object list
, prev
;
353 struct gcpro gcpro1
, gcpro2
;
356 /* Force a keymap flush for the next call to where-is.
357 Since this can be called from within where-is, we don't set where_is_cache
358 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
359 be changed during where-is, while where_is_cache_keymaps is only used at
360 the very beginning of where-is and can thus be changed here without any
362 This is a very minor correctness (rather than safety) issue. */
363 where_is_cache_keymaps
= Qt
;
365 GCPRO2 (keymap
, parent
);
366 keymap
= get_keymap (keymap
, 1, 1);
370 parent
= get_keymap (parent
, 1, 1);
372 /* Check for cycles. */
373 if (keymap_memberp (keymap
, parent
))
374 error ("Cyclic keymap inheritance");
377 /* Skip past the initial element `keymap'. */
382 /* If there is a parent keymap here, replace it.
383 If we came to the end, add the parent in PREV. */
384 if (!CONSP (list
) || KEYMAPP (list
))
386 /* If we already have the right parent, return now
387 so that we avoid the loops below. */
388 if (EQ (XCDR (prev
), parent
))
389 RETURN_UNGCPRO (parent
);
391 XSETCDR (prev
, parent
);
397 /* Scan through for submaps, and set their parents too. */
399 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
401 /* Stop the scan when we come to the parent. */
402 if (EQ (XCAR (list
), Qkeymap
))
405 /* If this element holds a prefix map, deal with it. */
406 if (CONSP (XCAR (list
))
407 && CONSP (XCDR (XCAR (list
))))
408 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
411 if (VECTORP (XCAR (list
)))
412 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
413 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
414 fix_submap_inheritance (keymap
, make_number (i
),
415 XVECTOR (XCAR (list
))->contents
[i
]);
417 if (CHAR_TABLE_P (XCAR (list
)))
419 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
), keymap
);
423 RETURN_UNGCPRO (parent
);
426 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
427 if EVENT is also a prefix in MAP's parent,
428 make sure that SUBMAP inherits that definition as its own parent. */
431 fix_submap_inheritance (map
, event
, submap
)
432 Lisp_Object map
, event
, submap
;
434 Lisp_Object map_parent
, parent_entry
;
436 /* SUBMAP is a cons that we found as a key binding.
437 Discard the other things found in a menu key binding. */
439 submap
= get_keymap (get_keyelt (submap
, 0), 0, 0);
441 /* If it isn't a keymap now, there's no work to do. */
445 map_parent
= keymap_parent (map
, 0);
446 if (!NILP (map_parent
))
448 get_keymap (access_keymap (map_parent
, event
, 0, 0, 0), 0, 0);
452 /* If MAP's parent has something other than a keymap,
453 our own submap shadows it completely. */
454 if (!CONSP (parent_entry
))
457 if (! EQ (parent_entry
, submap
))
459 Lisp_Object submap_parent
;
460 submap_parent
= submap
;
465 tem
= keymap_parent (submap_parent
, 0);
469 if (keymap_memberp (tem
, parent_entry
))
470 /* Fset_keymap_parent could create a cycle. */
477 Fset_keymap_parent (submap_parent
, parent_entry
);
481 /* Look up IDX in MAP. IDX may be any sort of event.
482 Note that this does only one level of lookup; IDX must be a single
483 event, not a sequence.
485 If T_OK is non-zero, bindings for Qt are treated as default
486 bindings; any key left unmentioned by other tables and bindings is
487 given the binding of Qt.
489 If T_OK is zero, bindings for Qt are not treated specially.
491 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
494 access_keymap (map
, idx
, t_ok
, noinherit
, autoload
)
503 /* Qunbound in VAL means we have found no binding yet. */
506 /* If idx is a list (some sort of mouse click, perhaps?),
507 the index we want to use is the car of the list, which
508 ought to be a symbol. */
509 idx
= EVENT_HEAD (idx
);
511 /* If idx is a symbol, it might have modifiers, which need to
512 be put in the canonical order. */
514 idx
= reorder_modifiers (idx
);
515 else if (INTEGERP (idx
))
516 /* Clobber the high bits that can be present on a machine
517 with more than 24 bits of integer. */
518 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
520 /* Handle the special meta -> esc mapping. */
521 if (INTEGERP (idx
) && XUINT (idx
) & meta_modifier
)
523 /* See if there is a meta-map. If there's none, there is
524 no binding for IDX, unless a default binding exists in MAP. */
526 Lisp_Object meta_map
;
528 meta_map
= get_keymap (access_keymap (map
, meta_prefix_char
,
529 t_ok
, noinherit
, autoload
),
532 if (CONSP (meta_map
))
535 idx
= make_number (XUINT (idx
) & ~meta_modifier
);
538 /* Set IDX to t, so that we only find a default binding. */
541 /* We know there is no binding. */
545 /* t_binding is where we put a default binding that applies,
546 to use in case we do not find a binding specifically
547 for this key sequence. */
550 Lisp_Object t_binding
= Qnil
;
551 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
553 GCPRO4 (map
, tail
, idx
, t_binding
);
555 /* If `t_ok' is 2, both `t' is accepted. */
558 for (tail
= XCDR (map
);
560 || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
)));
565 binding
= XCAR (tail
);
566 if (SYMBOLP (binding
))
568 /* If NOINHERIT, stop finding prefix definitions
569 after we pass a second occurrence of the `keymap' symbol. */
570 if (noinherit
&& EQ (binding
, Qkeymap
))
571 RETURN_UNGCPRO (Qnil
);
573 else if (CONSP (binding
))
575 Lisp_Object key
= XCAR (binding
);
578 val
= XCDR (binding
);
579 else if (t_ok
> 1 && EQ (key
, Qt
))
581 t_binding
= XCDR (binding
);
585 else if (VECTORP (binding
))
587 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (binding
))
588 val
= AREF (binding
, XFASTINT (idx
));
590 else if (CHAR_TABLE_P (binding
))
592 /* Character codes with modifiers
593 are not included in a char-table.
594 All character codes without modifiers are included. */
595 if (NATNUMP (idx
) && (XFASTINT (idx
) & CHAR_MODIFIER_MASK
) == 0)
597 val
= Faref (binding
, idx
);
598 /* `nil' has a special meaning for char-tables, so
599 we use something else to record an explicitly
606 /* If we found a binding, clean it up and return it. */
607 if (!EQ (val
, Qunbound
))
610 /* A Qt binding is just like an explicit nil binding
611 (i.e. it shadows any parent binding but not bindings in
612 keymaps of lower precedence). */
614 val
= get_keyelt (val
, autoload
);
616 fix_submap_inheritance (map
, idx
, val
);
617 RETURN_UNGCPRO (val
);
622 return get_keyelt (t_binding
, autoload
);
627 map_keymap_item (fun
, args
, key
, val
, data
)
628 map_keymap_function_t fun
;
629 Lisp_Object args
, key
, val
;
632 /* We should maybe try to detect bindings shadowed by previous
633 ones and things like that. */
636 (*fun
) (key
, val
, args
, data
);
640 map_keymap_char_table_item (args
, key
, val
)
641 Lisp_Object args
, key
, val
;
645 map_keymap_function_t fun
= XSAVE_VALUE (XCAR (args
))->pointer
;
647 map_keymap_item (fun
, XCDR (args
), key
, val
,
648 XSAVE_VALUE (XCAR (args
))->pointer
);
652 /* Call FUN for every binding in MAP.
653 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
654 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
656 map_keymap (map
, fun
, args
, data
, autoload
)
657 map_keymap_function_t fun
;
658 Lisp_Object map
, args
;
662 struct gcpro gcpro1
, gcpro2
, gcpro3
;
665 GCPRO3 (map
, args
, tail
);
666 map
= get_keymap (map
, 1, autoload
);
667 for (tail
= (CONSP (map
) && EQ (Qkeymap
, XCAR (map
))) ? XCDR (map
) : map
;
668 CONSP (tail
) || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
));
671 Lisp_Object binding
= XCAR (tail
);
674 map_keymap_item (fun
, args
, XCAR (binding
), XCDR (binding
), data
);
675 else if (VECTORP (binding
))
677 /* Loop over the char values represented in the vector. */
678 int len
= ASIZE (binding
);
680 for (c
= 0; c
< len
; c
++)
682 Lisp_Object character
;
683 XSETFASTINT (character
, c
);
684 map_keymap_item (fun
, args
, character
, AREF (binding
, c
), data
);
687 else if (CHAR_TABLE_P (binding
))
689 map_char_table (map_keymap_char_table_item
, Qnil
, binding
,
690 Fcons (make_save_value (fun
, 0),
691 Fcons (make_save_value (data
, 0),
699 map_keymap_call (key
, val
, fun
, dummy
)
700 Lisp_Object key
, val
, fun
;
703 call2 (fun
, key
, val
);
706 DEFUN ("map-keymap", Fmap_keymap
, Smap_keymap
, 2, 3, 0,
707 doc
: /* Call FUNCTION for every binding in KEYMAP.
708 FUNCTION is called with two arguments: the event and its binding.
709 If KEYMAP has a parent, the parent's bindings are included as well.
710 This works recursively: if the parent has itself a parent, then the
711 grandparent's bindings are also included and so on.
712 usage: (map-keymap FUNCTION KEYMAP) */)
713 (function
, keymap
, sort_first
)
714 Lisp_Object function
, keymap
, sort_first
;
716 if (INTEGERP (function
))
717 /* We have to stop integers early since map_keymap gives them special
719 Fsignal (Qinvalid_function
, Fcons (function
, Qnil
));
720 if (! NILP (sort_first
))
721 return call3 (intern ("map-keymap-internal"), function
, keymap
, Qt
);
723 map_keymap (keymap
, map_keymap_call
, function
, NULL
, 1);
727 /* Given OBJECT which was found in a slot in a keymap,
728 trace indirect definitions to get the actual definition of that slot.
729 An indirect definition is a list of the form
730 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
731 and INDEX is the object to look up in KEYMAP to yield the definition.
733 Also if OBJECT has a menu string as the first element,
734 remove that. Also remove a menu help string as second element.
736 If AUTOLOAD is nonzero, load autoloadable keymaps
737 that are referred to with indirection. */
740 get_keyelt (object
, autoload
)
746 if (!(CONSP (object
)))
747 /* This is really the value. */
750 /* If the keymap contents looks like (keymap ...) or (lambda ...)
752 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
755 /* If the keymap contents looks like (menu-item name . DEFN)
756 or (menu-item name DEFN ...) then use DEFN.
757 This is a new format menu item. */
758 else if (EQ (XCAR (object
), Qmenu_item
))
760 if (CONSP (XCDR (object
)))
764 object
= XCDR (XCDR (object
));
767 object
= XCAR (object
);
769 /* If there's a `:filter FILTER', apply FILTER to the
770 menu-item's definition to get the real definition to
772 for (; CONSP (tem
) && CONSP (XCDR (tem
)); tem
= XCDR (tem
))
773 if (EQ (XCAR (tem
), QCfilter
) && autoload
)
776 filter
= XCAR (XCDR (tem
));
777 filter
= list2 (filter
, list2 (Qquote
, object
));
778 object
= menu_item_eval_property (filter
);
783 /* Invalid keymap. */
787 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
788 Keymap alist elements like (CHAR MENUSTRING . DEFN)
789 will be used by HierarKey menus. */
790 else if (STRINGP (XCAR (object
)))
792 object
= XCDR (object
);
793 /* Also remove a menu help string, if any,
794 following the menu item name. */
795 if (CONSP (object
) && STRINGP (XCAR (object
)))
796 object
= XCDR (object
);
797 /* Also remove the sublist that caches key equivalences, if any. */
798 if (CONSP (object
) && CONSP (XCAR (object
)))
801 carcar
= XCAR (XCAR (object
));
802 if (NILP (carcar
) || VECTORP (carcar
))
803 object
= XCDR (object
);
807 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
813 map
= get_keymap (Fcar_safe (object
), 0, autoload
);
815 return (!CONSP (map
) ? object
/* Invalid keymap */
816 : access_keymap (map
, Fcdr (object
), 0, 0, autoload
));
822 store_in_keymap (keymap
, idx
, def
)
824 register Lisp_Object idx
;
825 register Lisp_Object def
;
827 /* Flush any reverse-map cache. */
828 where_is_cache
= Qnil
;
829 where_is_cache_keymaps
= Qt
;
831 /* If we are preparing to dump, and DEF is a menu element
832 with a menu item indicator, copy it to ensure it is not pure. */
833 if (CONSP (def
) && PURE_P (def
)
834 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
835 def
= Fcons (XCAR (def
), XCDR (def
));
837 if (!CONSP (keymap
) || !EQ (XCAR (keymap
), Qkeymap
))
838 error ("attempt to define a key in a non-keymap");
840 /* If idx is a cons, and the car part is a character, idx must be of
841 the form (FROM-CHAR . TO-CHAR). */
842 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
843 CHECK_CHARACTER_CDR (idx
);
845 /* If idx is a list (some sort of mouse click, perhaps?),
846 the index we want to use is the car of the list, which
847 ought to be a symbol. */
848 idx
= EVENT_HEAD (idx
);
850 /* If idx is a symbol, it might have modifiers, which need to
851 be put in the canonical order. */
853 idx
= reorder_modifiers (idx
);
854 else if (INTEGERP (idx
))
855 /* Clobber the high bits that can be present on a machine
856 with more than 24 bits of integer. */
857 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
859 /* Scan the keymap for a binding of idx. */
863 /* The cons after which we should insert new bindings. If the
864 keymap has a table element, we record its position here, so new
865 bindings will go after it; this way, the table will stay
866 towards the front of the alist and character lookups in dense
867 keymaps will remain fast. Otherwise, this just points at the
868 front of the keymap. */
869 Lisp_Object insertion_point
;
871 insertion_point
= keymap
;
872 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
879 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (elt
))
881 ASET (elt
, XFASTINT (idx
), def
);
884 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
886 int from
= XFASTINT (XCAR (idx
));
887 int to
= XFASTINT (XCDR (idx
));
889 if (to
>= ASIZE (elt
))
890 to
= ASIZE (elt
) - 1;
891 for (; from
<= to
; from
++)
892 ASET (elt
, from
, def
);
893 if (to
== XFASTINT (XCDR (idx
)))
894 /* We have defined all keys in IDX. */
897 insertion_point
= tail
;
899 else if (CHAR_TABLE_P (elt
))
901 /* Character codes with modifiers
902 are not included in a char-table.
903 All character codes without modifiers are included. */
904 if (NATNUMP (idx
) && !(XFASTINT (idx
) & CHAR_MODIFIER_MASK
))
907 /* `nil' has a special meaning for char-tables, so
908 we use something else to record an explicitly
910 NILP (def
) ? Qt
: def
);
913 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
915 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
918 insertion_point
= tail
;
920 else if (CONSP (elt
))
922 if (EQ (idx
, XCAR (elt
)))
927 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
929 int from
= XFASTINT (XCAR (idx
));
930 int to
= XFASTINT (XCDR (idx
));
932 if (from
<= XFASTINT (XCAR (elt
))
933 && to
>= XFASTINT (XCAR (elt
)))
941 else if (EQ (elt
, Qkeymap
))
942 /* If we find a 'keymap' symbol in the spine of KEYMAP,
943 then we must have found the start of a second keymap
944 being used as the tail of KEYMAP, and a binding for IDX
945 should be inserted before it. */
952 /* We have scanned the entire keymap, and not found a binding for
953 IDX. Let's add one. */
957 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
959 /* IDX specifies a range of characters, and not all of them
960 were handled yet, which means this keymap doesn't have a
961 char-table. So, we insert a char-table now. */
962 elt
= Fmake_char_table (Qkeymap
, Qnil
);
963 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
966 elt
= Fcons (idx
, def
);
967 XSETCDR (insertion_point
, Fcons (elt
, XCDR (insertion_point
)));
974 EXFUN (Fcopy_keymap
, 1);
977 copy_keymap_item (elt
)
980 Lisp_Object res
, tem
;
987 /* Is this a new format menu item. */
988 if (EQ (XCAR (tem
), Qmenu_item
))
990 /* Copy cell with menu-item marker. */
991 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
995 /* Copy cell with menu-item name. */
996 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1002 /* Copy cell with binding and if the binding is a keymap,
1004 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1007 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1008 XSETCAR (elt
, Fcopy_keymap (tem
));
1010 if (CONSP (tem
) && CONSP (XCAR (tem
)))
1011 /* Delete cache for key equivalences. */
1012 XSETCDR (elt
, XCDR (tem
));
1017 /* It may be an old fomat menu item.
1018 Skip the optional menu string. */
1019 if (STRINGP (XCAR (tem
)))
1021 /* Copy the cell, since copy-alist didn't go this deep. */
1022 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
1024 /* Also skip the optional menu help string. */
1025 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1027 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1031 /* There may also be a list that caches key equivalences.
1032 Just delete it for the new keymap. */
1034 && CONSP (XCAR (tem
))
1035 && (NILP (XCAR (XCAR (tem
)))
1036 || VECTORP (XCAR (XCAR (tem
)))))
1038 XSETCDR (elt
, XCDR (tem
));
1041 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1042 XSETCDR (elt
, Fcopy_keymap (tem
));
1044 else if (EQ (XCAR (tem
), Qkeymap
))
1045 res
= Fcopy_keymap (elt
);
1051 copy_keymap_1 (chartable
, idx
, elt
)
1052 Lisp_Object chartable
, idx
, elt
;
1054 Fset_char_table_range (chartable
, idx
, copy_keymap_item (elt
));
1057 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
1058 doc
: /* Return a copy of the keymap KEYMAP.
1059 The copy starts out with the same definitions of KEYMAP,
1060 but changing either the copy or KEYMAP does not affect the other.
1061 Any key definitions that are subkeymaps are recursively copied.
1062 However, a key definition which is a symbol whose definition is a keymap
1067 register Lisp_Object copy
, tail
;
1068 keymap
= get_keymap (keymap
, 1, 0);
1069 copy
= tail
= Fcons (Qkeymap
, Qnil
);
1070 keymap
= XCDR (keymap
); /* Skip the `keymap' symbol. */
1072 while (CONSP (keymap
) && !EQ (XCAR (keymap
), Qkeymap
))
1074 Lisp_Object elt
= XCAR (keymap
);
1075 if (CHAR_TABLE_P (elt
))
1077 elt
= Fcopy_sequence (elt
);
1078 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
);
1080 else if (VECTORP (elt
))
1083 elt
= Fcopy_sequence (elt
);
1084 for (i
= 0; i
< ASIZE (elt
); i
++)
1085 ASET (elt
, i
, copy_keymap_item (AREF (elt
, i
)));
1087 else if (CONSP (elt
))
1088 elt
= Fcons (XCAR (elt
), copy_keymap_item (XCDR (elt
)));
1089 XSETCDR (tail
, Fcons (elt
, Qnil
));
1091 keymap
= XCDR (keymap
);
1093 XSETCDR (tail
, keymap
);
1097 /* Simple Keymap mutators and accessors. */
1099 /* GC is possible in this function if it autoloads a keymap. */
1101 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
1102 doc
: /* In KEYMAP, define key sequence KEY as DEF.
1105 KEY is a string or a vector of symbols and characters meaning a
1106 sequence of keystrokes and events. Non-ASCII characters with codes
1107 above 127 (such as ISO Latin-1) can be included if you use a vector.
1108 Using [t] for KEY creates a default definition, which applies to any
1109 event type that has no other definition in this keymap.
1111 DEF is anything that can be a key's definition:
1112 nil (means key is undefined in this keymap),
1113 a command (a Lisp function suitable for interactive calling),
1114 a string (treated as a keyboard macro),
1115 a keymap (to define a prefix key),
1116 a symbol (when the key is looked up, the symbol will stand for its
1117 function definition, which should at that time be one of the above,
1118 or another symbol whose function definition is used, etc.),
1119 a cons (STRING . DEFN), meaning that DEFN is the definition
1120 (DEFN should be a valid definition in its own right),
1121 or a cons (MAP . CHAR), meaning use definition of CHAR in keymap MAP.
1123 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1124 binding is altered. If there is no binding for KEY, the new pair
1125 binding KEY to DEF is added at the front of KEYMAP. */)
1132 register Lisp_Object c
;
1133 register Lisp_Object cmd
;
1137 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1139 GCPRO3 (keymap
, key
, def
);
1140 keymap
= get_keymap (keymap
, 1, 1);
1142 if (!VECTORP (key
) && !STRINGP (key
))
1143 key
= wrong_type_argument (Qarrayp
, key
);
1145 length
= XFASTINT (Flength (key
));
1147 RETURN_UNGCPRO (Qnil
);
1149 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
1150 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
1152 meta_bit
= VECTORP (key
) ? meta_modifier
: 0x80;
1157 c
= Faref (key
, make_number (idx
));
1161 /* C may be a Lucid style event type list or a cons (FROM .
1162 TO) specifying a range of characters. */
1163 if (lucid_event_type_list_p (c
))
1164 c
= Fevent_convert_list (c
);
1165 else if (CHARACTERP (XCAR (c
)))
1166 CHECK_CHARACTER_CDR (c
);
1170 silly_event_symbol_error (c
);
1173 && (XINT (c
) & meta_bit
)
1176 c
= meta_prefix_char
;
1182 XSETINT (c
, XINT (c
) & ~meta_bit
);
1188 if (!INTEGERP (c
) && !SYMBOLP (c
)
1190 /* If C is a range, it must be a leaf. */
1191 || (INTEGERP (XCAR (c
)) && idx
!= length
)))
1192 error ("Key sequence contains invalid event");
1195 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
1197 cmd
= access_keymap (keymap
, c
, 0, 1, 1);
1199 /* If this key is undefined, make it a prefix. */
1201 cmd
= define_as_prefix (keymap
, c
);
1203 keymap
= get_keymap (cmd
, 0, 1);
1204 if (!CONSP (keymap
))
1205 /* We must use Fkey_description rather than just passing key to
1206 error; key might be a vector, not a string. */
1207 error ("Key sequence %s uses invalid prefix characters",
1208 SDATA (Fkey_description (key
, Qnil
)));
1212 /* This function may GC (it calls Fkey_binding). */
1214 DEFUN ("command-remapping", Fcommand_remapping
, Scommand_remapping
, 1, 1, 0,
1215 doc
: /* Return the remapping for command COMMAND in current keymaps.
1216 Returns nil if COMMAND is not remapped (or not a symbol). */)
1218 Lisp_Object command
;
1220 if (!SYMBOLP (command
))
1223 ASET (command_remapping_vector
, 1, command
);
1224 return Fkey_binding (command_remapping_vector
, Qnil
, Qt
);
1227 /* Value is number if KEY is too long; nil if valid but has no definition. */
1228 /* GC is possible in this function if it autoloads a keymap. */
1230 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
1231 doc
: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1232 nil means undefined. See doc of `define-key' for kinds of definitions.
1234 A number as value means KEY is "too long";
1235 that is, characters or symbols in it except for the last one
1236 fail to be a valid sequence of prefix characters in KEYMAP.
1237 The number is how many characters at the front of KEY
1238 it takes to reach a non-prefix command.
1240 Normally, `lookup-key' ignores bindings for t, which act as default
1241 bindings, used when nothing else in the keymap applies; this makes it
1242 usable as a general function for probing keymaps. However, if the
1243 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1244 recognize the default bindings, just as `read-key-sequence' does. */)
1245 (keymap
, key
, accept_default
)
1248 Lisp_Object accept_default
;
1251 register Lisp_Object cmd
;
1252 register Lisp_Object c
;
1254 int t_ok
= !NILP (accept_default
);
1255 struct gcpro gcpro1
, gcpro2
;
1257 GCPRO2 (keymap
, key
);
1258 keymap
= get_keymap (keymap
, 1, 1);
1260 if (!VECTORP (key
) && !STRINGP (key
))
1261 key
= wrong_type_argument (Qarrayp
, key
);
1263 length
= XFASTINT (Flength (key
));
1265 RETURN_UNGCPRO (keymap
);
1270 c
= Faref (key
, make_number (idx
++));
1272 if (CONSP (c
) && lucid_event_type_list_p (c
))
1273 c
= Fevent_convert_list (c
);
1275 /* Turn the 8th bit of string chars into a meta modifier. */
1276 if (INTEGERP (c
) && XINT (c
) & 0x80 && STRINGP (key
))
1277 XSETINT (c
, (XINT (c
) | meta_modifier
) & ~0x80);
1279 /* Allow string since binding for `menu-bar-select-buffer'
1280 includes the buffer name in the key sequence. */
1281 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
) && !STRINGP (c
))
1282 error ("Key sequence contains invalid event");
1284 cmd
= access_keymap (keymap
, c
, t_ok
, 0, 1);
1286 RETURN_UNGCPRO (cmd
);
1288 keymap
= get_keymap (cmd
, 0, 1);
1289 if (!CONSP (keymap
))
1290 RETURN_UNGCPRO (make_number (idx
));
1296 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1297 Assume that currently it does not define C at all.
1298 Return the keymap. */
1301 define_as_prefix (keymap
, c
)
1302 Lisp_Object keymap
, c
;
1306 cmd
= Fmake_sparse_keymap (Qnil
);
1307 /* If this key is defined as a prefix in an inherited keymap,
1308 make it a prefix in this map, and make its definition
1309 inherit the other prefix definition. */
1310 cmd
= nconc2 (cmd
, access_keymap (keymap
, c
, 0, 0, 0));
1311 store_in_keymap (keymap
, c
, cmd
);
1316 /* Append a key to the end of a key sequence. We always make a vector. */
1319 append_key (key_sequence
, key
)
1320 Lisp_Object key_sequence
, key
;
1322 Lisp_Object args
[2];
1324 args
[0] = key_sequence
;
1326 args
[1] = Fcons (key
, Qnil
);
1327 return Fvconcat (2, args
);
1330 /* Given a event type C which is a symbol,
1331 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1334 silly_event_symbol_error (c
)
1337 Lisp_Object parsed
, base
, name
, assoc
;
1340 parsed
= parse_modifiers (c
);
1341 modifiers
= (int) XUINT (XCAR (XCDR (parsed
)));
1342 base
= XCAR (parsed
);
1343 name
= Fsymbol_name (base
);
1344 /* This alist includes elements such as ("RET" . "\\r"). */
1345 assoc
= Fassoc (name
, exclude_keys
);
1349 char new_mods
[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1351 Lisp_Object keystring
;
1352 if (modifiers
& alt_modifier
)
1353 { *p
++ = '\\'; *p
++ = 'A'; *p
++ = '-'; }
1354 if (modifiers
& ctrl_modifier
)
1355 { *p
++ = '\\'; *p
++ = 'C'; *p
++ = '-'; }
1356 if (modifiers
& hyper_modifier
)
1357 { *p
++ = '\\'; *p
++ = 'H'; *p
++ = '-'; }
1358 if (modifiers
& meta_modifier
)
1359 { *p
++ = '\\'; *p
++ = 'M'; *p
++ = '-'; }
1360 if (modifiers
& shift_modifier
)
1361 { *p
++ = '\\'; *p
++ = 'S'; *p
++ = '-'; }
1362 if (modifiers
& super_modifier
)
1363 { *p
++ = '\\'; *p
++ = 's'; *p
++ = '-'; }
1366 c
= reorder_modifiers (c
);
1367 keystring
= concat2 (build_string (new_mods
), XCDR (assoc
));
1369 error ((modifiers
& ~meta_modifier
1370 ? "To bind the key %s, use [?%s], not [%s]"
1371 : "To bind the key %s, use \"%s\", not [%s]"),
1372 SDATA (SYMBOL_NAME (c
)), SDATA (keystring
),
1373 SDATA (SYMBOL_NAME (c
)));
1377 /* Global, local, and minor mode keymap stuff. */
1379 /* We can't put these variables inside current_minor_maps, since under
1380 some systems, static gets macro-defined to be the empty string.
1382 static Lisp_Object
*cmm_modes
= NULL
, *cmm_maps
= NULL
;
1383 static int cmm_size
= 0;
1385 /* Error handler used in current_minor_maps. */
1387 current_minor_maps_error ()
1392 /* Store a pointer to an array of the keymaps of the currently active
1393 minor modes in *buf, and return the number of maps it contains.
1395 This function always returns a pointer to the same buffer, and may
1396 free or reallocate it, so if you want to keep it for a long time or
1397 hand it out to lisp code, copy it. This procedure will be called
1398 for every key sequence read, so the nice lispy approach (return a
1399 new assoclist, list, what have you) for each invocation would
1400 result in a lot of consing over time.
1402 If we used xrealloc/xmalloc and ran out of memory, they would throw
1403 back to the command loop, which would try to read a key sequence,
1404 which would call this function again, resulting in an infinite
1405 loop. Instead, we'll use realloc/malloc and silently truncate the
1406 list, let the key sequence be read, and hope some other piece of
1407 code signals the error. */
1409 current_minor_maps (modeptr
, mapptr
)
1410 Lisp_Object
**modeptr
, **mapptr
;
1413 int list_number
= 0;
1414 Lisp_Object alist
, assoc
, var
, val
;
1415 Lisp_Object emulation_alists
;
1416 Lisp_Object lists
[2];
1418 emulation_alists
= Vemulation_mode_map_alists
;
1419 lists
[0] = Vminor_mode_overriding_map_alist
;
1420 lists
[1] = Vminor_mode_map_alist
;
1422 for (list_number
= 0; list_number
< 2; list_number
++)
1424 if (CONSP (emulation_alists
))
1426 alist
= XCAR (emulation_alists
);
1427 emulation_alists
= XCDR (emulation_alists
);
1428 if (SYMBOLP (alist
))
1429 alist
= find_symbol_value (alist
);
1433 alist
= lists
[list_number
];
1435 for ( ; CONSP (alist
); alist
= XCDR (alist
))
1436 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1437 && (var
= XCAR (assoc
), SYMBOLP (var
))
1438 && (val
= find_symbol_value (var
), !EQ (val
, Qunbound
))
1443 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1444 and also an entry in Vminor_mode_map_alist,
1445 ignore the latter. */
1446 if (list_number
== 1)
1448 val
= assq_no_quit (var
, lists
[0]);
1455 int newsize
, allocsize
;
1456 Lisp_Object
*newmodes
, *newmaps
;
1458 newsize
= cmm_size
== 0 ? 30 : cmm_size
* 2;
1459 allocsize
= newsize
* sizeof *newmodes
;
1461 /* Use malloc here. See the comment above this function.
1462 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1464 newmodes
= (Lisp_Object
*) malloc (allocsize
);
1469 bcopy (cmm_modes
, newmodes
, cmm_size
* sizeof cmm_modes
[0]);
1472 cmm_modes
= newmodes
;
1475 newmaps
= (Lisp_Object
*) malloc (allocsize
);
1480 bcopy (cmm_maps
, newmaps
, cmm_size
* sizeof cmm_maps
[0]);
1487 if (newmodes
== NULL
|| newmaps
== NULL
)
1492 /* Get the keymap definition--or nil if it is not defined. */
1493 temp
= internal_condition_case_1 (Findirect_function
,
1495 Qerror
, current_minor_maps_error
);
1499 cmm_maps
[i
] = temp
;
1505 if (modeptr
) *modeptr
= cmm_modes
;
1506 if (mapptr
) *mapptr
= cmm_maps
;
1510 DEFUN ("current-active-maps", Fcurrent_active_maps
, Scurrent_active_maps
,
1512 doc
: /* Return a list of the currently active keymaps.
1513 OLP if non-nil indicates that we should obey `overriding-local-map' and
1514 `overriding-terminal-local-map'. */)
1518 Lisp_Object keymaps
= Fcons (current_global_map
, Qnil
);
1522 if (!NILP (Voverriding_local_map
))
1523 keymaps
= Fcons (Voverriding_local_map
, keymaps
);
1524 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1525 keymaps
= Fcons (current_kboard
->Voverriding_terminal_local_map
, keymaps
);
1527 if (NILP (XCDR (keymaps
)))
1533 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1535 keymaps
= Fcons (local
, keymaps
);
1537 nmaps
= current_minor_maps (0, &maps
);
1539 for (i
= --nmaps
; i
>= 0; i
--)
1540 if (!NILP (maps
[i
]))
1541 keymaps
= Fcons (maps
[i
], keymaps
);
1543 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1545 keymaps
= Fcons (local
, keymaps
);
1551 /* GC is possible in this function if it autoloads a keymap. */
1553 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 3, 0,
1554 doc
: /* Return the binding for command KEY in current keymaps.
1555 KEY is a string or vector, a sequence of keystrokes.
1556 The binding is probably a symbol with a function definition.
1558 Normally, `key-binding' ignores bindings for t, which act as default
1559 bindings, used when nothing else in the keymap applies; this makes it
1560 usable as a general function for probing keymaps. However, if the
1561 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1562 recognize the default bindings, just as `read-key-sequence' does.
1564 Like the normal command loop, `key-binding' will remap the command
1565 resulting from looking up KEY by looking up the command in the
1566 current keymaps. However, if the optional third argument NO-REMAP
1567 is non-nil, `key-binding' returns the unmapped command. */)
1568 (key
, accept_default
, no_remap
)
1569 Lisp_Object key
, accept_default
, no_remap
;
1571 Lisp_Object
*maps
, value
;
1573 struct gcpro gcpro1
;
1577 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1579 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1580 key
, accept_default
);
1581 if (! NILP (value
) && !INTEGERP (value
))
1584 else if (!NILP (Voverriding_local_map
))
1586 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1587 if (! NILP (value
) && !INTEGERP (value
))
1594 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1597 value
= Flookup_key (local
, key
, accept_default
);
1598 if (! NILP (value
) && !INTEGERP (value
))
1602 nmaps
= current_minor_maps (0, &maps
);
1603 /* Note that all these maps are GCPRO'd
1604 in the places where we found them. */
1606 for (i
= 0; i
< nmaps
; i
++)
1607 if (! NILP (maps
[i
]))
1609 value
= Flookup_key (maps
[i
], key
, accept_default
);
1610 if (! NILP (value
) && !INTEGERP (value
))
1614 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1617 value
= Flookup_key (local
, key
, accept_default
);
1618 if (! NILP (value
) && !INTEGERP (value
))
1623 value
= Flookup_key (current_global_map
, key
, accept_default
);
1627 if (NILP (value
) || INTEGERP (value
))
1630 /* If the result of the ordinary keymap lookup is an interactive
1631 command, look for a key binding (ie. remapping) for that command. */
1633 if (NILP (no_remap
) && SYMBOLP (value
))
1636 if (value1
= Fcommand_remapping (value
), !NILP (value1
))
1643 /* GC is possible in this function if it autoloads a keymap. */
1645 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1646 doc
: /* Return the binding for command KEYS in current local keymap only.
1647 KEYS is a string or vector, a sequence of keystrokes.
1648 The binding is probably a symbol with a function definition.
1650 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1651 bindings; see the description of `lookup-key' for more details about this. */)
1652 (keys
, accept_default
)
1653 Lisp_Object keys
, accept_default
;
1655 register Lisp_Object map
;
1656 map
= current_buffer
->keymap
;
1659 return Flookup_key (map
, keys
, accept_default
);
1662 /* GC is possible in this function if it autoloads a keymap. */
1664 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1665 doc
: /* Return the binding for command KEYS in current global keymap only.
1666 KEYS is a string or vector, a sequence of keystrokes.
1667 The binding is probably a symbol with a function definition.
1668 This function's return values are the same as those of `lookup-key'
1671 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1672 bindings; see the description of `lookup-key' for more details about this. */)
1673 (keys
, accept_default
)
1674 Lisp_Object keys
, accept_default
;
1676 return Flookup_key (current_global_map
, keys
, accept_default
);
1679 /* GC is possible in this function if it autoloads a keymap. */
1681 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1682 doc
: /* Find the visible minor mode bindings of KEY.
1683 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
1684 the symbol which names the minor mode binding KEY, and BINDING is
1685 KEY's definition in that mode. In particular, if KEY has no
1686 minor-mode bindings, return nil. If the first binding is a
1687 non-prefix, all subsequent bindings will be omitted, since they would
1688 be ignored. Similarly, the list doesn't include non-prefix bindings
1689 that come after prefix bindings.
1691 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1692 bindings; see the description of `lookup-key' for more details about this. */)
1693 (key
, accept_default
)
1694 Lisp_Object key
, accept_default
;
1696 Lisp_Object
*modes
, *maps
;
1698 Lisp_Object binding
;
1700 struct gcpro gcpro1
, gcpro2
;
1702 nmaps
= current_minor_maps (&modes
, &maps
);
1703 /* Note that all these maps are GCPRO'd
1704 in the places where we found them. */
1707 GCPRO2 (key
, binding
);
1709 for (i
= j
= 0; i
< nmaps
; i
++)
1711 && !NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1712 && !INTEGERP (binding
))
1714 if (KEYMAPP (binding
))
1715 maps
[j
++] = Fcons (modes
[i
], binding
);
1717 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1721 return Flist (j
, maps
);
1724 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1725 doc
: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1726 A new sparse keymap is stored as COMMAND's function definition and its value.
1727 If a second optional argument MAPVAR is given, the map is stored as
1728 its value instead of as COMMAND's value; but COMMAND is still defined
1730 The third optional argument NAME, if given, supplies a menu name
1731 string for the map. This is required to use the keymap as a menu.
1732 This function returns COMMAND. */)
1733 (command
, mapvar
, name
)
1734 Lisp_Object command
, mapvar
, name
;
1737 map
= Fmake_sparse_keymap (name
);
1738 Ffset (command
, map
);
1742 Fset (command
, map
);
1746 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1747 doc
: /* Select KEYMAP as the global keymap. */)
1751 keymap
= get_keymap (keymap
, 1, 1);
1752 current_global_map
= keymap
;
1757 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1758 doc
: /* Select KEYMAP as the local keymap.
1759 If KEYMAP is nil, that means no local keymap. */)
1764 keymap
= get_keymap (keymap
, 1, 1);
1766 current_buffer
->keymap
= keymap
;
1771 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1772 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1775 return current_buffer
->keymap
;
1778 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1779 doc
: /* Return the current global keymap. */)
1782 return current_global_map
;
1785 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1786 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1790 int nmaps
= current_minor_maps (0, &maps
);
1792 return Flist (nmaps
, maps
);
1795 /* Help functions for describing and documenting keymaps. */
1799 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1800 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1801 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1805 cmd
= get_keymap (get_keyelt (cmd
, 0), 0, 0);
1809 /* Look for and break cycles. */
1810 while (!NILP (tem
= Frassq (cmd
, maps
)))
1812 Lisp_Object prefix
= XCAR (tem
);
1813 int lim
= XINT (Flength (XCAR (tem
)));
1814 if (lim
<= XINT (Flength (thisseq
)))
1815 { /* This keymap was already seen with a smaller prefix. */
1817 while (i
< lim
&& EQ (Faref (prefix
, make_number (i
)),
1818 Faref (thisseq
, make_number (i
))))
1821 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1824 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1825 but maybe `cmd' occurs again further down in `maps', so keep
1827 maps
= XCDR (Fmemq (tem
, maps
));
1830 /* If the last key in thisseq is meta-prefix-char,
1831 turn it into a meta-ized keystroke. We know
1832 that the event we're about to append is an
1833 ascii keystroke since we're processing a
1837 int meta_bit
= meta_modifier
;
1838 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1839 tem
= Fcopy_sequence (thisseq
);
1841 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1843 /* This new sequence is the same length as
1844 thisseq, so stick it in the list right
1847 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1851 tem
= append_key (thisseq
, key
);
1852 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1857 accessible_keymaps_char_table (args
, index
, cmd
)
1858 Lisp_Object args
, index
, cmd
;
1860 accessible_keymaps_1 (index
, cmd
,
1864 XINT (XCDR (XCAR (args
))));
1867 /* This function cannot GC. */
1869 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1871 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1872 Returns a list of elements of the form (KEYS . MAP), where the sequence
1873 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1874 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1875 An optional argument PREFIX, if non-nil, should be a key sequence;
1876 then the value includes only maps for prefixes that start with PREFIX. */)
1878 Lisp_Object keymap
, prefix
;
1880 Lisp_Object maps
, tail
;
1883 /* no need for gcpro because we don't autoload any keymaps. */
1886 prefixlen
= XINT (Flength (prefix
));
1890 /* If a prefix was specified, start with the keymap (if any) for
1891 that prefix, so we don't waste time considering other prefixes. */
1893 tem
= Flookup_key (keymap
, prefix
, Qt
);
1894 /* Flookup_key may give us nil, or a number,
1895 if the prefix is not defined in this particular map.
1896 It might even give us a list that isn't a keymap. */
1897 tem
= get_keymap (tem
, 0, 0);
1900 /* Convert PREFIX to a vector now, so that later on
1901 we don't have to deal with the possibility of a string. */
1902 if (STRINGP (prefix
))
1907 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1908 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1912 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1913 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1914 c
^= 0200 | meta_modifier
;
1915 ASET (copy
, i_before
, make_number (c
));
1919 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1925 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1926 get_keymap (keymap
, 1, 0)),
1929 /* For each map in the list maps,
1930 look at any other maps it points to,
1931 and stick them at the end if they are not already in the list.
1933 This is a breadth-first traversal, where tail is the queue of
1934 nodes, and maps accumulates a list of all nodes visited. */
1936 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1938 register Lisp_Object thisseq
, thismap
;
1940 /* Does the current sequence end in the meta-prefix-char? */
1943 thisseq
= Fcar (Fcar (tail
));
1944 thismap
= Fcdr (Fcar (tail
));
1945 last
= make_number (XINT (Flength (thisseq
)) - 1);
1946 is_metized
= (XINT (last
) >= 0
1947 /* Don't metize the last char of PREFIX. */
1948 && XINT (last
) >= prefixlen
1949 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1951 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1955 elt
= XCAR (thismap
);
1959 if (CHAR_TABLE_P (elt
))
1961 map_char_table (accessible_keymaps_char_table
, Qnil
,
1962 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1963 Fcons (tail
, thisseq
)));
1965 else if (VECTORP (elt
))
1969 /* Vector keymap. Scan all the elements. */
1970 for (i
= 0; i
< ASIZE (elt
); i
++)
1971 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1972 maps
, tail
, thisseq
, is_metized
);
1975 else if (CONSP (elt
))
1976 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1977 maps
, tail
, thisseq
,
1978 is_metized
&& INTEGERP (XCAR (elt
)));
1986 Lisp_Object Qsingle_key_description
, Qkey_description
;
1988 /* This function cannot GC. */
1990 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 2, 0,
1991 doc
: /* Return a pretty description of key-sequence KEYS.
1992 Optional arg PREFIX is the sequence of keys leading up to KEYS.
1993 Control characters turn into "C-foo" sequences, meta into "M-foo",
1994 spaces are put between sequence elements, etc. */)
1996 Lisp_Object keys
, prefix
;
2001 int size
= XINT (Flength (keys
));
2003 Lisp_Object sep
= build_string (" ");
2008 size
+= XINT (Flength (prefix
));
2010 /* This has one extra element at the end that we don't pass to Fconcat. */
2011 args
= (Lisp_Object
*) alloca (size
* 4 * sizeof (Lisp_Object
));
2013 /* In effect, this computes
2014 (mapconcat 'single-key-description keys " ")
2015 but we shouldn't use mapconcat because it can do GC. */
2019 list
= prefix
, prefix
= Qnil
;
2020 else if (!NILP (keys
))
2021 list
= keys
, keys
= Qnil
;
2026 args
[len
] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2030 return empty_string
;
2031 return Fconcat (len
- 1, args
);
2035 size
= SCHARS (list
);
2036 else if (VECTORP (list
))
2037 size
= XVECTOR (list
)->size
;
2038 else if (CONSP (list
))
2039 size
= XINT (Flength (list
));
2041 wrong_type_argument (Qarrayp
, list
);
2050 FETCH_STRING_CHAR_ADVANCE (c
, list
, i
, i_byte
);
2051 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
2052 c
^= 0200 | meta_modifier
;
2053 XSETFASTINT (key
, c
);
2055 else if (VECTORP (list
))
2057 key
= AREF (list
, i
++);
2069 || EQ (key
, meta_prefix_char
)
2070 || (XINT (key
) & meta_modifier
))
2072 args
[len
++] = Fsingle_key_description (meta_prefix_char
, Qnil
);
2074 if (EQ (key
, meta_prefix_char
))
2078 XSETINT (key
, (XINT (key
) | meta_modifier
) & ~0x80);
2081 else if (EQ (key
, meta_prefix_char
))
2086 args
[len
++] = Fsingle_key_description (key
, Qnil
);
2094 push_key_description (c
, p
, force_multibyte
)
2095 register unsigned int c
;
2097 int force_multibyte
;
2101 /* Clear all the meaningless bits above the meta bit. */
2102 c
&= meta_modifier
| ~ - meta_modifier
;
2103 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
2104 | meta_modifier
| shift_modifier
| super_modifier
);
2106 if (c
& alt_modifier
)
2112 if ((c
& ctrl_modifier
) != 0
2113 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
2117 c
&= ~ctrl_modifier
;
2119 if (c
& hyper_modifier
)
2123 c
-= hyper_modifier
;
2125 if (c
& meta_modifier
)
2131 if (c
& shift_modifier
)
2135 c
-= shift_modifier
;
2137 if (c
& super_modifier
)
2141 c
-= super_modifier
;
2157 else if (c
== Ctl ('M'))
2165 /* `C-' already added above. */
2166 if (c
> 0 && c
<= Ctl ('Z'))
2185 || (NILP (current_buffer
->enable_multibyte_characters
)
2186 && SINGLE_BYTE_CHAR_P (c
)
2187 && !force_multibyte
))
2191 else if (CHARACTERP (make_number (c
)))
2193 if (NILP (current_buffer
->enable_multibyte_characters
)
2194 && ! force_multibyte
)
2195 *p
++ = multibyte_char_to_unibyte (c
, Qnil
);
2197 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2203 /* The biggest character code uses 22 bits. */
2204 for (bit_offset
= 21; bit_offset
>= 0; bit_offset
-= 3)
2206 if (c
>= (1 << bit_offset
))
2207 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2214 /* This function cannot GC. */
2216 DEFUN ("single-key-description", Fsingle_key_description
,
2217 Ssingle_key_description
, 1, 2, 0,
2218 doc
: /* Return a pretty description of command character KEY.
2219 Control characters turn into C-whatever, etc.
2220 Optional argument NO-ANGLES non-nil means don't put angle brackets
2221 around function keys and event symbols. */)
2223 Lisp_Object key
, no_angles
;
2225 if (CONSP (key
) && lucid_event_type_list_p (key
))
2226 key
= Fevent_convert_list (key
);
2228 key
= EVENT_HEAD (key
);
2230 if (INTEGERP (key
)) /* Normal character */
2232 char tem
[KEY_DESCRIPTION_SIZE
];
2234 *push_key_description (XUINT (key
), tem
, 1) = 0;
2235 return build_string (tem
);
2237 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2239 if (NILP (no_angles
))
2242 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2243 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2244 return build_string (buffer
);
2247 return Fsymbol_name (key
);
2249 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2250 return Fcopy_sequence (key
);
2252 error ("KEY must be an integer, cons, symbol, or string");
2257 push_text_char_description (c
, p
)
2258 register unsigned int c
;
2270 *p
++ = c
+ 64; /* 'A' - 1 */
2282 /* This function cannot GC. */
2284 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2285 doc
: /* Return a pretty description of file-character CHARACTER.
2286 Control characters turn into "^char", etc. This differs from
2287 `single-key-description' which turns them into "C-char".
2288 Also, this function recognizes the 2**7 bit as the Meta character,
2289 whereas `single-key-description' uses the 2**27 bit for Meta.
2290 See Info node `(elisp)Describing Characters' for examples. */)
2292 Lisp_Object character
;
2294 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2295 unsigned char str
[6];
2298 CHECK_NUMBER (character
);
2300 c
= XINT (character
);
2301 if (!ASCII_CHAR_P (c
))
2303 int len
= CHAR_STRING (c
, str
);
2305 return make_multibyte_string (str
, 1, len
);
2308 *push_text_char_description (c
& 0377, str
) = 0;
2310 return build_string (str
);
2313 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2316 ascii_sequence_p (seq
)
2320 int len
= XINT (Flength (seq
));
2322 for (i
= 0; i
< len
; i
++)
2324 Lisp_Object ii
, elt
;
2326 XSETFASTINT (ii
, i
);
2327 elt
= Faref (seq
, ii
);
2330 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2338 /* where-is - finding a command in a set of keymaps. */
2340 static Lisp_Object
where_is_internal ();
2341 static Lisp_Object
where_is_internal_1 ();
2342 static void where_is_internal_2 ();
2344 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2345 Returns the first non-nil binding found in any of those maps. */
2348 shadow_lookup (shadow
, key
, flag
)
2349 Lisp_Object shadow
, key
, flag
;
2351 Lisp_Object tail
, value
;
2353 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2355 value
= Flookup_key (XCAR (tail
), key
, flag
);
2356 if (!NILP (value
) && !NATNUMP (value
))
2362 static Lisp_Object Vmouse_events
;
2364 /* This function can GC if Flookup_key autoloads any keymaps. */
2367 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2368 Lisp_Object definition
, keymaps
;
2369 Lisp_Object firstonly
, noindirect
, no_remap
;
2371 Lisp_Object maps
= Qnil
;
2372 Lisp_Object found
, sequences
;
2373 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2374 /* 1 means ignore all menu bindings entirely. */
2375 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2377 /* If this command is remapped, then it has no key bindings
2379 if (NILP (no_remap
) && SYMBOLP (definition
))
2382 if (tem
= Fcommand_remapping (definition
), !NILP (tem
))
2387 while (CONSP (found
))
2391 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2392 found
= XCDR (found
);
2395 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2399 for (; !NILP (maps
); maps
= Fcdr (maps
))
2401 /* Key sequence to reach map, and the map that it reaches */
2402 register Lisp_Object
this, map
, tem
;
2404 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2405 [M-CHAR] sequences, check if last character of the sequence
2406 is the meta-prefix char. */
2410 this = Fcar (Fcar (maps
));
2411 map
= Fcdr (Fcar (maps
));
2412 last
= make_number (XINT (Flength (this)) - 1);
2413 last_is_meta
= (XINT (last
) >= 0
2414 && EQ (Faref (this, last
), meta_prefix_char
));
2416 /* if (nomenus && !ascii_sequence_p (this)) */
2417 if (nomenus
&& XINT (last
) >= 0
2418 && SYMBOLP (tem
= Faref (this, make_number (0)))
2419 && !NILP (Fmemq (XCAR (parse_modifiers (tem
)), Vmouse_events
)))
2420 /* If no menu entries should be returned, skip over the
2421 keymaps bound to `menu-bar' and `tool-bar' and other
2422 non-ascii prefixes like `C-down-mouse-2'. */
2429 /* Because the code we want to run on each binding is rather
2430 large, we don't want to have two separate loop bodies for
2431 sparse keymap bindings and tables; we want to iterate one
2432 loop body over both keymap and vector bindings.
2434 For this reason, if Fcar (map) is a vector, we don't
2435 advance map to the next element until i indicates that we
2436 have finished off the vector. */
2437 Lisp_Object elt
, key
, binding
;
2445 /* Set key and binding to the current key and binding, and
2446 advance map and i to the next binding. */
2449 Lisp_Object sequence
;
2451 /* In a vector, look at each element. */
2452 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2454 binding
= AREF (elt
, i
);
2455 XSETFASTINT (key
, i
);
2456 sequence
= where_is_internal_1 (binding
, key
, definition
,
2458 last
, nomenus
, last_is_meta
);
2459 if (!NILP (sequence
))
2460 sequences
= Fcons (sequence
, sequences
);
2463 else if (CHAR_TABLE_P (elt
))
2467 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2468 Qnil
), /* Result accumulator. */
2469 Fcons (Fcons (this, last
),
2470 Fcons (make_number (nomenus
),
2471 make_number (last_is_meta
))));
2472 map_char_table (where_is_internal_2
, Qnil
, elt
, args
);
2473 sequences
= XCDR (XCAR (args
));
2475 else if (CONSP (elt
))
2477 Lisp_Object sequence
;
2480 binding
= XCDR (elt
);
2482 sequence
= where_is_internal_1 (binding
, key
, definition
,
2484 last
, nomenus
, last_is_meta
);
2485 if (!NILP (sequence
))
2486 sequences
= Fcons (sequence
, sequences
);
2490 while (!NILP (sequences
))
2492 Lisp_Object sequence
, remapped
, function
;
2494 sequence
= XCAR (sequences
);
2495 sequences
= XCDR (sequences
);
2497 /* If the current sequence is a command remapping with
2498 format [remap COMMAND], find the key sequences
2499 which run COMMAND, and use those sequences instead. */
2502 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2503 && EQ (AREF (sequence
, 0), Qremap
)
2504 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2506 Lisp_Object remapped1
;
2508 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2509 if (CONSP (remapped1
))
2511 /* Verify that this key binding actually maps to the
2512 remapped command (see below). */
2513 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2515 sequence
= XCAR (remapped1
);
2516 remapped
= XCDR (remapped1
);
2517 goto record_sequence
;
2521 /* Verify that this key binding is not shadowed by another
2522 binding for the same key, before we say it exists.
2524 Mechanism: look for local definition of this key and if
2525 it is defined and does not match what we found then
2528 Either nil or number as value from Flookup_key
2530 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2534 /* It is a true unshadowed match. Record it, unless it's already
2535 been seen (as could happen when inheriting keymaps). */
2536 if (NILP (Fmember (sequence
, found
)))
2537 found
= Fcons (sequence
, found
);
2539 /* If firstonly is Qnon_ascii, then we can return the first
2540 binding we find. If firstonly is not Qnon_ascii but not
2541 nil, then we should return the first ascii-only binding
2543 if (EQ (firstonly
, Qnon_ascii
))
2544 RETURN_UNGCPRO (sequence
);
2545 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2546 RETURN_UNGCPRO (sequence
);
2548 if (CONSP (remapped
))
2550 sequence
= XCAR (remapped
);
2551 remapped
= XCDR (remapped
);
2552 goto record_sequence
;
2560 found
= Fnreverse (found
);
2562 /* firstonly may have been t, but we may have gone all the way through
2563 the keymaps without finding an all-ASCII key sequence. So just
2564 return the best we could find. */
2565 if (!NILP (firstonly
))
2566 return Fcar (found
);
2571 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2572 doc
: /* Return list of keys that invoke DEFINITION.
2573 If KEYMAP is a keymap, search only KEYMAP and the global keymap.
2574 If KEYMAP is nil, search all the currently active keymaps.
2575 If KEYMAP is a list of keymaps, search only those keymaps.
2577 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2578 rather than a list of all possible key sequences.
2579 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2580 no matter what it is.
2581 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters
2582 \(or their meta variants) and entirely reject menu bindings.
2584 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2585 to other keymaps or slots. This makes it possible to search for an
2586 indirect definition itself.
2588 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2589 that invoke a command which is remapped to DEFINITION, but include the
2590 remapped command in the returned list. */)
2591 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2592 Lisp_Object definition
, keymap
;
2593 Lisp_Object firstonly
, noindirect
, no_remap
;
2595 Lisp_Object sequences
, keymaps
;
2596 /* 1 means ignore all menu bindings entirely. */
2597 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2600 /* Find the relevant keymaps. */
2601 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2603 else if (!NILP (keymap
))
2604 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2606 keymaps
= Fcurrent_active_maps (Qnil
);
2608 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2609 We don't really need to check `keymap'. */
2610 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2614 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2616 /* Check heuristic-consistency of the cache. */
2617 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2618 where_is_cache
= Qnil
;
2620 if (NILP (where_is_cache
))
2622 /* We need to create the cache. */
2623 Lisp_Object args
[2];
2624 where_is_cache
= Fmake_hash_table (0, args
);
2625 where_is_cache_keymaps
= Qt
;
2627 /* Fill in the cache. */
2628 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2629 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2632 where_is_cache_keymaps
= keymaps
;
2635 /* We want to process definitions from the last to the first.
2636 Instead of consing, copy definitions to a vector and step
2637 over that vector. */
2638 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2639 n
= XINT (Flength (sequences
));
2640 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2641 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2642 defns
[i
++] = XCAR (sequences
);
2644 /* Verify that the key bindings are not shadowed. Note that
2645 the following can GC. */
2646 GCPRO2 (definition
, keymaps
);
2649 for (i
= n
- 1; i
>= 0; --i
)
2650 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2652 if (ascii_sequence_p (defns
[i
]))
2658 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2663 /* Kill the cache so that where_is_internal_1 doesn't think
2664 we're filling it up. */
2665 where_is_cache
= Qnil
;
2666 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2672 /* This is the function that Fwhere_is_internal calls using map_char_table.
2674 (((DEFINITION . NOINDIRECT) . RESULT)
2676 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2677 Since map_char_table doesn't really use the return value from this function,
2678 we the result append to RESULT, the slot in ARGS.
2680 KEY may be a cons (FROM . TO) where both FROM and TO are integers
2681 (i.e. character events).
2683 This function can GC because it calls where_is_internal_1 which can
2687 where_is_internal_2 (args
, key
, binding
)
2688 Lisp_Object args
, key
, binding
;
2690 Lisp_Object definition
, noindirect
, this, last
;
2691 Lisp_Object result
, sequence
;
2692 int nomenus
, last_is_meta
;
2693 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2695 GCPRO3 (args
, key
, binding
);
2696 definition
= XCAR (XCAR (XCAR (args
)));
2697 noindirect
= XCDR (XCAR (XCAR (args
)));
2698 this = XCAR (XCAR (XCDR (args
)));
2699 last
= XCDR (XCAR (XCDR (args
)));
2700 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2701 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2704 if (CONSP (key
) && INTEGERP (XCAR (key
)) && INTEGERP (XCDR (key
)))
2706 /* Try all ASCII characters. Try also non-ASCII characters but
2707 only the first and last one because trying all of them is
2708 extremely memory and time consuming.
2710 Fixme: Perhaps it should be allowed to store a cons directly
2711 in RESULT. -- handa@m17n.org */
2712 int from
= XINT (XCAR (key
)), to
= XINT (XCDR (key
));
2715 for (; from
<= to
; to
--)
2717 k
= make_number (to
);
2718 sequence
= where_is_internal_1 (binding
, k
, definition
, noindirect
,
2719 this, last
, nomenus
, last_is_meta
);
2720 if (!NILP (sequence
))
2721 result
= Fcons (sequence
, result
);
2728 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2729 this, last
, nomenus
, last_is_meta
);
2730 if (!NILP (sequence
))
2731 result
= Fcons (sequence
, Qnil
);
2734 if (! NILP (result
))
2735 nconc2 (XCAR (args
), result
);
2741 /* This function cannot GC. */
2744 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2745 nomenus
, last_is_meta
)
2746 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2747 int nomenus
, last_is_meta
;
2749 Lisp_Object sequence
;
2751 /* Search through indirections unless that's not wanted. */
2752 if (NILP (noindirect
))
2753 binding
= get_keyelt (binding
, 0);
2755 /* End this iteration if this element does not match
2758 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2759 || EQ (binding
, definition
)
2760 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2761 /* Doesn't match. */
2764 /* We have found a match. Construct the key sequence where we found it. */
2765 if (INTEGERP (key
) && last_is_meta
)
2767 sequence
= Fcopy_sequence (this);
2768 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2771 sequence
= append_key (this, key
);
2773 if (!NILP (where_is_cache
))
2775 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2776 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2783 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2785 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2786 doc
: /* Insert the list of all defined keys and their definitions.
2787 The list is inserted in the current buffer, while the bindings are
2788 looked up in BUFFER.
2789 The optional argument PREFIX, if non-nil, should be a key sequence;
2790 then we display only bindings that start with that prefix.
2791 The optional argument MENUS, if non-nil, says to mention menu bindings.
2792 \(Ordinarily these are omitted from the output.) */)
2793 (buffer
, prefix
, menus
)
2794 Lisp_Object buffer
, prefix
, menus
;
2796 Lisp_Object outbuf
, shadow
;
2797 int nomenu
= NILP (menus
);
2798 register Lisp_Object start1
;
2799 struct gcpro gcpro1
;
2801 char *alternate_heading
2803 Keyboard translations:\n\n\
2804 You type Translation\n\
2805 -------- -----------\n";
2810 outbuf
= Fcurrent_buffer ();
2812 /* Report on alternates for keys. */
2813 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2816 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2817 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2819 for (c
= 0; c
< translate_len
; c
++)
2820 if (translate
[c
] != c
)
2822 char buf
[KEY_DESCRIPTION_SIZE
];
2825 if (alternate_heading
)
2827 insert_string (alternate_heading
);
2828 alternate_heading
= 0;
2831 bufend
= push_key_description (translate
[c
], buf
, 1);
2832 insert (buf
, bufend
- buf
);
2833 Findent_to (make_number (16), make_number (1));
2834 bufend
= push_key_description (c
, buf
, 1);
2835 insert (buf
, bufend
- buf
);
2843 if (!NILP (Vkey_translation_map
))
2844 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2845 "Key translations", nomenu
, 1, 0);
2848 /* Print the (major mode) local map. */
2850 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2851 start1
= current_kboard
->Voverriding_terminal_local_map
;
2852 else if (!NILP (Voverriding_local_map
))
2853 start1
= Voverriding_local_map
;
2857 describe_map_tree (start1
, 1, shadow
, prefix
,
2858 "\f\nOverriding Bindings", nomenu
, 0, 0);
2859 shadow
= Fcons (start1
, shadow
);
2863 /* Print the minor mode and major mode keymaps. */
2865 Lisp_Object
*modes
, *maps
;
2867 /* Temporarily switch to `buffer', so that we can get that buffer's
2868 minor modes correctly. */
2869 Fset_buffer (buffer
);
2871 nmaps
= current_minor_maps (&modes
, &maps
);
2872 Fset_buffer (outbuf
);
2874 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2875 XBUFFER (buffer
), Qkeymap
);
2878 describe_map_tree (start1
, 1, shadow
, prefix
,
2879 "\f\n`keymap' Property Bindings", nomenu
, 0, 0);
2880 shadow
= Fcons (start1
, shadow
);
2883 /* Print the minor mode maps. */
2884 for (i
= 0; i
< nmaps
; i
++)
2886 /* The title for a minor mode keymap
2887 is constructed at run time.
2888 We let describe_map_tree do the actual insertion
2889 because it takes care of other features when doing so. */
2892 if (!SYMBOLP (modes
[i
]))
2895 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2899 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2900 SCHARS (SYMBOL_NAME (modes
[i
])));
2901 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2903 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2904 p
+= sizeof (" Minor Mode Bindings") - 1;
2907 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2908 shadow
= Fcons (maps
[i
], shadow
);
2911 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2912 XBUFFER (buffer
), Qlocal_map
);
2915 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2916 describe_map_tree (start1
, 1, shadow
, prefix
,
2917 "\f\nMajor Mode Bindings", nomenu
, 0, 0);
2919 describe_map_tree (start1
, 1, shadow
, prefix
,
2920 "\f\n`local-map' Property Bindings",
2923 shadow
= Fcons (start1
, shadow
);
2927 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2928 "\f\nGlobal Bindings", nomenu
, 0, 1);
2930 /* Print the function-key-map translations under this prefix. */
2931 if (!NILP (Vfunction_key_map
))
2932 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2933 "\f\nFunction key map translations", nomenu
, 1, 0);
2939 /* Insert a description of the key bindings in STARTMAP,
2940 followed by those of all maps reachable through STARTMAP.
2941 If PARTIAL is nonzero, omit certain "uninteresting" commands
2942 (such as `undefined').
2943 If SHADOW is non-nil, it is a list of maps;
2944 don't mention keys which would be shadowed by any of them.
2945 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2946 TITLE, if not 0, is a string to insert at the beginning.
2947 TITLE should not end with a colon or a newline; we supply that.
2948 If NOMENU is not 0, then omit menu-bar commands.
2950 If TRANSL is nonzero, the definitions are actually key translations
2951 so print strings and vectors differently.
2953 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2957 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2959 Lisp_Object startmap
, shadow
, prefix
;
2966 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2967 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2974 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2977 GCPRO3 (maps
, seen
, sub_shadows
);
2983 /* Delete from MAPS each element that is for the menu bar. */
2984 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2986 Lisp_Object elt
, prefix
, tem
;
2989 prefix
= Fcar (elt
);
2990 if (XVECTOR (prefix
)->size
>= 1)
2992 tem
= Faref (prefix
, make_number (0));
2993 if (EQ (tem
, Qmenu_bar
))
2994 maps
= Fdelq (elt
, maps
);
2999 if (!NILP (maps
) || always_title
)
3003 insert_string (title
);
3006 insert_string (" Starting With ");
3007 insert1 (Fkey_description (prefix
, Qnil
));
3009 insert_string (":\n");
3011 insert_string (key_heading
);
3015 for (; !NILP (maps
); maps
= Fcdr (maps
))
3017 register Lisp_Object elt
, prefix
, tail
;
3020 prefix
= Fcar (elt
);
3024 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
3028 shmap
= XCAR (tail
);
3030 /* If the sequence by which we reach this keymap is zero-length,
3031 then the shadow map for this keymap is just SHADOW. */
3032 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
3033 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
3035 /* If the sequence by which we reach this keymap actually has
3036 some elements, then the sequence's definition in SHADOW is
3037 what we should use. */
3040 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
3041 if (INTEGERP (shmap
))
3045 /* If shmap is not nil and not a keymap,
3046 it completely shadows this map, so don't
3047 describe this map at all. */
3048 if (!NILP (shmap
) && !KEYMAPP (shmap
))
3052 sub_shadows
= Fcons (shmap
, sub_shadows
);
3055 /* Maps we have already listed in this loop shadow this map. */
3056 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
3059 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
3061 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
3064 describe_map (Fcdr (elt
), prefix
,
3065 transl
? describe_translation
: describe_command
,
3066 partial
, sub_shadows
, &seen
, nomenu
);
3072 insert_string ("\n");
3077 static int previous_description_column
;
3080 describe_command (definition
, args
)
3081 Lisp_Object definition
, args
;
3083 register Lisp_Object tem1
;
3084 int column
= (int) current_column (); /* iftc */
3085 int description_column
;
3087 /* If column 16 is no good, go to col 32;
3088 but don't push beyond that--go to next line instead. */
3092 description_column
= 32;
3094 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
3095 description_column
= 32;
3097 description_column
= 16;
3099 Findent_to (make_number (description_column
), make_number (1));
3100 previous_description_column
= description_column
;
3102 if (SYMBOLP (definition
))
3104 tem1
= SYMBOL_NAME (definition
);
3106 insert_string ("\n");
3108 else if (STRINGP (definition
) || VECTORP (definition
))
3109 insert_string ("Keyboard Macro\n");
3110 else if (KEYMAPP (definition
))
3111 insert_string ("Prefix Command\n");
3113 insert_string ("??\n");
3117 describe_translation (definition
, args
)
3118 Lisp_Object definition
, args
;
3120 register Lisp_Object tem1
;
3122 Findent_to (make_number (16), make_number (1));
3124 if (SYMBOLP (definition
))
3126 tem1
= SYMBOL_NAME (definition
);
3128 insert_string ("\n");
3130 else if (STRINGP (definition
) || VECTORP (definition
))
3132 insert1 (Fkey_description (definition
, Qnil
));
3133 insert_string ("\n");
3135 else if (KEYMAPP (definition
))
3136 insert_string ("Prefix Command\n");
3138 insert_string ("??\n");
3141 /* Describe the contents of map MAP, assuming that this map itself is
3142 reached by the sequence of prefix keys PREFIX (a string or vector).
3143 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3146 describe_map (map
, prefix
, elt_describer
, partial
, shadow
, seen
, nomenu
)
3147 register Lisp_Object map
;
3149 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3155 Lisp_Object tail
, definition
, event
;
3157 Lisp_Object suppress
;
3160 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3165 suppress
= intern ("suppress-keymap");
3167 /* This vector gets used to present single keys to Flookup_key. Since
3168 that is done once per keymap element, we don't want to cons up a
3169 fresh vector every time. */
3170 kludge
= Fmake_vector (make_number (1), Qnil
);
3173 GCPRO3 (prefix
, definition
, kludge
);
3175 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3179 if (VECTORP (XCAR (tail
))
3180 || CHAR_TABLE_P (XCAR (tail
)))
3181 describe_vector (XCAR (tail
),
3182 prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3184 else if (CONSP (XCAR (tail
)))
3186 event
= XCAR (XCAR (tail
));
3188 /* Ignore bindings whose "prefix" are not really valid events.
3189 (We get these in the frames and buffers menu.) */
3190 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3193 if (nomenu
&& EQ (event
, Qmenu_bar
))
3196 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3198 /* Don't show undefined commands or suppressed commands. */
3199 if (NILP (definition
)) continue;
3200 if (SYMBOLP (definition
) && partial
)
3202 tem
= Fget (definition
, suppress
);
3207 /* Don't show a command that isn't really visible
3208 because a local definition of the same key shadows it. */
3210 ASET (kludge
, 0, event
);
3213 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3214 if (!NILP (tem
)) continue;
3217 tem
= Flookup_key (map
, kludge
, Qt
);
3218 if (!EQ (tem
, definition
)) continue;
3222 previous_description_column
= 0;
3227 /* THIS gets the string to describe the character EVENT. */
3228 insert1 (Fkey_description (kludge
, prefix
));
3230 /* Print a description of the definition of this character.
3231 elt_describer will take care of spacing out far enough
3232 for alignment purposes. */
3233 (*elt_describer
) (definition
, Qnil
);
3235 else if (EQ (XCAR (tail
), Qkeymap
))
3237 /* The same keymap might be in the structure twice, if we're
3238 using an inherited keymap. So skip anything we've already
3240 tem
= Fassq (tail
, *seen
);
3241 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), prefix
)))
3243 *seen
= Fcons (Fcons (tail
, prefix
), *seen
);
3251 describe_vector_princ (elt
, fun
)
3252 Lisp_Object elt
, fun
;
3254 Findent_to (make_number (16), make_number (1));
3259 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3260 doc
: /* Insert a description of contents of VECTOR.
3261 This is text showing the elements of vector matched against indices.
3262 DESCRIBER is the output function used; nil means use `princ'. */)
3264 Lisp_Object vector
, describer
;
3266 int count
= SPECPDL_INDEX ();
3267 if (NILP (describer
))
3268 describer
= intern ("princ");
3269 specbind (Qstandard_output
, Fcurrent_buffer ());
3270 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3271 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3272 Qnil
, Qnil
, (int *)0, 0, 0);
3274 return unbind_to (count
, Qnil
);
3277 /* Insert in the current buffer a description of the contents of VECTOR.
3278 We call ELT_DESCRIBER to insert the description of one value found
3281 ELT_PREFIX describes what "comes before" the keys or indices defined
3282 by this vector. This is a human-readable string whose size
3283 is not necessarily related to the situation.
3285 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3286 leads to this keymap.
3288 If the vector is a chartable, ELT_PREFIX is the vector
3289 of bytes that lead to the character set or portion of a character
3290 set described by this chartable.
3292 If PARTIAL is nonzero, it means do not mention suppressed commands
3293 (that assumes the vector is in a keymap).
3295 SHADOW is a list of keymaps that shadow this map.
3296 If it is non-nil, then we look up the key in those maps
3297 and we don't mention it now if it is defined by any of them.
3299 ENTIRE_MAP is the keymap in which this vector appears.
3300 If the definition in effect in the whole map does not match
3301 the one in this vector, we ignore this one.
3303 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3305 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3308 KEYMAP_P is 1 if vector is known to be a keymap, so map ESC to M-.
3310 ARGS is simply passed as the second argument to ELT_DESCRIBER. */
3313 describe_vector (vector
, prefix
, args
, elt_describer
,
3314 partial
, shadow
, entire_map
,
3315 indices
, char_table_depth
, keymap_p
)
3316 register Lisp_Object vector
;
3317 Lisp_Object prefix
, args
;
3318 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3321 Lisp_Object entire_map
;
3323 int char_table_depth
;
3326 Lisp_Object definition
;
3328 Lisp_Object elt_prefix
= Qnil
;
3330 Lisp_Object suppress
;
3333 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
3334 /* Range of elements to be handled. */
3336 Lisp_Object character
;
3345 /* Call Fkey_description first, to avoid GC bug for the other string. */
3346 if (!NILP (prefix
) && XFASTINT (Flength (prefix
)) > 0)
3349 tem
= Fkey_description (prefix
, Qnil
);
3350 elt_prefix
= concat2 (tem
, build_string (" "));
3355 /* This vector gets used to present single keys to Flookup_key. Since
3356 that is done once per vector element, we don't want to cons up a
3357 fresh vector every time. */
3358 kludge
= Fmake_vector (make_number (1), Qnil
);
3359 GCPRO4 (elt_prefix
, prefix
, definition
, kludge
);
3362 suppress
= intern ("suppress-keymap");
3365 to
= CHAR_TABLE_P (vector
) ? MAX_CHAR
+ 1 : XVECTOR (vector
)->size
;
3367 for (i
= from
; i
< to
; i
++)
3369 int range_beg
, range_end
;
3376 if (CHAR_TABLE_P (vector
))
3377 val
= char_table_ref_and_range (vector
, i
, &range_beg
, &i
);
3379 val
= AREF (vector
, i
);
3380 definition
= get_keyelt (val
, 0);
3382 if (NILP (definition
)) continue;
3384 /* Don't mention suppressed commands. */
3385 if (SYMBOLP (definition
) && partial
)
3389 tem
= Fget (definition
, suppress
);
3391 if (!NILP (tem
)) continue;
3394 character
= make_number (starting_i
);
3395 ASET (kludge
, 0, character
);
3397 /* If this binding is shadowed by some other map, ignore it. */
3402 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3404 if (!NILP (tem
)) continue;
3407 /* Ignore this definition if it is shadowed by an earlier
3408 one in the same keymap. */
3409 if (!NILP (entire_map
))
3413 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3415 if (!EQ (tem
, definition
))
3425 /* Output the prefix that applies to every entry in this map. */
3426 if (!NILP (elt_prefix
))
3427 insert1 (elt_prefix
);
3429 insert1 (Fkey_description (kludge
, prefix
));
3431 /* Find all consecutive characters or rows that have the same
3432 definition. But, for elements of a top level char table, if
3433 they are for charsets, we had better describe one by one even
3434 if they have the same definition. */
3435 if (CHAR_TABLE_P (vector
))
3437 && (val
= char_table_ref_and_range (vector
, i
+ 1,
3438 &range_beg
, &range_end
),
3439 tem2
= get_keyelt (val
, 0),
3441 && !NILP (Fequal (tem2
, definition
)))
3445 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3447 && !NILP (Fequal (tem2
, definition
)))
3450 /* If we have a range of more than one character,
3451 print where the range reaches to. */
3453 if (i
!= starting_i
)
3457 ASET (kludge
, 0, make_number (i
));
3459 if (!NILP (elt_prefix
))
3460 insert1 (elt_prefix
);
3462 insert1 (Fkey_description (kludge
, prefix
));
3465 /* Print a description of the definition of this character.
3466 elt_describer will take care of spacing out far enough
3467 for alignment purposes. */
3468 (*elt_describer
) (definition
, args
);
3471 if (CHAR_TABLE_P (vector
) && ! NILP (XCHAR_TABLE (vector
)->defalt
))
3473 if (!NILP (elt_prefix
))
3474 insert1 (elt_prefix
);
3475 insert ("default", 7);
3476 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3482 /* Apropos - finding all symbols whose names match a regexp. */
3483 static Lisp_Object apropos_predicate
;
3484 static Lisp_Object apropos_accumulate
;
3487 apropos_accum (symbol
, string
)
3488 Lisp_Object symbol
, string
;
3490 register Lisp_Object tem
;
3492 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3493 if (!NILP (tem
) && !NILP (apropos_predicate
))
3494 tem
= call1 (apropos_predicate
, symbol
);
3496 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3499 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3500 doc
: /* Show all symbols whose names contain match for REGEXP.
3501 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3502 for each symbol and a symbol is mentioned only if that returns non-nil.
3503 Return list of symbols found. */)
3505 Lisp_Object regexp
, predicate
;
3508 CHECK_STRING (regexp
);
3509 apropos_predicate
= predicate
;
3510 apropos_accumulate
= Qnil
;
3511 map_obarray (Vobarray
, apropos_accum
, regexp
);
3512 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3513 apropos_accumulate
= Qnil
;
3514 apropos_predicate
= Qnil
;
3521 Qkeymap
= intern ("keymap");
3522 staticpro (&Qkeymap
);
3523 staticpro (&apropos_predicate
);
3524 staticpro (&apropos_accumulate
);
3525 apropos_predicate
= Qnil
;
3526 apropos_accumulate
= Qnil
;
3528 /* Now we are ready to set up this property, so we can
3529 create char tables. */
3530 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3532 /* Initialize the keymaps standardly used.
3533 Each one is the value of a Lisp variable, and is also
3534 pointed to by a C variable */
3536 global_map
= Fmake_keymap (Qnil
);
3537 Fset (intern ("global-map"), global_map
);
3539 current_global_map
= global_map
;
3540 staticpro (&global_map
);
3541 staticpro (¤t_global_map
);
3543 meta_map
= Fmake_keymap (Qnil
);
3544 Fset (intern ("esc-map"), meta_map
);
3545 Ffset (intern ("ESC-prefix"), meta_map
);
3547 control_x_map
= Fmake_keymap (Qnil
);
3548 Fset (intern ("ctl-x-map"), control_x_map
);
3549 Ffset (intern ("Control-X-prefix"), control_x_map
);
3552 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3553 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3554 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3555 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3556 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3558 staticpro (&exclude_keys
);
3560 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3561 doc
: /* List of commands given new key bindings recently.
3562 This is used for internal purposes during Emacs startup;
3563 don't alter it yourself. */);
3564 Vdefine_key_rebound_commands
= Qt
;
3566 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3567 doc
: /* Default keymap to use when reading from the minibuffer. */);
3568 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3570 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3571 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3572 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3573 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3575 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3576 doc
: /* Local keymap for minibuffer input with completion. */);
3577 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3578 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3580 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3581 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3582 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3583 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3584 Vminibuffer_local_completion_map
);
3586 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3587 doc
: /* Alist of keymaps to use for minor modes.
3588 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3589 key sequences and look up bindings iff VARIABLE's value is non-nil.
3590 If two active keymaps bind the same key, the keymap appearing earlier
3591 in the list takes precedence. */);
3592 Vminor_mode_map_alist
= Qnil
;
3594 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3595 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3596 This variable is an alist just like `minor-mode-map-alist', and it is
3597 used the same way (and before `minor-mode-map-alist'); however,
3598 it is provided for major modes to bind locally. */);
3599 Vminor_mode_overriding_map_alist
= Qnil
;
3601 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3602 doc
: /* List of keymap alists to use for emulations modes.
3603 It is intended for modes or packages using multiple minor-mode keymaps.
3604 Each element is a keymap alist just like `minor-mode-map-alist', or a
3605 symbol with a variable binding which is a keymap alist, and it is used
3606 the same way. The "active" keymaps in each alist are used before
3607 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3608 Vemulation_mode_map_alists
= Qnil
;
3611 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3612 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3613 This allows Emacs to recognize function keys sent from ASCII
3614 terminals at any point in a key sequence.
3616 The `read-key-sequence' function replaces any subsequence bound by
3617 `function-key-map' with its binding. More precisely, when the active
3618 keymaps have no binding for the current key sequence but
3619 `function-key-map' binds a suffix of the sequence to a vector or string,
3620 `read-key-sequence' replaces the matching suffix with its binding, and
3621 continues with the new sequence.
3623 The events that come from bindings in `function-key-map' are not
3624 themselves looked up in `function-key-map'.
3626 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3627 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3628 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3629 key, typing `ESC O P x' would return [f1 x]. */);
3630 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3632 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3633 doc
: /* Keymap of key translations that can override keymaps.
3634 This keymap works like `function-key-map', but comes after that,
3635 and its non-prefix bindings override ordinary bindings. */);
3636 Vkey_translation_map
= Qnil
;
3638 staticpro (&Vmouse_events
);
3639 Vmouse_events
= Fcons (intern ("menu-bar"),
3640 Fcons (intern ("tool-bar"),
3641 Fcons (intern ("header-line"),
3642 Fcons (intern ("mode-line"),
3643 Fcons (intern ("mouse-1"),
3644 Fcons (intern ("mouse-2"),
3645 Fcons (intern ("mouse-3"),
3646 Fcons (intern ("mouse-4"),
3647 Fcons (intern ("mouse-5"),
3651 Qsingle_key_description
= intern ("single-key-description");
3652 staticpro (&Qsingle_key_description
);
3654 Qkey_description
= intern ("key-description");
3655 staticpro (&Qkey_description
);
3657 Qkeymapp
= intern ("keymapp");
3658 staticpro (&Qkeymapp
);
3660 Qnon_ascii
= intern ("non-ascii");
3661 staticpro (&Qnon_ascii
);
3663 Qmenu_item
= intern ("menu-item");
3664 staticpro (&Qmenu_item
);
3666 Qremap
= intern ("remap");
3667 staticpro (&Qremap
);
3669 command_remapping_vector
= Fmake_vector (make_number (2), Qremap
);
3670 staticpro (&command_remapping_vector
);
3672 where_is_cache_keymaps
= Qt
;
3673 where_is_cache
= Qnil
;
3674 staticpro (&where_is_cache
);
3675 staticpro (&where_is_cache_keymaps
);
3677 defsubr (&Skeymapp
);
3678 defsubr (&Skeymap_parent
);
3679 defsubr (&Skeymap_prompt
);
3680 defsubr (&Sset_keymap_parent
);
3681 defsubr (&Smake_keymap
);
3682 defsubr (&Smake_sparse_keymap
);
3683 defsubr (&Smap_keymap
);
3684 defsubr (&Scopy_keymap
);
3685 defsubr (&Scommand_remapping
);
3686 defsubr (&Skey_binding
);
3687 defsubr (&Slocal_key_binding
);
3688 defsubr (&Sglobal_key_binding
);
3689 defsubr (&Sminor_mode_key_binding
);
3690 defsubr (&Sdefine_key
);
3691 defsubr (&Slookup_key
);
3692 defsubr (&Sdefine_prefix_command
);
3693 defsubr (&Suse_global_map
);
3694 defsubr (&Suse_local_map
);
3695 defsubr (&Scurrent_local_map
);
3696 defsubr (&Scurrent_global_map
);
3697 defsubr (&Scurrent_minor_mode_maps
);
3698 defsubr (&Scurrent_active_maps
);
3699 defsubr (&Saccessible_keymaps
);
3700 defsubr (&Skey_description
);
3701 defsubr (&Sdescribe_vector
);
3702 defsubr (&Ssingle_key_description
);
3703 defsubr (&Stext_char_description
);
3704 defsubr (&Swhere_is_internal
);
3705 defsubr (&Sdescribe_buffer_bindings
);
3706 defsubr (&Sapropos_internal
);
3712 initial_define_key (global_map
, 033, "ESC-prefix");
3713 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");
3716 /* arch-tag: 6dd15c26-7cf1-41c4-b904-f42f7ddda463
3717 (do not change this comment) */