1 /* Manipulation of keymaps
2 Copyright (C) 1985, 86,87,88,93,94,95,98,99, 2000, 2001
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 silly_event_symbol_error
P_ ((Lisp_Object
));
127 /* Keymap object support - constructors and predicates. */
129 DEFUN ("make-keymap", Fmake_keymap
, Smake_keymap
, 0, 1, 0,
130 doc
: /* Construct and return a new keymap, of the form (keymap CHARTABLE . ALIST).
131 CHARTABLE is a char-table that holds the bindings for the ASCII
132 characters. ALIST is an assoc-list which holds bindings for function keys,
133 mouse events, and any other things that appear in the input stream.
134 All entries in it are initially nil, meaning "command undefined".
136 The optional arg STRING supplies a menu name for the keymap
137 in case you use it as a menu with `x-popup-menu'. */)
143 tail
= Fcons (string
, Qnil
);
146 return Fcons (Qkeymap
,
147 Fcons (Fmake_char_table (Qkeymap
, Qnil
), tail
));
150 DEFUN ("make-sparse-keymap", Fmake_sparse_keymap
, Smake_sparse_keymap
, 0, 1, 0,
151 doc
: /* Construct and return a new sparse keymap.
152 Its car is `keymap' and its cdr is an alist of (CHAR . DEFINITION),
153 which binds the character CHAR to DEFINITION, or (SYMBOL . DEFINITION),
154 which binds the function key or mouse event SYMBOL to DEFINITION.
155 Initially the alist is nil.
157 The optional arg STRING supplies a menu name for the keymap
158 in case you use it as a menu with `x-popup-menu'. */)
163 return Fcons (Qkeymap
, Fcons (string
, Qnil
));
164 return Fcons (Qkeymap
, Qnil
);
167 /* This function is used for installing the standard key bindings
168 at initialization time.
172 initial_define_key (control_x_map, Ctl('X'), "exchange-point-and-mark"); */
175 initial_define_key (keymap
, key
, defname
)
180 store_in_keymap (keymap
, make_number (key
), intern (defname
));
184 initial_define_lispy_key (keymap
, keyname
, defname
)
189 store_in_keymap (keymap
, intern (keyname
), intern (defname
));
192 DEFUN ("keymapp", Fkeymapp
, Skeymapp
, 1, 1, 0,
193 doc
: /* Return t if OBJECT is a keymap.
195 A keymap is a list (keymap . ALIST),
196 or a symbol whose function definition is itself a keymap.
197 ALIST elements look like (CHAR . DEFN) or (SYMBOL . DEFN);
198 a vector of densely packed bindings for small character codes
199 is also allowed as an element. */)
203 return (KEYMAPP (object
) ? Qt
: Qnil
);
206 DEFUN ("keymap-prompt", Fkeymap_prompt
, Skeymap_prompt
, 1, 1, 0,
207 doc
: /* Return the prompt-string of a keymap MAP.
208 If non-nil, the prompt is shown in the echo-area
209 when reading a key-sequence to be looked-up in this keymap. */)
215 register Lisp_Object tem
;
224 /* Check that OBJECT is a keymap (after dereferencing through any
225 symbols). If it is, return it.
227 If AUTOLOAD is non-zero and OBJECT is a symbol whose function value
228 is an autoload form, do the autoload and try again.
229 If AUTOLOAD is nonzero, callers must assume GC is possible.
231 If the map needs to be autoloaded, but AUTOLOAD is zero (and ERROR
232 is zero as well), return Qt.
234 ERROR controls how we respond if OBJECT isn't a keymap.
235 If ERROR is non-zero, signal an error; otherwise, just return Qnil.
237 Note that most of the time, we don't want to pursue autoloads.
238 Functions like Faccessible_keymaps which scan entire keymap trees
239 shouldn't load every autoloaded keymap. I'm not sure about this,
240 but it seems to me that only read_key_sequence, Flookup_key, and
241 Fdefine_key should cause keymaps to be autoloaded.
243 This function can GC when AUTOLOAD is non-zero, because it calls
244 do_autoload which can GC. */
247 get_keymap (object
, error
, autoload
)
256 if (CONSP (object
) && EQ (XCAR (object
), Qkeymap
))
259 tem
= indirect_function (object
);
262 if (EQ (XCAR (tem
), Qkeymap
))
265 /* Should we do an autoload? Autoload forms for keymaps have
266 Qkeymap as their fifth element. */
267 if ((autoload
|| !error
) && EQ (XCAR (tem
), Qautoload
))
271 tail
= Fnth (make_number (4), tem
);
272 if (EQ (tail
, Qkeymap
))
276 struct gcpro gcpro1
, gcpro2
;
278 GCPRO2 (tem
, object
);
279 do_autoload (tem
, object
);
292 wrong_type_argument (Qkeymapp
, object
);
296 /* Return the parent map of KEYMAP, or nil if it has none.
297 We assume that KEYMAP is a valid keymap. */
300 keymap_parent (keymap
, autoload
)
306 keymap
= get_keymap (keymap
, 1, autoload
);
308 /* Skip past the initial element `keymap'. */
309 list
= XCDR (keymap
);
310 for (; CONSP (list
); list
= XCDR (list
))
312 /* See if there is another `keymap'. */
317 return get_keymap (list
, 0, autoload
);
320 DEFUN ("keymap-parent", Fkeymap_parent
, Skeymap_parent
, 1, 1, 0,
321 doc
: /* Return the parent keymap of KEYMAP. */)
325 return keymap_parent (keymap
, 1);
328 /* Check whether MAP is one of MAPS parents. */
330 keymap_memberp (map
, maps
)
331 Lisp_Object map
, maps
;
333 if (NILP (map
)) return 0;
334 while (KEYMAPP (maps
) && !EQ (map
, maps
))
335 maps
= keymap_parent (maps
, 0);
336 return (EQ (map
, maps
));
339 /* Set the parent keymap of MAP to PARENT. */
341 DEFUN ("set-keymap-parent", Fset_keymap_parent
, Sset_keymap_parent
, 2, 2, 0,
342 doc
: /* Modify KEYMAP to set its parent map to PARENT.
343 PARENT should be nil or another keymap. */)
345 Lisp_Object keymap
, parent
;
347 Lisp_Object list
, prev
;
348 struct gcpro gcpro1
, gcpro2
;
351 /* Force a keymap flush for the next call to where-is.
352 Since this can be called from within where-is, we don't set where_is_cache
353 directly but only where_is_cache_keymaps, since where_is_cache shouldn't
354 be changed during where-is, while where_is_cache_keymaps is only used at
355 the very beginning of where-is and can thus be changed here without any
357 This is a very minor correctness (rather than safety) issue. */
358 where_is_cache_keymaps
= Qt
;
360 GCPRO2 (keymap
, parent
);
361 keymap
= get_keymap (keymap
, 1, 1);
365 parent
= get_keymap (parent
, 1, 1);
367 /* Check for cycles. */
368 if (keymap_memberp (keymap
, parent
))
369 error ("Cyclic keymap inheritance");
372 /* Skip past the initial element `keymap'. */
377 /* If there is a parent keymap here, replace it.
378 If we came to the end, add the parent in PREV. */
379 if (!CONSP (list
) || KEYMAPP (list
))
381 /* If we already have the right parent, return now
382 so that we avoid the loops below. */
383 if (EQ (XCDR (prev
), parent
))
384 RETURN_UNGCPRO (parent
);
386 XSETCDR (prev
, parent
);
392 /* Scan through for submaps, and set their parents too. */
394 for (list
= XCDR (keymap
); CONSP (list
); list
= XCDR (list
))
396 /* Stop the scan when we come to the parent. */
397 if (EQ (XCAR (list
), Qkeymap
))
400 /* If this element holds a prefix map, deal with it. */
401 if (CONSP (XCAR (list
))
402 && CONSP (XCDR (XCAR (list
))))
403 fix_submap_inheritance (keymap
, XCAR (XCAR (list
)),
406 if (VECTORP (XCAR (list
)))
407 for (i
= 0; i
< XVECTOR (XCAR (list
))->size
; i
++)
408 if (CONSP (XVECTOR (XCAR (list
))->contents
[i
]))
409 fix_submap_inheritance (keymap
, make_number (i
),
410 XVECTOR (XCAR (list
))->contents
[i
]);
412 if (CHAR_TABLE_P (XCAR (list
)))
414 map_char_table (fix_submap_inheritance
, Qnil
, XCAR (list
), keymap
);
418 RETURN_UNGCPRO (parent
);
421 /* EVENT is defined in MAP as a prefix, and SUBMAP is its definition.
422 if EVENT is also a prefix in MAP's parent,
423 make sure that SUBMAP inherits that definition as its own parent. */
426 fix_submap_inheritance (map
, event
, submap
)
427 Lisp_Object map
, event
, submap
;
429 Lisp_Object map_parent
, parent_entry
;
431 /* SUBMAP is a cons that we found as a key binding.
432 Discard the other things found in a menu key binding. */
434 submap
= get_keymap (get_keyelt (submap
, 0), 0, 0);
436 /* If it isn't a keymap now, there's no work to do. */
440 map_parent
= keymap_parent (map
, 0);
441 if (!NILP (map_parent
))
443 get_keymap (access_keymap (map_parent
, event
, 0, 0, 0), 0, 0);
447 /* If MAP's parent has something other than a keymap,
448 our own submap shadows it completely. */
449 if (!CONSP (parent_entry
))
452 if (! EQ (parent_entry
, submap
))
454 Lisp_Object submap_parent
;
455 submap_parent
= submap
;
460 tem
= keymap_parent (submap_parent
, 0);
464 if (keymap_memberp (tem
, parent_entry
))
465 /* Fset_keymap_parent could create a cycle. */
472 Fset_keymap_parent (submap_parent
, parent_entry
);
476 /* Look up IDX in MAP. IDX may be any sort of event.
477 Note that this does only one level of lookup; IDX must be a single
478 event, not a sequence.
480 If T_OK is non-zero, bindings for Qt are treated as default
481 bindings; any key left unmentioned by other tables and bindings is
482 given the binding of Qt.
484 If T_OK is zero, bindings for Qt are not treated specially.
486 If NOINHERIT, don't accept a subkeymap found in an inherited keymap. */
489 access_keymap (map
, idx
, t_ok
, noinherit
, autoload
)
498 /* Qunbound in VAL means we have found no binding yet. */
501 /* If idx is a list (some sort of mouse click, perhaps?),
502 the index we want to use is the car of the list, which
503 ought to be a symbol. */
504 idx
= EVENT_HEAD (idx
);
506 /* If idx is a symbol, it might have modifiers, which need to
507 be put in the canonical order. */
509 idx
= reorder_modifiers (idx
);
510 else if (INTEGERP (idx
))
511 /* Clobber the high bits that can be present on a machine
512 with more than 24 bits of integer. */
513 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
515 /* Handle the special meta -> esc mapping. */
516 if (INTEGERP (idx
) && XUINT (idx
) & meta_modifier
)
518 /* See if there is a meta-map. If there's none, there is
519 no binding for IDX, unless a default binding exists in MAP. */
521 Lisp_Object meta_map
;
523 meta_map
= get_keymap (access_keymap (map
, meta_prefix_char
,
524 t_ok
, noinherit
, autoload
),
527 if (CONSP (meta_map
))
530 idx
= make_number (XUINT (idx
) & ~meta_modifier
);
533 /* Set IDX to t, so that we only find a default binding. */
536 /* We know there is no binding. */
540 /* t_binding is where we put a default binding that applies,
541 to use in case we do not find a binding specifically
542 for this key sequence. */
545 Lisp_Object t_binding
= Qnil
;
546 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
;
548 GCPRO4 (map
, tail
, idx
, t_binding
);
550 /* If `t_ok' is 2, both `t' is accepted. */
553 for (tail
= XCDR (map
);
555 || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
)));
560 binding
= XCAR (tail
);
561 if (SYMBOLP (binding
))
563 /* If NOINHERIT, stop finding prefix definitions
564 after we pass a second occurrence of the `keymap' symbol. */
565 if (noinherit
&& EQ (binding
, Qkeymap
))
566 RETURN_UNGCPRO (Qnil
);
568 else if (CONSP (binding
))
570 Lisp_Object key
= XCAR (binding
);
573 val
= XCDR (binding
);
574 else if (t_ok
> 1 && EQ (key
, Qt
))
576 t_binding
= XCDR (binding
);
580 else if (VECTORP (binding
))
582 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (binding
))
583 val
= AREF (binding
, XFASTINT (idx
));
585 else if (CHAR_TABLE_P (binding
))
587 /* Character codes with modifiers
588 are not included in a char-table.
589 All character codes without modifiers are included. */
590 if (NATNUMP (idx
) && (XFASTINT (idx
) & CHAR_MODIFIER_MASK
) == 0)
592 val
= Faref (binding
, idx
);
593 /* `nil' has a special meaning for char-tables, so
594 we use something else to record an explicitly
601 /* If we found a binding, clean it up and return it. */
602 if (!EQ (val
, Qunbound
))
605 /* A Qt binding is just like an explicit nil binding
606 (i.e. it shadows any parent binding but not bindings in
607 keymaps of lower precedence). */
609 val
= get_keyelt (val
, autoload
);
611 fix_submap_inheritance (map
, idx
, val
);
612 RETURN_UNGCPRO (val
);
617 return get_keyelt (t_binding
, autoload
);
622 map_keymap_item (fun
, args
, key
, val
, data
)
623 map_keymap_function_t fun
;
624 Lisp_Object args
, key
, val
;
627 /* We should maybe try to detect bindings shadowed by previous
628 ones and things like that. */
631 (*fun
) (key
, val
, args
, data
);
635 map_keymap_char_table_item (args
, key
, val
)
636 Lisp_Object args
, key
, val
;
640 map_keymap_function_t fun
= XSAVE_VALUE (XCAR (args
))->pointer
;
642 map_keymap_item (fun
, XCDR (args
), key
, val
,
643 XSAVE_VALUE (XCAR (args
))->pointer
);
647 /* Call FUN for every binding in MAP.
648 FUN is called with 4 arguments: FUN (KEY, BINDING, ARGS, DATA).
649 AUTOLOAD if non-zero means that we can autoload keymaps if necessary. */
651 map_keymap (map
, fun
, args
, data
, autoload
)
652 map_keymap_function_t fun
;
653 Lisp_Object map
, args
;
657 struct gcpro gcpro1
, gcpro2
, gcpro3
;
660 GCPRO3 (map
, args
, tail
);
661 map
= get_keymap (map
, 1, autoload
);
662 for (tail
= (CONSP (map
) && EQ (Qkeymap
, XCAR (map
))) ? XCDR (map
) : map
;
663 CONSP (tail
) || (tail
= get_keymap (tail
, 0, autoload
), CONSP (tail
));
666 Lisp_Object binding
= XCAR (tail
);
669 map_keymap_item (fun
, args
, XCAR (binding
), XCDR (binding
), data
);
670 else if (VECTORP (binding
))
672 /* Loop over the char values represented in the vector. */
673 int len
= ASIZE (binding
);
676 for (c
= 0; c
< len
; c
++)
678 Lisp_Object character
;
679 XSETFASTINT (character
, c
);
680 map_keymap_item (fun
, args
, character
, AREF (binding
, c
), data
);
683 else if (CHAR_TABLE_P (binding
))
685 map_char_table (map_keymap_char_table_item
, Qnil
, binding
,
686 Fcons (make_save_value (fun
, 0),
687 Fcons (make_save_value (data
, 0),
695 map_keymap_call (key
, val
, fun
, dummy
)
696 Lisp_Object key
, val
, fun
;
699 call2 (fun
, key
, val
);
702 DEFUN ("map-keymap", Fmap_keymap
, Smap_keymap
, 2, 2, 0,
703 doc
: /* Call FUNCTION for every binding in KEYMAP.
704 FUNCTION is called with two arguments: the event and its binding. */)
706 Lisp_Object function
, keymap
;
708 if (INTEGERP (function
))
709 /* We have to stop integers early since map_keymap gives them special
711 Fsignal (Qinvalid_function
, Fcons (function
, Qnil
));
712 map_keymap (keymap
, map_keymap_call
, function
, NULL
, 1);
716 /* Given OBJECT which was found in a slot in a keymap,
717 trace indirect definitions to get the actual definition of that slot.
718 An indirect definition is a list of the form
719 (KEYMAP . INDEX), where KEYMAP is a keymap or a symbol defined as one
720 and INDEX is the object to look up in KEYMAP to yield the definition.
722 Also if OBJECT has a menu string as the first element,
723 remove that. Also remove a menu help string as second element.
725 If AUTOLOAD is nonzero, load autoloadable keymaps
726 that are referred to with indirection. */
729 get_keyelt (object
, autoload
)
735 if (!(CONSP (object
)))
736 /* This is really the value. */
739 /* If the keymap contents looks like (keymap ...) or (lambda ...)
741 else if (EQ (XCAR (object
), Qkeymap
) || EQ (XCAR (object
), Qlambda
))
744 /* If the keymap contents looks like (menu-item name . DEFN)
745 or (menu-item name DEFN ...) then use DEFN.
746 This is a new format menu item. */
747 else if (EQ (XCAR (object
), Qmenu_item
))
749 if (CONSP (XCDR (object
)))
753 object
= XCDR (XCDR (object
));
756 object
= XCAR (object
);
758 /* If there's a `:filter FILTER', apply FILTER to the
759 menu-item's definition to get the real definition to
761 for (; CONSP (tem
) && CONSP (XCDR (tem
)); tem
= XCDR (tem
))
762 if (EQ (XCAR (tem
), QCfilter
) && autoload
)
765 filter
= XCAR (XCDR (tem
));
766 filter
= list2 (filter
, list2 (Qquote
, object
));
767 object
= menu_item_eval_property (filter
);
772 /* Invalid keymap. */
776 /* If the keymap contents looks like (STRING . DEFN), use DEFN.
777 Keymap alist elements like (CHAR MENUSTRING . DEFN)
778 will be used by HierarKey menus. */
779 else if (STRINGP (XCAR (object
)))
781 object
= XCDR (object
);
782 /* Also remove a menu help string, if any,
783 following the menu item name. */
784 if (CONSP (object
) && STRINGP (XCAR (object
)))
785 object
= XCDR (object
);
786 /* Also remove the sublist that caches key equivalences, if any. */
787 if (CONSP (object
) && CONSP (XCAR (object
)))
790 carcar
= XCAR (XCAR (object
));
791 if (NILP (carcar
) || VECTORP (carcar
))
792 object
= XCDR (object
);
796 /* If the contents are (KEYMAP . ELEMENT), go indirect. */
802 map
= get_keymap (Fcar_safe (object
), 0, autoload
);
804 return (!CONSP (map
) ? object
/* Invalid keymap */
805 : access_keymap (map
, Fcdr (object
), 0, 0, autoload
));
811 store_in_keymap (keymap
, idx
, def
)
813 register Lisp_Object idx
;
814 register Lisp_Object def
;
816 /* Flush any reverse-map cache. */
817 where_is_cache
= Qnil
;
818 where_is_cache_keymaps
= Qt
;
820 /* If we are preparing to dump, and DEF is a menu element
821 with a menu item indicator, copy it to ensure it is not pure. */
822 if (CONSP (def
) && PURE_P (def
)
823 && (EQ (XCAR (def
), Qmenu_item
) || STRINGP (XCAR (def
))))
824 def
= Fcons (XCAR (def
), XCDR (def
));
826 if (!CONSP (keymap
) || !EQ (XCAR (keymap
), Qkeymap
))
827 error ("attempt to define a key in a non-keymap");
829 /* If idx is a cons, and the car part is a character, idx must be of
830 the form (FROM-CHAR . TO-CHAR). */
831 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
832 CHECK_CHARACTER_CDR (idx
);
834 /* If idx is a list (some sort of mouse click, perhaps?),
835 the index we want to use is the car of the list, which
836 ought to be a symbol. */
837 idx
= EVENT_HEAD (idx
);
839 /* If idx is a symbol, it might have modifiers, which need to
840 be put in the canonical order. */
842 idx
= reorder_modifiers (idx
);
843 else if (INTEGERP (idx
))
844 /* Clobber the high bits that can be present on a machine
845 with more than 24 bits of integer. */
846 XSETFASTINT (idx
, XINT (idx
) & (CHAR_META
| (CHAR_META
- 1)));
848 /* Scan the keymap for a binding of idx. */
852 /* The cons after which we should insert new bindings. If the
853 keymap has a table element, we record its position here, so new
854 bindings will go after it; this way, the table will stay
855 towards the front of the alist and character lookups in dense
856 keymaps will remain fast. Otherwise, this just points at the
857 front of the keymap. */
858 Lisp_Object insertion_point
;
860 insertion_point
= keymap
;
861 for (tail
= XCDR (keymap
); CONSP (tail
); tail
= XCDR (tail
))
868 if (NATNUMP (idx
) && XFASTINT (idx
) < ASIZE (elt
))
870 ASET (elt
, XFASTINT (idx
), def
);
873 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
875 int from
= XFASTINT (XCAR (idx
));
876 int to
= XFASTINT (XCDR (idx
));
878 if (to
>= ASIZE (elt
))
879 to
= ASIZE (elt
) - 1;
880 for (; from
<= to
; from
++)
881 ASET (elt
, from
, def
);
882 if (to
== XFASTINT (XCDR (idx
)))
883 /* We have defined all keys in IDX. */
886 insertion_point
= tail
;
888 else if (CHAR_TABLE_P (elt
))
890 /* Character codes with modifiers
891 are not included in a char-table.
892 All character codes without modifiers are included. */
893 if (NATNUMP (idx
) && !(XFASTINT (idx
) & CHAR_MODIFIER_MASK
))
896 /* `nil' has a special meaning for char-tables, so
897 we use something else to record an explicitly
899 NILP (def
) ? Qt
: def
);
902 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
904 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
907 insertion_point
= tail
;
909 else if (CONSP (elt
))
911 if (EQ (idx
, XCAR (elt
)))
916 else if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
918 int from
= XFASTINT (XCAR (idx
));
919 int to
= XFASTINT (XCDR (idx
));
921 if (from
<= XFASTINT (XCAR (elt
))
922 && to
>= XFASTINT (XCAR (elt
)))
930 else if (EQ (elt
, Qkeymap
))
931 /* If we find a 'keymap' symbol in the spine of KEYMAP,
932 then we must have found the start of a second keymap
933 being used as the tail of KEYMAP, and a binding for IDX
934 should be inserted before it. */
941 /* We have scanned the entire keymap, and not found a binding for
942 IDX. Let's add one. */
946 if (CONSP (idx
) && CHARACTERP (XCAR (idx
)))
948 /* IDX specifies a range of characters, and not all of them
949 were handled yet, which means this keymap doesn't have a
950 char-table. So, we insert a char-table now. */
951 elt
= Fmake_char_table (Qkeymap
, Qnil
);
952 Fset_char_table_range (elt
, idx
, NILP (def
) ? Qt
: def
);
955 elt
= Fcons (idx
, def
);
956 XSETCDR (insertion_point
, Fcons (elt
, XCDR (insertion_point
)));
963 EXFUN (Fcopy_keymap
, 1);
966 copy_keymap_item (elt
)
969 Lisp_Object res
, tem
;
976 /* Is this a new format menu item. */
977 if (EQ (XCAR (tem
), Qmenu_item
))
979 /* Copy cell with menu-item marker. */
980 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
984 /* Copy cell with menu-item name. */
985 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
991 /* Copy cell with binding and if the binding is a keymap,
993 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
996 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
997 XSETCAR (elt
, Fcopy_keymap (tem
));
999 if (CONSP (tem
) && CONSP (XCAR (tem
)))
1000 /* Delete cache for key equivalences. */
1001 XSETCDR (elt
, XCDR (tem
));
1006 /* It may be an old fomat menu item.
1007 Skip the optional menu string. */
1008 if (STRINGP (XCAR (tem
)))
1010 /* Copy the cell, since copy-alist didn't go this deep. */
1011 res
= elt
= Fcons (XCAR (tem
), XCDR (tem
));
1013 /* Also skip the optional menu help string. */
1014 if (CONSP (tem
) && STRINGP (XCAR (tem
)))
1016 XSETCDR (elt
, Fcons (XCAR (tem
), XCDR (tem
)));
1020 /* There may also be a list that caches key equivalences.
1021 Just delete it for the new keymap. */
1023 && CONSP (XCAR (tem
))
1024 && (NILP (XCAR (XCAR (tem
)))
1025 || VECTORP (XCAR (XCAR (tem
)))))
1027 XSETCDR (elt
, XCDR (tem
));
1030 if (CONSP (tem
) && EQ (XCAR (tem
), Qkeymap
))
1031 XSETCDR (elt
, Fcopy_keymap (tem
));
1033 else if (EQ (XCAR (tem
), Qkeymap
))
1034 res
= Fcopy_keymap (elt
);
1040 copy_keymap_1 (chartable
, idx
, elt
)
1041 Lisp_Object chartable
, idx
, elt
;
1043 Fset_char_table_range (chartable
, idx
, copy_keymap_item (elt
));
1046 DEFUN ("copy-keymap", Fcopy_keymap
, Scopy_keymap
, 1, 1, 0,
1047 doc
: /* Return a copy of the keymap KEYMAP.
1048 The copy starts out with the same definitions of KEYMAP,
1049 but changing either the copy or KEYMAP does not affect the other.
1050 Any key definitions that are subkeymaps are recursively copied.
1051 However, a key definition which is a symbol whose definition is a keymap
1056 register Lisp_Object copy
, tail
;
1057 keymap
= get_keymap (keymap
, 1, 0);
1058 copy
= tail
= Fcons (Qkeymap
, Qnil
);
1059 keymap
= XCDR (keymap
); /* Skip the `keymap' symbol. */
1061 while (CONSP (keymap
) && !EQ (XCAR (keymap
), Qkeymap
))
1063 Lisp_Object elt
= XCAR (keymap
);
1064 if (CHAR_TABLE_P (elt
))
1066 elt
= Fcopy_sequence (elt
);
1067 map_char_table (copy_keymap_1
, Qnil
, elt
, elt
);
1069 else if (VECTORP (elt
))
1072 elt
= Fcopy_sequence (elt
);
1073 for (i
= 0; i
< ASIZE (elt
); i
++)
1074 ASET (elt
, i
, copy_keymap_item (AREF (elt
, i
)));
1076 else if (CONSP (elt
))
1077 elt
= Fcons (XCAR (elt
), copy_keymap_item (XCDR (elt
)));
1078 XSETCDR (tail
, Fcons (elt
, Qnil
));
1080 keymap
= XCDR (keymap
);
1082 XSETCDR (tail
, keymap
);
1086 /* Simple Keymap mutators and accessors. */
1088 /* GC is possible in this function if it autoloads a keymap. */
1090 DEFUN ("define-key", Fdefine_key
, Sdefine_key
, 3, 3, 0,
1091 doc
: /* In KEYMAP, define key sequence KEY as DEF.
1094 KEY is a string or a vector of symbols and characters meaning a
1095 sequence of keystrokes and events. Non-ASCII characters with codes
1096 above 127 (such as ISO Latin-1) can be included if you use a vector.
1097 Using [t] for KEY creates a default definition, which applies to any
1098 event type that has no other definition in this keymap.
1100 DEF is anything that can be a key's definition:
1101 nil (means key is undefined in this keymap),
1102 a command (a Lisp function suitable for interactive calling)
1103 a string (treated as a keyboard macro),
1104 a keymap (to define a prefix key),
1105 a symbol. When the key is looked up, the symbol will stand for its
1106 function definition, which should at that time be one of the above,
1107 or another symbol whose function definition is used, etc.
1108 a cons (STRING . DEFN), meaning that DEFN is the definition
1109 (DEFN should be a valid definition in its own right),
1110 or a cons (KEYMAP . CHAR), meaning use definition of CHAR in map KEYMAP.
1112 If KEYMAP is a sparse keymap with a binding for KEY, the existing
1113 binding is altered. If there is no binding for KEY, the new pair
1114 binding KEY to DEF is added at the front of KEYMAP. */)
1121 register Lisp_Object c
;
1122 register Lisp_Object cmd
;
1126 struct gcpro gcpro1
, gcpro2
, gcpro3
;
1128 GCPRO3 (keymap
, key
, def
);
1129 keymap
= get_keymap (keymap
, 1, 1);
1131 if (!VECTORP (key
) && !STRINGP (key
))
1132 key
= wrong_type_argument (Qarrayp
, key
);
1134 length
= XFASTINT (Flength (key
));
1136 RETURN_UNGCPRO (Qnil
);
1138 if (SYMBOLP (def
) && !EQ (Vdefine_key_rebound_commands
, Qt
))
1139 Vdefine_key_rebound_commands
= Fcons (def
, Vdefine_key_rebound_commands
);
1141 meta_bit
= VECTORP (key
) ? meta_modifier
: 0x80;
1146 c
= Faref (key
, make_number (idx
));
1150 /* C may be a Lucid style event type list or a cons (FROM .
1151 TO) specifying a range of characters. */
1152 if (lucid_event_type_list_p (c
))
1153 c
= Fevent_convert_list (c
);
1154 else if (CHARACTERP (XCAR (c
)))
1155 CHECK_CHARACTER_CDR (c
);
1159 silly_event_symbol_error (c
);
1162 && (XINT (c
) & meta_bit
)
1165 c
= meta_prefix_char
;
1171 XSETINT (c
, XINT (c
) & ~meta_bit
);
1177 if (!INTEGERP (c
) && !SYMBOLP (c
)
1179 /* If C is a range, it must be a leaf. */
1180 || (INTEGERP (XCAR (c
)) && idx
!= length
)))
1181 error ("Key sequence contains invalid event");
1184 RETURN_UNGCPRO (store_in_keymap (keymap
, c
, def
));
1186 cmd
= access_keymap (keymap
, c
, 0, 1, 1);
1188 /* If this key is undefined, make it a prefix. */
1190 cmd
= define_as_prefix (keymap
, c
);
1192 keymap
= get_keymap (cmd
, 0, 1);
1193 if (!CONSP (keymap
))
1194 /* We must use Fkey_description rather than just passing key to
1195 error; key might be a vector, not a string. */
1196 error ("Key sequence %s uses invalid prefix characters",
1197 SDATA (Fkey_description (key
)));
1201 /* This function may GC (it calls Fkey_binding). */
1203 DEFUN ("command-remapping", Fcommand_remapping
, Scommand_remapping
, 1, 1, 0,
1204 doc
: /* Return the remapping for command COMMAND in current keymaps.
1205 Returns nil if COMMAND is not remapped (or not a symbol). */)
1207 Lisp_Object command
;
1209 if (!SYMBOLP (command
))
1212 ASET (command_remapping_vector
, 1, command
);
1213 return Fkey_binding (command_remapping_vector
, Qnil
, Qt
);
1216 /* Value is number if KEY is too long; nil if valid but has no definition. */
1217 /* GC is possible in this function if it autoloads a keymap. */
1219 DEFUN ("lookup-key", Flookup_key
, Slookup_key
, 2, 3, 0,
1220 doc
: /* In keymap KEYMAP, look up key sequence KEY. Return the definition.
1221 nil means undefined. See doc of `define-key' for kinds of definitions.
1223 A number as value means KEY is "too long";
1224 that is, characters or symbols in it except for the last one
1225 fail to be a valid sequence of prefix characters in KEYMAP.
1226 The number is how many characters at the front of KEY
1227 it takes to reach a non-prefix command.
1229 Normally, `lookup-key' ignores bindings for t, which act as default
1230 bindings, used when nothing else in the keymap applies; this makes it
1231 usable as a general function for probing keymaps. However, if the
1232 third optional argument ACCEPT-DEFAULT is non-nil, `lookup-key' will
1233 recognize the default bindings, just as `read-key-sequence' does. */)
1234 (keymap
, key
, accept_default
)
1237 Lisp_Object accept_default
;
1240 register Lisp_Object cmd
;
1241 register Lisp_Object c
;
1243 int t_ok
= !NILP (accept_default
);
1244 struct gcpro gcpro1
, gcpro2
;
1246 GCPRO2 (keymap
, key
);
1247 keymap
= get_keymap (keymap
, 1, 1);
1249 if (!VECTORP (key
) && !STRINGP (key
))
1250 key
= wrong_type_argument (Qarrayp
, key
);
1252 length
= XFASTINT (Flength (key
));
1254 RETURN_UNGCPRO (keymap
);
1259 c
= Faref (key
, make_number (idx
++));
1261 if (CONSP (c
) && lucid_event_type_list_p (c
))
1262 c
= Fevent_convert_list (c
);
1264 /* Turn the 8th bit of string chars into a meta modifier. */
1265 if (XINT (c
) & 0x80 && STRINGP (key
))
1266 XSETINT (c
, (XINT (c
) | meta_modifier
) & ~0x80);
1268 /* Allow string since binding for `menu-bar-select-buffer'
1269 includes the buffer name in the key sequence. */
1270 if (!INTEGERP (c
) && !SYMBOLP (c
) && !CONSP (c
) && !STRINGP (c
))
1271 error ("Key sequence contains invalid event");
1273 cmd
= access_keymap (keymap
, c
, t_ok
, 0, 1);
1275 RETURN_UNGCPRO (cmd
);
1277 keymap
= get_keymap (cmd
, 0, 1);
1278 if (!CONSP (keymap
))
1279 RETURN_UNGCPRO (make_number (idx
));
1285 /* Make KEYMAP define event C as a keymap (i.e., as a prefix).
1286 Assume that currently it does not define C at all.
1287 Return the keymap. */
1290 define_as_prefix (keymap
, c
)
1291 Lisp_Object keymap
, c
;
1295 cmd
= Fmake_sparse_keymap (Qnil
);
1296 /* If this key is defined as a prefix in an inherited keymap,
1297 make it a prefix in this map, and make its definition
1298 inherit the other prefix definition. */
1299 cmd
= nconc2 (cmd
, access_keymap (keymap
, c
, 0, 0, 0));
1300 store_in_keymap (keymap
, c
, cmd
);
1305 /* Append a key to the end of a key sequence. We always make a vector. */
1308 append_key (key_sequence
, key
)
1309 Lisp_Object key_sequence
, key
;
1311 Lisp_Object args
[2];
1313 args
[0] = key_sequence
;
1315 args
[1] = Fcons (key
, Qnil
);
1316 return Fvconcat (2, args
);
1319 /* Given a event type C which is a symbol,
1320 signal an error if is a mistake such as RET or M-RET or C-DEL, etc. */
1323 silly_event_symbol_error (c
)
1326 Lisp_Object parsed
, base
, name
, assoc
;
1329 parsed
= parse_modifiers (c
);
1330 modifiers
= (int) XUINT (XCAR (XCDR (parsed
)));
1331 base
= XCAR (parsed
);
1332 name
= Fsymbol_name (base
);
1333 /* This alist includes elements such as ("RET" . "\\r"). */
1334 assoc
= Fassoc (name
, exclude_keys
);
1338 char new_mods
[sizeof ("\\A-\\C-\\H-\\M-\\S-\\s-")];
1340 Lisp_Object keystring
;
1341 if (modifiers
& alt_modifier
)
1342 { *p
++ = '\\'; *p
++ = 'A'; *p
++ = '-'; }
1343 if (modifiers
& ctrl_modifier
)
1344 { *p
++ = '\\'; *p
++ = 'C'; *p
++ = '-'; }
1345 if (modifiers
& hyper_modifier
)
1346 { *p
++ = '\\'; *p
++ = 'H'; *p
++ = '-'; }
1347 if (modifiers
& meta_modifier
)
1348 { *p
++ = '\\'; *p
++ = 'M'; *p
++ = '-'; }
1349 if (modifiers
& shift_modifier
)
1350 { *p
++ = '\\'; *p
++ = 'S'; *p
++ = '-'; }
1351 if (modifiers
& super_modifier
)
1352 { *p
++ = '\\'; *p
++ = 's'; *p
++ = '-'; }
1355 c
= reorder_modifiers (c
);
1356 keystring
= concat2 (build_string (new_mods
), XCDR (assoc
));
1358 error ((modifiers
& ~meta_modifier
1359 ? "To bind the key %s, use [?%s], not [%s]"
1360 : "To bind the key %s, use \"%s\", not [%s]"),
1361 SDATA (SYMBOL_NAME (c
)), SDATA (keystring
),
1362 SDATA (SYMBOL_NAME (c
)));
1366 /* Global, local, and minor mode keymap stuff. */
1368 /* We can't put these variables inside current_minor_maps, since under
1369 some systems, static gets macro-defined to be the empty string.
1371 static Lisp_Object
*cmm_modes
= NULL
, *cmm_maps
= NULL
;
1372 static int cmm_size
= 0;
1374 /* Error handler used in current_minor_maps. */
1376 current_minor_maps_error ()
1381 /* Store a pointer to an array of the keymaps of the currently active
1382 minor modes in *buf, and return the number of maps it contains.
1384 This function always returns a pointer to the same buffer, and may
1385 free or reallocate it, so if you want to keep it for a long time or
1386 hand it out to lisp code, copy it. This procedure will be called
1387 for every key sequence read, so the nice lispy approach (return a
1388 new assoclist, list, what have you) for each invocation would
1389 result in a lot of consing over time.
1391 If we used xrealloc/xmalloc and ran out of memory, they would throw
1392 back to the command loop, which would try to read a key sequence,
1393 which would call this function again, resulting in an infinite
1394 loop. Instead, we'll use realloc/malloc and silently truncate the
1395 list, let the key sequence be read, and hope some other piece of
1396 code signals the error. */
1398 current_minor_maps (modeptr
, mapptr
)
1399 Lisp_Object
**modeptr
, **mapptr
;
1402 int list_number
= 0;
1403 Lisp_Object alist
, assoc
, var
, val
;
1404 Lisp_Object emulation_alists
;
1405 Lisp_Object lists
[2];
1407 emulation_alists
= Vemulation_mode_map_alists
;
1408 lists
[0] = Vminor_mode_overriding_map_alist
;
1409 lists
[1] = Vminor_mode_map_alist
;
1411 for (list_number
= 0; list_number
< 2; list_number
++)
1413 if (CONSP (emulation_alists
))
1415 alist
= XCAR (emulation_alists
);
1416 emulation_alists
= XCDR (emulation_alists
);
1417 if (SYMBOLP (alist
))
1418 alist
= find_symbol_value (alist
);
1422 alist
= lists
[list_number
];
1424 for ( ; CONSP (alist
); alist
= XCDR (alist
))
1425 if ((assoc
= XCAR (alist
), CONSP (assoc
))
1426 && (var
= XCAR (assoc
), SYMBOLP (var
))
1427 && (val
= find_symbol_value (var
), !EQ (val
, Qunbound
))
1432 /* If a variable has an entry in Vminor_mode_overriding_map_alist,
1433 and also an entry in Vminor_mode_map_alist,
1434 ignore the latter. */
1435 if (list_number
== 1)
1437 val
= assq_no_quit (var
, lists
[0]);
1444 int newsize
, allocsize
;
1445 Lisp_Object
*newmodes
, *newmaps
;
1447 newsize
= cmm_size
== 0 ? 30 : cmm_size
* 2;
1448 allocsize
= newsize
* sizeof *newmodes
;
1450 /* Use malloc here. See the comment above this function.
1451 Avoid realloc here; it causes spurious traps on GNU/Linux [KFS] */
1453 newmodes
= (Lisp_Object
*) malloc (allocsize
);
1458 bcopy (cmm_modes
, newmodes
, cmm_size
* sizeof cmm_modes
[0]);
1461 cmm_modes
= newmodes
;
1464 newmaps
= (Lisp_Object
*) malloc (allocsize
);
1469 bcopy (cmm_maps
, newmaps
, cmm_size
* sizeof cmm_maps
[0]);
1476 if (newmodes
== NULL
|| newmaps
== NULL
)
1481 /* Get the keymap definition--or nil if it is not defined. */
1482 temp
= internal_condition_case_1 (Findirect_function
,
1484 Qerror
, current_minor_maps_error
);
1488 cmm_maps
[i
] = temp
;
1494 if (modeptr
) *modeptr
= cmm_modes
;
1495 if (mapptr
) *mapptr
= cmm_maps
;
1499 DEFUN ("current-active-maps", Fcurrent_active_maps
, Scurrent_active_maps
,
1501 doc
: /* Return a list of the currently active keymaps.
1502 OLP if non-nil indicates that we should obey `overriding-local-map' and
1503 `overriding-terminal-local-map'. */)
1507 Lisp_Object keymaps
= Fcons (current_global_map
, Qnil
);
1511 if (!NILP (Voverriding_local_map
))
1512 keymaps
= Fcons (Voverriding_local_map
, keymaps
);
1513 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1514 keymaps
= Fcons (current_kboard
->Voverriding_terminal_local_map
, keymaps
);
1516 if (NILP (XCDR (keymaps
)))
1522 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1524 keymaps
= Fcons (local
, keymaps
);
1526 nmaps
= current_minor_maps (0, &maps
);
1528 for (i
= --nmaps
; i
>= 0; i
--)
1529 if (!NILP (maps
[i
]))
1530 keymaps
= Fcons (maps
[i
], keymaps
);
1532 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1534 keymaps
= Fcons (local
, keymaps
);
1540 /* GC is possible in this function if it autoloads a keymap. */
1542 DEFUN ("key-binding", Fkey_binding
, Skey_binding
, 1, 3, 0,
1543 doc
: /* Return the binding for command KEY in current keymaps.
1544 KEY is a string or vector, a sequence of keystrokes.
1545 The binding is probably a symbol with a function definition.
1547 Normally, `key-binding' ignores bindings for t, which act as default
1548 bindings, used when nothing else in the keymap applies; this makes it
1549 usable as a general function for probing keymaps. However, if the
1550 optional second argument ACCEPT-DEFAULT is non-nil, `key-binding' does
1551 recognize the default bindings, just as `read-key-sequence' does.
1553 Like the normal command loop, `key-binding' will remap the command
1554 resulting from looking up KEY by looking up the command in the
1555 current keymaps. However, if the optional third argument NO-REMAP
1556 is non-nil, `key-binding' returns the unmapped command. */)
1557 (key
, accept_default
, no_remap
)
1558 Lisp_Object key
, accept_default
, no_remap
;
1560 Lisp_Object
*maps
, value
;
1562 struct gcpro gcpro1
;
1566 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
1568 value
= Flookup_key (current_kboard
->Voverriding_terminal_local_map
,
1569 key
, accept_default
);
1570 if (! NILP (value
) && !INTEGERP (value
))
1573 else if (!NILP (Voverriding_local_map
))
1575 value
= Flookup_key (Voverriding_local_map
, key
, accept_default
);
1576 if (! NILP (value
) && !INTEGERP (value
))
1583 local
= get_local_map (PT
, current_buffer
, Qkeymap
);
1586 value
= Flookup_key (local
, key
, accept_default
);
1587 if (! NILP (value
) && !INTEGERP (value
))
1591 nmaps
= current_minor_maps (0, &maps
);
1592 /* Note that all these maps are GCPRO'd
1593 in the places where we found them. */
1595 for (i
= 0; i
< nmaps
; i
++)
1596 if (! NILP (maps
[i
]))
1598 value
= Flookup_key (maps
[i
], key
, accept_default
);
1599 if (! NILP (value
) && !INTEGERP (value
))
1603 local
= get_local_map (PT
, current_buffer
, Qlocal_map
);
1606 value
= Flookup_key (local
, key
, accept_default
);
1607 if (! NILP (value
) && !INTEGERP (value
))
1612 value
= Flookup_key (current_global_map
, key
, accept_default
);
1616 if (NILP (value
) || INTEGERP (value
))
1619 /* If the result of the ordinary keymap lookup is an interactive
1620 command, look for a key binding (ie. remapping) for that command. */
1622 if (NILP (no_remap
) && SYMBOLP (value
))
1625 if (value1
= Fcommand_remapping (value
), !NILP (value1
))
1632 /* GC is possible in this function if it autoloads a keymap. */
1634 DEFUN ("local-key-binding", Flocal_key_binding
, Slocal_key_binding
, 1, 2, 0,
1635 doc
: /* Return the binding for command KEYS in current local keymap only.
1636 KEYS is a string, a sequence of keystrokes.
1637 The binding is probably a symbol with a function definition.
1639 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1640 bindings; see the description of `lookup-key' for more details about this. */)
1641 (keys
, accept_default
)
1642 Lisp_Object keys
, accept_default
;
1644 register Lisp_Object map
;
1645 map
= current_buffer
->keymap
;
1648 return Flookup_key (map
, keys
, accept_default
);
1651 /* GC is possible in this function if it autoloads a keymap. */
1653 DEFUN ("global-key-binding", Fglobal_key_binding
, Sglobal_key_binding
, 1, 2, 0,
1654 doc
: /* Return the binding for command KEYS in current global keymap only.
1655 KEYS is a string, a sequence of keystrokes.
1656 The binding is probably a symbol with a function definition.
1657 This function's return values are the same as those of lookup-key
1660 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1661 bindings; see the description of `lookup-key' for more details about this. */)
1662 (keys
, accept_default
)
1663 Lisp_Object keys
, accept_default
;
1665 return Flookup_key (current_global_map
, keys
, accept_default
);
1668 /* GC is possible in this function if it autoloads a keymap. */
1670 DEFUN ("minor-mode-key-binding", Fminor_mode_key_binding
, Sminor_mode_key_binding
, 1, 2, 0,
1671 doc
: /* Find the visible minor mode bindings of KEY.
1672 Return an alist of pairs (MODENAME . BINDING), where MODENAME is the
1673 the symbol which names the minor mode binding KEY, and BINDING is
1674 KEY's definition in that mode. In particular, if KEY has no
1675 minor-mode bindings, return nil. If the first binding is a
1676 non-prefix, all subsequent bindings will be omitted, since they would
1677 be ignored. Similarly, the list doesn't include non-prefix bindings
1678 that come after prefix bindings.
1680 If optional argument ACCEPT-DEFAULT is non-nil, recognize default
1681 bindings; see the description of `lookup-key' for more details about this. */)
1682 (key
, accept_default
)
1683 Lisp_Object key
, accept_default
;
1685 Lisp_Object
*modes
, *maps
;
1687 Lisp_Object binding
;
1689 struct gcpro gcpro1
, gcpro2
;
1691 nmaps
= current_minor_maps (&modes
, &maps
);
1692 /* Note that all these maps are GCPRO'd
1693 in the places where we found them. */
1696 GCPRO2 (key
, binding
);
1698 for (i
= j
= 0; i
< nmaps
; i
++)
1700 && !NILP (binding
= Flookup_key (maps
[i
], key
, accept_default
))
1701 && !INTEGERP (binding
))
1703 if (KEYMAPP (binding
))
1704 maps
[j
++] = Fcons (modes
[i
], binding
);
1706 RETURN_UNGCPRO (Fcons (Fcons (modes
[i
], binding
), Qnil
));
1710 return Flist (j
, maps
);
1713 DEFUN ("define-prefix-command", Fdefine_prefix_command
, Sdefine_prefix_command
, 1, 3, 0,
1714 doc
: /* Define COMMAND as a prefix command. COMMAND should be a symbol.
1715 A new sparse keymap is stored as COMMAND's function definition and its value.
1716 If a second optional argument MAPVAR is given, the map is stored as
1717 its value instead of as COMMAND's value; but COMMAND is still defined
1719 The third optional argument NAME, if given, supplies a menu name
1720 string for the map. This is required to use the keymap as a menu. */)
1721 (command
, mapvar
, name
)
1722 Lisp_Object command
, mapvar
, name
;
1725 map
= Fmake_sparse_keymap (name
);
1726 Ffset (command
, map
);
1730 Fset (command
, map
);
1734 DEFUN ("use-global-map", Fuse_global_map
, Suse_global_map
, 1, 1, 0,
1735 doc
: /* Select KEYMAP as the global keymap. */)
1739 keymap
= get_keymap (keymap
, 1, 1);
1740 current_global_map
= keymap
;
1745 DEFUN ("use-local-map", Fuse_local_map
, Suse_local_map
, 1, 1, 0,
1746 doc
: /* Select KEYMAP as the local keymap.
1747 If KEYMAP is nil, that means no local keymap. */)
1752 keymap
= get_keymap (keymap
, 1, 1);
1754 current_buffer
->keymap
= keymap
;
1759 DEFUN ("current-local-map", Fcurrent_local_map
, Scurrent_local_map
, 0, 0, 0,
1760 doc
: /* Return current buffer's local keymap, or nil if it has none. */)
1763 return current_buffer
->keymap
;
1766 DEFUN ("current-global-map", Fcurrent_global_map
, Scurrent_global_map
, 0, 0, 0,
1767 doc
: /* Return the current global keymap. */)
1770 return current_global_map
;
1773 DEFUN ("current-minor-mode-maps", Fcurrent_minor_mode_maps
, Scurrent_minor_mode_maps
, 0, 0, 0,
1774 doc
: /* Return a list of keymaps for the minor modes of the current buffer. */)
1778 int nmaps
= current_minor_maps (0, &maps
);
1780 return Flist (nmaps
, maps
);
1783 /* Help functions for describing and documenting keymaps. */
1787 accessible_keymaps_1 (key
, cmd
, maps
, tail
, thisseq
, is_metized
)
1788 Lisp_Object maps
, tail
, thisseq
, key
, cmd
;
1789 int is_metized
; /* If 1, `key' is assumed to be INTEGERP. */
1793 cmd
= get_keymap (get_keyelt (cmd
, 0), 0, 0);
1797 /* Look for and break cycles. */
1798 while (!NILP (tem
= Frassq (cmd
, maps
)))
1800 Lisp_Object prefix
= XCAR (tem
);
1801 int lim
= XINT (Flength (XCAR (tem
)));
1802 if (lim
<= XINT (Flength (thisseq
)))
1803 { /* This keymap was already seen with a smaller prefix. */
1805 while (i
< lim
&& EQ (Faref (prefix
, make_number (i
)),
1806 Faref (thisseq
, make_number (i
))))
1809 /* `prefix' is a prefix of `thisseq' => there's a cycle. */
1812 /* This occurrence of `cmd' in `maps' does not correspond to a cycle,
1813 but maybe `cmd' occurs again further down in `maps', so keep
1815 maps
= XCDR (Fmemq (tem
, maps
));
1818 /* If the last key in thisseq is meta-prefix-char,
1819 turn it into a meta-ized keystroke. We know
1820 that the event we're about to append is an
1821 ascii keystroke since we're processing a
1825 int meta_bit
= meta_modifier
;
1826 Lisp_Object last
= make_number (XINT (Flength (thisseq
)) - 1);
1827 tem
= Fcopy_sequence (thisseq
);
1829 Faset (tem
, last
, make_number (XINT (key
) | meta_bit
));
1831 /* This new sequence is the same length as
1832 thisseq, so stick it in the list right
1835 Fcons (Fcons (tem
, cmd
), XCDR (tail
)));
1839 tem
= append_key (thisseq
, key
);
1840 nconc2 (tail
, Fcons (Fcons (tem
, cmd
), Qnil
));
1845 accessible_keymaps_char_table (args
, index
, cmd
)
1846 Lisp_Object args
, index
, cmd
;
1848 accessible_keymaps_1 (index
, cmd
,
1852 XINT (XCDR (XCAR (args
))));
1855 /* This function cannot GC. */
1857 DEFUN ("accessible-keymaps", Faccessible_keymaps
, Saccessible_keymaps
,
1859 doc
: /* Find all keymaps accessible via prefix characters from KEYMAP.
1860 Returns a list of elements of the form (KEYS . MAP), where the sequence
1861 KEYS starting from KEYMAP gets you to MAP. These elements are ordered
1862 so that the KEYS increase in length. The first element is ([] . KEYMAP).
1863 An optional argument PREFIX, if non-nil, should be a key sequence;
1864 then the value includes only maps for prefixes that start with PREFIX. */)
1866 Lisp_Object keymap
, prefix
;
1868 Lisp_Object maps
, tail
;
1871 /* no need for gcpro because we don't autoload any keymaps. */
1874 prefixlen
= XINT (Flength (prefix
));
1878 /* If a prefix was specified, start with the keymap (if any) for
1879 that prefix, so we don't waste time considering other prefixes. */
1881 tem
= Flookup_key (keymap
, prefix
, Qt
);
1882 /* Flookup_key may give us nil, or a number,
1883 if the prefix is not defined in this particular map.
1884 It might even give us a list that isn't a keymap. */
1885 tem
= get_keymap (tem
, 0, 0);
1888 /* Convert PREFIX to a vector now, so that later on
1889 we don't have to deal with the possibility of a string. */
1890 if (STRINGP (prefix
))
1895 copy
= Fmake_vector (make_number (SCHARS (prefix
)), Qnil
);
1896 for (i
= 0, i_byte
= 0; i
< SCHARS (prefix
);)
1900 FETCH_STRING_CHAR_ADVANCE (c
, prefix
, i
, i_byte
);
1901 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
1902 c
^= 0200 | meta_modifier
;
1903 ASET (copy
, i_before
, make_number (c
));
1907 maps
= Fcons (Fcons (prefix
, tem
), Qnil
);
1913 maps
= Fcons (Fcons (Fmake_vector (make_number (0), Qnil
),
1914 get_keymap (keymap
, 1, 0)),
1917 /* For each map in the list maps,
1918 look at any other maps it points to,
1919 and stick them at the end if they are not already in the list.
1921 This is a breadth-first traversal, where tail is the queue of
1922 nodes, and maps accumulates a list of all nodes visited. */
1924 for (tail
= maps
; CONSP (tail
); tail
= XCDR (tail
))
1926 register Lisp_Object thisseq
, thismap
;
1928 /* Does the current sequence end in the meta-prefix-char? */
1931 thisseq
= Fcar (Fcar (tail
));
1932 thismap
= Fcdr (Fcar (tail
));
1933 last
= make_number (XINT (Flength (thisseq
)) - 1);
1934 is_metized
= (XINT (last
) >= 0
1935 /* Don't metize the last char of PREFIX. */
1936 && XINT (last
) >= prefixlen
1937 && EQ (Faref (thisseq
, last
), meta_prefix_char
));
1939 for (; CONSP (thismap
); thismap
= XCDR (thismap
))
1943 elt
= XCAR (thismap
);
1947 if (CHAR_TABLE_P (elt
))
1949 map_char_table (accessible_keymaps_char_table
, Qnil
,
1950 elt
, Fcons (Fcons (maps
, make_number (is_metized
)),
1951 Fcons (tail
, thisseq
)));
1953 else if (VECTORP (elt
))
1957 /* Vector keymap. Scan all the elements. */
1958 for (i
= 0; i
< ASIZE (elt
); i
++)
1959 accessible_keymaps_1 (make_number (i
), AREF (elt
, i
),
1960 maps
, tail
, thisseq
, is_metized
);
1963 else if (CONSP (elt
))
1964 accessible_keymaps_1 (XCAR (elt
), XCDR (elt
),
1965 maps
, tail
, thisseq
,
1966 is_metized
&& INTEGERP (XCAR (elt
)));
1974 Lisp_Object Qsingle_key_description
, Qkey_description
;
1976 /* This function cannot GC. */
1978 DEFUN ("key-description", Fkey_description
, Skey_description
, 1, 1, 0,
1979 doc
: /* Return a pretty description of key-sequence KEYS.
1980 Control characters turn into "C-foo" sequences, meta into "M-foo"
1981 spaces are put between sequence elements, etc. */)
1988 Lisp_Object
*args
= NULL
;
1993 vector
= Fmake_vector (Flength (keys
), Qnil
);
1994 for (i
= 0, i_byte
= 0; i
< SCHARS (keys
); )
1999 FETCH_STRING_CHAR_ADVANCE (c
, keys
, i
, i_byte
);
2000 if (SINGLE_BYTE_CHAR_P (c
) && (c
& 0200))
2001 c
^= 0200 | meta_modifier
;
2002 XSETFASTINT (AREF (vector
, i_before
), c
);
2009 /* In effect, this computes
2010 (mapconcat 'single-key-description keys " ")
2011 but we shouldn't use mapconcat because it can do GC. */
2013 len
= XVECTOR (keys
)->size
;
2014 sep
= build_string (" ");
2015 /* This has one extra element at the end that we don't pass to Fconcat. */
2016 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
2018 for (i
= 0; i
< len
; i
++)
2020 args
[i
* 2] = Fsingle_key_description (AREF (keys
, i
), Qnil
);
2021 args
[i
* 2 + 1] = sep
;
2024 else if (CONSP (keys
))
2026 /* In effect, this computes
2027 (mapconcat 'single-key-description keys " ")
2028 but we shouldn't use mapconcat because it can do GC. */
2030 len
= XFASTINT (Flength (keys
));
2031 sep
= build_string (" ");
2032 /* This has one extra element at the end that we don't pass to Fconcat. */
2033 args
= (Lisp_Object
*) alloca (len
* 2 * sizeof (Lisp_Object
));
2035 for (i
= 0; i
< len
; i
++)
2037 args
[i
* 2] = Fsingle_key_description (XCAR (keys
), Qnil
);
2038 args
[i
* 2 + 1] = sep
;
2043 keys
= wrong_type_argument (Qarrayp
, keys
);
2046 return empty_string
;
2047 return Fconcat (len
* 2 - 1, args
);
2051 push_key_description (c
, p
, force_multibyte
)
2052 register unsigned int c
;
2054 int force_multibyte
;
2058 /* Clear all the meaningless bits above the meta bit. */
2059 c
&= meta_modifier
| ~ - meta_modifier
;
2060 c2
= c
& ~(alt_modifier
| ctrl_modifier
| hyper_modifier
2061 | meta_modifier
| shift_modifier
| super_modifier
);
2063 if (c
& alt_modifier
)
2069 if ((c
& ctrl_modifier
) != 0
2070 || (c2
< ' ' && c2
!= 27 && c2
!= '\t' && c2
!= Ctl ('M')))
2074 c
&= ~ctrl_modifier
;
2076 if (c
& hyper_modifier
)
2080 c
-= hyper_modifier
;
2082 if (c
& meta_modifier
)
2088 if (c
& shift_modifier
)
2092 c
-= shift_modifier
;
2094 if (c
& super_modifier
)
2098 c
-= super_modifier
;
2114 else if (c
== Ctl ('M'))
2122 /* `C-' already added above. */
2123 if (c
> 0 && c
<= Ctl ('Z'))
2142 || (NILP (current_buffer
->enable_multibyte_characters
)
2143 && SINGLE_BYTE_CHAR_P (c
)
2144 && !force_multibyte
))
2148 else if (CHARACTERP (make_number (c
)))
2150 if (NILP (current_buffer
->enable_multibyte_characters
)
2151 && ! force_multibyte
)
2152 *p
++ = multibyte_char_to_unibyte (c
, Qnil
);
2154 p
+= CHAR_STRING (c
, (unsigned char *) p
);
2160 /* The biggest character code uses 22 bits. */
2161 for (bit_offset
= 21; bit_offset
>= 0; bit_offset
-= 3)
2163 if (c
>= (1 << bit_offset
))
2164 *p
++ = ((c
& (7 << bit_offset
)) >> bit_offset
) + '0';
2171 /* This function cannot GC. */
2173 DEFUN ("single-key-description", Fsingle_key_description
,
2174 Ssingle_key_description
, 1, 2, 0,
2175 doc
: /* Return a pretty description of command character KEY.
2176 Control characters turn into C-whatever, etc.
2177 Optional argument NO-ANGLES non-nil means don't put angle brackets
2178 around function keys and event symbols. */)
2180 Lisp_Object key
, no_angles
;
2182 if (CONSP (key
) && lucid_event_type_list_p (key
))
2183 key
= Fevent_convert_list (key
);
2185 key
= EVENT_HEAD (key
);
2187 if (INTEGERP (key
)) /* Normal character */
2189 char tem
[KEY_DESCRIPTION_SIZE
];
2191 *push_key_description (XUINT (key
), tem
, 1) = 0;
2192 return build_string (tem
);
2194 else if (SYMBOLP (key
)) /* Function key or event-symbol */
2196 if (NILP (no_angles
))
2199 = (char *) alloca (SBYTES (SYMBOL_NAME (key
)) + 5);
2200 sprintf (buffer
, "<%s>", SDATA (SYMBOL_NAME (key
)));
2201 return build_string (buffer
);
2204 return Fsymbol_name (key
);
2206 else if (STRINGP (key
)) /* Buffer names in the menubar. */
2207 return Fcopy_sequence (key
);
2209 error ("KEY must be an integer, cons, symbol, or string");
2214 push_text_char_description (c
, p
)
2215 register unsigned int c
;
2227 *p
++ = c
+ 64; /* 'A' - 1 */
2239 /* This function cannot GC. */
2241 DEFUN ("text-char-description", Ftext_char_description
, Stext_char_description
, 1, 1, 0,
2242 doc
: /* Return a pretty description of file-character CHARACTER.
2243 Control characters turn into "^char", etc. */)
2245 Lisp_Object character
;
2247 /* Currently MAX_MULTIBYTE_LENGTH is 4 (< 6). */
2248 unsigned char str
[6];
2251 CHECK_NUMBER (character
);
2253 c
= XINT (character
);
2254 if (!ASCII_CHAR_P (c
))
2256 int len
= CHAR_STRING (c
, str
);
2258 return make_multibyte_string (str
, 1, len
);
2261 *push_text_char_description (c
& 0377, str
) = 0;
2263 return build_string (str
);
2266 /* Return non-zero if SEQ contains only ASCII characters, perhaps with
2269 ascii_sequence_p (seq
)
2273 int len
= XINT (Flength (seq
));
2275 for (i
= 0; i
< len
; i
++)
2277 Lisp_Object ii
, elt
;
2279 XSETFASTINT (ii
, i
);
2280 elt
= Faref (seq
, ii
);
2283 || (XUINT (elt
) & ~CHAR_META
) >= 0x80)
2291 /* where-is - finding a command in a set of keymaps. */
2293 static Lisp_Object
where_is_internal ();
2294 static Lisp_Object
where_is_internal_1 ();
2295 static void where_is_internal_2 ();
2297 /* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
2298 Returns the first non-nil binding found in any of those maps. */
2301 shadow_lookup (shadow
, key
, flag
)
2302 Lisp_Object shadow
, key
, flag
;
2304 Lisp_Object tail
, value
;
2306 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2308 value
= Flookup_key (XCAR (tail
), key
, flag
);
2309 if (!NILP (value
) && !NATNUMP (value
))
2315 static Lisp_Object Vmenu_events
;
2317 /* This function can GC if Flookup_key autoloads any keymaps. */
2320 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
)
2321 Lisp_Object definition
, keymaps
;
2322 Lisp_Object firstonly
, noindirect
, no_remap
;
2324 Lisp_Object maps
= Qnil
;
2325 Lisp_Object found
, sequences
;
2326 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2327 /* 1 means ignore all menu bindings entirely. */
2328 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2330 /* If this command is remapped, then it has no key bindings
2332 if (NILP (no_remap
) && SYMBOLP (definition
))
2335 if (tem
= Fcommand_remapping (definition
), !NILP (tem
))
2340 while (CONSP (found
))
2344 Faccessible_keymaps (get_keymap (XCAR (found
), 1, 0), Qnil
));
2345 found
= XCDR (found
);
2348 GCPRO5 (definition
, keymaps
, maps
, found
, sequences
);
2352 for (; !NILP (maps
); maps
= Fcdr (maps
))
2354 /* Key sequence to reach map, and the map that it reaches */
2355 register Lisp_Object
this, map
, tem
;
2357 /* In order to fold [META-PREFIX-CHAR CHAR] sequences into
2358 [M-CHAR] sequences, check if last character of the sequence
2359 is the meta-prefix char. */
2363 this = Fcar (Fcar (maps
));
2364 map
= Fcdr (Fcar (maps
));
2365 last
= make_number (XINT (Flength (this)) - 1);
2366 last_is_meta
= (XINT (last
) >= 0
2367 && EQ (Faref (this, last
), meta_prefix_char
));
2369 /* if (nomenus && !ascii_sequence_p (this)) */
2370 if (nomenus
&& XINT (last
) >= 0
2371 && SYMBOLP (tem
= Faref (this, make_number (0)))
2372 && !NILP (Fmemq (XCAR (parse_modifiers (tem
)), Vmenu_events
)))
2373 /* If no menu entries should be returned, skip over the
2374 keymaps bound to `menu-bar' and `tool-bar' and other
2375 non-ascii prefixes like `C-down-mouse-2'. */
2382 /* Because the code we want to run on each binding is rather
2383 large, we don't want to have two separate loop bodies for
2384 sparse keymap bindings and tables; we want to iterate one
2385 loop body over both keymap and vector bindings.
2387 For this reason, if Fcar (map) is a vector, we don't
2388 advance map to the next element until i indicates that we
2389 have finished off the vector. */
2390 Lisp_Object elt
, key
, binding
;
2398 /* Set key and binding to the current key and binding, and
2399 advance map and i to the next binding. */
2402 Lisp_Object sequence
;
2404 /* In a vector, look at each element. */
2405 for (i
= 0; i
< XVECTOR (elt
)->size
; i
++)
2407 binding
= AREF (elt
, i
);
2408 XSETFASTINT (key
, i
);
2409 sequence
= where_is_internal_1 (binding
, key
, definition
,
2411 last
, nomenus
, last_is_meta
);
2412 if (!NILP (sequence
))
2413 sequences
= Fcons (sequence
, sequences
);
2416 else if (CHAR_TABLE_P (elt
))
2420 args
= Fcons (Fcons (Fcons (definition
, noindirect
),
2421 Qnil
), /* Result accumulator. */
2422 Fcons (Fcons (this, last
),
2423 Fcons (make_number (nomenus
),
2424 make_number (last_is_meta
))));
2425 map_char_table (where_is_internal_2
, Qnil
, elt
, args
);
2426 sequences
= XCDR (XCAR (args
));
2428 else if (CONSP (elt
))
2430 Lisp_Object sequence
;
2433 binding
= XCDR (elt
);
2435 sequence
= where_is_internal_1 (binding
, key
, definition
,
2437 last
, nomenus
, last_is_meta
);
2438 if (!NILP (sequence
))
2439 sequences
= Fcons (sequence
, sequences
);
2443 while (!NILP (sequences
))
2445 Lisp_Object sequence
, remapped
, function
;
2447 sequence
= XCAR (sequences
);
2448 sequences
= XCDR (sequences
);
2450 /* If the current sequence is a command remapping with
2451 format [remap COMMAND], find the key sequences
2452 which run COMMAND, and use those sequences instead. */
2455 && VECTORP (sequence
) && XVECTOR (sequence
)->size
== 2
2456 && EQ (AREF (sequence
, 0), Qremap
)
2457 && (function
= AREF (sequence
, 1), SYMBOLP (function
)))
2459 Lisp_Object remapped1
;
2461 remapped1
= where_is_internal (function
, keymaps
, firstonly
, noindirect
, Qt
);
2462 if (CONSP (remapped1
))
2464 /* Verify that this key binding actually maps to the
2465 remapped command (see below). */
2466 if (!EQ (shadow_lookup (keymaps
, XCAR (remapped1
), Qnil
), function
))
2468 sequence
= XCAR (remapped1
);
2469 remapped
= XCDR (remapped1
);
2470 goto record_sequence
;
2474 /* Verify that this key binding is not shadowed by another
2475 binding for the same key, before we say it exists.
2477 Mechanism: look for local definition of this key and if
2478 it is defined and does not match what we found then
2481 Either nil or number as value from Flookup_key
2483 if (!EQ (shadow_lookup (keymaps
, sequence
, Qnil
), definition
))
2487 /* It is a true unshadowed match. Record it, unless it's already
2488 been seen (as could happen when inheriting keymaps). */
2489 if (NILP (Fmember (sequence
, found
)))
2490 found
= Fcons (sequence
, found
);
2492 /* If firstonly is Qnon_ascii, then we can return the first
2493 binding we find. If firstonly is not Qnon_ascii but not
2494 nil, then we should return the first ascii-only binding
2496 if (EQ (firstonly
, Qnon_ascii
))
2497 RETURN_UNGCPRO (sequence
);
2498 else if (!NILP (firstonly
) && ascii_sequence_p (sequence
))
2499 RETURN_UNGCPRO (sequence
);
2501 if (CONSP (remapped
))
2503 sequence
= XCAR (remapped
);
2504 remapped
= XCDR (remapped
);
2505 goto record_sequence
;
2513 found
= Fnreverse (found
);
2515 /* firstonly may have been t, but we may have gone all the way through
2516 the keymaps without finding an all-ASCII key sequence. So just
2517 return the best we could find. */
2518 if (!NILP (firstonly
))
2519 return Fcar (found
);
2524 DEFUN ("where-is-internal", Fwhere_is_internal
, Swhere_is_internal
, 1, 5, 0,
2525 doc
: /* Return list of keys that invoke DEFINITION.
2526 If KEYMAP is non-nil, search only KEYMAP and the global keymap.
2527 If KEYMAP is nil, search all the currently active keymaps.
2528 If KEYMAP is a list of keymaps, search only those keymaps.
2530 If optional 3rd arg FIRSTONLY is non-nil, return the first key sequence found,
2531 rather than a list of all possible key sequences.
2532 If FIRSTONLY is the symbol `non-ascii', return the first binding found,
2533 no matter what it is.
2534 If FIRSTONLY has another non-nil value, prefer sequences of ASCII characters,
2535 and entirely reject menu bindings.
2537 If optional 4th arg NOINDIRECT is non-nil, don't follow indirections
2538 to other keymaps or slots. This makes it possible to search for an
2539 indirect definition itself.
2541 If optional 5th arg NO-REMAP is non-nil, don't search for key sequences
2542 that invoke a command which is remapped to DEFINITION, but include the
2543 remapped command in the returned list. */)
2544 (definition
, keymap
, firstonly
, noindirect
, no_remap
)
2545 Lisp_Object definition
, keymap
;
2546 Lisp_Object firstonly
, noindirect
, no_remap
;
2548 Lisp_Object sequences
, keymaps
;
2549 /* 1 means ignore all menu bindings entirely. */
2550 int nomenus
= !NILP (firstonly
) && !EQ (firstonly
, Qnon_ascii
);
2553 /* Find the relevant keymaps. */
2554 if (CONSP (keymap
) && KEYMAPP (XCAR (keymap
)))
2556 else if (!NILP (keymap
))
2557 keymaps
= Fcons (keymap
, Fcons (current_global_map
, Qnil
));
2559 keymaps
= Fcurrent_active_maps (Qnil
);
2561 /* Only use caching for the menubar (i.e. called with (def nil t nil).
2562 We don't really need to check `keymap'. */
2563 if (nomenus
&& NILP (noindirect
) && NILP (keymap
))
2567 struct gcpro gcpro1
, gcpro2
, gcpro3
, gcpro4
, gcpro5
;
2569 /* Check heuristic-consistency of the cache. */
2570 if (NILP (Fequal (keymaps
, where_is_cache_keymaps
)))
2571 where_is_cache
= Qnil
;
2573 if (NILP (where_is_cache
))
2575 /* We need to create the cache. */
2576 Lisp_Object args
[2];
2577 where_is_cache
= Fmake_hash_table (0, args
);
2578 where_is_cache_keymaps
= Qt
;
2580 /* Fill in the cache. */
2581 GCPRO5 (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2582 where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2585 where_is_cache_keymaps
= keymaps
;
2588 /* We want to process definitions from the last to the first.
2589 Instead of consing, copy definitions to a vector and step
2590 over that vector. */
2591 sequences
= Fgethash (definition
, where_is_cache
, Qnil
);
2592 n
= XINT (Flength (sequences
));
2593 defns
= (Lisp_Object
*) alloca (n
* sizeof *defns
);
2594 for (i
= 0; CONSP (sequences
); sequences
= XCDR (sequences
))
2595 defns
[i
++] = XCAR (sequences
);
2597 /* Verify that the key bindings are not shadowed. Note that
2598 the following can GC. */
2599 GCPRO2 (definition
, keymaps
);
2602 for (i
= n
- 1; i
>= 0; --i
)
2603 if (EQ (shadow_lookup (keymaps
, defns
[i
], Qnil
), definition
))
2605 if (ascii_sequence_p (defns
[i
]))
2611 result
= i
>= 0 ? defns
[i
] : (j
>= 0 ? defns
[j
] : Qnil
);
2616 /* Kill the cache so that where_is_internal_1 doesn't think
2617 we're filling it up. */
2618 where_is_cache
= Qnil
;
2619 result
= where_is_internal (definition
, keymaps
, firstonly
, noindirect
, no_remap
);
2625 /* This is the function that Fwhere_is_internal calls using map_char_table.
2627 (((DEFINITION . NOINDIRECT) . (KEYMAP . RESULT))
2629 ((THIS . LAST) . (NOMENUS . LAST_IS_META)))
2630 Since map_char_table doesn't really use the return value from this function,
2631 we the result append to RESULT, the slot in ARGS.
2633 This function can GC because it calls where_is_internal_1 which can
2637 where_is_internal_2 (args
, key
, binding
)
2638 Lisp_Object args
, key
, binding
;
2640 Lisp_Object definition
, noindirect
, this, last
;
2641 Lisp_Object result
, sequence
;
2642 int nomenus
, last_is_meta
;
2643 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2645 GCPRO3 (args
, key
, binding
);
2646 result
= XCDR (XCAR (args
));
2647 definition
= XCAR (XCAR (XCAR (args
)));
2648 noindirect
= XCDR (XCAR (XCAR (args
)));
2649 this = XCAR (XCAR (XCDR (args
)));
2650 last
= XCDR (XCAR (XCDR (args
)));
2651 nomenus
= XFASTINT (XCAR (XCDR (XCDR (args
))));
2652 last_is_meta
= XFASTINT (XCDR (XCDR (XCDR (args
))));
2654 sequence
= where_is_internal_1 (binding
, key
, definition
, noindirect
,
2655 this, last
, nomenus
, last_is_meta
);
2657 if (!NILP (sequence
))
2658 XSETCDR (XCAR (args
), Fcons (sequence
, result
));
2664 /* This function cannot GC. */
2667 where_is_internal_1 (binding
, key
, definition
, noindirect
, this, last
,
2668 nomenus
, last_is_meta
)
2669 Lisp_Object binding
, key
, definition
, noindirect
, this, last
;
2670 int nomenus
, last_is_meta
;
2672 Lisp_Object sequence
;
2674 /* Search through indirections unless that's not wanted. */
2675 if (NILP (noindirect
))
2676 binding
= get_keyelt (binding
, 0);
2678 /* End this iteration if this element does not match
2681 if (!(!NILP (where_is_cache
) /* everything "matches" during cache-fill. */
2682 || EQ (binding
, definition
)
2683 || (CONSP (definition
) && !NILP (Fequal (binding
, definition
)))))
2684 /* Doesn't match. */
2687 /* We have found a match. Construct the key sequence where we found it. */
2688 if (INTEGERP (key
) && last_is_meta
)
2690 sequence
= Fcopy_sequence (this);
2691 Faset (sequence
, last
, make_number (XINT (key
) | meta_modifier
));
2694 sequence
= append_key (this, key
);
2696 if (!NILP (where_is_cache
))
2698 Lisp_Object sequences
= Fgethash (binding
, where_is_cache
, Qnil
);
2699 Fputhash (binding
, Fcons (sequence
, sequences
), where_is_cache
);
2706 /* describe-bindings - summarizing all the bindings in a set of keymaps. */
2708 DEFUN ("describe-buffer-bindings", Fdescribe_buffer_bindings
, Sdescribe_buffer_bindings
, 1, 3, 0,
2709 doc
: /* Insert the list of all defined keys and their definitions.
2710 The list is inserted in the current buffer, while the bindings are
2711 looked up in BUFFER.
2712 The optional argument PREFIX, if non-nil, should be a key sequence;
2713 then we display only bindings that start with that prefix.
2714 The optional argument MENUS, if non-nil, says to mention menu bindings.
2715 \(Ordinarily these are omitted from the output.) */)
2716 (buffer
, prefix
, menus
)
2717 Lisp_Object buffer
, prefix
, menus
;
2719 Lisp_Object outbuf
, shadow
;
2720 int nomenu
= NILP (menus
);
2721 register Lisp_Object start1
;
2722 struct gcpro gcpro1
;
2724 char *alternate_heading
2726 Keyboard translations:\n\n\
2727 You type Translation\n\
2728 -------- -----------\n";
2733 outbuf
= Fcurrent_buffer ();
2735 /* Report on alternates for keys. */
2736 if (STRINGP (Vkeyboard_translate_table
) && !NILP (prefix
))
2739 const unsigned char *translate
= SDATA (Vkeyboard_translate_table
);
2740 int translate_len
= SCHARS (Vkeyboard_translate_table
);
2742 for (c
= 0; c
< translate_len
; c
++)
2743 if (translate
[c
] != c
)
2745 char buf
[KEY_DESCRIPTION_SIZE
];
2748 if (alternate_heading
)
2750 insert_string (alternate_heading
);
2751 alternate_heading
= 0;
2754 bufend
= push_key_description (translate
[c
], buf
, 1);
2755 insert (buf
, bufend
- buf
);
2756 Findent_to (make_number (16), make_number (1));
2757 bufend
= push_key_description (c
, buf
, 1);
2758 insert (buf
, bufend
- buf
);
2766 if (!NILP (Vkey_translation_map
))
2767 describe_map_tree (Vkey_translation_map
, 0, Qnil
, prefix
,
2768 "Key translations", nomenu
, 1, 0);
2771 /* Print the (major mode) local map. */
2773 if (!NILP (current_kboard
->Voverriding_terminal_local_map
))
2774 start1
= current_kboard
->Voverriding_terminal_local_map
;
2775 else if (!NILP (Voverriding_local_map
))
2776 start1
= Voverriding_local_map
;
2780 describe_map_tree (start1
, 1, shadow
, prefix
,
2781 "\f\nOverriding Bindings", nomenu
, 0, 0);
2782 shadow
= Fcons (start1
, shadow
);
2786 /* Print the minor mode and major mode keymaps. */
2788 Lisp_Object
*modes
, *maps
;
2790 /* Temporarily switch to `buffer', so that we can get that buffer's
2791 minor modes correctly. */
2792 Fset_buffer (buffer
);
2794 nmaps
= current_minor_maps (&modes
, &maps
);
2795 Fset_buffer (outbuf
);
2797 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2798 XBUFFER (buffer
), Qkeymap
);
2801 describe_map_tree (start1
, 1, shadow
, prefix
,
2802 "\f\n`keymap' Property Bindings", nomenu
, 0, 0);
2803 shadow
= Fcons (start1
, shadow
);
2806 /* Print the minor mode maps. */
2807 for (i
= 0; i
< nmaps
; i
++)
2809 /* The title for a minor mode keymap
2810 is constructed at run time.
2811 We let describe_map_tree do the actual insertion
2812 because it takes care of other features when doing so. */
2815 if (!SYMBOLP (modes
[i
]))
2818 p
= title
= (char *) alloca (42 + SCHARS (SYMBOL_NAME (modes
[i
])));
2822 bcopy (SDATA (SYMBOL_NAME (modes
[i
])), p
,
2823 SCHARS (SYMBOL_NAME (modes
[i
])));
2824 p
+= SCHARS (SYMBOL_NAME (modes
[i
]));
2826 bcopy (" Minor Mode Bindings", p
, sizeof (" Minor Mode Bindings") - 1);
2827 p
+= sizeof (" Minor Mode Bindings") - 1;
2830 describe_map_tree (maps
[i
], 1, shadow
, prefix
, title
, nomenu
, 0, 0);
2831 shadow
= Fcons (maps
[i
], shadow
);
2834 start1
= get_local_map (BUF_PT (XBUFFER (buffer
)),
2835 XBUFFER (buffer
), Qlocal_map
);
2838 if (EQ (start1
, XBUFFER (buffer
)->keymap
))
2839 describe_map_tree (start1
, 1, shadow
, prefix
,
2840 "\f\nMajor Mode Bindings", nomenu
, 0, 0);
2842 describe_map_tree (start1
, 1, shadow
, prefix
,
2843 "\f\n`local-map' Property Bindings",
2846 shadow
= Fcons (start1
, shadow
);
2850 describe_map_tree (current_global_map
, 1, shadow
, prefix
,
2851 "\f\nGlobal Bindings", nomenu
, 0, 1);
2853 /* Print the function-key-map translations under this prefix. */
2854 if (!NILP (Vfunction_key_map
))
2855 describe_map_tree (Vfunction_key_map
, 0, Qnil
, prefix
,
2856 "\f\nFunction key map translations", nomenu
, 1, 0);
2862 /* Insert a description of the key bindings in STARTMAP,
2863 followed by those of all maps reachable through STARTMAP.
2864 If PARTIAL is nonzero, omit certain "uninteresting" commands
2865 (such as `undefined').
2866 If SHADOW is non-nil, it is a list of maps;
2867 don't mention keys which would be shadowed by any of them.
2868 PREFIX, if non-nil, says mention only keys that start with PREFIX.
2869 TITLE, if not 0, is a string to insert at the beginning.
2870 TITLE should not end with a colon or a newline; we supply that.
2871 If NOMENU is not 0, then omit menu-bar commands.
2873 If TRANSL is nonzero, the definitions are actually key translations
2874 so print strings and vectors differently.
2876 If ALWAYS_TITLE is nonzero, print the title even if there are no maps
2880 describe_map_tree (startmap
, partial
, shadow
, prefix
, title
, nomenu
, transl
,
2882 Lisp_Object startmap
, shadow
, prefix
;
2889 Lisp_Object maps
, orig_maps
, seen
, sub_shadows
;
2890 struct gcpro gcpro1
, gcpro2
, gcpro3
;
2897 orig_maps
= maps
= Faccessible_keymaps (startmap
, prefix
);
2900 GCPRO3 (maps
, seen
, sub_shadows
);
2906 /* Delete from MAPS each element that is for the menu bar. */
2907 for (list
= maps
; !NILP (list
); list
= XCDR (list
))
2909 Lisp_Object elt
, prefix
, tem
;
2912 prefix
= Fcar (elt
);
2913 if (XVECTOR (prefix
)->size
>= 1)
2915 tem
= Faref (prefix
, make_number (0));
2916 if (EQ (tem
, Qmenu_bar
))
2917 maps
= Fdelq (elt
, maps
);
2922 if (!NILP (maps
) || always_title
)
2926 insert_string (title
);
2929 insert_string (" Starting With ");
2930 insert1 (Fkey_description (prefix
));
2932 insert_string (":\n");
2934 insert_string (key_heading
);
2938 for (; !NILP (maps
); maps
= Fcdr (maps
))
2940 register Lisp_Object elt
, prefix
, tail
;
2943 prefix
= Fcar (elt
);
2947 for (tail
= shadow
; CONSP (tail
); tail
= XCDR (tail
))
2951 shmap
= XCAR (tail
);
2953 /* If the sequence by which we reach this keymap is zero-length,
2954 then the shadow map for this keymap is just SHADOW. */
2955 if ((STRINGP (prefix
) && SCHARS (prefix
) == 0)
2956 || (VECTORP (prefix
) && XVECTOR (prefix
)->size
== 0))
2958 /* If the sequence by which we reach this keymap actually has
2959 some elements, then the sequence's definition in SHADOW is
2960 what we should use. */
2963 shmap
= Flookup_key (shmap
, Fcar (elt
), Qt
);
2964 if (INTEGERP (shmap
))
2968 /* If shmap is not nil and not a keymap,
2969 it completely shadows this map, so don't
2970 describe this map at all. */
2971 if (!NILP (shmap
) && !KEYMAPP (shmap
))
2975 sub_shadows
= Fcons (shmap
, sub_shadows
);
2978 /* Maps we have already listed in this loop shadow this map. */
2979 for (tail
= orig_maps
; !EQ (tail
, maps
); tail
= XCDR (tail
))
2982 tem
= Fequal (Fcar (XCAR (tail
)), prefix
);
2984 sub_shadows
= Fcons (XCDR (XCAR (tail
)), sub_shadows
);
2987 describe_map (Fcdr (elt
), prefix
,
2988 transl
? describe_translation
: describe_command
,
2989 partial
, sub_shadows
, &seen
, nomenu
);
2995 insert_string ("\n");
3000 static int previous_description_column
;
3003 describe_command (definition
, args
)
3004 Lisp_Object definition
, args
;
3006 register Lisp_Object tem1
;
3007 int column
= (int) current_column (); /* iftc */
3008 int description_column
;
3010 /* If column 16 is no good, go to col 32;
3011 but don't push beyond that--go to next line instead. */
3015 description_column
= 32;
3017 else if (column
> 14 || (column
> 10 && previous_description_column
== 32))
3018 description_column
= 32;
3020 description_column
= 16;
3022 Findent_to (make_number (description_column
), make_number (1));
3023 previous_description_column
= description_column
;
3025 if (SYMBOLP (definition
))
3027 tem1
= SYMBOL_NAME (definition
);
3029 insert_string ("\n");
3031 else if (STRINGP (definition
) || VECTORP (definition
))
3032 insert_string ("Keyboard Macro\n");
3033 else if (KEYMAPP (definition
))
3034 insert_string ("Prefix Command\n");
3036 insert_string ("??\n");
3040 describe_translation (definition
, args
)
3041 Lisp_Object definition
, args
;
3043 register Lisp_Object tem1
;
3045 Findent_to (make_number (16), make_number (1));
3047 if (SYMBOLP (definition
))
3049 tem1
= SYMBOL_NAME (definition
);
3051 insert_string ("\n");
3053 else if (STRINGP (definition
) || VECTORP (definition
))
3055 insert1 (Fkey_description (definition
));
3056 insert_string ("\n");
3058 else if (KEYMAPP (definition
))
3059 insert_string ("Prefix Command\n");
3061 insert_string ("??\n");
3064 /* Describe the contents of map MAP, assuming that this map itself is
3065 reached by the sequence of prefix keys KEYS (a string or vector).
3066 PARTIAL, SHADOW, NOMENU are as in `describe_map_tree' above. */
3069 describe_map (map
, keys
, elt_describer
, partial
, shadow
, seen
, nomenu
)
3070 register Lisp_Object map
;
3072 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3078 Lisp_Object elt_prefix
;
3079 Lisp_Object tail
, definition
, event
;
3081 Lisp_Object suppress
;
3084 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3088 if (!NILP (keys
) && XFASTINT (Flength (keys
)) > 0)
3090 /* Call Fkey_description first, to avoid GC bug for the other string. */
3091 tem
= Fkey_description (keys
);
3092 elt_prefix
= concat2 (tem
, build_string (" "));
3098 suppress
= intern ("suppress-keymap");
3100 /* This vector gets used to present single keys to Flookup_key. Since
3101 that is done once per keymap element, we don't want to cons up a
3102 fresh vector every time. */
3103 kludge
= Fmake_vector (make_number (1), Qnil
);
3106 GCPRO3 (elt_prefix
, definition
, kludge
);
3108 for (tail
= map
; CONSP (tail
); tail
= XCDR (tail
))
3112 if (VECTORP (XCAR (tail
))
3113 || CHAR_TABLE_P (XCAR (tail
)))
3114 describe_vector (XCAR (tail
),
3115 elt_prefix
, Qnil
, elt_describer
, partial
, shadow
, map
,
3117 else if (CONSP (XCAR (tail
)))
3119 event
= XCAR (XCAR (tail
));
3121 /* Ignore bindings whose "keys" are not really valid events.
3122 (We get these in the frames and buffers menu.) */
3123 if (!(SYMBOLP (event
) || INTEGERP (event
)))
3126 if (nomenu
&& EQ (event
, Qmenu_bar
))
3129 definition
= get_keyelt (XCDR (XCAR (tail
)), 0);
3131 /* Don't show undefined commands or suppressed commands. */
3132 if (NILP (definition
)) continue;
3133 if (SYMBOLP (definition
) && partial
)
3135 tem
= Fget (definition
, suppress
);
3140 /* Don't show a command that isn't really visible
3141 because a local definition of the same key shadows it. */
3143 ASET (kludge
, 0, event
);
3146 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3147 if (!NILP (tem
)) continue;
3150 tem
= Flookup_key (map
, kludge
, Qt
);
3151 if (!EQ (tem
, definition
)) continue;
3155 previous_description_column
= 0;
3160 if (!NILP (elt_prefix
))
3161 insert1 (elt_prefix
);
3163 /* THIS gets the string to describe the character EVENT. */
3164 insert1 (Fsingle_key_description (event
, Qnil
));
3166 /* Print a description of the definition of this character.
3167 elt_describer will take care of spacing out far enough
3168 for alignment purposes. */
3169 (*elt_describer
) (definition
, Qnil
);
3171 else if (EQ (XCAR (tail
), Qkeymap
))
3173 /* The same keymap might be in the structure twice, if we're
3174 using an inherited keymap. So skip anything we've already
3176 tem
= Fassq (tail
, *seen
);
3177 if (CONSP (tem
) && !NILP (Fequal (XCAR (tem
), keys
)))
3179 *seen
= Fcons (Fcons (tail
, keys
), *seen
);
3187 describe_vector_princ (elt
, fun
)
3188 Lisp_Object elt
, fun
;
3190 Findent_to (make_number (16), make_number (1));
3195 DEFUN ("describe-vector", Fdescribe_vector
, Sdescribe_vector
, 1, 2, 0,
3196 doc
: /* Insert a description of contents of VECTOR.
3197 This is text showing the elements of vector matched against indices. */)
3199 Lisp_Object vector
, describer
;
3201 int count
= SPECPDL_INDEX ();
3202 if (NILP (describer
))
3203 describer
= intern ("princ");
3204 specbind (Qstandard_output
, Fcurrent_buffer ());
3205 CHECK_VECTOR_OR_CHAR_TABLE (vector
);
3206 describe_vector (vector
, Qnil
, describer
, describe_vector_princ
, 0,
3207 Qnil
, Qnil
, (int *)0, 0);
3209 return unbind_to (count
, Qnil
);
3212 /* Insert in the current buffer a description of the contents of VECTOR.
3213 We call ELT_DESCRIBER to insert the description of one value found
3216 ELT_PREFIX describes what "comes before" the keys or indices defined
3217 by this vector. This is a human-readable string whose size
3218 is not necessarily related to the situation.
3220 If the vector is in a keymap, ELT_PREFIX is a prefix key which
3221 leads to this keymap.
3223 If the vector is a chartable, ELT_PREFIX is the vector
3224 of bytes that lead to the character set or portion of a character
3225 set described by this chartable.
3227 If PARTIAL is nonzero, it means do not mention suppressed commands
3228 (that assumes the vector is in a keymap).
3230 SHADOW is a list of keymaps that shadow this map.
3231 If it is non-nil, then we look up the key in those maps
3232 and we don't mention it now if it is defined by any of them.
3234 ENTIRE_MAP is the keymap in which this vector appears.
3235 If the definition in effect in the whole map does not match
3236 the one in this vector, we ignore this one.
3238 ARGS is simply passed as the second argument to ELT_DESCRIBER.
3240 INDICES and CHAR_TABLE_DEPTH are ignored. They will be removed in
3244 describe_vector (vector
, elt_prefix
, args
, elt_describer
,
3245 partial
, shadow
, entire_map
,
3246 indices
, char_table_depth
)
3247 register Lisp_Object vector
;
3248 Lisp_Object elt_prefix
, args
;
3249 void (*elt_describer
) P_ ((Lisp_Object
, Lisp_Object
));
3252 Lisp_Object entire_map
;
3254 int char_table_depth
;
3256 Lisp_Object definition
;
3259 Lisp_Object suppress
;
3261 struct gcpro gcpro1
, gcpro2
, gcpro3
;
3262 /* Range of elements to be handled. */
3264 Lisp_Object character
;
3272 /* This vector gets used to present single keys to Flookup_key. Since
3273 that is done once per vector element, we don't want to cons up a
3274 fresh vector every time. */
3275 kludge
= Fmake_vector (make_number (1), Qnil
);
3276 GCPRO3 (elt_prefix
, definition
, kludge
);
3279 suppress
= intern ("suppress-keymap");
3282 to
= CHAR_TABLE_P (vector
) ? MAX_CHAR
+ 1 : XVECTOR (vector
)->size
;
3284 for (i
= from
; i
< to
; i
++)
3286 int range_beg
, range_end
;
3293 if (CHAR_TABLE_P (vector
))
3294 val
= char_table_ref_and_range (vector
, i
, &range_beg
, &i
);
3296 val
= AREF (vector
, i
);
3297 definition
= get_keyelt (val
, 0);
3299 if (NILP (definition
)) continue;
3301 /* Don't mention suppressed commands. */
3302 if (SYMBOLP (definition
) && partial
)
3306 tem
= Fget (definition
, suppress
);
3308 if (!NILP (tem
)) continue;
3311 character
= make_number (starting_i
);
3313 /* If this binding is shadowed by some other map, ignore it. */
3318 ASET (kludge
, 0, character
);
3319 tem
= shadow_lookup (shadow
, kludge
, Qt
);
3321 if (!NILP (tem
)) continue;
3324 /* Ignore this definition if it is shadowed by an earlier
3325 one in the same keymap. */
3326 if (!NILP (entire_map
))
3330 ASET (kludge
, 0, character
);
3331 tem
= Flookup_key (entire_map
, kludge
, Qt
);
3333 if (!EQ (tem
, definition
))
3343 /* Output the prefix that applies to every entry in this map. */
3344 if (!NILP (elt_prefix
))
3345 insert1 (elt_prefix
);
3347 insert1 (Fsingle_key_description (character
, Qnil
));
3349 /* Find all consecutive characters or rows that have the same
3350 definition. But, for elements of a top level char table, if
3351 they are for charsets, we had better describe one by one even
3352 if they have the same definition. */
3353 if (CHAR_TABLE_P (vector
))
3355 && (val
= char_table_ref_and_range (vector
, i
+ 1,
3356 &range_beg
, &range_end
),
3357 tem2
= get_keyelt (val
, 0),
3359 && !NILP (Fequal (tem2
, definition
)))
3363 && (tem2
= get_keyelt (AREF (vector
, i
+ 1), 0),
3365 && !NILP (Fequal (tem2
, definition
)))
3368 /* If we have a range of more than one character,
3369 print where the range reaches to. */
3371 if (i
!= starting_i
)
3375 if (!NILP (elt_prefix
))
3376 insert1 (elt_prefix
);
3378 insert1 (Fsingle_key_description (make_number (i
), Qnil
));
3381 /* Print a description of the definition of this character.
3382 elt_describer will take care of spacing out far enough
3383 for alignment purposes. */
3384 (*elt_describer
) (definition
, args
);
3387 if (CHAR_TABLE_P (vector
) && ! NILP (XCHAR_TABLE (vector
)->defalt
))
3389 if (!NILP (elt_prefix
))
3390 insert1 (elt_prefix
);
3391 insert ("default", 7);
3392 (*elt_describer
) (XCHAR_TABLE (vector
)->defalt
, args
);
3398 /* Apropos - finding all symbols whose names match a regexp. */
3399 static Lisp_Object apropos_predicate
;
3400 static Lisp_Object apropos_accumulate
;
3403 apropos_accum (symbol
, string
)
3404 Lisp_Object symbol
, string
;
3406 register Lisp_Object tem
;
3408 tem
= Fstring_match (string
, Fsymbol_name (symbol
), Qnil
);
3409 if (!NILP (tem
) && !NILP (apropos_predicate
))
3410 tem
= call1 (apropos_predicate
, symbol
);
3412 apropos_accumulate
= Fcons (symbol
, apropos_accumulate
);
3415 DEFUN ("apropos-internal", Fapropos_internal
, Sapropos_internal
, 1, 2, 0,
3416 doc
: /* Show all symbols whose names contain match for REGEXP.
3417 If optional 2nd arg PREDICATE is non-nil, (funcall PREDICATE SYMBOL) is done
3418 for each symbol and a symbol is mentioned only if that returns non-nil.
3419 Return list of symbols found. */)
3421 Lisp_Object regexp
, predicate
;
3424 CHECK_STRING (regexp
);
3425 apropos_predicate
= predicate
;
3426 apropos_accumulate
= Qnil
;
3427 map_obarray (Vobarray
, apropos_accum
, regexp
);
3428 tem
= Fsort (apropos_accumulate
, Qstring_lessp
);
3429 apropos_accumulate
= Qnil
;
3430 apropos_predicate
= Qnil
;
3437 Qkeymap
= intern ("keymap");
3438 staticpro (&Qkeymap
);
3439 staticpro (&apropos_predicate
);
3440 staticpro (&apropos_accumulate
);
3441 apropos_predicate
= Qnil
;
3442 apropos_accumulate
= Qnil
;
3444 /* Now we are ready to set up this property, so we can
3445 create char tables. */
3446 Fput (Qkeymap
, Qchar_table_extra_slots
, make_number (0));
3448 /* Initialize the keymaps standardly used.
3449 Each one is the value of a Lisp variable, and is also
3450 pointed to by a C variable */
3452 global_map
= Fmake_keymap (Qnil
);
3453 Fset (intern ("global-map"), global_map
);
3455 current_global_map
= global_map
;
3456 staticpro (&global_map
);
3457 staticpro (¤t_global_map
);
3459 meta_map
= Fmake_keymap (Qnil
);
3460 Fset (intern ("esc-map"), meta_map
);
3461 Ffset (intern ("ESC-prefix"), meta_map
);
3463 control_x_map
= Fmake_keymap (Qnil
);
3464 Fset (intern ("ctl-x-map"), control_x_map
);
3465 Ffset (intern ("Control-X-prefix"), control_x_map
);
3468 = Fcons (Fcons (build_string ("DEL"), build_string ("\\d")),
3469 Fcons (Fcons (build_string ("TAB"), build_string ("\\t")),
3470 Fcons (Fcons (build_string ("RET"), build_string ("\\r")),
3471 Fcons (Fcons (build_string ("ESC"), build_string ("\\e")),
3472 Fcons (Fcons (build_string ("SPC"), build_string (" ")),
3474 staticpro (&exclude_keys
);
3476 DEFVAR_LISP ("define-key-rebound-commands", &Vdefine_key_rebound_commands
,
3477 doc
: /* List of commands given new key bindings recently.
3478 This is used for internal purposes during Emacs startup;
3479 don't alter it yourself. */);
3480 Vdefine_key_rebound_commands
= Qt
;
3482 DEFVAR_LISP ("minibuffer-local-map", &Vminibuffer_local_map
,
3483 doc
: /* Default keymap to use when reading from the minibuffer. */);
3484 Vminibuffer_local_map
= Fmake_sparse_keymap (Qnil
);
3486 DEFVAR_LISP ("minibuffer-local-ns-map", &Vminibuffer_local_ns_map
,
3487 doc
: /* Local keymap for the minibuffer when spaces are not allowed. */);
3488 Vminibuffer_local_ns_map
= Fmake_sparse_keymap (Qnil
);
3489 Fset_keymap_parent (Vminibuffer_local_ns_map
, Vminibuffer_local_map
);
3491 DEFVAR_LISP ("minibuffer-local-completion-map", &Vminibuffer_local_completion_map
,
3492 doc
: /* Local keymap for minibuffer input with completion. */);
3493 Vminibuffer_local_completion_map
= Fmake_sparse_keymap (Qnil
);
3494 Fset_keymap_parent (Vminibuffer_local_completion_map
, Vminibuffer_local_map
);
3496 DEFVAR_LISP ("minibuffer-local-must-match-map", &Vminibuffer_local_must_match_map
,
3497 doc
: /* Local keymap for minibuffer input with completion, for exact match. */);
3498 Vminibuffer_local_must_match_map
= Fmake_sparse_keymap (Qnil
);
3499 Fset_keymap_parent (Vminibuffer_local_must_match_map
,
3500 Vminibuffer_local_completion_map
);
3502 DEFVAR_LISP ("minor-mode-map-alist", &Vminor_mode_map_alist
,
3503 doc
: /* Alist of keymaps to use for minor modes.
3504 Each element looks like (VARIABLE . KEYMAP); KEYMAP is used to read
3505 key sequences and look up bindings iff VARIABLE's value is non-nil.
3506 If two active keymaps bind the same key, the keymap appearing earlier
3507 in the list takes precedence. */);
3508 Vminor_mode_map_alist
= Qnil
;
3510 DEFVAR_LISP ("minor-mode-overriding-map-alist", &Vminor_mode_overriding_map_alist
,
3511 doc
: /* Alist of keymaps to use for minor modes, in current major mode.
3512 This variable is an alist just like `minor-mode-map-alist', and it is
3513 used the same way (and before `minor-mode-map-alist'); however,
3514 it is provided for major modes to bind locally. */);
3515 Vminor_mode_overriding_map_alist
= Qnil
;
3517 DEFVAR_LISP ("emulation-mode-map-alists", &Vemulation_mode_map_alists
,
3518 doc
: /* List of keymap alists to use for emulations modes.
3519 It is intended for modes or packages using multiple minor-mode keymaps.
3520 Each element is a keymap alist just like `minor-mode-map-alist', or a
3521 symbol with a variable binding which is a keymap alist, and it is used
3522 the same way. The "active" keymaps in each alist are used before
3523 `minor-mode-map-alist' and `minor-mode-overriding-map-alist'. */);
3524 Vemulation_mode_map_alists
= Qnil
;
3527 DEFVAR_LISP ("function-key-map", &Vfunction_key_map
,
3528 doc
: /* Keymap mapping ASCII function key sequences onto their preferred forms.
3529 This allows Emacs to recognize function keys sent from ASCII
3530 terminals at any point in a key sequence.
3532 The `read-key-sequence' function replaces any subsequence bound by
3533 `function-key-map' with its binding. More precisely, when the active
3534 keymaps have no binding for the current key sequence but
3535 `function-key-map' binds a suffix of the sequence to a vector or string,
3536 `read-key-sequence' replaces the matching suffix with its binding, and
3537 continues with the new sequence.
3539 The events that come from bindings in `function-key-map' are not
3540 themselves looked up in `function-key-map'.
3542 For example, suppose `function-key-map' binds `ESC O P' to [f1].
3543 Typing `ESC O P' to `read-key-sequence' would return [f1]. Typing
3544 `C-x ESC O P' would return [?\\C-x f1]. If [f1] were a prefix
3545 key, typing `ESC O P x' would return [f1 x]. */);
3546 Vfunction_key_map
= Fmake_sparse_keymap (Qnil
);
3548 DEFVAR_LISP ("key-translation-map", &Vkey_translation_map
,
3549 doc
: /* Keymap of key translations that can override keymaps.
3550 This keymap works like `function-key-map', but comes after that,
3551 and applies even for keys that have ordinary bindings. */);
3552 Vkey_translation_map
= Qnil
;
3554 staticpro (&Vmenu_events
);
3555 Vmenu_events
= Fcons (intern ("menu-bar"),
3556 Fcons (intern ("tool-bar"),
3557 Fcons (intern ("mouse-1"),
3558 Fcons (intern ("mouse-2"),
3559 Fcons (intern ("mouse-3"),
3563 Qsingle_key_description
= intern ("single-key-description");
3564 staticpro (&Qsingle_key_description
);
3566 Qkey_description
= intern ("key-description");
3567 staticpro (&Qkey_description
);
3569 Qkeymapp
= intern ("keymapp");
3570 staticpro (&Qkeymapp
);
3572 Qnon_ascii
= intern ("non-ascii");
3573 staticpro (&Qnon_ascii
);
3575 Qmenu_item
= intern ("menu-item");
3576 staticpro (&Qmenu_item
);
3578 Qremap
= intern ("remap");
3579 staticpro (&Qremap
);
3581 command_remapping_vector
= Fmake_vector (make_number (2), Qremap
);
3582 staticpro (&command_remapping_vector
);
3584 where_is_cache_keymaps
= Qt
;
3585 where_is_cache
= Qnil
;
3586 staticpro (&where_is_cache
);
3587 staticpro (&where_is_cache_keymaps
);
3589 defsubr (&Skeymapp
);
3590 defsubr (&Skeymap_parent
);
3591 defsubr (&Skeymap_prompt
);
3592 defsubr (&Sset_keymap_parent
);
3593 defsubr (&Smake_keymap
);
3594 defsubr (&Smake_sparse_keymap
);
3595 defsubr (&Smap_keymap
);
3596 defsubr (&Scopy_keymap
);
3597 defsubr (&Scommand_remapping
);
3598 defsubr (&Skey_binding
);
3599 defsubr (&Slocal_key_binding
);
3600 defsubr (&Sglobal_key_binding
);
3601 defsubr (&Sminor_mode_key_binding
);
3602 defsubr (&Sdefine_key
);
3603 defsubr (&Slookup_key
);
3604 defsubr (&Sdefine_prefix_command
);
3605 defsubr (&Suse_global_map
);
3606 defsubr (&Suse_local_map
);
3607 defsubr (&Scurrent_local_map
);
3608 defsubr (&Scurrent_global_map
);
3609 defsubr (&Scurrent_minor_mode_maps
);
3610 defsubr (&Scurrent_active_maps
);
3611 defsubr (&Saccessible_keymaps
);
3612 defsubr (&Skey_description
);
3613 defsubr (&Sdescribe_vector
);
3614 defsubr (&Ssingle_key_description
);
3615 defsubr (&Stext_char_description
);
3616 defsubr (&Swhere_is_internal
);
3617 defsubr (&Sdescribe_buffer_bindings
);
3618 defsubr (&Sapropos_internal
);
3624 initial_define_key (global_map
, 033, "ESC-prefix");
3625 initial_define_key (global_map
, Ctl('X'), "Control-X-prefix");